aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--.gitignore4
-rw-r--r--bootstrap/lib/compiler/ebin/beam_a.beambin2236 -> 2288 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_eval.beambin23220 -> 22692 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_pp.beambin24776 -> 25120 bytes
-rw-r--r--erts/configure.in1
-rw-r--r--erts/doc/src/erl.xml24
-rw-r--r--erts/doc/src/erts_alloc.xml86
-rw-r--r--erts/emulator/Makefile.in4
-rw-r--r--erts/emulator/beam/atom.names2
-rw-r--r--erts/emulator/beam/erl_afit_alloc.c20
-rw-r--r--erts/emulator/beam/erl_alloc.c313
-rw-r--r--erts/emulator/beam/erl_alloc.h10
-rw-r--r--erts/emulator/beam/erl_alloc.types9
-rw-r--r--erts/emulator/beam/erl_alloc_util.c2776
-rw-r--r--erts/emulator/beam/erl_alloc_util.h153
-rw-r--r--erts/emulator/beam/erl_ao_firstfit_alloc.c405
-rw-r--r--erts/emulator/beam/erl_ao_firstfit_alloc.h5
-rw-r--r--erts/emulator/beam/erl_bestfit_alloc.c66
-rw-r--r--erts/emulator/beam/erl_bestfit_alloc.h1
-rwxr-xr-xerts/emulator/beam/erl_bif_info.c34
-rw-r--r--erts/emulator/beam/erl_gc.c173
-rw-r--r--erts/emulator/beam/erl_goodfit_alloc.c27
-rw-r--r--erts/emulator/beam/erl_init.c61
-rw-r--r--erts/emulator/beam/erl_instrument.c6
-rw-r--r--erts/emulator/beam/erl_lock_check.c1
-rw-r--r--erts/emulator/beam/erl_port_task.c3
-rw-r--r--erts/emulator/beam/erl_process.c18
-rw-r--r--erts/emulator/beam/erl_process.h10
-rw-r--r--erts/emulator/beam/erl_ptab.c342
-rw-r--r--erts/emulator/beam/erl_ptab.h13
-rwxr-xr-xerts/emulator/beam/global.h12
-rw-r--r--erts/emulator/beam/io.c32
-rw-r--r--erts/emulator/drivers/common/efile_drv.c4
-rw-r--r--erts/emulator/sys/common/erl_check_io.c16
-rw-r--r--erts/emulator/test/alloc_SUITE.erl9
-rw-r--r--erts/emulator/test/alloc_SUITE_data/Makefile.src3
-rw-r--r--erts/emulator/test/alloc_SUITE_data/allocator_test.h15
-rw-r--r--erts/emulator/test/alloc_SUITE_data/coalesce.c2
-rw-r--r--erts/emulator/test/alloc_SUITE_data/cpool.c157
-rw-r--r--erts/emulator/test/alloc_SUITE_data/rbtree.c174
-rw-r--r--erts/emulator/test/driver_SUITE.erl3
-rw-r--r--erts/emulator/test/nif_SUITE.erl3
-rw-r--r--erts/emulator/test/port_SUITE.erl13
-rw-r--r--erts/emulator/test/process_SUITE.erl12
-rw-r--r--erts/emulator/test/send_term_SUITE.erl4
-rw-r--r--erts/etc/common/erlexec.c4
-rw-r--r--erts/etc/unix/cerl.src33
-rw-r--r--erts/preloaded/ebin/erlang.beambin92912 -> 94140 bytes
-rw-r--r--erts/preloaded/ebin/prim_eval.beambin0 -> 1352 bytes
-rw-r--r--erts/preloaded/src/.gitignore1
-rw-r--r--erts/preloaded/src/Makefile26
-rw-r--r--erts/preloaded/src/add_abstract_code34
-rw-r--r--erts/preloaded/src/erlang.erl57
-rw-r--r--erts/preloaded/src/prim_eval.S70
-rw-r--r--erts/preloaded/src/prim_eval.erl28
-rw-r--r--erts/test/z_SUITE.erl9
-rw-r--r--lib/asn1/src/asn1_db.erl67
-rw-r--r--lib/asn1/src/asn1_records.hrl2
-rw-r--r--lib/asn1/src/asn1ct.erl573
-rw-r--r--lib/asn1/src/asn1ct_check.erl970
-rw-r--r--lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl83
-rw-r--r--lib/asn1/src/asn1ct_constructed_per.erl573
-rw-r--r--lib/asn1/src/asn1ct_func.erl21
-rw-r--r--lib/asn1/src/asn1ct_gen.erl179
-rw-r--r--lib/asn1/src/asn1ct_gen_ber_bin_v2.erl532
-rw-r--r--lib/asn1/src/asn1ct_gen_per.erl553
-rw-r--r--lib/asn1/src/asn1ct_gen_per_rt2ct.erl946
-rw-r--r--lib/asn1/src/asn1ct_imm.erl85
-rw-r--r--lib/asn1/src/asn1ct_name.erl152
-rw-r--r--lib/asn1/src/asn1ct_parser2.erl7
-rw-r--r--lib/asn1/src/asn1ct_value.erl4
-rw-r--r--lib/asn1/src/asn1rtt_ber.erl136
-rw-r--r--lib/asn1/src/asn1rtt_per.erl187
-rw-r--r--lib/asn1/src/asn1rtt_uper.erl178
-rw-r--r--lib/asn1/test/Makefile3
-rw-r--r--lib/asn1/test/asn1_SUITE.erl40
-rw-r--r--lib/asn1/test/asn1_SUITE_data/BadEnumValue1.asn8
-rw-r--r--lib/asn1/test/asn1_SUITE_data/Certificate.asn0
-rw-r--r--lib/asn1/test/asn1_SUITE_data/ChoExtension.asn16
-rw-r--r--lib/asn1/test/asn1_SUITE_data/ConstraintEquivalence.asn120
-rw-r--r--lib/asn1/test/asn1_SUITE_data/Constraints.py7
-rw-r--r--lib/asn1/test/asn1_SUITE_data/EUTRA-InterNodeDefinitions.asn123
-rw-r--r--lib/asn1/test/asn1_SUITE_data/EUTRA-UE-Variables.asn49
-rw-r--r--lib/asn1/test/asn1_SUITE_data/EnumExt.asn163
-rw-r--r--lib/asn1/test/asn1_SUITE_data/InfObj.asn92
-rw-r--r--lib/asn1/test/asn1_SUITE_data/InfObj2.asn156
-rw-r--r--lib/asn1/test/asn1_SUITE_data/MAP-insertSubscriberData-def.py102
-rw-r--r--lib/asn1/test/asn1_SUITE_data/Mod.set.asn5
-rw-r--r--lib/asn1/test/asn1_SUITE_data/Mod1.asn18
-rw-r--r--lib/asn1/test/asn1_SUITE_data/Mod2.asn43
-rw-r--r--lib/asn1/test/asn1_SUITE_data/Mod3.asn33
-rw-r--r--lib/asn1/test/asn1_SUITE_data/Mod4.asn33
-rw-r--r--lib/asn1/test/asn1_SUITE_data/Mod5.asn37
-rw-r--r--lib/asn1/test/asn1_SUITE_data/Mvrasn.set.asn7
-rw-r--r--lib/asn1/test/asn1_SUITE_data/P-Record.asn1dbbin3128 -> 0 bytes
-rw-r--r--lib/asn1/test/asn1_SUITE_data/P-Record.erl244
-rw-r--r--lib/asn1/test/asn1_SUITE_data/P-Record.hrl17
-rw-r--r--lib/asn1/test/asn1_SUITE_data/PDUs.py325
-rw-r--r--lib/asn1/test/asn1_SUITE_data/Pattern.asn8
-rw-r--r--lib/asn1/test/asn1_SUITE_data/Prim.asn112
-rw-r--r--lib/asn1/test/asn1_SUITE_data/PrimStrings.asn179
-rw-r--r--lib/asn1/test/asn1_SUITE_data/ROSE.asn1449
-rw-r--r--lib/asn1/test/asn1_SUITE_data/SeqDefault.asn111
-rw-r--r--lib/asn1/test/asn1_SUITE_data/SeqOf.asn19
-rw-r--r--lib/asn1/test/asn1_SUITE_data/SetDefault.asn111
-rw-r--r--lib/asn1/test/asn1_SUITE_data/TConstr.asn16
-rw-r--r--lib/asn1/test/asn1_SUITE_data/Tst.py153
-rw-r--r--lib/asn1/test/asn1_SUITE_data/Two.py34
-rw-r--r--lib/asn1/test/asn1_SUITE_data/UPERDefault.asn18
-rw-r--r--lib/asn1/test/asn1_SUITE_data/UndefType.py14
-rw-r--r--lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl82
-rw-r--r--lib/asn1/test/asn1_test_lib.erl9
-rw-r--r--lib/asn1/test/error_SUITE.erl104
-rw-r--r--lib/asn1/test/testChoExtension.erl5
-rw-r--r--lib/asn1/test/testCompactBitString.erl2
-rw-r--r--lib/asn1/test/testConstraints.erl61
-rw-r--r--lib/asn1/test/testDeepTConstr.erl59
-rw-r--r--lib/asn1/test/testEnumExt.erl12
-rw-r--r--lib/asn1/test/testInfObj.erl47
-rw-r--r--lib/asn1/test/testPrim.erl569
-rw-r--r--lib/asn1/test/testPrimStrings.erl521
-rw-r--r--lib/asn1/test/testSeqOf.erl281
-rw-r--r--lib/common_test/src/ct_config.erl33
-rw-r--r--lib/common_test/src/ct_ftp.erl6
-rw-r--r--lib/common_test/src/ct_gen_conn.erl37
-rw-r--r--lib/common_test/src/ct_netconfc.erl11
-rw-r--r--lib/common_test/src/ct_ssh.erl6
-rw-r--r--lib/common_test/src/ct_telnet.erl17
-rw-r--r--lib/common_test/src/ct_util.erl132
-rw-r--r--lib/common_test/test/Makefile1
-rw-r--r--lib/common_test/test/ct_gen_conn_SUITE.erl135
-rw-r--r--lib/common_test/test/ct_gen_conn_SUITE_data/conn.conf8
-rw-r--r--lib/common_test/test/ct_gen_conn_SUITE_data/conn_SUITE.erl240
-rw-r--r--lib/common_test/test/ct_gen_conn_SUITE_data/proto.erl196
-rw-r--r--lib/compiler/src/beam_a.erl4
-rw-r--r--lib/compiler/src/beam_utils.erl4
-rw-r--r--lib/compiler/test/receive_SUITE.erl21
-rw-r--r--lib/crypto/doc/src/crypto.xml36
-rw-r--r--lib/crypto/test/crypto_SUITE.erl128
-rw-r--r--lib/diameter/doc/src/diameter_app.xml14
-rw-r--r--lib/diameter/doc/src/diameter_transport.xml7
-rw-r--r--lib/diameter/include/diameter_gen.hrl200
-rw-r--r--lib/diameter/src/base/diameter_capx.erl19
-rw-r--r--lib/diameter/src/base/diameter_codec.erl175
-rw-r--r--lib/diameter/src/base/diameter_peer_fsm.erl50
-rw-r--r--lib/diameter/src/base/diameter_traffic.erl165
-rw-r--r--lib/diameter/src/base/diameter_watchdog.erl4
-rw-r--r--lib/diameter/src/compiler/diameter_codegen.erl6
-rw-r--r--lib/diameter/test/diameter_3xxx_SUITE.erl82
-rw-r--r--lib/diameter/test/diameter_app_SUITE.erl2
-rw-r--r--lib/diameter/test/diameter_codec_SUITE_data/diameter_test_unknown.erl4
-rw-r--r--lib/diameter/test/diameter_codec_test.erl10
-rw-r--r--lib/diameter/test/diameter_distribution_SUITE.erl10
-rw-r--r--lib/diameter/test/diameter_examples_SUITE.erl27
-rw-r--r--lib/diameter/test/diameter_gen_tcp_SUITE.erl106
-rw-r--r--lib/diameter/test/diameter_tls_SUITE.erl18
-rw-r--r--lib/diameter/test/diameter_traffic_SUITE.erl150
-rw-r--r--lib/diameter/test/modules.mk1
-rw-r--r--lib/inets/src/http_client/httpc_handler.erl55
-rw-r--r--lib/inets/src/http_lib/http_chunk.erl53
-rw-r--r--lib/inets/test/httpc_SUITE.erl9
-rw-r--r--lib/kernel/test/file_SUITE.erl17
-rw-r--r--lib/kernel/test/file_name_SUITE.erl16
-rw-r--r--lib/kernel/test/gen_tcp_misc_SUITE.erl2
-rw-r--r--lib/kernel/test/interactive_shell_SUITE.erl6
-rw-r--r--lib/kernel/test/prim_file_SUITE.erl17
-rw-r--r--lib/observer/src/crashdump_viewer.erl269
-rw-r--r--lib/observer/src/crashdump_viewer.hrl5
-rw-r--r--lib/observer/src/crashdump_viewer_html.erl84
-rw-r--r--lib/observer/src/observer_lib.erl7
-rw-r--r--lib/observer/src/observer_procinfo.erl56
-rw-r--r--lib/observer/src/observer_sys_wx.erl94
-rw-r--r--lib/odbc/configure.in3
-rw-r--r--lib/reltool/doc/src/reltool_examples.xml3
-rw-r--r--lib/runtime_tools/src/observer_backend.erl24
-rw-r--r--lib/sasl/src/systools_make.erl4
-rw-r--r--lib/snmp/.gitignore5
-rw-r--r--lib/snmp/doc/src/files.mk2
-rw-r--r--lib/snmp/doc/src/notes.xml211
-rw-r--r--lib/snmp/doc/src/ref_man.xml2
-rw-r--r--lib/snmp/doc/src/snmp_app.xml186
-rw-r--r--lib/snmp/doc/src/snmp_config.xml170
-rw-r--r--lib/snmp/doc/src/snmpa_mib_data.xml392
-rw-r--r--lib/snmp/doc/src/snmpa_mib_storage.xml292
-rw-r--r--lib/snmp/src/agent/depend.mk20
-rw-r--r--lib/snmp/src/agent/modules.mk16
-rw-r--r--lib/snmp/src/agent/snmp_user_based_sm_mib.erl14
-rw-r--r--lib/snmp/src/agent/snmpa.erl33
-rw-r--r--lib/snmp/src/agent/snmpa_agent.erl185
-rw-r--r--lib/snmp/src/agent/snmpa_agent_sup.erl10
-rw-r--r--lib/snmp/src/agent/snmpa_mib.erl207
-rw-r--r--lib/snmp/src/agent/snmpa_mib_data.erl1374
-rw-r--r--lib/snmp/src/agent/snmpa_mib_data_ttln.erl1402
-rw-r--r--lib/snmp/src/agent/snmpa_mib_data_tttn.erl1443
-rw-r--r--lib/snmp/src/agent/snmpa_mib_storage.erl181
-rw-r--r--lib/snmp/src/agent/snmpa_mib_storage_dets.erl309
-rw-r--r--lib/snmp/src/agent/snmpa_mib_storage_ets.erl341
-rw-r--r--lib/snmp/src/agent/snmpa_mib_storage_mnesia.erl302
-rw-r--r--lib/snmp/src/agent/snmpa_supervisor.erl107
-rw-r--r--lib/snmp/src/agent/snmpa_symbolic_store.erl283
-rw-r--r--lib/snmp/src/app/snmp.app.src8
-rw-r--r--lib/snmp/src/app/snmp.appup.src12
-rw-r--r--lib/snmp/src/app/snmp.erl18
-rw-r--r--lib/snmp/src/app/snmp_app.erl14
-rw-r--r--lib/snmp/src/manager/snmpm_config.erl41
-rw-r--r--lib/snmp/src/misc/snmp_config.erl22
-rw-r--r--lib/snmp/src/misc/snmp_misc.erl17
-rw-r--r--lib/snmp/src/misc/snmp_usm.erl25
-rw-r--r--lib/snmp/test/snmp_agent_mibs_test.erl263
-rw-r--r--lib/snmp/test/snmp_agent_test.erl2235
-rw-r--r--lib/snmp/test/snmp_agent_test_lib.erl319
-rw-r--r--lib/snmp/test/snmp_test_lib.erl9
-rw-r--r--lib/snmp/vsn.mk2
-rw-r--r--lib/ssl/src/Makefile25
-rw-r--r--lib/ssl/src/dtls.erl (renamed from lib/ssl/src/ssl_debug.hrl)28
-rw-r--r--lib/ssl/src/dtls_connection.erl19
-rw-r--r--lib/ssl/src/dtls_handshake.erl18
-rw-r--r--lib/ssl/src/dtls_handshake.hrl50
-rw-r--r--lib/ssl/src/dtls_record.erl18
-rw-r--r--lib/ssl/src/dtls_record.hrl44
-rw-r--r--lib/ssl/src/ssl.app.src25
-rw-r--r--lib/ssl/src/ssl.erl933
-rw-r--r--lib/ssl/src/ssl_certificate.erl2
-rw-r--r--lib/ssl/src/ssl_connection_sup.erl6
-rw-r--r--lib/ssl/src/ssl_handshake.hrl23
-rw-r--r--lib/ssl/src/ssl_manager.erl31
-rw-r--r--lib/ssl/src/ssl_pkix_db.erl (renamed from lib/ssl/src/ssl_certificate_db.erl)2
-rw-r--r--lib/ssl/src/ssl_record.hrl30
-rw-r--r--lib/ssl/src/tls.erl1037
-rw-r--r--lib/ssl/src/tls_connection.erl (renamed from lib/ssl/src/ssl_connection.erl)194
-rw-r--r--lib/ssl/src/tls_handshake.erl (renamed from lib/ssl/src/ssl_handshake.erl)62
-rw-r--r--lib/ssl/src/tls_handshake.hrl45
-rw-r--r--lib/ssl/src/tls_record.erl (renamed from lib/ssl/src/ssl_record.erl)6
-rw-r--r--lib/ssl/src/tls_record.hrl39
-rw-r--r--lib/ssl/test/Makefile4
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl42
-rw-r--r--lib/ssl/test/ssl_certificate_verify_SUITE.erl4
-rw-r--r--lib/ssl/test/ssl_cipher_SUITE.erl2
-rw-r--r--lib/ssl/test/ssl_handshake_SUITE.erl8
-rw-r--r--lib/ssl/test/ssl_npn_hello_SUITE.erl32
-rw-r--r--lib/ssl/test/ssl_to_openssl_SUITE.erl38
-rw-r--r--lib/stdlib/doc/src/c.xml4
-rw-r--r--lib/stdlib/doc/src/erl_eval.xml5
-rw-r--r--lib/stdlib/src/beam_lib.erl2
-rw-r--r--lib/stdlib/src/c.erl6
-rw-r--r--lib/stdlib/src/erl_eval.erl64
-rw-r--r--lib/stdlib/src/erl_pp.erl8
-rw-r--r--lib/stdlib/src/otp_internal.erl4
-rw-r--r--lib/stdlib/test/c_SUITE.erl11
-rw-r--r--lib/stdlib/test/erl_pp_SUITE.erl13
-rw-r--r--lib/stdlib/test/ets_SUITE.erl20
-rw-r--r--lib/test_server/src/test_server.erl13
-rw-r--r--lib/test_server/src/ts_install_cth.erl4
-rw-r--r--lib/tools/emacs/erlang.el1
254 files changed, 17897 insertions, 12809 deletions
diff --git a/.gitignore b/.gitignore
index a3e03dc46f..7ccedd3ff3 100644
--- a/.gitignore
+++ b/.gitignore
@@ -287,13 +287,13 @@ JAVADOC-GENERATED
# otp_mibs
-/lib/otp_mibs/include/[A-Z]*.hrl
+/lib/otp_mibs/include/OTP*.hrl
/lib/otp_mibs/mibs/v1/OTP*.mib.v1
/lib/otp_mibs/priv/mibs/OTP*.bin
# os_mon
-/lib/os_mon/include/[A-Z]*.hrl
+/lib/os_mon/include/OTP*.hrl
/lib/os_mon/mibs/v1/OTP*.mib.v1
/lib/os_mon/priv/mibs/OTP*.bin
diff --git a/bootstrap/lib/compiler/ebin/beam_a.beam b/bootstrap/lib/compiler/ebin/beam_a.beam
index fd53a2e0f9..a4965abd48 100644
--- a/bootstrap/lib/compiler/ebin/beam_a.beam
+++ b/bootstrap/lib/compiler/ebin/beam_a.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam
index 07f663b2c6..6f4180ee07 100644
--- a/bootstrap/lib/stdlib/ebin/erl_eval.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_eval.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_pp.beam b/bootstrap/lib/stdlib/ebin/erl_pp.beam
index 8e531126d2..ecc8933bef 100644
--- a/bootstrap/lib/stdlib/ebin/erl_pp.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_pp.beam
Binary files differ
diff --git a/erts/configure.in b/erts/configure.in
index b9c9a76ef6..c47c211c4e 100644
--- a/erts/configure.in
+++ b/erts/configure.in
@@ -624,6 +624,7 @@ case $chk_arch_ in
armv5teb) ARCH=arm;;
armv5tel) ARCH=arm;;
armv5tejl) ARCH=arm;;
+ armv6l) ARCH=arm;;
armv7l) ARCH=arm;;
tile) ARCH=tile;;
*) ARCH=noarch;;
diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml
index a68e62d051..8dca7402e8 100644
--- a/erts/doc/src/erl.xml
+++ b/erts/doc/src/erl.xml
@@ -657,10 +657,11 @@
<p>Se also <seealso marker="stdlib:io#printable_range/0">
io:printable_range/0</seealso>.</p>
</item>
- <tag><marker id="+P"/><marker id="max_processes"><c><![CDATA[+P Number]]></c></marker></tag>
+ <tag><marker id="+P"/><marker id="max_processes"><c><![CDATA[+P Number|legacy]]></c></marker></tag>
<item>
<p>Sets the maximum number of simultaneously existing processes for this
- system. Valid range for <c>Number</c> is <c>[1024-134217727]</c></p>
+ system if a <c>Number</c> is passed as value. Valid range for
+ <c>Number</c> is <c>[1024-134217727]</c></p>
<p><em>NOTE</em>: The actual maximum chosen may be much larger than
the <c>Number</c> passed. Currently the runtime system often,
but not always, chooses a value that is a power of 2. This might,
@@ -668,11 +669,19 @@
checked by calling
<seealso marker="erlang#system_info_process_limit">erlang:system_info(process_limit)</seealso>.</p>
<p>The default value is <c>262144</c></p>
+ <p>If <c>legacy</c> is passed as value, the legacy algorithm for
+ allocation of process identifiers will be used. Using the legacy
+ algorithm, identifiers will be allocated in a strictly increasing
+ fashion until largest possible identifier has been reached. Note that
+ this algorithm suffers from performance issues and can under certain
+ circumstances be extremely expensive. The legacy algoritm is deprecated,
+ and the <c>legacy</c> option is scheduled for removal in OTP-R18.</p>
</item>
- <tag><marker id="+Q"/><marker id="max_ports"><c><![CDATA[+Q Number]]></c></marker></tag>
+ <tag><marker id="+Q"/><marker id="max_ports"><c><![CDATA[+Q Number|legacy]]></c></marker></tag>
<item>
<p>Sets the maximum number of simultaneously existing ports for this
- system. Valid range for <c>Number</c> is <c>[1024-134217727]</c></p>
+ system if a Number is passed as value. Valid range for <c>Number</c>
+ is <c>[1024-134217727]</c></p>
<p><em>NOTE</em>: The actual maximum chosen may be much larger than
the actual <c>Number</c> passed. Currently the runtime system often,
but not always, chooses a value that is a power of 2. This might,
@@ -691,6 +700,13 @@
for setting the maximum number of simultaneously existing ports. This
environment variable is deprecated, and scheduled for removal in
OTP-R17, but can still be used.</p>
+ <p>If <c>legacy</c> is passed as value, the legacy algorithm for
+ allocation of port identifiers will be used. Using the legacy
+ algorithm, identifiers will be allocated in a strictly increasing
+ fashion until largest possible identifier has been reached. Note that
+ this algorithm suffers from performance issues and can under certain
+ circumstances be extremely expensive. The legacy algoritm is deprecated,
+ and the <c>legacy</c> option is scheduled for removal in OTP-R18.</p>
</item>
<tag><marker id="compat_rel"><c><![CDATA[+R ReleaseNumber]]></c></marker></tag>
<item>
diff --git a/erts/doc/src/erts_alloc.xml b/erts/doc/src/erts_alloc.xml
index c73cdfd290..2ffb55c6ab 100644
--- a/erts/doc/src/erts_alloc.xml
+++ b/erts/doc/src/erts_alloc.xml
@@ -75,10 +75,6 @@
segments are allocated, cached segments are used if possible
instead of creating new segments. This in order to reduce
the number of system calls made.</item>
- <tag><c>sbmbc_alloc</c></tag>
- <item>Allocator used by other allocators for allocation of carriers
- where only small blocks are placed. Currently this allocator is
- disabled by default.</item>
</taglist>
<p><c>sys_alloc</c> is always enabled and
cannot be disabled. <c>mseg_alloc</c> is always enabled if it is
@@ -86,9 +82,7 @@
allocators can be <seealso marker="#M_e">enabled or disabled</seealso>.
By default all allocators are enabled.
When an allocator is disabled, <c>sys_alloc</c> is used instead of
- the disabled allocator. <c>sbmbc_alloc</c> is an exception. If
- <c>sbmbc_alloc</c> is disabled, other allocators will not handle
- small blocks in separate carriers.</p>
+ the disabled allocator.</p>
<p>The main idea with the <c>erts_alloc</c> library is to separate
memory blocks that are used differently into different memory
areas, and by this achieving less memory fragmentation. By
@@ -106,20 +100,15 @@
following does <em>not</em> apply to them.</p>
<p>An allocator manages multiple areas, called carriers, in which
memory blocks are placed. A carrier is either placed in a
- separate memory segment (allocated via <c>mseg_alloc</c>), in
- the heap segment (allocated via <c>sys_alloc</c>), or inside
- another carrier (in case it is a carrier created by
- <c>sbmbc_alloc</c>). Multiblock
+ separate memory segment (allocated via <c>mseg_alloc</c>), or in
+ the heap segment (allocated via <c>sys_alloc</c>). Multiblock
carriers are used for storage of several blocks. Singleblock
carriers are used for storage of one block. Blocks that are
larger than the value of the singleblock carrier threshold
(<seealso marker="#M_sbct">sbct</seealso>) parameter are placed
in singleblock carriers. Blocks that are smaller than the value
of the <c>sbct</c> parameter are placed in multiblock
- carriers. Blocks that are smaller than the small block multiblock
- carrier threshold (<seealso marker="#M_sbmbct">sbmbct</seealso>)
- will be placed in multiblock carriers only used for small blocks.
- Normally an allocator creates a "main multiblock
+ carriers. Normally an allocator creates a "main multiblock
carrier". Main multiblock carriers are never deallocated. The
size of the main multiblock carrier is determined by the value
of the <seealso marker="#M_mmbcs">mmbcs</seealso> parameter.</p>
@@ -140,9 +129,7 @@
<c>sbct</c> parameter should be larger than the value of the
<c>lmbcs</c> parameter, the allocator may have to create
multiblock carriers that are larger than the value of the
- <c>lmbcs</c> parameter, though. The size of multiblock carriers
- for small blocks is determined by the small block multiblock
- carrier size (<seealso marker="#M_sbmbcs">sbmbcs</seealso>).
+ <c>lmbcs</c> parameter, though.
Singleblock carriers allocated via <c>mseg_alloc</c> are sized
to whole pages.</p>
<p>Sizes of carriers allocated via <c>sys_alloc</c> are
@@ -183,6 +170,15 @@
used. The time complexity is proportional to log N, where
N is the number of free blocks.</p>
</item>
+ <tag>Address order first fit carrier address order best fit</tag>
+ <item>
+ <p>Strategy: Find the <em>carrier</em> with the lowest address that
+ can satisfy the requested block size, then find a block within
+ that carrier using the "adress order best fit" strategy.</p>
+ <p>Implementation: Balanced binary search trees are
+ used. The time complexity is proportional to log N, where
+ N is the number of free blocks.</p>
+ </item>
<tag>Good fit</tag>
<item>
<p>Strategy: Try to find the best fit, but settle for the best fit
@@ -219,11 +215,6 @@
but can only satisfy a limited amount of requests.</p>
</section>
- <note><p>
- Currently only allocators using the best fit and the address order
- best fit strategies are able to use "small block multi block carriers".
- </p></note>
-
<section>
<marker id="flags"></marker>
<title>System Flags Effecting erts_alloc</title>
@@ -245,7 +236,6 @@
the currently present allocators:</p>
<list type="bulleted">
<item><c>B: binary_alloc</c></item>
- <item><c>C: sbmbc_alloc</c></item>
<item><c>D: std_alloc</c></item>
<item><c>E: ets_alloc</c></item>
<item><c>F: fix_alloc</c></item>
@@ -319,10 +309,42 @@
subsystem identifier, only the specific allocator identified will be
effected:</p>
<taglist>
- <tag><marker id="M_as"><c><![CDATA[+M<S>as bf|aobf|aoff|gf|af]]></c></marker></tag>
+ <tag><marker id="M_acul"><c><![CDATA[+M<S>acul <utilization>|de]]></c></marker></tag>
+ <item>
+ Abandon carrier utilization limit. A valid
+ <c><![CDATA[<utilization>]]></c> is an integer in the range
+ <c>[0, 100]</c> representing utilization in percent. When a
+ utilization value larger than zero is used, allocator instances
+ are allowed to abandon multiblock carriers. Currently the default
+ is zero. If <c>de</c> (default enabled) is passed instead of a
+ <c><![CDATA[<utilization>]]></c>, a recomended non zero utilization
+ value will be used. The actual value chosen depend on allocator
+ type and may be changed between ERTS versions. Carriers will be
+ abandoned when memory utilization in the allocator instance falls
+ below the utilization value used. Once a carrier has been abandoned,
+ no new allocations will be made in it. When an allocator instance
+ gets an increased multiblock carrier need, it will first try to
+ fetch an abandoned carrier from an allocator instances of the same
+ allocator type. If no abandoned carrier could be fetched, it will
+ create a new empty carrier. When an abandoned carrier has been
+ fetched it will function as an ordinary carrier. This feature has
+ special requirements on the
+ <seealso marker="#M_as">allocation strategy</seealso> used. Currently
+ only the <c>aoff</c> and the <c>aoffcaobf</c> strategies support
+ abandoned carriers. This feature also requires
+ <seealso marker="#M_t">multiple thread specific instances</seealso>
+ to be enabled. When enabling this feature, multiple thread specific
+ instances will be enabled if not already enabled, and the
+ <c>aoffcaobf</c> strategy will be enabled if current strategy does not
+ support abandoned carriers. This feature can be enabled on all
+ allocators based on the <c>alloc_util</c> framework with the
+ exception of <c>temp_alloc</c> (which would be pointless).
+ </item>
+ <tag><marker id="M_as"><c><![CDATA[+M<S>as bf|aobf|aoff|aoffcaobf|gf|af]]></c></marker></tag>
<item>
Allocation strategy. Valid strategies are <c>bf</c> (best fit),
<c>aobf</c> (address order best fit), <c>aoff</c> (address order first fit),
+ <c>aoffcaobf</c> (address order first fit carrier address order best fit),
<c>gf</c> (good fit), and <c>af</c> (a fit). See
<seealso marker="#strategy">the description of allocation strategies</seealso> in "the <c>alloc_util</c> framework" section.</item>
<tag><marker id="M_asbcst"><c><![CDATA[+M<S>asbcst <size>]]></c></marker></tag>
@@ -416,20 +438,6 @@
smaller than this threshold will be placed in multiblock
carriers. On 32-bit Unix style OS this threshold can not be set higher
than 8 megabytes.</item>
- <tag><marker id="M_sbmbcs"><c><![CDATA[+M<S>sbmbcs <size>]]></c></marker></tag>
- <item>
- Small block multiblock carrier size (in bytes). Memory blocks smaller
- than the small block multiblock carrier threshold
- (<seealso marker="#M_sbmbct">sbmbct</seealso>) will be placed in
- multiblock carriers used for small blocks only. This parameter
- determines the size of such carriers.
- </item>
- <tag><marker id="M_sbmbct"><c><![CDATA[+M<S>sbmbct <size>]]></c></marker></tag>
- <item>
- Small block multiblock carrier threshold (in bytes). Memory blocks
- smaller than this threshold will be placed in multiblock carriers
- used for small blocks only.
- </item>
<tag><marker id="M_smbcs"><c><![CDATA[+M<S>smbcs <size>]]></c></marker></tag>
<item>
Smallest (<c>mseg_alloc</c>) multiblock carrier size (in
diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in
index fb4cde0e76..58e83540e1 100644
--- a/erts/emulator/Makefile.in
+++ b/erts/emulator/Makefile.in
@@ -559,13 +559,14 @@ GENERATE += $(TTF_DIR)/driver_tab.c
# Preloaded code.
#
# This list must be consistent with PRE_LOADED_MODULES in
-# lib/kernel/src/Makefile.
+# erts/preloaded/src/Makefile.
ifeq ($(TARGET),win32)
# On windows the preloaded objects are in a resource object.
PRELOAD_OBJ = $(OBJDIR)/beams.$(RES_EXT)
PRELOAD_SRC = $(TARGET)/beams.rc
$(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \
$(ERL_TOP)/erts/preloaded/ebin/init.beam \
+ $(ERL_TOP)/erts/preloaded/ebin/prim_eval.beam \
$(ERL_TOP)/erts/preloaded/ebin/prim_inet.beam \
$(ERL_TOP)/erts/preloaded/ebin/prim_file.beam \
$(ERL_TOP)/erts/preloaded/ebin/zlib.beam \
@@ -579,6 +580,7 @@ PRELOAD_OBJ = $(OBJDIR)/preload.o
PRELOAD_SRC = $(TARGET)/preload.c
$(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \
$(ERL_TOP)/erts/preloaded/ebin/init.beam \
+ $(ERL_TOP)/erts/preloaded/ebin/prim_eval.beam \
$(ERL_TOP)/erts/preloaded/ebin/prim_inet.beam \
$(ERL_TOP)/erts/preloaded/ebin/prim_file.beam \
$(ERL_TOP)/erts/preloaded/ebin/zlib.beam \
diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index ce60bb9bbc..7d86e486f1 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -248,6 +248,7 @@ atom get_data
atom get_seq_token
atom get_tcw
atom getenv
+atom gather_gc_info_result
atom gather_sched_wall_time_result
atom getting_linked
atom getting_unlinked
@@ -322,6 +323,7 @@ atom maximum
atom max_tables max_processes
atom mbuf_size
atom memory
+atom memory_internal
atom memory_types
atom message
atom message_binary
diff --git a/erts/emulator/beam/erl_afit_alloc.c b/erts/emulator/beam/erl_afit_alloc.c
index b45201af42..eca4e3b3bb 100644
--- a/erts/emulator/beam/erl_afit_alloc.c
+++ b/erts/emulator/beam/erl_afit_alloc.c
@@ -48,10 +48,9 @@ struct AFFreeBlock_t_ {
#define MIN_MBC_FIRST_FREE_SZ (4*1024)
/* Prototypes of callback functions */
-static Block_t * get_free_block (Allctr_t *, Uint,
- Block_t *, Uint, Uint32);
-static void link_free_block (Allctr_t *, Block_t *, Uint32);
-static void unlink_free_block (Allctr_t *, Block_t *, Uint32);
+static Block_t * get_free_block (Allctr_t *, Uint, Block_t *, Uint);
+static void link_free_block (Allctr_t *, Block_t *);
+static void unlink_free_block (Allctr_t *, Block_t *);
static Eterm info_options (Allctr_t *, char *, int *,
@@ -84,8 +83,7 @@ erts_afalc_start(AFAllctr_t *afallctr,
sys_memcpy((void *) afallctr, (void *) &zero.allctr, sizeof(AFAllctr_t));
- init->sbmbct = 0; /* Small mbc not supported by afit */
-
+ allctr->mbc_header_size = sizeof(Carrier_t);
allctr->min_mbc_size = MIN_MBC_SZ;
allctr->min_mbc_first_free_size = MIN_MBC_FIRST_FREE_SZ;
allctr->min_block_size = sizeof(AFFreeBlock_t);
@@ -100,6 +98,9 @@ erts_afalc_start(AFAllctr_t *afallctr,
allctr->get_next_mbc_size = NULL;
allctr->creating_mbc = NULL;
allctr->destroying_mbc = NULL;
+ allctr->add_mbc = NULL;
+ allctr->remove_mbc = NULL;
+ allctr->largest_fblk_in_mbc = NULL;
allctr->init_atoms = init_atoms;
#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG
@@ -116,8 +117,7 @@ erts_afalc_start(AFAllctr_t *afallctr,
}
static Block_t *
-get_free_block(Allctr_t *allctr, Uint size, Block_t *cand_blk, Uint cand_size,
- Uint32 flags)
+get_free_block(Allctr_t *allctr, Uint size, Block_t *cand_blk, Uint cand_size)
{
AFAllctr_t *afallctr = (AFAllctr_t *) allctr;
@@ -135,7 +135,7 @@ get_free_block(Allctr_t *allctr, Uint size, Block_t *cand_blk, Uint cand_size,
}
static void
-link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags)
+link_free_block(Allctr_t *allctr, Block_t *block)
{
AFFreeBlock_t *blk = (AFFreeBlock_t *) block;
AFAllctr_t *afallctr = (AFAllctr_t *) allctr;
@@ -156,7 +156,7 @@ link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags)
}
static void
-unlink_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags)
+unlink_free_block(Allctr_t *allctr, Block_t *block)
{
AFFreeBlock_t *blk = (AFFreeBlock_t *) block;
AFAllctr_t *afallctr = (AFAllctr_t *) allctr;
diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c
index 9de4ef1ff9..a547191d6d 100644
--- a/erts/emulator/beam/erl_alloc.c
+++ b/erts/emulator/beam/erl_alloc.c
@@ -71,6 +71,23 @@
#define AU_ALLOC_DEFAULT_ENABLE(X) (X)
#endif
+#define ERTS_ALC_DEFAULT_ENABLED_ACUL 60
+#define ERTS_ALC_DEFAULT_ENABLED_ACUL_EHEAP_ALLOC 45
+#define ERTS_ALC_DEFAULT_ENABLED_ACUL_LL_ALLOC 85
+
+#define ERTS_ALC_DEFAULT_ACUL 0
+#define ERTS_ALC_DEFAULT_ACUL_EHEAP_ALLOC 0
+#define ERTS_ALC_DEFAULT_ACUL_LL_ALLOC 0
+
+#ifndef ERTS_SMP
+# undef ERTS_ALC_DEFAULT_ACUL
+# define ERTS_ALC_DEFAULT_ACUL 0
+# undef ERTS_ALC_DEFAULT_ACUL_EHEAP_ALLOC
+# define ERTS_ALC_DEFAULT_ACUL_EHEAP_ALLOC 0
+# undef ERTS_ALC_DEFAULT_ACUL_LL_ALLOC
+# define ERTS_ALC_DEFAULT_ACUL_LL_ALLOC 0
+#endif
+
#ifdef DEBUG
static Uint install_debug_functions(void);
#if 0
@@ -101,11 +118,9 @@ typedef union {
char align_aoffa[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(AOFFAllctr_t))];
} ErtsAllocatorState_t;
-static ErtsAllocatorState_t sbmbc_alloc_state;
static ErtsAllocatorState_t std_alloc_state;
static ErtsAllocatorState_t ll_alloc_state;
#if HALFWORD_HEAP
-static ErtsAllocatorState_t sbmbc_low_alloc_state;
static ErtsAllocatorState_t std_low_alloc_state;
static ErtsAllocatorState_t ll_low_alloc_state;
#endif
@@ -120,6 +135,7 @@ static ErtsAllocatorState_t fix_alloc_state;
typedef struct {
erts_smp_atomic32_t refc;
int only_sz;
+ int internal;
Uint req_sched;
Process *proc;
Eterm ref;
@@ -162,6 +178,7 @@ enum allctr_type {
struct au_init {
int enable;
int thr_spec;
+ int carrier_migration_allowed;
enum allctr_type atype;
struct {
AllctrInit_t util;
@@ -200,7 +217,6 @@ typedef struct {
char *mtrace;
char *nodename;
} instr;
- struct au_init sbmbc_alloc;
struct au_init sl_alloc;
struct au_init std_alloc;
struct au_init ll_alloc;
@@ -211,13 +227,12 @@ typedef struct {
struct au_init driver_alloc;
struct au_init fix_alloc;
#if HALFWORD_HEAP
- struct au_init sbmbc_low_alloc;
struct au_init std_low_alloc;
struct au_init ll_low_alloc;
#endif
} erts_alc_hndl_args_init_t;
-#define ERTS_AU_INIT__ {0, 0, GOODFIT, DEFAULT_ALLCTR_INIT, {1,1,1,1}}
+#define ERTS_AU_INIT__ {0, 0, 1, GOODFIT, DEFAULT_ALLCTR_INIT, {1,1,1,1}}
#define SET_DEFAULT_ALLOC_OPTS(IP) \
do { \
@@ -225,32 +240,13 @@ do { \
sys_memcpy((void *) (IP), (void *) &aui__, sizeof(struct au_init)); \
} while (0)
-static void
-set_default_sbmbc_alloc_opts(struct au_init *ip)
+static ERTS_INLINE void
+set_default_acul(struct au_init *ip, int acul)
{
- SET_DEFAULT_ALLOC_OPTS(ip);
- ip->enable = 0;
- ip->thr_spec = 0;
- ip->atype = BESTFIT;
- ip->init.bf.ao = 1;
- ip->init.util.ramv = 0;
- ip->init.util.mmsbc = 0;
- ip->init.util.mmmbc = 500;
- ip->init.util.sbct = ~((UWord) 0);
- ip->init.util.name_prefix = "sbmbc_";
- ip->init.util.alloc_no = ERTS_ALC_A_SBMBC;
-#ifndef SMALL_MEMORY
- ip->init.util.mmbcs = 2*1024*1024; /* Main carrier size */
-#else
- ip->init.util.mmbcs = 1*1024*1024; /* Main carrier size */
-#endif
- ip->init.util.ts = ERTS_ALC_MTA_SBMBC;
- ip->init.util.asbcst = 0;
- ip->init.util.rsbcst = 0;
- ip->init.util.rsbcmt = 0;
- ip->init.util.rmbcmt = 0;
- ip->init.util.sbmbct = 0;
- ip->init.util.sbmbcs = 0;
+ ip->thr_spec = 1;
+ ip->atype = AOFIRSTFIT;
+ ip->init.aoff.bf_within_carrier = 1;
+ ip->init.util.acul = acul;
}
static void
@@ -258,8 +254,12 @@ set_default_sl_alloc_opts(struct au_init *ip)
{
SET_DEFAULT_ALLOC_OPTS(ip);
ip->enable = AU_ALLOC_DEFAULT_ENABLE(1);
+#if ERTS_ALC_DEFAULT_ACUL
+ set_default_acul(ip, ERTS_ALC_DEFAULT_ACUL);
+#else
ip->thr_spec = 1;
ip->atype = GOODFIT;
+#endif
ip->init.util.name_prefix = "sl_";
ip->init.util.mmmbc = 5;
ip->init.util.alloc_no = ERTS_ALC_A_SHORT_LIVED;
@@ -282,8 +282,12 @@ set_default_std_alloc_opts(struct au_init *ip)
{
SET_DEFAULT_ALLOC_OPTS(ip);
ip->enable = AU_ALLOC_DEFAULT_ENABLE(1);
+#if ERTS_ALC_DEFAULT_ACUL
+ set_default_acul(ip, ERTS_ALC_DEFAULT_ACUL);
+#else
ip->thr_spec = 1;
ip->atype = BESTFIT;
+#endif
ip->init.util.name_prefix = "std_";
ip->init.util.mmmbc = 5;
ip->init.util.alloc_no = ERTS_ALC_A_STANDARD;
@@ -300,9 +304,13 @@ set_default_ll_alloc_opts(struct au_init *ip)
{
SET_DEFAULT_ALLOC_OPTS(ip);
ip->enable = AU_ALLOC_DEFAULT_ENABLE(1);
+#if ERTS_ALC_DEFAULT_ACUL_LL_ALLOC
+ set_default_acul(ip, ERTS_ALC_DEFAULT_ACUL_LL_ALLOC);
+#else
ip->thr_spec = 0;
ip->atype = BESTFIT;
ip->init.bf.ao = 1;
+#endif
ip->init.util.ramv = 0;
ip->init.util.mmsbc = 0;
ip->init.util.mmmbc = 0;
@@ -319,8 +327,6 @@ set_default_ll_alloc_opts(struct au_init *ip)
ip->init.util.rsbcst = 0;
ip->init.util.rsbcmt = 0;
ip->init.util.rmbcmt = 0;
- ip->init.util.sbmbct = 0;
- ip->init.util.sbmbcs = 0;
}
static void
@@ -329,6 +335,7 @@ set_default_temp_alloc_opts(struct au_init *ip)
SET_DEFAULT_ALLOC_OPTS(ip);
ip->enable = AU_ALLOC_DEFAULT_ENABLE(1);
ip->thr_spec = 1;
+ ip->carrier_migration_allowed = 0;
ip->atype = AFIT;
ip->init.util.name_prefix = "temp_";
ip->init.util.alloc_no = ERTS_ALC_A_TEMPORARY;
@@ -351,8 +358,12 @@ set_default_eheap_alloc_opts(struct au_init *ip)
{
SET_DEFAULT_ALLOC_OPTS(ip);
ip->enable = AU_ALLOC_DEFAULT_ENABLE(1);
+#if ERTS_ALC_DEFAULT_ACUL_EHEAP_ALLOC
+ set_default_acul(ip, ERTS_ALC_DEFAULT_ACUL_EHEAP_ALLOC);
+#else
ip->thr_spec = 1;
ip->atype = GOODFIT;
+#endif
ip->init.util.mmmbc = 100;
ip->init.util.name_prefix = "eheap_";
ip->init.util.alloc_no = ERTS_ALC_A_EHEAP;
@@ -374,8 +385,12 @@ set_default_binary_alloc_opts(struct au_init *ip)
{
SET_DEFAULT_ALLOC_OPTS(ip);
ip->enable = AU_ALLOC_DEFAULT_ENABLE(1);
+#if ERTS_ALC_DEFAULT_ACUL
+ set_default_acul(ip, ERTS_ALC_DEFAULT_ACUL);
+#else
ip->thr_spec = 1;
ip->atype = BESTFIT;
+#endif
ip->init.util.mmmbc = 50;
ip->init.util.name_prefix = "binary_";
ip->init.util.alloc_no = ERTS_ALC_A_BINARY;
@@ -392,8 +407,12 @@ set_default_ets_alloc_opts(struct au_init *ip)
{
SET_DEFAULT_ALLOC_OPTS(ip);
ip->enable = AU_ALLOC_DEFAULT_ENABLE(1);
+#if ERTS_ALC_DEFAULT_ACUL
+ set_default_acul(ip, ERTS_ALC_DEFAULT_ACUL);
+#else
ip->thr_spec = 1;
ip->atype = BESTFIT;
+#endif
ip->init.util.mmmbc = 100;
ip->init.util.name_prefix = "ets_";
ip->init.util.alloc_no = ERTS_ALC_A_ETS;
@@ -410,8 +429,12 @@ set_default_driver_alloc_opts(struct au_init *ip)
{
SET_DEFAULT_ALLOC_OPTS(ip);
ip->enable = AU_ALLOC_DEFAULT_ENABLE(1);
+#if ERTS_ALC_DEFAULT_ACUL
+ set_default_acul(ip, ERTS_ALC_DEFAULT_ACUL);
+#else
ip->thr_spec = 1;
ip->atype = BESTFIT;
+#endif
ip->init.util.name_prefix = "driver_";
ip->init.util.alloc_no = ERTS_ALC_A_DRIVER;
#ifndef SMALL_MEMORY
@@ -428,8 +451,12 @@ set_default_fix_alloc_opts(struct au_init *ip,
{
SET_DEFAULT_ALLOC_OPTS(ip);
ip->enable = AU_ALLOC_DEFAULT_ENABLE(1);
+#if ERTS_ALC_DEFAULT_ACUL
+ set_default_acul(ip, ERTS_ALC_DEFAULT_ACUL);
+#else
ip->thr_spec = 1;
ip->atype = BESTFIT;
+#endif
ip->init.bf.ao = 1;
ip->init.util.name_prefix = "fix_";
ip->init.util.fix_type_size = fix_type_sizes;
@@ -527,6 +554,39 @@ static void adjust_fix_alloc_sizes(UWord extra_block_size)
}
}
+static ERTS_INLINE int
+strategy_support_carrier_migration(struct au_init *auip)
+{
+ /*
+ * Currently only aoff and aoffcaobf support carrier
+ * migration, i.e, type AOFIRSTFIT.
+ */
+ return auip->atype == AOFIRSTFIT;
+}
+
+static ERTS_INLINE void
+check_disable_carrier_migration(struct au_init *auip)
+{
+ if (!strategy_support_carrier_migration(auip) || !auip->thr_spec)
+ auip->init.util.acul = 0;
+}
+
+static ERTS_INLINE void
+ensure_carrier_migration_support(struct au_init *auip)
+{
+ auip->thr_spec = 1; /* Need thread preferred */
+
+ /*
+ * If strategy cannot handle carrier migration,
+ * default to a strategy that can...
+ */
+ if (!strategy_support_carrier_migration(auip)) {
+ /* Default to aoffcaobf */
+ auip->atype = AOFIRSTFIT;
+ auip->init.aoff.bf_within_carrier = 1;
+ }
+}
+
void
erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
{
@@ -565,7 +625,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
hdbg_init();
#endif
- erts_have_sbmbc_alloc = 0;
ncpu = eaiop->ncpu;
if (ncpu < 1)
ncpu = 1;
@@ -575,7 +634,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
erts_sys_alloc_init();
erts_init_utils_mem();
- set_default_sbmbc_alloc_opts(&init.sbmbc_alloc);
set_default_sl_alloc_opts(&init.sl_alloc);
set_default_std_alloc_opts(&init.std_alloc);
set_default_ll_alloc_opts(&init.ll_alloc);
@@ -591,7 +649,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
handle_args(argc, argv, &init);
#ifndef ERTS_SMP
- init.sbmbc_alloc.thr_spec = 0;
init.sl_alloc.thr_spec = 0;
init.std_alloc.thr_spec = 0;
init.ll_alloc.thr_spec = 0;
@@ -604,7 +661,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
if (init.erts_alloc_config) {
/* Adjust flags that erts_alloc_config won't like */
- init.sbmbc_alloc.thr_spec = 0;
init.temp_alloc.thr_spec = 0;
init.sl_alloc.thr_spec = 0;
init.std_alloc.thr_spec = 0;
@@ -616,13 +672,22 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
init.fix_alloc.thr_spec = 0;
}
+ check_disable_carrier_migration(&init.sl_alloc);
+ check_disable_carrier_migration(&init.std_alloc);
+ check_disable_carrier_migration(&init.ll_alloc);
+ check_disable_carrier_migration(&init.eheap_alloc);
+ check_disable_carrier_migration(&init.binary_alloc);
+ check_disable_carrier_migration(&init.ets_alloc);
+ check_disable_carrier_migration(&init.driver_alloc);
+ check_disable_carrier_migration(&init.fix_alloc);
+
+
#ifdef ERTS_SMP
/* Only temp_alloc can use thread specific interface */
if (init.temp_alloc.thr_spec)
init.temp_alloc.thr_spec = erts_no_schedulers;
/* Others must use thread preferred interface */
- adjust_tpref(&init.sbmbc_alloc, erts_no_schedulers);
adjust_tpref(&init.sl_alloc, erts_no_schedulers);
adjust_tpref(&init.std_alloc, erts_no_schedulers);
adjust_tpref(&init.ll_alloc, erts_no_schedulers);
@@ -641,7 +706,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
* The following allocators cannot be run with afit strategy.
* Make sure they don't...
*/
- refuse_af_strategy(&init.sbmbc_alloc);
refuse_af_strategy(&init.sl_alloc);
refuse_af_strategy(&init.std_alloc);
refuse_af_strategy(&init.ll_alloc);
@@ -685,11 +749,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
#if HALFWORD_HEAP
/* Init low memory variants by cloning */
- init.sbmbc_low_alloc = init.sbmbc_alloc;
- init.sbmbc_low_alloc.init.util.name_prefix = "sbmbc_low_";
- init.sbmbc_low_alloc.init.util.alloc_no = ERTS_ALC_A_SBMBC_LOW;
- init.sbmbc_low_alloc.init.util.low_mem = 1;
-
init.std_low_alloc = init.std_alloc;
init.std_low_alloc.init.util.name_prefix = "std_low_";
init.std_low_alloc.init.util.alloc_no = ERTS_ALC_A_STANDARD_LOW;
@@ -702,13 +761,11 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
init.ll_low_alloc.init.util.force = 1;
init.ll_low_alloc.init.util.low_mem = 1;
- set_au_allocator(ERTS_ALC_A_SBMBC_LOW, &init.sbmbc_low_alloc, ncpu);
set_au_allocator(ERTS_ALC_A_STANDARD_LOW, &init.std_low_alloc, ncpu);
set_au_allocator(ERTS_ALC_A_LONG_LIVED_LOW, &init.ll_low_alloc, ncpu);
#endif /* HALFWORD */
set_au_allocator(ERTS_ALC_A_TEMPORARY, &init.temp_alloc, ncpu);
- set_au_allocator(ERTS_ALC_A_SBMBC, &init.sbmbc_alloc, ncpu);
set_au_allocator(ERTS_ALC_A_SHORT_LIVED, &init.sl_alloc, ncpu);
set_au_allocator(ERTS_ALC_A_STANDARD, &init.std_alloc, ncpu);
set_au_allocator(ERTS_ALC_A_LONG_LIVED, &init.ll_alloc, ncpu);
@@ -735,20 +792,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
erts_mtrace_init(init.instr.mtrace, init.instr.nodename);
- /* sbmbc_alloc() needs to be started first */
- start_au_allocator(ERTS_ALC_A_SBMBC,
- &init.sbmbc_alloc,
- &sbmbc_alloc_state);
-#if HALFWORD_HEAP
- start_au_allocator(ERTS_ALC_A_SBMBC_LOW,
- &init.sbmbc_low_alloc,
- &sbmbc_low_alloc_state);
- erts_have_sbmbc_alloc = (init.sbmbc_alloc.enable
- && init.sbmbc_low_alloc.enable);
-#else
- erts_have_sbmbc_alloc = init.sbmbc_alloc.enable;
-#endif
-
start_au_allocator(ERTS_ALC_A_TEMPORARY,
&init.temp_alloc,
&temp_alloc_state);
@@ -1138,6 +1181,7 @@ get_kb_value(char *param_end, char** argv, int* ip)
return ((Uint) tmp)*1024;
}
+#if 0
static Uint
get_byte_value(char *param_end, char** argv, int* ip)
{
@@ -1151,6 +1195,7 @@ get_byte_value(char *param_end, char** argv, int* ip)
bad_value(param, param_end, value);
return (Uint) tmp;
}
+#endif
static Uint
get_amount_value(char *param_end, char** argv, int* ip)
@@ -1166,17 +1211,59 @@ get_amount_value(char *param_end, char** argv, int* ip)
return (Uint) tmp;
}
+static Uint
+get_acul_value(struct au_init *auip, char *param_end, char** argv, int* ip)
+{
+ Sint tmp;
+ char *rest;
+ char *param = argv[*ip]+1;
+ char *value = get_value(param_end, argv, ip);
+ if (sys_strcmp(value, "de") == 0) {
+ switch (auip->init.util.alloc_no) {
+ case ERTS_ALC_A_LONG_LIVED:
+#if HALFWORD_HEAP
+ case ERTS_ALC_A_LONG_LIVED_LOW:
+#endif
+ return ERTS_ALC_DEFAULT_ENABLED_ACUL_LL_ALLOC;
+ case ERTS_ALC_A_EHEAP:
+ return ERTS_ALC_DEFAULT_ENABLED_ACUL_EHEAP_ALLOC;
+ default:
+ return ERTS_ALC_DEFAULT_ENABLED_ACUL;
+ }
+ }
+ errno = 0;
+ tmp = (Sint) ErtsStrToSint(value, &rest, 10);
+ if (errno != 0 || rest == value || tmp < 0 || 100 < tmp)
+ bad_value(param, param_end, value);
+ return (Uint) tmp;
+}
+
static void
handle_au_arg(struct au_init *auip,
char* sub_param,
char** argv,
- int* ip)
+ int* ip,
+ int u_switch)
{
char *param = argv[*ip]+1;
switch (sub_param[0]) {
case 'a':
- if(has_prefix("asbcst", sub_param)) {
+ if (has_prefix("acul", sub_param)) {
+ if (!auip->carrier_migration_allowed) {
+ if (!u_switch)
+ goto bad_switch;
+ else {
+ /* ignore */
+ (void) get_acul_value(auip, sub_param + 4, argv, ip);
+ break;
+ }
+ }
+ ensure_carrier_migration_support(auip);
+
+ auip->init.util.acul = get_acul_value(auip, sub_param + 4, argv, ip);
+ }
+ else if(has_prefix("asbcst", sub_param)) {
auip->init.util.asbcst = get_kb_value(sub_param + 6, argv, ip);
}
else if(has_prefix("as", sub_param)) {
@@ -1197,21 +1284,22 @@ handle_au_arg(struct au_init *auip,
}
else if (strcmp("aoff", alg) == 0) {
auip->atype = AOFIRSTFIT;
+ auip->init.aoff.bf_within_carrier = 0;
+ }
+ else if (strcmp("aoffcaobf", alg) == 0) {
+ auip->atype = AOFIRSTFIT;
+ auip->init.aoff.bf_within_carrier = 1;
}
else {
bad_value(param, sub_param + 1, alg);
}
+ check_disable_carrier_migration(auip);
}
else
goto bad_switch;
break;
case 'e':
auip->enable = get_bool_value(sub_param+1, argv, ip);
-#if !HAVE_ERTS_SBMBC
- if (auip->init.util.alloc_no == ERTS_ALC_A_SBMBC) {
- auip->enable = 0;
- }
-#endif
break;
case 'l':
if (has_prefix("lmbcs", sub_param)) {
@@ -1271,18 +1359,6 @@ handle_au_arg(struct au_init *auip,
if(has_prefix("sbct", sub_param)) {
auip->init.util.sbct = get_kb_value(sub_param + 4, argv, ip);
}
- else if (has_prefix("sbmbcs", sub_param)) {
-#if HAVE_ERTS_SBMBC
- auip->init.util.sbmbcs =
-#endif
- get_byte_value(sub_param + 6, argv, ip);
- }
- else if (has_prefix("sbmbct", sub_param)) {
-#if HAVE_ERTS_SBMBC
- auip->init.util.sbmbct =
-#endif
- get_byte_value(sub_param + 6, argv, ip);
- }
else if (has_prefix("smbcs", sub_param)) {
auip->default_.smbcs = 0;
auip->init.util.smbcs = get_kb_value(sub_param + 5, argv, ip);
@@ -1298,6 +1374,7 @@ handle_au_arg(struct au_init *auip,
}
else if (res == 0) {
auip->thr_spec = 0;
+ check_disable_carrier_migration(auip);
break;
}
goto bad_switch;
@@ -1312,7 +1389,6 @@ static void
handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init)
{
struct au_init *aui[] = {
- &init->sbmbc_alloc,
&init->binary_alloc,
&init->std_alloc,
&init->ets_alloc,
@@ -1339,25 +1415,22 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init)
case 'M':
switch (argv[i][2]) {
case 'B':
- handle_au_arg(&init->binary_alloc, &argv[i][3], argv, &i);
- break;
- case 'C':
- handle_au_arg(&init->sbmbc_alloc, &argv[i][3], argv, &i);
+ handle_au_arg(&init->binary_alloc, &argv[i][3], argv, &i, 0);
break;
case 'D':
- handle_au_arg(&init->std_alloc, &argv[i][3], argv, &i);
+ handle_au_arg(&init->std_alloc, &argv[i][3], argv, &i, 0);
break;
case 'E':
- handle_au_arg(&init->ets_alloc, &argv[i][3], argv, &i);
+ handle_au_arg(&init->ets_alloc, &argv[i][3], argv, &i, 0);
break;
case 'F':
- handle_au_arg(&init->fix_alloc, &argv[i][3], argv, &i);
+ handle_au_arg(&init->fix_alloc, &argv[i][3], argv, &i, 0);
break;
case 'H':
- handle_au_arg(&init->eheap_alloc, &argv[i][3], argv, &i);
+ handle_au_arg(&init->eheap_alloc, &argv[i][3], argv, &i, 0);
break;
case 'L':
- handle_au_arg(&init->ll_alloc, &argv[i][3], argv, &i);
+ handle_au_arg(&init->ll_alloc, &argv[i][3], argv, &i, 0);
break;
case 'M':
if (has_prefix("amcbf", argv[i]+3)) {
@@ -1383,13 +1456,13 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init)
}
break;
case 'R':
- handle_au_arg(&init->driver_alloc, &argv[i][3], argv, &i);
+ handle_au_arg(&init->driver_alloc, &argv[i][3], argv, &i, 0);
break;
case 'S':
- handle_au_arg(&init->sl_alloc, &argv[i][3], argv, &i);
+ handle_au_arg(&init->sl_alloc, &argv[i][3], argv, &i, 0);
break;
case 'T':
- handle_au_arg(&init->temp_alloc, &argv[i][3], argv, &i);
+ handle_au_arg(&init->temp_alloc, &argv[i][3], argv, &i, 0);
break;
case 'Y': { /* sys_alloc */
if (has_prefix("tt", param+2)) {
@@ -1448,9 +1521,6 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init)
else if (strcmp("max", arg) == 0) {
for (a = 0; a < aui_sz; a++)
aui[a]->enable = 1;
-#if !HAVE_ERTS_SBMBC
- init->sbmbc_alloc.enable = 0;
-#endif
}
else if (strcmp("config", arg) == 0) {
init->erts_alloc_config = 1;
@@ -1478,6 +1548,7 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init)
for (a = 0; a < aui_sz; a++) {
aui[a]->thr_spec = 0;
+ check_disable_carrier_migration(aui[a]);
aui[a]->init.util.ramv = 0;
aui[a]->init.util.mmmbc = 10;
aui[a]->init.util.lmbcs = 5*1024*1024;
@@ -1542,7 +1613,7 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init)
argv[start + 1] = val;
i = start;
}
- handle_au_arg(aui[a], &argv[i][3], argv, &i);
+ handle_au_arg(aui[a], &argv[i][3], argv, &i, 1);
}
}
break;
@@ -2088,15 +2159,11 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg)
return am_badarg;
}
- /* All alloc_util allocators except sbmbc_alloc *have* to be enabled */
+ /* All alloc_util allocators *have* to be enabled */
for (ai = ERTS_ALC_A_MIN; ai <= ERTS_ALC_A_MAX; ai++) {
switch (ai) {
case ERTS_ALC_A_SYSTEM:
- case ERTS_ALC_A_SBMBC:
-#if HALFWORD_HEAP
- case ERTS_ALC_A_SBMBC_LOW:
-#endif
break;
default:
if (!erts_allctrs_info[ai].enabled
@@ -2136,12 +2203,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg)
* Often not thread safe and usually never
* contain any allocated memory.
*/
- case ERTS_ALC_A_SBMBC:
- /* Included in other allocators */
-#if HALFWORD_HEAP
- case ERTS_ALC_A_SBMBC_LOW:
- /* Included in other allocators */
-#endif
continue;
case ERTS_ALC_A_EHEAP:
save = &size.processes;
@@ -2176,7 +2237,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg)
if (want_tot_or_sys || want.processes || want.processes_used) {
- int max_processes = erts_ptab_max(&erts_proc);
UWord tmp;
if (ERTS_MEM_NEED_ALL_ALCU)
@@ -2186,7 +2246,7 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg)
fi, ERTS_ALC_NO_FIXED_SIZES);
tmp = alcu_size(ERTS_ALC_A_EHEAP, NULL, 0);
}
- tmp += max_processes*sizeof(erts_smp_atomic_t);
+ tmp += erts_ptab_mem_size(&erts_proc);
tmp += erts_bif_timer_memory_size();
tmp += erts_tot_link_lh_size();
@@ -2312,13 +2372,11 @@ struct aa_values {
Eterm
erts_allocated_areas(int *print_to_p, void *print_to_arg, void *proc)
{
-#define MAX_AA_VALUES (23)
+#define MAX_AA_VALUES (24)
struct aa_values values[MAX_AA_VALUES];
Eterm res = THE_NON_VALUE;
int i, length;
Uint reserved_atom_space, atom_space;
- int max_processes = erts_ptab_max(&erts_proc);
- int max_ports = erts_ptab_max(&erts_port);
if (proc) {
ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN
@@ -2349,8 +2407,8 @@ erts_allocated_areas(int *print_to_p, void *print_to_arg, void *proc)
values[i].arity = 2;
values[i].name = "static";
- values[i].ui[0] =
- max_ports*sizeof(erts_smp_atomic_t) /* Port table */
+ values[i].ui[0] =
+ sizeof(ErtsPTab)*2 /* proc & port tables */
+ erts_timer_wheel_memory_size(); /* Timer wheel */
i++;
@@ -2429,7 +2487,12 @@ erts_allocated_areas(int *print_to_p, void *print_to_arg, void *proc)
values[i].arity = 2;
values[i].name = "process_table";
- values[i].ui[0] = max_processes*sizeof(Process*);
+ values[i].ui[0] = erts_ptab_mem_size(&erts_proc);
+ i++;
+
+ values[i].arity = 2;
+ values[i].name = "port_table";
+ values[i].ui[0] = erts_ptab_mem_size(&erts_port);
i++;
values[i].arity = 2;
@@ -2583,7 +2646,7 @@ erts_allocator_info(int to, void *arg)
as = erts_allctr_thr_spec[a].allctr[ai];
}
/* Binary alloc has its own thread safety... */
- erts_alcu_info(as, 0, &to, arg, NULL, NULL);
+ erts_alcu_info(as, 0, 0, &to, arg, NULL, NULL);
}
else {
switch (a) {
@@ -2845,6 +2908,7 @@ reply_alloc_info(void *vair)
int i;
Eterm (*info_func)(Allctr_t *,
int,
+ int,
int *,
void *,
Uint **,
@@ -2973,8 +3037,8 @@ reply_alloc_info(void *vair)
allctr = erts_allctr_thr_spec[ai].allctr[0];
else
allctr = erts_allctrs_info[ai].extra;
- ainfo = info_func(allctr, hpp != NULL, NULL,
- NULL, hpp, szp);
+ ainfo = info_func(allctr, air->internal, hpp != NULL,
+ NULL, NULL, hpp, szp);
ainfo = erts_bld_tuple(hpp, szp, 3, alloc_atom,
make_small(0), ainfo);
}
@@ -3009,7 +3073,7 @@ reply_alloc_info(void *vair)
alloc_atom = erts_bld_atom(hpp, szp,
(char *) ERTS_ALC_A2AD(ai));
allctr = erts_allctr_thr_spec[ai].allctr[sched_id];
- ainfo = info_func(allctr, hpp != NULL, NULL,
+ ainfo = info_func(allctr, air->internal, hpp != NULL, NULL,
NULL, hpp, szp);
ai_list = erts_bld_cons(hpp, szp,
erts_bld_tuple(
@@ -3065,7 +3129,8 @@ int
erts_request_alloc_info(struct process *c_p,
Eterm ref,
Eterm allocs,
- int only_sz)
+ int only_sz,
+ int internal)
{
ErtsAllocInfoReq *air = aireq_alloc();
Eterm req_ai[ERTS_ALC_A_MAX+1+2] = {0};
@@ -3077,6 +3142,8 @@ erts_request_alloc_info(struct process *c_p,
air->only_sz = only_sz;
+ air->internal = internal;
+
air->proc = c_p;
if (is_not_internal_ref(ref))
@@ -3271,14 +3338,13 @@ UWord erts_alc_test(UWord op, UWord a1, UWord a2, UWord a3)
init.atype = GOODFIT;
init.init.util.name_prefix = (char *) a1;
init.init.util.ts = a2 ? 1 : 0;
- init.init.util.sbmbct = 0;
if ((char **) a3) {
char **argv = (char **) a3;
int i = 0;
while (argv[i]) {
if (argv[i][0] == '-' && argv[i][1] == 't')
- handle_au_arg(&init, &argv[i][2], argv, &i);
+ handle_au_arg(&init, &argv[i][2], argv, &i, 0);
else
return (UWord) NULL;
i++;
@@ -3398,6 +3464,11 @@ UWord erts_alc_test(UWord op, UWord a1, UWord a2, UWord a3)
ERTS_ALC_TEST_ABORT;
break;
#endif /* #ifdef USE_THREADS */
+#ifdef ERTS_SMP
+ case 0xf13: return (UWord) 1;
+#else
+ case 0xf13: return (UWord) 0;
+#endif
default:
break;
}
diff --git a/erts/emulator/beam/erl_alloc.h b/erts/emulator/beam/erl_alloc.h
index 9cafd8ddc8..d9fdfc6f58 100644
--- a/erts/emulator/beam/erl_alloc.h
+++ b/erts/emulator/beam/erl_alloc.h
@@ -65,7 +65,7 @@ Eterm erts_allocator_options(void *proc);
struct process;
int erts_request_alloc_info(struct process *c_p, Eterm ref, Eterm allocs,
- int only_sz);
+ int only_sz, int internal);
#define ERTS_ALLOC_INIT_DEF_OPTS_INITER {0}
typedef struct {
@@ -100,14 +100,6 @@ UWord erts_alc_test(UWord,
#define ERTS_ALC_MIN_LONG_LIVED_TIME (10*60*1000)
-#if HALFWORD_HEAP
-#define ERTS_IS_SBMBC_ALLOCATOR_NO__(NO) \
- ((NO) == ERTS_ALC_A_SBMBC || (NO) == ERTS_ALC_A_SBMBC_LOW)
-#else
-#define ERTS_IS_SBMBC_ALLOCATOR_NO__(NO) \
- ((NO) == ERTS_ALC_A_SBMBC)
-#endif
-
typedef struct {
int alloc_util;
int enabled;
diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types
index 5a92ab7f24..095ad24387 100644
--- a/erts/emulator/beam/erl_alloc.types
+++ b/erts/emulator/beam/erl_alloc.types
@@ -76,11 +76,6 @@
allocator SYSTEM true sys_alloc
-allocator SBMBC true sbmbc_alloc
-+if halfword
-allocator SBMBC_LOW true sbmbc_low_alloc
-+endif
-
+if smp
allocator TEMPORARY true temp_alloc
@@ -146,7 +141,6 @@ class SYSTEM system_data
#
# <TYPE> <ALLOCATOR> <CLASS> <DESCRIPTION>
-type SBMBC SBMBC SYSTEM small_block_mbc
type PROC FIXED_SIZE PROCESSES proc
type PORT DRIVER SYSTEM port
type ATOM LONG_LIVED ATOM atom_entry
@@ -351,7 +345,6 @@ type SSB SHORT_LIVED PROCESSES ssb
+if halfword
-type SBMBC_LOW SBMBC_LOW SYSTEM small_block_mbc_low
type DDLL_PROCESS STANDARD_LOW SYSTEM ddll_processes
type MONITOR_LH STANDARD_LOW PROCESSES monitor_lh
type NLINK_LH STANDARD_LOW PROCESSES nlink_lh
@@ -366,6 +359,7 @@ 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
+type GC_INFO_REQ STANDARD_LOW SYSTEM gc_info_request
+else # "fullword"
@@ -383,6 +377,7 @@ 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
+type GC_INFO_REQ SHORT_LIVED SYSTEM gc_info_request
+endif
diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c
index 53062979a6..b19e603a5f 100644
--- a/erts/emulator/beam/erl_alloc_util.c
+++ b/erts/emulator/beam/erl_alloc_util.c
@@ -71,21 +71,16 @@
#define ALLOC_ZERO_EQ_NULL 0
+#ifndef ERTS_MSEG_FLG_2POW
+# define ERTS_MSEG_FLG_2POW 0
+#endif
+#ifndef ERTS_MSEG_FLG_NONE
+# define ERTS_MSEG_FLG_NONE 0
+#endif
+
static int atoms_initialized = 0;
static int initialized = 0;
-int erts_have_sbmbc_alloc;
-
-#if HAVE_ERTS_MSEG
-
-#define MSEG_UNIT_SHIFT MSEG_ALIGN_BITS
-#define MSEG_UNIT_SZ (1 << MSEG_UNIT_SHIFT)
-#define MSEG_UNIT_MASK ((~(UWord)0) << MSEG_UNIT_SHIFT)
-
-#define MSEG_UNIT_FLOOR(X) ((X) & MSEG_UNIT_MASK)
-#define MSEG_UNIT_CEILING(X) MSEG_UNIT_FLOOR((X) + ~MSEG_UNIT_MASK)
-
-#endif
#define INV_SYS_ALLOC_CARRIER_MASK ((UWord) (sys_alloc_carrier_size - 1))
#define SYS_ALLOC_CARRIER_MASK (~INV_SYS_ALLOC_CARRIER_MASK)
@@ -110,13 +105,12 @@ static Uint max_mseg_carriers;
#define ONE_GIGA (1000000000)
-#define INC_CC(CC) ((CC).no == ONE_GIGA - 1 \
- ? ((CC).giga_no++, (CC).no = 0) \
- : (CC).no++)
+#define ERTS_ALC_CC_GIGA_VAL(CC) ((CC) / ONE_GIGA)
+#define ERTS_ALC_CC_VAL(CC) ((CC) % ONE_GIGA)
+
+#define INC_CC(CC) ((CC)++)
-#define DEC_CC(CC) ((CC).no == 0 \
- ? ((CC).giga_no--, (CC).no = ONE_GIGA - 1) \
- : (CC).no--)
+#define DEC_CC(CC) ((CC)--)
/* Multi block carrier (MBC) memory layout in R16:
@@ -173,14 +167,6 @@ MBC after deallocating first block:
#define SET_BLK_SZ_FTR(B, SZ) \
(((FreeBlkFtr_t *) (((char *) (B)) + (SZ)))[-1] = (SZ))
-#define THIS_FREE_BLK_HDR_FLG (((UWord) 1) << 0)
-#define PREV_FREE_BLK_HDR_FLG (((UWord) 1) << 1)
-#define LAST_BLK_HDR_FLG (((UWord) 1) << 2)
-
-/* Special flag combo for (allocated) SBC blocks
-*/
-#define SBC_BLK_HDR_FLG (THIS_FREE_BLK_HDR_FLG | PREV_FREE_BLK_HDR_FLG | LAST_BLK_HDR_FLG)
-
#define SET_MBC_ABLK_SZ(B, SZ) \
(ASSERT(((SZ) & FLG_MASK) == 0), \
(B)->bhdr = (((B)->bhdr) & ~MBC_ABLK_SZ_MASK) | (SZ))
@@ -222,18 +208,7 @@ MBC after deallocating first block:
ASSERT(((UWord)(F) & (~FLG_MASK|THIS_FREE_BLK_HDR_FLG|PREV_FREE_BLK_HDR_FLG)) == THIS_FREE_BLK_HDR_FLG), \
(B)->bhdr = ((Sz) | (F)), \
(B)->u.carrier = (C))
-
-# define ABLK_TO_MBC(B) \
- (ASSERT(IS_MBC_BLK(B) && IS_ALLOCED_BLK(B)), \
- (Carrier_t*)((MSEG_UNIT_FLOOR((UWord)(B)) - \
- (((B)->bhdr >> MBC_ABLK_OFFSET_SHIFT) << MSEG_UNIT_SHIFT))))
-
-# define FBLK_TO_MBC(B) \
- (ASSERT(IS_MBC_BLK(B) && IS_FREE_BLK(B)), \
- (B)->u.carrier)
-# define BLK_TO_MBC(B) (IS_FREE_BLK(B) ? FBLK_TO_MBC(B) : ABLK_TO_MBC(B))
-
# define IS_MBC_FIRST_ABLK(AP,B) \
((((UWord)(B) & ~MSEG_UNIT_MASK) == MBC_HEADER_SIZE(AP)) \
&& ((B)->bhdr & MBC_ABLK_OFFSET_MASK) == 0)
@@ -272,10 +247,6 @@ MBC after deallocating first block:
(B)->bhdr = ((Sz) | (F)), \
(B)->carrier = (C))
-# define BLK_TO_MBC(B) ((B)->carrier)
-# define ABLK_TO_MBC(B) BLK_TO_MBC(B)
-# define FBLK_TO_MBC(B) BLK_TO_MBC(B)
-
# define IS_MBC_FIRST_BLK(AP,B) \
((char*)(B) == (char*)((B)->carrier) + MBC_HEADER_SIZE(AP))
# define IS_MBC_FIRST_ABLK(AP,B) IS_MBC_FIRST_BLK(AP,B)
@@ -300,8 +271,6 @@ MBC after deallocating first block:
((B)->bhdr & PREV_FREE_BLK_HDR_FLG)
#define IS_PREV_BLK_ALLOCED(B) \
(!IS_PREV_BLK_FREE((B)))
-#define IS_FREE_BLK(B) \
- (ASSERT(!IS_SBC_BLK(B)), (B)->bhdr & THIS_FREE_BLK_HDR_FLG)
#define IS_ALLOCED_BLK(B) \
(!IS_FREE_BLK((B)))
#define IS_LAST_BLK(B) \
@@ -318,13 +287,6 @@ MBC after deallocating first block:
#define GET_BLK_HDR_FLGS(B) \
((B)->bhdr & FLG_MASK)
-#define IS_SBC_BLK(B) \
- (((B)->bhdr & FLG_MASK) == SBC_BLK_HDR_FLG)
-#define IS_MBC_BLK(B) \
- (!IS_SBC_BLK((B)))
-
-#define MBC_BLK_SZ(B) (IS_FREE_BLK(B) ? MBC_FBLK_SZ(B) : MBC_ABLK_SZ(B))
-
#define NXT_BLK(B) \
(ASSERT(IS_MBC_BLK(B)), \
(Block_t *) (((char *) (B)) + MBC_BLK_SZ((B))))
@@ -338,9 +300,96 @@ MBC after deallocating first block:
/* Carriers ... */
-#define SBC_HEADER_SIZE (UNIT_CEILING(sizeof(Carrier_t) + ABLK_HDR_SZ) \
- - ABLK_HDR_SZ)
-#define MBC_HEADER_SIZE(AP) SBC_HEADER_SIZE
+/* #define ERTS_ALC_CPOOL_DEBUG */
+
+#if defined(DEBUG) && !defined(ERTS_ALC_CPOOL_DEBUG)
+# define ERTS_ALC_CPOOL_DEBUG
+#endif
+
+#ifndef ERTS_SMP
+# undef ERTS_ALC_CPOOL_DEBUG
+#endif
+
+#ifdef ERTS_ALC_CPOOL_DEBUG
+# define ERTS_ALC_CPOOL_ASSERT(A) \
+ ((void) ((A) \
+ ? 1 \
+ : (erts_alcu_assert_failed(#A, \
+ (char *) __FILE__, \
+ __LINE__, \
+ (char *) __func__), \
+ 0)))
+#else
+# define ERTS_ALC_CPOOL_ASSERT(A) ((void) 1)
+#endif
+
+#ifdef ERTS_SMP
+#define ERTS_ALC_IS_CPOOL_ENABLED(A) ((A)->cpool.util_limit)
+#else
+#define ERTS_ALC_IS_CPOOL_ENABLED(A) (0)
+#endif
+
+#ifdef ERTS_SMP
+
+#define ERTS_ALC_CPOOL_MAX_DISABLE_ABANDON 1000
+#define ERTS_ALC_CPOOL_ALLOC_OP_INC 8
+#define ERTS_ALC_CPOOL_FREE_OP_DEC 10
+
+#define ERTS_ALC_CPOOL_ALLOC_OP(A) \
+do { \
+ if ((A)->cpool.disable_abandon < ERTS_ALC_CPOOL_MAX_DISABLE_ABANDON) { \
+ (A)->cpool.disable_abandon += ERTS_ALC_CPOOL_ALLOC_OP_INC; \
+ if ((A)->cpool.disable_abandon > ERTS_ALC_CPOOL_MAX_DISABLE_ABANDON) \
+ (A)->cpool.disable_abandon = ERTS_ALC_CPOOL_MAX_DISABLE_ABANDON; \
+ } \
+} while (0)
+
+
+#if ERTS_ALC_CPOOL_ALLOC_OP_INC >= ERTS_ALC_CPOOL_FREE_OP_DEC
+# error "Implementation assume ERTS_ALC_CPOOL_ALLOC_OP_INC < ERTS_ALC_CPOOL_FREE_OP_DEC"
+#endif
+
+#define ERTS_ALC_CPOOL_REALLOC_OP(A) \
+do { \
+ if ((A)->cpool.disable_abandon) { \
+ (A)->cpool.disable_abandon -= (ERTS_ALC_CPOOL_FREE_OP_DEC \
+ - ERTS_ALC_CPOOL_ALLOC_OP_INC); \
+ if ((A)->cpool.disable_abandon < 0) \
+ (A)->cpool.disable_abandon = 0; \
+ } \
+} while (0)
+
+#define ERTS_ALC_CPOOL_FREE_OP(A) \
+do { \
+ if ((A)->cpool.disable_abandon) { \
+ (A)->cpool.disable_abandon -= ERTS_ALC_CPOOL_FREE_OP_DEC; \
+ if ((A)->cpool.disable_abandon < 0) \
+ (A)->cpool.disable_abandon = 0; \
+ } \
+} while (0)
+
+#else
+#define ERTS_ALC_CPOOL_ALLOC_OP(A)
+#define ERTS_ALC_CPOOL_REALLOC_OP(A)
+#define ERTS_ALC_CPOOL_FREE_OP(A)
+#endif
+
+#define ERTS_CRR_ALCTR_FLG_IN_POOL (((erts_aint_t) 1) << 0)
+#define ERTS_CRR_ALCTR_FLG_BUSY (((erts_aint_t) 1) << 1)
+
+#ifdef ERTS_SMP
+#define SBC_HEADER_SIZE \
+ (UNIT_CEILING(sizeof(Carrier_t) \
+ - sizeof(ErtsAlcCPoolData_t) \
+ + ABLK_HDR_SZ) \
+ - ABLK_HDR_SZ)
+#else
+#define SBC_HEADER_SIZE \
+ (UNIT_CEILING(sizeof(Carrier_t) \
+ + ABLK_HDR_SZ) \
+ - ABLK_HDR_SZ)
+#endif
+#define MBC_HEADER_SIZE(AP) ((AP)->mbc_header_size)
#define MSEG_CARRIER_HDR_FLAG (((UWord) 1) << 0)
@@ -352,7 +401,8 @@ MBC after deallocating first block:
#define SCH_SBC SBC_CARRIER_HDR_FLAG
#define SET_CARRIER_HDR(C, Sz, F, AP) \
- (ASSERT(((Sz) & FLG_MASK) == 0), (C)->chdr = ((Sz) | (F)), (C)->allctr = (AP))
+ (ASSERT(((Sz) & FLG_MASK) == 0), (C)->chdr = ((Sz) | (F)), \
+ erts_smp_atomic_init_nob(&(C)->allctr, (erts_aint_t) (AP)))
#define BLK_TO_SBC(B) \
((Carrier_t *) (((char *) (B)) - SBC_HEADER_SIZE))
@@ -385,6 +435,7 @@ MBC after deallocating first block:
#define CFLG_FORCE_SYS_ALLOC (1 << 3)
#define CFLG_FORCE_SIZE (1 << 4)
#define CFLG_MAIN_CARRIER (1 << 5)
+#define CFLG_NO_CPOOL (1 << 6)
#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG
static void check_blk_carrier(Allctr_t *, Block_t *);
@@ -412,11 +463,7 @@ static void check_blk_carrier(Allctr_t *, Block_t *);
ASSERT(((AP)->mbcs.curr.norm.sys_alloc.no \
&& (AP)->mbcs.curr.norm.sys_alloc.size) \
|| (!(AP)->mbcs.curr.norm.sys_alloc.no \
- && !(AP)->mbcs.curr.norm.sys_alloc.size)); \
- ASSERT(((AP)->sbmbcs.curr.small_block.no \
- && (AP)->sbmbcs.curr.small_block.size) \
- || (!(AP)->sbmbcs.curr.small_block.no \
- && !(AP)->sbmbcs.curr.small_block.size))
+ && !(AP)->mbcs.curr.norm.sys_alloc.size));
#else
#define DEBUG_CHECK_CARRIER_NO_SZ(AP)
@@ -487,17 +534,6 @@ do { \
+ (AP)->mbcs.curr.norm.sys_alloc.size)
-#define STAT_SBMBC_ALLOC(AP, CSZ) \
-do { \
- (AP)->sbmbcs.curr.small_block.no++; \
- (AP)->sbmbcs.curr.small_block.size += (CSZ); \
- if ((AP)->sbmbcs.max.no < (AP)->sbmbcs.curr.small_block.no) \
- (AP)->sbmbcs.max.no = (AP)->sbmbcs.curr.small_block.no; \
- if ((AP)->sbmbcs.max.size < (AP)->sbmbcs.curr.small_block.size) \
- (AP)->sbmbcs.max.size = (AP)->sbmbcs.curr.small_block.size; \
- DEBUG_CHECK_CARRIER_NO_SZ((AP)); \
-} while (0)
-
#define STAT_MSEG_MBC_ALLOC(AP, CSZ) \
do { \
(AP)->mbcs.curr.norm.mseg.no++; \
@@ -514,13 +550,19 @@ do { \
DEBUG_CHECK_CARRIER_NO_SZ((AP)); \
} while (0)
-#define STAT_SBMBC_FREE(AP, CSZ) \
+#define STAT_MBC_CPOOL_FETCH(AP, CRR) \
do { \
- ASSERT((AP)->sbmbcs.curr.small_block.no > 0); \
- (AP)->sbmbcs.curr.small_block.no--; \
- ASSERT((AP)->sbmbcs.curr.small_block.size >= (CSZ)); \
- (AP)->sbmbcs.curr.small_block.size -= (CSZ); \
- DEBUG_CHECK_CARRIER_NO_SZ((AP)); \
+ UWord csz__ = CARRIER_SZ((CRR)); \
+ if (IS_MSEG_CARRIER((CRR))) \
+ STAT_MSEG_MBC_ALLOC((AP), csz__); \
+ else \
+ STAT_SYS_ALLOC_MBC_ALLOC((AP), csz__); \
+ (AP)->mbcs.blocks.curr.no += (CRR)->cpool.blocks; \
+ if ((AP)->mbcs.blocks.max.no < (AP)->mbcs.blocks.curr.no) \
+ (AP)->mbcs.blocks.max.no = (AP)->mbcs.blocks.curr.no; \
+ (AP)->mbcs.blocks.curr.size += (CRR)->cpool.blocks_size; \
+ if ((AP)->mbcs.blocks.max.size < (AP)->mbcs.blocks.curr.size) \
+ (AP)->mbcs.blocks.max.size = (AP)->mbcs.blocks.curr.size; \
} while (0)
#define STAT_MSEG_MBC_FREE(AP, CSZ) \
@@ -541,28 +583,88 @@ do { \
DEBUG_CHECK_CARRIER_NO_SZ((AP)); \
} while (0)
-#define STAT_MBC_BLK_ALLOC(AP, BSZ, FLGS) \
+#define STAT_MBC_CPOOL_INSERT(AP, CRR) \
+do { \
+ UWord csz__ = CARRIER_SZ((CRR)); \
+ if (IS_MSEG_CARRIER((CRR))) \
+ STAT_MSEG_MBC_FREE((AP), csz__); \
+ else \
+ STAT_SYS_ALLOC_MBC_FREE((AP), csz__); \
+ ERTS_ALC_CPOOL_ASSERT((AP)->mbcs.blocks.curr.no \
+ >= (CRR)->cpool.blocks); \
+ (AP)->mbcs.blocks.curr.no -= (CRR)->cpool.blocks; \
+ ERTS_ALC_CPOOL_ASSERT((AP)->mbcs.blocks.curr.size \
+ >= (CRR)->cpool.blocks_size); \
+ (AP)->mbcs.blocks.curr.size -= (CRR)->cpool.blocks_size; \
+} while (0)
+
+#ifdef ERTS_SMP
+#define STAT_MBC_BLK_ALLOC_CRR(CRR, BSZ) \
+do { \
+ (CRR)->cpool.blocks++; \
+ (CRR)->cpool.blocks_size += (BSZ); \
+} while (0)
+#else
+#define STAT_MBC_BLK_ALLOC_CRR(CRR, BSZ) ((void) (CRR)) /* Get rid of warning */
+#endif
+
+#define STAT_MBC_BLK_ALLOC(AP, CRR, BSZ, FLGS) \
do { \
- CarriersStats_t *cstats__ = (((FLGS) & ERTS_ALCU_FLG_SBMBC) \
- ? &(AP)->sbmbcs \
- : &(AP)->mbcs); \
+ CarriersStats_t *cstats__ = &(AP)->mbcs; \
cstats__->blocks.curr.no++; \
if (cstats__->blocks.max.no < cstats__->blocks.curr.no) \
cstats__->blocks.max.no = cstats__->blocks.curr.no; \
cstats__->blocks.curr.size += (BSZ); \
if (cstats__->blocks.max.size < cstats__->blocks.curr.size) \
cstats__->blocks.max.size = cstats__->blocks.curr.size; \
+ STAT_MBC_BLK_ALLOC_CRR((CRR), (BSZ)); \
} while (0)
-#define STAT_MBC_BLK_FREE(AP, BSZ, FLGS) \
+static ERTS_INLINE int
+stat_cpool_mbc_blk_free(Allctr_t *allctr,
+ Carrier_t *crr,
+ Carrier_t **busy_pcrr_pp,
+ UWord blksz)
+{
+#ifdef ERTS_SMP
+
+ ERTS_ALC_CPOOL_ASSERT(crr->cpool.blocks > 0);
+ crr->cpool.blocks--;
+ ERTS_ALC_CPOOL_ASSERT(crr->cpool.blocks_size >= blksz);
+ crr->cpool.blocks_size -= blksz;
+
+ if (!busy_pcrr_pp || !*busy_pcrr_pp)
+ return 0;
+
+ ERTS_ALC_CPOOL_ASSERT(crr == *busy_pcrr_pp);
+
+#ifdef ERTS_ALC_CPOOL_DEBUG
+ ERTS_ALC_CPOOL_ASSERT(
+ erts_atomic_dec_read_nob(&allctr->cpool.stat.no_blocks) >= 0);
+ ERTS_ALC_CPOOL_ASSERT(
+ erts_atomic_add_read_nob(&allctr->cpool.stat.blocks_size,
+ -((erts_aint_t) blksz)) >= 0);
+#else
+ erts_atomic_dec_nob(&allctr->cpool.stat.no_blocks);
+ erts_atomic_add_nob(&allctr->cpool.stat.blocks_size,
+ -((erts_aint_t) blksz));
+#endif
+
+ return 1;
+#else
+ return 0;
+#endif
+}
+
+#define STAT_MBC_BLK_FREE(AP, CRR, BPCRRPP, BSZ, FLGS) \
do { \
- CarriersStats_t *cstats__ = (((FLGS) & ERTS_ALCU_FLG_SBMBC) \
- ? &(AP)->sbmbcs \
- : &(AP)->mbcs); \
- ASSERT(cstats__->blocks.curr.no > 0); \
- cstats__->blocks.curr.no--; \
- ASSERT(cstats__->blocks.curr.size >= (BSZ)); \
- cstats__->blocks.curr.size -= (BSZ); \
+ if (!stat_cpool_mbc_blk_free((AP), (CRR), (BPCRRPP), (BSZ))) { \
+ CarriersStats_t *cstats__ = &(AP)->mbcs; \
+ ASSERT(cstats__->blocks.curr.no > 0); \
+ cstats__->blocks.curr.no--; \
+ ASSERT(cstats__->blocks.curr.size >= (BSZ)); \
+ cstats__->blocks.curr.size -= (BSZ); \
+ } \
} while (0)
/* Debug stuff... */
@@ -613,13 +715,42 @@ do { \
#define ERTS_ALCU_DBG_CHK_THR_ACCESS(A)
#endif
-
static void make_name_atoms(Allctr_t *allctr);
static Block_t *create_carrier(Allctr_t *, Uint, UWord);
-static void destroy_carrier(Allctr_t *, Block_t *);
-static void mbc_free(Allctr_t *allctr, void *p);
+static void destroy_carrier(Allctr_t *, Block_t *, Carrier_t **);
+static void mbc_free(Allctr_t *allctr, void *p, Carrier_t **busy_pcrr_pp);
+static void dealloc_block(Allctr_t *, void *, int);
+
+/* internal data... */
+
+#if 0
+
+static ERTS_INLINE void *
+internal_alloc(UWord size)
+{
+ void *res = erts_sys_alloc(0, NULL, size);
+ if (!res)
+ erts_alloc_enomem(ERTS_ALC_T_UNDEF, size);
+ return res;
+}
+static ERTS_INLINE void *
+internal_realloc(void *ptr, UWord size)
+{
+ void *res = erts_sys_realloc(0, NULL, ptr, size);
+ if (!res)
+ erts_alloc_enomem(ERTS_ALC_T_UNDEF, size);
+ return res;
+}
+
+static ERTS_INLINE void
+internal_free(void *ptr)
+{
+ erts_sys_free(0, NULL, ptr);
+}
+
+#endif
/* mseg ... */
@@ -781,10 +912,35 @@ unlink_carrier(CarrierList_t *cl, Carrier_t *crr)
}
}
-static Block_t *create_sbmbc(Allctr_t *allctr, Uint umem_sz);
-static void destroy_sbmbc(Allctr_t *allctr, Block_t *blk);
-static Block_t *create_carrier(Allctr_t *, Uint, UWord);
-static void destroy_carrier(Allctr_t *, Block_t *);
+#ifdef ERTS_SMP
+
+static ERTS_INLINE void
+clear_busy_pool_carrier(Allctr_t *allctr, Carrier_t *crr)
+{
+ if (crr) {
+ erts_aint_t max_size;
+ erts_aint_t new_val;
+
+ max_size = (erts_aint_t) allctr->largest_fblk_in_mbc(allctr, crr);
+ erts_atomic_set_nob(&crr->cpool.max_size, max_size);
+
+ new_val = (((erts_aint_t) allctr)|ERTS_CRR_ALCTR_FLG_IN_POOL);
+
+#ifdef ERTS_ALC_CPOOL_DEBUG
+ {
+ erts_aint_t old_val = new_val|ERTS_CRR_ALCTR_FLG_BUSY;
+
+ ERTS_ALC_CPOOL_ASSERT(old_val
+ == erts_smp_atomic_xchg_relb(&crr->allctr,
+ new_val));
+ }
+#else
+ erts_smp_atomic_set_relb(&crr->allctr, new_val);
+#endif
+ }
+}
+
+#endif
#if 0
#define ERTS_DBG_CHK_FIX_LIST(A, FIX, IX, B) \
@@ -806,13 +962,154 @@ chk_fix_list(Allctr_t *allctr, ErtsAlcFixList_t *fix, int ix, int before)
#define ERTS_DBG_CHK_FIX_LIST(A, FIX, IX, B)
#endif
-erts_aint32_t
-erts_alcu_fix_alloc_shrink(Allctr_t *allctr, erts_aint32_t flgs)
+static void *mbc_alloc(Allctr_t *allctr, Uint size);
+
+#ifdef ERTS_SMP
+typedef struct {
+ ErtsAllctrDDBlock_t ddblock__; /* must be first */
+ ErtsAlcType_t fix_type;
+} ErtsAllctrFixDDBlock_t;
+#endif
+
+static ERTS_INLINE void
+dealloc_fix_block(Allctr_t *allctr,
+ ErtsAlcType_t type,
+ void *ptr,
+ int dec_cc_on_redirect)
+{
+#ifdef ERTS_SMP
+ /* May be redirected... */
+ ((ErtsAllctrFixDDBlock_t *) ptr)->fix_type = type;
+#endif
+ dealloc_block(allctr, ptr, dec_cc_on_redirect);
+}
+
+static ERTS_INLINE void
+sched_fix_shrink(Allctr_t *allctr, int on)
+{
+ if (on && !allctr->fix_shrink_scheduled) {
+ allctr->fix_shrink_scheduled = 1;
+ erts_set_aux_work_timeout(allctr->ix,
+ (ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM
+ | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC),
+ 1);
+ }
+ else if (!on && allctr->fix_shrink_scheduled) {
+ allctr->fix_shrink_scheduled = 0;
+ erts_set_aux_work_timeout(allctr->ix,
+ (ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM
+ | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC),
+ 0);
+ }
+}
+
+static ERTS_INLINE void
+fix_cpool_check_shrink(Allctr_t *allctr,
+ ErtsAlcType_t type,
+ ErtsAlcFixList_t *fix,
+ Carrier_t **busy_pcrr_pp)
+{
+ if (fix->u.cpool.shrink_list > 0) {
+ if (fix->list_size == 0)
+ fix->u.cpool.shrink_list = 0;
+ else {
+ void *p;
+#ifdef ERTS_SMP
+ if (busy_pcrr_pp) {
+ clear_busy_pool_carrier(allctr, *busy_pcrr_pp);
+ *busy_pcrr_pp = NULL;
+ }
+#endif
+ fix->u.cpool.shrink_list--;
+ p = fix->list;
+ fix->list = *((void **) p);
+ fix->list_size--;
+ if (fix->u.cpool.min_list_size > fix->list_size)
+ fix->u.cpool.min_list_size = fix->list_size;
+
+ fix->u.cpool.allocated--;
+ dealloc_fix_block(allctr, type, p, 0);
+ }
+ }
+}
+
+static ERTS_INLINE void *
+fix_cpool_alloc(Allctr_t *allctr, ErtsAlcType_t type, Uint size)
+{
+ void *res;
+ ErtsAlcFixList_t *fix;
+
+ ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE <= type
+ && type <= ERTS_ALC_N_MAX_A_FIXED_SIZE);
+
+ fix = &allctr->fix[type - ERTS_ALC_N_MIN_A_FIXED_SIZE];
+
+ res = fix->list;
+ if (res) {
+ fix->list = *((void **) res);
+ fix->list_size--;
+ if (fix->u.cpool.min_list_size > fix->list_size)
+ fix->u.cpool.min_list_size = fix->list_size;
+ fix->u.cpool.used++;
+ fix_cpool_check_shrink(allctr, type, fix, NULL);
+ return res;
+ }
+ if (size < 2*sizeof(UWord))
+ size += sizeof(UWord);
+ if (size >= allctr->sbc_threshold) {
+ Block_t *blk;
+ blk = create_carrier(allctr, size, CFLG_SBC);
+ res = blk ? BLK2UMEM(blk) : NULL;
+ }
+ else
+ res = mbc_alloc(allctr, size);
+ if (res) {
+ fix->u.cpool.used++;
+ fix->u.cpool.allocated++;
+ }
+ return res;
+}
+
+static ERTS_INLINE void
+fix_cpool_free(Allctr_t *allctr,
+ ErtsAlcType_t type,
+ void *p,
+ Carrier_t **busy_pcrr_pp)
+{
+ ErtsAlcFixList_t *fix;
+
+ ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE <= type
+ && type <= ERTS_ALC_N_MAX_A_FIXED_SIZE);
+
+ fix = &allctr->fix[type - ERTS_ALC_N_MIN_A_FIXED_SIZE];
+
+ fix->u.cpool.used--;
+
+ if ((!busy_pcrr_pp || !*busy_pcrr_pp)
+ && !fix->u.cpool.shrink_list
+ && fix->list_size < ERTS_ALCU_FIX_MAX_LIST_SZ) {
+ *((void **) p) = fix->list;
+ fix->list = p;
+ fix->list_size++;
+ sched_fix_shrink(allctr, 1);
+ }
+ else {
+ Block_t *blk = UMEM2BLK(p);
+ if (IS_SBC_BLK(blk))
+ destroy_carrier(allctr, blk, NULL);
+ else
+ mbc_free(allctr, p, busy_pcrr_pp);
+ fix->u.cpool.allocated--;
+ fix_cpool_check_shrink(allctr, type, fix, busy_pcrr_pp);
+ }
+}
+
+static ERTS_INLINE erts_aint32_t
+fix_cpool_alloc_shrink(Allctr_t *allctr, erts_aint32_t flgs)
{
int all_empty = 1;
erts_aint32_t res = 0;
int ix, o;
- ErtsAlcFixList_t *fix = allctr->fix;
int flush = flgs == 0;
#ifdef USE_THREADS
@@ -821,56 +1118,204 @@ erts_alcu_fix_alloc_shrink(Allctr_t *allctr, erts_aint32_t flgs)
#endif
for (ix = 0; ix < ERTS_ALC_NO_FIXED_SIZES; ix++) {
+ ErtsAlcFixList_t *fix = &allctr->fix[ix];
+ ErtsAlcType_t type;
ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 1);
- if (flgs & ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM) {
- fix[ix].limit = fix[ix].max_used;
- if (fix[ix].limit < fix[ix].used)
- fix[ix].limit = fix[ix].used;
- fix[ix].max_used = fix[ix].used;
- ASSERT(fix[ix].limit >= 0);
-
- }
- if (flush) {
- fix[ix].limit = 0;
- fix[ix].max_used = fix[ix].used;
- ASSERT(fix[ix].limit >= 0);
+ if (flush)
+ fix->u.cpool.shrink_list = fix->list_size;
+ else if (flgs & ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM) {
+ fix->u.cpool.shrink_list = fix->u.cpool.min_list_size;
+ fix->u.cpool.min_list_size = fix->list_size;
}
+ type = (ErtsAlcType_t) (ix + ERTS_ALC_N_MIN_A_FIXED_SIZE);
for (o = 0; o < ERTS_ALC_FIX_MAX_SHRINK_OPS || flush; o++) {
- Block_t *blk;
void *ptr;
- if (!flush && fix[ix].limit >= fix[ix].allocated)
+ if (fix->u.cpool.shrink_list == 0)
break;
- if (fix[ix].list_size == 0)
+ if (fix->list_size == 0) {
+ fix->u.cpool.shrink_list = 0;
break;
- ptr = fix[ix].list;
- fix[ix].list = *((void **) ptr);
- fix[ix].list_size--;
+ }
+ ptr = fix->list;
+ fix->list = *((void **) ptr);
+ fix->list_size--;
+ fix->u.cpool.shrink_list--;
+ fix->u.cpool.allocated--;
+ dealloc_fix_block(allctr, type, ptr, 0);
+ }
+ if (fix->u.cpool.min_list_size > fix->list_size)
+ fix->u.cpool.min_list_size = fix->list_size;
+ if (fix->list_size != 0) {
+ if (fix->u.cpool.shrink_list > 0)
+ res |= ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC;
+ all_empty = 0;
+ }
+ }
+
+ if (all_empty)
+ sched_fix_shrink(allctr, 0);
+
+#ifdef USE_THREADS
+ if (allctr->thread_safe)
+ erts_mtx_unlock(&allctr->mutex);
+#endif
- blk = UMEM2BLK(ptr);
+ return res;
+}
+static ERTS_INLINE void *
+fix_nocpool_alloc(Allctr_t *allctr, ErtsAlcType_t type, Uint size)
+{
+ ErtsAlcFixList_t *fix;
+ void *res;
+
+ ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE <= type
+ && type <= ERTS_ALC_N_MAX_A_FIXED_SIZE);
+
+ fix = &allctr->fix[type - ERTS_ALC_N_MIN_A_FIXED_SIZE];
+
+ ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 1);
+ fix->u.nocpool.used++;
+ res = fix->list;
+ if (res) {
+ fix->list_size--;
+ fix->list = *((void **) res);
+ if (fix->list && fix->u.nocpool.allocated > fix->u.nocpool.limit) {
+ Block_t *blk;
+ void *p = fix->list;
+ fix->list = *((void **) p);
+ fix->list_size--;
+ blk = UMEM2BLK(p);
if (IS_SBC_BLK(blk))
- destroy_carrier(allctr, blk);
+ destroy_carrier(allctr, blk, NULL);
else
- mbc_free(allctr, ptr);
+ mbc_free(allctr, p, NULL);
+ fix->u.nocpool.allocated--;
+ }
+ ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0);
+ return res;
+ }
+ if (size < 2*sizeof(UWord))
+ size += sizeof(UWord);
+ if (fix->u.nocpool.limit < fix->u.nocpool.used)
+ fix->u.nocpool.limit = fix->u.nocpool.used;
+ if (fix->u.nocpool.max_used < fix->u.nocpool.used)
+ fix->u.nocpool.max_used = fix->u.nocpool.used;
+ fix->u.nocpool.allocated++;
- fix[ix].allocated--;
+ if (size >= allctr->sbc_threshold) {
+ Block_t *blk;
+ blk = create_carrier(allctr, size, CFLG_SBC);
+ res = blk ? BLK2UMEM(blk) : NULL;
+ }
+ else
+ res = mbc_alloc(allctr, size);
+
+ if (!res) {
+ fix->u.nocpool.allocated--;
+ fix->u.nocpool.used--;
+ }
+ return res;
+}
+
+static ERTS_INLINE void
+fix_nocpool_free(Allctr_t *allctr,
+ ErtsAlcType_t type,
+ void *p)
+{
+ Block_t *blk;
+ ErtsAlcFixList_t *fix;
+
+ ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE <= type
+ && type <= ERTS_ALC_N_MAX_A_FIXED_SIZE);
+
+ fix = &allctr->fix[type - ERTS_ALC_N_MIN_A_FIXED_SIZE];
+
+ ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 1);
+ fix->u.nocpool.used--;
+ if (fix->u.nocpool.allocated < fix->u.nocpool.limit
+ && fix->list_size < ERTS_ALCU_FIX_MAX_LIST_SZ) {
+ *((void **) p) = fix->list;
+ fix->list = p;
+ fix->list_size++;
+ sched_fix_shrink(allctr, 1);
+ ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0);
+ return;
+ }
+ fix->u.nocpool.allocated--;
+ if (fix->list && fix->u.nocpool.allocated > fix->u.nocpool.limit) {
+ blk = UMEM2BLK(p);
+ if (IS_SBC_BLK(blk))
+ destroy_carrier(allctr, blk, NULL);
+ else
+ mbc_free(allctr, p, NULL);
+ p = fix->list;
+ fix->list = *((void **) p);
+ fix->list_size--;
+ fix->u.nocpool.allocated--;
+ }
+
+ blk = UMEM2BLK(p);
+ if (IS_SBC_BLK(blk))
+ destroy_carrier(allctr, blk, NULL);
+ else
+ mbc_free(allctr, p, NULL);
+ ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0);
+}
+
+static ERTS_INLINE erts_aint32_t
+fix_nocpool_alloc_shrink(Allctr_t *allctr, erts_aint32_t flgs)
+{
+ int all_empty = 1;
+ erts_aint32_t res = 0;
+ int ix, o;
+ int flush = flgs == 0;
+
+#ifdef USE_THREADS
+ if (allctr->thread_safe)
+ erts_mtx_lock(&allctr->mutex);
+#endif
+
+ for (ix = 0; ix < ERTS_ALC_NO_FIXED_SIZES; ix++) {
+ ErtsAlcFixList_t *fix = &allctr->fix[ix];
+ ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 1);
+ if (flgs & ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM) {
+ fix->u.nocpool.limit = fix->u.nocpool.max_used;
+ if (fix->u.nocpool.limit < fix->u.nocpool.used)
+ fix->u.nocpool.limit = fix->u.nocpool.used;
+ fix->u.nocpool.max_used = fix->u.nocpool.used;
+ ASSERT(fix->u.nocpool.limit >= 0);
+
+ }
+ if (flush) {
+ fix->u.nocpool.limit = 0;
+ fix->u.nocpool.max_used = fix->u.nocpool.used;
+ ASSERT(fix->u.nocpool.limit >= 0);
}
- if (fix[ix].list_size != 0) {
- if (fix[ix].limit < fix[ix].allocated)
+ for (o = 0; o < ERTS_ALC_FIX_MAX_SHRINK_OPS || flush; o++) {
+ void *ptr;
+
+ if (!flush && fix->u.nocpool.limit >= fix->u.nocpool.allocated)
+ break;
+ if (fix->list_size == 0)
+ break;
+ ptr = fix->list;
+ fix->list = *((void **) ptr);
+ fix->list_size--;
+ dealloc_block(allctr, ptr, 0);
+ fix->u.nocpool.allocated--;
+ }
+ if (fix->list_size != 0) {
+ if (fix->u.nocpool.limit < fix->u.nocpool.allocated)
res |= ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC;
all_empty = 0;
}
ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0);
}
- if (all_empty && allctr->fix_shrink_scheduled) {
- allctr->fix_shrink_scheduled = 0;
- erts_set_aux_work_timeout(allctr->ix,
- (ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM
- | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC),
- 0);
- }
+ if (all_empty)
+ sched_fix_shrink(allctr, 0);
#ifdef USE_THREADS
if (allctr->thread_safe)
@@ -880,13 +1325,18 @@ erts_alcu_fix_alloc_shrink(Allctr_t *allctr, erts_aint32_t flgs)
return res;
}
-#ifdef ERTS_SMP
+erts_aint32_t
+erts_alcu_fix_alloc_shrink(Allctr_t *allctr, erts_aint32_t flgs)
+{
+ if (ERTS_ALC_IS_CPOOL_ENABLED(allctr))
+ return fix_cpool_alloc_shrink(allctr, flgs);
+ else
+ return fix_nocpool_alloc_shrink(allctr, flgs);
+}
-typedef struct {
- ErtsAllctrDDBlock_t ddblock__; /* must be first */
- ErtsAlcType_t fix_type;
-}ErtsAllctrFixDDBlock_t;
+static void dealloc_carrier(Allctr_t *allctr, Carrier_t *crr, Uint mseg_flags);
+#ifdef ERTS_SMP
static ERTS_INLINE Allctr_t*
get_pref_allctr(void *extra)
@@ -902,6 +1352,9 @@ get_pref_allctr(void *extra)
return tspec->allctr[pref_ix];
}
+#define ERTS_ALC_TS_PREF_LOCK_IF_USED (1)
+#define ERTS_ALC_TS_PREF_LOCK_NO (0)
+
/* SMP note:
* get_used_allctr() must be safe WITHOUT locking the allocator while
* concurrent threads may be updating adjacent blocks.
@@ -910,22 +1363,85 @@ get_pref_allctr(void *extra)
* the "PREV_FREE" flag bit.
*/
static ERTS_INLINE Allctr_t*
-get_used_allctr(void *extra, void *p, UWord *sizep)
+get_used_allctr(Allctr_t *pref_allctr, int pref_lock, void *p, UWord *sizep,
+ Carrier_t **busy_pcrr_pp)
{
Block_t* blk = UMEM2BLK(p);
- Carrier_t* crr;
+ Carrier_t *crr;
+ erts_aint_t iallctr;
+ Allctr_t *used_allctr;
+
+ *busy_pcrr_pp = NULL;
if (IS_SBC_BLK(blk)) {
crr = BLK_TO_SBC(blk);
if (sizep)
*sizep = SBC_BLK_SZ(blk) - ABLK_HDR_SZ;
+ iallctr = erts_smp_atomic_read_dirty(&crr->allctr);
}
else {
crr = ABLK_TO_MBC(blk);
+
if (sizep)
*sizep = MBC_ABLK_SZ(blk) - ABLK_HDR_SZ;
+ if (!ERTS_ALC_IS_CPOOL_ENABLED(pref_allctr))
+ iallctr = erts_smp_atomic_read_dirty(&crr->allctr);
+ else {
+ int locked_pref_allctr = 0;
+ iallctr = erts_smp_atomic_read_ddrb(&crr->allctr);
+
+ if (ERTS_ALC_TS_PREF_LOCK_IF_USED == pref_lock
+ && pref_allctr->thread_safe) {
+ used_allctr = (Allctr_t *) (iallctr & ~FLG_MASK);
+ if (pref_allctr == used_allctr) {
+ erts_mtx_lock(&pref_allctr->mutex);
+ locked_pref_allctr = 1;
+ }
+ }
+
+ while ((iallctr & ((~FLG_MASK)|ERTS_CRR_ALCTR_FLG_IN_POOL))
+ == (((erts_aint_t) pref_allctr)|ERTS_CRR_ALCTR_FLG_IN_POOL)) {
+ erts_aint_t act;
+
+ ERTS_ALC_CPOOL_ASSERT(!(iallctr & ERTS_CRR_ALCTR_FLG_BUSY));
+ act = erts_smp_atomic_cmpxchg_ddrb(&crr->allctr,
+ iallctr|ERTS_CRR_ALCTR_FLG_BUSY,
+ iallctr);
+ if (act == iallctr) {
+ *busy_pcrr_pp = crr;
+ break;
+ }
+ iallctr = act;
+ }
+
+ used_allctr = (Allctr_t *) (iallctr & ~FLG_MASK);
+
+ if (ERTS_ALC_TS_PREF_LOCK_IF_USED == pref_lock) {
+ if (locked_pref_allctr && used_allctr != pref_allctr) {
+ /* Was taken out of pool; now owned by someone else */
+ erts_mtx_unlock(&pref_allctr->mutex);
+ }
+ }
+
+ ERTS_ALC_CPOOL_ASSERT(
+ (((iallctr & ~FLG_MASK) == (erts_aint_t) pref_allctr)
+ ? (((iallctr & FLG_MASK) == ERTS_CRR_ALCTR_FLG_IN_POOL)
+ || ((iallctr & FLG_MASK) == 0))
+ : 1));
+
+ return used_allctr;
+ }
+ }
+
+ used_allctr = (Allctr_t *) (iallctr & ~FLG_MASK);
+
+ if (ERTS_ALC_TS_PREF_LOCK_IF_USED == pref_lock
+ && used_allctr == pref_allctr
+ && pref_allctr->thread_safe) {
+ erts_mtx_lock(&pref_allctr->mutex);
}
- return crr->allctr;
+
+ return used_allctr;
}
static void
@@ -1020,7 +1536,7 @@ check_insert_marker(ErtsAllctrDDQueue_t *ddq, erts_aint_t ilast)
}
static ERTS_INLINE int
-ddq_enqueue(ErtsAlcType_t type, ErtsAllctrDDQueue_t *ddq, void *ptr, int cinit)
+ddq_enqueue(ErtsAllctrDDQueue_t *ddq, void *ptr, int cinit)
{
int last_elem;
int um_refc_ix = 0;
@@ -1121,6 +1637,59 @@ store_earliest_thr_prgr(ErtsThrPrgrVal *prev_val, ErtsAllctrDDQueue_t *ddq)
}
}
+static void
+check_pending_dealloc_carrier(Allctr_t *allctr,
+ int *need_thr_progress,
+ ErtsThrPrgrVal *thr_prgr_p,
+ int *need_more_work);
+
+static void
+handle_delayed_fix_dealloc(Allctr_t *allctr, void *ptr)
+{
+ ErtsAlcType_t type;
+
+ type = ((ErtsAllctrFixDDBlock_t *) ptr)->fix_type;
+
+ ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE <= type
+ && type <= ERTS_ALC_N_MAX_A_FIXED_SIZE);
+
+ if (!ERTS_ALC_IS_CPOOL_ENABLED(allctr))
+ fix_nocpool_free(allctr, type, ptr);
+ else {
+ Block_t *blk = UMEM2BLK(ptr);
+ Carrier_t *busy_pcrr_p;
+ Allctr_t *used_allctr;
+
+ if (IS_SBC_BLK(blk)) {
+ busy_pcrr_p = NULL;
+ goto doit;
+ }
+
+ used_allctr = get_used_allctr(allctr, ERTS_ALC_TS_PREF_LOCK_NO, ptr,
+ NULL, &busy_pcrr_p);
+ if (used_allctr == allctr) {
+ doit:
+ fix_cpool_free(allctr, type, ptr, &busy_pcrr_p);
+ clear_busy_pool_carrier(allctr, busy_pcrr_p);
+ }
+ else {
+ /* Carrier migrated; need to redirect block to new owner... */
+ int cinit = used_allctr->dd.ix - allctr->dd.ix;
+
+ ERTS_ALC_CPOOL_ASSERT(!busy_pcrr_p);
+
+ DEC_CC(allctr->calls.this_free);
+
+ ((ErtsAllctrFixDDBlock_t *) ptr)->fix_type = type;
+ if (ddq_enqueue(&used_allctr->dd.q, ptr, cinit))
+ erts_alloc_notify_delayed_dealloc(used_allctr->ix);
+ }
+ }
+}
+
+static void
+schedule_dealloc_carrier(Allctr_t *allctr, Carrier_t *crr);
+
static ERTS_INLINE int
handle_delayed_dealloc(Allctr_t *allctr,
int allctr_locked,
@@ -1152,7 +1721,6 @@ handle_delayed_dealloc(Allctr_t *allctr,
while (1) {
Block_t *blk;
void *ptr;
- int ix;
if (use_limit && ++ops > ops_limit) {
if (ddq->head.first != ddq->head.unref_end) {
@@ -1181,52 +1749,29 @@ handle_delayed_dealloc(Allctr_t *allctr,
res = 1;
- INC_CC(allctr->calls.this_free);
-
- if (fix) {
- ErtsAlcType_t type;
-
- type = ((ErtsAllctrFixDDBlock_t*) ptr)->fix_type;
- ix = type - ERTS_ALC_N_MIN_A_FIXED_SIZE;
- ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 1);
- fix[ix].used--;
- if (fix[ix].allocated < fix[ix].limit
- && fix[ix].list_size < ERTS_ALCU_FIX_MAX_LIST_SZ) {
- *((void **) ptr) = fix[ix].list;
- fix[ix].list = ptr;
- fix[ix].list_size++;
- if (!allctr->fix_shrink_scheduled) {
- allctr->fix_shrink_scheduled = 1;
- erts_set_aux_work_timeout(
- allctr->ix,
- (ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM
- | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC),
- 1);
- }
- ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0);
- continue;
- }
- fix[ix].allocated--;
- if (fix[ix].list && fix[ix].allocated > fix[ix].limit) {
- blk = UMEM2BLK(ptr);
- if (IS_SBC_BLK(blk))
- destroy_carrier(allctr, blk);
- else
- mbc_free(allctr, ptr);
- ptr = fix[ix].list;
- fix[ix].list = *((void **) ptr);
- fix[ix].list_size--;
- fix[ix].allocated--;
- }
+ blk = UMEM2BLK(ptr);
+ if (IS_FREE_LAST_MBC_BLK(blk)) {
+ /*
+ * A multiblock carrier that previously has been migrated away
+ * from us and now is back to be deallocated...
+ *
+ * Note that we cannot use FBLK_TO_MBC(blk) since it
+ * data has been overwritten by the queue.
+ */
+ Carrier_t *crr = FIRST_BLK_TO_MBC(allctr, blk);
+ ERTS_ALC_CPOOL_ASSERT(ERTS_ALC_IS_CPOOL_ENABLED(allctr));
+ ERTS_ALC_CPOOL_ASSERT(allctr == crr->cpool.orig_allctr);
+ schedule_dealloc_carrier(allctr, crr);
}
+ else {
- blk = UMEM2BLK(ptr);
+ INC_CC(allctr->calls.this_free);
- if (IS_SBC_BLK(blk))
- destroy_carrier(allctr, blk);
- else
- mbc_free(allctr, ptr);
- ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0);
+ if (fix)
+ handle_delayed_fix_dealloc(allctr, ptr);
+ else
+ dealloc_block(allctr, ptr, 1);
+ }
}
if (need_thr_progress && !(need_thr_prgr | need_mr_wrk)) {
@@ -1236,6 +1781,12 @@ handle_delayed_dealloc(Allctr_t *allctr,
store_earliest_thr_prgr(thr_prgr_p, ddq);
}
+ if (ERTS_ALC_IS_CPOOL_ENABLED(allctr))
+ check_pending_dealloc_carrier(allctr,
+ need_thr_progress,
+ thr_prgr_p,
+ need_more_work);
+
if (allctr->thread_safe && !allctr_locked)
erts_mtx_unlock(&allctr->mutex);
return res;
@@ -1250,13 +1801,59 @@ enqueue_dealloc_other_instance(ErtsAlcType_t type,
if (allctr->fix)
((ErtsAllctrFixDDBlock_t*) ptr)->fix_type = type;
- if (ddq_enqueue(type, &allctr->dd.q, ptr, cinit))
+ if (ddq_enqueue(&allctr->dd.q, ptr, cinit))
erts_alloc_notify_delayed_dealloc(allctr->ix);
}
#endif
#ifdef ERTS_SMP
+static void
+set_new_allctr_abandon_limit(Allctr_t *allctr);
+static void
+abandon_carrier(Allctr_t *allctr, Carrier_t *crr);
+
+
+static ERTS_INLINE void
+check_abandon_carrier(Allctr_t *allctr, Block_t *fblk, Carrier_t **busy_pcrr_pp)
+{
+ Carrier_t *crr;
+
+ if (busy_pcrr_pp && *busy_pcrr_pp)
+ return;
+
+ if (!ERTS_ALC_IS_CPOOL_ENABLED(allctr))
+ return;
+
+ allctr->cpool.check_limit_count--;
+ if (--allctr->cpool.check_limit_count <= 0)
+ set_new_allctr_abandon_limit(allctr);
+
+ if (!erts_thr_progress_is_managed_thread())
+ return;
+
+ if (allctr->cpool.disable_abandon)
+ return;
+
+ if (allctr->mbcs.blocks.curr.size > allctr->cpool.abandon_limit)
+ return;
+
+
+ crr = FBLK_TO_MBC(fblk);
+
+ if (allctr->main_carrier == crr)
+ return;
+
+ if (crr->cpool.blocks_size > crr->cpool.abandon_limit)
+ return;
+
+ if (crr->cpool.thr_prgr != ERTS_THR_PRGR_INVALID
+ && !erts_thr_progress_has_reached(crr->cpool.thr_prgr))
+ return;
+
+ abandon_carrier(allctr, crr);
+}
+
void
erts_alcu_check_delayed_dealloc(Allctr_t *allctr,
int limit,
@@ -1274,78 +1871,88 @@ erts_alcu_check_delayed_dealloc(Allctr_t *allctr,
}
#endif
-#define ERTS_ALCU_HANDLE_DD_IN_OP(Allctr, Locked) \
- handle_delayed_dealloc((Allctr), (Locked), 1, \
+#define ERTS_ALCU_HANDLE_DD_IN_OP(Allctr, Locked) \
+ handle_delayed_dealloc((Allctr), (Locked), 1, \
ERTS_ALCU_DD_OPS_LIM_LOW, NULL, NULL, NULL)
+static void
+dealloc_block(Allctr_t *allctr, void *ptr, int dec_cc_on_redirect)
+{
+ Block_t *blk = UMEM2BLK(ptr);
+
+ ERTS_SMP_LC_ASSERT(!allctr->thread_safe
+ || erts_lc_mtx_is_locked(&allctr->mutex));
+
+ if (IS_SBC_BLK(blk))
+ destroy_carrier(allctr, blk, NULL);
+#ifndef ERTS_SMP
+ else
+ mbc_free(allctr, ptr, NULL);
+#else
+ else if (!ERTS_ALC_IS_CPOOL_ENABLED(allctr))
+ mbc_free(allctr, ptr, NULL);
+ else {
+ Carrier_t *busy_pcrr_p;
+ Allctr_t *used_allctr;
+ used_allctr = get_used_allctr(allctr, ERTS_ALC_TS_PREF_LOCK_NO, ptr,
+ NULL, &busy_pcrr_p);
+ if (used_allctr == allctr) {
+ mbc_free(allctr, ptr, &busy_pcrr_p);
+ clear_busy_pool_carrier(allctr, busy_pcrr_p);
+ }
+ else {
+ /* Carrier migrated; need to redirect block to new owner... */
+ int cinit = used_allctr->dd.ix - allctr->dd.ix;
+
+ ERTS_ALC_CPOOL_ASSERT(!busy_pcrr_p);
+
+ if (dec_cc_on_redirect)
+ DEC_CC(allctr->calls.this_free);
+ if (ddq_enqueue(&used_allctr->dd.q, ptr, cinit))
+ erts_alloc_notify_delayed_dealloc(used_allctr->ix);
+ }
+ }
+#endif
+}
+
/* Multi block carrier alloc/realloc/free ... */
/* NOTE! mbc_alloc() may in case of memory shortage place the requested
* block in a sbc.
*/
static ERTS_INLINE void *
-mbc_alloc_block(Allctr_t *allctr, Uint size, Uint *blk_szp, Uint32 *alcu_flgsp)
+mbc_alloc_block(Allctr_t *allctr, Uint size, Uint *blk_szp)
{
Block_t *blk;
Uint get_blk_sz;
- Uint sbmbct;
ASSERT(size);
ASSERT(size < allctr->sbc_threshold);
*blk_szp = get_blk_sz = UMEMSZ2BLKSZ(allctr, size);
- sbmbct = allctr->sbmbc_threshold;
- if (sbmbct) {
- if (get_blk_sz < sbmbct) {
- *alcu_flgsp |= ERTS_ALCU_FLG_SBMBC;
- if (get_blk_sz + allctr->min_block_size > sbmbct) {
- /* Since we use block size to determine if blocks are
- located in sbmbc or not... */
- get_blk_sz += allctr->min_block_size;
- }
- }
- }
-
-#ifdef ERTS_SMP
- if (allctr->dd.use)
- ERTS_ALCU_HANDLE_DD_IN_OP(allctr, 1);
-#endif
-
- blk = (*allctr->get_free_block)(allctr, get_blk_sz, NULL, 0, *alcu_flgsp);
-
-#ifdef ERTS_SMP
- if (!blk && allctr->dd.use) {
- if (ERTS_ALCU_HANDLE_DD_IN_OP(allctr, 1))
- blk = (*allctr->get_free_block)(allctr, get_blk_sz, NULL, 0,
- *alcu_flgsp);
- }
-#endif
+ blk = (*allctr->get_free_block)(allctr, get_blk_sz, NULL, 0);
if (!blk) {
- if ((*alcu_flgsp) & ERTS_ALCU_FLG_SBMBC)
- blk = create_sbmbc(allctr, get_blk_sz);
- else {
- blk = create_carrier(allctr, get_blk_sz, CFLG_MBC);
+ blk = create_carrier(allctr, get_blk_sz, CFLG_MBC);
#if !HALFWORD_HEAP && !HAVE_SUPER_ALIGNED_MB_CARRIERS
- if (!blk) {
- /* Emergency! We couldn't create the carrier as we wanted.
- Try to place it in a sys_alloced sbc. */
- blk = create_carrier(allctr,
- size,
- (CFLG_SBC
- | CFLG_FORCE_SIZE
- | CFLG_FORCE_SYS_ALLOC));
- }
-#endif
+ if (!blk) {
+ /* Emergency! We couldn't create the carrier as we wanted.
+ Try to place it in a sys_alloced sbc. */
+ blk = create_carrier(allctr,
+ size,
+ (CFLG_SBC
+ | CFLG_FORCE_SIZE
+ | CFLG_FORCE_SYS_ALLOC));
}
+#endif
}
#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG
if (IS_MBC_BLK(blk)) {
- (*allctr->link_free_block)(allctr, blk, *alcu_flgsp);
+ (*allctr->link_free_block)(allctr, blk);
HARD_CHECK_BLK_CARRIER(allctr, blk);
- (*allctr->unlink_free_block)(allctr, blk, *alcu_flgsp);
+ (*allctr->unlink_free_block)(allctr, blk);
}
#endif
@@ -1359,8 +1966,7 @@ mbc_alloc_finalize(Allctr_t *allctr,
UWord flags,
Carrier_t *crr,
Uint want_blk_sz,
- int valid_blk_info,
- Uint32 alcu_flgs)
+ int valid_blk_info)
{
Uint blk_sz;
Uint nxt_blk_sz;
@@ -1392,7 +1998,7 @@ mbc_alloc_finalize(Allctr_t *allctr,
SET_PREV_BLK_FREE(allctr, nxt_nxt_blk);
}
}
- (*allctr->link_free_block)(allctr, nxt_blk, alcu_flgs);
+ (*allctr->link_free_block)(allctr, nxt_blk);
ASSERT(IS_NOT_LAST_BLK(blk));
ASSERT(IS_FREE_BLK(nxt_blk));
@@ -1433,7 +2039,8 @@ mbc_alloc_finalize(Allctr_t *allctr,
ASSERT(ABLK_TO_MBC(blk) == crr);
}
- STAT_MBC_BLK_ALLOC(allctr, blk_sz, alcu_flgs);
+ ERTS_ALC_CPOOL_ALLOC_OP(allctr);
+ STAT_MBC_BLK_ALLOC(allctr, crr, blk_sz, alcu_flgs);
ASSERT(IS_ALLOCED_BLK(blk));
ASSERT(blk_sz == MBC_BLK_SZ(blk));
@@ -1453,8 +2060,7 @@ mbc_alloc(Allctr_t *allctr, Uint size)
{
Block_t *blk;
Uint blk_sz;
- Uint32 alcu_flgs = 0;
- blk = mbc_alloc_block(allctr, size, &blk_sz, &alcu_flgs);
+ blk = mbc_alloc_block(allctr, size, &blk_sz);
if (!blk)
return NULL;
if (IS_MBC_BLK(blk))
@@ -1464,35 +2070,34 @@ mbc_alloc(Allctr_t *allctr, Uint size)
GET_BLK_HDR_FLGS(blk),
FBLK_TO_MBC(blk),
blk_sz,
- 1,
- alcu_flgs);
+ 1);
return BLK2UMEM(blk);
}
static void
-mbc_free(Allctr_t *allctr, void *p)
+mbc_free(Allctr_t *allctr, void *p, Carrier_t **busy_pcrr_pp)
{
Uint is_first_blk;
Uint is_last_blk;
- Uint32 alcu_flgs = 0;
Uint blk_sz;
Block_t *blk;
Block_t *nxt_blk;
-
+ Carrier_t *crr;
ASSERT(p);
blk = UMEM2BLK(p);
blk_sz = MBC_ABLK_SZ(blk);
- if (blk_sz < allctr->sbmbc_threshold)
- alcu_flgs |= ERTS_ALCU_FLG_SBMBC;
ASSERT(IS_MBC_BLK(blk));
ASSERT(blk_sz >= allctr->min_block_size);
HARD_CHECK_BLK_CARRIER(allctr, blk);
- STAT_MBC_BLK_FREE(allctr, blk_sz, alcu_flgs);
+ crr = ABLK_TO_MBC(blk);
+
+ ERTS_ALC_CPOOL_FREE_OP(allctr);
+ STAT_MBC_BLK_FREE(allctr, crr, busy_pcrr_pp, blk_sz, alcu_flgs);
is_first_blk = IS_MBC_FIRST_ABLK(allctr, blk);
is_last_blk = IS_LAST_BLK(blk);
@@ -1501,7 +2106,7 @@ mbc_free(Allctr_t *allctr, void *p)
ASSERT(!is_first_blk);
/* Coalesce with previous block... */
blk = PREV_BLK(blk);
- (*allctr->unlink_free_block)(allctr, blk, alcu_flgs);
+ (*allctr->unlink_free_block)(allctr, blk);
blk_sz += MBC_FBLK_SZ(blk);
is_first_blk = IS_MBC_FIRST_FBLK(allctr, blk);
@@ -1517,7 +2122,7 @@ mbc_free(Allctr_t *allctr, void *p)
nxt_blk = BLK_AFTER(blk, blk_sz);
if (IS_FREE_BLK(nxt_blk)) {
/* Coalesce with next block... */
- (*allctr->unlink_free_block)(allctr, nxt_blk, alcu_flgs);
+ (*allctr->unlink_free_block)(allctr, nxt_blk);
blk_sz += MBC_FBLK_SZ(nxt_blk);
SET_MBC_FBLK_SZ(blk, blk_sz);
@@ -1550,19 +2155,20 @@ mbc_free(Allctr_t *allctr, void *p)
if (is_first_blk
&& is_last_blk
&& allctr->main_carrier != FIRST_BLK_TO_MBC(allctr, blk)) {
- if (alcu_flgs & ERTS_ALCU_FLG_SBMBC)
- destroy_sbmbc(allctr, blk);
- else
- destroy_carrier(allctr, blk);
+ destroy_carrier(allctr, blk, busy_pcrr_pp);
}
else {
- (*allctr->link_free_block)(allctr, blk, alcu_flgs);
+ (*allctr->link_free_block)(allctr, blk);
HARD_CHECK_BLK_CARRIER(allctr, blk);
+#ifdef ERTS_SMP
+ check_abandon_carrier(allctr, blk, busy_pcrr_pp);
+#endif
}
}
static void *
-mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs)
+mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs,
+ Carrier_t **busy_pcrr_pp)
{
void *new_p;
Uint old_blk_sz;
@@ -1576,11 +2182,6 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs)
Uint is_last_blk;
#endif /* #ifndef MBC_REALLOC_ALWAYS_MOVES */
-#ifdef ERTS_SMP
- if (allctr->dd.use)
- ERTS_ALCU_HANDLE_DD_IN_OP(allctr, 1);
-#endif
-
ASSERT(p);
ASSERT(size);
ASSERT(size < allctr->sbc_threshold);
@@ -1594,13 +2195,13 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs)
if (alcu_flgs & ERTS_ALCU_FLG_FAIL_REALLOC_MOVE)
return NULL;
#else /* !MBC_REALLOC_ALWAYS_MOVES */
+
+#ifdef ERTS_SMP
+ if (busy_pcrr_pp && *busy_pcrr_pp)
+ goto realloc_move; /* Don't want to use carrier in pool */
+#endif
+
get_blk_sz = blk_sz = UMEMSZ2BLKSZ(allctr, size);
- if ((alcu_flgs & ERTS_ALCU_FLG_SBMBC)
- && (blk_sz + allctr->min_block_size > allctr->sbmbc_threshold)) {
- /* Since we use block size to determine if blocks are
- located in sbmbc or not... */
- get_blk_sz = blk_sz + allctr->min_block_size;
- }
ASSERT(IS_ALLOCED_BLK(blk));
ASSERT(IS_MBC_BLK(blk));
@@ -1648,8 +2249,7 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs)
new_blk = (*allctr->get_free_block)(allctr,
get_blk_sz,
cand_blk,
- cand_blk_sz,
- alcu_flgs);
+ cand_blk_sz);
if (new_blk || cand_blk != blk)
goto move_into_new_blk;
}
@@ -1671,8 +2271,11 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs)
nxt_blk = BLK_AFTER(blk, blk_sz);
- STAT_MBC_BLK_FREE(allctr, old_blk_sz, alcu_flgs);
- STAT_MBC_BLK_ALLOC(allctr, blk_sz, alcu_flgs);
+ crr = ABLK_TO_MBC(blk);
+
+ ERTS_ALC_CPOOL_REALLOC_OP(allctr);
+ STAT_MBC_BLK_FREE(allctr, crr, NULL, old_blk_sz, alcu_flgs);
+ STAT_MBC_BLK_ALLOC(allctr, crr, blk_sz, alcu_flgs);
ASSERT(MBC_BLK_SZ(blk) >= allctr->min_block_size);
@@ -1680,7 +2283,7 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs)
if (IS_FREE_BLK(nxt_nxt_blk)) {
/* Coalesce with next free block... */
nxt_blk_sz += MBC_FBLK_SZ(nxt_nxt_blk);
- (*allctr->unlink_free_block)(allctr, nxt_nxt_blk, alcu_flgs);
+ (*allctr->unlink_free_block)(allctr, nxt_nxt_blk);
is_last_blk = GET_LAST_BLK_HDR_FLG(nxt_nxt_blk);
}
@@ -1690,12 +2293,11 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs)
SET_BLK_SZ_FTR(nxt_blk, nxt_blk_sz);
}
- crr = ABLK_TO_MBC(blk);
SET_MBC_FBLK_HDR(nxt_blk, nxt_blk_sz,
SBH_THIS_FREE | (is_last_blk ? SBH_LAST_BLK : 0),
crr);
- (*allctr->link_free_block)(allctr, nxt_blk, alcu_flgs);
+ (*allctr->link_free_block)(allctr, nxt_blk);
ASSERT(IS_ALLOCED_BLK(blk));
@@ -1718,6 +2320,10 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs)
HARD_CHECK_BLK_CARRIER(allctr, blk);
+#ifdef ERTS_SMP
+ check_abandon_carrier(allctr, nxt_blk, NULL);
+#endif
+
return p;
}
@@ -1727,11 +2333,12 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs)
nxt_blk = BLK_AFTER(blk, old_blk_sz);
nxt_blk_sz = MBC_BLK_SZ(nxt_blk);
if (IS_FREE_BLK(nxt_blk) && get_blk_sz <= old_blk_sz + nxt_blk_sz) {
+ Carrier_t* crr = ABLK_TO_MBC(blk);
/* Grow into next block... */
HARD_CHECK_BLK_CARRIER(allctr, blk);
- (*allctr->unlink_free_block)(allctr, nxt_blk, alcu_flgs);
+ (*allctr->unlink_free_block)(allctr, nxt_blk);
nxt_blk_sz -= blk_sz - old_blk_sz;
is_last_blk = IS_LAST_BLK(nxt_blk);
@@ -1756,7 +2363,6 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs)
}
}
else {
- Carrier_t* crr = ABLK_TO_MBC(blk);
SET_MBC_ABLK_SZ(blk, blk_sz);
nxt_blk = BLK_AFTER(blk, blk_sz);
@@ -1767,15 +2373,15 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs)
else
SET_BLK_SZ_FTR(nxt_blk, nxt_blk_sz);
- (*allctr->link_free_block)(allctr, nxt_blk, alcu_flgs);
+ (*allctr->link_free_block)(allctr, nxt_blk);
ASSERT(IS_FREE_BLK(nxt_blk));
ASSERT(FBLK_TO_MBC(nxt_blk) == crr);
}
- STAT_MBC_BLK_FREE(allctr, old_blk_sz, alcu_flgs);
- STAT_MBC_BLK_ALLOC(allctr, blk_sz, alcu_flgs);
-
+ ERTS_ALC_CPOOL_REALLOC_OP(allctr);
+ STAT_MBC_BLK_FREE(allctr, crr, NULL, old_blk_sz, alcu_flgs);
+ STAT_MBC_BLK_ALLOC(allctr, crr, blk_sz, alcu_flgs);
ASSERT(IS_ALLOCED_BLK(blk));
ASSERT(blk_sz == MBC_BLK_SZ(blk));
@@ -1828,13 +2434,16 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs)
if (cand_blk_sz < get_blk_sz) {
/* We wont fit in cand_blk get a new one */
+#ifdef ERTS_SMP
+ realloc_move:
+#endif
#endif /* !MBC_REALLOC_ALWAYS_MOVES */
new_p = mbc_alloc(allctr, size);
if (!new_p)
return NULL;
sys_memcpy(new_p, p, MIN(size, old_blk_sz - ABLK_HDR_SZ));
- mbc_free(allctr, p);
+ mbc_free(allctr, p, busy_pcrr_pp);
return new_p;
@@ -1847,8 +2456,7 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs)
new_blk = (*allctr->get_free_block)(allctr,
get_blk_sz,
cand_blk,
- cand_blk_sz,
- alcu_flgs);
+ cand_blk_sz);
move_into_new_blk:
/*
* new_blk, and cand_blk have to be correctly set
@@ -1862,11 +2470,10 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs)
GET_BLK_HDR_FLGS(new_blk),
FBLK_TO_MBC(new_blk),
blk_sz,
- 1,
- alcu_flgs);
+ 1);
new_p = BLK2UMEM(new_blk);
sys_memcpy(new_p, p, MIN(size, old_blk_sz - ABLK_HDR_SZ));
- mbc_free(allctr, p);
+ mbc_free(allctr, p, NULL);
return new_p;
}
else {
@@ -1886,7 +2493,7 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs)
HARD_CHECK_BLK_CARRIER(allctr, blk);
- (*allctr->unlink_free_block)(allctr, new_blk, alcu_flgs); /* prev */
+ (*allctr->unlink_free_block)(allctr, new_blk); /* prev */
if (is_last_blk)
new_blk_flgs |= LAST_BLK_HDR_FLG;
@@ -1895,7 +2502,7 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs)
if (IS_FREE_BLK(nxt_blk)) {
new_blk_flgs |= GET_LAST_BLK_HDR_FLG(nxt_blk);
new_blk_sz += MBC_FBLK_SZ(nxt_blk);
- (*allctr->unlink_free_block)(allctr, nxt_blk, alcu_flgs);
+ (*allctr->unlink_free_block)(allctr, nxt_blk);
}
}
@@ -1920,10 +2527,10 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs)
new_blk_flgs,
crr,
blk_sz,
- 0,
- alcu_flgs);
+ 0);
- STAT_MBC_BLK_FREE(allctr, old_blk_sz, alcu_flgs);
+ ERTS_ALC_CPOOL_FREE_OP(allctr);
+ STAT_MBC_BLK_FREE(allctr, crr, NULL, old_blk_sz, alcu_flgs);
return new_p;
}
@@ -1931,6 +2538,635 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs)
#endif /* !MBC_REALLOC_ALWAYS_MOVES */
}
+#ifdef ERTS_SMP
+
+#define ERTS_ALC_MAX_DEALLOC_CARRIER 10
+#define ERTS_ALC_CPOOL_MAX_FETCH_INSPECT 10
+#define ERTS_ALC_CPOOL_CHECK_LIMIT_COUNT 100
+#define ERTS_ALC_CPOOL_MAX_NO_CARRIERS 5
+#define ERTS_ALC_CPOOL_INSERT_ALLOWED_OFFSET 100
+#define ERTS_ALC_CPOOL_MAX_FAILED_STAT_READS 3
+
+#define ERTS_ALC_CPOOL_PTR_MOD_MRK (((erts_aint_t) 1) << 0)
+#define ERTS_ALC_CPOOL_PTR_DEL_MRK (((erts_aint_t) 1) << 1)
+
+#define ERTS_ALC_CPOOL_PTR_MRKS \
+ (ERTS_ALC_CPOOL_PTR_MOD_MRK | ERTS_ALC_CPOOL_PTR_DEL_MRK)
+
+/*
+ * When setting multiple mod markers we always
+ * set mod markers in pointer order and always
+ * on next pointers before prev pointers.
+ */
+
+typedef union {
+ ErtsAlcCPoolData_t sentinel;
+ char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsAlcCPoolData_t))];
+} ErtsAlcCrrPool_t;
+
+#if ERTS_ALC_A_INVALID != 0
+# error "Carrier pool implementation assumes ERTS_ALC_A_INVALID == 0"
+#endif
+#if ERTS_ALC_A_MIN <= ERTS_ALC_A_INVALID
+# error "Carrier pool implementation assumes ERTS_ALC_A_MIN > ERTS_ALC_A_INVALID"
+#endif
+
+/*
+ * The pool is only allowed to be manipulated by managed
+ * threads except in the alloc_SUITE:cpool case. In this
+ * test case carrier_pool[ERTS_ALC_A_INVALID] will be
+ * used.
+ */
+
+static ErtsAlcCrrPool_t carrier_pool[ERTS_ALC_A_MAX+1] erts_align_attribute(ERTS_CACHE_LINE_SIZE);
+
+#define ERTS_ALC_CPOOL_MAX_BACKOFF (1 << 8)
+
+static int
+backoff(int n)
+{
+ int i;
+
+ for (i = 0; i < n; i++)
+ ERTS_SPIN_BODY;
+
+ if (n >= ERTS_ALC_CPOOL_MAX_BACKOFF)
+ return ERTS_ALC_CPOOL_MAX_BACKOFF;
+ else
+ return n << 1;
+}
+
+static int
+cpool_dbg_is_in_pool(Allctr_t *allctr, Carrier_t *crr)
+{
+ ErtsAlcCPoolData_t *sentinel = &carrier_pool[allctr->alloc_no].sentinel;
+ ErtsAlcCPoolData_t *cpdp = sentinel;
+ Carrier_t *tmp_crr;
+
+ while (1) {
+ cpdp = (ErtsAlcCPoolData_t *) (erts_atomic_read_ddrb(&cpdp->next) & ~FLG_MASK);
+ if (cpdp == sentinel)
+ return 0;
+ tmp_crr = (Carrier_t *) (((char *) cpdp) - offsetof(Carrier_t, cpool));
+ if (tmp_crr == crr)
+ return 1;
+ }
+}
+
+static int
+cpool_is_empty(Allctr_t *allctr)
+{
+ ErtsAlcCPoolData_t *sentinel = &carrier_pool[allctr->alloc_no].sentinel;
+ return ((erts_atomic_read_rb(&sentinel->next) == (erts_aint_t) sentinel)
+ && (erts_atomic_read_rb(&sentinel->prev) == (erts_aint_t) sentinel));
+}
+
+static ERTS_INLINE ErtsAlcCPoolData_t *
+cpool_aint2cpd(erts_aint_t aint)
+{
+ return (ErtsAlcCPoolData_t *) (aint & ~ERTS_ALC_CPOOL_PTR_MRKS);
+}
+
+static ERTS_INLINE erts_aint_t
+cpool_read(erts_atomic_t *aptr)
+{
+ return erts_atomic_read_acqb(aptr);
+}
+
+static ERTS_INLINE void
+cpool_init(erts_atomic_t *aptr, erts_aint_t val)
+{
+ erts_atomic_set_nob(aptr, val);
+}
+
+static ERTS_INLINE void
+cpool_set_mod_marked(erts_atomic_t *aptr, erts_aint_t new, erts_aint_t old)
+{
+#ifdef ERTS_ALC_CPOOL_DEBUG
+ erts_aint_t act = erts_atomic_xchg_relb(aptr, new);
+ ERTS_ALC_CPOOL_ASSERT(act == (old | ERTS_ALC_CPOOL_PTR_MOD_MRK));
+#else
+ erts_atomic_set_relb(aptr, new);
+#endif
+}
+
+
+static ERTS_INLINE erts_aint_t
+cpool_try_mod_mark_exp(erts_atomic_t *aptr, erts_aint_t exp)
+{
+ ERTS_ALC_CPOOL_ASSERT((exp & ERTS_ALC_CPOOL_PTR_MOD_MRK) == 0);
+ return erts_atomic_cmpxchg_nob(aptr, exp | ERTS_ALC_CPOOL_PTR_MOD_MRK, exp);
+}
+
+static ERTS_INLINE erts_aint_t
+cpool_mod_mark_exp(erts_atomic_t *aptr, erts_aint_t exp)
+{
+ int b;
+ erts_aint_t act;
+ ERTS_ALC_CPOOL_ASSERT((exp & ERTS_ALC_CPOOL_PTR_MOD_MRK) == 0);
+ while (1) {
+ act = erts_atomic_cmpxchg_nob(aptr,
+ exp | ERTS_ALC_CPOOL_PTR_MOD_MRK,
+ exp);
+ if (act == exp)
+ return exp;
+ b = 1;
+ do {
+ if ((act & ~ERTS_ALC_CPOOL_PTR_MOD_MRK) != exp)
+ return act;
+ b = backoff(b);
+ act = erts_atomic_read_nob(aptr);
+ } while (act != exp);
+ }
+}
+
+static ERTS_INLINE erts_aint_t
+cpool_mod_mark(erts_atomic_t *aptr)
+{
+ int b;
+ erts_aint_t act, exp;
+ act = cpool_read(aptr);
+ while (1) {
+ b = 1;
+ while (act & ERTS_ALC_CPOOL_PTR_MOD_MRK) {
+ b = backoff(b);
+ act = erts_atomic_read_nob(aptr);
+ }
+ exp = act;
+ act = erts_atomic_cmpxchg_acqb(aptr,
+ exp | ERTS_ALC_CPOOL_PTR_MOD_MRK,
+ exp);
+ if (act == exp)
+ return exp;
+ }
+}
+
+static void
+cpool_insert(Allctr_t *allctr, Carrier_t *crr)
+{
+ ErtsAlcCPoolData_t *cpd1p, *cpd2p;
+ erts_aint_t val;
+ ErtsAlcCPoolData_t *sentinel = &carrier_pool[allctr->alloc_no].sentinel;
+
+ ERTS_ALC_CPOOL_ASSERT(allctr->alloc_no == ERTS_ALC_A_INVALID /* testcase */
+ || erts_thr_progress_is_managed_thread());
+ ERTS_ALC_CPOOL_ASSERT(erts_smp_atomic_read_nob(&crr->allctr)
+ == (erts_aint_t) allctr);
+
+ erts_atomic_add_nob(&allctr->cpool.stat.blocks_size,
+ (erts_aint_t) crr->cpool.blocks_size);
+ erts_atomic_add_nob(&allctr->cpool.stat.no_blocks,
+ (erts_aint_t) crr->cpool.blocks);
+ erts_atomic_add_nob(&allctr->cpool.stat.carriers_size,
+ (erts_aint_t) CARRIER_SZ(crr));
+ erts_atomic_inc_nob(&allctr->cpool.stat.no_carriers);
+
+ erts_smp_atomic_set_nob(&crr->allctr,
+ ((erts_aint_t) allctr)|ERTS_CRR_ALCTR_FLG_IN_POOL);
+
+ /*
+ * We search in 'next' direction and begin by passing
+ * one element before trying to insert. This in order to
+ * avoid contention with threads fetching elements.
+ */
+
+ val = cpool_read(&sentinel->next);
+
+ /* Find a predecessor to be, and set mod marker on its next ptr */
+
+ while (1) {
+ cpd1p = cpool_aint2cpd(val);
+ if (cpd1p == sentinel) {
+ val = cpool_mod_mark(&cpd1p->next);
+ break;
+ }
+ val = cpool_read(&cpd1p->next);
+ if (!(val & ERTS_ALC_CPOOL_PTR_MRKS)) {
+ erts_aint_t tmp = cpool_try_mod_mark_exp(&cpd1p->next, val);
+ if (tmp == val) {
+ val = tmp;
+ break;
+ }
+ val = tmp;
+ }
+ }
+
+ /* Set mod marker on prev ptr of the to be successor */
+
+ cpd2p = cpool_aint2cpd(val);
+
+ cpool_init(&crr->cpool.next, (erts_aint_t) cpd2p);
+ cpool_init(&crr->cpool.prev, (erts_aint_t) cpd1p);
+
+ val = (erts_aint_t) cpd1p;
+
+ while (1) {
+ int b;
+ erts_aint_t tmp;
+
+ tmp = cpool_mod_mark_exp(&cpd2p->prev, val);
+ if (tmp == val)
+ break;
+ b = 1;
+ do {
+ b = backoff(b);
+ tmp = cpool_read(&cpd2p->prev);
+ } while (tmp != val);
+ }
+
+ /* Write pointers to this element in successor and predecessor */
+
+ cpool_set_mod_marked(&cpd1p->next,
+ (erts_aint_t) &crr->cpool,
+ (erts_aint_t) cpd2p);
+ cpool_set_mod_marked(&cpd2p->prev,
+ (erts_aint_t) &crr->cpool,
+ (erts_aint_t) cpd1p);
+}
+
+static void
+cpool_delete(Allctr_t *allctr, Allctr_t *prev_allctr, Carrier_t *crr)
+{
+ ErtsAlcCPoolData_t *cpd1p, *cpd2p;
+ erts_aint_t val;
+#ifdef ERTS_ALC_CPOOL_DEBUG
+ ErtsAlcCPoolData_t *sentinel = &carrier_pool[allctr->alloc_no].sentinel;
+#endif
+
+ ERTS_ALC_CPOOL_ASSERT(allctr->alloc_no == ERTS_ALC_A_INVALID /* testcase */
+ || erts_thr_progress_is_managed_thread());
+ ERTS_ALC_CPOOL_ASSERT(sentinel != &crr->cpool);
+
+ /* Set mod marker on next ptr of our predecessor */
+
+ val = (erts_aint_t) &crr->cpool;
+ while (1) {
+ erts_aint_t tmp;
+ cpd1p = cpool_aint2cpd(cpool_read(&crr->cpool.prev));
+ tmp = cpool_mod_mark_exp(&cpd1p->next, val);
+ if (tmp == val)
+ break;
+ }
+
+ /* Set mod marker on our next ptr */
+
+ val = cpool_mod_mark(&crr->cpool.next);
+
+ /* Set mod marker on the prev ptr of our successor */
+
+ cpd2p = cpool_aint2cpd(val);
+
+ val = (erts_aint_t) &crr->cpool;
+
+ while (1) {
+ int b;
+ erts_aint_t tmp;
+
+ tmp = cpool_mod_mark_exp(&cpd2p->prev, val);
+ if (tmp == val)
+ break;
+ b = 1;
+ do {
+ b = backoff(b);
+ tmp = cpool_read(&cpd2p->prev);
+ } while (tmp != val);
+ }
+
+ /* Set mod marker on our prev ptr */
+
+ val = (erts_aint_t) cpd1p;
+
+ while (1) {
+ int b;
+ erts_aint_t tmp;
+
+ tmp = cpool_mod_mark_exp(&crr->cpool.prev, val);
+ if (tmp == val)
+ break;
+ b = 1;
+ do {
+ b = backoff(b);
+ tmp = cpool_read(&cpd2p->prev);
+ } while (tmp != val);
+ }
+
+ /* Write pointers past this element in predecessor and successor */
+
+ cpool_set_mod_marked(&cpd1p->next,
+ (erts_aint_t) cpd2p,
+ (erts_aint_t) &crr->cpool);
+ cpool_set_mod_marked(&cpd2p->prev,
+ (erts_aint_t) cpd1p,
+ (erts_aint_t) &crr->cpool);
+
+ /* Repleace mod markers with delete markers on this element */
+ cpool_set_mod_marked(&crr->cpool.next,
+ ((erts_aint_t) cpd2p) | ERTS_ALC_CPOOL_PTR_DEL_MRK,
+ ((erts_aint_t) cpd2p) | ERTS_ALC_CPOOL_PTR_MOD_MRK);
+ cpool_set_mod_marked(&crr->cpool.prev,
+ ((erts_aint_t) cpd1p) | ERTS_ALC_CPOOL_PTR_DEL_MRK,
+ ((erts_aint_t) cpd1p) | ERTS_ALC_CPOOL_PTR_MOD_MRK);
+
+ crr->cpool.thr_prgr = erts_thr_progress_later(NULL);
+
+ erts_atomic_add_nob(&prev_allctr->cpool.stat.blocks_size,
+ -((erts_aint_t) crr->cpool.blocks_size));
+ erts_atomic_add_nob(&prev_allctr->cpool.stat.no_blocks,
+ -((erts_aint_t) crr->cpool.blocks));
+ erts_atomic_add_nob(&prev_allctr->cpool.stat.carriers_size,
+ -((erts_aint_t) CARRIER_SZ(crr)));
+ erts_atomic_dec_wb(&prev_allctr->cpool.stat.no_carriers);
+
+}
+
+static Carrier_t *
+cpool_fetch(Allctr_t *allctr, UWord size)
+{
+ int i;
+ Carrier_t *crr;
+ ErtsAlcCPoolData_t *cpdp;
+ ErtsAlcCPoolData_t *sentinel = &carrier_pool[allctr->alloc_no].sentinel;
+
+ ERTS_ALC_CPOOL_ASSERT(allctr->alloc_no == ERTS_ALC_A_INVALID /* testcase */
+ || erts_thr_progress_is_managed_thread());
+
+ i = 0;
+
+ /* First; check our own pending dealloc carrier list... */
+ crr = allctr->cpool.dc_list.last;
+ while (crr && i < ERTS_ALC_CPOOL_MAX_FETCH_INSPECT) {
+ if (erts_atomic_read_nob(&crr->cpool.max_size) >= size) {
+ unlink_carrier(&allctr->cpool.dc_list, crr);
+#ifdef ERTS_ALC_CPOOL_DEBUG
+ ERTS_ALC_CPOOL_ASSERT(erts_smp_atomic_xchg_nob(&crr->allctr,
+ ((erts_aint_t) allctr))
+ == (((erts_aint_t) allctr) & ~FLG_MASK));
+#else
+ erts_smp_atomic_set_nob(&crr->allctr, ((erts_aint_t) allctr));
+#endif
+ return crr;
+ }
+ crr = crr->prev;
+ i++;
+ }
+
+ /* ... then the pool ... */
+
+ /*
+ * We search in 'prev' direction and begin by passing
+ * one element before trying to fetch. This in order to
+ * avoid contention with threads inserting elements.
+ */
+
+ cpdp = cpool_aint2cpd(cpool_read(&sentinel->prev));
+ if (cpdp == sentinel)
+ return NULL;
+
+ while (i < ERTS_ALC_CPOOL_MAX_FETCH_INSPECT) {
+ erts_aint_t exp;
+ cpdp = cpool_aint2cpd(cpool_read(&cpdp->prev));
+ if (cpdp == sentinel) {
+ cpdp = cpool_aint2cpd(cpool_read(&cpdp->prev));
+ if (cpdp == sentinel)
+ return NULL;
+ i = ERTS_ALC_CPOOL_MAX_FETCH_INSPECT; /* Last one to inspect */
+ }
+ crr = (Carrier_t *) (((char *) cpdp) - offsetof(Carrier_t, cpool));
+ exp = erts_smp_atomic_read_rb(&crr->allctr);
+ if (((exp & (ERTS_CRR_ALCTR_FLG_IN_POOL|ERTS_CRR_ALCTR_FLG_BUSY))
+ == ERTS_CRR_ALCTR_FLG_IN_POOL)
+ && (erts_atomic_read_nob(&cpdp->max_size) >= size)) {
+ erts_aint_t act;
+ /* Try to fetch it... */
+ act = erts_smp_atomic_cmpxchg_mb(&crr->allctr,
+ (erts_aint_t) allctr,
+ exp);
+ if (act == exp) {
+ cpool_delete(allctr, ((Allctr_t *) (act & ~FLG_MASK)), crr);
+ return crr;
+ }
+ }
+ i++;
+ }
+ return NULL;
+}
+
+static void
+check_pending_dealloc_carrier(Allctr_t *allctr,
+ int *need_thr_progress,
+ ErtsThrPrgrVal *thr_prgr_p,
+ int *need_more_work)
+{
+ Carrier_t *crr = allctr->cpool.dc_list.first;
+
+ if (crr) {
+ ErtsThrPrgrVal current = erts_thr_progress_current();
+ int i = 0;
+
+ do {
+ Carrier_t *dcrr;
+
+ if (!erts_thr_progress_has_reached_this(current, crr->cpool.thr_prgr))
+ break;
+
+ dcrr = crr;
+ crr = crr->next;
+ dealloc_carrier(allctr, dcrr, ERTS_MSEG_FLG_2POW);
+ i++;
+ } while (crr && i < ERTS_ALC_MAX_DEALLOC_CARRIER);
+
+ allctr->cpool.dc_list.first = crr;
+ if (!crr)
+ allctr->cpool.dc_list.last = NULL;
+ else {
+ crr->prev = NULL;
+
+ if (need_more_work) {
+ ERTS_ALC_CPOOL_ASSERT(need_thr_progress && thr_prgr_p);
+ if (erts_thr_progress_has_reached_this(current, crr->cpool.thr_prgr))
+ *need_more_work = 1;
+ else {
+ *need_thr_progress = 1;
+ if (*thr_prgr_p == ERTS_THR_PRGR_INVALID
+ || erts_thr_progress_cmp(crr->cpool.thr_prgr,
+ *thr_prgr_p) < 0) {
+ *thr_prgr_p = crr->cpool.thr_prgr;
+ }
+ }
+ }
+ }
+ }
+}
+
+static void
+schedule_dealloc_carrier(Allctr_t *allctr, Carrier_t *crr)
+{
+ Allctr_t *used_allctr;
+ int check_pending_dealloc;
+ erts_aint_t max_size;
+
+ if (!ERTS_ALC_IS_CPOOL_ENABLED(allctr)) {
+ dealloc_carrier(allctr, crr, ERTS_MSEG_FLG_2POW);
+ return;
+ }
+
+ used_allctr = crr->cpool.orig_allctr;
+
+ if (allctr != used_allctr) {
+ Block_t *blk = MBC_TO_FIRST_BLK(allctr, crr);
+ int cinit = used_allctr->dd.ix - allctr->dd.ix;
+
+ /*
+ * Receiver will recognize that this is a carrier to
+ * deallocate since the block is an mbc block that
+ * is free and last in carrier...
+ */
+ ERTS_ALC_CPOOL_ASSERT(IS_FREE_LAST_MBC_BLK(blk));
+
+ ERTS_ALC_CPOOL_ASSERT(IS_MBC_FIRST_ABLK(allctr, blk));
+ ERTS_ALC_CPOOL_ASSERT(crr == FBLK_TO_MBC(blk));
+ ERTS_ALC_CPOOL_ASSERT(crr == FIRST_BLK_TO_MBC(used_allctr, blk));
+
+ if (ddq_enqueue(&used_allctr->dd.q, BLK2UMEM(blk), cinit))
+ erts_alloc_notify_delayed_dealloc(used_allctr->ix);
+ return;
+ }
+
+ if (crr->cpool.thr_prgr == ERTS_THR_PRGR_INVALID
+ || erts_thr_progress_has_reached(crr->cpool.thr_prgr)) {
+ dealloc_carrier(allctr, crr, ERTS_MSEG_FLG_2POW);
+ return;
+ }
+
+ max_size = (erts_aint_t) allctr->largest_fblk_in_mbc(allctr, crr);
+ erts_atomic_set_nob(&crr->cpool.max_size, max_size);
+
+ crr->next = NULL;
+ crr->prev = allctr->cpool.dc_list.last;
+ if (allctr->cpool.dc_list.last) {
+ check_pending_dealloc = 1;
+ allctr->cpool.dc_list.last->next = crr;
+ }
+ else {
+ check_pending_dealloc = 0;
+ allctr->cpool.dc_list.first = crr;
+ }
+ allctr->cpool.dc_list.last = crr;
+ if (check_pending_dealloc)
+ check_pending_dealloc_carrier(allctr, NULL, NULL, NULL);
+ erts_alloc_ensure_handle_delayed_dealloc_call(allctr->ix);
+}
+
+static ERTS_INLINE void
+cpool_init_carrier_data(Allctr_t *allctr, Carrier_t *crr)
+{
+ erts_atomic_init_nob(&crr->cpool.next, ERTS_AINT_NULL);
+ erts_atomic_init_nob(&crr->cpool.prev, ERTS_AINT_NULL);
+ crr->cpool.orig_allctr = allctr;
+ crr->cpool.thr_prgr = ERTS_THR_PRGR_INVALID;
+ erts_atomic_init_nob(&crr->cpool.max_size, 0);
+ crr->cpool.blocks = 0;
+ crr->cpool.blocks_size = 0;
+ if (!ERTS_ALC_IS_CPOOL_ENABLED(allctr))
+ crr->cpool.abandon_limit = 0;
+ else {
+ UWord csz = CARRIER_SZ(crr);
+ UWord limit = csz*allctr->cpool.util_limit;
+ if (limit > csz)
+ limit /= 100;
+ else
+ limit = (csz/100)*allctr->cpool.util_limit;
+ crr->cpool.abandon_limit = limit;
+ }
+}
+
+static void
+set_new_allctr_abandon_limit(Allctr_t *allctr)
+{
+ UWord limit;
+ UWord csz;
+
+ allctr->cpool.check_limit_count = ERTS_ALC_CPOOL_CHECK_LIMIT_COUNT;
+
+ csz = allctr->mbcs.curr.norm.mseg.size;
+ csz += allctr->mbcs.curr.norm.sys_alloc.size;
+
+ limit = csz*allctr->cpool.util_limit;
+ if (limit > csz)
+ limit /= 100;
+ else
+ limit = (csz/100)*allctr->cpool.util_limit;
+
+ allctr->cpool.abandon_limit = limit;
+}
+
+static void
+abandon_carrier(Allctr_t *allctr, Carrier_t *crr)
+{
+ erts_aint_t max_size;
+
+ STAT_MBC_CPOOL_INSERT(allctr, crr);
+
+ unlink_carrier(&allctr->mbc_list, crr);
+
+ allctr->remove_mbc(allctr, crr);
+
+ max_size = (erts_aint_t) allctr->largest_fblk_in_mbc(allctr, crr);
+ erts_atomic_set_nob(&crr->cpool.max_size, max_size);
+
+ cpool_insert(allctr, crr);
+
+ set_new_allctr_abandon_limit(allctr);
+}
+
+static void
+cpool_read_stat(Allctr_t *allctr, UWord *nocp, UWord *cszp, UWord *nobp, UWord *bszp)
+{
+ int i;
+ UWord noc = 0, csz = 0, nob = 0, bsz = 0;
+
+ /*
+ * We try to get consistent values, but after
+ * ERTS_ALC_CPOOL_MAX_FAILED_STAT_READS failed
+ * tries we give up and present what we got...
+ */
+ for (i = 0; i <= ERTS_ALC_CPOOL_MAX_FAILED_STAT_READS; i++) {
+ UWord tnoc, tcsz, tnob, tbsz;
+
+ tnoc = (UWord) (nocp
+ ? erts_atomic_read_nob(&allctr->cpool.stat.no_carriers)
+ : 0);
+ tcsz = (UWord) (cszp
+ ? erts_atomic_read_nob(&allctr->cpool.stat.carriers_size)
+ : 0);
+ tnob = (UWord) (nobp
+ ? erts_atomic_read_nob(&allctr->cpool.stat.no_blocks)
+ : 0);
+ tbsz = (UWord) (bszp
+ ? erts_atomic_read_nob(&allctr->cpool.stat.blocks_size)
+ : 0);
+ if (tnoc == noc && tcsz == csz && tnob == nob && tbsz == bsz)
+ break;
+ noc = tnoc;
+ csz = tcsz;
+ nob = tnob;
+ bsz = tbsz;
+ ERTS_THR_READ_MEMORY_BARRIER;
+ }
+
+ if (nocp)
+ *nocp = noc;
+ if (cszp)
+ *cszp = csz;
+ if (nobp)
+ *nobp = nob;
+ if (bszp)
+ *bszp = bsz;
+}
+
+
+#endif /* ERTS_SMP */
+
#ifdef DEBUG
#if HAVE_ERTS_MSEG
@@ -1974,81 +3210,6 @@ static void CHECK_1BLK_CARRIER(Allctr_t* A, int SBC, int MSEGED, Carrier_t* C,
#endif
static Block_t *
-create_sbmbc(Allctr_t *allctr, Uint umem_sz)
-{
- Block_t *blk;
- Uint blk_sz;
- Uint crr_sz = allctr->sbmbc_size;
- Carrier_t *crr;
-
-#if HALFWORD_HEAP
- if (allctr->mseg_opt.low_mem)
- crr = erts_alloc(ERTS_ALC_T_SBMBC_LOW, crr_sz);
- else
-#endif
- crr = erts_alloc(ERTS_ALC_T_SBMBC, crr_sz);
-
- INC_CC(allctr->calls.sbmbc_alloc);
- SET_CARRIER_HDR(crr, crr_sz, SCH_SYS_ALLOC|SCH_MBC, allctr);
-
- blk = MBC_TO_FIRST_BLK(allctr, crr);
-
- blk_sz = UNIT_FLOOR(crr_sz - MBC_HEADER_SIZE(allctr));
-
- SET_MBC_FBLK_HDR(blk, blk_sz, SBH_THIS_FREE|SBH_LAST_BLK, crr);
-
- link_carrier(&allctr->sbmbc_list, crr);
-
- STAT_SBMBC_ALLOC(allctr, crr_sz);
- CHECK_1BLK_CARRIER(allctr, 0, 0, crr, crr_sz, blk, blk_sz);
- if (allctr->creating_mbc)
- (*allctr->creating_mbc)(allctr, crr, ERTS_ALCU_FLG_SBMBC);
-
- DEBUG_SAVE_ALIGNMENT(crr);
- return blk;
-}
-
-static void
-destroy_sbmbc(Allctr_t *allctr, Block_t *blk)
-{
- Uint crr_sz;
- Carrier_t *crr;
-
- ASSERT(IS_MBC_BLK(blk));
- ASSERT(IS_MBC_FIRST_FBLK(allctr, blk));
-
- crr = FIRST_BLK_TO_MBC(allctr, blk);
- crr_sz = CARRIER_SZ(crr);
-
-#ifdef DEBUG
- if (!allctr->stopped) {
- ASSERT(IS_LAST_BLK(blk));
-
-#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG
- (*allctr->link_free_block)(allctr, blk, ERTS_ALCU_FLG_SBMBC);
- HARD_CHECK_BLK_CARRIER(allctr, blk);
- (*allctr->unlink_free_block)(allctr, blk, ERTS_ALCU_FLG_SBMBC);
-#endif
- }
-#endif
-
- STAT_SBMBC_FREE(allctr, crr_sz);
-
- unlink_carrier(&allctr->sbmbc_list, crr);
- if (allctr->destroying_mbc)
- (*allctr->destroying_mbc)(allctr, crr, ERTS_ALCU_FLG_SBMBC);
-
- INC_CC(allctr->calls.sbmbc_free);
-
-#if HALFWORD_HEAP
- if (allctr->mseg_opt.low_mem)
- erts_free(ERTS_ALC_T_SBMBC_LOW, crr);
- else
-#endif
- erts_free(ERTS_ALC_T_SBMBC, crr);
-}
-
-static Block_t *
create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags)
{
Block_t *blk;
@@ -2077,6 +3238,24 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags)
blk_sz = UMEMSZ2BLKSZ(allctr, umem_sz);
+#ifdef ERTS_SMP
+ allctr->cpool.disable_abandon = ERTS_ALC_CPOOL_MAX_DISABLE_ABANDON;
+
+ if ((flags & (CFLG_MBC|CFLG_NO_CPOOL)) == CFLG_MBC
+ && ERTS_ALC_IS_CPOOL_ENABLED(allctr)
+ && erts_thr_progress_is_managed_thread()) {
+ crr = cpool_fetch(allctr, blk_sz);
+ if (crr) {
+ STAT_MBC_CPOOL_FETCH(allctr, crr);
+ link_carrier(&allctr->mbc_list, crr);
+ (*allctr->add_mbc)(allctr, crr);
+ blk = (*allctr->get_free_block)(allctr, blk_sz, NULL, 0);
+ ASSERT(blk);
+ return blk;
+ }
+ }
+#endif
+
#if HAVE_ERTS_MSEG
if (flags & CFLG_FORCE_SYS_ALLOC)
@@ -2204,11 +3383,15 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags)
allctr->main_carrier = crr;
}
+#ifdef ERTS_SMP
+ cpool_init_carrier_data(allctr, crr);
+#endif
+
link_carrier(&allctr->mbc_list, crr);
CHECK_1BLK_CARRIER(allctr, 0, is_mseg, crr, crr_sz, blk, blk_sz);
if (allctr->creating_mbc)
- (*allctr->creating_mbc)(allctr, crr, 0);
+ (*allctr->creating_mbc)(allctr, crr);
}
@@ -2352,14 +3535,21 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags)
}
static void
-destroy_carrier(Allctr_t *allctr, Block_t *blk)
+dealloc_carrier(Allctr_t *allctr, Carrier_t *crr, Uint mseg_flags)
{
- Uint crr_sz;
- Carrier_t *crr;
#if HAVE_ERTS_MSEG
- Uint is_mseg = 0;
- Uint mseg_flags = ERTS_MSEG_FLG_NONE;
+ if (IS_MSEG_CARRIER(crr))
+ alcu_mseg_dealloc(allctr, crr, CARRIER_SZ(crr), mseg_flags);
+ else
#endif
+ alcu_sys_free(allctr, crr);
+}
+
+static void
+destroy_carrier(Allctr_t *allctr, Block_t *blk, Carrier_t **busy_pcrr_pp)
+{
+ Uint crr_sz;
+ Carrier_t *crr;
if (IS_SBC_BLK(blk)) {
Uint blk_sz = SBC_BLK_SZ(blk);
@@ -2372,7 +3562,6 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk)
#if HAVE_ERTS_MSEG
if (IS_MSEG_CARRIER(crr)) {
- is_mseg++;
ASSERT(crr_sz % MSEG_UNIT_SZ == 0);
STAT_MSEG_SBC_FREE(allctr, crr_sz, blk_sz);
}
@@ -2382,6 +3571,7 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk)
unlink_carrier(&allctr->sbc_list, crr);
+ dealloc_carrier(allctr, crr, ERTS_MSEG_FLG_NONE);
}
else {
ASSERT(IS_MBC_FIRST_FBLK(allctr, blk));
@@ -2400,30 +3590,36 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk)
}
#endif
-#if HAVE_ERTS_MSEG
- if (IS_MSEG_CARRIER(crr)) {
- is_mseg++;
- ASSERT(crr_sz % MSEG_UNIT_SZ == 0);
- STAT_MSEG_MBC_FREE(allctr, crr_sz);
- mseg_flags = ERTS_MSEG_FLG_2POW;
+ if (allctr->destroying_mbc)
+ (*allctr->destroying_mbc)(allctr, crr);
+
+#ifdef ERTS_SMP
+ if (busy_pcrr_pp && *busy_pcrr_pp) {
+ ERTS_ALC_CPOOL_ASSERT(*busy_pcrr_pp == crr);
+ *busy_pcrr_pp = NULL;
+ cpool_delete(allctr, allctr, crr);
}
else
#endif
- STAT_SYS_ALLOC_MBC_FREE(allctr, crr_sz);
+ {
+ unlink_carrier(&allctr->mbc_list, crr);
+#if HAVE_ERTS_MSEG
+ if (IS_MSEG_CARRIER(crr)) {
+ ASSERT(crr_sz % MSEG_UNIT_SZ == 0);
+ STAT_MSEG_MBC_FREE(allctr, crr_sz);
+ }
+ else
+#endif
+ STAT_SYS_ALLOC_MBC_FREE(allctr, crr_sz);
+ }
- unlink_carrier(&allctr->mbc_list, crr);
- if (allctr->destroying_mbc)
- (*allctr->destroying_mbc)(allctr, crr, 0);
+#ifdef ERTS_SMP
+ schedule_dealloc_carrier(allctr, crr);
+#else
+ dealloc_carrier(allctr, crr, ERTS_MSEG_FLG_2POW);
+#endif
}
-
-#if HAVE_ERTS_MSEG
- if (is_mseg) {
- alcu_mseg_dealloc(allctr, crr, crr_sz, mseg_flags);
- }
- else
-#endif
- alcu_sys_free(allctr, crr);
}
@@ -2457,19 +3653,19 @@ static struct {
Eterm lmbcs;
Eterm smbcs;
Eterm mbcgs;
- Eterm sbmbcs;
- Eterm sbmbct;
+ Eterm acul;
#if HAVE_ERTS_MSEG
Eterm mmc;
#endif
Eterm ycs;
- /* Eterm sbmbcs; */
-
Eterm fix_types;
Eterm mbcs;
+#ifdef ERTS_SMP
+ Eterm mbcs_pool;
+#endif
Eterm sbcs;
Eterm sys_alloc_carriers_size;
@@ -2494,8 +3690,6 @@ static struct {
Eterm mseg_dealloc;
Eterm mseg_realloc;
#endif
- Eterm sbmbc_alloc;
- Eterm sbmbc_free;
#ifdef DEBUG
Eterm end_of_atoms;
#endif
@@ -2551,19 +3745,19 @@ init_atoms(Allctr_t *allctr)
AM_INIT(lmbcs);
AM_INIT(smbcs);
AM_INIT(mbcgs);
- AM_INIT(sbmbcs);
- AM_INIT(sbmbct);
+ AM_INIT(acul);
#if HAVE_ERTS_MSEG
AM_INIT(mmc);
#endif
AM_INIT(ycs);
- /*AM_INIT(sbmbcs);*/
-
AM_INIT(fix_types);
AM_INIT(mbcs);
+#ifdef ERTS_SMP
+ AM_INIT(mbcs_pool);
+#endif
AM_INIT(sbcs);
AM_INIT(sys_alloc_carriers_size);
@@ -2588,8 +3782,6 @@ init_atoms(Allctr_t *allctr)
AM_INIT(mseg_dealloc);
AM_INIT(mseg_realloc);
#endif
- AM_INIT(sbmbc_free);
- AM_INIT(sbmbc_alloc);
#ifdef DEBUG
for (atom = (Eterm *) &am; atom < &am.end_of_atoms; atom++) {
@@ -2637,19 +3829,22 @@ ensure_atoms_initialized(Allctr_t *allctr)
* that would fit a small when size check is done may need to be built
* as a big when the actual build is performed. Caller is required to
* HRelease after build.
+ *
+ * Note, bld_unstable_uint() should have been called bld_unstable_uword()
+ * but we do not want to rename it...
*/
static ERTS_INLINE Eterm
-bld_unstable_uint(Uint **hpp, Uint *szp, Uint ui)
+bld_unstable_uint(Uint **hpp, Uint *szp, UWord ui)
{
Eterm res = THE_NON_VALUE;
if (szp)
- *szp += BIG_UINT_HEAP_SIZE;
+ *szp += BIG_UWORD_HEAP_SIZE(~((UWord) 0));
if (hpp) {
if (IS_USMALL(0, ui))
res = make_small(ui);
else {
- res = uint_to_big(ui, *hpp);
- *hpp += BIG_UINT_HEAP_SIZE;
+ res = uword_to_big(ui, *hpp);
+ *hpp += BIG_UWORD_HEAP_SIZE(ui);
}
}
return res;
@@ -2675,8 +3870,24 @@ add_4tup(Uint **hpp, Uint *szp, Eterm *lp,
bld_cons(hpp, szp, bld_tuple(hpp, szp, 4, el1, el2, el3, el4), *lp);
}
+static ERTS_INLINE void
+add_fix_types(Allctr_t *allctr, int internal, Uint **hpp, Uint *szp,
+ Eterm *lp, Eterm fix)
+{
+ if (allctr->fix) {
+ if (!ERTS_ALC_IS_CPOOL_ENABLED(allctr))
+ add_2tup(hpp, szp, lp, am.fix_types, fix);
+ else if (internal)
+ add_3tup(hpp, szp, lp,
+ am.fix_types,
+ erts_bld_uword(hpp, szp, ~((UWord) 0)),
+ fix);
+ }
+}
+
static Eterm
sz_info_fix(Allctr_t *allctr,
+ int internal,
int *print_to_p,
void *print_to_arg,
Uint **hpp,
@@ -2684,36 +3895,67 @@ sz_info_fix(Allctr_t *allctr,
{
Eterm res;
int ix;
- ErtsAlcFixList_t *fix = allctr->fix;
- ASSERT(fix);
+ ASSERT(allctr->fix);
res = NIL;
- for (ix = ERTS_ALC_NO_FIXED_SIZES-1; ix >= 0; ix--) {
- ErtsAlcType_t n = ix + ERTS_ALC_N_MIN_A_FIXED_SIZE;
- Uint alloced = (fix[ix].type_size * fix[ix].allocated);
- Uint used = fix[ix].type_size*fix[ix].used;
-
- if (print_to_p) {
- int to = *print_to_p;
- void *arg = print_to_arg;
- erts_print(to,
- arg,
- "fix type: %s %bpu %bpu\n",
- (char *) ERTS_ALC_N2TD(n),
- alloced,
- used);
- }
+ if (ERTS_ALC_IS_CPOOL_ENABLED(allctr)) {
+
+ if (internal) {
+ for (ix = ERTS_ALC_NO_FIXED_SIZES-1; ix >= 0; ix--) {
+ ErtsAlcFixList_t *fix = &allctr->fix[ix];
+ UWord alloced = fix->type_size * fix->u.cpool.allocated;
+ UWord used = fix->type_size * fix->u.cpool.used;
+
+ if (print_to_p) {
+ int to = *print_to_p;
+ void *arg = print_to_arg;
+ erts_print(to,
+ arg,
+ "fix type internal: %s %bpu %bpu\n",
+ (char *) ERTS_ALC_N2TD(ERTS_ALC_N_MIN_A_FIXED_SIZE
+ + ix),
+ alloced,
+ used);
+ }
- if (hpp || szp) {
- add_3tup(hpp, szp, &res,
- fix_type_atoms[ix],
- bld_unstable_uint(hpp, szp, alloced),
- bld_unstable_uint(hpp, szp, used));
+ if (hpp || szp) {
+ add_3tup(hpp, szp, &res,
+ fix_type_atoms[ix],
+ bld_unstable_uint(hpp, szp, alloced),
+ bld_unstable_uint(hpp, szp, used));
+ }
+ }
}
}
+ else {
+ for (ix = ERTS_ALC_NO_FIXED_SIZES-1; ix >= 0; ix--) {
+ ErtsAlcFixList_t *fix = &allctr->fix[ix];
+ UWord alloced = fix->type_size * fix->u.nocpool.allocated;
+ UWord used = fix->type_size*fix->u.nocpool.used;
+
+ if (print_to_p) {
+ int to = *print_to_p;
+ void *arg = print_to_arg;
+ erts_print(to,
+ arg,
+ "fix type: %s %bpu %bpu\n",
+ (char *) ERTS_ALC_N2TD(ERTS_ALC_N_MIN_A_FIXED_SIZE
+ + ix),
+ alloced,
+ used);
+ }
+
+ if (hpp || szp) {
+ add_3tup(hpp, szp, &res,
+ fix_type_atoms[ix],
+ bld_unstable_uint(hpp, szp, alloced),
+ bld_unstable_uint(hpp, szp, used));
+ }
+ }
+ }
return res;
}
@@ -2727,9 +3969,7 @@ sz_info_carriers(Allctr_t *allctr,
Uint *szp)
{
Eterm res = THE_NON_VALUE;
- Uint curr_size = (cs == &allctr->sbmbcs
- ? cs->curr.small_block.size
- : cs->curr.norm.mseg.size + cs->curr.norm.sys_alloc.size);
+ UWord curr_size = cs->curr.norm.mseg.size + cs->curr.norm.sys_alloc.size;
if (print_to_p) {
int to = *print_to_p;
@@ -2743,7 +3983,7 @@ sz_info_carriers(Allctr_t *allctr,
cs->blocks.max_ever.size);
erts_print(to,
arg,
- "%scarriers size: %beu %bpu %bpu\n",
+ "%scarriers size: %bpu %bpu %bpu\n",
prefix,
curr_size,
cs->max.size,
@@ -2767,6 +4007,62 @@ sz_info_carriers(Allctr_t *allctr,
return res;
}
+#ifdef ERTS_SMP
+
+static Eterm
+info_cpool(Allctr_t *allctr,
+ int sz_only,
+ char *prefix,
+ int *print_to_p,
+ void *print_to_arg,
+ Uint **hpp,
+ Uint *szp)
+{
+ Eterm res = THE_NON_VALUE;
+ UWord noc, csz, nob, bsz;
+
+ noc = csz = nob = bsz = ~0;
+ if (print_to_p || hpp) {
+ if (sz_only)
+ cpool_read_stat(allctr, NULL, &csz, NULL, &bsz);
+ else
+ cpool_read_stat(allctr, &noc, &csz, &nob, &bsz);
+ }
+
+ if (print_to_p) {
+ int to = *print_to_p;
+ void *arg = print_to_arg;
+ if (!sz_only)
+ erts_print(to, arg, "%sblocks: %bpu\n", prefix, nob);
+ erts_print(to, arg, "%sblocks size: %bpu\n", prefix, bsz);
+ if (!sz_only)
+ erts_print(to, arg, "%scarriers: %bpu\n", prefix, noc);
+ erts_print(to, arg, "%scarriers size: %bpu\n", prefix, csz);
+ }
+
+ if (hpp || szp) {
+ res = NIL;
+ add_2tup(hpp, szp, &res,
+ am.carriers_size,
+ bld_unstable_uint(hpp, szp, csz));
+ if (!sz_only)
+ add_2tup(hpp, szp, &res,
+ am.carriers,
+ bld_unstable_uint(hpp, szp, noc));
+ add_2tup(hpp, szp, &res,
+ am.blocks_size,
+ bld_unstable_uint(hpp, szp, bsz));
+ if (!sz_only)
+ add_2tup(hpp, szp, &res,
+ am.blocks,
+ bld_unstable_uint(hpp, szp, nob));
+ }
+
+ return res;
+}
+
+#endif /* ERTS_SMP */
+
static Eterm
info_carriers(Allctr_t *allctr,
CarriersStats_t *cs,
@@ -2777,17 +4073,10 @@ info_carriers(Allctr_t *allctr,
Uint *szp)
{
Eterm res = THE_NON_VALUE;
- Uint curr_no, curr_size;
- int small_block = cs == &allctr->sbmbcs;
-
- if (small_block) {
- curr_no = cs->curr.small_block.no;
- curr_size = cs->curr.small_block.size;
- }
- else {
- curr_no = cs->curr.norm.mseg.no + cs->curr.norm.sys_alloc.no;
- curr_size = cs->curr.norm.mseg.size + cs->curr.norm.sys_alloc.size;
- }
+ UWord curr_no, curr_size;
+
+ curr_no = cs->curr.norm.mseg.no + cs->curr.norm.sys_alloc.no;
+ curr_size = cs->curr.norm.mseg.size + cs->curr.norm.sys_alloc.size;
if (print_to_p) {
int to = *print_to_p;
@@ -2808,75 +4097,67 @@ info_carriers(Allctr_t *allctr,
cs->blocks.max_ever.size);
erts_print(to,
arg,
- "%scarriers: %beu %bpu %bpu\n",
+ "%scarriers: %bpu %bpu %bpu\n",
prefix,
curr_no,
cs->max.no,
cs->max_ever.no);
- if (!small_block) {
#if HAVE_ERTS_MSEG
- erts_print(to,
- arg,
- "%smseg carriers: %bpu\n",
- prefix,
- cs->curr.norm.mseg.no);
-#endif
- erts_print(to,
- arg,
- "%ssys_alloc carriers: %bpu\n",
- prefix,
- cs->curr.norm.sys_alloc.no);
- }
erts_print(to,
arg,
- "%scarriers size: %beu %bpu %bpu\n",
+ "%smseg carriers: %bpu\n",
+ prefix,
+ cs->curr.norm.mseg.no);
+#endif
+ erts_print(to,
+ arg,
+ "%ssys_alloc carriers: %bpu\n",
+ prefix,
+ cs->curr.norm.sys_alloc.no);
+ erts_print(to,
+ arg,
+ "%scarriers size: %bpu %bpu %bpu\n",
prefix,
curr_size,
cs->max.size,
cs->max_ever.size);
- if (!small_block) {
#if HAVE_ERTS_MSEG
- erts_print(to,
- arg,
- "%smseg carriers size: %bpu\n",
- prefix,
- cs->curr.norm.mseg.size);
-#endif
- erts_print(to,
- arg,
- "%ssys_alloc carriers size: %bpu\n",
- prefix,
- cs->curr.norm.sys_alloc.size);
- }
+ erts_print(to,
+ arg,
+ "%smseg carriers size: %bpu\n",
+ prefix,
+ cs->curr.norm.mseg.size);
+#endif
+ erts_print(to,
+ arg,
+ "%ssys_alloc carriers size: %bpu\n",
+ prefix,
+ cs->curr.norm.sys_alloc.size);
}
if (hpp || szp) {
res = NIL;
- if (!small_block) {
- add_2tup(hpp, szp, &res,
- am.sys_alloc_carriers_size,
- bld_unstable_uint(hpp, szp, cs->curr.norm.sys_alloc.size));
+ add_2tup(hpp, szp, &res,
+ am.sys_alloc_carriers_size,
+ bld_unstable_uint(hpp, szp, cs->curr.norm.sys_alloc.size));
#if HAVE_ERTS_MSEG
- add_2tup(hpp, szp, &res,
- am.mseg_alloc_carriers_size,
- bld_unstable_uint(hpp, szp, cs->curr.norm.mseg.size));
+ add_2tup(hpp, szp, &res,
+ am.mseg_alloc_carriers_size,
+ bld_unstable_uint(hpp, szp, cs->curr.norm.mseg.size));
#endif
- }
add_4tup(hpp, szp, &res,
am.carriers_size,
bld_unstable_uint(hpp, szp, curr_size),
bld_unstable_uint(hpp, szp, cs->max.size),
bld_unstable_uint(hpp, szp, cs->max_ever.size));
- if (!small_block) {
- add_2tup(hpp, szp, &res,
- am.sys_alloc_carriers,
- bld_unstable_uint(hpp, szp, cs->curr.norm.sys_alloc.no));
+ add_2tup(hpp, szp, &res,
+ am.sys_alloc_carriers,
+ bld_unstable_uint(hpp, szp, cs->curr.norm.sys_alloc.no));
#if HAVE_ERTS_MSEG
- add_2tup(hpp, szp, &res,
- am.mseg_alloc_carriers,
- bld_unstable_uint(hpp, szp, cs->curr.norm.mseg.no));
+ add_2tup(hpp, szp, &res,
+ am.mseg_alloc_carriers,
+ bld_unstable_uint(hpp, szp, cs->curr.norm.mseg.no));
#endif
- }
add_4tup(hpp, szp, &res,
am.carriers,
bld_unstable_uint(hpp, szp, curr_no),
@@ -2935,16 +4216,10 @@ info_calls(Allctr_t *allctr,
if (print_to_p) {
#define PRINT_CC_4(TO, TOA, NAME, CC) \
- if ((CC).giga_no == 0) \
- erts_print(TO, TOA, "%s calls: %b32u\n", NAME, CC.no); \
- else \
- erts_print(TO, TOA, "%s calls: %b32u%09lu\n", NAME, CC.giga_no, CC.no)
+ erts_print(TO, TOA, "%s calls: %b64u\n", NAME, CC)
#define PRINT_CC_5(TO, TOA, PRFX, NAME, CC) \
- if ((CC).giga_no == 0) \
- erts_print(TO, TOA, "%s%s calls: %b32u\n",PRFX,NAME,CC.no); \
- else \
- erts_print(TO, TOA, "%s%s calls: %b32u%09lu\n",PRFX,NAME,CC.giga_no,CC.no)
+ erts_print(TO, TOA, "%s%s calls: %b64u\n",PRFX,NAME,CC)
char *prefix = allctr->name_prefix;
int to = *print_to_p;
@@ -2954,9 +4229,6 @@ info_calls(Allctr_t *allctr,
PRINT_CC_5(to, arg, prefix, "free", allctr->calls.this_free);
PRINT_CC_5(to, arg, prefix, "realloc", allctr->calls.this_realloc);
- PRINT_CC_4(to, arg, "sbmbc_alloc", allctr->calls.sbmbc_alloc);
- PRINT_CC_4(to, arg, "sbmbc_free", allctr->calls.sbmbc_free);
-
#if HAVE_ERTS_MSEG
PRINT_CC_4(to, arg, "mseg_alloc", allctr->calls.mseg_alloc);
PRINT_CC_4(to, arg, "mseg_dealloc", allctr->calls.mseg_dealloc);
@@ -2983,50 +4255,42 @@ info_calls(Allctr_t *allctr,
add_3tup(hpp, szp, &res,
am.sys_realloc,
- bld_unstable_uint(hpp, szp, allctr->calls.sys_realloc.giga_no),
- bld_unstable_uint(hpp, szp, allctr->calls.sys_realloc.no));
+ bld_unstable_uint(hpp, szp, ERTS_ALC_CC_GIGA_VAL(allctr->calls.sys_realloc)),
+ bld_unstable_uint(hpp, szp, ERTS_ALC_CC_VAL(allctr->calls.sys_realloc)));
add_3tup(hpp, szp, &res,
am.sys_free,
- bld_unstable_uint(hpp, szp, allctr->calls.sys_free.giga_no),
- bld_unstable_uint(hpp, szp, allctr->calls.sys_free.no));
+ bld_unstable_uint(hpp, szp, ERTS_ALC_CC_GIGA_VAL(allctr->calls.sys_free)),
+ bld_unstable_uint(hpp, szp, ERTS_ALC_CC_VAL(allctr->calls.sys_free)));
add_3tup(hpp, szp, &res,
am.sys_alloc,
- bld_unstable_uint(hpp, szp, allctr->calls.sys_alloc.giga_no),
- bld_unstable_uint(hpp, szp, allctr->calls.sys_alloc.no));
+ bld_unstable_uint(hpp, szp, ERTS_ALC_CC_GIGA_VAL(allctr->calls.sys_alloc)),
+ bld_unstable_uint(hpp, szp, ERTS_ALC_CC_VAL(allctr->calls.sys_alloc)));
#if HAVE_ERTS_MSEG
add_3tup(hpp, szp, &res,
am.mseg_realloc,
- bld_unstable_uint(hpp, szp, allctr->calls.mseg_realloc.giga_no),
- bld_unstable_uint(hpp, szp, allctr->calls.mseg_realloc.no));
+ bld_unstable_uint(hpp, szp, ERTS_ALC_CC_GIGA_VAL(allctr->calls.mseg_realloc)),
+ bld_unstable_uint(hpp, szp, ERTS_ALC_CC_VAL(allctr->calls.mseg_realloc)));
add_3tup(hpp, szp, &res,
am.mseg_dealloc,
- bld_unstable_uint(hpp, szp, allctr->calls.mseg_dealloc.giga_no),
- bld_unstable_uint(hpp, szp, allctr->calls.mseg_dealloc.no));
+ bld_unstable_uint(hpp, szp, ERTS_ALC_CC_GIGA_VAL(allctr->calls.mseg_dealloc)),
+ bld_unstable_uint(hpp, szp, ERTS_ALC_CC_VAL(allctr->calls.mseg_dealloc)));
add_3tup(hpp, szp, &res,
am.mseg_alloc,
- bld_unstable_uint(hpp, szp, allctr->calls.mseg_alloc.giga_no),
- bld_unstable_uint(hpp, szp, allctr->calls.mseg_alloc.no));
+ bld_unstable_uint(hpp, szp, ERTS_ALC_CC_GIGA_VAL(allctr->calls.mseg_alloc)),
+ bld_unstable_uint(hpp, szp, ERTS_ALC_CC_VAL(allctr->calls.mseg_alloc)));
#endif
add_3tup(hpp, szp, &res,
- am.sbmbc_free,
- bld_unstable_uint(hpp, szp, allctr->calls.sbmbc_free.giga_no),
- bld_unstable_uint(hpp, szp, allctr->calls.sbmbc_free.no));
- add_3tup(hpp, szp, &res,
- am.sbmbc_alloc,
- bld_unstable_uint(hpp, szp, allctr->calls.sbmbc_alloc.giga_no),
- bld_unstable_uint(hpp, szp, allctr->calls.sbmbc_alloc.no));
- add_3tup(hpp, szp, &res,
allctr->name.realloc,
- bld_unstable_uint(hpp, szp, allctr->calls.this_realloc.giga_no),
- bld_unstable_uint(hpp, szp, allctr->calls.this_realloc.no));
+ bld_unstable_uint(hpp, szp, ERTS_ALC_CC_GIGA_VAL(allctr->calls.this_realloc)),
+ bld_unstable_uint(hpp, szp, ERTS_ALC_CC_VAL(allctr->calls.this_realloc)));
add_3tup(hpp, szp, &res,
allctr->name.free,
- bld_unstable_uint(hpp, szp, allctr->calls.this_free.giga_no),
- bld_unstable_uint(hpp, szp, allctr->calls.this_free.no));
+ bld_unstable_uint(hpp, szp, ERTS_ALC_CC_GIGA_VAL(allctr->calls.this_free)),
+ bld_unstable_uint(hpp, szp, ERTS_ALC_CC_VAL(allctr->calls.this_free)));
add_3tup(hpp, szp, &res,
allctr->name.alloc,
- bld_unstable_uint(hpp, szp, allctr->calls.this_alloc.giga_no),
- bld_unstable_uint(hpp, szp, allctr->calls.this_alloc.no));
+ bld_unstable_uint(hpp, szp, ERTS_ALC_CC_GIGA_VAL(allctr->calls.this_alloc)),
+ bld_unstable_uint(hpp, szp, ERTS_ALC_CC_VAL(allctr->calls.this_alloc)));
}
return res;
@@ -3040,6 +4304,7 @@ info_options(Allctr_t *allctr,
Uint *szp)
{
Eterm res = THE_NON_VALUE;
+ int acul;
if (!allctr) {
if (print_to_p)
@@ -3051,6 +4316,12 @@ info_options(Allctr_t *allctr,
return res;
}
+#ifdef ERTS_SMP
+ acul = allctr->cpool.util_limit;
+#else
+ acul = 0;
+#endif
+
if (print_to_p) {
char topt[21]; /* Enough for any 64-bit integer */
if (allctr->t)
@@ -3079,9 +4350,8 @@ info_options(Allctr_t *allctr,
#endif
"option lmbcs: %beu\n"
"option smbcs: %beu\n"
- "option mbcgs: %beu\n"
- "option sbmbcs: %beu\n"
- "option sbmbct: %beu\n",
+ "option mbcgs: %beu\n",
+ "option acul: %d\n",
topt,
allctr->ramv ? "true" : "false",
#if HALFWORD_HEAP
@@ -3102,8 +4372,7 @@ info_options(Allctr_t *allctr,
allctr->largest_mbc_size,
allctr->smallest_mbc_size,
allctr->mbc_growth_stages,
- allctr->sbmbc_size,
- allctr->sbmbc_threshold);
+ acul);
}
res = (*allctr->info_options)(allctr, "option ", print_to_p, print_to_arg,
@@ -3111,11 +4380,8 @@ info_options(Allctr_t *allctr,
if (hpp || szp) {
add_2tup(hpp, szp, &res,
- am.sbmbct,
- bld_uint(hpp, szp, allctr->sbmbc_threshold));
- add_2tup(hpp, szp, &res,
- am.sbmbcs,
- bld_uint(hpp, szp, allctr->sbmbc_size));
+ am.acul,
+ bld_uint(hpp, szp, (UWord) acul));
add_2tup(hpp, szp, &res,
am.mbcgs,
bld_uint(hpp, szp, allctr->mbc_growth_stages));
@@ -3261,13 +4527,17 @@ erts_alcu_info_options(Allctr_t *allctr,
Eterm
erts_alcu_sz_info(Allctr_t *allctr,
+ int internal,
int begin_max_period,
int *print_to_p,
void *print_to_arg,
Uint **hpp,
Uint *szp)
{
- Eterm res, sbmbcs, mbcs, sbcs, fix = THE_NON_VALUE;
+ Eterm res, mbcs, sbcs, fix = THE_NON_VALUE;
+#ifdef ERTS_SMP
+ Eterm mbcs_pool;
+#endif
res = THE_NON_VALUE;
@@ -3296,30 +4566,35 @@ erts_alcu_sz_info(Allctr_t *allctr,
= allctr->sbcs.curr.norm.mseg.no + allctr->sbcs.curr.norm.sys_alloc.no;
allctr->sbcs.blocks.max.no = allctr->sbcs.max.no;
- update_max_ever_values(&allctr->sbmbcs);
update_max_ever_values(&allctr->mbcs);
update_max_ever_values(&allctr->sbcs);
if (allctr->fix)
- fix = sz_info_fix(allctr, print_to_p, print_to_arg, hpp, szp);
- sbmbcs = sz_info_carriers(allctr, &allctr->sbmbcs, "sbmbcs ", print_to_p,
- print_to_arg, hpp, szp);
+ fix = sz_info_fix(allctr, internal, print_to_p, print_to_arg, hpp, szp);
mbcs = sz_info_carriers(allctr, &allctr->mbcs, "mbcs ", print_to_p,
print_to_arg, hpp, szp);
+#ifdef ERTS_SMP
+ if (ERTS_ALC_IS_CPOOL_ENABLED(allctr))
+ mbcs_pool = info_cpool(allctr, 1, "mbcs_pool ", print_to_p,
+ print_to_arg, hpp, szp);
+ else
+ mbcs_pool = THE_NON_VALUE; /* shut up annoying warning... */
+#endif
sbcs = sz_info_carriers(allctr, &allctr->sbcs, "sbcs ", print_to_p,
print_to_arg, hpp, szp);
if (hpp || szp) {
res = NIL;
add_2tup(hpp, szp, &res, am.sbcs, sbcs);
+#ifdef ERTS_SMP
+ if (ERTS_ALC_IS_CPOOL_ENABLED(allctr))
+ add_2tup(hpp, szp, &res, am.mbcs_pool, mbcs_pool);
+#endif
add_2tup(hpp, szp, &res, am.mbcs, mbcs);
- add_2tup(hpp, szp, &res, am.sbmbcs, sbmbcs);
- if (allctr->fix)
- add_2tup(hpp, szp, &res, am.fix_types, fix);
+ add_fix_types(allctr, internal, hpp, szp, &res, fix);
}
if (begin_max_period) {
- reset_max_values(&allctr->sbmbcs);
reset_max_values(&allctr->mbcs);
reset_max_values(&allctr->sbcs);
}
@@ -3338,13 +4613,17 @@ erts_alcu_sz_info(Allctr_t *allctr,
Eterm
erts_alcu_info(Allctr_t *allctr,
+ int internal,
int begin_max_period,
int *print_to_p,
void *print_to_arg,
Uint **hpp,
Uint *szp)
{
- Eterm res, sett, sbmbcs, mbcs, sbcs, calls, fix = THE_NON_VALUE;
+ Eterm res, sett, mbcs, sbcs, calls, fix = THE_NON_VALUE;
+#ifdef ERTS_SMP
+ Eterm mbcs_pool;
+#endif
res = THE_NON_VALUE;
@@ -3373,7 +4652,6 @@ erts_alcu_info(Allctr_t *allctr,
= allctr->sbcs.curr.norm.mseg.no + allctr->sbcs.curr.norm.sys_alloc.no;
allctr->sbcs.blocks.max.no = allctr->sbcs.max.no;
- update_max_ever_values(&allctr->sbmbcs);
update_max_ever_values(&allctr->mbcs);
update_max_ever_values(&allctr->sbcs);
@@ -3387,11 +4665,16 @@ erts_alcu_info(Allctr_t *allctr,
sett = info_options(allctr, print_to_p, print_to_arg, hpp, szp);
if (allctr->fix)
- fix = sz_info_fix(allctr, print_to_p, print_to_arg, hpp, szp);
- sbmbcs = info_carriers(allctr, &allctr->sbmbcs, "sbmbcs ", print_to_p,
- print_to_arg, hpp, szp);
+ fix = sz_info_fix(allctr, internal, print_to_p, print_to_arg, hpp, szp);
mbcs = info_carriers(allctr, &allctr->mbcs, "mbcs ", print_to_p,
print_to_arg, hpp, szp);
+#ifdef ERTS_SMP
+ if (ERTS_ALC_IS_CPOOL_ENABLED(allctr))
+ mbcs_pool = info_cpool(allctr, 0, "mbcs_pool ", print_to_p,
+ print_to_arg, hpp, szp);
+ else
+ mbcs_pool = THE_NON_VALUE; /* shut up annoying warning... */
+#endif
sbcs = info_carriers(allctr, &allctr->sbcs, "sbcs ", print_to_p,
print_to_arg, hpp, szp);
calls = info_calls(allctr, print_to_p, print_to_arg, hpp, szp);
@@ -3401,10 +4684,12 @@ erts_alcu_info(Allctr_t *allctr,
add_2tup(hpp, szp, &res, am.calls, calls);
add_2tup(hpp, szp, &res, am.sbcs, sbcs);
+#ifdef ERTS_SMP
+ if (ERTS_ALC_IS_CPOOL_ENABLED(allctr))
+ add_2tup(hpp, szp, &res, am.mbcs_pool, mbcs_pool);
+#endif
add_2tup(hpp, szp, &res, am.mbcs, mbcs);
- add_2tup(hpp, szp, &res, am.sbmbcs, sbmbcs);
- if (allctr->fix)
- add_2tup(hpp, szp, &res, am.fix_types, fix);
+ add_fix_types(allctr, internal, hpp, szp, &res, fix);
add_2tup(hpp, szp, &res, am.options, sett);
add_3tup(hpp, szp, &res,
am.versions,
@@ -3413,7 +4698,6 @@ erts_alcu_info(Allctr_t *allctr,
}
if (begin_max_period) {
- reset_max_values(&allctr->sbmbcs);
reset_max_values(&allctr->mbcs);
reset_max_values(&allctr->sbcs);
}
@@ -3441,22 +4725,37 @@ erts_alcu_current_size(Allctr_t *allctr, AllctrSize_t *size, ErtsAlcUFixInfo_t *
size->carriers = allctr->mbcs.curr.norm.mseg.size;
size->carriers += allctr->mbcs.curr.norm.sys_alloc.size;
- size->carriers += allctr->sbmbcs.curr.small_block.size;
size->carriers += allctr->sbcs.curr.norm.mseg.size;
size->carriers += allctr->sbcs.curr.norm.sys_alloc.size;
size->blocks = allctr->mbcs.blocks.curr.size;
- size->blocks += allctr->sbmbcs.blocks.curr.size;
size->blocks += allctr->sbcs.blocks.curr.size;
+#ifdef ERTS_SMP
+ if (ERTS_ALC_IS_CPOOL_ENABLED(allctr)) {
+ UWord csz, bsz;
+ cpool_read_stat(allctr, NULL, &csz, NULL, &bsz);
+ size->blocks += bsz;
+ size->carriers += csz;
+ }
+#endif
+
if (fi) {
int ix;
for (ix = 0; ix < fisz; ix++) {
if (allctr->fix) {
- fi[ix].allocated += (allctr->fix[ix].type_size
- * allctr->fix[ix].allocated);
- fi[ix].used += (allctr->fix[ix].type_size
- * allctr->fix[ix].used);
+ if (ERTS_ALC_IS_CPOOL_ENABLED(allctr)) {
+ fi[ix].allocated += (allctr->fix[ix].type_size
+ * allctr->fix[ix].u.cpool.allocated);
+ fi[ix].used += (allctr->fix[ix].type_size
+ * allctr->fix[ix].u.cpool.used);
+ }
+ else {
+ fi[ix].allocated += (allctr->fix[ix].type_size
+ * allctr->fix[ix].u.nocpool.allocated);
+ fi[ix].used += (allctr->fix[ix].type_size
+ * allctr->fix[ix].u.nocpool.used);
+ }
}
}
}
@@ -3474,7 +4773,6 @@ do_erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size)
{
Allctr_t *allctr = (Allctr_t *) extra;
void *res;
- ErtsAlcFixList_t *fix;
ASSERT(initialized);
@@ -3492,57 +4790,21 @@ do_erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size)
INC_CC(allctr->calls.this_alloc);
- fix = allctr->fix;
- if (fix) {
- int ix = type - ERTS_ALC_N_MIN_A_FIXED_SIZE;
- ASSERT((unsigned)ix < ERTS_ALC_NO_FIXED_SIZES);
- ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 1);
- ASSERT(size <= fix[ix].type_size);
- fix[ix].used++;
- res = fix[ix].list;
- if (res) {
- fix[ix].list_size--;
- fix[ix].list = *((void **) res);
- if (fix[ix].list && fix[ix].allocated > fix[ix].limit) {
- void *p = fix[ix].list;
- Block_t *blk;
- fix[ix].list = *((void **) p);
- fix[ix].list_size--;
- blk = UMEM2BLK(p);
- if (IS_SBC_BLK(blk))
- destroy_carrier(allctr, blk);
- else
- mbc_free(allctr, p);
- fix[ix].allocated--;
- }
- ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0);
- return res;
- }
- size = fix[ix].type_size;
- if (fix[ix].limit < fix[ix].used)
- fix[ix].limit = fix[ix].used;
- if (fix[ix].max_used < fix[ix].used)
- fix[ix].max_used = fix[ix].used;
- fix[ix].allocated++;
+ if (allctr->fix) {
+ if (ERTS_ALC_IS_CPOOL_ENABLED(allctr))
+ return fix_cpool_alloc(allctr, type, size);
+ else
+ return fix_nocpool_alloc(allctr, type, size);
}
if (size >= allctr->sbc_threshold) {
Block_t *blk;
-#ifdef ERTS_SMP
- if (allctr->dd.use)
- ERTS_ALCU_HANDLE_DD_IN_OP(allctr, 1);
-#endif
blk = create_carrier(allctr, size, CFLG_SBC);
res = blk ? BLK2UMEM(blk) : NULL;
}
else
res = mbc_alloc(allctr, size);
- if (!res && fix) {
- int ix = type - ERTS_ALC_N_MIN_A_FIXED_SIZE;
- fix[ix].allocated--;
- fix[ix].used--;
- }
return res;
}
@@ -3611,9 +4873,22 @@ erts_alcu_alloc_thr_pref(ErtsAlcType_t type, void *extra, Uint size)
if (pref_allctr->thread_safe)
erts_mtx_lock(&pref_allctr->mutex);
+#ifdef ERTS_SMP
+ ASSERT(pref_allctr->dd.use);
+ ERTS_ALCU_HANDLE_DD_IN_OP(pref_allctr, 1);
+#endif
+
ERTS_ALCU_DBG_CHK_THR_ACCESS(pref_allctr);
res = do_erts_alcu_alloc(type, pref_allctr, size);
+
+#ifdef ERTS_SMP
+ if (!res && ERTS_ALCU_HANDLE_DD_IN_OP(pref_allctr, 1)) {
+ /* Cleaned up a bit more; try one more time... */
+ res = do_erts_alcu_alloc(type, pref_allctr, size);
+ }
+#endif
+
if (pref_allctr->thread_safe)
erts_mtx_unlock(&pref_allctr->mutex);
@@ -3630,9 +4905,9 @@ erts_alcu_alloc_thr_pref(ErtsAlcType_t type, void *extra, Uint size)
/* ------------------------------------------------------------------------- */
static ERTS_INLINE void
-do_erts_alcu_free(ErtsAlcType_t type, void *extra, void *p)
+do_erts_alcu_free(ErtsAlcType_t type, void *extra, void *p,
+ Carrier_t **busy_pcrr_pp)
{
- int ix;
Allctr_t *allctr = (Allctr_t *) extra;
ASSERT(initialized);
@@ -3644,57 +4919,28 @@ do_erts_alcu_free(ErtsAlcType_t type, void *extra, void *p)
ERTS_ALCU_DBG_CHK_THR_ACCESS(allctr);
if (p) {
- ErtsAlcFixList_t *fix = allctr->fix;
- Block_t *blk;
INC_CC(allctr->calls.this_free);
- if (fix) {
- ix = type - ERTS_ALC_N_MIN_A_FIXED_SIZE;
- ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 1);
- fix[ix].used--;
- if (fix[ix].allocated < fix[ix].limit
- && fix[ix].list_size < ERTS_ALCU_FIX_MAX_LIST_SZ) {
- *((void **) p) = fix[ix].list;
- fix[ix].list = p;
- fix[ix].list_size++;
- if (!allctr->fix_shrink_scheduled) {
- allctr->fix_shrink_scheduled = 1;
- erts_set_aux_work_timeout(
- allctr->ix,
- (ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM
- | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC),
- 1);
- }
- ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0);
- return;
- }
- fix[ix].allocated--;
- if (fix[ix].list && fix[ix].allocated > fix[ix].limit) {
- blk = UMEM2BLK(p);
- if (IS_SBC_BLK(blk))
- destroy_carrier(allctr, blk);
- else
- mbc_free(allctr, p);
- p = fix[ix].list;
- fix[ix].list = *((void **) p);
- fix[ix].list_size--;
- fix[ix].allocated--;
- }
+ if (allctr->fix) {
+ if (ERTS_ALC_IS_CPOOL_ENABLED(allctr))
+ fix_cpool_free(allctr, type, p, busy_pcrr_pp);
+ else
+ fix_nocpool_free(allctr, type, p);
+ }
+ else {
+ Block_t *blk = UMEM2BLK(p);
+ if (IS_SBC_BLK(blk))
+ destroy_carrier(allctr, blk, NULL);
+ else
+ mbc_free(allctr, p, busy_pcrr_pp);
}
-
- blk = UMEM2BLK(p);
- if (IS_SBC_BLK(blk))
- destroy_carrier(allctr, blk);
- else
- mbc_free(allctr, p);
- ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0);
}
}
void erts_alcu_free(ErtsAlcType_t type, void *extra, void *p)
{
- do_erts_alcu_free(type, extra, p);
+ do_erts_alcu_free(type, extra, p, NULL);
}
#ifdef USE_THREADS
@@ -3704,7 +4950,7 @@ erts_alcu_free_ts(ErtsAlcType_t type, void *extra, void *p)
{
Allctr_t *allctr = (Allctr_t *) extra;
erts_mtx_lock(&allctr->mutex);
- do_erts_alcu_free(type, extra, p);
+ do_erts_alcu_free(type, extra, p, NULL);
erts_mtx_unlock(&allctr->mutex);
}
@@ -3726,7 +4972,7 @@ erts_alcu_free_thr_spec(ErtsAlcType_t type, void *extra, void *p)
if (allctr->thread_safe)
erts_mtx_lock(&allctr->mutex);
- do_erts_alcu_free(type, allctr, p);
+ do_erts_alcu_free(type, allctr, p, NULL);
if (allctr->thread_safe)
erts_mtx_unlock(&allctr->mutex);
@@ -3736,10 +4982,12 @@ void
erts_alcu_free_thr_pref(ErtsAlcType_t type, void *extra, void *p)
{
if (p) {
+ Carrier_t *busy_pcrr_p;
Allctr_t *pref_allctr, *used_allctr;
pref_allctr = get_pref_allctr(extra);
- used_allctr = get_used_allctr(extra, p, NULL);
+ used_allctr = get_used_allctr(pref_allctr, ERTS_ALC_TS_PREF_LOCK_IF_USED,
+ p, NULL, &busy_pcrr_p);
if (pref_allctr != used_allctr)
enqueue_dealloc_other_instance(type,
used_allctr,
@@ -3747,12 +4995,11 @@ erts_alcu_free_thr_pref(ErtsAlcType_t type, void *extra, void *p)
(used_allctr->dd.ix
- pref_allctr->dd.ix));
else {
- if (used_allctr->thread_safe)
- erts_mtx_lock(&used_allctr->mutex);
ERTS_ALCU_DBG_CHK_THR_ACCESS(used_allctr);
- do_erts_alcu_free(type, used_allctr, p);
- if (used_allctr->thread_safe)
- erts_mtx_unlock(&used_allctr->mutex);
+ do_erts_alcu_free(type, used_allctr, p, &busy_pcrr_p);
+ clear_busy_pool_carrier(used_allctr, busy_pcrr_p);
+ if (pref_allctr->thread_safe)
+ erts_mtx_unlock(&pref_allctr->mutex);
}
}
}
@@ -3768,7 +5015,8 @@ do_erts_alcu_realloc(ErtsAlcType_t type,
void *extra,
void *p,
Uint size,
- Uint32 alcu_flgs)
+ Uint32 alcu_flgs,
+ Carrier_t **busy_pcrr_pp)
{
Allctr_t *allctr = (Allctr_t *) extra;
Block_t *blk;
@@ -3793,7 +5041,7 @@ do_erts_alcu_realloc(ErtsAlcType_t type,
#if ALLOC_ZERO_EQ_NULL
if (!size) {
ASSERT(p);
- do_erts_alcu_free(type, extra, p);
+ do_erts_alcu_free(type, extra, p, busy_pcrr_pp);
INC_CC(allctr->calls.this_realloc);
DEC_CC(allctr->calls.this_free);
return NULL;
@@ -3804,32 +5052,9 @@ do_erts_alcu_realloc(ErtsAlcType_t type,
blk = UMEM2BLK(p);
- if (allctr->sbmbc_threshold > 0) {
- Uint old_sz, new_sz, lim;
- lim = allctr->sbmbc_threshold;
- old_sz = BLK_SZ(blk);
- new_sz = UMEMSZ2BLKSZ(allctr, size);
- if ((old_sz < lim && lim <= new_sz)
- || (new_sz < lim && lim <= old_sz)) {
- /* *Need* to move it... */
-
- INC_CC(allctr->calls.this_realloc);
- res = do_erts_alcu_alloc(type, extra, size);
- DEC_CC(allctr->calls.this_alloc);
-
- sys_memcpy(res, p, MIN(size, old_sz - ABLK_HDR_SZ));
-
- do_erts_alcu_free(type, extra, p);
- DEC_CC(allctr->calls.this_free);
- return res;
- }
- if (old_sz < lim)
- alcu_flgs |= ERTS_ALCU_FLG_SBMBC;
- }
-
if (size < allctr->sbc_threshold) {
if (IS_MBC_BLK(blk))
- res = mbc_realloc(allctr, p, size, alcu_flgs);
+ res = mbc_realloc(allctr, p, size, alcu_flgs, busy_pcrr_pp);
else {
Uint used_sz = SBC_HEADER_SIZE + ABLK_HDR_SZ + size;
Uint crr_sz;
@@ -3868,16 +5093,12 @@ do_erts_alcu_realloc(ErtsAlcType_t type,
sys_memcpy((void*) res,
(void*) p,
MIN(SBC_BLK_SZ(blk) - ABLK_HDR_SZ, size));
- destroy_carrier(allctr, blk);
+ destroy_carrier(allctr, blk, NULL);
}
}
}
else {
Block_t *new_blk;
-#ifdef ERTS_SMP
- if (allctr->dd.use)
- ERTS_ALCU_HANDLE_DD_IN_OP(allctr, 1);
-#endif
if(IS_SBC_BLK(blk)) {
do_carrier_resize:
#if HALFWORD_HEAP
@@ -3896,7 +5117,7 @@ do_erts_alcu_realloc(ErtsAlcType_t type,
sys_memcpy((void *) res,
(void *) p,
MIN(MBC_ABLK_SZ(blk) - ABLK_HDR_SZ, size));
- mbc_free(allctr, p);
+ mbc_free(allctr, p, busy_pcrr_pp);
}
else
res = NULL;
@@ -3910,7 +5131,7 @@ void *
erts_alcu_realloc(ErtsAlcType_t type, void *extra, void *p, Uint size)
{
void *res;
- res = do_erts_alcu_realloc(type, extra, p, size, 0);
+ res = do_erts_alcu_realloc(type, extra, p, size, 0, NULL);
DEBUG_CHECK_ALIGNMENT(res);
return res;
}
@@ -3931,7 +5152,7 @@ erts_alcu_realloc_mv(ErtsAlcType_t type, void *extra, void *p, Uint size)
if (cpy_size > size)
cpy_size = size;
sys_memcpy(res, p, cpy_size);
- do_erts_alcu_free(type, extra, p);
+ do_erts_alcu_free(type, extra, p, NULL);
}
DEBUG_CHECK_ALIGNMENT(res);
return res;
@@ -3946,7 +5167,7 @@ erts_alcu_realloc_ts(ErtsAlcType_t type, void *extra, void *ptr, Uint size)
Allctr_t *allctr = (Allctr_t *) extra;
void *res;
erts_mtx_lock(&allctr->mutex);
- res = do_erts_alcu_realloc(type, extra, ptr, size, 0);
+ res = do_erts_alcu_realloc(type, extra, ptr, size, 0, NULL);
erts_mtx_unlock(&allctr->mutex);
DEBUG_CHECK_ALIGNMENT(res);
return res;
@@ -3970,7 +5191,7 @@ erts_alcu_realloc_mv_ts(ErtsAlcType_t type, void *extra, void *p, Uint size)
if (cpy_size > size)
cpy_size = size;
sys_memcpy(res, p, cpy_size);
- do_erts_alcu_free(type, extra, p);
+ do_erts_alcu_free(type, extra, p, NULL);
}
erts_mtx_unlock(&allctr->mutex);
DEBUG_CHECK_ALIGNMENT(res);
@@ -3997,7 +5218,7 @@ erts_alcu_realloc_thr_spec(ErtsAlcType_t type, void *extra,
if (allctr->thread_safe)
erts_mtx_lock(&allctr->mutex);
- res = do_erts_alcu_realloc(type, allctr, ptr, size, 0);
+ res = do_erts_alcu_realloc(type, allctr, ptr, size, 0, NULL);
if (allctr->thread_safe)
erts_mtx_unlock(&allctr->mutex);
@@ -4040,7 +5261,7 @@ erts_alcu_realloc_mv_thr_spec(ErtsAlcType_t type, void *extra,
if (cpy_size > size)
cpy_size = size;
sys_memcpy(res, ptr, cpy_size);
- do_erts_alcu_free(type, allctr, ptr);
+ do_erts_alcu_free(type, allctr, ptr, NULL);
if (allctr->thread_safe)
erts_mtx_unlock(&allctr->mutex);
}
@@ -4057,40 +5278,64 @@ realloc_thr_pref(ErtsAlcType_t type, void *extra, void *p, Uint size,
void *res;
Allctr_t *pref_allctr, *used_allctr;
UWord old_user_size;
+ Carrier_t *busy_pcrr_p;
+#ifdef ERTS_SMP
+ int retried;
+#endif
if (!p)
return erts_alcu_alloc_thr_pref(type, extra, size);
pref_allctr = get_pref_allctr(extra);
- used_allctr = get_used_allctr(extra, p, &old_user_size);
+
+ if (pref_allctr->thread_safe)
+ erts_mtx_lock(&pref_allctr->mutex);
+
+#ifdef ERTS_SMP
+ ASSERT(pref_allctr->dd.use);
+ ERTS_ALCU_HANDLE_DD_IN_OP(pref_allctr, 1);
+ retried = 0;
+restart:
+#endif
+
+ used_allctr = get_used_allctr(pref_allctr, ERTS_ALC_TS_PREF_LOCK_NO,
+ p, &old_user_size, &busy_pcrr_p);
ASSERT(used_allctr && pref_allctr);
if (!force_move && used_allctr == pref_allctr) {
- if (used_allctr->thread_safe)
- erts_mtx_lock(&used_allctr->mutex);
ERTS_ALCU_DBG_CHK_THR_ACCESS(used_allctr);
res = do_erts_alcu_realloc(type,
used_allctr,
p,
size,
- 0);
- if (used_allctr->thread_safe)
- erts_mtx_unlock(&used_allctr->mutex);
+ 0,
+ &busy_pcrr_p);
+ clear_busy_pool_carrier(used_allctr, busy_pcrr_p);
+#ifdef ERTS_SMP
+ if (!res && !retried && ERTS_ALCU_HANDLE_DD_IN_OP(pref_allctr, 1)) {
+ /* Cleaned up a bit more; try one more time... */
+ retried = 1;
+ goto restart;
+ }
+#endif
+ if (pref_allctr->thread_safe)
+ erts_mtx_unlock(&pref_allctr->mutex);
}
else {
- if (pref_allctr->thread_safe)
- erts_mtx_lock(&pref_allctr->mutex);
res = do_erts_alcu_alloc(type, pref_allctr, size);
- if (pref_allctr->thread_safe && used_allctr != pref_allctr) {
- erts_mtx_unlock(&pref_allctr->mutex);
- }
- if (res) {
- DEBUG_CHECK_ALIGNMENT(res);
+ if (!res)
+ goto unlock_ts_return;
+ else {
- sys_memcpy(res, p, MIN(size,old_user_size));
+ DEBUG_CHECK_ALIGNMENT(res);
if (used_allctr != pref_allctr) {
+ if (pref_allctr->thread_safe)
+ erts_mtx_unlock(&pref_allctr->mutex);
+
+ sys_memcpy(res, p, MIN(size, old_user_size));
+
enqueue_dealloc_other_instance(type,
used_allctr,
p,
@@ -4098,8 +5343,14 @@ realloc_thr_pref(ErtsAlcType_t type, void *extra, void *p, Uint size,
- pref_allctr->dd.ix));
}
else {
- do_erts_alcu_free(type, used_allctr, p);
+
+ sys_memcpy(res, p, MIN(size, old_user_size));
+
+ do_erts_alcu_free(type, used_allctr, p, &busy_pcrr_p);
ASSERT(pref_allctr == used_allctr);
+ clear_busy_pool_carrier(used_allctr, busy_pcrr_p);
+
+ unlock_ts_return:
if (pref_allctr->thread_safe)
erts_mtx_unlock(&pref_allctr->mutex);
}
@@ -4213,6 +5464,17 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
if (sz > allctr->min_block_size)
allctr->min_block_size = sz;
}
+
+ allctr->cpool.dc_list.first = NULL;
+ allctr->cpool.dc_list.last = NULL;
+ allctr->cpool.abandon_limit = 0;
+ allctr->cpool.disable_abandon = 0;
+ erts_atomic_init_nob(&allctr->cpool.stat.blocks_size, 0);
+ erts_atomic_init_nob(&allctr->cpool.stat.no_blocks, 0);
+ erts_atomic_init_nob(&allctr->cpool.stat.carriers_size, 0);
+ erts_atomic_init_nob(&allctr->cpool.stat.no_carriers, 0);
+ allctr->cpool.check_limit_count = ERTS_ALC_CPOOL_CHECK_LIMIT_COUNT;
+ allctr->cpool.util_limit = init->acul;
#endif
allctr->sbc_threshold = init->sbct;
@@ -4232,27 +5494,6 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
}
#endif
-
-
- allctr->sbmbc_threshold = init->sbmbct;
-
- if (!erts_have_sbmbc_alloc
- || ERTS_IS_SBMBC_ALLOCATOR_NO__(allctr->alloc_no))
- allctr->sbmbc_threshold = 0;
-
- if (!allctr->sbmbc_threshold)
- allctr->sbmbc_size = 0;
- else {
- Uint min_size;
- allctr->sbmbc_size = init->sbmbcs;
- min_size = allctr->sbmbc_threshold;
- min_size += allctr->min_block_size;
- min_size += MBC_HEADER_SIZE(allctr);
- if (allctr->sbmbc_size < min_size)
- allctr->sbmbc_size = min_size;
- }
-
-
#if HAVE_ERTS_MSEG
if (allctr->mseg_opt.abs_shrink_th > ~((UWord) 0) / 100)
allctr->mseg_opt.abs_shrink_th = ~((UWord) 0) / 100;
@@ -4264,16 +5505,12 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
#ifdef ERTS_ENABLE_LOCK_COUNT
erts_mtx_init_x_opt(&allctr->mutex,
- ERTS_IS_SBMBC_ALLOCATOR_NO__(allctr->alloc_no)
- ? "sbmbc_alloc"
- : "alcu_allocator",
+ "alcu_allocator",
make_small(allctr->alloc_no),
ERTS_LCNT_LT_ALLOC);
#else
erts_mtx_init_x(&allctr->mutex,
- ERTS_IS_SBMBC_ALLOCATOR_NO__(allctr->alloc_no)
- ? "sbmbc_alloc"
- : "alcu_allocator",
+ "alcu_allocator",
make_small(allctr->alloc_no));
#endif /*ERTS_ENABLE_LOCK_COUNT*/
@@ -4292,6 +5529,8 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
if (!allctr->get_next_mbc_size)
allctr->get_next_mbc_size = get_next_mbc_size;
+ if (allctr->mbc_header_size < sizeof(Carrier_t))
+ goto error;
#ifdef ERTS_SMP
allctr->dd.use = 0;
if (init->tpref) {
@@ -4300,6 +5539,9 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
allctr->dd.ix = init->ix;
}
#endif
+ allctr->mbc_header_size = (UNIT_CEILING(allctr->mbc_header_size
+ + ABLK_HDR_SZ)
+ - ABLK_HDR_SZ);
if (allctr->main_carrier_size) {
Block_t *blk;
@@ -4308,6 +5550,7 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
allctr->main_carrier_size,
CFLG_MBC
| CFLG_FORCE_SIZE
+ | CFLG_NO_CPOOL
#if !HALFWORD_HEAP && !HAVE_SUPER_ALIGNED_MB_CARRIERS
| CFLG_FORCE_SYS_ALLOC
#endif
@@ -4315,7 +5558,7 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
if (!blk)
goto error;
- (*allctr->link_free_block)(allctr, blk, 0);
+ (*allctr->link_free_block)(allctr, blk);
HARD_CHECK_BLK_CARRIER(allctr, blk);
@@ -4326,16 +5569,24 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
allctr->fix = init->fix;
allctr->fix_shrink_scheduled = 0;
for (i = 0; i < ERTS_ALC_NO_FIXED_SIZES; i++) {
- allctr->fix[i].max_used = 0;
- allctr->fix[i].limit = 0;
allctr->fix[i].type_size = init->fix_type_size[i];
allctr->fix[i].list_size = 0;
allctr->fix[i].list = NULL;
- allctr->fix[i].allocated = 0;
- allctr->fix[i].used = 0;
#ifdef ERTS_SMP
ASSERT(allctr->fix[i].type_size >= sizeof(ErtsAllctrFixDDBlock_t));
#endif
+ if (ERTS_ALC_IS_CPOOL_ENABLED(allctr)) {
+ allctr->fix[i].u.cpool.min_list_size = 0;
+ allctr->fix[i].u.cpool.shrink_list = 0;
+ allctr->fix[i].u.cpool.allocated = 0;
+ allctr->fix[i].u.cpool.used = 0;
+ }
+ else {
+ allctr->fix[i].u.nocpool.max_used = 0;
+ allctr->fix[i].u.nocpool.limit = 0;
+ allctr->fix[i].u.nocpool.allocated = 0;
+ allctr->fix[i].u.nocpool.used = 0;
+ }
}
}
@@ -4360,11 +5611,9 @@ erts_alcu_stop(Allctr_t *allctr)
allctr->stopped = 1;
while (allctr->sbc_list.first)
- destroy_carrier(allctr, SBC2BLK(allctr, allctr->sbc_list.first));
+ destroy_carrier(allctr, SBC2BLK(allctr, allctr->sbc_list.first), NULL);
while (allctr->mbc_list.first)
- destroy_carrier(allctr, MBC_TO_FIRST_BLK(allctr, allctr->mbc_list.first));
- while (allctr->sbmbc_list.first)
- destroy_sbmbc(allctr, MBC_TO_FIRST_BLK(allctr, allctr->sbmbc_list.first));
+ destroy_carrier(allctr, MBC_TO_FIRST_BLK(allctr, allctr->mbc_list.first), NULL);
#ifdef USE_THREADS
if (allctr->thread_safe)
@@ -4378,6 +5627,14 @@ erts_alcu_stop(Allctr_t *allctr)
void
erts_alcu_init(AlcUInit_t *init)
{
+#ifdef ERTS_SMP
+ int i;
+ for (i = 0; i <= ERTS_ALC_A_MAX; i++) {
+ ErtsAlcCPoolData_t *sentinel = &carrier_pool[i].sentinel;
+ erts_atomic_init_nob(&sentinel->next, (erts_aint_t) sentinel);
+ erts_atomic_init_nob(&sentinel->prev, (erts_aint_t) sentinel);
+ }
+#endif
ASSERT(SBC_BLK_SZ_MASK == MBC_FBLK_SZ_MASK); /* see BLK_SZ */
#if HAVE_ERTS_MSEG
ASSERT(erts_mseg_unit_size() == MSEG_UNIT_SZ);
@@ -4440,8 +5697,35 @@ erts_alcu_test(UWord op, UWord a1, UWord a2)
case 0x019: return (UWord) PREV_BLK((Block_t *) a1);
case 0x01a: return (UWord) IS_MBC_FIRST_BLK((Allctr_t*)a1, (Block_t *) a2);
case 0x01b: return (UWord) sizeof(Unit_t);
+ case 0x01c: return (unsigned long) BLK_TO_MBC((Block_t*) a1);
+ case 0x01d: ((Allctr_t*) a1)->add_mbc((Allctr_t*)a1, (Carrier_t*)a2); break;
+ case 0x01e: ((Allctr_t*) a1)->remove_mbc((Allctr_t*)a1, (Carrier_t*)a2); break;
+#ifdef ERTS_SMP
+ case 0x01f: return (UWord) sizeof(ErtsAlcCrrPool_t);
+ case 0x020:
+ SET_CARRIER_HDR((Carrier_t *) a2, 0, SCH_SYS_ALLOC|SCH_MBC, (Allctr_t *) a1);
+ cpool_init_carrier_data((Allctr_t *) a1, (Carrier_t *) a2);
+ return (UWord) a2;
+ case 0x021:
+ cpool_insert((Allctr_t *) a1, (Carrier_t *) a2);
+ return (UWord) a2;
+ case 0x022:
+ cpool_delete((Allctr_t *) a1, (Allctr_t *) a1, (Carrier_t *) a2);
+ return (UWord) a2;
+ case 0x023: return (UWord) cpool_is_empty((Allctr_t *) a1);
+ case 0x024: return (UWord) cpool_dbg_is_in_pool((Allctr_t *) a1, (Carrier_t *) a2);
+#else
+ case 0x01f: return (UWord) 0;
+ case 0x020: return (UWord) 0;
+ case 0x021: return (UWord) 0;
+ case 0x022: return (UWord) 0;
+ case 0x023: return (UWord) 0;
+ case 0x024: return (UWord) 0;
+#endif
+
default: ASSERT(0); return ~((UWord) 0);
}
+ return 0;
}
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
@@ -4449,6 +5733,20 @@ erts_alcu_test(UWord op, UWord a1, UWord a2)
\* */
void
+erts_alcu_assert_failed(char* expr, char* file, int line, char *func)
+{
+ fflush(stdout);
+ fprintf(stderr, "%s:%d:%s(): Assertion failed: %s\n",
+ file, line, func, expr);
+ fflush(stderr);
+#if defined(__WIN__) || defined(__WIN32__)
+ DebugBreak();
+#else
+ abort();
+#endif
+}
+
+void
erts_alcu_verify_unused(Allctr_t *allctr)
{
UWord no;
@@ -4456,12 +5754,10 @@ erts_alcu_verify_unused(Allctr_t *allctr)
no = allctr->sbcs.curr.norm.mseg.no;
no += allctr->sbcs.curr.norm.sys_alloc.no;
no += allctr->mbcs.blocks.curr.no;
- no += allctr->sbmbcs.blocks.curr.no;
if (no) {
UWord sz = allctr->sbcs.blocks.curr.size;
sz += allctr->mbcs.blocks.curr.size;
- sz += allctr->sbmbcs.blocks.curr.size;
erl_exit(ERTS_ABORT_EXIT,
"%salloc() used when expected to be unused!\n"
"Total amount of blocks allocated: %bpu\n"
@@ -4595,7 +5891,7 @@ check_blk_carrier(Allctr_t *allctr, Block_t *iblk)
cl = &allctr->mbc_list;
}
-#if 0 /* FIXIT sbmbc */
+#ifdef DEBUG
if (cl->first == crr) {
ASSERT(!crr->prev);
}
diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h
index 4773598561..5e52b9b733 100644
--- a/erts/emulator/beam/erl_alloc_util.h
+++ b/erts/emulator/beam/erl_alloc_util.h
@@ -55,8 +55,7 @@ typedef struct {
UWord lmbcs;
UWord smbcs;
UWord mbcgs;
- UWord sbmbct;
- UWord sbmbcs;
+ int acul;
void *fix;
size_t *fix_type_size;
@@ -100,8 +99,7 @@ typedef struct {
10*1024*1024, /* (bytes) lmbcs: largest mbc size */\
1024*1024, /* (bytes) smbcs: smallest mbc size */\
10, /* (amount) mbcgs: mbc growth stages */\
- 256, /* (bytes) sbmbct: small block mbc threshold */\
- 8*1024, /* (bytes) sbmbcs: small block mbc size */ \
+ 0, /* (%) acul: abandon carrier utilization limit */\
/* --- Data not options -------------------------------------------- */\
NULL, /* (ptr) fix */\
NULL /* (ptr) fix_type_size */\
@@ -134,8 +132,7 @@ typedef struct {
1024*1024, /* (bytes) lmbcs: largest mbc size */\
128*1024, /* (bytes) smbcs: smallest mbc size */\
10, /* (amount) mbcgs: mbc growth stages */\
- 256, /* (bytes) sbmbct: small block mbc threshold */\
- 8*1024, /* (bytes) sbmbcs: small block mbc size */ \
+ 0, /* (%) acul: abandon carrier utilization limit */\
/* --- Data not options -------------------------------------------- */\
NULL, /* (ptr) fix */\
NULL /* (ptr) fix_type_size */\
@@ -165,8 +162,8 @@ void erts_alcu_free_thr_pref(ErtsAlcType_t, void *, void *);
#endif
Eterm erts_alcu_au_info_options(int *, void *, Uint **, Uint *);
Eterm erts_alcu_info_options(Allctr_t *, int *, void *, Uint **, Uint *);
-Eterm erts_alcu_sz_info(Allctr_t *, int, int *, void *, Uint **, Uint *);
-Eterm erts_alcu_info(Allctr_t *, int, int *, void *, Uint **, Uint *);
+Eterm erts_alcu_sz_info(Allctr_t *, int, int, int *, void *, Uint **, Uint *);
+Eterm erts_alcu_info(Allctr_t *, int, int, int *, void *, Uint **, Uint *);
void erts_alcu_init(AlcUInit_t *);
void erts_alcu_current_size(Allctr_t *, AllctrSize_t *,
ErtsAlcUFixInfo_t *, int);
@@ -181,7 +178,6 @@ erts_aint32_t erts_alcu_fix_alloc_shrink(Allctr_t *, erts_aint32_t);
#define ERL_ALLOC_UTIL_IMPL__
#define ERTS_ALCU_FLG_FAIL_REALLOC_MOVE (((Uint32) 1) << 0)
-#define ERTS_ALCU_FLG_SBMBC (((Uint32) 1) << 1)
#ifdef USE_THREADS
#define ERL_THREADS_EMU_INTERNAL__
@@ -221,8 +217,15 @@ erts_aint32_t erts_alcu_fix_alloc_shrink(Allctr_t *, erts_aint32_t);
#define MBC_FBLK_SZ_MASK UNIT_MASK
#define CARRIER_SZ_MASK UNIT_MASK
-
#if HAVE_ERTS_MSEG
+
+# define MSEG_UNIT_SHIFT MSEG_ALIGN_BITS
+# define MSEG_UNIT_SZ (1 << MSEG_UNIT_SHIFT)
+# define MSEG_UNIT_MASK ((~(UWord)0) << MSEG_UNIT_SHIFT)
+
+# define MSEG_UNIT_FLOOR(X) ((X) & MSEG_UNIT_MASK)
+# define MSEG_UNIT_CEILING(X) MSEG_UNIT_FLOOR((X) + ~MSEG_UNIT_MASK)
+
# ifdef ARCH_64
# define MBC_ABLK_OFFSET_BITS 24
# elif HAVE_SUPER_ALIGNED_MB_CARRIERS
@@ -238,10 +241,8 @@ erts_aint32_t erts_alcu_fix_alloc_shrink(Allctr_t *, erts_aint32_t);
# define MBC_ABLK_OFFSET_SHIFT (sizeof(UWord)*8 - MBC_ABLK_OFFSET_BITS)
# define MBC_ABLK_OFFSET_MASK (~((UWord)0) << MBC_ABLK_OFFSET_SHIFT)
# define MBC_ABLK_SZ_MASK (~MBC_ABLK_OFFSET_MASK & ~FLG_MASK)
-# define HAVE_ERTS_SBMBC 0
#else
# define MBC_ABLK_SZ_MASK (~FLG_MASK)
-# define HAVE_ERTS_SBMBC 1
#endif
#define MBC_ABLK_SZ(B) (ASSERT_EXPR(!is_sbc_blk(B)), (B)->bhdr & MBC_ABLK_SZ_MASK)
@@ -251,18 +252,37 @@ erts_aint32_t erts_alcu_fix_alloc_shrink(Allctr_t *, erts_aint32_t);
#define CARRIER_SZ(C) \
((C)->chdr & CARRIER_SZ_MASK)
-extern int erts_have_sbmbc_alloc;
-
typedef union {char c[ERTS_ALLOC_ALIGN_BYTES]; long l; double d;} Unit_t;
+#ifdef ERTS_SMP
+
+typedef struct {
+ erts_atomic_t next;
+ erts_atomic_t prev;
+ Allctr_t *orig_allctr;
+ ErtsThrPrgrVal thr_prgr;
+ erts_atomic_t max_size;
+ UWord abandon_limit;
+ UWord blocks;
+ UWord blocks_size;
+} ErtsAlcCPoolData_t;
+
+#endif
+
typedef struct Carrier_t_ Carrier_t;
struct Carrier_t_ {
UWord chdr;
Carrier_t *next;
Carrier_t *prev;
- Allctr_t *allctr;
+ erts_smp_atomic_t allctr;
+#ifdef ERTS_SMP
+ ErtsAlcCPoolData_t cpool; /* Overwritten by block if sbc */
+#endif
};
+#define ERTS_ALC_CARRIER_TO_ALLCTR(C) \
+ ((Allctr_t *) (erts_smp_atomic_read_nob(&(C)->allctr) & ~FLG_MASK))
+
typedef struct {
Carrier_t *first;
Carrier_t *last;
@@ -280,12 +300,46 @@ typedef struct {
#endif
} Block_t;
+#define THIS_FREE_BLK_HDR_FLG (((UWord) 1) << 0)
+#define PREV_FREE_BLK_HDR_FLG (((UWord) 1) << 1)
+#define LAST_BLK_HDR_FLG (((UWord) 1) << 2)
+
+#define SBC_BLK_HDR_FLG /* Special flag combo for (allocated) SBC blocks */\
+ (THIS_FREE_BLK_HDR_FLG | PREV_FREE_BLK_HDR_FLG | LAST_BLK_HDR_FLG)
+
+/*
+ * FREE_LAST_MBC_BLK_HDR_FLGS is a special flag combo used for
+ * distinguishing empty mbc's from allocated blocks in
+ * handle_delayed_dealloc().
+ */
+#define FREE_LAST_MBC_BLK_HDR_FLGS (THIS_FREE_BLK_HDR_FLG | LAST_BLK_HDR_FLG)
+
+#define IS_FREE_LAST_MBC_BLK(B) \
+ (((B)->bhdr & FLG_MASK) == FREE_LAST_MBC_BLK_HDR_FLGS)
+
+#define IS_SBC_BLK(B) (((B)->bhdr & FLG_MASK) == SBC_BLK_HDR_FLG)
+#define IS_MBC_BLK(B) (!IS_SBC_BLK((B)))
+#define IS_FREE_BLK(B) (ASSERT(IS_MBC_BLK(B)), \
+ (B)->bhdr & THIS_FREE_BLK_HDR_FLG)
+
+#if MBC_ABLK_OFFSET_BITS
+# define FBLK_TO_MBC(B) (ASSERT(IS_MBC_BLK(B) && IS_FREE_BLK(B)), \
+ (B)->u.carrier)
+# define ABLK_TO_MBC(B) \
+ (ASSERT(IS_MBC_BLK(B) && !IS_FREE_BLK(B)), \
+ (Carrier_t*)((MSEG_UNIT_FLOOR((UWord)(B)) - \
+ (((B)->bhdr >> MBC_ABLK_OFFSET_SHIFT) << MSEG_UNIT_SHIFT))))
+# define BLK_TO_MBC(B) (IS_FREE_BLK(B) ? FBLK_TO_MBC(B) : ABLK_TO_MBC(B))
+#else
+# define FBLK_TO_MBC(B) ((B)->carrier)
+# define ABLK_TO_MBC(B) ((B)->carrier)
+# define BLK_TO_MBC(B) ((B)->carrier)
+#endif
+#define MBC_BLK_SZ(B) (IS_FREE_BLK(B) ? MBC_FBLK_SZ(B) : MBC_ABLK_SZ(B))
+
typedef UWord FreeBlkFtr_t; /* Footer of a free block */
-typedef struct {
- UWord giga_no;
- UWord no;
-} CallCounter_t;
+typedef Uint64 CallCounter_t;
typedef struct {
UWord no;
@@ -298,7 +352,6 @@ typedef struct {
StatValues_t mseg;
StatValues_t sys_alloc;
} norm;
- StatValues_t small_block;
} curr;
StatValues_t max;
StatValues_t max_ever;
@@ -358,10 +411,20 @@ typedef struct {
size_t type_size;
SWord list_size;
void *list;
- SWord max_used;
- SWord limit;
- SWord allocated;
- SWord used;
+ union {
+ struct {
+ SWord max_used;
+ SWord limit;
+ SWord allocated;
+ SWord used;
+ } nocpool;
+ struct {
+ int min_list_size;
+ int shrink_list;
+ UWord allocated;
+ UWord used;
+ } cpool;
+ } u;
} ErtsAlcFixList_t;
struct Allctr_t_ {
@@ -409,37 +472,56 @@ struct Allctr_t_ {
Uint largest_mbc_size;
Uint smallest_mbc_size;
Uint mbc_growth_stages;
- Uint sbmbc_threshold;
- Uint sbmbc_size;
#if HAVE_ERTS_MSEG
ErtsMsegOpt_t mseg_opt;
#endif
/* */
+ Uint mbc_header_size;
Uint min_mbc_size;
Uint min_mbc_first_free_size;
Uint min_block_size;
/* Carriers */
- CarrierList_t sbmbc_list;
CarrierList_t mbc_list;
CarrierList_t sbc_list;
+#ifdef ERTS_SMP
+ struct {
+ CarrierList_t dc_list;
+ UWord abandon_limit;
+ int disable_abandon;
+ int check_limit_count;
+ int util_limit;
+ struct {
+ erts_atomic_t blocks_size;
+ erts_atomic_t no_blocks;
+ erts_atomic_t carriers_size;
+ erts_atomic_t no_carriers;
+ } stat;
+ } cpool;
+#endif
/* Main carrier (if there is one) */
Carrier_t * main_carrier;
/* Callback functions (first 4 are mandatory) */
Block_t * (*get_free_block) (Allctr_t *, Uint,
- Block_t *, Uint, Uint32);
- void (*link_free_block) (Allctr_t *, Block_t *, Uint32);
- void (*unlink_free_block) (Allctr_t *, Block_t *, Uint32);
+ Block_t *, Uint);
+ void (*link_free_block) (Allctr_t *, Block_t *);
+ void (*unlink_free_block) (Allctr_t *, Block_t *);
Eterm (*info_options) (Allctr_t *, char *, int *,
void *, Uint **, Uint *);
Uint (*get_next_mbc_size) (Allctr_t *);
- void (*creating_mbc) (Allctr_t *, Carrier_t *, Uint32);
- void (*destroying_mbc) (Allctr_t *, Carrier_t *, Uint32);
+ void (*creating_mbc) (Allctr_t *, Carrier_t *);
+ void (*destroying_mbc) (Allctr_t *, Carrier_t *);
+
+ /* The three callbacks below are needed to support carrier migration */
+ void (*add_mbc) (Allctr_t *, Carrier_t *);
+ void (*remove_mbc) (Allctr_t *, Carrier_t *);
+ UWord (*largest_fblk_in_mbc) (Allctr_t *, Carrier_t *);
+
void (*init_atoms) (void);
#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG
@@ -471,8 +553,6 @@ struct Allctr_t_ {
CallCounter_t this_alloc;
CallCounter_t this_free;
CallCounter_t this_realloc;
- CallCounter_t sbmbc_alloc;
- CallCounter_t sbmbc_free;
CallCounter_t mseg_alloc;
CallCounter_t mseg_dealloc;
CallCounter_t mseg_realloc;
@@ -483,8 +563,7 @@ struct Allctr_t_ {
CarriersStats_t sbcs;
CarriersStats_t mbcs;
- CarriersStats_t sbmbcs;
-
+
#ifdef DEBUG
#ifdef USE_THREADS
struct {
@@ -503,6 +582,8 @@ void erts_alcu_verify_unused_ts(Allctr_t *allctr);
UWord erts_alcu_test(UWord, UWord, UWord);
+void erts_alcu_assert_failed(char* expr, char* file, int line, char *func);
+
#ifdef DEBUG
int is_sbc_blk(Block_t*);
#endif
diff --git a/erts/emulator/beam/erl_ao_firstfit_alloc.c b/erts/emulator/beam/erl_ao_firstfit_alloc.c
index b916cb6198..f73ac2eb6e 100644
--- a/erts/emulator/beam/erl_ao_firstfit_alloc.c
+++ b/erts/emulator/beam/erl_ao_firstfit_alloc.c
@@ -28,11 +28,16 @@
*
* This module is a callback-module for erl_alloc_util.c
*
- * Algorithm: The tree nodes are free-blocks ordered in address order.
+ * AOFF Algorithm:
+ * The tree nodes are ordered in address order.
* Every node also keeps the size of the largest block in its
- * sub-tree ('max_size'). By that we can start from root and keep
+ * sub-tree ('max_sz'). By that we can start from root and keep
* left (for low addresses) while dismissing entire sub-trees with
* too small blocks.
+ * AOFFCBF:
+ * The only difference for "bestfit within carrier" is the tree
+ * sorting order. Blocks within the same carrier are sorted
+ * wrt size instead of address.
*
* Authors: Rickard Green/Sverker Eriksson
*/
@@ -85,21 +90,45 @@ typedef struct AOFF_RBTree_t_ AOFF_RBTree_t;
struct AOFF_RBTree_t_ {
Block_t hdr;
- Uint flags;
AOFF_RBTree_t *parent;
AOFF_RBTree_t *left;
AOFF_RBTree_t *right;
- Uint max_sz; /* of all blocks in this sub-tree */
+ Uint32 flags;
+ Uint32 max_sz; /* of all blocks in this sub-tree */
};
#define AOFF_BLK_SZ(B) MBC_FBLK_SZ(&(B)->hdr)
+typedef struct AOFF_Carrier_t_ AOFF_Carrier_t;
+
+struct AOFF_Carrier_t_ {
+ Carrier_t crr;
+ AOFF_RBTree_t rbt_node; /* My node in the carrier tree */
+ AOFF_RBTree_t* root; /* Root of my block tree */
+};
+#define RBT_NODE_TO_MBC(PTR) ((AOFF_Carrier_t*)((char*)(PTR) - offsetof(AOFF_Carrier_t, rbt_node)))
+
+/*
+ To support carrier migration we keep two kinds of rb-trees:
+ 1. One tree of carriers for each allocator instance.
+ 2. One tree of free blocks for each carrier.
+ Both trees use the same node structure AOFF_RBTree_t and implementation.
+ Carrier nodes thus contain a phony Block_t header 'rbt_node.hdr'.
+ The size value of such a phony block is the size of the largest free block in
+ that carrier, i.e same as 'max_sz' of the root node of its block tree.
+*/
+
#ifdef HARD_DEBUG
-static AOFF_RBTree_t * check_tree(AOFF_RBTree_t* root, Uint);
+# define HARD_CHECK_IS_MEMBER(ROOT,NODE) rbt_assert_is_member(ROOT,NODE)
+# define HARD_CHECK_TREE(CRR,BF,ROOT,SZ) check_tree(CRR, BF, ROOT, SZ)
+static AOFF_RBTree_t * check_tree(Carrier_t* within_crr, int bestfit, AOFF_RBTree_t* root, Uint);
+#else
+# define HARD_CHECK_IS_MEMBER(ROOT,NODE)
+# define HARD_CHECK_TREE(CRR,BF,ROOT,SZ)
#endif
-/* Calculate 'max_size' of tree node x by only looking at the direct children
- * of x and x itself.
+/* Calculate 'max_sz' of tree node x by only looking at 'max_sz' of the
+ * direct children of x and the size x itself.
*/
static ERTS_INLINE Uint node_max_size(AOFF_RBTree_t *x)
{
@@ -113,7 +142,7 @@ static ERTS_INLINE Uint node_max_size(AOFF_RBTree_t *x)
return sz;
}
-/* Set new possibly lower 'max_size' of node and propagate change toward root
+/* Set new possibly lower 'max_sz' of node and propagate change toward root
*/
static ERTS_INLINE void lower_max_size(AOFF_RBTree_t *node,
AOFF_RBTree_t* stop_at)
@@ -132,32 +161,53 @@ static ERTS_INLINE void lower_max_size(AOFF_RBTree_t *node,
else ASSERT(new_max == old_max);
}
+static ERTS_INLINE SWord cmp_blocks(int bestfit,
+ AOFF_RBTree_t* lhs, AOFF_RBTree_t* rhs)
+{
+ ASSERT(lhs != rhs);
+ ASSERT(!bestfit || FBLK_TO_MBC(&lhs->hdr) == FBLK_TO_MBC(&rhs->hdr));
+ if (bestfit) {
+ SWord diff = (SWord)AOFF_BLK_SZ(lhs) - (SWord)AOFF_BLK_SZ(rhs);
+ if (diff) return diff;
+ }
+ return (char*)lhs - (char*)rhs;
+}
+
+static ERTS_INLINE SWord cmp_cand_blk(int bestfit,
+ Block_t* cand_blk, AOFF_RBTree_t* rhs)
+{
+ if (bestfit) {
+ if (BLK_TO_MBC(cand_blk) == FBLK_TO_MBC(&rhs->hdr)) {
+ SWord diff = (SWord)MBC_BLK_SZ(cand_blk) - (SWord)MBC_FBLK_SZ(&rhs->hdr);
+ if (diff) return diff;
+ }
+ }
+ return (char*)cand_blk - (char*)rhs;
+}
+
/* Prototypes of callback functions */
-static Block_t* aoff_get_free_block(Allctr_t *, Uint, Block_t *, Uint, Uint32 flags);
-static void aoff_link_free_block(Allctr_t *, Block_t*, Uint32 flags);
-static void aoff_unlink_free_block(Allctr_t *allctr, Block_t *del, Uint32 flags);
+static Block_t* aoff_get_free_block(Allctr_t *, Uint, Block_t *, Uint);
+static void aoff_link_free_block(Allctr_t *, Block_t*);
+static void aoff_unlink_free_block(Allctr_t *allctr, Block_t *del);
+static void aoff_creating_mbc(Allctr_t*, Carrier_t*);
+static void aoff_destroying_mbc(Allctr_t*, Carrier_t*);
+static void aoff_add_mbc(Allctr_t*, Carrier_t*);
+static void aoff_remove_mbc(Allctr_t*, Carrier_t*);
+static UWord aoff_largest_fblk_in_mbc(Allctr_t*, Carrier_t*);
+
+/* Generic tree functions used by both carrier and block trees. */
+static void rbt_delete(AOFF_RBTree_t** root, AOFF_RBTree_t* del);
+static void rbt_insert(int bestfit, AOFF_RBTree_t** root, AOFF_RBTree_t* blk);
+static AOFF_RBTree_t* rbt_search(AOFF_RBTree_t* root, Uint size);
+#ifdef HARD_DEBUG
+static int rbt_assert_is_member(AOFF_RBTree_t* root, AOFF_RBTree_t* node);
+#endif
static Eterm info_options(Allctr_t *, char *, int *, void *, Uint **, Uint *);
static void init_atoms(void);
-
-#ifdef DEBUG
-
-/* Destroy all tree fields */
-#define DESTROY_TREE_NODE(N) \
- sys_memset((void *) (((Block_t *) (N)) + 1), \
- 0xff, \
- (sizeof(AOFF_RBTree_t) - sizeof(Block_t)))
-
-#else
-
-#define DESTROY_TREE_NODE(N)
-
-#endif
-
-
static int atoms_initialized = 0;
void
@@ -184,11 +234,14 @@ erts_aoffalc_start(AOFFAllctr_t *alc,
sys_memcpy((void *) alc, (void *) &zero.allctr, sizeof(AOFFAllctr_t));
+ alc->bf_within_carrier = aoffinit->bf_within_carrier;
+ allctr->mbc_header_size = sizeof(AOFF_Carrier_t);
allctr->min_mbc_size = MIN_MBC_SZ;
allctr->min_mbc_first_free_size = MIN_MBC_FIRST_FREE_SZ;
allctr->min_block_size = sizeof(AOFF_RBTree_t);
- allctr->vsn_str = ERTS_ALC_AOFF_ALLOC_VSN_STR;
+ allctr->vsn_str = aoffinit->bf_within_carrier ?
+ ERTS_ALC_AOFF_CBF_ALLOC_VSN_STR : ERTS_ALC_AOFF_ALLOC_VSN_STR;
/* Callback functions */
@@ -199,8 +252,11 @@ erts_aoffalc_start(AOFFAllctr_t *alc,
allctr->info_options = info_options;
allctr->get_next_mbc_size = NULL;
- allctr->creating_mbc = NULL;
- allctr->destroying_mbc = NULL;
+ allctr->creating_mbc = aoff_creating_mbc;
+ allctr->destroying_mbc = aoff_destroying_mbc;
+ allctr->add_mbc = aoff_add_mbc;
+ allctr->remove_mbc = aoff_remove_mbc;
+ allctr->largest_fblk_in_mbc = aoff_largest_fblk_in_mbc;
allctr->init_atoms = init_atoms;
#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG
@@ -306,7 +362,6 @@ replace(AOFF_RBTree_t **root, AOFF_RBTree_t *x, AOFF_RBTree_t *y)
y->max_sz = x->max_sz;
lower_max_size(y, NULL);
- DESTROY_TREE_NODE(x);
}
static void
@@ -403,21 +458,47 @@ tree_insert_fixup(AOFF_RBTree_t** root, AOFF_RBTree_t *blk)
}
static void
-aoff_unlink_free_block(Allctr_t *allctr, Block_t *del, Uint32 flags)
+aoff_unlink_free_block(Allctr_t *allctr, Block_t *del)
+{
+#ifdef HARD_DEBUG
+ AOFFAllctr_t* alc = (AOFFAllctr_t*)allctr;
+#endif
+ AOFF_Carrier_t *crr = (AOFF_Carrier_t*) FBLK_TO_MBC(del);
+
+ ASSERT(crr->rbt_node.hdr.bhdr == crr->root->max_sz);
+ HARD_CHECK_IS_MEMBER(alc->mbc_root, &crr->rbt_node);
+ HARD_CHECK_TREE(&crr->crr, alc->bf_within_carrier, crr->root, 0);
+
+ rbt_delete(&crr->root, (AOFF_RBTree_t*)del);
+
+ HARD_CHECK_TREE(&crr->crr, alc->bf_within_carrier, crr->root, 0);
+
+ /* Update the carrier tree with a potentially new (lower) max_sz
+ */
+ if (crr->root) {
+ if (crr->rbt_node.hdr.bhdr == crr->root->max_sz) {
+ return;
+ }
+ ASSERT(crr->rbt_node.hdr.bhdr > crr->root->max_sz);
+ crr->rbt_node.hdr.bhdr = crr->root->max_sz;
+ }
+ else {
+ crr->rbt_node.hdr.bhdr = 0;
+ }
+ lower_max_size(&crr->rbt_node, NULL);
+}
+
+static void
+rbt_delete(AOFF_RBTree_t** root, AOFF_RBTree_t* del)
{
- AOFFAllctr_t *alc = (AOFFAllctr_t *) allctr;
- AOFF_RBTree_t **root = ((flags & ERTS_ALCU_FLG_SBMBC)
- ? &alc->sbmbc_root : &alc->mbc_root);
Uint spliced_is_black;
- AOFF_RBTree_t *x, *y, *z = (AOFF_RBTree_t *) del;
+ AOFF_RBTree_t *x, *y, *z = del;
AOFF_RBTree_t null_x; /* null_x is used to get the fixup started when we
splice out a node without children. */
- null_x.parent = NULL;
+ HARD_CHECK_IS_MEMBER(*root, del);
-#ifdef HARD_DEBUG
- check_tree(*root, 0);
-#endif
+ null_x.parent = NULL;
/* Remove node from tree... */
@@ -572,26 +653,43 @@ aoff_unlink_free_block(Allctr_t *allctr, Block_t *del, Uint32 flags)
RBT_ASSERT(!null_x.right);
}
}
-
- DESTROY_TREE_NODE(del);
-
-#ifdef HARD_DEBUG
- check_tree(*root, 0);
-#endif
}
static void
-aoff_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags)
+aoff_link_free_block(Allctr_t *allctr, Block_t *block)
{
- AOFFAllctr_t *alc = (AOFFAllctr_t *) allctr;
+ AOFFAllctr_t* alc = (AOFFAllctr_t*) allctr;
AOFF_RBTree_t *blk = (AOFF_RBTree_t *) block;
- AOFF_RBTree_t **root = ((flags & ERTS_ALCU_FLG_SBMBC)
- ? &alc->sbmbc_root : &alc->mbc_root);
+ AOFF_RBTree_t *crr_node;
+ AOFF_Carrier_t *blk_crr = (AOFF_Carrier_t*) FBLK_TO_MBC(block);
Uint blk_sz = AOFF_BLK_SZ(blk);
-#ifdef HARD_DEBUG
- check_tree(*root, 0);
-#endif
+ ASSERT(allctr == ERTS_ALC_CARRIER_TO_ALLCTR(&blk_crr->crr));
+ ASSERT(blk_crr->rbt_node.hdr.bhdr == (blk_crr->root ? blk_crr->root->max_sz : 0));
+ HARD_CHECK_IS_MEMBER(alc->mbc_root, &blk_crr->rbt_node);
+ HARD_CHECK_TREE(&blk_crr->crr, alc->bf_within_carrier, blk_crr->root, 0);
+
+ rbt_insert(alc->bf_within_carrier, &blk_crr->root, blk);
+
+ /* Update the carrier tree with a potential new (larger) max_sz
+ */
+ crr_node = &blk_crr->rbt_node;
+ if (blk_sz > crr_node->hdr.bhdr) {
+ ASSERT(blk_sz == blk_crr->root->max_sz);
+ crr_node->hdr.bhdr = blk_sz;
+ while (blk_sz > crr_node->max_sz) {
+ crr_node->max_sz = blk_sz;
+ crr_node = crr_node->parent;
+ if (!crr_node) break;
+ }
+ }
+ HARD_CHECK_TREE(&blk_crr->crr, alc->bf_within_carrier, blk_crr->root, 0);
+}
+
+static void
+rbt_insert(int bestfit, AOFF_RBTree_t** root, AOFF_RBTree_t* blk)
+{
+ Uint blk_sz = AOFF_BLK_SZ(blk);
blk->flags = 0;
blk->left = NULL;
@@ -609,7 +707,7 @@ aoff_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags)
if (x->max_sz < blk_sz) {
x->max_sz = blk_sz;
}
- if (blk < x) {
+ if (cmp_blocks(bestfit, blk, x) < 0) {
if (!x->left) {
blk->parent = x;
x->left = blk;
@@ -625,7 +723,6 @@ aoff_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags)
}
x = x->right;
}
-
}
/* Insert block into size tree */
@@ -635,38 +732,59 @@ aoff_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags)
if (IS_RED(blk->parent))
tree_insert_fixup(root, blk);
}
-
-#ifdef HARD_DEBUG
- check_tree(*root, 0);
-#endif
}
-static Block_t *
-aoff_get_free_block(Allctr_t *allctr, Uint size,
- Block_t *cand_blk, Uint cand_size, Uint32 flags)
+static AOFF_RBTree_t*
+rbt_search(AOFF_RBTree_t* root, Uint size)
{
- AOFFAllctr_t *alc = (AOFFAllctr_t *) allctr;
- AOFF_RBTree_t *x = ((flags & ERTS_ALCU_FLG_SBMBC)
- ? alc->sbmbc_root : alc->mbc_root);
- AOFF_RBTree_t *blk = NULL;
-#ifdef HARD_DEBUG
- AOFF_RBTree_t* dbg_blk = check_tree(x, size);
-#endif
+ AOFF_RBTree_t* x = root;
- ASSERT(!cand_blk || cand_size >= size);
-
- while (x) {
+ ASSERT(x);
+ for (;;) {
if (x->left && x->left->max_sz >= size) {
x = x->left;
}
else if (AOFF_BLK_SZ(x) >= size) {
- blk = x;
- break;
+ return x;
}
else {
x = x->right;
+ if (!x) {
+ return NULL;
+ }
}
}
+}
+
+static Block_t *
+aoff_get_free_block(Allctr_t *allctr, Uint size,
+ Block_t *cand_blk, Uint cand_size)
+{
+ AOFFAllctr_t *alc = (AOFFAllctr_t *) allctr;
+ AOFF_RBTree_t *crr_node = alc->mbc_root;
+ AOFF_Carrier_t* crr;
+ AOFF_RBTree_t *blk = NULL;
+#ifdef HARD_DEBUG
+ AOFF_RBTree_t* dbg_blk;
+#endif
+
+ ASSERT(!cand_blk || cand_size >= size);
+
+ /* Get first-fit carrier
+ */
+ if (!crr_node || !(blk=rbt_search(crr_node, size))) {
+ return NULL;
+ }
+ crr = RBT_NODE_TO_MBC(blk);
+
+ /* Get block within carrier tree
+ */
+#ifdef HARD_DEBUG
+ dbg_blk = HARD_CHECK_TREE(&crr->crr, alc->bf_within_carrier, crr->root, size);
+#endif
+
+ blk = rbt_search(crr->root, size);
+ ASSERT(blk);
#ifdef HARD_DEBUG
ASSERT(blk == dbg_blk);
@@ -675,15 +793,87 @@ aoff_get_free_block(Allctr_t *allctr, Uint size,
if (!blk)
return NULL;
- if (cand_blk && cand_blk < &blk->hdr) {
+ if (cand_blk && cmp_cand_blk(alc->bf_within_carrier, cand_blk, blk) < 0) {
return NULL; /* cand_blk was better */
}
- aoff_unlink_free_block(allctr, (Block_t *) blk, flags);
+ aoff_unlink_free_block(allctr, (Block_t *) blk);
return (Block_t *) blk;
}
+static void aoff_creating_mbc(Allctr_t *allctr, Carrier_t *carrier)
+{
+ AOFFAllctr_t *alc = (AOFFAllctr_t *) allctr;
+ AOFF_Carrier_t *crr = (AOFF_Carrier_t*) carrier;
+ AOFF_RBTree_t **root = &alc->mbc_root;
+
+ HARD_CHECK_TREE(NULL, 0, *root, 0);
+
+ /* Link carrier in address order tree
+ */
+ crr->rbt_node.hdr.bhdr = 0;
+ rbt_insert(0, root, &crr->rbt_node);
+
+ /* aoff_link_free_block will add free block later */
+ crr->root = NULL;
+
+ HARD_CHECK_TREE(NULL, 0, *root, 0);
+}
+
+static void aoff_destroying_mbc(Allctr_t *allctr, Carrier_t *carrier)
+{
+ AOFFAllctr_t *alc = (AOFFAllctr_t *) allctr;
+ AOFF_Carrier_t *crr = (AOFF_Carrier_t*) carrier;
+ AOFF_RBTree_t *root = alc->mbc_root;
+
+ if (crr->rbt_node.parent || &crr->rbt_node == root) {
+ aoff_remove_mbc(allctr, carrier);
+ }
+ /*else already removed */
+}
+
+static void aoff_add_mbc(Allctr_t *allctr, Carrier_t *carrier)
+{
+ AOFFAllctr_t *alc = (AOFFAllctr_t *) allctr;
+ AOFF_Carrier_t *crr = (AOFF_Carrier_t*) carrier;
+ AOFF_RBTree_t **root = &alc->mbc_root;
+
+ HARD_CHECK_TREE(NULL, 0, *root, 0);
+
+ /* Link carrier in address order tree
+ */
+ rbt_insert(0, root, &crr->rbt_node);
+
+ HARD_CHECK_TREE(NULL, 0, *root, 0);
+}
+
+static void aoff_remove_mbc(Allctr_t *allctr, Carrier_t *carrier)
+{
+ AOFFAllctr_t *alc = (AOFFAllctr_t *) allctr;
+ AOFF_Carrier_t *crr = (AOFF_Carrier_t*) carrier;
+ AOFF_RBTree_t **root = &alc->mbc_root;
+
+ ASSERT(allctr == ERTS_ALC_CARRIER_TO_ALLCTR(carrier));
+ HARD_CHECK_TREE(NULL, 0, *root, 0);
+
+ rbt_delete(root, &crr->rbt_node);
+ crr->rbt_node.parent = NULL;
+ crr->rbt_node.left = NULL;
+ crr->rbt_node.right = NULL;
+ crr->rbt_node.max_sz = crr->rbt_node.hdr.bhdr;
+
+ HARD_CHECK_TREE(NULL, 0, *root, 0);
+}
+
+static UWord aoff_largest_fblk_in_mbc(Allctr_t* allctr, Carrier_t* carrier)
+{
+ AOFF_Carrier_t *crr = (AOFF_Carrier_t*) carrier;
+
+ ASSERT(allctr == ERTS_ALC_CARRIER_TO_ALLCTR(carrier));
+ ASSERT(crr->rbt_node.hdr.bhdr == (crr->root ? crr->root->max_sz : 0));
+ return crr->rbt_node.hdr.bhdr;
+}
/*
* info_options()
@@ -692,6 +882,7 @@ aoff_get_free_block(Allctr_t *allctr, Uint size,
static struct {
Eterm as;
Eterm aoff;
+ Eterm aoffcaobf;
#ifdef DEBUG
Eterm end_of_atoms;
#endif
@@ -720,6 +911,7 @@ init_atoms(void)
#endif
AM_INIT(as);
AM_INIT(aoff);
+ AM_INIT(aoffcaobf);
#ifdef DEBUG
for (atom = (Eterm *) &am; atom < &am.end_of_atoms; atom++) {
@@ -749,6 +941,7 @@ info_options(Allctr_t *allctr,
Uint **hpp,
Uint *szp)
{
+ AOFFAllctr_t* alc = (AOFFAllctr_t*) allctr;
Eterm res = THE_NON_VALUE;
if (print_to_p) {
@@ -756,7 +949,7 @@ info_options(Allctr_t *allctr,
print_to_arg,
"%sas: %s\n",
prefix,
- "aoff");
+ alc->bf_within_carrier ? "aoffcaobf" : "aoff");
}
if (hpp || szp) {
@@ -766,7 +959,8 @@ info_options(Allctr_t *allctr,
__FILE__, __LINE__);;
res = NIL;
- add_2tup(hpp, szp, &res, am.as, am.aoff);
+ add_2tup(hpp, szp, &res, am.as,
+ alc->bf_within_carrier ? am.aoffcaobf : am.aoff);
}
return res;
@@ -784,14 +978,19 @@ UWord
erts_aoffalc_test(UWord op, UWord a1, UWord a2)
{
switch (op) {
- case 0x500: return (UWord) 0; /* IS_AOBF */
- case 0x501: return (UWord) ((AOFFAllctr_t *) a1)->mbc_root;
+ case 0x501: {
+ AOFF_RBTree_t *node = ((AOFFAllctr_t *) a1)->mbc_root;
+ Uint size = (Uint) a2;
+ node = node ? rbt_search(node, size) : NULL;
+ return (UWord) (node ? RBT_NODE_TO_MBC(node)->root : NULL);
+ }
case 0x502: return (UWord) ((AOFF_RBTree_t *) a1)->parent;
case 0x503: return (UWord) ((AOFF_RBTree_t *) a1)->left;
case 0x504: return (UWord) ((AOFF_RBTree_t *) a1)->right;
case 0x506: return (UWord) IS_BLACK((AOFF_RBTree_t *) a1);
- case 0x508: return (UWord) 1; /* IS_AOFF */
+ case 0x508: return (UWord) 0; /* IS_BF_ALGO */
case 0x509: return (UWord) ((AOFF_RBTree_t *) a1)->max_sz;
+ case 0x50a: return (UWord) ((AOFFAllctr_t *) a1)->bf_within_carrier;
default: ASSERT(0); return ~((UWord) 0);
}
}
@@ -804,6 +1003,16 @@ erts_aoffalc_test(UWord op, UWord a1, UWord a2)
#ifdef HARD_DEBUG
+static int rbt_assert_is_member(AOFF_RBTree_t* root, AOFF_RBTree_t* node)
+{
+ while (node != root) {
+ ASSERT(node->parent);
+ ASSERT(node->parent->left == node || node->parent->right == node);
+ node = node->parent;
+ }
+ return 1;
+}
+
#define IS_LEFT_VISITED(FB) ((FB)->flags & LEFT_VISITED_FLG)
#define IS_RIGHT_VISITED(FB) ((FB)->flags & RIGHT_VISITED_FLG)
@@ -840,12 +1049,14 @@ static void print_tree(AOFF_RBTree_t*);
*/
static AOFF_RBTree_t *
-check_tree(AOFF_RBTree_t* root, Uint size)
+check_tree(Carrier_t* within_crr, int bestfit, AOFF_RBTree_t* root, Uint size)
{
AOFF_RBTree_t *res = NULL;
Sint blacks;
Sint curr_blacks;
AOFF_RBTree_t *x;
+ Carrier_t* crr;
+ Uint depth, max_depth, node_cnt;
#ifdef PRINT_TREE
print_tree(root);
@@ -859,12 +1070,16 @@ check_tree(AOFF_RBTree_t* root, Uint size)
ASSERT(!x->parent);
curr_blacks = 1;
blacks = -1;
+ depth = 1;
+ max_depth = 0;
+ node_cnt = 0;
while (x) {
if (!IS_LEFT_VISITED(x)) {
SET_LEFT_VISITED(x);
if (x->left) {
x = x->left;
+ ++depth;
if (IS_BLACK(x))
curr_blacks++;
continue;
@@ -880,6 +1095,7 @@ check_tree(AOFF_RBTree_t* root, Uint size)
SET_RIGHT_VISITED(x);
if (x->right) {
x = x->right;
+ ++depth;
if (IS_BLACK(x))
curr_blacks++;
continue;
@@ -891,6 +1107,16 @@ check_tree(AOFF_RBTree_t* root, Uint size)
}
}
+ ++node_cnt;
+ if (depth > max_depth)
+ max_depth = depth;
+
+ if (within_crr) {
+ crr = FBLK_TO_MBC(&x->hdr);
+ ASSERT(crr == within_crr);
+ ASSERT((char*)x > (char*)crr);
+ ASSERT(((char*)x + AOFF_BLK_SZ(x)) <= ((char*)crr + CARRIER_SZ(crr)));
+ }
if (IS_RED(x)) {
ASSERT(IS_BLACK(x->right));
@@ -901,13 +1127,13 @@ check_tree(AOFF_RBTree_t* root, Uint size)
if (x->left) {
ASSERT(x->left->parent == x);
- ASSERT(x->left < x);
+ ASSERT(cmp_blocks(bestfit, x->left, x) < 0);
ASSERT(x->left->max_sz <= x->max_sz);
}
if (x->right) {
ASSERT(x->right->parent == x);
- ASSERT(x->right > x);
+ ASSERT(cmp_blocks(bestfit, x->right, x) > 0);
ASSERT(x->right->max_sz <= x->max_sz);
}
ASSERT(x->max_sz >= AOFF_BLK_SZ(x));
@@ -916,7 +1142,7 @@ check_tree(AOFF_RBTree_t* root, Uint size)
|| x->max_sz == (x->right ? x->right->max_sz : 0));
if (size && AOFF_BLK_SZ(x) >= size) {
- if (!res || x < res) {
+ if (!res || cmp_blocks(bestfit, x, res) < 0) {
res = x;
}
}
@@ -926,10 +1152,11 @@ check_tree(AOFF_RBTree_t* root, Uint size)
if (IS_BLACK(x))
curr_blacks--;
x = x->parent;
-
+ --depth;
}
-
+ ASSERT(depth == 0 || (!root && depth==1));
ASSERT(curr_blacks == 0);
+ ASSERT((1 << (max_depth/2)) <= node_cnt);
UNSET_LEFT_VISITED(root);
UNSET_RIGHT_VISITED(root);
@@ -954,9 +1181,9 @@ print_tree_aux(AOFF_RBTree_t *x, int indent)
for (i = 0; i < indent; i++) {
putc(' ', stderr);
}
- fprintf(stderr, "%s: sz=%lu addr=0x%lx max_size=%lu\r\n",
+ fprintf(stderr, "%s: sz=%lu addr=0x%lx max_size=%u\r\n",
IS_BLACK(x) ? "BLACK" : "RED",
- AOFF_BLK_SZ(x), (Uint)x, x->max_sz);
+ AOFF_BLK_SZ(x), (Uint)x, (unsigned)x->max_sz);
print_tree_aux(x->left, indent + INDENT_STEP);
}
}
diff --git a/erts/emulator/beam/erl_ao_firstfit_alloc.h b/erts/emulator/beam/erl_ao_firstfit_alloc.h
index 21c36c6654..87427e8e62 100644
--- a/erts/emulator/beam/erl_ao_firstfit_alloc.h
+++ b/erts/emulator/beam/erl_ao_firstfit_alloc.h
@@ -24,11 +24,12 @@
#include "erl_alloc_util.h"
#define ERTS_ALC_AOFF_ALLOC_VSN_STR "0.9"
+#define ERTS_ALC_AOFF_CBF_ALLOC_VSN_STR "0.9"
typedef struct AOFFAllctr_t_ AOFFAllctr_t;
typedef struct {
- int dummy;
+ int bf_within_carrier;
} AOFFAllctrInit_t;
#define ERTS_DEFAULT_AOFF_ALLCTR_INIT {0/*dummy*/}
@@ -51,7 +52,7 @@ struct AOFFAllctr_t_ {
Allctr_t allctr; /* Has to be first! */
struct AOFF_RBTree_t_* mbc_root;
- struct AOFF_RBTree_t_* sbmbc_root;
+ int bf_within_carrier;
};
UWord erts_aoffalc_test(UWord, UWord, UWord);
diff --git a/erts/emulator/beam/erl_bestfit_alloc.c b/erts/emulator/beam/erl_bestfit_alloc.c
index ed843a51fb..58e53c3d00 100644
--- a/erts/emulator/beam/erl_bestfit_alloc.c
+++ b/erts/emulator/beam/erl_bestfit_alloc.c
@@ -89,21 +89,21 @@
static RBTree_t * check_tree(RBTree_t, int, Uint);
#endif
-static void tree_delete(Allctr_t *allctr, Block_t *del, Uint32 flags);
+static void tree_delete(Allctr_t *allctr, Block_t *del);
/* Prototypes of callback functions */
/* "address order best fit" specific callback functions */
static Block_t * aobf_get_free_block (Allctr_t *, Uint,
- Block_t *, Uint, Uint32);
-static void aobf_link_free_block (Allctr_t *, Block_t *, Uint32);
+ Block_t *, Uint);
+static void aobf_link_free_block (Allctr_t *, Block_t *);
#define aobf_unlink_free_block tree_delete
/* "best fit" specific callback functions */
static Block_t * bf_get_free_block (Allctr_t *, Uint,
- Block_t *, Uint, Uint32);
-static void bf_link_free_block (Allctr_t *, Block_t *, Uint32);
-static ERTS_INLINE void bf_unlink_free_block (Allctr_t *, Block_t *, Uint32);
+ Block_t *, Uint);
+static void bf_link_free_block (Allctr_t *, Block_t *);
+static ERTS_INLINE void bf_unlink_free_block (Allctr_t *, Block_t *);
static Eterm info_options (Allctr_t *, char *, int *,
@@ -179,6 +179,7 @@ erts_bfalc_start(BFAllctr_t *bfallctr,
bfallctr->address_order = bfinit->ao;
+ allctr->mbc_header_size = sizeof(Carrier_t);
allctr->min_mbc_size = MIN_MBC_SZ;
allctr->min_mbc_first_free_size = MIN_MBC_FIRST_FREE_SZ;
allctr->min_block_size = (bfinit->ao
@@ -207,6 +208,9 @@ erts_bfalc_start(BFAllctr_t *bfallctr,
allctr->get_next_mbc_size = NULL;
allctr->creating_mbc = NULL;
allctr->destroying_mbc = NULL;
+ allctr->add_mbc = NULL;
+ allctr->remove_mbc = NULL;
+ allctr->largest_fblk_in_mbc = NULL;
allctr->init_atoms = init_atoms;
#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG
@@ -407,13 +411,11 @@ tree_insert_fixup(RBTree_t **root, RBTree_t *blk)
* callback function in the address order case.
*/
static void
-tree_delete(Allctr_t *allctr, Block_t *del, Uint32 flags)
+tree_delete(Allctr_t *allctr, Block_t *del)
{
BFAllctr_t *bfallctr = (BFAllctr_t *) allctr;
Uint spliced_is_black;
- RBTree_t **root = ((flags & ERTS_ALCU_FLG_SBMBC)
- ? &bfallctr->sbmbc_root
- : &bfallctr->mbc_root);
+ RBTree_t **root = &bfallctr->mbc_root;
RBTree_t *x, *y, *z = (RBTree_t *) del;
RBTree_t null_x; /* null_x is used to get the fixup started when we
splice out a node without children. */
@@ -586,12 +588,10 @@ tree_delete(Allctr_t *allctr, Block_t *del, Uint32 flags)
\* */
static void
-aobf_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags)
+aobf_link_free_block(Allctr_t *allctr, Block_t *block)
{
BFAllctr_t *bfallctr = (BFAllctr_t *) allctr;
- RBTree_t **root = ((flags & ERTS_ALCU_FLG_SBMBC)
- ? &bfallctr->sbmbc_root
- : &bfallctr->mbc_root);
+ RBTree_t **root = &bfallctr->mbc_root;
RBTree_t *blk = (RBTree_t *) block;
Uint blk_sz = BF_BLK_SZ(blk);
@@ -647,21 +647,18 @@ aobf_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags)
#if 0 /* tree_delete() is directly used instead */
static void
-aobf_unlink_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags)
+aobf_unlink_free_block(Allctr_t *allctr, Block_t *block)
{
- tree_delete(allctr, block, flags);
+ tree_delete(allctr, block);
}
#endif
static Block_t *
aobf_get_free_block(Allctr_t *allctr, Uint size,
- Block_t *cand_blk, Uint cand_size,
- Uint32 flags)
+ Block_t *cand_blk, Uint cand_size)
{
BFAllctr_t *bfallctr = (BFAllctr_t *) allctr;
- RBTree_t **root = ((flags & ERTS_ALCU_FLG_SBMBC)
- ? &bfallctr->sbmbc_root
- : &bfallctr->mbc_root);
+ RBTree_t **root = &bfallctr->mbc_root;
RBTree_t *x = *root;
RBTree_t *blk = NULL;
Uint blk_sz;
@@ -694,7 +691,7 @@ aobf_get_free_block(Allctr_t *allctr, Uint size,
return NULL; /* cand_blk was better */
}
- aobf_unlink_free_block(allctr, (Block_t *) blk, flags);
+ aobf_unlink_free_block(allctr, (Block_t *) blk);
return (Block_t *) blk;
}
@@ -705,12 +702,10 @@ aobf_get_free_block(Allctr_t *allctr, Uint size,
\* */
static void
-bf_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags)
+bf_link_free_block(Allctr_t *allctr, Block_t *block)
{
BFAllctr_t *bfallctr = (BFAllctr_t *) allctr;
- RBTree_t **root = ((flags & ERTS_ALCU_FLG_SBMBC)
- ? &bfallctr->sbmbc_root
- : &bfallctr->mbc_root);
+ RBTree_t **root = &bfallctr->mbc_root;
RBTree_t *blk = (RBTree_t *) block;
Uint blk_sz = BF_BLK_SZ(blk);
@@ -779,12 +774,10 @@ bf_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags)
}
static ERTS_INLINE void
-bf_unlink_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags)
+bf_unlink_free_block(Allctr_t *allctr, Block_t *block)
{
BFAllctr_t *bfallctr = (BFAllctr_t *) allctr;
- RBTree_t **root = ((flags & ERTS_ALCU_FLG_SBMBC)
- ? &bfallctr->sbmbc_root
- : &bfallctr->mbc_root);
+ RBTree_t **root = &bfallctr->mbc_root;
RBTree_t *x = (RBTree_t *) block;
if (IS_LIST_ELEM(x)) {
@@ -812,7 +805,7 @@ bf_unlink_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags)
}
else {
/* Remove from tree */
- tree_delete(allctr, block, flags);
+ tree_delete(allctr, block);
}
DESTROY_LIST_ELEM(x);
@@ -821,13 +814,10 @@ bf_unlink_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags)
static Block_t *
bf_get_free_block(Allctr_t *allctr, Uint size,
- Block_t *cand_blk, Uint cand_size,
- Uint32 flags)
+ Block_t *cand_blk, Uint cand_size)
{
BFAllctr_t *bfallctr = (BFAllctr_t *) allctr;
- RBTree_t **root = ((flags & ERTS_ALCU_FLG_SBMBC)
- ? &bfallctr->sbmbc_root
- : &bfallctr->mbc_root);
+ RBTree_t **root = &bfallctr->mbc_root;
RBTree_t *x = *root;
RBTree_t *blk = NULL;
Uint blk_sz;
@@ -867,7 +857,7 @@ bf_get_free_block(Allctr_t *allctr, Uint size,
the tree node */
blk = LIST_NEXT(blk) ? LIST_NEXT(blk) : blk;
- bf_unlink_free_block(allctr, (Block_t *) blk, flags);
+ bf_unlink_free_block(allctr, (Block_t *) blk);
return (Block_t *) blk;
}
@@ -984,7 +974,7 @@ erts_bfalc_test(UWord op, UWord a1, UWord a2)
case 0x205: return (UWord) ((RBTreeList_t *) a1)->next;
case 0x206: return (UWord) IS_BLACK((RBTree_t *) a1);
case 0x207: return (UWord) IS_TREE_NODE((RBTree_t *) a1);
- case 0x208: return (UWord) 0; /* IS_AOFF */
+ case 0x208: return (UWord) 1; /* IS_BF_ALGO */
default: ASSERT(0); return ~((UWord) 0);
}
}
diff --git a/erts/emulator/beam/erl_bestfit_alloc.h b/erts/emulator/beam/erl_bestfit_alloc.h
index f2d2f07d7a..be8b2b871d 100644
--- a/erts/emulator/beam/erl_bestfit_alloc.h
+++ b/erts/emulator/beam/erl_bestfit_alloc.h
@@ -55,7 +55,6 @@ struct BFAllctr_t_ {
Allctr_t allctr; /* Has to be first! */
RBTree_t * mbc_root;
- RBTree_t * sbmbc_root;
int address_order;
};
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index 54eefe8d12..74a37f374d 100755
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -59,6 +59,7 @@ static Export* alloc_info_trap = NULL;
static Export* alloc_sizes_trap = NULL;
static Export *gather_sched_wall_time_res_trap;
+static Export *gather_gc_info_res_trap;
#define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1)
@@ -1670,13 +1671,22 @@ info_1_tuple(Process* BIF_P, /* Pointer to current process. */
sel = *tp++;
- if (sel == am_allocator_sizes) {
+ if (sel == am_memory_internal) {
+ switch (arity) {
+ case 3:
+ if (erts_request_alloc_info(BIF_P, tp[0], tp[1], 1, 1))
+ return am_true;
+ default:
+ goto badarg;
+ }
+ }
+ else if (sel == am_allocator_sizes) {
switch (arity) {
case 2:
ERTS_BIF_PREP_TRAP1(ret, alloc_sizes_trap, BIF_P, *tp);
return ret;
case 3:
- if (erts_request_alloc_info(BIF_P, tp[0], tp[1], 1))
+ if (erts_request_alloc_info(BIF_P, tp[0], tp[1], 1, 0))
return am_true;
default:
goto badarg;
@@ -1735,7 +1745,7 @@ info_1_tuple(Process* BIF_P, /* Pointer to current process. */
ERTS_BIF_PREP_TRAP1(ret, alloc_info_trap, BIF_P, *tp);
return ret;
case 3:
- if (erts_request_alloc_info(BIF_P, tp[0], tp[1], 0))
+ if (erts_request_alloc_info(BIF_P, tp[0], tp[1], 0, 0))
return am_true;
default:
goto badarg;
@@ -3103,18 +3113,10 @@ BIF_RETTYPE statistics_1(BIF_ALIST_1)
res = TUPLE2(hp, cs, SMALL_ZERO);
BIF_RET(res);
} else if (BIF_ARG_1 == am_garbage_collection) {
- Uint hsz = 4;
- ErtsGCInfo gc_info;
- Eterm gcs;
- Eterm recl;
- erts_gc_info(&gc_info);
- (void) erts_bld_uint(NULL, &hsz, gc_info.garbage_collections);
- (void) erts_bld_uint(NULL, &hsz, gc_info.reclaimed);
- hp = HAlloc(BIF_P, hsz);
- gcs = erts_bld_uint(&hp, NULL, gc_info.garbage_collections);
- recl = erts_bld_uint(&hp, NULL, gc_info.reclaimed);
- res = TUPLE3(hp, gcs, recl, SMALL_ZERO);
- BIF_RET(res);
+ res = erts_gc_info_request(BIF_P);
+ if (is_non_value(res))
+ BIF_RET(am_undefined);
+ BIF_TRAP1(gather_gc_info_res_trap, BIF_P, res);
} else if (BIF_ARG_1 == am_reductions) {
Uint reds;
Uint diff;
@@ -4082,6 +4084,8 @@ erts_bif_info_init(void)
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);
+ gather_gc_info_res_trap
+ = erts_export_put(am_erlang, am_gather_gc_info_result, 1);
process_info_init();
os_info_init();
}
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index 298909c921..0d12e658d9 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -47,10 +47,6 @@
*/
#define ALENGTH(a) (sizeof(a)/sizeof(a[0]))
-static erts_smp_spinlock_t info_lck;
-static Uint garbage_cols; /* no of garbage collections */
-static Uint reclaimed; /* no of words reclaimed in GCs */
-
# define STACK_SZ_ON_HEAP(p) ((p)->hend - (p)->stop)
# define OverRunCheck(P) \
if ((P)->stop < (P)->htop) { \
@@ -120,6 +116,8 @@ static void offset_rootset(Process *p, Sint offs, char* area, Uint area_size,
static void offset_off_heap(Process* p, Sint offs, char* area, Uint area_size);
static void offset_mqueue(Process *p, Sint offs, char* area, Uint area_size);
+static void init_gc_info(ErtsGCInfo *gcip);
+
#ifdef HARDDEBUG
static void disallow_heap_frag_ref_in_heap(Process* p);
static void disallow_heap_frag_ref_in_old_heap(Process* p);
@@ -137,13 +135,41 @@ static int num_heap_sizes; /* Number of heap sizes. */
Uint erts_test_long_gc_sleep; /* Only used for testing... */
+typedef struct {
+ Process *proc;
+ Eterm ref;
+ Eterm ref_heap[REF_THING_SIZE];
+ Uint req_sched;
+ erts_smp_atomic32_t refc;
+} ErtsGCInfoReq;
+
+#if !HALFWORD_HEAP
+ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(gcireq,
+ ErtsGCInfoReq,
+ 5,
+ ERTS_ALC_T_GC_INFO_REQ)
+#else
+static ERTS_INLINE ErtsGCInfoReq *
+gcireq_alloc(void)
+{
+ return erts_alloc(ERTS_ALC_T_GC_INFO_REQ,
+ sizeof(ErtsGCInfoReq));
+}
+
+static ERTS_INLINE void
+gcireq_free(ErtsGCInfoReq *ptr)
+{
+ erts_free(ERTS_ALC_T_GC_INFO_REQ, ptr);
+}
+#endif
+
/*
* Initialize GC global data.
*/
void
erts_init_gc(void)
{
- int i = 0;
+ int i = 0, ix;
Sint max_heap_size = 0;
ASSERT(offsetof(ProcBin,thing_word) == offsetof(struct erl_off_heap_header,thing_word));
@@ -156,9 +182,6 @@ erts_init_gc(void)
ASSERT(offsetof(ProcBin,next) == offsetof(ErlFunThing,next));
ASSERT(offsetof(ProcBin,next) == offsetof(ExternalThing,next));
- erts_smp_spinlock_init(&info_lck, "gc_info");
- garbage_cols = 0;
- reclaimed = 0;
erts_test_long_gc_sleep = 0;
/*
@@ -199,6 +222,16 @@ erts_init_gc(void)
}
}
num_heap_sizes = i;
+
+ for (ix = 0; ix < erts_no_schedulers; ix++) {
+ ErtsSchedulerData *esdp = ERTS_SCHEDULER_IX(ix);
+ init_gc_info(&esdp->gc_info);
+ }
+
+#if !HALFWORD_HEAP
+ init_gcireq_alloc();
+#endif
+
}
/*
@@ -287,17 +320,6 @@ erts_heap_sizes(Process* p)
return res;
}
-void
-erts_gc_info(ErtsGCInfo *gcip)
-{
- if (gcip) {
- erts_smp_spin_lock(&info_lck);
- gcip->garbage_collections = garbage_cols;
- gcip->reclaimed = reclaimed;
- erts_smp_spin_unlock(&info_lck);
- }
-}
-
void
erts_offset_heap(Eterm* hp, Uint sz, Sint offs, Eterm* low, Eterm* high)
{
@@ -378,6 +400,7 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj)
Uint reclaimed_now = 0;
int done = 0;
Uint ms1, s1, us1;
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
#ifdef USE_VM_PROBES
DTRACE_CHARBUF(pidbuf, DTRACE_TERM_BUF_SIZE);
#endif
@@ -455,11 +478,9 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj)
monitor_large_heap(p);
}
- erts_smp_spin_lock(&info_lck);
- garbage_cols++;
- reclaimed += reclaimed_now;
- erts_smp_spin_unlock(&info_lck);
-
+ esdp->gc_info.garbage_cols++;
+ esdp->gc_info.reclaimed += reclaimed_now;
+
FLAGS(p) &= ~F_FORCE_GC;
#ifdef CHECK_FOR_HOLES
@@ -2543,6 +2564,110 @@ offset_rootset(Process *p, Sint offs, char* area, Uint area_size,
offset_one_rootset(p, offs, area, area_size, objv, nobj);
}
+static void
+init_gc_info(ErtsGCInfo *gcip)
+{
+ gcip->reclaimed = 0;
+ gcip->garbage_cols = 0;
+}
+
+static void
+reply_gc_info(void *vgcirp)
+{
+ Uint64 reclaimed = 0, garbage_cols = 0;
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ ErtsGCInfoReq *gcirp = (ErtsGCInfoReq *) vgcirp;
+ ErtsProcLocks rp_locks = (gcirp->req_sched == esdp->no
+ ? ERTS_PROC_LOCK_MAIN
+ : 0);
+ Process *rp = gcirp->proc;
+ Eterm ref_copy = NIL, msg;
+ Eterm *hp = NULL;
+ Eterm **hpp;
+ Uint sz, *szp;
+ ErlOffHeap *ohp = NULL;
+ ErlHeapFragment *bp = NULL;
+
+ ASSERT(esdp);
+
+ reclaimed = esdp->gc_info.reclaimed;
+ garbage_cols = esdp->gc_info.garbage_cols;
+
+ sz = 0;
+ hpp = NULL;
+ szp = &sz;
+
+ while (1) {
+ if (hpp)
+ ref_copy = STORE_NC(hpp, ohp, gcirp->ref);
+ else
+ *szp += REF_THING_SIZE;
+
+ msg = erts_bld_tuple(hpp, szp, 3,
+ make_small(esdp->no),
+ erts_bld_uint64(hpp, szp, garbage_cols),
+ erts_bld_uint64(hpp, szp, reclaimed));
+
+ 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
+#ifdef USE_VM_PROBES
+ , NIL
+#endif
+ );
+
+ if (gcirp->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(&gcirp->refc) == 0)
+ gcireq_free(vgcirp);
+}
+
+Eterm
+erts_gc_info_request(Process *c_p)
+{
+ ErtsSchedulerData *esdp = ERTS_PROC_GET_SCHDATA(c_p);
+ Eterm ref;
+ ErtsGCInfoReq *gcirp;
+ Eterm *hp;
+
+ gcirp = gcireq_alloc();
+ ref = erts_make_ref(c_p);
+ hp = &gcirp->ref_heap[0];
+
+ gcirp->proc = c_p;
+ gcirp->ref = STORE_NC(&hp, NULL, ref);
+ gcirp->req_sched = esdp->no;
+ erts_smp_atomic32_init_nob(&gcirp->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_gc_info,
+ (void *) gcirp);
+#endif
+
+ reply_gc_info((void *) gcirp);
+
+ return ref;
+}
+
#if defined(DEBUG) || defined(ERTS_OFFHEAP_DEBUG)
static int
diff --git a/erts/emulator/beam/erl_goodfit_alloc.c b/erts/emulator/beam/erl_goodfit_alloc.c
index 79d8b40f8c..e9d8249ee1 100644
--- a/erts/emulator/beam/erl_goodfit_alloc.c
+++ b/erts/emulator/beam/erl_goodfit_alloc.c
@@ -163,10 +163,10 @@ BKT_MIN_SZ(GFAllctr_t *gfallctr, int ix)
/* Prototypes of callback functions */
static Block_t * get_free_block (Allctr_t *, Uint,
- Block_t *, Uint, Uint32);
-static void link_free_block (Allctr_t *, Block_t *, Uint32);
-static void unlink_free_block (Allctr_t *, Block_t *, Uint32);
-static void update_last_aux_mbc (Allctr_t *, Carrier_t *, Uint32);
+ Block_t *, Uint);
+static void link_free_block (Allctr_t *, Block_t *);
+static void unlink_free_block (Allctr_t *, Block_t *);
+static void update_last_aux_mbc (Allctr_t *, Carrier_t *);
static Eterm info_options (Allctr_t *, char *, int *,
void *, Uint **, Uint *);
static void init_atoms (void);
@@ -203,8 +203,7 @@ erts_gfalc_start(GFAllctr_t *gfallctr,
sys_memcpy((void *) gfallctr, (void *) &zero.allctr, sizeof(GFAllctr_t));
- init->sbmbct = 0; /* Small mbc not yet supported by goodfit */
-
+ allctr->mbc_header_size = sizeof(Carrier_t);
allctr->min_mbc_size = MIN_MBC_SZ;
allctr->min_mbc_first_free_size = MIN_MBC_FIRST_FREE_SZ;
allctr->min_block_size = sizeof(GFFreeBlock_t);
@@ -222,7 +221,9 @@ erts_gfalc_start(GFAllctr_t *gfallctr,
allctr->get_next_mbc_size = NULL;
allctr->creating_mbc = update_last_aux_mbc;
allctr->destroying_mbc = update_last_aux_mbc;
-
+ allctr->add_mbc = NULL;
+ allctr->remove_mbc = NULL;
+ allctr->largest_fblk_in_mbc = NULL;
allctr->init_atoms = init_atoms;
#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG
@@ -384,7 +385,7 @@ search_bucket(Allctr_t *allctr, int ix, Uint size)
static Block_t *
get_free_block(Allctr_t *allctr, Uint size,
- Block_t *cand_blk, Uint cand_size, Uint32 flags)
+ Block_t *cand_blk, Uint cand_size)
{
GFAllctr_t *gfallctr = (GFAllctr_t *) allctr;
int unsafe_bi, min_bi;
@@ -403,7 +404,7 @@ get_free_block(Allctr_t *allctr, Uint size,
if (blk) {
if (cand_blk && cand_size <= MBC_FBLK_SZ(blk))
return NULL; /* cand_blk was better */
- unlink_free_block(allctr, blk, flags);
+ unlink_free_block(allctr, blk);
return blk;
}
if (min_bi < NO_OF_BKTS - 1) {
@@ -423,14 +424,14 @@ get_free_block(Allctr_t *allctr, Uint size,
ASSERT(blk);
if (cand_blk && cand_size <= MBC_FBLK_SZ(blk))
return NULL; /* cand_blk was better */
- unlink_free_block(allctr, blk, flags);
+ unlink_free_block(allctr, blk);
return blk;
}
static void
-link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags)
+link_free_block(Allctr_t *allctr, Block_t *block)
{
GFAllctr_t *gfallctr = (GFAllctr_t *) allctr;
GFFreeBlock_t *blk = (GFFreeBlock_t *) block;
@@ -451,7 +452,7 @@ link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags)
}
static void
-unlink_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags)
+unlink_free_block(Allctr_t *allctr, Block_t *block)
{
GFAllctr_t *gfallctr = (GFAllctr_t *) allctr;
GFFreeBlock_t *blk = (GFFreeBlock_t *) block;
@@ -472,7 +473,7 @@ unlink_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags)
}
static void
-update_last_aux_mbc(Allctr_t *allctr, Carrier_t *mbc, Uint32 flags)
+update_last_aux_mbc(Allctr_t *allctr, Carrier_t *mbc)
{
GFAllctr_t *gfallctr = (GFAllctr_t *) allctr;
diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c
index e6a96d427f..b3a3c3d403 100644
--- a/erts/emulator/beam/erl_init.c
+++ b/erts/emulator/beam/erl_init.c
@@ -131,8 +131,10 @@ extern void ConWaitForExit(void);
static void erl_init(int ncpu,
int proc_tab_sz,
+ int legacy_proc_tab,
int port_tab_sz,
- int port_tab_sz_ignore_files);
+ int port_tab_sz_ignore_files,
+ int legacy_port_tab);
static erts_atomic_t exiting;
@@ -280,7 +282,9 @@ erts_short_init(void)
int ncpu = early_init(NULL, NULL);
erl_init(ncpu,
ERTS_DEFAULT_MAX_PROCESSES,
+ 0,
ERTS_DEFAULT_MAX_PORTS,
+ 0,
0);
erts_initialized = 1;
}
@@ -288,19 +292,21 @@ erts_short_init(void)
static void
erl_init(int ncpu,
int proc_tab_sz,
+ int legacy_proc_tab,
int port_tab_sz,
- int port_tab_sz_ignore_files)
+ int port_tab_sz_ignore_files,
+ int legacy_port_tab)
{
init_benchmarking();
erts_init_monitors();
- erts_init_gc();
erts_init_time();
erts_init_sys_common_misc();
- erts_init_process(ncpu, proc_tab_sz);
+ erts_init_process(ncpu, proc_tab_sz, legacy_proc_tab);
erts_init_scheduling(no_schedulers,
no_schedulers_online);
erts_init_cpu_topology(); /* Must be after init_scheduling */
+ erts_init_gc(); /* Must be after init_scheduling */
erts_alloc_late_init();
H_MIN_SIZE = erts_next_heap_size(H_MIN_SIZE, 0);
@@ -327,7 +333,7 @@ erl_init(int ncpu,
init_dist();
erl_drv_thr_init();
erts_init_async();
- erts_init_io(port_tab_sz, port_tab_sz_ignore_files);
+ erts_init_io(port_tab_sz, port_tab_sz_ignore_files, legacy_port_tab);
init_load();
erts_init_bif();
erts_init_bif_chksum();
@@ -923,6 +929,9 @@ erl_start(int argc, char **argv)
int proc_tab_sz = ERTS_DEFAULT_MAX_PROCESSES;
int port_tab_sz = ERTS_DEFAULT_MAX_PORTS;
int port_tab_sz_ignore_files = 0;
+ int legacy_proc_tab = 0;
+ int legacy_port_tab = 0;
+
envbufsz = sizeof(envbuf);
if (erts_sys_getenv_raw(ERL_MAX_ETS_TABLES_ENV, envbuf, &envbufsz) == 0)
@@ -1268,27 +1277,35 @@ erl_start(int argc, char **argv)
case 'P': /* set maximum number of processes */
arg = get_arg(argv[i]+2, argv[i+1], &i);
- errno = 0;
- proc_tab_sz = strtol(arg, NULL, 10);
- if (errno != 0
- || proc_tab_sz < ERTS_MIN_PROCESSES
- || ERTS_MAX_PROCESSES < proc_tab_sz) {
- erts_fprintf(stderr, "bad number of processes %s\n", arg);
- erts_usage();
+ if (strcmp(arg, "legacy") == 0)
+ legacy_proc_tab = 1;
+ else {
+ errno = 0;
+ proc_tab_sz = strtol(arg, NULL, 10);
+ if (errno != 0
+ || proc_tab_sz < ERTS_MIN_PROCESSES
+ || ERTS_MAX_PROCESSES < proc_tab_sz) {
+ erts_fprintf(stderr, "bad number of processes %s\n", arg);
+ erts_usage();
+ }
}
break;
case 'Q': /* set maximum number of ports */
arg = get_arg(argv[i]+2, argv[i+1], &i);
- errno = 0;
- port_tab_sz = strtol(arg, NULL, 10);
- if (errno != 0
- || port_tab_sz < ERTS_MIN_PROCESSES
- || ERTS_MAX_PROCESSES < port_tab_sz) {
- erts_fprintf(stderr, "bad number of ports %s\n", arg);
- erts_usage();
+ if (strcmp(arg, "legacy") == 0)
+ legacy_port_tab = 1;
+ else {
+ errno = 0;
+ port_tab_sz = strtol(arg, NULL, 10);
+ if (errno != 0
+ || port_tab_sz < ERTS_MIN_PROCESSES
+ || ERTS_MAX_PROCESSES < port_tab_sz) {
+ erts_fprintf(stderr, "bad number of ports %s\n", arg);
+ erts_usage();
+ }
+ port_tab_sz_ignore_files = 1;
}
- port_tab_sz_ignore_files = 1;
break;
case 'S' : /* Was handled in early_init() just read past it */
@@ -1642,8 +1659,10 @@ erl_start(int argc, char **argv)
erl_init(ncpu,
proc_tab_sz,
+ legacy_proc_tab,
port_tab_sz,
- port_tab_sz_ignore_files);
+ port_tab_sz_ignore_files,
+ legacy_port_tab);
load_preloaded();
erts_end_staging_code_ix();
diff --git a/erts/emulator/beam/erl_instrument.c b/erts/emulator/beam/erl_instrument.c
index 1aea3f65bc..df7c443387 100644
--- a/erts/emulator/beam/erl_instrument.c
+++ b/erts/emulator/beam/erl_instrument.c
@@ -1236,8 +1236,6 @@ erts_instr_init(int stat, int map_stat)
sys_memzero((void *) stats->n, sizeof(Stat_t)*(ERTS_ALC_N_MAX+1));
for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) {
- if (ERTS_IS_SBMBC_ALLOCATOR_NO__(i))
- continue;
if (erts_allctrs_info[i].enabled)
stats->ap[i] = &stats->a[i];
else
@@ -1251,8 +1249,6 @@ erts_instr_init(int stat, int map_stat)
erts_instr_memory_map = 1;
erts_instr_stat = 1;
for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) {
- if (ERTS_IS_SBMBC_ALLOCATOR_NO__(i))
- continue;
erts_allctrs[i].alloc = map_stat_alloc;
erts_allctrs[i].realloc = map_stat_realloc;
erts_allctrs[i].free = map_stat_free;
@@ -1265,8 +1261,6 @@ erts_instr_init(int stat, int map_stat)
else {
erts_instr_stat = 1;
for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) {
- if (ERTS_IS_SBMBC_ALLOCATOR_NO__(i))
- continue;
erts_allctrs[i].alloc = stat_alloc;
erts_allctrs[i].realloc = stat_realloc;
erts_allctrs[i].free = stat_free;
diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c
index a1d270adba..bc59fe55d4 100644
--- a/erts/emulator/beam/erl_lock_check.c
+++ b/erts/emulator/beam/erl_lock_check.c
@@ -150,7 +150,6 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "instr_x", NULL },
{ "instr", NULL },
{ "alcu_allocator", "index" },
- { "sbmbc_alloc", "index" },
{ "mseg", NULL },
#if HALFWORD_HEAP
{ "pmmap", NULL },
diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c
index 53cb01a8c6..f753de8f52 100644
--- a/erts/emulator/beam/erl_port_task.c
+++ b/erts/emulator/beam/erl_port_task.c
@@ -1928,18 +1928,21 @@ begin_port_cleanup(Port *pp, ErtsPortTask **execqp, int *processing_busy_q_p)
break;
case ERTS_PORT_TASK_INPUT:
erts_stale_drv_select(pp->common.id,
+ ERTS_Port2ErlDrvPort(pp),
ptp->u.alive.td.io.event,
DO_READ,
1);
break;
case ERTS_PORT_TASK_OUTPUT:
erts_stale_drv_select(pp->common.id,
+ ERTS_Port2ErlDrvPort(pp),
ptp->u.alive.td.io.event,
DO_WRITE,
1);
break;
case ERTS_PORT_TASK_EVENT:
erts_stale_drv_select(pp->common.id,
+ ERTS_Port2ErlDrvPort(pp),
ptp->u.alive.td.io.event,
0,
1);
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index 7415a5721f..88eb224f84 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -485,7 +485,7 @@ release_process(void *vproc)
/* initialize the scheduler */
void
-erts_init_process(int ncpu, int proc_tab_size)
+erts_init_process(int ncpu, int proc_tab_size, int legacy_proc_tab)
{
#ifdef ERTS_SMP
@@ -505,7 +505,8 @@ erts_init_process(int ncpu, int proc_tab_size)
(ErtsPTabElementCommon *) &erts_invalid_process.common,
proc_tab_size,
sizeof(Process),
- "process_table");
+ "process_table",
+ legacy_proc_tab);
last_reductions = 0;
last_exact_reductions = 0;
@@ -1326,6 +1327,17 @@ erts_alloc_notify_delayed_dealloc(int ix)
ERTS_SSI_AUX_WORK_DD);
}
+void
+erts_alloc_ensure_handle_delayed_dealloc_call(int ix)
+{
+#ifdef DEBUG
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ ASSERT(!esdp || ix == (int) esdp->no);
+#endif
+ set_aux_work_flags_wakeup_nob(ERTS_SCHED_SLEEP_INFO_IX(ix-1),
+ ERTS_SSI_AUX_WORK_DD);
+}
+
static ERTS_INLINE erts_aint32_t
handle_delayed_dealloc(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting)
{
@@ -4670,8 +4682,8 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online)
esdp->reductions = 0;
init_sched_wall_time(&esdp->sched_wall_time);
-
erts_port_task_handle_init(&esdp->nosuspend_port_task_handle);
+
}
init_misc_aux_work();
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index 5a1f6bbe8d..865ac6c43f 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -420,6 +420,11 @@ typedef struct {
} ErtsSchedWallTime;
typedef struct {
+ Uint64 reclaimed;
+ Uint64 garbage_cols;
+} ErtsGCInfo;
+
+typedef struct {
int sched;
erts_aint32_t aux_work;
} ErtsDelayedAuxWorkWakeupJob;
@@ -507,6 +512,7 @@ struct ErtsSchedulerData_ {
Uint64 reductions;
ErtsSchedWallTime sched_wall_time;
+ ErtsGCInfo gc_info;
ErtsPortTaskHandle nosuspend_port_task_handle;
#ifdef ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC
@@ -1126,6 +1132,7 @@ 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);
+Eterm erts_gc_info_request(Process *c_p);
Uint64 erts_get_proc_interval(void);
Uint64 erts_ensure_later_proc_interval(Uint64);
Uint64 erts_step_proc_interval(void);
@@ -1333,6 +1340,7 @@ int erts_is_multi_scheduling_blocked(void);
Eterm erts_multi_scheduling_blockers(Process *);
void erts_start_schedulers(void);
void erts_alloc_notify_delayed_dealloc(int);
+void erts_alloc_ensure_handle_delayed_dealloc_call(int);
void erts_smp_notify_check_children_needed(void);
#endif
#if ERTS_USE_ASYNC_READY_Q
@@ -1352,7 +1360,7 @@ void erts_schedule_multi_misc_aux_work(int ignore_self,
erts_aint32_t erts_set_aux_work_timeout(int, erts_aint32_t, int);
void erts_sched_notify_check_cpu_bind(void);
Uint erts_active_schedulers(void);
-void erts_init_process(int, int);
+void erts_init_process(int, int, int);
Eterm erts_process_status(Process *, ErtsProcLocks, Process *, Eterm);
Uint erts_run_queues_len(Uint *);
void erts_add_to_runq(Process *);
diff --git a/erts/emulator/beam/erl_ptab.c b/erts/emulator/beam/erl_ptab.c
index 5bbc71c659..8da135b2c8 100644
--- a/erts/emulator/beam/erl_ptab.c
+++ b/erts/emulator/beam/erl_ptab.c
@@ -34,6 +34,8 @@
typedef struct ErtsPTabListBifData_ ErtsPTabListBifData;
+#define ERTS_PTAB_NEW_MAX_RESERVE_FAIL 1000
+
#define ERTS_PTAB_LIST_BIF_TAB_INSPECT_INDICES_PER_RED 25
#define ERTS_PTAB_LIST_BIF_TAB_CHUNK_SIZE 1000
#define ERTS_PTAB_LIST_BIF_MIN_START_REDS \
@@ -415,6 +417,27 @@ last_data_cmp(Uint64 ld1, Uint64 ld2)
#define ERTS_PTAB_LastData2EtermData(LD) \
((Eterm) ((LD) & ~(~((Uint64) 0) << ERTS_PTAB_ID_DATA_SIZE)))
+static ERTS_INLINE Uint32
+ix_to_free_id_data_ix(ErtsPTab *ptab, Uint32 ix)
+{
+ Uint32 dix;
+
+ dix = ((ix & ptab->r.o.dix_cl_mask) << ptab->r.o.dix_cl_shift);
+ dix += ((ix >> ptab->r.o.dix_cli_shift) & ptab->r.o.dix_cli_mask);
+ ASSERT(0 <= dix && dix < ptab->r.o.max);
+ return dix;
+}
+
+UWord
+erts_ptab_mem_size(ErtsPTab *ptab)
+{
+ UWord size = ptab->r.o.max*sizeof(erts_smp_atomic_t);
+ if (ptab->r.o.free_id_data)
+ size += ptab->r.o.max*sizeof(Uint32);
+ return size;
+}
+
+
void
erts_ptab_init_table(ErtsPTab *ptab,
ErtsAlcType_t atype,
@@ -422,10 +445,11 @@ erts_ptab_init_table(ErtsPTab *ptab,
ErtsPTabElementCommon *invalid_element,
int size,
UWord element_size,
- char *name)
+ char *name,
+ int legacy)
{
- size_t tab_sz;
- int bits;
+ size_t tab_sz, alloc_sz;
+ Uint32 bits, cl, cli, ix, ix_per_cache_line, tab_cache_lines;
char *tab_end;
erts_smp_atomic_t *tab_entry;
erts_smp_rwmtx_opt_t rwmtx_opts = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER;
@@ -448,7 +472,10 @@ erts_ptab_init_table(ErtsPTab *ptab,
ptab->r.o.max = size;
tab_sz = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(size*sizeof(erts_smp_atomic_t));
- ptab->r.o.tab = erts_alloc_permanent_cache_aligned(atype, tab_sz);
+ alloc_sz = tab_sz;
+ if (!legacy)
+ alloc_sz += ERTS_ALC_CACHE_LINE_ALIGN_SIZE(size*sizeof(Uint32));
+ ptab->r.o.tab = erts_alloc_permanent_cache_aligned(atype, alloc_sz);
tab_end = ((char *) ptab->r.o.tab) + tab_sz;
tab_entry = ptab->r.o.tab;
while (tab_end > ((char *) tab_entry)) {
@@ -456,28 +483,57 @@ erts_ptab_init_table(ErtsPTab *ptab,
tab_entry++;
}
- ptab->r.o.tab_cache_lines = tab_sz/ERTS_CACHE_LINE_SIZE;
- ptab->r.o.pix_per_cache_line = (ERTS_CACHE_LINE_SIZE
- / sizeof(erts_smp_atomic_t));
+ tab_cache_lines = tab_sz/ERTS_CACHE_LINE_SIZE;
+ ix_per_cache_line = (ERTS_CACHE_LINE_SIZE/sizeof(erts_smp_atomic_t));
ASSERT((ptab->r.o.max & (ptab->r.o.max - 1)) == 0); /* power of 2 */
- ASSERT((ptab->r.o.pix_per_cache_line
- & (ptab->r.o.pix_per_cache_line - 1)) == 0); /* power of 2 */
- ASSERT((ptab->r.o.tab_cache_lines
- & (ptab->r.o.tab_cache_lines - 1)) == 0); /* power of 2 */
-
- ptab->r.o.pix_mask
- = (1 << bits) - 1;
- ptab->r.o.pix_cl_mask
- = ptab->r.o.tab_cache_lines-1;
- ptab->r.o.pix_cl_shift
- = erts_fit_in_bits_int32(ptab->r.o.pix_per_cache_line-1);
- ptab->r.o.pix_cli_shift
- = erts_fit_in_bits_int32(ptab->r.o.pix_cl_mask);
- ptab->r.o.pix_cli_mask
- = (1 << (bits - ptab->r.o.pix_cli_shift)) - 1;
+ ASSERT((ix_per_cache_line & (ix_per_cache_line - 1)) == 0); /* power of 2 */
+ ASSERT((tab_cache_lines & (tab_cache_lines - 1)) == 0); /* power of 2 */
+
+ ptab->r.o.pix_mask = (1 << bits) - 1;
+ ptab->r.o.pix_cl_mask = tab_cache_lines-1;
+ ptab->r.o.pix_cl_shift = erts_fit_in_bits_int32(ix_per_cache_line-1);
+ ptab->r.o.pix_cli_shift = erts_fit_in_bits_int32(ptab->r.o.pix_cl_mask);
+ ptab->r.o.pix_cli_mask = (1 << (bits - ptab->r.o.pix_cli_shift)) - 1;
ASSERT(ptab->r.o.pix_cl_shift + ptab->r.o.pix_cli_shift == bits);
+ if (legacy) {
+ ptab->r.o.free_id_data = NULL;
+ ptab->r.o.dix_cl_mask = 0;
+ ptab->r.o.dix_cl_shift = 0;
+ ptab->r.o.dix_cli_shift = 0;
+ ptab->r.o.dix_cli_mask = 0;
+ }
+ else {
+
+ tab_sz = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(size*sizeof(Uint32));
+ ptab->r.o.free_id_data = (Uint32 *) tab_end;
+
+ tab_cache_lines = tab_sz/ERTS_CACHE_LINE_SIZE;
+ ix_per_cache_line = (ERTS_CACHE_LINE_SIZE/sizeof(Uint32));
+
+ ptab->r.o.dix_cl_mask = tab_cache_lines-1;
+ ptab->r.o.dix_cl_shift = erts_fit_in_bits_int32(ix_per_cache_line-1);
+ ptab->r.o.dix_cli_shift = erts_fit_in_bits_int32(ptab->r.o.dix_cl_mask);
+ ptab->r.o.dix_cli_mask = (1 << (bits - ptab->r.o.dix_cli_shift)) - 1;
+
+ ASSERT((ix_per_cache_line & (ix_per_cache_line - 1)) == 0); /* power of 2 */
+ ASSERT((tab_cache_lines & (tab_cache_lines - 1)) == 0); /* power of 2 */
+
+ ASSERT(ptab->r.o.dix_cl_shift + ptab->r.o.dix_cli_shift == bits);
+
+ ix = 0;
+ for (cl = 0; cl < tab_cache_lines; cl++) {
+ for (cli = 0; cli < ix_per_cache_line; cli++) {
+ ptab->r.o.free_id_data[ix] = cli*tab_cache_lines+cl;
+ ix++;
+ }
+ }
+
+ erts_smp_atomic32_init_nob(&ptab->vola.tile.aid_ix, -1);
+ erts_smp_atomic32_init_nob(&ptab->vola.tile.fid_ix, -1);
+
+ }
ptab->r.o.invalid_element = invalid_element;
ptab->r.o.invalid_data = erts_ptab_id2data(ptab, invalid_element->id);
ptab->r.o.release_element = release_element;
@@ -522,9 +578,7 @@ erts_ptab_new_element(ErtsPTab *ptab,
void *init_arg,
void (*init_ptab_el)(void *, Eterm))
{
- int pix;
- Uint64 ld, exp_ld;
- Eterm data;
+ Uint32 pix, ix, data;
erts_aint32_t count;
erts_aint_t invalid = (erts_aint_t) ptab->r.o.invalid_element;
@@ -551,62 +605,108 @@ erts_ptab_new_element(ErtsPTab *ptab,
ptab_el->u.alive.started_interval
= erts_smp_current_interval_nob(erts_ptab_interval(ptab));
- ld = last_data_read_acqb(ptab);
+ if (ptab->r.o.free_id_data) {
- /* Reserve slot */
- while (1) {
- ld++;
- pix = erts_ptab_data2pix(ptab, ERTS_PTAB_LastData2EtermData(ld));
- if (erts_smp_atomic_read_nob(&ptab->r.o.tab[pix]) == ERTS_AINT_NULL) {
- erts_aint_t val;
- val = erts_smp_atomic_cmpxchg_relb(&ptab->r.o.tab[pix],
- invalid,
- ERTS_AINT_NULL);
+ ix = (Uint32) erts_smp_atomic32_inc_read_acqb(&ptab->vola.tile.aid_ix);
+ ix = ix_to_free_id_data_ix(ptab, ix);
+
+ data = ptab->r.o.free_id_data[ix];
+
+ init_ptab_el(init_arg, (Eterm) data);
+
+#ifdef ERTS_SMP
+ erts_smp_atomic32_init_nob(&ptab_el->refc, 1);
+#endif
+
+ pix = erts_ptab_data2pix(ptab, (Eterm) data);
+
+#ifdef DEBUG
+ ASSERT(ERTS_AINT_NULL == erts_smp_atomic_xchg_relb(&ptab->r.o.tab[pix],
+ (erts_aint_t) ptab_el));
+#else
+ erts_smp_atomic_set_relb(&ptab->r.o.tab[pix], (erts_aint_t) ptab_el);
+#endif
+
+ erts_ptab_runlock(ptab);
- if (ERTS_AINT_NULL == val)
- break;
- }
}
+ else {
+ int rlocked = ERTS_PTAB_NEW_MAX_RESERVE_FAIL;
+ Uint64 ld, exp_ld;
+ /* Deprecated legacy algorithm... */
+
+ restart:
+
+ ptab_el->u.alive.started_interval
+ = erts_smp_current_interval_nob(erts_ptab_interval(ptab));
- data = ERTS_PTAB_LastData2EtermData(ld);
+ ld = last_data_read_acqb(ptab);
+
+ /* Reserve slot */
+ while (1) {
+ ld++;
+ pix = erts_ptab_data2pix(ptab, ERTS_PTAB_LastData2EtermData(ld));
+ if (erts_smp_atomic_read_nob(&ptab->r.o.tab[pix])
+ == ERTS_AINT_NULL) {
+ erts_aint_t val;
+ val = erts_smp_atomic_cmpxchg_relb(&ptab->r.o.tab[pix],
+ invalid,
+ ERTS_AINT_NULL);
+
+ if (ERTS_AINT_NULL == val)
+ break;
+ }
+ if (rlocked && --rlocked == 0) {
+ erts_ptab_runlock(ptab);
+ erts_ptab_rwlock(ptab);
+ goto restart;
+ }
+ }
- if (data == ptab->r.o.invalid_data) {
- /* Do not use invalid data; fix it... */
- ld += ptab->r.o.max;
- ASSERT(pix == erts_ptab_data2pix(ptab,
- ERTS_PTAB_LastData2EtermData(ld)));
data = ERTS_PTAB_LastData2EtermData(ld);
- ASSERT(data != ptab->r.o.invalid_data);
- }
- exp_ld = last_data_read_nob(ptab);
+ if (data == ptab->r.o.invalid_data) {
+ /* Do not use invalid data; fix it... */
+ ld += ptab->r.o.max;
+ ASSERT(pix == erts_ptab_data2pix(ptab,
+ ERTS_PTAB_LastData2EtermData(ld)));
+ data = ERTS_PTAB_LastData2EtermData(ld);
+ ASSERT(data != ptab->r.o.invalid_data);
+ }
- /* Move last data forward */
- while (1) {
- Uint64 act_ld;
- if (last_data_cmp(ld, exp_ld) < 0)
- break;
- act_ld = last_data_cmpxchg_relb(ptab, ld, exp_ld);
- if (act_ld == exp_ld)
- break;
- exp_ld = act_ld;
- }
+ exp_ld = last_data_read_nob(ptab);
+
+ /* Move last data forward */
+ while (1) {
+ Uint64 act_ld;
+ if (last_data_cmp(ld, exp_ld) < 0)
+ break;
+ act_ld = last_data_cmpxchg_relb(ptab, ld, exp_ld);
+ if (act_ld == exp_ld)
+ break;
+ exp_ld = act_ld;
+ }
- init_ptab_el(init_arg, data);
+ init_ptab_el(init_arg, data);
#ifdef ERTS_SMP
- erts_smp_atomic32_init_nob(&ptab_el->refc, 1);
+ erts_smp_atomic32_init_nob(&ptab_el->refc, 1);
#endif
- /* Move into slot reserved */
+ /* Move into slot reserved */
#ifdef DEBUG
- ASSERT(invalid == erts_smp_atomic_xchg_relb(&ptab->r.o.tab[pix],
+ ASSERT(invalid == erts_smp_atomic_xchg_relb(&ptab->r.o.tab[pix],
(erts_aint_t) ptab_el));
#else
- erts_smp_atomic_set_relb(&ptab->r.o.tab[pix], (erts_aint_t) ptab_el);
+ erts_smp_atomic_set_relb(&ptab->r.o.tab[pix], (erts_aint_t) ptab_el);
#endif
- erts_ptab_runlock(ptab);
+ if (rlocked)
+ erts_ptab_runlock(ptab);
+ else
+ erts_ptab_rwunlock(ptab);
+
+ }
return 1;
}
@@ -647,7 +747,9 @@ erts_ptab_delete_element(ErtsPTab *ptab,
ErtsPTabElementCommon *ptab_el)
{
int maybe_save;
- int pix = erts_ptab_id2pix(ptab, ptab_el->id);
+ Uint32 pix, ix, data;
+
+ pix = erts_ptab_id2pix(ptab, ptab_el->id);
ASSERT(erts_get_scheduler_id()); /* *Need* to be a scheduler */
@@ -660,6 +762,26 @@ erts_ptab_delete_element(ErtsPTab *ptab,
erts_smp_atomic_set_relb(&ptab->r.o.tab[pix], ERTS_AINT_NULL);
+ if (ptab->r.o.free_id_data) {
+
+ /* Next data for this slot... */
+ data = (Uint32) erts_ptab_id2data(ptab, ptab_el->id);
+ data += ptab->r.o.max;
+ data &= ~(~((Uint32) 0) << ERTS_PTAB_ID_DATA_SIZE);
+ if (data == ptab->r.o.invalid_data) { /* make sure not invalid */
+ data += ptab->r.o.max;
+ data &= ~(~((Uint32) 0) << ERTS_PTAB_ID_DATA_SIZE);
+ }
+
+ ASSERT(data != ptab->r.o.invalid_data);
+ ASSERT(pix == erts_ptab_data2pix(ptab, data));
+
+ ix = (Uint32) erts_smp_atomic32_inc_read_relb(&ptab->vola.tile.fid_ix);
+ ix = ix_to_free_id_data_ix(ptab, ix);
+
+ ptab->r.o.free_id_data[ix] = data;
+ }
+
ASSERT(erts_smp_atomic32_read_nob(&ptab->vola.tile.count) > 0);
erts_smp_atomic32_dec_relb(&ptab->vola.tile.count);
@@ -1280,42 +1402,86 @@ erts_ptab_test_next_id(ErtsPTab *ptab, int set, Uint next)
erts_ptab_rwlock(ptab);
- if (!set)
- ld = last_data_read_nob(ptab);
- else {
+ if (ptab->r.o.free_id_data) {
+ Uint32 aid_ix, dix;
- ld = (Uint64) next;
- data = ERTS_PTAB_LastData2EtermData(ld);
- if (ptab->r.o.invalid_data == data) {
- ld += ptab->r.o.max;
- ASSERT(erts_ptab_data2pix(ptab, data)
- == erts_ptab_data2pix(ptab,
- ERTS_PTAB_LastData2EtermData(ld)));
+ if (set) {
+ Uint32 max_ix, ser, num, start;
+ max_ix = ptab->r.o.max - 1;
+ ser = next & ~max_ix;
+ start = num = next & max_ix;
+
+ aid_ix = (Uint32) erts_smp_atomic32_read_nob(&ptab->vola.tile.aid_ix) + 1;
+
+ do {
+ Uint32 pix = erts_ptab_data2pix(ptab, num);
+ if (ERTS_AINT_NULL == erts_ptab_pix2intptr_nob(ptab, pix)) {
+ dix = ix_to_free_id_data_ix(ptab, aid_ix);
+ ptab->r.o.free_id_data[dix] = ser + num;
+ ASSERT(pix == erts_ptab_data2pix(ptab, ser+num));
+ if (aid_ix == max_ix)
+ aid_ix = 0;
+ else
+ aid_ix++;
+ }
+ if (num == max_ix)
+ num = 0;
+ else
+ num++;
+ } while (num != start);
+
+#ifdef DEBUG
+ if (aid_ix == 0)
+ aid_ix = max_ix;
+ else
+ aid_ix--;
+ ASSERT((aid_ix & max_ix) == (((Uint32) erts_atomic32_read_nob(&ptab->vola.tile.fid_ix)) & max_ix));
+#endif
}
- last_data_set_relb(ptab, ld);
+
+ aid_ix = (Uint32) erts_smp_atomic32_read_nob(&ptab->vola.tile.aid_ix) + 1;
+ dix = ix_to_free_id_data_ix(ptab, aid_ix);
+ res = (Sint) ptab->r.o.free_id_data[dix];
}
+ else {
+ /* Deprecated legacy algorithm... */
+ if (!set)
+ ld = last_data_read_nob(ptab);
+ else {
- while (1) {
- int pix;
- ld++;
- pix = (int) (ld % ptab->r.o.max);
- if (first_pix < 0)
- first_pix = pix;
- else if (pix == first_pix) {
- res = -1;
- break;
- }
- if (ERTS_AINT_NULL == erts_ptab_pix2intptr_nob(ptab, pix)) {
+ ld = (Uint64) next;
data = ERTS_PTAB_LastData2EtermData(ld);
if (ptab->r.o.invalid_data == data) {
ld += ptab->r.o.max;
ASSERT(erts_ptab_data2pix(ptab, data)
== erts_ptab_data2pix(ptab,
ERTS_PTAB_LastData2EtermData(ld)));
+ }
+ last_data_set_relb(ptab, ld);
+ }
+
+ while (1) {
+ int pix;
+ ld++;
+ pix = (int) (ld % ptab->r.o.max);
+ if (first_pix < 0)
+ first_pix = pix;
+ else if (pix == first_pix) {
+ res = -1;
+ break;
+ }
+ if (ERTS_AINT_NULL == erts_ptab_pix2intptr_nob(ptab, pix)) {
data = ERTS_PTAB_LastData2EtermData(ld);
+ if (ptab->r.o.invalid_data == data) {
+ ld += ptab->r.o.max;
+ ASSERT(erts_ptab_data2pix(ptab, data)
+ == erts_ptab_data2pix(ptab,
+ ERTS_PTAB_LastData2EtermData(ld)));
+ data = ERTS_PTAB_LastData2EtermData(ld);
+ }
+ res = data;
+ break;
}
- res = data;
- break;
}
}
diff --git a/erts/emulator/beam/erl_ptab.h b/erts/emulator/beam/erl_ptab.h
index 7fa1251900..84ff7d0de4 100644
--- a/erts/emulator/beam/erl_ptab.h
+++ b/erts/emulator/beam/erl_ptab.h
@@ -94,18 +94,23 @@ typedef struct {
erts_smp_atomic_t last_data;
#endif
erts_smp_atomic32_t count;
+ erts_smp_atomic32_t aid_ix;
+ erts_smp_atomic32_t fid_ix;
} ErtsPTabVolatileData;
typedef struct {
erts_smp_atomic_t *tab;
+ Uint32 *free_id_data;
Uint32 max;
- Uint32 tab_cache_lines;
- Uint32 pix_per_cache_line;
Uint32 pix_mask;
Uint32 pix_cl_mask;
Uint32 pix_cl_shift;
Uint32 pix_cli_mask;
Uint32 pix_cli_shift;
+ Uint32 dix_cl_mask;
+ Uint32 dix_cl_shift;
+ Uint32 dix_cli_mask;
+ Uint32 dix_cli_shift;
ErtsPTabElementCommon *invalid_element;
Eterm invalid_data;
void (*release_element)(void *);
@@ -179,7 +184,8 @@ void erts_ptab_init_table(ErtsPTab *ptab,
ErtsPTabElementCommon *invalid_element,
int size,
UWord element_size,
- char *name);
+ char *name,
+ int legacy);
int erts_ptab_new_element(ErtsPTab *ptab,
ErtsPTabElementCommon *ptab_el,
void *init_arg,
@@ -187,6 +193,7 @@ int erts_ptab_new_element(ErtsPTab *ptab,
void erts_ptab_delete_element(ErtsPTab *ptab,
ErtsPTabElementCommon *ptab_el);
int erts_ptab_initialized(ErtsPTab *ptab);
+UWord erts_ptab_mem_size(ErtsPTab *ptab);
ERTS_GLB_INLINE erts_interval_t *erts_ptab_interval(ErtsPTab *ptab);
ERTS_GLB_INLINE int erts_ptab_max(ErtsPTab *ptab);
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index 012c1c7e6a..d5e727bcba 100755
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -688,12 +688,6 @@ void MD5Final(unsigned char [16], MD5_CTX *);
/* ggc.c */
-
-typedef struct {
- Uint garbage_collections;
- Uint reclaimed;
-} ErtsGCInfo;
-
void erts_gc_info(ErtsGCInfo *gcip);
void erts_init_gc(void);
int erts_garbage_collect(Process*, int, Eterm*, int);
@@ -724,15 +718,15 @@ int erts_add_driver_entry(ErlDrvEntry *drv, DE_Handle *handle, int driver_list_l
void erts_destroy_driver(erts_driver_t *drv);
int erts_save_suspend_process_on_port(Port*, Process*);
Port *erts_open_driver(erts_driver_t*, Eterm, char*, SysDriverOpts*, int *, int *);
-void erts_init_io(int, int);
+void erts_init_io(int, int, int);
void erts_raw_port_command(Port*, byte*, Uint);
void driver_report_exit(ErlDrvPort, int);
LineBuf* allocate_linebuf(int);
int async_ready(Port *, void*);
-ErtsPortNames *erts_get_port_names(Eterm);
+ErtsPortNames *erts_get_port_names(Eterm, ErlDrvPort);
void erts_free_port_names(ErtsPortNames *);
Uint erts_port_ioq_size(Port *pp);
-void erts_stale_drv_select(Eterm, ErlDrvEvent, int, int);
+void erts_stale_drv_select(Eterm, ErlDrvPort, ErlDrvEvent, int, int);
Port *erts_get_heart_port(void);
diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c
index b6b7b47bd6..01e130bd64 100644
--- a/erts/emulator/beam/io.c
+++ b/erts/emulator/beam/io.c
@@ -2707,7 +2707,8 @@ erts_port_link(Process *c_p, Port *prt, Eterm to, Eterm *refp)
}
void erts_init_io(int port_tab_size,
- int port_tab_size_ignore_files)
+ int port_tab_size_ignore_files,
+ int legacy_port_tab)
{
ErlDrvEntry** dp;
UWord common_element_size;
@@ -2750,7 +2751,8 @@ void erts_init_io(int port_tab_size,
(ErtsPTabElementCommon *) &erts_invalid_port.common,
port_tab_size,
common_element_size, /* Doesn't need to be excact */
- "port_table");
+ "port_table",
+ legacy_port_tab);
erts_smp_atomic_init_nob(&erts_bytes_out, 0);
erts_smp_atomic_init_nob(&erts_bytes_in, 0);
@@ -4812,7 +4814,8 @@ int async_ready(Port *p, void* data)
static void
report_missing_drv_callback(Port *p, char *drv_type, char *callback)
{
- ErtsPortNames *pnp = erts_get_port_names(p->common.id);
+ ErtsPortNames *pnp = erts_get_port_names(p->common.id,
+ ERTS_Port2ErlDrvPort(p));
char *unknown = "<unknown>";
char *drv_name = pnp->driver_name ? pnp->driver_name : unknown;
char *prt_name = pnp->name ? pnp->name : unknown;
@@ -4827,15 +4830,25 @@ report_missing_drv_callback(Port *p, char *drv_type, char *callback)
void
erts_stale_drv_select(Eterm port,
+ ErlDrvPort drv_port,
ErlDrvEvent hndl,
int mode,
int deselect)
{
char *type;
- ErlDrvPort drv_port = ERTS_Port2ErlDrvPort(erts_port_lookup_raw(port));
- ErtsPortNames *pnp = erts_get_port_names(port);
+ ErtsPortNames *pnp;
erts_dsprintf_buf_t *dsbufp;
+ if (drv_port == ERTS_INVALID_ERL_DRV_PORT) {
+ Port *prt = erts_port_lookup_raw(port);
+ if (prt)
+ drv_port = ERTS_Port2ErlDrvPort(port);
+ else
+ drv_port = ERTS_INVALID_ERL_DRV_PORT;
+ }
+
+ pnp = erts_get_port_names(port, drv_port);
+
switch (mode) {
case ERL_DRV_READ | ERL_DRV_WRITE:
type = "Input/Output";
@@ -4870,12 +4883,16 @@ erts_stale_drv_select(Eterm port,
}
ErtsPortNames *
-erts_get_port_names(Eterm id)
+erts_get_port_names(Eterm id, ErlDrvPort drv_port)
{
- Port *prt = erts_port_lookup_raw(id);
+ Port *prt;
ErtsPortNames *pnp;
ASSERT(is_nil(id) || is_internal_port(id));
+ prt = ERTS_ErlDrvPort2Port(drv_port);
+ if (prt == ERTS_INVALID_ERL_DRV_PORT)
+ prt = erts_port_lookup_raw(id);
+
if (!prt) {
pnp = erts_alloc(ERTS_ALC_T_PORT_NAMES, sizeof(ErtsPortNames));
pnp->name = NULL;
@@ -4887,6 +4904,7 @@ erts_get_port_names(Eterm id)
size_t pnp_len = sizeof(ErtsPortNames);
#ifndef DEBUG
pnp_len += 100; /* In most cases 100 characters will be enough... */
+ ASSERT(prt->common.id == id);
#endif
pnp = erts_alloc(ERTS_ALC_T_PORT_NAMES, pnp_len);
do {
diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c
index 6cc1295973..595b0488a8 100644
--- a/erts/emulator/drivers/common/efile_drv.c
+++ b/erts/emulator/drivers/common/efile_drv.c
@@ -1679,10 +1679,10 @@ static void invoke_pwritev(void *data) {
d->again = 0;
}
} else
- ASSERT(written == FILE_SEGMENT_WRITE);
+ ASSERT(written >= FILE_SEGMENT_WRITE);
MUTEX_LOCK(d->c.writev.q_mtx);
- driver_deq(d->c.pwritev.port, size);
+ driver_deq(d->c.pwritev.port, written);
MUTEX_UNLOCK(d->c.writev.q_mtx);
done:
EF_FREE(iov); /* Free our copy of the vector, nothing to restore */
diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c
index 853dd90c34..7035dc77df 100644
--- a/erts/emulator/sys/common/erl_check_io.c
+++ b/erts/emulator/sys/common/erl_check_io.c
@@ -874,7 +874,7 @@ need2steal(ErtsDrvEventState *state, int mode)
static void
print_driver_name(erts_dsprintf_buf_t *dsbufp, Eterm id)
{
- ErtsPortNames *pnp = erts_get_port_names(id);
+ ErtsPortNames *pnp = erts_get_port_names(id, ERTS_INVALID_ERL_DRV_PORT);
if (!pnp->name && !pnp->driver_name)
erts_dsprintf(dsbufp, "%s ", "<unknown>");
else {
@@ -1357,8 +1357,8 @@ bad_fd_in_pollset(ErtsDrvEventState *state, Eterm inport,
"Bad %s fd in erts_poll()! fd=%d, ",
io_str, (int) state->fd);
if (is_nil(port)) {
- ErtsPortNames *ipnp = erts_get_port_names(inport);
- ErtsPortNames *opnp = erts_get_port_names(outport);
+ ErtsPortNames *ipnp = erts_get_port_names(inport, ERTS_INVALID_ERL_DRV_PORT);
+ ErtsPortNames *opnp = erts_get_port_names(outport, ERTS_INVALID_ERL_DRV_PORT);
erts_dsprintf(dsbufp, "ports=%T/%T, drivers=%s/%s, names=%s/%s\n",
is_nil(inport) ? am_undefined : inport,
is_nil(outport) ? am_undefined : outport,
@@ -1370,7 +1370,7 @@ bad_fd_in_pollset(ErtsDrvEventState *state, Eterm inport,
erts_free_port_names(opnp);
}
else {
- ErtsPortNames *pnp = erts_get_port_names(port);
+ ErtsPortNames *pnp = erts_get_port_names(port, ERTS_INVALID_ERL_DRV_PORT);
erts_dsprintf(dsbufp, "port=%T, driver=%s, name=%s\n",
is_nil(port) ? am_undefined : port,
pnp->driver_name ? pnp->driver_name : "<unknown>",
@@ -1390,7 +1390,7 @@ bad_fd_in_pollset(ErtsDrvEventState *state, Eterm inport,
static void
stale_drv_select(Eterm id, ErtsDrvEventState *state, int mode)
{
- erts_stale_drv_select(id, (ErlDrvEvent) state->fd, mode, 0);
+ erts_stale_drv_select(id, ERTS_INVALID_ERL_DRV_PORT, (ErlDrvEvent) state->fd, mode, 0);
deselect(state, mode);
}
@@ -1774,7 +1774,7 @@ static void doit_erts_check_io_debug(void *vstate, void *vcounters)
err = 1;
}
else {
- ErtsPortNames *pnp = erts_get_port_names(id);
+ ErtsPortNames *pnp = erts_get_port_names(id, ERTS_INVALID_ERL_DRV_PORT);
erts_printf(" inport=%T inname=%s indrv=%s ",
id,
pnp->name ? pnp->name : "unknown",
@@ -1791,7 +1791,7 @@ static void doit_erts_check_io_debug(void *vstate, void *vcounters)
err = 1;
}
else {
- ErtsPortNames *pnp = erts_get_port_names(id);
+ ErtsPortNames *pnp = erts_get_port_names(id, ERTS_INVALID_ERL_DRV_PORT);
erts_printf(" outport=%T outname=%s outdrv=%s ",
id,
pnp->name ? pnp->name : "unknown",
@@ -1827,7 +1827,7 @@ static void doit_erts_check_io_debug(void *vstate, void *vcounters)
err = 1;
}
else {
- ErtsPortNames *pnp = erts_get_port_names(id);
+ ErtsPortNames *pnp = erts_get_port_names(id, ERTS_INVALID_ERL_DRV_PORT);
erts_printf(" port=%T name=%s drv=%s ",
id,
pnp->name ? pnp->name : "unknown",
diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl
index 22b5d93983..33abd45982 100644
--- a/erts/emulator/test/alloc_SUITE.erl
+++ b/erts/emulator/test/alloc_SUITE.erl
@@ -28,7 +28,8 @@
bucket_index/1,
bucket_mask/1,
rbtree/1,
- mseg_clear_cache/1]).
+ mseg_clear_cache/1,
+ cpool/1]).
-export([init_per_testcase/2, end_per_testcase/2]).
@@ -40,7 +41,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[basic, coalesce, threads, realloc_copy, bucket_index,
- bucket_mask, rbtree, mseg_clear_cache].
+ bucket_mask, rbtree, mseg_clear_cache, cpool].
groups() ->
[].
@@ -105,6 +106,10 @@ mseg_clear_cache(suite) -> [];
mseg_clear_cache(doc) -> [];
mseg_clear_cache(Cfg) -> ?line drv_case(Cfg).
+cpool(suite) -> [];
+cpool(doc) -> [];
+cpool(Cfg) -> ?line drv_case(Cfg).
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% %%
%% Internal functions %%
diff --git a/erts/emulator/test/alloc_SUITE_data/Makefile.src b/erts/emulator/test/alloc_SUITE_data/Makefile.src
index 035415d73e..1d4286e671 100644
--- a/erts/emulator/test/alloc_SUITE_data/Makefile.src
+++ b/erts/emulator/test/alloc_SUITE_data/Makefile.src
@@ -23,7 +23,8 @@ TEST_DRVS = basic@dll@ \
bucket_index@dll@ \
bucket_mask@dll@ \
rbtree@dll@ \
- mseg_clear_cache@dll@
+ mseg_clear_cache@dll@ \
+ cpool@dll@
CC = @CC@
LD = @LD@
diff --git a/erts/emulator/test/alloc_SUITE_data/allocator_test.h b/erts/emulator/test/alloc_SUITE_data/allocator_test.h
index c0396ddb61..c37b074f93 100644
--- a/erts/emulator/test/alloc_SUITE_data/allocator_test.h
+++ b/erts/emulator/test/alloc_SUITE_data/allocator_test.h
@@ -75,6 +75,15 @@ typedef void* erts_cond;
#define PREV_BLK(B) ((Block_t *) ALC_TEST1(0x019, (B)))
#define IS_MBC_FIRST_BLK(A,B) ((Ulong) ALC_TEST2(0x01a, (A), (B)))
#define UNIT_SZ ((Ulong) ALC_TEST0(0x01b))
+#define BLK_TO_MBC(B) ((Carrier_t *) ALC_TEST1(0x01c, (B)))
+#define ADD_MBC(A, C) ((void) ALC_TEST2(0x01d, (A), (C)))
+#define REMOVE_MBC(A, C) ((void) ALC_TEST2(0x01e, (A), (C)))
+#define ZERO_CRR_SIZE ((Ulong) ALC_TEST0(0x01f))
+#define ZERO_CRR_INIT(A,B) ((Carrier_t *) ALC_TEST2(0x020, (A), (B)))
+#define CPOOL_INSERT(A,B) ((Carrier_t *) ALC_TEST2(0x021, (A), (B)))
+#define CPOOL_DELETE(A,B) ((Carrier_t *) ALC_TEST2(0x022, (A), (B)))
+#define CPOOL_IS_EMPTY(A) ((int) ALC_TEST1(0x023, (A)))
+#define CPOOL_IS_IN_POOL(A,B) ((int) ALC_TEST2(0x024, (A), (B)))
/* From erl_goodfit_alloc.c */
#define BKT_IX(A, S) ((Ulong) ALC_TEST2(0x100, (A), (S)))
@@ -84,15 +93,16 @@ typedef void* erts_cond;
/* From erl_bestfit_alloc.c and erl_ao_firstfit_alloc.c */
#define IS_AOBF(A) ((Ulong) ALC_TEST1(RBT_OP(0), (A)))
-#define RBT_ROOT(A) ((RBT_t *) ALC_TEST1(RBT_OP(1), (A)))
+#define RBT_ROOT(A,SZ) ((RBT_t *) ALC_TEST2(RBT_OP(1), (A), (SZ)))
#define RBT_PARENT(T) ((RBT_t *) ALC_TEST1(RBT_OP(2), (T)))
#define RBT_LEFT(T) ((RBT_t *) ALC_TEST1(RBT_OP(3), (T)))
#define RBT_RIGHT(T) ((RBT_t *) ALC_TEST1(RBT_OP(4), (T)))
#define RBT_NEXT(T) ((RBTL_t *) ALC_TEST1(RBT_OP(5), (T)))
#define RBT_IS_BLACK(T) ((Ulong) ALC_TEST1(RBT_OP(6), (T)))
#define RBT_IS_TREE(T) ((Ulong) ALC_TEST1(RBT_OP(7), (T)))
-#define IS_AOFF(A) ((Ulong) ALC_TEST1(RBT_OP(8), (A)))
+#define IS_BF_ALGO(A) ((Ulong) ALC_TEST1(RBT_OP(8), (A)))
#define RBT_MAX_SZ(T) ((Ulong) ALC_TEST1(RBT_OP(9), (T)))
+#define IS_CBF(A) ((Ulong) ALC_TEST1(RBT_OP(0xa), (A)))
/* From erl_mseg.c */
#define HAVE_MSEG() ((int) ALC_TEST0(0x400))
@@ -129,5 +139,6 @@ typedef void* erts_cond;
#define THR_CREATE(F, A) ((erts_thread) ALC_TEST2(0xf10, (F), (A)))
#define THR_JOIN(T) ((void) ALC_TEST1(0xf11, (T)))
#define THR_EXIT(R) ((void) ALC_TEST1(0xf12, (R)))
+#define IS_SMP_ENABLED ((int) ALC_TEST0(0xf13))
#endif
diff --git a/erts/emulator/test/alloc_SUITE_data/coalesce.c b/erts/emulator/test/alloc_SUITE_data/coalesce.c
index 981fa6d43e..36710bf7b5 100644
--- a/erts/emulator/test/alloc_SUITE_data/coalesce.c
+++ b/erts/emulator/test/alloc_SUITE_data/coalesce.c
@@ -267,7 +267,7 @@ void
testcase_run(TestCaseState_t *tcs)
{
char *argv_org[] = {"-tsmbcs511","-tmmbcs511", "-tsbct512", "-trmbcmt100", "-tas", NULL, NULL};
- char *alg[] = {"af", "gf", "bf", "aobf", "aoff", NULL};
+ char *alg[] = {"af", "gf", "bf", "aobf", "aoff", "aoffcaobf", NULL};
int i;
for (i = 0; alg[i]; i++) {
diff --git a/erts/emulator/test/alloc_SUITE_data/cpool.c b/erts/emulator/test/alloc_SUITE_data/cpool.c
new file mode 100644
index 0000000000..276ed7be04
--- /dev/null
+++ b/erts/emulator/test/alloc_SUITE_data/cpool.c
@@ -0,0 +1,157 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2013. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+
+#ifndef __WIN32__
+#include <sys/types.h>
+#include <unistd.h>
+#include <errno.h>
+#endif
+#include <stdio.h>
+#include <stdarg.h>
+#include <string.h>
+#include "testcase_driver.h"
+#include "allocator_test.h"
+
+#define FATAL_ASSERT(A) \
+ ((void) ((A) \
+ ? 1 \
+ : (fatal_assert_failed(#A, \
+ (char *) __FILE__, \
+ __LINE__), \
+ 0)))
+
+static void
+fatal_assert_failed(char* expr, char* file, int line)
+{
+ fflush(stdout);
+ fprintf(stderr, "%s:%d: Assertion failed: %s\n",
+ file, line, expr);
+ fflush(stderr);
+ abort();
+}
+
+#define TEST_NO_THREADS 10
+#define TEST_NO_CARRIERS_PER_THREAD 100000
+#define TEST_CARRIERS_OFFSET 5
+
+static Allctr_t *alloc = NULL;
+
+static void stop_allocator(void)
+{
+ if (alloc) {
+ STOP_ALC(alloc);
+ alloc = NULL;
+ }
+}
+
+
+void *thread_func(void *arg);
+
+char *
+testcase_name(void)
+{
+ return "cpool";
+}
+
+void
+testcase_cleanup(TestCaseState_t *tcs)
+{
+ stop_allocator();
+}
+
+void *
+thread_func(void *arg)
+{
+ Carrier_t *crr = (Carrier_t *) arg;
+ int i;
+
+ for (i = 0; i < (TEST_NO_CARRIERS_PER_THREAD+TEST_CARRIERS_OFFSET); i++) {
+ int d;
+ if (i < TEST_NO_CARRIERS_PER_THREAD) {
+ CPOOL_INSERT(alloc, crr[i]);
+ if ((i & 0x7) == 0)
+ FATAL_ASSERT(CPOOL_IS_IN_POOL(alloc, crr[i]));
+ }
+ d = i-TEST_CARRIERS_OFFSET;
+ if (d >= 0) {
+ CPOOL_DELETE(alloc, crr[d]);
+ if ((d & 0x7) == 0)
+ FATAL_ASSERT(!CPOOL_IS_IN_POOL(alloc, crr[d]));
+ }
+ }
+ for (i = 0; i < TEST_NO_CARRIERS_PER_THREAD; i++)
+ FATAL_ASSERT(!CPOOL_IS_IN_POOL(alloc, crr[i]));
+ return NULL;
+}
+
+static struct {
+ erts_thread tid;
+ Carrier_t *crr[TEST_NO_CARRIERS_PER_THREAD];
+} threads[TEST_NO_THREADS] = {{0}};
+
+void
+testcase_run(TestCaseState_t *tcs)
+{
+ int no_threads, t, c;
+ char *block, *p;
+ Ulong zcrr_sz;
+
+ if (!IS_SMP_ENABLED)
+ testcase_skipped(tcs, "No SMP support");
+
+ alloc = START_ALC("Zero carrier allocator", 1, NULL);
+
+ zcrr_sz = ZERO_CRR_SIZE;
+
+ block = p = ALLOC(alloc, zcrr_sz*TEST_NO_THREADS*TEST_NO_CARRIERS_PER_THREAD);
+
+ ASSERT(tcs, block != NULL);
+
+ for (t = 0; t < TEST_NO_THREADS; t++) {
+ for (c = 0; c < TEST_NO_CARRIERS_PER_THREAD; c++) {
+ Carrier_t *crr = (Carrier_t *) p;
+ p += zcrr_sz;
+ ZERO_CRR_INIT(alloc, crr);
+ threads[t].crr[c] = crr;
+ }
+ }
+
+ no_threads = 0;
+ for (t = 0; t < TEST_NO_THREADS; t++) {
+ threads[t].tid = THR_CREATE(thread_func, (void *) threads[t].crr);
+ if (threads[t].tid) {
+ testcase_printf(tcs, "Successfully created thread %d\n", t);
+ no_threads++;
+ }
+ else {
+ testcase_printf(tcs, "Failed to create thread %d\n", t);
+ break;
+ }
+ }
+
+ for (t = 0; t < no_threads; t++)
+ THR_JOIN(threads[t].tid);
+
+ FATAL_ASSERT(CPOOL_IS_EMPTY(alloc));
+
+ FREE(alloc, block);
+
+ ASSERT(tcs, no_threads == TEST_NO_THREADS);
+}
diff --git a/erts/emulator/test/alloc_SUITE_data/rbtree.c b/erts/emulator/test/alloc_SUITE_data/rbtree.c
index 4e7f821baf..702f075304 100644
--- a/erts/emulator/test/alloc_SUITE_data/rbtree.c
+++ b/erts/emulator/test/alloc_SUITE_data/rbtree.c
@@ -85,7 +85,7 @@ print_tree(TestCaseState_t *tcs, RBT_t *root)
static RBT_t *
check_tree(TestCaseState_t *tcs, Allctr_t *alc, Ulong size)
{
- enum { BF, AOBF, AOFF }type;
+ enum { BF, AOBF, AOFF, AOFFCAOBF }type;
int i, max_i;
char stk[128];
RBT_t *root, *x, *y, *res;
@@ -94,11 +94,16 @@ check_tree(TestCaseState_t *tcs, Allctr_t *alc, Ulong size)
res = NULL;
- if (IS_AOBF(alc)) type = AOBF;
- else if (IS_AOFF(alc)) type = AOFF;
- else type = BF;
+ if (IS_BF_ALGO(alc)) {
+ if (IS_AOBF(alc)) type = AOBF;
+ else type = BF;
+ }
+ else { /* AOFF_ALGO */
+ if (IS_CBF(alc)) type = AOFFCAOBF;
+ else type = AOFF;
+ }
- root = RBT_ROOT(alc);
+ root = RBT_ROOT(alc, size);
#ifdef PRINT_TREE
print_tree(tcs, root);
@@ -188,6 +193,15 @@ check_tree(TestCaseState_t *tcs, Allctr_t *alc, Ulong size)
ASSERT(tcs, y < x);
ASSERT(tcs, RBT_MAX_SZ(y) <= RBT_MAX_SZ(x));
break;
+ case AOFFCAOBF:
+ {
+ void* x_crr = BLK_TO_MBC(x);
+ void* y_crr = BLK_TO_MBC(y);
+ ASSERT(tcs, (y < x && (x_crr != y_crr || x_sz == y_sz))
+ || (y_sz < x_sz && x_crr == y_crr));
+ ASSERT(tcs, RBT_MAX_SZ(y) <= RBT_MAX_SZ(x));
+ break;
+ }
}
}
@@ -207,6 +221,15 @@ check_tree(TestCaseState_t *tcs, Allctr_t *alc, Ulong size)
ASSERT(tcs, y > x);
ASSERT(tcs, RBT_MAX_SZ(y) <= RBT_MAX_SZ(x));
break;
+ case AOFFCAOBF:
+ {
+ void* x_crr = BLK_TO_MBC(x);
+ void* y_crr = BLK_TO_MBC(y);
+ ASSERT(tcs, (y > x && (x_crr != y_crr || x_sz == y_sz))
+ || (y_sz > x_sz && x_crr == y_crr));
+ ASSERT(tcs, RBT_MAX_SZ(y) <= RBT_MAX_SZ(x));
+ break;
+ }
}
}
@@ -239,7 +262,18 @@ check_tree(TestCaseState_t *tcs, Allctr_t *alc, Ulong size)
res = x;
}
break;
+ case AOFFCAOBF:
+ if (BLK_TO_MBC(x) != BLK_TO_MBC(res) || x_sz == y_sz) {
+ if (x < res) {
+ res = x;
+ }
+ }
+ else if (x_sz < y_sz) {
+ res = x;
+ }
+ break;
}
+
}
}
@@ -263,17 +297,20 @@ check_tree(TestCaseState_t *tcs, Allctr_t *alc, Ulong size)
}
static void
-do_check(TestCaseState_t *tcs, Allctr_t *a, Ulong size)
+do_check(TestCaseState_t *tcs, Allctr_t *a, Ulong size, int ignore_null)
{
Ulong sz = ((size + 7) / 8)*8;
void *tmp;
Block_t *x, *y;
x = (Block_t *) check_tree(tcs, a, sz);
+ if (!x && ignore_null)
+ return;
+
tmp = ALLOC(a, sz - ABLK_HDR_SZ);
ASSERT(tcs, tmp);
y = UMEM2BLK(tmp);
- if (IS_AOBF(a)) {
+ if (!(IS_BF_ALGO(a) && !IS_AOBF(a))) {
ASSERT(tcs, x == y);
}
else {
@@ -306,7 +343,7 @@ test_it(TestCaseState_t *tcs)
blk[i] = NULL;
}
if (i % (NO_BLOCKS/2) == 0)
- do_check(tcs, a, 50);
+ do_check(tcs, a, 50, 0);
}
for (i = 0; i < NO_BLOCKS; i++) {
@@ -315,7 +352,7 @@ test_it(TestCaseState_t *tcs)
blk[i] = NULL;
}
if (i % (NO_BLOCKS/2) == 0)
- do_check(tcs, a, 200);
+ do_check(tcs, a, 200, 0);
}
for (i = 0; i < NO_BLOCKS; i++) {
@@ -324,20 +361,101 @@ test_it(TestCaseState_t *tcs)
blk[i] = NULL;
}
if (i % (NO_BLOCKS/2) == 0)
- do_check(tcs, a, 100);
+ do_check(tcs, a, 100, 0);
}
- do_check(tcs, a, 250);
+ do_check(tcs, a, 250, 0);
for (i = 0; i < NO_BLOCKS; i++) {
FREE(a, fence[i]);
if (i % (NO_BLOCKS/3) == 0)
- do_check(tcs, a, 300);
+ do_check(tcs, a, 300, 0);
+ }
+
+ ASSERT(tcs, RBT_ROOT(a,0));
+ ASSERT(tcs, !RBT_LEFT(RBT_ROOT(a,0)));
+ ASSERT(tcs, !RBT_RIGHT(RBT_ROOT(a,0)));
+}
+
+
+static int is_single_ablk_in_mbc(Allctr_t* a, void* ptr, void* crr)
+{
+ Block_t* blk = UMEM2BLK(ptr);
+ if (crr == BLK_TO_MBC(blk)) {
+ Block_t* first = MBC_TO_FIRST_BLK(a, crr);
+ if (blk == first || (IS_FREE_BLK(first) && blk == NXT_BLK(first))) {
+ Block_t* nxt;
+ if (IS_LAST_BLK(blk)) {
+ return 1;
+ }
+ nxt = NXT_BLK(blk);
+ return IS_FREE_BLK(nxt) && IS_LAST_BLK(nxt);
+ }
+ }
+ return 0;
+}
+
+static void
+test_carrier_migration(TestCaseState_t *tcs)
+{
+ int i, j;
+ Allctr_t* a = ((rbtree_test_data *) tcs->extra)->allocator;
+ void **blk = ((rbtree_test_data *) tcs->extra)->blk;
+ void **fence = ((rbtree_test_data *) tcs->extra)->fence;
+ void *crr, *p, *free_crr;
+ Ulong min_blk_sz;
+
+ min_blk_sz = MIN_BLK_SZ(a);
+
+ for (i = 0; i < NO_BLOCKS; i++) {
+ blk[i] = ALLOC(a, min_blk_sz + i % 500);
+ fence[i] = ALLOC(a, 1);
+ ASSERT(tcs, blk[i] && fence[i]);
+ }
+
+ for (j = 0; j < NO_BLOCKS; j += 997) {
+ crr = BLK_TO_MBC(UMEM2BLK(blk[j]));
+ REMOVE_MBC(a, crr);
+
+ for (i = 0; i < NO_BLOCKS; i++) {
+ if (i % 3 == 0) {
+ if (is_single_ablk_in_mbc(a, blk[i], crr)) {
+ crr = NULL; /* about to destroy the removed mbc */
+ }
+ FREE(a, blk[i]);
+ blk[i] = NULL;
+ }
+ if (i % (NO_BLOCKS/2) == 0)
+ do_check(tcs, a, 50, 1);
+ }
+
+ for (i = 0; i < NO_BLOCKS; i++) {
+ if (i % 3 == 0) {
+ ASSERT(tcs, !blk[i]);
+ blk[i] = ALLOC(a, min_blk_sz + i % 500);
+ ASSERT(tcs, BLK_TO_MBC(UMEM2BLK(blk[i])) != crr);
+ }
+ if (i % (NO_BLOCKS/2) == 0)
+ do_check(tcs, a, 50, 1);
+ }
+ if (crr) {
+ ADD_MBC(a, crr);
+ }
+ }
+
+ for (crr = FIRST_MBC(a); crr; crr = NEXT_C(crr)) {
+ REMOVE_MBC(a, crr);
}
- ASSERT(tcs, RBT_ROOT(a));
- ASSERT(tcs, !RBT_LEFT(RBT_ROOT(a)));
- ASSERT(tcs, !RBT_RIGHT(RBT_ROOT(a)));
+ p = ALLOC(a, 1);
+ free_crr = BLK_TO_MBC(UMEM2BLK(p));
+ FREE(a, p);
+
+ for (crr = FIRST_MBC(a); crr; crr = NEXT_C(crr)) {
+ ASSERT(tcs, free_crr != crr);
+ }
+
+ ASSERT(tcs, !RBT_ROOT(a,0));
}
@@ -369,6 +487,7 @@ testcase_run(TestCaseState_t *tcs)
char *argv1[] = {"-tasbf", NULL};
char *argv2[] = {"-tasaobf", NULL};
char *argv3[] = {"-tasaoff", NULL};
+ char *argv4[] = {"-tasaoffcaobf", NULL};
Allctr_t *a;
rbtree_test_data *td;
@@ -390,6 +509,7 @@ testcase_run(TestCaseState_t *tcs)
td->allocator = a = START_ALC("rbtree_bf_", 0, argv1);
ASSERT(tcs, a);
+ ASSERT(tcs, IS_BF_ALGO(a));
ASSERT(tcs, !IS_AOBF(a));
test_it(tcs);
@@ -407,6 +527,7 @@ testcase_run(TestCaseState_t *tcs)
td->allocator = a = START_ALC("rbtree_aobf_", 0, argv2);
ASSERT(tcs, a);
+ ASSERT(tcs, IS_BF_ALGO(a));
ASSERT(tcs, IS_AOBF(a));
test_it(tcs);
@@ -424,11 +545,34 @@ testcase_run(TestCaseState_t *tcs)
td->allocator = a = START_ALC("rbtree_aoff_", 0, argv3);
ASSERT(tcs, a);
+ ASSERT(tcs, !IS_BF_ALGO(a));
+ ASSERT(tcs, !IS_CBF(a));
test_it(tcs);
+ test_carrier_migration(tcs);
STOP_ALC(a);
td->allocator = NULL;
testcase_printf(tcs, "Address order first fit test succeeded!\n");
+
+ /* Address order first fit, best fit within carrier */
+
+ testcase_printf(tcs, "Starting test of aoffcaobf...\n");
+
+ current_rbt_type_op_base = AO_FIRSTFIT_OP_BASE;
+ td->allocator = a = START_ALC("rbtree_aoffcaobf_", 0, argv4);
+
+ ASSERT(tcs, a);
+ ASSERT(tcs, !IS_BF_ALGO(a));
+ ASSERT(tcs, IS_CBF(a));
+
+ test_it(tcs);
+ test_carrier_migration(tcs);
+
+ STOP_ALC(a);
+ td->allocator = NULL;
+
+ testcase_printf(tcs, "aoffcaobf test succeeded!\n");
+
}
diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl
index dfba7d098f..104bdf8aec 100644
--- a/erts/emulator/test/driver_SUITE.erl
+++ b/erts/emulator/test/driver_SUITE.erl
@@ -2582,10 +2582,9 @@ driver_alloc_size() ->
MemInfo ->
CS = lists:foldl(
fun ({instance, _, L}, Acc) ->
- {value,{_,SBMBCS}} = lists:keysearch(sbmbcs, 1, L),
{value,{_,MBCS}} = lists:keysearch(mbcs, 1, L),
{value,{_,SBCS}} = lists:keysearch(sbcs, 1, L),
- [SBMBCS,MBCS,SBCS | Acc]
+ [MBCS,SBCS | Acc]
end,
[],
MemInfo),
diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl
index dcf58fa474..9a70e8646a 100644
--- a/erts/emulator/test/nif_SUITE.erl
+++ b/erts/emulator/test/nif_SUITE.erl
@@ -1368,10 +1368,9 @@ tmpmem() ->
MemInfo ->
MSBCS = lists:foldl(
fun ({instance, _, L}, Acc) ->
- {value,{_,SBMBCS}} = lists:keysearch(sbmbcs, 1, L),
{value,{_,MBCS}} = lists:keysearch(mbcs, 1, L),
{value,{_,SBCS}} = lists:keysearch(sbcs, 1, L),
- [SBMBCS,MBCS,SBCS | Acc]
+ [MBCS,SBCS | Acc]
end,
[],
MemInfo),
diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl
index 13aa0f4c00..e467e844b3 100644
--- a/erts/emulator/test/port_SUITE.erl
+++ b/erts/emulator/test/port_SUITE.erl
@@ -92,7 +92,7 @@
spawn_driver/1, spawn_executable/1, close_deaf_port/1,
unregister_name/1, parallelism_option/1]).
--export([]).
+-export([do_iter_max_ports/2]).
%% Internal exports.
-export([tps/3]).
@@ -635,9 +635,16 @@ iter_max_ports_test(Config) ->
{win32,_} -> 4;
_ -> 10
end,
- L = do_iter_max_ports(Iters, Command),
+ %% Run on a different node in order to limit the effect if this test fails.
+ Dir = filename:dirname(code:which(?MODULE)),
+ {ok,Node} = test_server:start_node(test_iter_max_socks,slave,
+ [{args,"+Q 2048 -pa " ++ Dir}]),
+ L = rpc:call(Node,?MODULE,do_iter_max_ports,[Iters, Command]),
+ test_server:stop_node(Node),
+
io:format("Result: ~p",[L]),
all_equal(L),
+ all_equal(L),
test_server:timetrap_cancel(Dog),
{comment, "Max ports: " ++ integer_to_list(hd(L))}.
@@ -670,7 +677,7 @@ close_ports([]) ->
ok.
open_ports(Name, Settings) ->
- test_server:sleep(50),
+ test_server:sleep(5),
case catch open_port(Name, Settings) of
P when is_port(P) ->
[P| open_ports(Name, Settings)];
diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl
index 863cd2d654..72f3e8fe85 100644
--- a/erts/emulator/test/process_SUITE.erl
+++ b/erts/emulator/test/process_SUITE.erl
@@ -1494,6 +1494,7 @@ processes_bif_cleaner() ->
spawn_initial_hangarounds(Cleaner) ->
TabSz = erlang:system_info(process_limit),
+ erts_debug:set_internal_state(next_pid,TabSz),
spawn_initial_hangarounds(Cleaner,
TabSz,
TabSz*2,
@@ -1538,14 +1539,21 @@ hangaround(Cleaner, Type) ->
spawn_initial_hangarounds(_Cleaner, NP, Max, Len, HAs) when NP > Max ->
{Len, HAs};
spawn_initial_hangarounds(Cleaner, NP, Max, Len, HAs) ->
- erts_debug:set_internal_state(next_pid,NP),
+ Skip = 30,
HA1 = spawn_opt(?MODULE, hangaround, [Cleaner, initial_hangaround],
[{priority, low}]),
HA2 = spawn_opt(?MODULE, hangaround, [Cleaner, initial_hangaround],
[{priority, normal}]),
HA3 = spawn_opt(?MODULE, hangaround, [Cleaner, initial_hangaround],
[{priority, high}]),
- spawn_initial_hangarounds(Cleaner, NP+30, Max, Len+3, [HA1,HA2,HA3|HAs]).
+ spawn_drop(Skip),
+ spawn_initial_hangarounds(Cleaner, NP+Skip, Max, Len+3, [HA1,HA2,HA3|HAs]).
+
+spawn_drop(N) when N =< 0 ->
+ ok;
+spawn_drop(N) ->
+ spawn(fun () -> ok end),
+ spawn_drop(N-1).
do_processes(WantReds) ->
erts_debug:set_internal_state(reds_left, WantReds),
diff --git a/erts/emulator/test/send_term_SUITE.erl b/erts/emulator/test/send_term_SUITE.erl
index ba0ba804ca..6615873392 100644
--- a/erts/emulator/test/send_term_SUITE.erl
+++ b/erts/emulator/test/send_term_SUITE.erl
@@ -175,10 +175,6 @@ chk_temp_alloc() ->
%% Verify that we havn't got anything allocated by temp_alloc
lists:foreach(
fun ({instance, _, TI}) ->
- ?line {value, {sbmbcs, SBMBCInfo}}
- = lists:keysearch(sbmbcs, 1, TI),
- ?line {value, {blocks, 0, _, _}}
- = lists:keysearch(blocks, 1, SBMBCInfo),
?line {value, {mbcs, MBCInfo}}
= lists:keysearch(mbcs, 1, TI),
?line {value, {blocks, 0, _, _}}
diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c
index 31d9b2e0ad..01134dd718 100644
--- a/erts/etc/common/erlexec.c
+++ b/erts/etc/common/erlexec.c
@@ -64,7 +64,6 @@
static const char plusM_au_allocs[]= {
'u', /* all alloc_util allocators */
'B', /* binary_alloc */
- 'C', /* sbmbc_alloc */
'D', /* std_alloc */
'E', /* ets_alloc */
'F', /* fix_alloc */
@@ -80,6 +79,7 @@ static const char plusM_au_allocs[]= {
static char *plusM_au_alloc_switches[] = {
"as",
"asbcst",
+ "acul",
"e",
"t",
"lmbcs",
@@ -95,8 +95,6 @@ static char *plusM_au_alloc_switches[] = {
"rsbcst",
"sbct",
"smbcs",
- "sbmbcs",
- "sbmbct",
NULL
};
diff --git a/erts/etc/unix/cerl.src b/erts/etc/unix/cerl.src
index f99059cb72..691b32e143 100644
--- a/erts/etc/unix/cerl.src
+++ b/erts/etc/unix/cerl.src
@@ -31,6 +31,8 @@
# -debug Run debug compiled emulator
# -gdb Run the debug compiled emulator in emacs and gdb.
# You have to start beam in gdb using "run".
+# -rgdb Run the debug compiled emulator in gdb.
+# You have to start beam in gdb using "run".
# -break F Run the debug compiled emulator in emacs and gdb and set break.
# The session is started, i.e. "run" is already don for you.
# -xxgdb FIXME currently disabled
@@ -178,6 +180,10 @@ while [ $# -gt 0 ]; do
;;
"-gdb")
shift
+ GDB=egdb
+ ;;
+ "-rgdb")
+ shift
GDB=gdb
;;
"-break")
@@ -188,6 +194,12 @@ while [ $# -gt 0 ]; do
;;
"-core")
shift
+ GDB=egdb
+ core="$1"
+ shift
+ ;;
+ "-rcore")
+ shift
GDB=gdb
core="$1"
shift
@@ -285,6 +297,27 @@ if [ "x$GDB" = "x" ]; then
else
exec $EXEC $eeargs $xargs ${1+"$@"}
fi
+elif [ "x$GDB" = "xgdb" ]; then
+ case "x$core" in
+ x)
+ # Get emu args to use from erlexec...
+ beam_args=`$EXEC -emu_args_exit ${1+"$@"}`
+ gdbcmd="--args $EMU_NAME $beam_args"
+ ;;
+ x/*)
+ gdbcmd="$EMU_NAME ${core}"
+ GDBBP=
+ ;;
+ *)
+ dir=`pwd`
+ gdbcmd="$EMU_NAME ${dir}/${core}"
+ GDBBP=
+ ;;
+ esac
+ cmdfile="/tmp/.cerlgdb.$$"
+ echo "source $ROOTDIR/erts/etc/unix/etp-commands" > $cmdfile
+ # Fire up gdb in emacs...
+ exec gdb $GDBBP -x $cmdfile $gdbcmd
else
if [ "x$EMACS" = "x" ]; then
EMACS=emacs
diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam
index 308cb99be5..947fbe7c24 100644
--- a/erts/preloaded/ebin/erlang.beam
+++ b/erts/preloaded/ebin/erlang.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam
new file mode 100644
index 0000000000..6c7b7e5262
--- /dev/null
+++ b/erts/preloaded/ebin/prim_eval.beam
Binary files differ
diff --git a/erts/preloaded/src/.gitignore b/erts/preloaded/src/.gitignore
new file mode 100644
index 0000000000..e4658fe142
--- /dev/null
+++ b/erts/preloaded/src/.gitignore
@@ -0,0 +1 @@
+prim_eval.abstr
diff --git a/erts/preloaded/src/Makefile b/erts/preloaded/src/Makefile
index a224b6a5d4..f53809e765 100644
--- a/erts/preloaded/src/Makefile
+++ b/erts/preloaded/src/Makefile
@@ -32,7 +32,7 @@ STATIC_EBIN=../ebin
include $(ERL_TOP)/erts/vsn.mk
include $(ERL_TOP)/lib/kernel/vsn.mk
-PRE_LOADED_MODULES = \
+PRE_LOADED_ERL_MODULES = \
erl_prim_loader \
init \
prim_file \
@@ -43,10 +43,17 @@ PRE_LOADED_MODULES = \
erlang \
erts_internal
+PRE_LOADED_BEAM_MODULES = \
+ prim_eval
+
+PRE_LOADED_MODULES = $(PRE_LOADED_ERL_MODULES) $(PRE_LOADED_BEAM_MODULES)
+
RELSYSDIR = $(RELEASE_PATH)/lib/erts-$(VSN)
# not $(RELEASE_PATH)/erts-$(VSN)/preloaded
-ERL_FILES= $(PRE_LOADED_MODULES:%=%.erl)
+ERL_FILES= $(PRE_LOADED_ERL_MODULES:%=%.erl)
+BEAM_FILES= $(PRE_LOADED_BEAM_MODULES:%=%.S)
+STUBS_FILES= $(PRE_LOADED_BEAM_MODULES:%=%.erl)
TARGET_FILES = $(PRE_LOADED_MODULES:%=$(EBIN)/%.$(EMULATOR))
STATIC_TARGET_FILES = $(PRE_LOADED_MODULES:%=$(STATIC_EBIN)/%.$(EMULATOR))
@@ -70,7 +77,7 @@ include $(ERL_TOP)/make/otp_release_targets.mk
release_spec:
$(INSTALL_DIR) "$(RELSYSDIR)/src"
- $(INSTALL_DATA) $(ERL_FILES) "$(RELSYSDIR)/src"
+ $(INSTALL_DATA) $(ERL_FILES) $(BEAM_FILES) $(STUBS_FILES) "$(RELSYSDIR)/src"
$(INSTALL_DIR) "$(RELSYSDIR)/ebin"
$(INSTALL_DATA) $(STATIC_TARGET_FILES) "$(RELSYSDIR)/ebin"
@@ -80,6 +87,19 @@ release_docs_spec:
list_preloaded:
@echo $(PRE_LOADED_MODULES)
+#
+# Combine a BEAM assembly script file a stub Erlang file into a BEAM file.
+# See add_abstract_chunk script.
+#
+
+prim_eval.abstr: prim_eval.erl
+ $(V_ERLC) $(ERL_COMPILE_FLAGS) -o$(dir $@) +dabstr $<
+
+prim_eval.beam: prim_eval.S prim_eval.abstr
+ $(gen_verbose)
+ $(V_at)$(ERLC) $(ERL_COMPILE_FLAGS) $<
+ $(V_at)escript add_abstract_code $@ prim_eval.abstr || (rm $@; exit 1)
+
# Include dependencies -- list below added by PaN
$(EBIN)/erl_prim_loader.beam: $(KERNEL_SRC)/inet_boot.hrl $(KERNEL_INCLUDE)/file.hrl
$(EBIN)/prim_file.beam: $(KERNEL_INCLUDE)/file.hrl
diff --git a/erts/preloaded/src/add_abstract_code b/erts/preloaded/src/add_abstract_code
new file mode 100644
index 0000000000..e670156d21
--- /dev/null
+++ b/erts/preloaded/src/add_abstract_code
@@ -0,0 +1,34 @@
+#!/usr/bin/env escript
+%% -*- erlang -*-
+
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2013. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-mode(compile).
+
+-export([main/1]).
+
+main([BeamFile,AbstrFile]) ->
+ {ok,_,Chunks0} = beam_lib:all_chunks(BeamFile),
+ {ok,Abstr} = file:consult(AbstrFile),
+ Chunks = lists:keyreplace("Abst", 1, Chunks0,
+ {"Abst",term_to_binary({raw_abstract_v1,Abstr})}),
+ {ok,Module} = beam_lib:build_module(Chunks),
+ ok = file:write_file(BeamFile, Module),
+ init:stop().
diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl
index 7106c0a4fb..a8a4425b63 100644
--- a/erts/preloaded/src/erlang.erl
+++ b/erts/preloaded/src/erlang.erl
@@ -45,7 +45,8 @@
-export([alloc_info/1, alloc_sizes/1]).
-export([gather_sched_wall_time_result/1,
- await_sched_wall_time_modifications/2]).
+ await_sched_wall_time_modifications/2,
+ gather_gc_info_result/1]).
-deprecated([hash/2]).
@@ -3113,8 +3114,8 @@ max(A, _) -> A.
| 'atom' | 'atom_used' | 'binary' | 'code' | 'ets'
| 'low' | 'maximum'.
--define(CARRIER_ALLOCS, [mseg_alloc, sbmbc_alloc, sbmbc_low_alloc]).
--define(LOW_ALLOCS, [sbmbc_low_alloc, ll_low_alloc, std_low_alloc]).
+-define(CARRIER_ALLOCS, [mseg_alloc]).
+-define(LOW_ALLOCS, [ll_low_alloc, std_low_alloc]).
-define(ALL_NEEDED_ALLOCS, (erlang:system_info(alloc_util_allocators)
-- ?CARRIER_ALLOCS)).
@@ -3281,12 +3282,16 @@ get_blocks_size([{blocks_size, Sz, _, _} | Rest], Acc) ->
get_blocks_size(Rest, Acc+Sz);
get_blocks_size([{_, _, _, _} | Rest], Acc) ->
get_blocks_size(Rest, Acc);
+get_blocks_size([{blocks_size, Sz} | Rest], Acc) ->
+ get_blocks_size(Rest, Acc+Sz);
+get_blocks_size([{_, _} | Rest], Acc) ->
+ get_blocks_size(Rest, Acc);
get_blocks_size([], Acc) ->
Acc.
blocks_size([{Carriers, SizeList} | Rest], Acc) when Carriers == mbcs;
- Carriers == sbcs;
- Carriers == sbmbcs ->
+ Carriers == mbcs_pool;
+ Carriers == sbcs ->
blocks_size(Rest, get_blocks_size(SizeList, Acc));
blocks_size([_ | Rest], Acc) ->
blocks_size(Rest, Acc);
@@ -3305,6 +3310,9 @@ get_fix_proc([], Acc) ->
fix_proc([{fix_types, SizeList} | _Rest], Acc) ->
get_fix_proc(SizeList, Acc);
+fix_proc([{fix_types, Mask, SizeList} | _Rest], Acc) ->
+ {A, U} = get_fix_proc(SizeList, Acc),
+ {Mask, A, U};
fix_proc([_ | Rest], Acc) ->
fix_proc(Rest, Acc);
fix_proc([], Acc) ->
@@ -3356,13 +3364,21 @@ au_mem_data(#memory{total = Tot,
processes_used = ProcU,
system = Sys} = Mem,
[{fix_alloc, _, Data} | Rest]) ->
- {A, U} = fix_proc(Data, {0, 0}),
Sz = blocks_size(Data, 0),
- au_mem_data(Mem#memory{total = Tot+Sz,
- processes = Proc+A,
- processes_used = ProcU+U,
- system = Sys+Sz-A},
- Rest);
+ case fix_proc(Data, {0, 0}) of
+ {A, U} ->
+ au_mem_data(Mem#memory{total = Tot+Sz,
+ processes = Proc+A,
+ processes_used = ProcU+U,
+ system = Sys+Sz-A},
+ Rest);
+ {Mask, A, U} ->
+ au_mem_data(Mem#memory{total = Tot+Sz,
+ processes = Mask band (Proc+A),
+ processes_used = Mask band (ProcU+U),
+ system = Mask band (Sys+Sz-A)},
+ Rest)
+ end;
au_mem_data(#memory{total = Tot,
system = Sys,
low = Low} = Mem,
@@ -3380,7 +3396,7 @@ au_mem_data(EMD, []) ->
au_mem_data(Allocs) ->
Ref = erlang:make_ref(),
- erlang:system_info({allocator_sizes, Ref, Allocs}),
+ erlang:system_info({memory_internal, Ref, Allocs}),
receive_emd(Ref).
receive_emd(_Ref, EMD, 0) ->
@@ -3536,3 +3552,20 @@ sched_wall_time(Ref, N, Acc) ->
{Ref, undefined} -> sched_wall_time(Ref, N-1, undefined);
{Ref, SWT} -> sched_wall_time(Ref, N-1, [SWT|Acc])
end.
+
+-spec erlang:gather_gc_info_result(Ref) -> [{pos_integer(),
+ pos_integer(),
+ 0}] when
+ Ref :: reference().
+
+gather_gc_info_result(Ref) when erlang:is_reference(Ref) ->
+ gc_info(Ref, erlang:system_info(schedulers), {0,0}).
+
+gc_info(_Ref, 0, {Colls,Recl}) ->
+ {Colls,Recl,0};
+gc_info(Ref, N, {OrigColls,OrigRecl}) ->
+ receive
+ {Ref, {_,Colls, Recl}} ->
+ gc_info(Ref, N-1, {Colls+OrigColls,Recl+OrigRecl})
+ end.
+
diff --git a/erts/preloaded/src/prim_eval.S b/erts/preloaded/src/prim_eval.S
new file mode 100644
index 0000000000..958a79a1da
--- /dev/null
+++ b/erts/preloaded/src/prim_eval.S
@@ -0,0 +1,70 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2013. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+{module, prim_eval}.
+
+%% This module uses low-level BEAM instructions for the message queue facility
+%% to allow erl_eval to evaluate receive expressions correctly.
+
+{exports, [{'receive',2},{module_info,0},{module_info,1}]}.
+
+{attributes, []}.
+
+{labels, 10}.
+
+
+{function, 'receive', 2, 2}.
+ {label,1}.
+ {func_info,{atom,prim_eval},{atom,'receive'},2}.
+ {label,2}.
+ {allocate,2,2}.
+ {move,{x,1},{y,0}}.
+ {move,{x,0},{y,1}}.
+ {label,3}.
+ {loop_rec,{f,5},{x,0}}.
+ {move,{y,1},{x,1}}.
+ {call_fun,1}.
+ {test,is_ne_exact,{f,4},[{x,0},{atom,nomatch}]}.
+ remove_message.
+ {deallocate,2}.
+ return.
+ {label,4}.
+ {loop_rec_end,{f,3}}.
+ {label,5}.
+ {wait_timeout,{f,3},{y,0}}.
+ timeout.
+ {move,{atom,timeout},{x,0}}.
+ {deallocate,2}.
+ return.
+
+
+{function, module_info, 0, 8}.
+ {label,6}.
+ {func_info,{atom,prim_eval},{atom,module_info},0}.
+ {label,7}.
+ {move,{atom,prim_eval},{x,0}}.
+ {call_ext_only,1,{extfunc,erlang,get_module_info,1}}.
+
+
+{function, module_info, 1, 10}.
+ {label,8}.
+ {func_info,{atom,prim_eval},{atom,module_info},1}.
+ {label,9}.
+ {move,{x,0},{x,1}}.
+ {move,{atom,prim_eval},{x,0}}.
+ {call_ext_only,2,{extfunc,erlang,get_module_info,2}}.
diff --git a/erts/preloaded/src/prim_eval.erl b/erts/preloaded/src/prim_eval.erl
new file mode 100644
index 0000000000..ec5af8c138
--- /dev/null
+++ b/erts/preloaded/src/prim_eval.erl
@@ -0,0 +1,28 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2013. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(prim_eval).
+
+%% This module is simply a stub which abstract code gets included in the result
+%% of compilation of prim_eval.S, to keep Dialyzer happy.
+
+-export(['receive'/2]).
+
+-spec 'receive'(fun((term()) -> nomatch | T), timeout()) -> T.
+'receive'(_, _) ->
+ erlang:nif_error(stub).
diff --git a/erts/test/z_SUITE.erl b/erts/test/z_SUITE.erl
index 78968ed405..9abc73c081 100644
--- a/erts/test/z_SUITE.erl
+++ b/erts/test/z_SUITE.erl
@@ -190,8 +190,13 @@ file_inspect(#core_search_conf{file = File}, Core) ->
probably_a_core
end.
-mk_readable(F) ->
- catch file:write_file_info(F, #file_info{mode = 8#00444}).
+mk_readable(F) ->
+ try
+ {ok, Old} = file:read_file_info(F),
+ file:write_file_info(F, Old#file_info{mode = 8#00444})
+ catch
+ _:_ -> io:format("Failed to \"chmod\" core file ~p\n", [F])
+ end.
ignore_core(C) ->
filelib:is_regular(filename:join([filename:dirname(C),
diff --git a/lib/asn1/src/asn1_db.erl b/lib/asn1/src/asn1_db.erl
index 843fc66c9c..e96ca9ae25 100644
--- a/lib/asn1/src/asn1_db.erl
+++ b/lib/asn1/src/asn1_db.erl
@@ -19,31 +19,22 @@
%%
-module(asn1_db).
--export([dbstart/1,dbnew/1,dbsave/2,dbload/1,dbput/3,dbget/2,dbget_all/1]).
--export([dbget_all_mod/1,dbclear/0,dberase_module/1,dbstop/0]).
+-export([dbstart/1,dbnew/1,dbsave/2,dbput/3,dbget/2]).
+-export([dbstop/0]).
-record(state, {parent, monitor, includes, table}).
%% Interface
dbstart(Includes) ->
Parent = self(),
- case get(?MODULE) of
- undefined ->
- put(?MODULE, spawn_link(fun() -> init(Parent, Includes) end)),
- true;
- _Pid ->
- req({new_includes, Includes})
- end.
+ undefined = get(?MODULE), %Assertion.
+ put(?MODULE, spawn_link(fun() -> init(Parent, Includes) end)),
+ ok.
dbnew(Module) -> req({new, Module}).
-dbsave(OutFile, Module) -> req({save, OutFile, Module}).
-dbload(Module) -> req({load, Module}).
-dbput(Module, K, V) -> req({set, Module, K, V}).
+dbsave(OutFile, Module) -> cast({save, OutFile, Module}).
+dbput(Module, K, V) -> cast({set, Module, K, V}).
dbget(Module, K) -> req({get, Module, K}).
-dbget_all(K) -> req({get_all, K}).
-dbget_all_mod(Mod) -> req({all_mod, Mod}).
-dbclear() -> req(clear).
-dberase_module({module,M}) -> req({delete_mod, M}).
dbstop() -> Resp = req(stop), erase(?MODULE), Resp.
%% Internal functions
@@ -59,8 +50,13 @@ req(Request) ->
exit({db_error,Info})
end.
+cast(Request) ->
+ get(?MODULE) ! Request,
+ ok.
+
reply({Ref,From}, Response) ->
- From ! {{Ref,?MODULE}, Response}.
+ From ! {{Ref,?MODULE}, Response},
+ ok.
init(Parent, Includes) ->
MRef = erlang:monitor(process, Parent),
@@ -70,10 +66,9 @@ init(Parent, Includes) ->
loop(#state{parent = Parent, monitor = MRef, table = Table,
includes = Includes} = State) ->
receive
- {From, {set, Mod, K2, V}} ->
+ {set, Mod, K2, V} ->
[{_, Modtab}] = ets:lookup(Table, Mod),
ets:insert(Modtab, {K2, V}),
- reply(From, ok),
loop(State);
{From, {get, Mod, K2}} ->
Result = case ets:lookup(Table, Mod) of
@@ -85,44 +80,16 @@ loop(#state{parent = Parent, monitor = MRef, table = Table,
_Error -> reply(From, undefined)
end,
loop(State);
- {From, {all_mod, Mod}} ->
- [{_, Modtab}] = ets:lookup(Table, Mod),
- reply(From, ets:tab2list(Modtab)),
- loop(State);
- {From, {delete_mod, Mod}} ->
- [{_, Modtab}] = ets:lookup(Table, Mod),
- ets:delete(Modtab),
- ets:delete(Table, Mod),
- reply(From, ok),
- loop(State);
- {From, {save, OutFile, Mod}} ->
+ {save, OutFile, Mod} ->
[{_,Mtab}] = ets:lookup(Table, Mod),
- reply(From, ets:tab2file(Mtab, OutFile)),
- loop(State);
- {From, {load, Mod}} ->
- Result = case ets:lookup(Table, Mod) of
- [] -> opentab(Table, Mod, Includes);
- [{_, Modtab}] -> {ok, Modtab}
- end,
- reply(From, Result),
+ ok = ets:tab2file(Mtab, OutFile),
loop(State);
{From, {new, Mod}} ->
- case ets:lookup(Table, Mod) of
- [{_, Modtab}] -> ets:delete(Modtab);
- _ -> true
- end,
+ [] = ets:lookup(Table, Mod), %Assertion.
ModTableId = ets:new(list_to_atom(lists:concat(["asn1_",Mod])), []),
ets:insert(Table, {Mod, ModTableId}),
reply(From, ok),
loop(State);
- {From, clear} ->
- [ets:delete(Mt) || {_, Mt} <- ets:tab2list(Table)],
- ets:delete(Table),
- reply(From, cleared),
- loop(State#state{table = ets:new(asn1, [set])});
- {From, {new_includes, NewIncludes}} ->
- reply(From, true),
- loop(State#state{includes = NewIncludes});
{From, stop} ->
reply(From, stopped); %% Nothing to store
{'DOWN', MRef, process, Parent, Reason} ->
diff --git a/lib/asn1/src/asn1_records.hrl b/lib/asn1/src/asn1_records.hrl
index 16d14c2e7b..396ba0fcfa 100644
--- a/lib/asn1/src/asn1_records.hrl
+++ b/lib/asn1/src/asn1_records.hrl
@@ -45,9 +45,7 @@
-record(pobjectdef,{checked=false,pos,name,args,class,def}).
-record(pobjectsetdef,{checked=false,pos,name,args,class,def}).
--record(typereference,{pos,val}).
-record(identifier,{pos,val}).
--record(constraint,{c,e}).
-record('Constraint',{'SingleValue'=no,'SizeConstraint'=no,'ValueRange'=no,'PermittedAlphabet'=no,
'ContainedSubtype'=no, 'TypeConstraint'=no,'InnerSubtyping'=no,e=no,'Other'=no}).
-record(simpletableattributes,{objectsetname,c_name,c_index,usedclassfield,
diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl
index 770b92cbc3..8e71a5697c 100644
--- a/lib/asn1/src/asn1ct.erl
+++ b/lib/asn1/src/asn1ct.erl
@@ -25,21 +25,20 @@
%%-compile(export_all).
%% Public exports
-export([compile/1, compile/2]).
--export([start/0, start/1]).
-export([encode/2, encode/3, decode/3]).
-export([test/1, test/2, test/3, value/2, value/3]).
%% Application internal exports
-export([compile_asn/3,compile_asn1/3,compile_py/3,compile/3,
vsn/0,
get_name_of_def/1,get_pos_of_def/1]).
--export([read_config_data/1,get_gen_state_field/1,get_gen_state/0,
- partial_inc_dec_toptype/1,save_gen_state/1,update_gen_state/2,
+-export([read_config_data/1,get_gen_state_field/1,
+ partial_inc_dec_toptype/1,update_gen_state/2,
get_tobe_refed_func/1,reset_gen_state/0,is_function_generated/1,
- generated_refed_func/1,next_refed_func/0,pop_namelist/0,
- next_namelist_el/0,update_namelist/1,step_in_constructed/0,
+ generated_refed_func/1,next_refed_func/0,
+ update_namelist/1,step_in_constructed/0,
add_tobe_refed_func/1,add_generated_refed_func/1,
- maybe_rename_function/3,latest_sindex/0,current_sindex/0,
- set_current_sindex/1,next_sindex/0,maybe_saved_sindex/2,
+ maybe_rename_function/3,current_sindex/0,
+ set_current_sindex/1,maybe_saved_sindex/2,
parse_and_save/2,verbose/3,warning/3,warning/4,error/3]).
-export([get_bit_string_format/0]).
@@ -82,7 +81,6 @@
%%
%%
-
compile(File) ->
compile(File,[]).
@@ -96,14 +94,30 @@ compile(File, Options0) when is_list(Options0) ->
Error
end.
+-record(st,
+ {file=[],
+ files=[],
+ inputmodules=[],
+ code,
+ opts=[],
+ outfile,
+ dbfile,
+ includes=[],
+ erule,
+ error=none,
+ run
+ }).
+
compile_proc(File, Includes, Options) ->
+ Erule = get_rule(Options),
+ St = #st{opts=Options,includes=Includes,erule=Erule},
case input_file_type(File, Includes) of
{single_file, SuffixedFile} -> %% "e.g. "/tmp/File.asn"
- compile1(SuffixedFile, Options);
+ compile1(SuffixedFile, St);
{multiple_files_file, SetBase, FileName} ->
case get_file_list(FileName, Includes) of
FileList when is_list(FileList) ->
- compile_set(SetBase, FileList, Options);
+ compile_set(SetBase, FileList, St);
Err ->
Err
end;
@@ -111,22 +125,222 @@ compile_proc(File, Includes, Options) ->
{error, Err}
end.
-compile1(File,Options) when is_list(Options) ->
- verbose("Erlang ASN.1 version ~p compiling ~p ~n",[?vsn,File],Options),
- verbose("Compiler Options: ~p~n",[Options],Options),
- Ext = filename:extension(File),
- Base = filename:basename(File,Ext),
- OutFile = outfile(Base,"",Options),
- DbFile = outfile(Base,"asn1db",Options),
- Includes = [I || {i,I} <- Options],
- EncodingRule = get_rule(Options),
- Continue1 = scan(File,Options),
- Continue2 = parse(Continue1,File,Options),
- Continue3 = check(Continue2,File,OutFile,Includes,EncodingRule,
- DbFile,Options,[]),
- Continue4 = generate(Continue3,OutFile,EncodingRule,Options),
- compile_erl(Continue4, OutFile, Options).
+set_passes() ->
+ [{pass,scan_parse,fun set_scan_parse_pass/1},
+ {pass,merge,fun merge_pass/1}|common_passes()].
+
+single_passes() ->
+ [{pass,scan,fun scan_pass/1},
+ {pass,parse,fun parse_pass/1}|common_passes()].
+
+parse_and_save_passes() ->
+ [{pass,scan,fun scan_pass/1},
+ {pass,parse,fun parse_pass/1},
+ {pass,save,fun save_pass/1}].
+
+common_passes() ->
+ [{pass,check,fun check_pass/1},
+ {iff,abs,{pass,abs_listing,fun abs_listing/1}},
+ {pass,generate,fun generate_pass/1},
+ {unless,noobj,{pass,compile,fun compile_pass/1}}].
+
+scan_pass(#st{file=File}=St) ->
+ case asn1ct_tok:file(File) of
+ {error,Reason} ->
+ {error,St#st{error=Reason}};
+ Tokens when is_list(Tokens) ->
+ {ok,St#st{code=Tokens}}
+ end.
+
+set_scan_parse_pass(#st{files=Files}=St) ->
+ try
+ L = set_scan_parse_pass_1(Files, St),
+ {ok,St#st{code=L}}
+ catch
+ throw:Error ->
+ {error,St#st{error=Error}}
+ end.
+
+set_scan_parse_pass_1([F|Fs], St) ->
+ case asn1ct_tok:file(F) of
+ {error,Error} ->
+ throw(Error);
+ Tokens when is_list(Tokens) ->
+ case catch asn1ct_parser2:parse(Tokens) of
+ {ok,M} ->
+ [M|set_scan_parse_pass_1(Fs, St)];
+ {error,ErrorTerm} ->
+ throw(handle_parse_error(ErrorTerm, St))
+ end
+ end;
+set_scan_parse_pass_1([], _) -> [].
+
+parse_pass(#st{code=Tokens}=St) ->
+ case catch asn1ct_parser2:parse(Tokens) of
+ {ok,M} ->
+ {ok,St#st{code=M}};
+ {error,ErrorTerm} ->
+ {error,St#st{error=handle_parse_error(ErrorTerm, St)}}
+ end.
+
+handle_parse_error(ErrorTerm, #st{file=File,opts=Opts}) ->
+ case ErrorTerm of
+ {{Line,_Mod,Message},_TokTup} ->
+ if
+ is_integer(Line) ->
+ BaseName = filename:basename(File),
+ error("syntax error at line ~p in module ~s:~n",
+ [Line,BaseName], Opts);
+ true ->
+ error("syntax error in module ~p:~n",
+ [File], Opts)
+ end,
+ print_error_message(Message),
+ Message;
+ {Line,_Mod,[Message,Token]} ->
+ error("syntax error: ~p ~p at line ~p~n",
+ [Message,Token,Line], Opts),
+ {Line,[Message,Token]}
+ end.
+
+merge_pass(#st{file=Base,code=Code}=St) ->
+ M = merge_modules(Code, Base),
+ {ok,St#st{code=M}}.
+
+check_pass(#st{code=M,file=File,includes=Includes,
+ erule=Erule,dbfile=DbFile,opts=Opts,
+ inputmodules=InputModules}=St) ->
+ start(Includes),
+ case asn1ct_check:storeindb(#state{erule=Erule}, M) of
+ ok ->
+ Module = asn1_db:dbget(M#module.name, 'MODULE'),
+ State = #state{mname=Module#module.name,
+ module=Module#module{typeorval=[]},
+ erule=Erule,
+ inputmodules=InputModules,
+ options=Opts,
+ sourcedir=filename:dirname(File)},
+ case asn1ct_check:check(State, Module#module.typeorval) of
+ {error,Reason} ->
+ {error,St#st{error=Reason}};
+ {ok,NewTypeOrVal,GenTypeOrVal} ->
+ NewM = Module#module{typeorval=NewTypeOrVal},
+ asn1_db:dbput(NewM#module.name, 'MODULE', NewM),
+ asn1_db:dbsave(DbFile, M#module.name),
+ verbose("--~p--~n", [{generated,DbFile}], Opts),
+ {ok,St#st{code={M,GenTypeOrVal}}}
+ end;
+ {error,Reason} ->
+ {error,St#st{error=Reason}}
+ end.
+
+save_pass(#st{code=M,erule=Erule,dbfile=DbFile}=St) ->
+ ok = asn1ct_check:storeindb(#state{erule=Erule}, M),
+ asn1_db:dbsave(DbFile,M#module.name),
+ {ok,St}.
+
+abs_listing(#st{code={M,_},outfile=OutFile}) ->
+ pretty2(M#module.name, OutFile++".abs"),
+ done.
+generate_pass(#st{code=Code,outfile=OutFile,erule=Erule,opts=Opts}=St0) ->
+ St = St0#st{code=undefined}, %Reclaim heap space
+ case generate(Code, OutFile, Erule, Opts) of
+ {error,Reason} ->
+ {error,St#st{error=Reason}};
+ ok ->
+ {ok,St}
+ end.
+
+compile_pass(#st{outfile=OutFile,opts=Opts0}=St) ->
+ asn1_db:dbstop(), %Reclaim memory.
+ asn1ct_table:delete([renamed_defs,original_imports,automatic_tags]),
+ Opts = remove_asn_flags(Opts0),
+ case c:c(OutFile, Opts) of
+ {ok,_Module} ->
+ {ok,St};
+ _ ->
+ {error,St}
+ end.
+
+run_passes(Passes, #st{opts=Opts}=St) ->
+ Run = case lists:member(time, Opts) of
+ false ->
+ fun(_, Pass, S) -> Pass(S) end;
+ true ->
+ fun run_tc/3
+ end,
+ run_passes_1(Passes, St#st{run=Run}).
+
+run_tc(Name, Fun, St) ->
+ Before0 = statistics(runtime),
+ Val = (catch Fun(St)),
+ After0 = statistics(runtime),
+ {Before_c, _} = Before0,
+ {After_c, _} = After0,
+ io:format("~-31s: ~10.2f s\n",
+ [Name,(After_c-Before_c) / 1000]),
+ Val.
+
+run_passes_1([{unless,Opt,Pass}|Passes], #st{opts=Opts}=St) ->
+ case proplists:get_bool(Opt, Opts) of
+ false ->
+ run_passes_1([Pass|Passes], St);
+ true ->
+ run_passes_1(Passes, St)
+ end;
+run_passes_1([{iff,Opt,Pass}|Passes], #st{opts=Opts}=St) ->
+ case proplists:get_bool(Opt, Opts) of
+ true ->
+ run_passes_1([Pass|Passes], St);
+ false ->
+ run_passes_1(Passes, St)
+ end;
+run_passes_1([{pass,Name,Pass}|Passes], #st{run=Run}=St0)
+ when is_function(Pass, 1) ->
+ try Run(Name, Pass, St0) of
+ {ok,St} ->
+ run_passes_1(Passes, St);
+ {error,#st{error=Errors}} ->
+ {Structured,AllErrors} = clean_errors(Errors),
+ print_structured_errors(Structured),
+ {error,AllErrors};
+ done ->
+ ok
+ catch
+ Class:Error ->
+ Stk = erlang:get_stacktrace(),
+ io:format("Internal error: ~p:~p\n~p\n",
+ [Class,Error,Stk]),
+ {error,{internal_error,{Class,Error}}}
+ end;
+run_passes_1([], _St) ->
+ ok.
+
+clean_errors(Errors) when is_list(Errors) ->
+ F = fun({structured_error,_,_,_}) -> true;
+ (_) -> false
+ end,
+ {Structured0,AdHoc} = lists:partition(F, Errors),
+ Structured = lists:sort(Structured0),
+ {Structured,Structured ++ AdHoc};
+clean_errors(AdHoc) -> {[],AdHoc}.
+
+print_structured_errors([_|_]=Errors) ->
+ _ = [io:format("~ts:~w: ~ts\n", [F,L,M:format_error(E)]) ||
+ {structured_error,{F,L},M,E} <- Errors],
+ ok;
+print_structured_errors(_) -> ok.
+
+compile1(File, #st{opts=Opts}=St0) ->
+ verbose("Erlang ASN.1 version ~p, compiling ~p~n", [?vsn,File], Opts),
+ verbose("Compiler Options: ~p~n", [Opts], Opts),
+ Passes = single_passes(),
+ Base = filename:rootname(filename:basename(File)),
+ OutFile = outfile(Base, "", Opts),
+ DbFile = outfile(Base, "asn1db", Opts),
+ St1 = St0#st{file=File,outfile=OutFile,dbfile=DbFile},
+ run_passes(Passes, St1).
%%****************************************************************************%%
%% functions dealing with compiling of several input files to one output file %%
@@ -134,53 +348,20 @@ compile1(File,Options) when is_list(Options) ->
%% compile_set/3 merges and compiles a number of asn1 modules
%% specified in a .set.asn file to one .erl file.
-compile_set(SetBase,Files,Options)
- when is_list(hd(Files)),is_list(Options) ->
- %% case when there are several input files in a list
- verbose("Erlang ASN.1 version ~p compiling ~p ~n",[?vsn,Files],Options),
- verbose("Compiler Options: ~p~n",[Options],Options),
- OutFile = outfile(SetBase,"",Options),
- DbFile = outfile(SetBase,"asn1db",Options),
- Includes = [I || {i,I} <- Options],
- EncodingRule = get_rule(Options),
- ScanRes = scan_set(Files,Options),
- ParseRes = parse_set(ScanRes,Options),
- Result =
- case [X||X <- ParseRes,element(1,X)==true] of
- [] -> %% all were false, time to quit
- lists:map(fun(X)->element(2,X) end,ParseRes);
- ParseRes -> %% all were true, continue with check
- InputModules =
- lists:map(
- fun(F)->
- E = filename:extension(F),
- B = filename:basename(F,E),
- if
- is_list(B) -> list_to_atom(B);
- true -> B
- end
- end,
- Files),
- check_set(ParseRes,SetBase,OutFile,Includes,
- EncodingRule,DbFile,Options,InputModules);
- Other ->
- {error,{'unexpected error in scan/parse phase',
- lists:map(fun(X)->element(3,X) end,Other)}}
- end,
- Result.
-
-check_set(ParseRes,SetBase,OutFile,Includes,EncRule,DbFile,
- Options,InputModules) ->
-
- MergedModule = merge_modules(ParseRes,SetBase),
- SetM = MergedModule#module{name=SetBase},
- Continue1 = check({true,SetM},SetBase,OutFile,Includes,EncRule,DbFile,
- Options,InputModules),
- Continue2 = generate(Continue1,OutFile,EncRule,Options),
-
- asn1ct_table:delete([renamed_defs, original_imports, automatic_tags]),
-
- compile_erl(Continue2, OutFile, Options).
+compile_set(SetBase, Files, #st{opts=Opts}=St0) ->
+ verbose("Erlang ASN.1 version ~p compiling ~p ~n", [?vsn,Files], Opts),
+ verbose("Compiler Options: ~p~n",[Opts], Opts),
+ OutFile = outfile(SetBase, "", Opts),
+ DbFile = outfile(SetBase, "asn1db", Opts),
+ InputModules = [begin
+ F1 = filename:basename(F0),
+ F = filename:rootname(F1),
+ list_to_atom(F)
+ end || F0 <- Files],
+ St = St0#st{file=SetBase,files=Files,outfile=OutFile,
+ dbfile=DbFile,inputmodules=InputModules},
+ Passes = set_passes(),
+ run_passes(Passes, St).
%% merge_modules/2 -> returns a module record where the typeorval lists are merged,
%% the exports lists are merged, the imports lists are merged when the
@@ -188,8 +369,7 @@ check_set(ParseRes,SetBase,OutFile,Includes,EncRule,DbFile,
%% field gets the shared value if all modules have same tagging scheme,
%% otherwise a tagging_error exception is thrown,
%% the extensiondefault ...(not handled yet).
-merge_modules(ParseRes,CommonName) ->
- ModuleList = lists:map(fun(X)->element(2,X) end,ParseRes),
+merge_modules(ModuleList, CommonName) ->
NewModuleList = remove_name_collisions(ModuleList),
case asn1ct_table:size(renamed_defs) of
0 -> asn1ct_table:delete(renamed_defs);
@@ -379,6 +559,8 @@ get_pos_of_def(#pobjectdef{pos=Pos}) ->
Pos;
get_pos_of_def(#pobjectsetdef{pos=Pos}) ->
Pos;
+get_pos_of_def(#'Externalvaluereference'{pos=Pos}) ->
+ Pos;
get_pos_of_def(_) ->
undefined.
@@ -651,123 +833,9 @@ delete_double_of_symbol1([],Acc) ->
Acc.
-scan_set(Files,Options) ->
- %% The files in Files already have their relative path and extension
- lists:map(
- fun(F)->
- case scan(F,Options) of
- {false,{error,Reason}} ->
- throw({error,{'scan error in file:',F,Reason}});
- {TrueOrFalse,Res} ->
- {TrueOrFalse,Res,F}
- end
- end,
- Files).
-
-parse_set(ScanRes,Options) ->
- lists:map(
- fun({TorF,Toks,F})->
- case parse({TorF,Toks},F,Options) of
- {false,{error,Reason}} ->
- throw({error,{'parse error in file:',F,Reason}});
- {TrueOrFalse,Res} ->
- {TrueOrFalse,Res,F}
- end
- end,
- ScanRes).
-
-
%%***********************************
-
-scan(File,Options) ->
- case asn1ct_tok:file(File) of
- {error,Reason} ->
- error("~p~n",[Reason],Options),
- {false,{error,Reason}};
- Tokens ->
- case lists:member(ss,Options) of
- true -> % we terminate after scan
- {false,Tokens};
- false -> % continue with next pass
- {true,Tokens}
- end
- end.
-
-
-parse({true,Tokens},File,Options) ->
- %Presult = asn1ct_parser2:parse(Tokens),
- %%case lists:member(p1,Options) of
- %% true ->
- %% asn1ct_parser:parse(Tokens);
- %% _ ->
- %% asn1ct_parser2:parse(Tokens)
- %% end,
- case catch asn1ct_parser2:parse(Tokens) of
- {error,{{Line,_Mod,Message},_TokTup}} ->
- if
- is_integer(Line) ->
- BaseName = filename:basename(File),
- error("syntax error at line ~p in module ~s:~n",
- [Line,BaseName],Options);
- true ->
- error("syntax error in module ~p:~n",
- [File],Options)
- end,
- print_error_message(Message),
- {false,{error,Message}};
- {error,{Line,_Mod,[Message,Token]}} ->
- error("syntax error: ~p ~p at line ~p~n",
- [Message,Token,Line],Options),
- {false,{error,{Line,[Message,Token]}}};
- {ok,M} ->
- case lists:member(sp,Options) of
- true -> % terminate after parse
- {false,M};
- false -> % continue with next pass
- {true,M}
- end;
- OtherError ->
- error("~p~n",[OtherError],Options)
- end;
-parse({false,Tokens},_,_) ->
- {false,Tokens}.
-
-check({true,M},File,OutFile,Includes,EncodingRule,DbFile,Options,InputMods) ->
-
- start(Includes),
- case asn1ct_check:storeindb(#state{erule=EncodingRule},M) of
- ok ->
- Module = asn1_db:dbget(M#module.name,'MODULE'),
- State = #state{mname=Module#module.name,
- module=Module#module{typeorval=[]},
- erule=EncodingRule,
- inputmodules=InputMods,
- options=Options,
- sourcedir=filename:dirname(File)},
- Check = asn1ct_check:check(State,Module#module.typeorval),
- case {Check,lists:member(abs,Options)} of
- {{error,Reason},_} ->
- {false,{error,Reason}};
- {{ok,NewTypeOrVal,_},true} ->
- NewM = Module#module{typeorval=NewTypeOrVal},
- asn1_db:dbput(NewM#module.name,'MODULE',NewM),
- pretty2(M#module.name,lists:concat([OutFile,".abs"])),
- {false,ok};
- {{ok,NewTypeOrVal,GenTypeOrVal},_} ->
- NewM = Module#module{typeorval=NewTypeOrVal},
- asn1_db:dbput(NewM#module.name,'MODULE',NewM),
- asn1_db:dbsave(DbFile,M#module.name),
- verbose("--~p--~n",[{generated,DbFile}],Options),
- {true,{M,NewM,GenTypeOrVal}}
- end;
- ErrorList = {error,_} ->
- {false,ErrorList}
- end;
-check({false,M},_,_,_,_,_,_,_) ->
- {false,M}.
-
-generate({true,{M,_Module,GenTOrV}}, OutFile, EncodingRule, Options) ->
+generate({M,GenTOrV}, OutFile, EncodingRule, Options) ->
debug_on(Options),
setup_bit_string_format(Options),
put(encoding_options,Options),
@@ -796,19 +864,7 @@ generate({true,{M,_Module,GenTOrV}}, OutFile, EncodingRule, Options) ->
erase(tlv_format), % used in ber
erase(class_default_type),% used in ber
asn1ct_table:delete(check_functions),
- case Result of
- {error,_} ->
- {false,Result};
- ok ->
- case lists:member(sg,Options) of
- true -> % terminate here , with .erl file generated
- {false,true};
- false ->
- {true,true}
- end
- end;
-generate({false,M},_,_,_) ->
- {false,M}.
+ Result.
setup_bit_string_format(Opts) ->
Format = case {lists:member(compact_bit_string, Opts),
@@ -836,14 +892,13 @@ get_bit_string_format() ->
parse_and_save(Module,S) ->
Options = S#state.options,
SourceDir = S#state.sourcedir,
- Includes = [I || {i,I} <-Options],
-
- case get_input_file(Module,[SourceDir|Includes]) of
+ Includes = [I || {i,I} <- Options],
+ case get_input_file(Module, [SourceDir|Includes]) of
%% search for asn1 source
{file,SuffixedASN1source} ->
case dbfile_uptodate(SuffixedASN1source,Options) of
false ->
- parse_and_save1(S,SuffixedASN1source,Options,Includes);
+ parse_and_save1(S, SuffixedASN1source, Options);
_ -> ok
end;
Err ->
@@ -851,24 +906,14 @@ parse_and_save(Module,S) ->
[lists:concat([Module,".asn1db"])],Options),
{error,{asn1,input_file_error,Err}}
end.
-parse_and_save1(S,File,Options,Includes) ->
+
+parse_and_save1(#state{erule=Erule}, File, Options) ->
Ext = filename:extension(File),
- Base = filename:basename(File,Ext),
- DbFile = outfile(Base,"asn1db",Options),
- Continue1 = scan(File,Options),
- M =
- case parse(Continue1,File,Options) of
- {true,Mod} -> Mod;
- _ ->
-%% io:format("~p~nnow I die!!!!!!!!!!!~n",[File]),
- exit({error,{asn1,File,"no such file"}})
- end,
-% start(["."|Includes]),
- start(Includes),
- case asn1ct_check:storeindb(S,M) of
- ok ->
- asn1_db:dbsave(DbFile,M#module.name)
- end.
+ Base = filename:basename(File, Ext),
+ DbFile = outfile(Base, "asn1db", Options),
+ St = #st{file=File,dbfile=DbFile,erule=Erule},
+ Passes = parse_and_save_passes(),
+ run_passes(Passes, St).
get_input_file(Module,[]) ->
Module;
@@ -926,13 +971,6 @@ dbfile_uptodate(File,Options) ->
end.
-compile_erl({true,_},OutFile,Options) ->
- erl_compile(OutFile,Options);
-compile_erl({false,true},_,_) ->
- ok;
-compile_erl({false,Result},_,_) ->
- Result.
-
input_file_type(Name,I) ->
case input_file_type(Name) of
{error,_} -> input_file_type2(filename:basename(Name),I);
@@ -1064,22 +1102,6 @@ translate_options([H|T]) ->
[H|translate_options(T)];
translate_options([]) -> [].
-erl_compile(OutFile,Options) ->
-% io:format("Options:~n~p~n",[Options]),
- case lists:member(noobj,Options) of
- true ->
- ok;
- _ ->
- ErlOptions = remove_asn_flags(Options),
- %% io:format("~n~nc:c(~p,~p)~n~n",[OutFile,ErlOptions]),
- case c:c(OutFile,ErlOptions) of
- {ok,_Module} ->
- ok;
- _ ->
- {error,'no_compilation'}
- end
- end.
-
remove_asn_flags(Options) ->
[X || X <- Options,
X /= get_rule(Options),
@@ -1216,7 +1238,6 @@ make_erl_options(Opts) ->
lists:map(fun(Dir) -> {i, Dir} end, Includes)]++Specific.
pretty2(Module,AbsFile) ->
- start(),
{ok,F} = file:open(AbsFile,[write]),
M = asn1_db:dbget(Module,'MODULE'),
io:format(F,"%%%%%%%%%%%%%%%%%%% ~p %%%%%%%%%%%%%%%%%%%~n",[Module]),
@@ -1251,10 +1272,6 @@ pretty2(Module,AbsFile) ->
lists:foreach(fun(T)-> io:format(F,"~s.\n",
[asn1ct_pretty_format:term(asn1_db:dbget(Module,T))])
end,ObjectSets).
-start() ->
- Includes = ["."],
- start(Includes).
-
start(Includes) when is_list(Includes) ->
asn1_db:dbstart(Includes).
@@ -2097,52 +2114,6 @@ update_namelist(Name) ->
Other -> Other
end.
-pop_namelist() ->
- DeepTail = %% removes next element in order
- fun([[{_,A}]|T],_Fun) when is_atom(A) -> T;
- ([{_N,L}|T],_Fun) when is_list(L) -> [L|T];
- ([[]|T],Fun) -> Fun(T,Fun);
- ([L1|L2],Fun) when is_list(L1) ->
- case lists:flatten(L1) of
- [] -> Fun([L2],Fun);
- _ -> [Fun(L1,Fun)|L2]
- end;
- ([_H|T],_Fun) -> T
- end,
- {Pop,NewNL} =
- case get_gen_state_field(namelist) of
- [] -> {[],[]};
- L ->
- {next_namelist_el(L),
- DeepTail(L,DeepTail)}
- end,
- update_gen_state(namelist,NewNL),
- Pop.
-
-%% next_namelist_el fetches the next type/component name in turn in
-%% the namelist, without changing the namelist.
-next_namelist_el() ->
- case get_gen_state_field(namelist) of
- undefined -> undefined;
- L when is_list(L) -> next_namelist_el(L)
- end.
-
-next_namelist_el([]) ->
- [];
-next_namelist_el([L]) when is_list(L) ->
- next_namelist_el(L);
-next_namelist_el([H|_]) when is_atom(H) ->
- H;
-next_namelist_el([L|T]) when is_list(L) ->
- case next_namelist_el(L) of
- [] ->
- next_namelist_el([T]);
- R ->
- R
- end;
-next_namelist_el([H={_,A}|_]) when is_atom(A) ->
- H.
-
%% removes a bracket from the namelist
step_in_constructed() ->
case get_gen_state_field(namelist) of
@@ -2382,14 +2353,6 @@ maybe_saved_sindex(Name,Pattern) ->
end
end.
-next_sindex() ->
- SI = get_gen_state_field(suffix_index),
- update_gen_state(suffix_index,SI+1),
- SI+1.
-
-latest_sindex() ->
- get_gen_state_field(suffix_index).
-
current_sindex() ->
get_gen_state_field(current_suffix_index).
diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl
index 0622998445..f94550b0a4 100644
--- a/lib/asn1/src/asn1ct_check.erl
+++ b/lib/asn1/src/asn1ct_check.erl
@@ -25,7 +25,7 @@
%-compile(export_all).
%% Avoid warning for local function error/1 clashing with autoimported BIF.
-compile({no_auto_import,[error/1]}).
--export([check/2,storeindb/2]).
+-export([check/2,storeindb/2,format_error/1]).
%-define(debug,1).
-include("asn1_records.hrl").
%%% The tag-number for universal types
@@ -73,7 +73,6 @@
end).
-record(newt,{type=unchanged,tag=unchanged,constraint=unchanged,inlined=no}). % used in check_type to update type and tag
--record(newv,{type=unchanged,value=unchanged}). % used in check_value to update type and value
check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) ->
%%Predicates used to filter errors
@@ -92,14 +91,14 @@ check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) ->
save_asn1db_uptodate(S,S#state.erule,S#state.mname),
put(top_module,S#state.mname),
- _Perror = checkp(S,ParameterizedTypes,[]), % must do this before the templates are used
+ _ = checkp(S, ParameterizedTypes), %must do this before the templates are used
%% table to save instances of parameterized objects,object sets
asn1ct_table:new(parameterized_objects),
asn1ct_table:new(inlined_objects),
- Terror = checkt(S,Types,[]),
+ Terror = checkt(S, Types),
?dbg("checkt finished with errors:~n~p~n~n",[Terror]),
%% get parameterized object sets sent to checkt/3
@@ -107,7 +106,7 @@ check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) ->
{PObjSetNames1,Terror2} = filter_errors(IsPObjSet,Terror),
- Verror = checkv(S,Values ++ ObjectSets,[]), %value sets may be parsed as object sets
+ Verror = checkv(S, Values ++ ObjectSets), %value sets may be parsed as object sets
?dbg("checkv finished with errors:~n~p~n~n",[Verror]),
%% get information object classes wrongly sent to checkt/3
%% and update Terror2
@@ -116,7 +115,7 @@ check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) ->
NewClasses = Classes++AddClasses,
- Cerror = checkc(S,NewClasses,[]),
+ Cerror = checkc(S, NewClasses),
?dbg("checkc finished with errors:~n~p~n~n",[Cerror]),
%% get object sets incorrectly sent to checkv/3
%% and update Verror
@@ -175,8 +174,9 @@ check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) ->
{NewTypes,NewValues,ParameterizedTypes,NewClasses,
lists:subtract(NewObjects,ExclO)++InlinedObjects,
lists:subtract(NewObjectSets,ExclOS)++ParObjectSetNames}};
- _ ->{error,{asn1,lists:flatten([Terror3,Verror5,Cerror,
- Oerror,Exporterror,ImportError])}}
+ _ ->
+ {error,lists:flatten([Terror3,Verror5,Cerror,
+ Oerror,Exporterror,ImportError])}
end.
context_switch_in_spec() ->
@@ -338,51 +338,40 @@ chained_import(S,ImpMod,DefMod,Name) ->
chained_import(S,OtherMod,DefMod,Name)
end
end.
-
-checkt(S,[Name|T],Acc) ->
- ?dbg("Checking type ~p~n",[Name]),
- Result =
- case asn1_db:dbget(S#state.mname,Name) of
- undefined ->
- error({type,{internal_error,'???'},S});
- Type when is_record(Type,typedef) ->
- NewS = S#state{type=Type,tname=Name},
- case catch(check_type(NewS,Type,Type#typedef.typespec)) of
- {error,Reason} ->
- error({type,Reason,NewS});
- {'EXIT',Reason} ->
- error({type,{internal_error,Reason},NewS});
- {asn1_class,_ClassDef} ->
- {asn1_class,Name};
- pobjectsetdef ->
- {pobjectsetdef,Name};
- pvalueset ->
- {pvalueset,Name};
- Ts ->
- case Type#typedef.checked of
- true -> % already checked and updated
- ok;
- _ ->
- NewTypeDef = Type#typedef{checked=true,typespec = Ts},
-
- asn1_db:dbput(NewS#state.mname,Name,NewTypeDef), % update the type
- ok
- end
- end
- end,
- case Result of
- ok ->
- checkt(S,T,Acc);
- _ ->
- checkt(S,T,[Result|Acc])
- end;
-checkt(S,[],Acc) ->
- case check_contextswitchingtypes(S,[]) of
- [] ->
- lists:reverse(Acc);
- L ->
- checkt(S,L,Acc)
+checkt(S0, Names) ->
+ Check = fun do_checkt/3,
+
+ %% NOTE: check_type/3 will store information in the process
+ %% dictionary if context switching types are encountered;
+ %% therefore we must force the evaluation order.
+ Types = check_fold(S0, Names, Check),
+ CtxtSwitch = check_contextswitchingtypes(S0, []),
+ check_fold(S0, lists:reverse(CtxtSwitch), Check) ++ Types.
+
+do_checkt(S, Name, #typedef{typespec=TypeSpec}=Type0) ->
+ NewS = S#state{type=Type0,tname=Name},
+ try check_type(NewS, Type0, TypeSpec) of
+ #type{}=Ts ->
+ case Type0#typedef.checked of
+ true -> %already checked and updated
+ ok;
+ _ ->
+ Type = Type0#typedef{checked=true,
+ typespec=Ts},
+ asn1_db:dbput(NewS#state.mname,
+ Name, Type),
+ ok
+ end
+ catch
+ {error,Reason} ->
+ error({type,Reason,NewS});
+ {asn1_class,_ClassDef} ->
+ {asn1_class,Name};
+ pobjectsetdef ->
+ {pobjectsetdef,Name};
+ pvalueset ->
+ {pvalueset,Name}
end.
check_contextswitchingtypes(S,Acc) ->
@@ -402,131 +391,86 @@ check_contextswitchingtypes(S,[{T,TName}|Ts],Acc) ->
check_contextswitchingtypes(_,[],Acc) ->
Acc.
-checkv(S,[Name|T],Acc) ->
- ?dbg("Checking valuedef ~p~n",[Name]),
- Result = case asn1_db:dbget(S#state.mname,Name) of
- undefined -> error({value,{internal_error,'???'},S});
- Value when is_record(Value,valuedef);
- is_record(Value,typedef); %Value set may be parsed as object set.
- is_record(Value,pvaluedef);
- is_record(Value,pvaluesetdef) ->
- NewS = S#state{value=Value},
- case catch(check_value(NewS,Value)) of
- {error,Reason} ->
- error({value,Reason,NewS});
- {'EXIT',Reason} ->
- error({value,{internal_error,Reason},NewS});
- {pobjectsetdef} ->
- {pobjectsetdef,Name};
- {objectsetdef} ->
- {objectsetdef,Name};
- {objectdef} ->
- %% this is an object, save as typedef
- #valuedef{checked=C,pos=Pos,name=N,type=Type,
- value=Def}=Value,
- ClassName = Type#type.def,
- NewSpec = #'Object'{classname=ClassName,
- def=Def},
- NewDef = #typedef{checked=C,pos=Pos,name=N,
- typespec=NewSpec},
- asn1_db:dbput(NewS#state.mname,Name,NewDef),
- {objectdef,Name};
- {valueset,VSet} ->
- Pos = asn1ct:get_pos_of_def(Value),
- CheckedVSDef = #typedef{checked=true,pos=Pos,
- name=Name,typespec=VSet},
- asn1_db:dbput(NewS#state.mname,Name,CheckedVSDef),
- {valueset,Name};
- V ->
- %% update the valuedef
- asn1_db:dbput(NewS#state.mname,Name,V),
- ok
- end
- end,
- case Result of
- ok ->
- checkv(S,T,Acc);
- _ ->
- checkv(S,T,[Result|Acc])
- end;
-checkv(_S,[],Acc) ->
- lists:reverse(Acc).
-
-
-checkp(S,[Name|T],Acc) ->
- %io:format("check_ptypedef:~p~n",[Name]),
- Result = case asn1_db:dbget(S#state.mname,Name) of
- undefined ->
- error({type,{internal_error,'???'},S});
- Type when is_record(Type,ptypedef) ->
- NewS = S#state{type=Type,tname=Name},
- case catch(check_ptype(NewS,Type,Type#ptypedef.typespec)) of
- {error,Reason} ->
- error({type,Reason,NewS});
- {'EXIT',Reason} ->
- error({type,{internal_error,Reason},NewS});
- {asn1_class,_ClassDef} ->
- {asn1_class,Name};
- {asn1_param_class,_} -> ok;
- Ts ->
- NewType = Type#ptypedef{checked=true,typespec = Ts},
- asn1_db:dbput(NewS#state.mname,Name,NewType), % update the type
- ok
- end
- end,
- case Result of
- ok ->
- checkp(S,T,Acc);
- _ ->
- checkp(S,T,[Result|Acc])
- end;
-checkp(_S,[],Acc) ->
- lists:reverse(Acc).
-
+checkv(S, Names) ->
+ check_fold(S, Names, fun do_checkv/3).
+
+do_checkv(S, Name, Value)
+ when is_record(Value, valuedef);
+ is_record(Value, typedef); %Value set may be parsed as object set.
+ is_record(Value, pvaluedef);
+ is_record(Value, pvaluesetdef) ->
+ NewS = S#state{value=Value},
+ try check_value(NewS, Value) of
+ {valueset,VSet} ->
+ Pos = asn1ct:get_pos_of_def(Value),
+ CheckedVSDef = #typedef{checked=true,pos=Pos,
+ name=Name,typespec=VSet},
+ asn1_db:dbput(NewS#state.mname, Name, CheckedVSDef),
+ {valueset,Name};
+ V ->
+ %% update the valuedef
+ asn1_db:dbput(NewS#state.mname, Name, V),
+ ok
+ catch
+ {error,Reason} ->
+ error({value,Reason,NewS});
+ {pobjectsetdef} ->
+ {pobjectsetdef,Name};
+ {objectsetdef} ->
+ {objectsetdef,Name};
+ {objectdef} ->
+ %% this is an object, save as typedef
+ #valuedef{checked=C,pos=Pos,name=N,type=Type,
+ value=Def} = Value,
+ ClassName = Type#type.def,
+ NewSpec = #'Object'{classname=ClassName,def=Def},
+ NewDef = #typedef{checked=C,pos=Pos,name=N,typespec=NewSpec},
+ asn1_db:dbput(NewS#state.mname, Name, NewDef),
+ {objectdef,Name}
+ end.
+%% Check parameterized types.
+checkp(S, Names) ->
+ check_fold(S, Names, fun do_checkp/3).
+do_checkp(S0, Name, #ptypedef{typespec=TypeSpec}=Type0) ->
+ S = S0#state{type=Type0,tname=Name},
+ try check_ptype(S, Type0, TypeSpec) of
+ #type{}=Ts ->
+ Type = Type0#ptypedef{checked=true,typespec=Ts},
+ asn1_db:dbput(S#state.mname, Name, Type),
+ ok
+ catch
+ {error,Reason} ->
+ error({type,Reason,S});
+ {asn1_class,_ClassDef} ->
+ {asn1_class,Name};
+ {asn1_param_class,_} ->
+ ok
+ end.
-checkc(S,[Name|Cs],Acc) ->
- Result =
- case asn1_db:dbget(S#state.mname,Name) of
- undefined ->
- error({class,{internal_error,'???'},S});
- Class ->
- ClassSpec = if
- is_record(Class,classdef) ->
-% Class#classdef.typespec;
- Class;
- is_record(Class,typedef) ->
- Class#typedef.typespec
- end,
- NewS = S#state{type=Class,tname=Name},
- case catch(check_class(NewS,ClassSpec)) of
- {error,Reason} ->
- error({class,Reason,NewS});
- {'EXIT',Reason} ->
- error({class,{internal_error,Reason},NewS});
- C ->
- %% update the classdef
- NewClass =
- if
- is_record(Class,classdef) ->
- Class#classdef{checked=true,typespec=C};
- is_record(Class,typedef) ->
- #classdef{checked=true,name=Name,typespec=C}
- end,
- asn1_db:dbput(NewS#state.mname,Name,NewClass),
- ok
- end
+%% Check class definitions.
+checkc(S, Names) ->
+ check_fold(S, Names, fun do_checkc/3).
+
+do_checkc(S0, Name, Class0) ->
+ {Class1,ClassSpec} =
+ case Class0 of
+ #classdef{} ->
+ {Class0,Class0};
+ #typedef{} ->
+ {#classdef{name=Name},Class0#typedef.typespec}
end,
- case Result of
- ok ->
- checkc(S,Cs,Acc);
- _ ->
- checkc(S,Cs,[Result|Acc])
- end;
-checkc(_S,[],Acc) ->
-%% include_default_class(S#state.mname),
- lists:reverse(Acc).
+ S = S0#state{type=Class0,tname=Name},
+ try check_class(S, ClassSpec) of
+ C ->
+ Class = Class1#classdef{checked=true,typespec=C},
+ asn1_db:dbput(S#state.mname, Name, Class),
+ ok
+ catch
+ {error,Reason} ->
+ error({class,Reason,S})
+ end.
checko(S,[Name|Os],Acc,ExclO,ExclOS) ->
?dbg("Checking object ~p~n",[Name]),
@@ -695,8 +639,7 @@ check_class_fields(S,[F|Fields],Acc) ->
Type2 = maybe_unchecked_OCFT(S,Type),
Cat =
case asn1ct_gen:type(asn1ct_gen:get_inner(Type2#type.def)) of
- Def when is_record(Def,typereference);
- is_record(Def,'Externaltypereference') ->
+ Def when is_record(Def,'Externaltypereference') ->
{_,D} = get_referenced_type(S,Def),
D;
{undefined,user} ->
@@ -876,14 +819,6 @@ check_object(S,
?dbg("check_object set: ~p~n",[ObjSet#'ObjectSet'.set]),
{_,ClassDef} = get_referenced_type(S,ClassRef),
NewClassRef = check_externaltypereference(S,ClassRef),
- %% XXXXXXXXXX
- case ObjSet of
- #'ObjectSet'{set={'Externaltypereference',undefined,'MSAccessProtocol',
- 'AllOperations'}} ->
- ok;
- _ ->
- ok
- end,
{UniqueFieldName,UniqueInfo} =
case (catch get_unique_fieldname(S,ClassDef)) of
{error,'__undefined_',_} ->
@@ -1233,8 +1168,7 @@ check_object_list(S,ClassRef,[ObjOrSet|Objs],Acc) ->
ObjSet when is_record(ObjSet,type) ->
ObjSetDef =
case ObjSet#type.def of
- Ref when is_record(Ref,typereference);
- is_record(Ref,'Externaltypereference') ->
+ Ref when is_record(Ref,'Externaltypereference') ->
{_,D} = get_referenced_type(S,ObjSet#type.def),
D;
Other ->
@@ -1826,10 +1760,6 @@ convert_to_defaultfield(S,ObjFieldName,[OFS|RestOFS],CField)->
T = check_type(S,#typedef{typespec=ObjFieldSetting},
ObjFieldSetting),
{#typedef{checked=true,name=Bif,typespec=T},RestSettings};
- _OCFT = #'ObjectClassFieldType'{} ->
- T=check_type(S,#typedef{typespec=ObjFieldSetting},ObjFieldSetting),
- %%io:format("OCFT=~p~n,T=~p~n",[OCFT,T]),
- {#typedef{checked=true,typespec=T},RestSettings};
_ ->
%this case should not happen any more
{Mod,T} =
@@ -2140,172 +2070,72 @@ check_value(S,#valuedef{pos=Pos,name=Name,type=Type,
NewType = Type#type{constraint=[Constr]},
{valueset,
check_type(S,#typedef{pos=Pos,name=Name,typespec=NewType},NewType)};
-check_value(OldS=#state{recordtopname=TopName},V) when is_record(V,valuedef) ->
- #valuedef{name=Name,checked=Checked,type=Vtype,
- value=Value,module=ModName} = V,
- ?dbg("check_value, V: ~p~n",[V]),
- case Checked of
- true ->
- V;
- {error,_} ->
+check_value(S, #valuedef{}=V) ->
+ ?dbg("check_value, V: ~p~n",[V0]),
+ case V of
+ #valuedef{checked=true} ->
V;
- false ->
- Def = Vtype#type.def,
- Constr = Vtype#type.constraint,
- S = OldS#state{type=Vtype,tname=Def,value=V,vname=Name},
- SVal = update_state(S,ModName),
- NewDef =
- case Def of
- Ext when is_record(Ext,'Externaltypereference') ->
- RecName = Ext#'Externaltypereference'.type,
- {RefM,Type} = get_referenced_type(S,Ext),
- %% If V isn't a value but an object Type is a #classdef{}
- %%NewS = S#state{mname=RefM},
- NewS = update_state(S,RefM),
- case Type of
- #classdef{} ->
- throw({objectdef});
- #typedef{} ->
- case is_contextswitchtype(Type) of
- true ->
- #valuedef{value=CheckedVal}=
- check_value(NewS,V#valuedef{type=Type#typedef.typespec}),
- #newv{value=CheckedVal};
- _ ->
- #valuedef{value=CheckedVal}=
- check_value(NewS#state{recordtopname=[RecName|TopName]},
- V#valuedef{type=Type#typedef.typespec}),
- #newv{value=CheckedVal}
- end;
- #type{} ->
- %% A parameter that couldn't be categorized.
- #valuedef{value=CheckedVal}=
- check_value(NewS#state{recordtopname=[RecName|TopName]},
- V#valuedef{type=Type}),
- #newv{value=CheckedVal}
- end;
- 'ANY' ->
- case Value of
- {opentypefieldvalue,ANYType,ANYValue} ->
- CheckedV=
- check_value(SVal,#valuedef{name=Name,
- type=ANYType,
- value=ANYValue,
- module=ModName}),
- #newv{value=CheckedV#valuedef.value};
- _ ->
- throw({error,{asn1,{'cant check value of type',Def}}})
- end;
- 'INTEGER' ->
- ok=validate_integer(SVal,Value,[],Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- {'INTEGER',NamedNumberList} ->
- ok=validate_integer(SVal,Value,NamedNumberList,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- {'BIT STRING',NamedNumberList} ->
- ok=validate_bitstring(SVal,Value,NamedNumberList,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'NULL' ->
- ok=validate_null(SVal,Value,Constr),
- #newv{};
- 'OBJECT IDENTIFIER' ->
- {ok,_}=validate_objectidentifier(SVal,Value,Constr),
- #newv{value = normalize_value(SVal,Vtype,Value,[])};
- 'RELATIVE-OID' ->
- {ok,_}=validate_relative_oid(SVal,Value,Constr),
- #newv{value = Value};
- 'ObjectDescriptor' ->
- ok=validate_objectdescriptor(SVal,Value,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'REAL' ->
- ok = validate_real(SVal,Value,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- {'ENUMERATED',NamedNumberList} ->
- ok=validate_enumerated(SVal,Value,NamedNumberList,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'BOOLEAN'->
- ok=validate_boolean(SVal,Value,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'OCTET STRING' ->
- ok=validate_octetstring(SVal,Value,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'NumericString' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- TString when TString =:= 'TeletexString';
- TString =:= 'T61String' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'VideotexString' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'UTCTime' ->
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
-% exit({'cant check value of type' ,Def});
- 'GeneralizedTime' ->
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
-% exit({'cant check value of type' ,Def});
- 'GraphicString' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'VisibleString' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'GeneralString' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'PrintableString' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'IA5String' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'BMPString' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'UTF8String' ->
- ok = validate_restrictedstring(SVal,Vtype,Value,Constr),
- %%io:format("Vtype: ~p~nValue: ~p~n",[Vtype,Value]);
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'UniversalString' -> %added 6/12 -00
- ok = validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- Seq when is_record(Seq,'SEQUENCE') ->
- {ok,SeqVal} = validate_sequence(SVal,Value,
- Seq#'SEQUENCE'.components,
- Constr),
- #newv{value=normalize_value(SVal,Vtype,SeqVal,TopName)};
- {'SEQUENCE OF',Components} ->
- ok=validate_sequenceof(SVal,Value,Components,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,TopName)};
- {'CHOICE',Components} ->
- ok=validate_choice(SVal,Value,Components,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,TopName)};
- Set when is_record(Set,'SET') ->
- ok=validate_set(SVal,Value,Set#'SET'.components,
- Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,TopName)};
- {'SET OF',Components} ->
- ok=validate_setof(SVal,Value,Components,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,TopName)};
- {'SelectionType',SelName,SelT} ->
- CheckedT = check_selectiontype(SVal,SelName,SelT),
- NewV = V#valuedef{type=CheckedT},
- SelVDef=check_value(S#state{value=NewV},NewV),
- #newv{value=SelVDef#valuedef.value};
- Other ->
- exit({'cannot check value of type' ,Other})
- end,
- case NewDef#newv.value of
- unchanged ->
- V#valuedef{checked=true,value=Value};
- ok ->
- V#valuedef{checked=true,value=Value};
- {error,Reason} ->
- V#valuedef{checked={error,Reason},value=Value};
- _V ->
- V#valuedef{checked=true,value=_V}
- end
+ #valuedef{checked=false} ->
+ check_valuedef(S, V)
+ end.
+
+check_valuedef(#state{recordtopname=TopName}=S0, V0) ->
+ #valuedef{name=Name,type=Vtype,value=Value,module=ModName} = V0,
+ V = V0#valuedef{checked=true},
+ Def = Vtype#type.def,
+ Constr = Vtype#type.constraint,
+ S1 = S0#state{type=Vtype,tname=Def,value=V0,vname=Name},
+ SVal = update_state(S1, ModName),
+ case Def of
+ #'Externaltypereference'{type=RecName}=Ext ->
+ {RefM,Type} = get_referenced_type(S1, Ext),
+ %% If V isn't a value but an object Type is a #classdef{}
+ S2 = update_state(S1, RefM),
+ case Type of
+ #classdef{} ->
+ throw({objectdef});
+ #typedef{typespec=TypeSpec} ->
+ S3 = case is_contextswitchtype(Type) of
+ true ->
+ S2;
+ false ->
+ S2#state{recordtopname=[RecName|TopName]}
+ end,
+ #valuedef{value=CheckedVal} =
+ check_value(S3, V0#valuedef{type=TypeSpec}),
+ V#valuedef{value=CheckedVal};
+ #type{} ->
+ %% A parameter that couldn't be categorized.
+ #valuedef{value=CheckedVal} =
+ check_value(S2#state{recordtopname=[RecName|TopName]},
+ V#valuedef{type=Type}),
+ V#valuedef{value=CheckedVal}
+ end;
+ 'ANY' ->
+ {opentypefieldvalue,ANYType,ANYValue} = Value,
+ CheckedV = check_value(SVal,#valuedef{name=Name,
+ type=ANYType,
+ value=ANYValue,
+ module=ModName}),
+ V#valuedef{value=CheckedV#valuedef.value};
+ 'INTEGER' ->
+ ok = validate_integer(SVal, Value, [], Constr),
+ V#valuedef{value=normalize_value(SVal, Vtype, Value, [])};
+ {'INTEGER',NamedNumberList} ->
+ ok = validate_integer(SVal, Value, NamedNumberList, Constr),
+ V#valuedef{value=normalize_value(SVal, Vtype, Value, [])};
+ #'SEQUENCE'{components=Components} ->
+ {ok,SeqVal} = validate_sequence(SVal, Value,
+ Components, Constr),
+ V#valuedef{value=normalize_value(SVal, Vtype,
+ SeqVal, TopName)};
+ {'SelectionType',SelName,SelT} ->
+ CheckedT = check_selectiontype(SVal, SelName, SelT),
+ NewV = V#valuedef{type=CheckedT},
+ SelVDef = check_value(S1#state{value=NewV}, NewV),
+ V#valuedef{value=SelVDef#valuedef.value};
+ _ ->
+ V#valuedef{value=normalize_value(SVal, Vtype, Value, TopName)}
end.
is_contextswitchtype(#typedef{name='EXTERNAL'})->
@@ -2358,23 +2188,7 @@ validate_integer_ref(S,Ref,NamedNumberList,Constr) ->
-check_integer_range(Int,Constr) when is_list(Constr) ->
- NewConstr = [X || #constraint{c=X} <- Constr],
- check_constr(Int,NewConstr);
-
-check_integer_range(_Int,_Constr) ->
- %%io:format("~p~n",[Constr]),
- ok.
-
-check_constr(Int,[{'ValueRange',Lb,Ub}|T]) when Int >= Lb, Int =< Ub ->
- check_constr(Int,T);
-check_constr(_Int,[]) ->
- ok.
-
-validate_bitstring(_S,_Value,_NamedNumberList,_Constr) ->
- ok.
-
-validate_null(_S,'NULL',_Constr) ->
+check_integer_range(_Int, Constr) when is_list(Constr) ->
ok.
%%------------
@@ -2390,9 +2204,6 @@ is_space_list([],Acc) ->
is_space_list([H|T],Acc) ->
is_space_list(T,[H|Acc]).
-validate_objectidentifier(S,ERef,C) ->
- validate_objectidentifier(S,o_id,ERef,C).
-
validate_objectidentifier(S,OID,ERef,C)
when is_record(ERef,'Externalvaluereference') ->
validate_objectidentifier(S,OID,[ERef],C);
@@ -2490,9 +2301,6 @@ validate_oid(_, S, OID, [Atom|Rest],Acc) when is_atom(Atom) ->
validate_oid(_, S, OID, V, Acc) ->
error({value, {"illegal "++to_string(OID),V,Acc},S}).
-validate_relative_oid(S,Value,Constr) ->
- validate_objectidentifier(S,rel_oid,Value,Constr).
-
is_object_id(OID,S,ERef=#'Externaltypereference'{}) ->
{_,OI} = get_referenced_type(S,ERef),
is_object_id(OID,S,OI#typedef.typespec);
@@ -2579,43 +2387,6 @@ valid_objectid(o_id,_I,[1]) -> false;
valid_objectid(o_id,_I,[2]) -> true;
valid_objectid(_,_,_) -> true.
-
-
-
-
-
-validate_objectdescriptor(_S,_Value,_Constr) ->
- ok.
-
-validate_real(_S,_Value,_Constr) ->
- ok.
-
-validate_enumerated(S,Id,NamedNumberList,_Constr) when is_atom(Id) ->
- case lists:keysearch(Id,1,NamedNumberList) of
- {value,_} -> ok;
- false -> error({value,"unknown ENUMERATED",S})
- end;
-validate_enumerated(S,{identifier,_Pos,Id},NamedNumberList,_Constr) ->
- case lists:keysearch(Id,1,NamedNumberList) of
- {value,_} -> ok;
- false -> error({value,"unknown ENUMERATED",S})
- end;
-validate_enumerated(S,#'Externalvaluereference'{value=Id},
- NamedNumberList,_Constr) ->
- case lists:keysearch(Id,1,NamedNumberList) of
- {value,_} -> ok;
- false -> error({value,"unknown ENUMERATED",S})
- end.
-
-validate_boolean(_S,_Value,_Constr) ->
- ok.
-
-validate_octetstring(_S,_Value,_Constr) ->
- ok.
-
-validate_restrictedstring(_S,_Value,_Def,_Constr) ->
- ok.
-
validate_sequence(S=#state{type=Vtype},Value,_Components,_Constr) ->
case Vtype of
#type{tag=[{tag,'UNIVERSAL',8,'IMPLICIT',32}]} ->
@@ -2630,18 +2401,6 @@ validate_sequence(S=#state{type=Vtype},Value,_Components,_Constr) ->
{ok,Value}
end.
-validate_sequenceof(_S,_Value,_Components,_Constr) ->
- ok.
-
-validate_choice(_S,_Value,_Components,_Constr) ->
- ok.
-
-validate_set(_S,_Value,_Components,_Constr) ->
- ok.
-
-validate_setof(_S,_Value,_Components,_Constr) ->
- ok.
-
to_EXTERNAL1990(S,[{identification,{'CHOICE',{syntax,Stx}}}|Rest]) ->
to_EXTERNAL1990(S,Rest,[{'direct-reference',Stx}]);
to_EXTERNAL1990(S,[{identification,{'CHOICE',{'presentation-context-id',I}}}|Rest]) ->
@@ -2667,7 +2426,8 @@ normalize_value(_,_,mandatory,_) ->
mandatory;
normalize_value(_,_,'OPTIONAL',_) ->
'OPTIONAL';
-normalize_value(S,Type,{'DEFAULT',Value},NameList) ->
+normalize_value(S0, Type, {'DEFAULT',Value}, NameList) ->
+ S = S0#state{value=Value},
case catch get_canonic_type(S,Type,NameList) of
{'BOOLEAN',CType,_} ->
normalize_boolean(S,Value,CType);
@@ -2892,12 +2652,12 @@ hstring_to_octetlist([H|T],BSL,Acc) when H >= $0; H =< $9 ->
hstring_to_octetlist([],_,Acc) ->
lists:reverse(Acc).
-normalize_objectidentifier(S,Value) ->
- {ok,Val}=validate_objectidentifier(S,Value,[]),
+normalize_objectidentifier(S, Value) ->
+ {ok,Val} = validate_objectidentifier(S, o_id, Value, []),
Val.
normalize_relative_oid(S,Value) ->
- {ok,Val} = validate_relative_oid(S,Value,[]),
+ {ok,Val} = validate_objectidentifier(S, rel_oid, Value, []),
Val.
normalize_objectdescriptor(Value) ->
@@ -2906,29 +2666,20 @@ normalize_objectdescriptor(Value) ->
normalize_real(Value) ->
Value.
-normalize_enumerated(S,#'Externalvaluereference'{value=V},CType)
- when is_list(CType) ->
- normalize_enumerated2(S,V,CType);
-normalize_enumerated(S,Value,CType) when is_atom(Value),is_list(CType) ->
- normalize_enumerated2(S,Value,CType);
-normalize_enumerated(S,{Name,EnumV},CType) when is_atom(Name) ->
- normalize_enumerated(S,EnumV,CType);
-normalize_enumerated(S,Value,{CType1,CType2}) when is_list(CType1), is_list(CType2)->
- normalize_enumerated(S,Value,CType1++CType2);
-normalize_enumerated(S,V,CType) ->
- asn1ct:warning("Enumerated unknown type ~p~n",[CType],S,
- "Enumerated unknown type"),
- V.
-normalize_enumerated2(S,V,Enum) ->
- case lists:keysearch(V,1,Enum) of
- {value,{Val,_}} -> Val;
- _ ->
- asn1ct:warning("enumerated value is not correct ~p~n",[V],S,
- "enumerated value is not correct"),
- V
+normalize_enumerated(S, Id, {Base,Ext}) ->
+ %% Extensible ENUMERATED.
+ normalize_enumerated(S, Id, Base++Ext);
+normalize_enumerated(S, #'Externalvaluereference'{value=Id},
+ NamedNumberList) ->
+ normalize_enumerated(S, Id, NamedNumberList);
+normalize_enumerated(S, Id, NamedNumberList) when is_atom(Id) ->
+ case lists:keymember(Id, 1, NamedNumberList) of
+ true ->
+ Id;
+ false ->
+ throw(asn1_error(S, S#state.value, {undefined,Id}))
end.
-
normalize_choice(S,{'CHOICE',{C,V}},CType,NameList) when is_atom(C) ->
case catch lists:keysearch(C,#'ComponentType'.name,CType) of
{value,#'ComponentType'{typespec=CT,name=Name}} ->
@@ -3535,10 +3286,6 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) ->
merge_tags(Tag,?TAG_CONSTRUCTED(?N_SET))};
%% This is a temporary hack until the full Information Obj Spec
%% in X.681 is supported
- {{typereference,_,'TYPE-IDENTIFIER'},[{typefieldreference,_,'Type'}]} ->
- Ct=maybe_illicit_implicit_tag(open_type,Tag),
- TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct};
-
{#'Externaltypereference'{type='TYPE-IDENTIFIER'},
[{typefieldreference,_,'Type'}]} ->
Ct=maybe_illicit_implicit_tag(open_type,Tag),
@@ -3575,7 +3322,15 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) ->
_ ->
MergedTag
end,
- TempNewDef#newt{type=NewTypeDef,tag=Ct};
+ case TopName of
+ [] when Type#typedef.name =/= undefined ->
+ %% This is a top-level type.
+ #type{def=Simplified} =
+ simplify_type(#type{def=NewTypeDef}),
+ TempNewDef#newt{type=Simplified,tag=Ct};
+ _ ->
+ TempNewDef#newt{type=NewTypeDef,tag=Ct}
+ end;
{'TypeFromObject',{object,Object},TypeField} ->
CheckedT = get_type_from_object(S,Object,TypeField),
@@ -3591,29 +3346,14 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) ->
Other ->
exit({'cant check' ,Other})
end,
- Ts2 = case NewDef of
- #newt{type=unchanged} ->
- Ts#type{def=Def};
- #newt{type=TDef}->
- Ts#type{def=TDef}
- end,
- NewTag = case NewDef of
- #newt{tag=unchanged} ->
- Tag;
- #newt{tag=TT} ->
- TT
- end,
- T3 = Ts2#type{tag = lists:map(fun(TempTag = #tag{type={default,TTx}}) ->
- TempTag#tag{type=TTx};
- (Else) -> Else end, NewTag)},
- T4 = case NewDef of
- #newt{constraint=unchanged} ->
- T3#type{constraint=Constr};
- #newt{constraint=NewConstr} ->
- T3#type{constraint=NewConstr}
- end,
- T5 = T4#type{inlined=NewDef#newt.inlined},
- T5#type{constraint=check_constraints(S,T5#type.constraint)};
+ #newt{type=TDef,tag=NewTags,constraint=NewConstr,inlined=Inlined} = NewDef,
+ Ts#type{def=TDef,
+ inlined=Inlined,
+ constraint=check_constraints(S, NewConstr),
+ tag=lists:map(fun(#tag{type={default,TTx}}=TempTag) ->
+ TempTag#tag{type=TTx};
+ (Other) -> Other
+ end, NewTags)};
check_type(_S,Type,Ts) ->
exit({error,{asn1,internal_error,Type,Ts}}).
@@ -3625,6 +3365,28 @@ get_non_typedef(S, Tref0) ->
Type
end.
+
+%%
+%% Simplify the backends by getting rid of an #'ObjectClassFieldType'{}
+%% with a type known at compile time.
+%%
+
+simplify_comps(Comps) ->
+ [simplify_comp(Comp) || Comp <- Comps].
+
+simplify_comp(#'ComponentType'{typespec=Type0}=C) ->
+ Type = simplify_type(Type0),
+ C#'ComponentType'{typespec=Type};
+simplify_comp(Other) -> Other.
+
+simplify_type(#type{tag=Tag,def=Inner}=T) ->
+ case Inner of
+ #'ObjectClassFieldType'{type={fixedtypevaluefield,_,Type}} ->
+ Type#type{tag=Tag};
+ _ ->
+ T
+ end.
+
%% tablecinf_choose. A SEQUENCE or SET may be inserted in another
%% SEQUENCE or SET by the COMPONENTS OF directive. If this inserted
%% type is a referenced type that already has been checked it already
@@ -4003,26 +3765,10 @@ categorize(_S,type,Def) when is_record(Def,type) ->
categorize(_,_,Def) ->
[Def].
categorize(S,object_set,Def,ClassRef) ->
- %% XXXXXXXXXX
- case Def of
- {'Externaltypereference',undefined,'MSAccessProtocol','AllOperations'} ->
- ok;
- _ ->
- ok
- end,
NewObjSetSpec =
check_object(S,Def,#'ObjectSet'{class = ClassRef,
set = parse_objectset(Def)}),
Name = new_reference_name("object_set_argument"),
- %% XXXXXXXXXX
- case Name of
- internal_object_set_argument_78 ->
- ok;
- internal_object_set_argument_77 ->
- ok;
- _ ->
- ok
- end,
[save_object_set_instance(S,Name,NewObjSetSpec)];
categorize(_S,object,Def,_ClassRef) ->
%% should be handled
@@ -4048,9 +3794,7 @@ parse_objectset(Set) ->
%% check_constraints/2
%%
check_constraints(S,C) when is_list(C) ->
- check_constraints(S, C, []);
-check_constraints(S,C) when is_record(C,constraint) ->
- check_constraints(S, C#constraint.c, []).
+ check_constraints(S, C, []).
resolv_tuple_or_list(S,List) when is_list(List) ->
lists:map(fun(X)->resolv_value(S,X) end, List);
@@ -4077,23 +3821,19 @@ resolv_value1(S, ERef = #'Externalvaluereference'{value=Name}) ->
resolv_value1(S,VDef)
end
end;
-resolv_value1(S,{gt,V}) ->
- case V of
+resolv_value1(S, {gt,V}) ->
+ case resolv_value1(S, V) of
Int when is_integer(Int) ->
- V + 1;
- #valuedef{value=Int} ->
- 1 + resolv_value(S,Int);
+ Int + 1;
Other ->
- throw({error,{asn1,{undefined_type_or_value,Other}}})
+ throw({error,{asn1,{not_integer_value,Other}}})
end;
-resolv_value1(S,{lt,V}) ->
- case V of
+resolv_value1(S, {lt,V}) ->
+ case resolv_value1(S, V) of
Int when is_integer(Int) ->
- V - 1;
- #valuedef{value=Int} ->
- resolv_value(S,Int) - 1;
+ Int - 1;
Other ->
- throw({error,{asn1,{undefined_type_or_value,Other}}})
+ throw({error,{asn1,{not_integer_value,Other}}})
end;
resolv_value1(S,{'ValueFromObject',{object,Object},[{valuefieldreference,
FieldName}]}) ->
@@ -4356,7 +4096,42 @@ normalize_cs([{'ValueRange',{Sv,Sv}}|Cs]) ->
[{'SingleValue',Sv}|normalize_cs(Cs)];
normalize_cs([{'ValueRange',{'MIN','MAX'}}|Cs]) ->
normalize_cs(Cs);
-normalize_cs(Other) -> Other.
+normalize_cs([{'SizeConstraint',C0}|Cs]) ->
+ case normalize_size_constraint(C0) of
+ none ->
+ normalize_cs(Cs);
+ C ->
+ [{'SizeConstraint',C}|normalize_cs(Cs)]
+ end;
+normalize_cs([H|T]) ->
+ [H|normalize_cs(T)];
+normalize_cs([]) -> [].
+
+%% Normalize a size constraint to make it non-ambiguous and
+%% easy to interpret for the backends.
+%%
+%% Returns one of the following terms:
+%% {LowerBound,UpperBound}
+%% {{LowerBound,UpperBound},[]} % Extensible
+%% none % Remove size constraint from list
+%%
+%% where:
+%% LowerBound = integer()
+%% UpperBound = integer() | 'MAX'
+
+normalize_size_constraint(Sv) when is_integer(Sv) ->
+ {Sv,Sv};
+normalize_size_constraint({Root,Ext}) when is_list(Ext) ->
+ {normalize_size_constraint(Root),[]};
+normalize_size_constraint({{_,_},Ext}) when is_integer(Ext) ->
+ normalize_size_constraint(Ext);
+normalize_size_constraint([H|T]) ->
+ {H,lists:last(T)};
+normalize_size_constraint({0,'MAX'}) ->
+ none;
+normalize_size_constraint({Lb,Ub}=Range)
+ when is_integer(Lb), is_integer(Ub) orelse Ub =:= 'MAX' ->
+ Range.
is_range(Prev, [H|T]) when Prev =:= H - 1 -> is_range(H, T);
is_range(_, [_|_]) -> false;
@@ -4925,19 +4700,7 @@ get_referenced(S,Emod,Ename,Pos) ->
end;
T when is_record(T,typedef) ->
?dbg("get_referenced T: ~p~n",[T]),
- Spec = T#typedef.typespec, %% XXXX Spec may be something else than #type
- case Spec of
- #type{def=#typereference{}} ->
- Tref = Spec#type.def,
- Def = #'Externaltypereference'{module=Emod,
- type=Tref#typereference.val,
- pos=Tref#typereference.pos},
-
-
- {Emod,T#typedef{typespec=Spec#type{def=Def}}};
- _ ->
- {Emod,T} % should add check that T is exported here
- end;
+ {Emod,T}; % should add check that T is exported here
V ->
?dbg("get_referenced V: ~p~n",[V]),
{Emod,V}
@@ -5385,14 +5148,14 @@ iof_associated_type1(S,C) ->
prop=mandatory,
tags=[{'CONTEXT',0}]}],
#'SEQUENCE'{tablecinf=TableCInf,
- components=IOFComponents}.
+ components=simplify_comps(IOFComponents)}.
%% returns the leading attribute, the constraint of the components and
%% the tablecinf value for the second component.
instance_of_constraints(_,[]) ->
{false,[],[],[]};
-instance_of_constraints(S,#constraint{c={simpletable,Type}}) ->
+instance_of_constraints(S, [{simpletable,Type}]) ->
#type{def=#'Externaltypereference'{type=Name}} = Type,
ModuleName = S#state.mname,
ObjectSetRef=#'Externaltypereference'{module=ModuleName,
@@ -5403,7 +5166,8 @@ instance_of_constraints(S,#constraint{c={simpletable,Type}}) ->
[{innermost,
[#'Externalvaluereference'{module=ModuleName,
value=type}]}]}],
- TableCInf=#simpletableattributes{objectsetname=Name,
+ Mod = S#state.mname,
+ TableCInf=#simpletableattributes{objectsetname={Mod,Name},
c_name='type-id',
c_index=1,
usedclassfield=id,
@@ -5539,46 +5303,37 @@ check_sequence(S,Type,Comps) ->
%% the involved class removed, as the class of the object
%% set.
CompListWithTblInf = get_tableconstraint_info(S,Type,NewComps2),
- %% If encoding rule is in the PER family the Root Components
- %% after the second extension mark should be encoded before
- %% all extensions i.e together with the first Root components
NewComps3 = textual_order(CompListWithTblInf),
- CompListTuple =
- complist_as_tuple(is_erule_per(S#state.erule),NewComps3),
+ NewComps4 = simplify_comps(NewComps3),
+ CompListTuple = complist_as_tuple(NewComps4),
{CRelInf,CompListTuple};
Dupl ->
throw({error,{asn1,{duplicate_components,Dupl}}})
end.
-complist_as_tuple(Per,CompList) ->
- complist_as_tuple(Per,CompList,[],[],[],root).
+complist_as_tuple(CompList) ->
+ complist_as_tuple(CompList, [], [], [], root).
-complist_as_tuple(Per,[#'EXTENSIONMARK'{}|T],Acc,Ext,Acc2,root) ->
- complist_as_tuple(Per,T,Acc,Ext,Acc2,ext);
-complist_as_tuple(Per,[#'EXTENSIONMARK'{}|T],Acc,Ext,Acc2,ext) ->
- complist_as_tuple(Per,T,Acc,Ext,Acc2,root2);
-complist_as_tuple(_Per,[#'EXTENSIONMARK'{}|_T],_Acc,_Ext,_Acc2,root2) ->
+complist_as_tuple([#'EXTENSIONMARK'{}|T], Acc, Ext, Acc2, root) ->
+ complist_as_tuple(T, Acc, Ext, Acc2, ext);
+complist_as_tuple([#'EXTENSIONMARK'{}|T], Acc, Ext, Acc2, ext) ->
+ complist_as_tuple(T, Acc, Ext, Acc2, root2);
+complist_as_tuple([#'EXTENSIONMARK'{}|_T], _Acc, _Ext, _Acc2, root2) ->
throw({error,{asn1,{too_many_extension_marks}}});
-complist_as_tuple(Per,[C|T],Acc,Ext,Acc2,root) ->
- complist_as_tuple(Per,T,[C|Acc],Ext,Acc2,root);
-complist_as_tuple(Per,[C|T],Acc,Ext,Acc2,ext) ->
- complist_as_tuple(Per,T,Acc,[C|Ext],Acc2,ext);
-complist_as_tuple(Per,[C|T],Acc,Ext,Acc2,root2) ->
- complist_as_tuple(Per,T,Acc,Ext,[C|Acc2],root2);
-complist_as_tuple(_Per,[],Acc,_Ext,_Acc2,root) ->
+complist_as_tuple([C|T], Acc, Ext, Acc2, root) ->
+ complist_as_tuple(T, [C|Acc], Ext, Acc2, root);
+complist_as_tuple([C|T], Acc, Ext, Acc2, ext) ->
+ complist_as_tuple(T, Acc, [C|Ext], Acc2, ext);
+complist_as_tuple([C|T], Acc, Ext, Acc2, root2) ->
+ complist_as_tuple(T, Acc, Ext, [C|Acc2], root2);
+complist_as_tuple([], Acc, _Ext, _Acc2, root) ->
lists:reverse(Acc);
-complist_as_tuple(_Per,[],Acc,Ext,_Acc2,ext) ->
+complist_as_tuple([], Acc, Ext, _Acc2, ext) ->
{lists:reverse(Acc),lists:reverse(Ext)};
-%%complist_as_tuple(_Per = true,[],Acc,Ext,Acc2,root2) ->
-%% {lists:reverse(Acc)++lists:reverse(Acc2),lists:reverse(Ext)};
-complist_as_tuple(_Per,[],Acc,Ext,Acc2,root2) ->
+complist_as_tuple([], Acc, Ext, Acc2, root2) ->
{lists:reverse(Acc),lists:reverse(Ext),lists:reverse(Acc2)}.
-is_erule_per(per) -> true;
-is_erule_per(uper) -> true;
-is_erule_per(ber) -> false.
-
expand_components(S, [{'COMPONENTS OF',Type}|T]) ->
CompList = expand_components2(S,get_referenced_type(S,Type#type.def)),
expand_components(S,CompList) ++ expand_components(S,T);
@@ -5622,7 +5377,7 @@ take_only_rootset([H|T]) ->
[H|take_only_rootset(T)].
check_unique_sequence_tags(S,CompList) ->
- TagComps = case complist_as_tuple(false,CompList) of
+ TagComps = case complist_as_tuple(CompList) of
{R1,Ext,R2} ->
R1 ++ [C#'ComponentType'{prop='OPTIONAL'}||
C = #'ComponentType'{} <- Ext]++R2;
@@ -5657,7 +5412,7 @@ check_unique_sequence_tags1(S,[],Acc) ->
check_unique_tags(S,lists:reverse(Acc)).
check_sequenceof(S,Type,Component) when is_record(Component,type) ->
- check_type(S,Type,Component).
+ simplify_type(check_type(S, Type, Component)).
check_set(S,Type,Components) ->
{TableCInf,NewComponents} = check_sequence(S,Type,Components),
@@ -5879,7 +5634,7 @@ extension({Root1,ExtList,Root2}) ->
X = #'ComponentType'{prop=Y}<-ExtList], Root2}.
check_setof(S,Type,Component) when is_record(Component,type) ->
- check_type(S,Type,Component).
+ simplify_type(check_type(S, Type, Component)).
check_selectiontype(S,Name,#type{def=Eref})
when is_record(Eref,'Externaltypereference') ->
@@ -5943,8 +5698,9 @@ check_choice(S,Type,Components) when is_list(Components) ->
('ExtensionAdditionGroupEnd') -> false;
(_) -> true
end,NewComps),
- check_unique_tags(S,NewComps2),
- complist_as_tuple(is_erule_per(S#state.erule),NewComps2);
+ NewComps3 = simplify_comps(NewComps2),
+ check_unique_tags(S, NewComps3),
+ complist_as_tuple(NewComps3);
Dupl ->
throw({error,{asn1,{duplicate_choice_alternatives,Dupl}}})
end;
@@ -6322,7 +6078,7 @@ get_simple_table_info1(S,#'ComponentType'{typespec=TS},Cnames,Path) ->
simple_table_info(S,#'ObjectClassFieldType'{classname=ClRef,
class=ObjectClass,
fieldname=FieldName},Path) ->
-
+
ObjectClassFieldName =
case FieldName of
{LastFieldName,[]} -> LastFieldName;
@@ -6875,9 +6631,6 @@ get_OCFType(S,Fields,[PrimFieldName|Rest]) ->
get_taglist(S,Ext) when is_record(Ext,'Externaltypereference') ->
{_,T} = get_referenced_type(S,Ext),
get_taglist(S,T#typedef.typespec);
-get_taglist(S,Tref) when is_record(Tref,typereference) ->
- {_,T} = get_referenced_type(S,Tref),
- get_taglist(S,T#typedef.typespec);
get_taglist(S,Type) when is_record(Type,type) ->
case Type#type.tag of
[] ->
@@ -7047,60 +6800,27 @@ storeindb(S,M) when is_record(M,module) ->
NewM = M#module{typeorval=findtypes_and_values(TVlist)},
asn1_db:dbnew(NewM#module.name),
asn1_db:dbput(NewM#module.name,'MODULE', NewM),
- Res = storeindb(NewM#module.name,TVlist,[]),
+ Res = storeindb(#state{mname=NewM#module.name}, TVlist, []),
include_default_class(S,NewM#module.name),
include_default_type(NewM#module.name),
Res.
-storeindb(Module,[H|T],ErrAcc) when is_record(H,typedef) ->
- storeindb(Module,H#typedef.name,H,T,ErrAcc);
-storeindb(Module,[H|T],ErrAcc) when is_record(H,valuedef) ->
- storeindb(Module,H#valuedef.name,H,T,ErrAcc);
-storeindb(Module,[H|T],ErrAcc) when is_record(H,ptypedef) ->
- storeindb(Module,H#ptypedef.name,H,T,ErrAcc);
-storeindb(Module,[H|T],ErrAcc) when is_record(H,classdef) ->
- storeindb(Module,H#classdef.name,H,T,ErrAcc);
-storeindb(Module,[H|T],ErrAcc) when is_record(H,pvaluesetdef) ->
- storeindb(Module,H#pvaluesetdef.name,H,T,ErrAcc);
-storeindb(Module,[H|T],ErrAcc) when is_record(H,pobjectdef) ->
- storeindb(Module,H#pobjectdef.name,H,T,ErrAcc);
-storeindb(Module,[H|T],ErrAcc) when is_record(H,pvaluedef) ->
- storeindb(Module,H#pvaluedef.name,H,T,ErrAcc);
-storeindb(_,[],[]) -> ok;
-storeindb(_,[],ErrAcc) ->
- {error,ErrAcc}.
-
-storeindb(Module,Name,H,T,ErrAcc) ->
- case asn1_db:dbget(Module,Name) of
+storeindb(#state{mname=Module}=S, [H|T], Errors) ->
+ Name = asn1ct:get_name_of_def(H),
+ case asn1_db:dbget(Module, Name) of
undefined ->
- asn1_db:dbput(Module,Name,H),
- storeindb(Module,T,ErrAcc);
- _ ->
- case H of
- _Type when is_record(H,typedef) ->
- error({type,"already defined",
- #state{mname=Module,type=H,tname=Name}});
- _Type when is_record(H,valuedef) ->
- error({value,"already defined",
- #state{mname=Module,value=H,vname=Name}});
- _Type when is_record(H,ptypedef) ->
- error({ptype,"already defined",
- #state{mname=Module,type=H,tname=Name}});
- _Type when is_record(H,pobjectdef) ->
- error({ptype,"already defined",
- #state{mname=Module,type=H,tname=Name}});
- _Type when is_record(H,pvaluesetdef) ->
- error({ptype,"already defined",
- #state{mname=Module,type=H,tname=Name}});
- _Type when is_record(H,pvaluedef) ->
- error({ptype,"already defined",
- #state{mname=Module,type=H,tname=Name}});
- _Type when is_record(H,classdef) ->
- error({class,"already defined",
- #state{mname=Module,value=H,vname=Name}})
- end,
- storeindb(Module,T,[H|ErrAcc])
- end.
+ asn1_db:dbput(Module, Name, H),
+ storeindb(S, T, Errors);
+ Prev ->
+ PrevLine = asn1ct:get_pos_of_def(Prev),
+ {error,Error} = asn1_error(S, H, {already_defined,Name,PrevLine}),
+ storeindb(S, T, [Error|Errors])
+ end;
+storeindb(_, [], []) ->
+ ok;
+storeindb(_, [], [_|_]=Errors) ->
+ {error,Errors}.
+
findtypes_and_values(TVList) ->
findtypes_and_values(TVList,[],[],[],[],[],[]).%% Types,Values,
@@ -7140,8 +6860,20 @@ findtypes_and_values([],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) ->
{lists:reverse(Tacc),lists:reverse(Vacc),lists:reverse(Pacc),
lists:reverse(Cacc),lists:reverse(Oacc),lists:reverse(OSacc)}.
-
-
+asn1_error(#state{mname=Where}, Item, Error) ->
+ Pos = asn1ct:get_pos_of_def(Item),
+ {error,{structured_error,{Where,Pos},?MODULE,Error}}.
+
+format_error({already_defined,Name,PrevLine}) ->
+ io_lib:format("the name ~p has already been defined at line ~p",
+ [Name,PrevLine]);
+format_error({undefined,Name}) ->
+ io_lib:format("'~s' is referenced, but is not defined", [Name]);
+format_error(Other) ->
+ io_lib:format("~p", [Other]).
+
+error({_,{structured_error,_,_,_}=SE,_}) ->
+ SE;
error({export,Msg,#state{mname=Mname,type=Ref,tname=Typename}}) ->
Pos = Ref#'Externaltypereference'.pos,
io:format("asn1error:~p:~p:~p~n~p~n",[Pos,Mname,Typename,Msg]),
@@ -7444,3 +7176,13 @@ insert_once(S,Tab,Key) ->
_ ->
skipped
end.
+
+check_fold(S, [H|T], Check) ->
+ Type = asn1_db:dbget(S#state.mname, H),
+ case Check(S, H, Type) of
+ ok ->
+ check_fold(S, T, Check);
+ Error ->
+ [Error|check_fold(S, T, Check)]
+ end;
+check_fold(_, [], Check) when is_function(Check, 3) -> [].
diff --git a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl
index 341a04761b..761faa53c5 100644
--- a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl
+++ b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl
@@ -114,30 +114,16 @@ gen_encode_sequence(Erules,Typename,D) when is_record(D,type) ->
usedclassfield=UniqueFieldName,
uniqueclassfield=UniqueFieldName,
valueindex=ValueIndex} -> %% N is index of attribute that determines constraint
- OSDef =
- case ObjectSetRef of
- {Module,OSName} ->
- asn1_db:dbget(Module,OSName);
- OSName ->
- asn1_db:dbget(get(currmod),OSName)
- end,
-% io:format("currmod: ~p~nOSName: ~p~nAttrN: ~p~nN: ~p~nUniqueFieldName: ~p~n",
-% [get(currmod),OSName,AttrN,N,UniqueFieldName]),
+ {ObjSetMod,ObjSetName} = ObjectSetRef,
+ OSDef = asn1_db:dbget(ObjSetMod, ObjSetName),
case (OSDef#typedef.typespec)#'ObjectSet'.gen of
true ->
ObjectEncode =
asn1ct_gen:un_hyphen_var(lists:concat(['Obj',
AttrN])),
- {ObjSetMod,ObjSetName} =
- case ObjectSetRef of
- {M,O} ->
- {{asis,M},O};
- _ ->
- {"?MODULE",ObjectSetRef}
- end,
- emit([ObjectEncode," = ",nl]),
- emit([" ",ObjSetMod,":'getenc_",ObjSetName,"'(",{asis,UniqueFieldName},
- ", ",nl]),
+ emit([ObjectEncode," = ",nl,
+ " ",{asis,ObjSetMod},":'getenc_",ObjSetName,
+ "'(",{asis,UniqueFieldName},", ",nl]),
ValueMatch = value_match(ValueIndex,
lists:concat(["Cindex",N])),
emit([indent(35),ValueMatch,"),",nl]),
@@ -183,7 +169,6 @@ gen_encode_sequence(Erules,Typename,D) when is_record(D,type) ->
gen_decode_sequence(Erules,Typename,D) when is_record(D,type) ->
asn1ct_name:start(),
- asn1ct_name:clear(),
asn1ct_name:new(tag),
#'SEQUENCE'{tablecinf=TableConsInfo,components=CList0} = D#type.def,
@@ -258,15 +243,9 @@ gen_decode_sequence(Erules,Typename,D) when is_record(D,type) ->
{[{ObjSetRef,LeadingAttr,Term}],PostponedDecArgs} ->
DecObj = asn1ct_gen:un_hyphen_var(lists:concat(['DecObj',LeadingAttr,Term])),
ValueMatch = value_match(ValueIndex,Term),
- {ObjSetMod,ObjSetName} =
- case ObjSetRef of
- {M,O} ->
- {{asis,M},O};
- _ ->
- {"?MODULE",ObjSetRef}
- end,
+ {ObjSetMod,ObjSetName} = ObjSetRef,
emit([DecObj," =",nl,
- " ",ObjSetMod,":'getdec_",ObjSetName,"'(",
+ " ",{asis,ObjSetMod},":'getdec_",ObjSetName,"'(",
{asis,UniqueFName},", ",ValueMatch,"),",nl]),
gen_dec_postponed_decs(DecObj,PostponedDecArgs)
end,
@@ -349,7 +328,6 @@ gen_encode_set(Erules,Typename,D) when is_record(D,type) ->
gen_decode_set(Erules,Typename,D) when is_record(D,type) ->
asn1ct_name:start(),
- asn1ct_name:clear(),
%% asn1ct_name:new(term),
asn1ct_name:new(tag),
#'SET'{tablecinf=TableConsInfo,components=TCompList0} = D#type.def,
@@ -444,15 +422,9 @@ gen_decode_set(Erules,Typename,D) when is_record(D,type) ->
{[{ObjSetRef,LeadingAttr,Term}],PostponedDecArgs} ->
DecObj = asn1ct_gen:un_hyphen_var(lists:concat(['DecObj',LeadingAttr,Term])),
ValueMatch = value_match(ValueIndex,Term),
- {ObjSetMod,ObjSetName} =
- case ObjSetRef of
- {M,O} ->
- {{asis,M},O};
- _ ->
- {"?MODULE",ObjSetRef}
- end,
+ {ObjSetMod,ObjSetName} = ObjSetRef,
emit([DecObj," =",nl,
- " ",ObjSetMod,":'getdec_",ObjSetName,"'(",
+ " ",{asis,ObjSetMod},":'getdec_",ObjSetName,"'(",
{asis,UniqueFName},", ",ValueMatch,"),",nl]),
gen_dec_postponed_decs(DecObj,PostponedDecArgs)
end,
@@ -504,7 +476,6 @@ gen_encode_sof(Erules,Typename,_InnerTypename,D) when is_record(D,type) ->
gen_decode_sof(Erules,TypeName,_InnerTypeName,D) when is_record(D,type) ->
asn1ct_name:start(),
- asn1ct_name:clear(),
{SeqOrSetOf, _TypeTag, Cont} =
case D#type.def of
{'SET OF',_Cont} -> {'SET OF','SET',_Cont};
@@ -1002,9 +973,7 @@ gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,Assign,EncObj)
{componentrelation,_,_}} ->
{_LeadingAttrName,Fun} = EncObj,
case RefedFieldName of
-%% {notype,T} ->
-%% throw({error,{notype,type_from_object,T}});
- {Name,RestFieldNames} when is_atom(Name), Name =/= notype ->
+ {Name,RestFieldNames} when is_atom(Name) ->
case OptOrMand of
mandatory -> ok;
_ ->
@@ -1035,17 +1004,8 @@ gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,Assign,EncObj)
_ ->
case WhatKind of
{primitive,bif} ->
- EncType =
- case Type#type.def of
- #'ObjectClassFieldType'{type={fixedtypevaluefield,_,Btype}} ->
- Btype;
- _ ->
- Type
- end,
- ?ASN1CT_GEN_BER:gen_encode_prim(ber,EncType,{asis,Tag},
- Element);
-%% {notype,_} ->
-%% emit(["'enc_",InnerType,"'(",Element,", ",{asis,Tag},")"]);
+ ?ASN1CT_GEN_BER:gen_encode_prim(ber, Type, {asis,Tag},
+ Element);
'ASN1_OPEN_TYPE' ->
case Type#type.def of
#'ObjectClassFieldType'{} -> %Open Type
@@ -1266,15 +1226,9 @@ gen_dec_call(InnerType,Erules,TopType,Cname,Type,BytesVar,Tag,PrimOptOrMand,
{Cname,{_,OSet,UniqueFName,ValIndex}} ->
Term = asn1ct_gen:mk_var(asn1ct_name:curr(term)),
ValueMatch = value_match(ValIndex,Term),
- {ObjSetMod,ObjSetName} =
- case OSet of
- {M,O} ->
- {{asis,M},O};
- _ ->
- {"?MODULE",OSet}
- end,
- emit([",",nl,"ObjFun = ",ObjSetMod,":'getdec_",ObjSetName,"'(",
- {asis,UniqueFName},", ",ValueMatch,")"]);
+ {ObjSetMod,ObjSetName} = OSet,
+ emit([",",nl,"ObjFun = ",{asis,ObjSetMod},":'getdec_",ObjSetName,
+ "'(",{asis,UniqueFName},", ",ValueMatch,")"]);
_ ->
ok
end,
@@ -1288,9 +1242,6 @@ gen_dec_call1({primitive,bif},InnerType,Erules,TopType,Cname,Type,BytesVar,
asn1ct:update_gen_state(namelist,Rest),
emit(["{'",asn1ct_gen:list2name([Cname|TopType]),"',",
BytesVar,"}"]);
- {_,{fixedtypevaluefield,_,Btype}} ->
- ?ASN1CT_GEN_BER:gen_dec_prim(Erules,Btype,BytesVar,Tag,[],
- ?PRIMITIVE,OptOrMand);
_ ->
?ASN1CT_GEN_BER:gen_dec_prim(Erules,Type,BytesVar,Tag,[],
?PRIMITIVE,OptOrMand)
@@ -1458,9 +1409,7 @@ print_attribute_comment(InnerType,Pos,Cname,Prop) ->
CommentLine = "%%-------------------------------------------------",
emit([nl,CommentLine]),
case InnerType of
- {typereference,_,Name} ->
- emit([nl,"%% attribute ",Cname,"(",Pos,") with type ",Name]);
- {'Externaltypereference',_,XModule,Name} ->
+ #'Externaltypereference'{module=XModule,type=Name} ->
emit([nl,"%% attribute ",Cname,"(",Pos,") External ",XModule,":",Name]);
_ ->
emit([nl,"%% attribute ",Cname,"(",Pos,") with type ",InnerType])
diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl
index aa5ee18c80..efb55cf015 100644
--- a/lib/asn1/src/asn1ct_constructed_per.erl
+++ b/lib/asn1/src/asn1ct_constructed_per.erl
@@ -143,40 +143,21 @@ gen_encode_constructed(Erule,Typename,D) when is_record(D,type) ->
uniqueclassfield=UniqueFieldName,
valueindex=ValueIndex
} -> %% N is index of attribute that determines constraint
- {{ObjSetMod,ObjSetName},OSDef} =
- case ObjectSet of
- {Module,OSName} ->
- {{{asis,Module},OSName},asn1_db:dbget(Module,OSName)};
- OSName ->
- {{"?MODULE",OSName},asn1_db:dbget(get(currmod),OSName)}
- end,
- case (OSDef#typedef.typespec)#'ObjectSet'.gen of
+ {Module,ObjSetName} = ObjectSet,
+ #typedef{typespec=#'ObjectSet'{gen=Gen}} =
+ asn1_db:dbget(Module, ObjSetName),
+ case Gen of
true ->
ObjectEncode =
asn1ct_gen:un_hyphen_var(lists:concat(['Obj',AttrN])),
- emit([ObjectEncode," = ",nl]),
- emit([" ",ObjSetMod,":'getenc_",ObjSetName,"'(",
- {asis,UniqueFieldName},", ",nl]),
- El = make_element(N+1,asn1ct_gen:mk_var(asn1ct_name:curr(val))),
-
- Length = fun(X,_LFun) when is_atom(X) ->
- length(atom_to_list(X));
- (X,_LFun) when is_list(X) ->
- length(X);
- ({X1,X2},LFun) ->
- LFun(X1,LFun) + LFun(X2,LFun)
- end,
- Indent = 12 + Length(ObjectSet,Length),
- case ValueIndex of
- [] ->
- emit([indent(Indent),El,"),",nl]);
- _ ->
- emit([indent(Indent),"value_match(",
- {asis,ValueIndex},",",El,")),",nl]),
- notice_value_match()
- end,
+ El = make_element(N+1, asn1ct_gen:mk_var(asn1ct_name:curr(val))),
+ ValueMatch = value_match(ValueIndex, El),
+ emit([ObjectEncode," =",nl,
+ " ",{asis,Module},":'getenc_",ObjSetName,"'(",
+ {asis,UniqueFieldName},", ",nl,
+ " ",ValueMatch,"),",nl]),
{AttrN,ObjectEncode};
- _ ->
+ false ->
false
end;
_ ->
@@ -227,7 +208,6 @@ gen_decode_constructed(Erule, Typename, #type{}=D) ->
Imm0 = gen_dec_constructed_imm(Erule, Typename, #type{}=D),
Imm = opt_imm(Imm0),
asn1ct_name:start(),
- asn1ct_name:clear(),
emit_gen_dec_imm(Imm),
emit([".",nl,nl]).
@@ -365,14 +345,10 @@ gen_dec_constructed_imm_2(Typename, CompList,
{[{ObjSet,LeadingAttr,Term}],ListOfOpenTypes} ->
DecObj = asn1ct_gen:un_hyphen_var(lists:concat(['DecObj',LeadingAttr,Term])),
ValueMatch = value_match(ValueIndex,Term),
- {ObjSetMod,ObjSetName} =
- case ObjSet of
- {M,O} -> {{asis,M},O};
- _ -> {"?MODULE",ObjSet}
- end,
- emit({DecObj," =",nl," ",ObjSetMod,":'getdec_",ObjSetName,"'(",
-% {asis,UniqueFName},", ",Term,"),",nl}),
- {asis,UniqueFName},", ",ValueMatch,"),",nl}),
+ {ObjSetMod,ObjSetName} = ObjSet,
+ emit([DecObj," =",nl,
+ " ",{asis,ObjSetMod},":'getdec_",ObjSetName,"'(",
+ {asis,UniqueFName},", ",ValueMatch,"),",nl]),
gen_dec_listofopentypes(DecObj,ListOfOpenTypes,false)
end,
%% we don't return named lists any more Cnames = mkcnamelist(CompList),
@@ -489,7 +465,6 @@ gen_encode_choice(Erule,Typename,D) when is_record(D,type) ->
gen_decode_choice(Erules,Typename,D) when is_record(D,type) ->
asn1ct_name:start(),
- asn1ct_name:clear(),
asn1ct_name:new(bytes),
{'CHOICE',CompList} = D#type.def,
Ext = extensible_enc(CompList),
@@ -504,12 +479,8 @@ gen_encode_sof(Erule,Typename,SeqOrSetOf,D) when is_record(D,type) ->
asn1ct_name:start(),
{_SeqOrSetOf,ComponentType} = D#type.def,
emit({"[",nl}),
- SizeConstraint =
- case asn1ct_gen:get_constraint(D#type.constraint,
- 'SizeConstraint') of
- no -> undefined;
- Range -> Range
- end,
+ SizeConstraint = asn1ct_imm:effective_constraint(bitstring,
+ D#type.constraint),
ObjFun =
case D#type.tablecinf of
[{objfun,_}|_R] ->
@@ -521,13 +492,7 @@ gen_encode_sof(Erule,Typename,SeqOrSetOf,D) when is_record(D,type) ->
emit({indent(3),"'enc_",asn1ct_gen:list2name(Typename),
"_components'(Val",ObjFun,", [])"}),
emit({nl,"].",nl}),
- NewComponentType =
- case ComponentType#type.def of
- {'ENUMERATED',_,Component}->
- ComponentType#type{def={'ENUMERATED',Component}};
- _ -> ComponentType
- end,
- gen_encode_sof_components(Erule,Typename,SeqOrSetOf,NewComponentType).
+ gen_encode_sof_components(Erule, Typename, SeqOrSetOf, ComponentType).
%% Logic copied from asn1_per_bin_rt2ct:encode_constrained_number
@@ -565,7 +530,7 @@ gen_encode_length(per, {Lb,Ub}) when Ub =< 65535, Lb >= 0 ->
gen_encode_length(Erules, SizeConstraint) ->
emit([nl,indent(3),
case SizeConstraint of
- undefined ->
+ no ->
{call,Erules,encode_length,["length(Val)"]};
_ ->
{call,Erules,encode_length,
@@ -576,12 +541,8 @@ gen_encode_length(Erules, SizeConstraint) ->
gen_decode_sof(Erules,Typename,SeqOrSetOf,D) when is_record(D,type) ->
asn1ct_name:start(),
{_SeqOrSetOf,ComponentType} = D#type.def,
- SizeConstraint =
- case asn1ct_gen:get_constraint(D#type.constraint,
- 'SizeConstraint') of
- no -> undefined;
- Range -> Range
- end,
+ SizeConstraint = asn1ct_imm:effective_constraint(bitstring,
+ D#type.constraint),
ObjFun =
case D#type.tablecinf of
[{objfun,_}|_R] ->
@@ -593,13 +554,7 @@ gen_decode_sof(Erules,Typename,SeqOrSetOf,D) when is_record(D,type) ->
emit([",",nl,
"'dec_",asn1ct_gen:list2name(Typename),
"_components'(",Num,", ",Buf,ObjFun,", []).",nl,nl]),
- NewComponentType =
- case ComponentType#type.def of
- {'ENUMERATED',_,Component}->
- ComponentType#type{def={'ENUMERATED',Component}};
- _ -> ComponentType
- end,
- gen_decode_sof_components(Erules,Typename,SeqOrSetOf,NewComponentType).
+ gen_decode_sof_components(Erules, Typename, SeqOrSetOf, ComponentType).
is_aligned(per) -> true;
is_aligned(uper) -> false.
@@ -629,10 +584,9 @@ gen_encode_sof_components(Erule,Typename,SeqOrSetOf,Cont) ->
Conttype = asn1ct_gen:get_inner(Cont#type.def),
Currmod = get(currmod),
- Ctgenmod = asn1ct_gen:ct_gen_module(Erule),
case asn1ct_gen:type(Conttype) of
{primitive,bif} ->
- gen_encode_prim_wrapper(Ctgenmod,Erule,Cont,false,"H");
+ asn1ct_gen_per:gen_encode_prim(Erule, Cont, "H");
{constructed,bif} ->
NewTypename = [Constructed_Suffix|Typename],
emit({"'enc_",asn1ct_gen:list2name(NewTypename),"'(H",
@@ -642,9 +596,9 @@ gen_encode_sof_components(Erule,Typename,SeqOrSetOf,Cont) ->
#'Externaltypereference'{module=EMod,type=EType} ->
emit({"'",EMod,"':'enc_",EType,"'(H)",nl,nl});
'ASN1_OPEN_TYPE' ->
- gen_encode_prim_wrapper(Ctgenmod,Erule,
- #type{def='ASN1_OPEN_TYPE'},
- false,"H");
+ asn1ct_gen_per:gen_encode_prim(Erule,
+ #type{def='ASN1_OPEN_TYPE'},
+ "H");
_ ->
emit({"'enc_",Conttype,"'(H)",nl,nl})
end,
@@ -668,7 +622,6 @@ gen_decode_sof_components(Erule,Typename,SeqOrSetOf,Cont) ->
Cont#type.def),
Conttype = asn1ct_gen:get_inner(Cont#type.def),
Ctgenmod = asn1ct_gen:ct_gen_module(Erule),
- CurrMod = get(currmod),
case asn1ct_gen:type(Conttype) of
{primitive,bif} ->
Ctgenmod:gen_dec_prim(Erule,Cont,"Bytes"),
@@ -677,12 +630,9 @@ gen_decode_sof_components(Erule,Typename,SeqOrSetOf,Cont) ->
NewTypename = [Constructed_Suffix|Typename],
emit({"'dec_",asn1ct_gen:list2name(NewTypename),
"'(Bytes, telltype",ObjFun,"),",nl});
- #typereference{val=Dname} ->
- emit({"'dec_",Dname,"'(Bytes,telltype),",nl});
- #'Externaltypereference'{module=CurrMod,type=EType} ->
- emit({"'dec_",EType,"'(Bytes,telltype),",nl});
- #'Externaltypereference'{module=EMod,type=EType} ->
- emit({"'",EMod,"':'dec_",EType,"'(Bytes,telltype),",nl});
+ #'Externaltypereference'{}=Etype ->
+ asn1ct_gen_per:gen_dec_external(Etype, "Bytes"),
+ emit([com,nl]);
'ASN1_OPEN_TYPE' ->
Ctgenmod:gen_dec_prim(Erule,#type{def='ASN1_OPEN_TYPE'},
"Bytes"),
@@ -1004,7 +954,6 @@ gen_enc_line(Erule,TopType, Cname, Type, [], Pos,DynamicEnc,Ext) ->
Element = make_element(Pos+1,asn1ct_gen:mk_var(asn1ct_name:curr(val))),
gen_enc_line(Erule,TopType,Cname,Type,Element, Pos,DynamicEnc,Ext);
gen_enc_line(Erule,TopType,Cname,Type,Element, _Pos,DynamicEnc,Ext) ->
- Ctgenmod = asn1ct_gen:ct_gen_module(Erule),
Atype =
case Type of
#type{def=#'ObjectClassFieldType'{type=InnerType}} ->
@@ -1026,8 +975,6 @@ gen_enc_line(Erule,TopType,Cname,Type,Element, _Pos,DynamicEnc,Ext) ->
case DynamicEnc of
{_LeadingAttrName,Fun} ->
case (Type#type.def)#'ObjectClassFieldType'.fieldname of
- {notype,T} ->
- throw({error,{notype,type_from_object,T}});
{Name,RestFieldNames} when is_atom(Name) ->
asn1ct_func:need({Erule,complete,1}),
asn1ct_func:need({Erule,encode_open_type,1}),
@@ -1057,29 +1004,17 @@ gen_enc_line(Erule,TopType,Cname,Type,Element, _Pos,DynamicEnc,Ext) ->
#'Externaltypereference'{module=Mod,type=EType} ->
emit({"'",Mod,"':'enc_",
EType,"'(",Element,")"});
- #typereference{val=Ename} ->
- emit({"'enc_",Ename,"'(",Element,")"});
- {notype,_} ->
- emit({"'enc_",Atype,"'(",Element,")"});
{primitive,bif} ->
- EncType =
- case Atype of
- {fixedtypevaluefield,_,Btype} ->
- Btype;
- _ ->
- Type
- end,
- gen_encode_prim_wrapper(Ctgenmod,Erule,EncType,
- false,Element);
+ asn1ct_gen_per:gen_encode_prim(Erule, Type, Element);
'ASN1_OPEN_TYPE' ->
case Type#type.def of
#'ObjectClassFieldType'{type=OpenType} ->
- gen_encode_prim_wrapper(Ctgenmod,Erule,
- #type{def=OpenType},
- false,Element);
+ asn1ct_gen_per:gen_encode_prim(Erule,
+ #type{def=OpenType},
+ Element);
_ ->
- gen_encode_prim_wrapper(Ctgenmod,Erule,Type,
- false,Element)
+ asn1ct_gen_per:gen_encode_prim(Erule, Type,
+ Element)
end;
{constructed,bif} ->
NewTypename = [Cname|TopType],
@@ -1235,68 +1170,67 @@ gen_dec_comp_call(Comp, Erule, TopType, Tpos, OptTable, DecInfObj,
end
end
end,
-
- OptOrDef =
- case {Ext,Prop} of
- {noext,mandatory} ->
- ignore;
- {noext,_} -> %% OPTIONAL or DEFAULT
- OptPos = get_optionality_pos(TextPos, OptTable),
- Element = io_lib:format("Opt band (1 bsl ~w)",
- [NumberOfOptionals - OptPos]),
- fun(St) ->
- emit(["case ",Element," of",nl]),
- emit([" _Opt",TextPos," when _Opt",TextPos," > 0 ->"]),
- St
- end;
- {{ext,_,_},_} -> %Extension
- fun(St) ->
- emit(["case Extensions of",nl,
- " <<_:",Pos-1,",1:1,_/bitstring>> ->",nl]),
- St
- end
- end,
- Lines = gen_dec_line_imm(Erule, TopType, Comp, Tpos, DecInfObj, Ext),
- Postamble =
- case {Ext,Prop} of
- {noext,mandatory} ->
- ignore;
- {noext,_} ->
- fun(St) ->
- emit([";",nl,"0 ->"]),
- emit(["{"]),
- gen_dec_component_no_val(Ext,Prop),
- emit({",",{curr,bytes},"}",nl}),
- emit([nl,"end"]),
- St
- end;
- _ ->
- fun(St) ->
- emit([";",nl,"_ ->",nl]),
- emit(["{"]),
- case Type of
- #type{def=#'SEQUENCE'{
- extaddgroup=Number2,
- components=ExtGroupCompList2}}
- when is_integer(Number2)->
- emit({"{extAddGroup,"}),
- gen_dec_extaddGroup_no_val(Ext,ExtGroupCompList2),
- emit({"}"});
- _ ->
- gen_dec_component_no_val(Ext, Prop)
- end,
- emit({",",{curr,bytes},"}",nl}),
- emit([nl,"end"]),
- St
- end
- end,
+ {Pre,Post} = comp_call_pre_post(Ext, Prop, Pos, Type, TextPos,
+ OptTable, NumberOfOptionals, Ext),
+ Lines = gen_dec_seq_line_imm(Erule, TopType, Comp, Tpos, DecInfObj, Ext),
AdvBuffer = {ignore,fun(St) ->
asn1ct_name:new(bytes),
St
end},
- [{group,[{safe,Comment},{safe,Preamble},
- OptOrDef|Lines]++
- [Postamble,{safe,AdvBuffer}]}].
+ [{group,[{safe,Comment},{safe,Preamble}] ++ Pre ++
+ Lines ++ Post ++ [{safe,AdvBuffer}]}].
+
+comp_call_pre_post(noext, mandatory, _, _, _, _, _, _) ->
+ {[],[]};
+comp_call_pre_post(noext, Prop, _, _, TextPos, OptTable, NumOptionals, Ext) ->
+ %% OPTIONAL or DEFAULT
+ OptPos = get_optionality_pos(TextPos, OptTable),
+ Element = case NumOptionals - OptPos of
+ 0 ->
+ "Opt band 1";
+ Shift ->
+ lists:concat(["(Opt bsr ",Shift,") band 1"])
+ end,
+ {[fun(St) ->
+ emit(["case ",Element," of",nl,
+ "1 ->",nl]),
+ St
+ end],
+ [fun(St) ->
+ emit([";",nl,
+ "0 ->",nl,
+ "{"]),
+ gen_dec_component_no_val(Ext, Prop),
+ emit([",",{curr,bytes},"}",nl,
+ "end"]),
+ St
+ end]};
+comp_call_pre_post({ext,_,_}, Prop, Pos, Type, _, _, _, Ext) ->
+ %% Extension
+ {[fun(St) ->
+ emit(["case Extensions of",nl,
+ " <<_:",Pos-1,",1:1,_/bitstring>> ->",nl]),
+ St
+ end],
+ [fun(St) ->
+ emit([";",nl,
+ "_ ->",nl,
+ "{"]),
+ case Type of
+ #type{def=#'SEQUENCE'{
+ extaddgroup=Number2,
+ components=ExtGroupCompList2}}
+ when is_integer(Number2)->
+ emit("{extAddGroup,"),
+ gen_dec_extaddGroup_no_val(Ext, ExtGroupCompList2),
+ emit("}");
+ _ ->
+ gen_dec_component_no_val(Ext, Prop)
+ end,
+ emit([",",{curr,bytes},"}",nl,
+ "end"]),
+ St
+ end]}.
is_mandatory_predef_tab_c(noext, mandatory,
{"got objfun through args","ObjFun"}) ->
@@ -1324,13 +1258,17 @@ gen_dec_component_no_val({ext,_,_},mandatory) ->
emit({"asn1_NOVALUE"}).
-gen_dec_line(Erule, TopType, Comp, Pos, DecInfObj, Ext) ->
- Imm0 = gen_dec_line_imm(Erule, TopType, Comp, Pos, DecInfObj, Ext),
+gen_dec_choice_line(Erule, TopType, Comp, Pre) ->
+ Imm0 = gen_dec_line_imm(Erule, TopType, Comp, false, Pre),
Init = {ignore,fun(_) -> {[],[]} end},
Imm = [{group,[Init|Imm0]}],
emit_gen_dec_imm(Imm).
-gen_dec_line_imm(Erule, TopType, Comp, Pos, DecInfObj, Ext) ->
+gen_dec_seq_line_imm(Erule, TopType, Comp, Pos, DecInfObj, Ext) ->
+ Pre = gen_dec_line_open_type(Erule, Ext, Pos),
+ gen_dec_line_imm(Erule, TopType, Comp, DecInfObj, Pre).
+
+gen_dec_line_imm(Erule, TopType, Comp, DecInfObj, Pre) ->
#'ComponentType'{name=Cname,typespec=Type} = Comp,
Atype =
case Type of
@@ -1339,9 +1277,7 @@ gen_dec_line_imm(Erule, TopType, Comp, Pos, DecInfObj, Ext) ->
_ ->
asn1ct_gen:get_inner(Type#type.def)
end,
-
- Pre = gen_dec_line_open_type(Erule, Ext, Pos),
- Decode = gen_dec_line_special(Erule, Atype, TopType, Comp, DecInfObj, Ext),
+ Decode = gen_dec_line_special(Erule, Atype, TopType, Comp, DecInfObj),
Post =
fun({SaveBytes,Finish}) ->
{AccTerm,AccBytes} = Finish(),
@@ -1385,7 +1321,7 @@ gen_dec_line_open_type(_, _, _) ->
end}.
gen_dec_line_special(Erule, {typefield,_}, _TopType, Comp,
- DecInfObj, Ext) ->
+ DecInfObj) ->
#'ComponentType'{name=Cname,typespec=Type,prop=Prop} = Comp,
fun({_BytesVar,PrevSt}) ->
case DecInfObj of
@@ -1417,7 +1353,7 @@ gen_dec_line_special(Erule, {typefield,_}, _TopType, Comp,
%% objfun though arguments on function
%% invocation.
if
- Ext == noext andalso Prop == mandatory ->
+ Prop =:= mandatory ->
ok;
true ->
asn1ct_name:new(tmpterm),
@@ -1431,7 +1367,7 @@ gen_dec_line_special(Erule, {typefield,_}, _TopType, Comp,
asn1ct_imm:dec_code_gen(Imm, BytesVar),
emit([com,nl]),
if
- Ext == noext andalso Prop == mandatory ->
+ Prop =:= mandatory ->
emit([{curr,term}," =",nl," "]);
true ->
emit([" {"])
@@ -1448,7 +1384,7 @@ gen_dec_line_special(Erule, {typefield,_}, _TopType, Comp,
emit([indent(6),{curr,tmpterm},nl]),
emit([indent(2),"end"]),
if
- Ext == noext andalso Prop == mandatory ->
+ Prop =:= mandatory ->
ok;
true ->
emit([",",nl,{curr,tmpbytes},"}"])
@@ -1468,7 +1404,7 @@ gen_dec_line_special(Erule, {typefield,_}, _TopType, Comp,
end
end;
gen_dec_line_special(Erule, {objectfield,PrimFieldName1,PFNList}, _TopType,
- Comp, _DecInfObj, _Ext) ->
+ Comp, _DecInfObj) ->
fun({_BytesVar,PrevSt}) ->
Imm = asn1ct_imm:per_dec_open_type(is_aligned(Erule)),
BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)),
@@ -1480,7 +1416,7 @@ gen_dec_line_special(Erule, {objectfield,PrimFieldName1,PFNList}, _TopType,
Prop}],
{SaveBytes,PrevSt}
end;
-gen_dec_line_special(Erule, Atype, TopType, Comp, DecInfObj, _Ext) ->
+gen_dec_line_special(Erule, Atype, TopType, Comp, DecInfObj) ->
case gen_dec_line_other(Erule, Atype, TopType, Comp) of
Fun when is_function(Fun, 1) ->
fun({BytesVar,PrevSt}) ->
@@ -1503,38 +1439,24 @@ gen_dec_line_dec_inf(Comp, DecInfObj) ->
{Cname,{_,OSet,UniqueFName,ValIndex}} ->
Term = asn1ct_gen:mk_var(asn1ct_name:curr(term)),
ValueMatch = value_match(ValIndex,Term),
- {ObjSetMod,ObjSetName} =
- case OSet of
- {M,O} -> {{asis,M},O};
- _ -> {"?MODULE",OSet}
- end,
- emit({",",nl,"ObjFun = ",ObjSetMod,
+ {ObjSetMod,ObjSetName} = OSet,
+ emit([",",nl,
+ "ObjFun = ",{asis,ObjSetMod},
":'getdec_",ObjSetName,"'(",
- {asis,UniqueFName},", ",ValueMatch,")"});
+ {asis,UniqueFName},", ",ValueMatch,")"]);
_ ->
ok
end.
gen_dec_line_other(Erule, Atype, TopType, Comp) ->
#'ComponentType'{name=Cname,typespec=Type} = Comp,
- CurrMod = get(currmod),
case asn1ct_gen:type(Atype) of
- #'Externaltypereference'{module=CurrMod,type=EType} ->
+ #'Externaltypereference'{}=Etype ->
fun(BytesVar) ->
- emit({"'dec_",EType,"'(",BytesVar,",telltype)"})
- end;
- #'Externaltypereference'{module=Mod,type=EType} ->
- fun(BytesVar) ->
- emit({"'",Mod,"':'dec_",EType,"'(",BytesVar,
- ",telltype)"})
+ asn1ct_gen_per:gen_dec_external(Etype, BytesVar)
end;
{primitive,bif} ->
- case Atype of
- {fixedtypevaluefield,_,Btype} ->
- asn1ct_gen_per:gen_dec_imm(Erule, Btype);
- _ ->
- asn1ct_gen_per:gen_dec_imm(Erule, Type)
- end;
+ asn1ct_gen_per:gen_dec_imm(Erule, Type);
'ASN1_OPEN_TYPE' ->
case Type#type.def of
#'ObjectClassFieldType'{type=OpenType} ->
@@ -1542,14 +1464,6 @@ gen_dec_line_other(Erule, Atype, TopType, Comp) ->
_ ->
asn1ct_gen_per:gen_dec_imm(Erule, Type)
end;
- #typereference{val=Dname} ->
- fun(BytesVar) ->
- emit({"'dec_",Dname,"'(",BytesVar,",telltype)"})
- end;
- {notype,_} ->
- fun(BytesVar) ->
- emit({"'dec_",Atype,"'(",BytesVar,",telltype)"})
- end;
{constructed,bif} ->
NewTypename = [Cname|TopType],
case Type#type.tablecinf of
@@ -1605,16 +1519,14 @@ get_name_list([], Acc) ->
gen_enc_choice2(Erule,TopType, {L1,L2}, Ext) ->
- gen_enc_choice2(Erule,TopType, L1 ++ L2, 0, Ext);
-gen_enc_choice2(Erule,TopType, {L1,L2,L3}, Ext) ->
- gen_enc_choice2(Erule,TopType, L1 ++ L3 ++ L2, 0, Ext);
+ gen_enc_choice2(Erule, TopType, L1 ++ L2, 0, [], Ext);
+gen_enc_choice2(Erule, TopType, {L1,L2,L3}, Ext) ->
+ gen_enc_choice2(Erule, TopType, L1 ++ L3 ++ L2, 0, [], Ext);
gen_enc_choice2(Erule,TopType, L, Ext) ->
- gen_enc_choice2(Erule,TopType, L, 0, Ext).
+ gen_enc_choice2(Erule,TopType, L, 0, [], Ext).
-gen_enc_choice2(Erule,TopType,[H1,H2|T], Pos, Ext)
-when is_record(H1,'ComponentType'), is_record(H2,'ComponentType') ->
- Cname = H1#'ComponentType'.name,
- Type = H1#'ComponentType'.typespec,
+gen_enc_choice2(Erule, TopType, [H|T], Pos, Sep0, Ext) ->
+ #'ComponentType'{name=Cname,typespec=Type} = H,
EncObj =
case asn1ct_gen:get_constraint(Type#type.constraint,
componentrelation) of
@@ -1622,130 +1534,157 @@ when is_record(H1,'ComponentType'), is_record(H2,'ComponentType') ->
case Type#type.tablecinf of
[{objfun,_}|_] ->
{"got objfun through args","ObjFun"};
- _ ->false
- end;
- _ -> {no_attr,"ObjFun"}
- end,
- emit({{asis,Cname}," ->",nl}),
- DoExt = case Ext of
- {ext,ExtPos,_} when (Pos + 1) < ExtPos -> noext;
- _ -> Ext
- end,
- gen_enc_line(Erule,TopType,Cname,Type,"element(2,Val)",
- Pos+1,EncObj,DoExt),
- emit({";",nl}),
- gen_enc_choice2(Erule,TopType,[H2|T], Pos+1, Ext);
-gen_enc_choice2(Erule,TopType,[H1|T], Pos, Ext)
- when is_record(H1,'ComponentType') ->
- Cname = H1#'ComponentType'.name,
- Type = H1#'ComponentType'.typespec,
- EncObj =
- case asn1ct_gen:get_constraint(Type#type.constraint,
- componentrelation) of
- no ->
- case Type#type.tablecinf of
- [{objfun,_}|_] ->
- {"got objfun through args","ObjFun"};
- _ ->false
+ _ ->
+ false
end;
- _ -> {no_attr,"ObjFun"}
+ _ ->
+ {no_attr,"ObjFun"}
end,
- emit({{asis,H1#'ComponentType'.name}," ->",nl}),
+ emit([Sep0,{asis,Cname}," ->",nl]),
DoExt = case Ext of
- {ext,ExtPos,_} when (Pos + 1) < ExtPos -> noext;
+ {ext,ExtPos,_} when Pos + 1 < ExtPos -> noext;
_ -> Ext
end,
- gen_enc_line(Erule,TopType,Cname,Type,"element(2,Val)",
- Pos+1,EncObj,DoExt),
- gen_enc_choice2(Erule,TopType,T, Pos+1, Ext);
-gen_enc_choice2(_Erule,_,[], _, _) ->
- true.
+ gen_enc_line(Erule, TopType, Cname, Type, "element(2, Val)",
+ Pos+1, EncObj, DoExt),
+ Sep = [";",nl],
+ gen_enc_choice2(Erule, TopType, T, Pos+1, Sep, Ext);
+gen_enc_choice2(_, _, [], _, _, _) -> ok.
+
+%% Generate the code for CHOICE. If the CHOICE is extensible,
+%% the structure of the generated code is as follows:
+%%
+%% case Bytes of
+%% <<0:1,Bytes1/bitstring>> ->
+%% Choice = <Decode INTEGER (0..LastRootChoice) from Bytes1>
+%% case Choice of
+%% 0 -> <Decode>;
+%% :
+%% LastRootChoice -> <Decode>
+%% end;
+%% <<1:1,Bytes1/bitstring>> ->
+%% Choice = <Decode normally small number from Bytes1>
+%% TmpVal = <Decode open type>
+%% case Choice of
+%% 0 -> <Decode TmpVal>;
+%% :
+%% LastExtension -> <Decode TmpVal>;
+%% _ -> <Return TmpVal since the type is unknown>
+%% end
+%% end
+%%
+%% The return value from the generated function always looks like:
+%% {{ChoiceTag,Value},RemainingBuffer}
+%% where ChoiceTag will be 'asn1_ExtAlt' for an unknown extension.
+%%
+%% If the CHOICE is not extensible, the top-level case is omitted
+%% and only the code in the first case arm is generated.
-gen_dec_choice(Erule,TopType,CompList,{ext,Pos,NumExt}) ->
- emit(["{Ext,",{curr,bytes},"} = ",
- {call,Erule,getbit,["Bytes"]},com,nl]),
+gen_dec_choice(Erule, TopType, CompList, {ext,_,_}=Ext) ->
+ {RootList,ExtList} = split_complist(CompList),
+ emit(["case Bytes of",nl]),
+ case RootList of
+ [] ->
+ ok;
+ [_|_] ->
+ emit(["<<0:1,Bytes1/bitstring>> ->",nl]),
+ asn1ct_name:new(bytes),
+ gen_dec_choice1(Erule, TopType, RootList, noext),
+ emit([";",nl,nl])
+ end,
+ emit(["<<1:1,Bytes1/bitstring>> ->",nl]),
+ asn1ct_name:clear(),
+ asn1ct_name:new(bytes),
asn1ct_name:new(bytes),
- gen_dec_choice1(Erule,TopType,CompList,{ext,Pos,NumExt});
-gen_dec_choice(Erule,TopType,CompList,noext) ->
- gen_dec_choice1(Erule,TopType,CompList,noext).
-
-gen_dec_choice1(Erule,TopType,CompList,noext) ->
- emit(["{Choice,",{curr,bytes},
- "} = ",{call,Erule,getchoice,
- [{prev,bytes},length(CompList),"0"]},com,nl,
- "{Cname,{Val,NewBytes}} = case Choice of",nl]),
- gen_dec_choice2(Erule,TopType,CompList,noext),
- emit({nl,"end,",nl}),
- emit({nl,"{{Cname,Val},NewBytes}"});
-gen_dec_choice1(Erule,TopType,{RootList,ExtList},Ext) ->
- NewList = RootList ++ ExtList,
- gen_dec_choice1(Erule,TopType, NewList, Ext);
-gen_dec_choice1(Erule,TopType,{RootList,ExtList,RootList2},Ext) ->
- NewList = RootList ++ RootList2 ++ ExtList,
- gen_dec_choice1(Erule,TopType, NewList, Ext);
-gen_dec_choice1(Erule,TopType,CompList,{ext,ExtPos,ExtNum}) ->
- emit(["{Choice,",{curr,bytes},"} = ",
- {call,Erule,getchoice,
- [{prev,bytes},length(CompList)-ExtNum,"Ext"]},com,nl]),
- emit({"{Cname,{Val,NewBytes}} = case Choice + Ext*",ExtPos-1," of",nl}),
- gen_dec_choice2(Erule,TopType,CompList,{ext,ExtPos,ExtNum}),
+ gen_dec_choice1(Erule, TopType, ExtList, Ext),
+ emit([nl,"end"]);
+gen_dec_choice(Erule, TopType, CompList, noext) ->
+ gen_dec_choice1(Erule, TopType, CompList, noext).
+
+split_complist({Root1,Ext,Root2}) ->
+ {Root1++Root2,Ext};
+split_complist({_,_}=CompList) ->
+ CompList.
+
+gen_dec_choice1(Erule, TopType, CompList, noext=Ext) ->
+ emit_getchoice(Erule, CompList, Ext),
+ emit(["case Choice of",nl]),
+ Pre = {safe,fun(St) ->
+ {asn1ct_gen:mk_var(asn1ct_name:curr(bytes)),
+ fun() -> St end}
+ end},
+ gen_dec_choice2(Erule, TopType, CompList, Pre),
+ emit([nl,"end"]);
+gen_dec_choice1(Erule, TopType, CompList, {ext,_,_}=Ext) ->
+ emit_getchoice(Erule, CompList, Ext),
Imm = asn1ct_imm:per_dec_open_type(is_aligned(Erule)),
+ emit(["begin",nl]),
BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)),
- emit([";",nl,
- "_ ->",nl]),
- {TmpTerm,TmpBuf} = asn1ct_imm:dec_slim_cg(Imm, BytesVar),
- emit([com,nl,
- "{asn1_ExtAlt,{",TmpTerm,com,TmpBuf,"}}",nl,
- "end,",nl,nl,
- "{{Cname,Val},NewBytes}"]).
-
+ {Dst,DstBuf} = asn1ct_imm:dec_slim_cg(Imm, BytesVar),
+ emit([nl,
+ "end,",nl,
+ "case Choice of",nl]),
+ Pre = {safe,fun(St) ->
+ emit(["{TmpVal,_} = "]),
+ {Dst,
+ fun() ->
+ emit([",",nl,
+ "{TmpVal,",DstBuf,"}"]),
+ St
+ end}
+ end},
+ gen_dec_choice2(Erule, TopType, CompList, Pre),
+ case CompList of
+ [] -> ok;
+ [_|_] -> emit([";",nl])
+ end,
+ emit(["_ ->",nl,
+ "{{asn1_ExtAlt,",Dst,"},",DstBuf,"}",nl,
+ "end"]).
+
+emit_getchoice(Erule, CompList, Ext) ->
+ Al = is_aligned(Erule),
+ Imm = case {Ext,CompList} of
+ {noext,[_]} ->
+ {value,0};
+ {noext,_} ->
+ asn1ct_imm:per_dec_constrained(0, length(CompList)-1, Al);
+ {{ext,_,_},_} ->
+ asn1ct_imm:per_dec_normally_small_number(Al)
+ end,
+ emit(["{Choice,",{curr,bytes},"} = ",nl]),
+ BytesVar = asn1ct_gen:mk_var(asn1ct_name:prev(bytes)),
+ asn1ct_imm:dec_code_gen(Imm, BytesVar),
+ emit([com,nl]).
gen_dec_choice2(Erule,TopType,L,Ext) ->
- gen_dec_choice2(Erule,TopType,L,0,Ext).
+ gen_dec_choice2(Erule, TopType, L, 0, [], Ext).
-gen_dec_choice2(Erule,TopType,[H1,H2|T],Pos,Ext)
-when is_record(H1,'ComponentType'), is_record(H2,'ComponentType') ->
- Cname = H1#'ComponentType'.name,
- Type = H1#'ComponentType'.typespec,
+gen_dec_choice2(Erule, TopType, [H0|T], Pos, Sep0, Pre) ->
+ #'ComponentType'{name=Cname,typespec=Type} = H0,
+ H = H0#'ComponentType'{prop=mandatory},
+ emit([Sep0,Pos," ->",nl]),
case Type#type.def of
#'ObjectClassFieldType'{type={typefield,_}} ->
- emit({Pos," -> ",nl}),
- wrap_gen_dec_line(Erule,H1,TopType,Cname,Type,Pos+1,false,Ext),
- emit({";",nl});
- _ ->
- emit({Pos," -> {",{asis,Cname},",",nl}),
- wrap_gen_dec_line(Erule,H1,TopType,Cname,Type,Pos+1,false,Ext),
- emit({"};",nl})
- end,
- gen_dec_choice2(Erule,TopType,[H2|T],Pos+1,Ext);
-gen_dec_choice2(Erule,TopType,[H1,_H2|T],Pos,Ext) when is_record(H1,'ComponentType') ->
- gen_dec_choice2(Erule,TopType,[H1|T],Pos,Ext); % skip extensionmark
-gen_dec_choice2(Erule,TopType,[H1|T],Pos,Ext) when is_record(H1,'ComponentType') ->
- Cname = H1#'ComponentType'.name,
- Type = H1#'ComponentType'.typespec,
- case Type#type.def of
- #'ObjectClassFieldType'{type={typefield,_}} ->
- emit({Pos," -> ",nl}),
- wrap_gen_dec_line(Erule,H1,TopType,Cname,Type,Pos+1,false,Ext);
+ emit("{Cname,{Val,NewBytes}} = begin\n"),
+ gen_dec_choice_line(Erule, TopType, H, Pre),
+ emit([nl,
+ "end,",nl,
+ "{{Cname,Val},NewBytes}"]);
_ ->
- emit({Pos," -> {",{asis,Cname},",",nl}),
- wrap_gen_dec_line(Erule,H1,TopType,Cname,Type,Pos+1,false,Ext),
- emit("}")
+ emit("{Val,NewBytes} = begin\n"),
+ gen_dec_choice_line(Erule, TopType, H, Pre),
+ emit([nl,
+ "end,",nl,
+ "{{",{asis,Cname},",Val},NewBytes}"])
end,
- gen_dec_choice2(Erule,TopType,[T],Pos+1);
-gen_dec_choice2(Erule,TopType,[_|T],Pos,Ext) ->
- gen_dec_choice2(Erule,TopType,T,Pos,Ext);% skip extensionmark
-gen_dec_choice2(_,_,[],Pos,_) ->
- Pos.
+ Sep = [";",nl],
+ gen_dec_choice2(Erule, TopType, T, Pos+1, Sep, Pre);
+gen_dec_choice2(_, _, [], _, _, _) -> ok.
indent(N) ->
lists:duplicate(N,32). % 32 = space
-gen_encode_prim_wrapper(CtgenMod,Erule,Cont,DoTag,Value) ->
-% put(component_type,true), % add more info in component_type
- CtgenMod:gen_encode_prim(Erule,Cont,DoTag,Value).
-% erase(component_type).
-
make_elements(I,Val,ExtCnames) ->
make_elements(I,Val,ExtCnames,[]).
@@ -1816,14 +1755,6 @@ wrap_extensionAdditionGroups([H|T],ExtAddGrpLenPos,Acc,ExtAddGroupDiff,ExtGroupN
wrap_extensionAdditionGroups([],_,Acc,_,_) ->
lists:reverse(Acc).
-
-wrap_gen_dec_line(Erule,C,TopType,_Cname,_Type,Pos,DIO,Ext) ->
- put(component_type,{true,C}),
- gen_dec_line(Erule, TopType, C#'ComponentType'{prop=mandatory},
- Pos, DIO, Ext),
- erase(component_type).
-
-
value_match(Index,Value) when is_atom(Value) ->
value_match(Index,atom_to_list(Value));
value_match([],Value) ->
@@ -1835,9 +1766,5 @@ value_match1(Value,[],Acc,Depth) ->
value_match1(Value,[{VI,_}|VIs],Acc,Depth) ->
value_match1(Value,VIs,Acc++lists:concat(["element(",VI,","]),Depth+1).
-notice_value_match() ->
- Module = get(currmod),
- put(value_match,{true,Module}).
-
is_optimized(per) -> true;
is_optimized(uper) -> false.
diff --git a/lib/asn1/src/asn1ct_func.erl b/lib/asn1/src/asn1ct_func.erl
index 2d221ca1b9..262bef6862 100644
--- a/lib/asn1/src/asn1ct_func.erl
+++ b/lib/asn1/src/asn1ct_func.erl
@@ -37,9 +37,13 @@ need(MFA) ->
cast({need,MFA}).
generate(Fd) ->
- req({generate,Fd}),
+ Used0 = req(get_used),
erase(?MODULE),
- ok.
+ Used = sofs:set(Used0, [mfa]),
+ Code = sofs:relation(asn1ct_rtt:code(), [{mfa,code}]),
+ Funcs0 = sofs:image(Code, Used),
+ Funcs = sofs:to_external(Funcs0),
+ ok = file:write(Fd, Funcs).
req(Req) ->
gen_server:call(get(?MODULE), Req, infinity).
@@ -64,9 +68,8 @@ handle_cast({need,MFA}, #st{used=Used0}=St) ->
{noreply,St}
end.
-handle_call({generate,Fd}, _From, #st{used=Used}=St) ->
- generate(Fd, Used),
- {stop,normal,ok,St}.
+handle_call(get_used, _From, #st{used=Used}=St) ->
+ {stop,normal,gb_sets:to_list(Used),St}.
terminate(_, _) ->
ok.
@@ -75,14 +78,6 @@ call_args([A|As], Sep) ->
[Sep,A|call_args(As, ", ")];
call_args([], _) -> [].
-generate(Fd, Used0) ->
- Used1 = gb_sets:to_list(Used0),
- Used = sofs:set(Used1, [mfa]),
- Code = sofs:relation(asn1ct_rtt:code(), [{mfa,code}]),
- Funcs0 = sofs:image(Code, Used),
- Funcs = sofs:to_external(Funcs0),
- io:put_chars(Fd, Funcs).
-
pull_in_deps(Ws0, Used0) ->
case gb_sets:is_empty(Ws0) of
true ->
diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl
index 76c4182160..9095e145a3 100644
--- a/lib/asn1/src/asn1ct_gen.erl
+++ b/lib/asn1/src/asn1ct_gen.erl
@@ -21,15 +21,9 @@
-include("asn1_records.hrl").
--export([pgen_exports/3,
- pgen_hrl/5,
- gen_head/3,
- demit/1,
+-export([demit/1,
emit/1,
get_inner/1,type/1,def_to_tag/1,prim_bif/1,
- type_from_object/1,
- get_typefromobject/1,get_fieldcategory/2,
- get_classfieldcategory/2,
list2name/1,
list2rname/1,
constructed_suffix/2,
@@ -41,7 +35,6 @@
index2suffix/1,
get_record_name_prefix/0]).
-export([pgen/5,
- pgen_module/6,
mk_var/1,
un_hyphen_var/1]).
-export([gen_encode_constructed/4,
@@ -75,7 +68,7 @@ pgen_module(OutFile,Erules,Module,
HrlGenerated = pgen_hrl(Erules,Module,TypeOrVal,Options,Indent),
asn1ct_name:start(),
ErlFile = lists:concat([OutFile,".erl"]),
- Fid = fopen(ErlFile,[write]),
+ Fid = fopen(ErlFile),
put(gen_file_out,Fid),
asn1ct_func:start_link(),
gen_head(Erules,Module,HrlGenerated),
@@ -115,8 +108,7 @@ pgen_values(Erules,Module,[H|T]) ->
gen_value(Valuedef),
pgen_values(Erules,Module,T).
-pgen_types(_,_,_,Module,[]) ->
- gen_value_match(Module),
+pgen_types(_, _, _, _, []) ->
true;
pgen_types(Rtmod,Erules,N2nConvEnums,Module,[H|T]) ->
asn1ct_name:clear(),
@@ -580,22 +572,6 @@ gen_types(Erules,Tname,Type) when is_record(Type,type) ->
asn1ct_name:clear(),
Rtmod:gen_decode(Erules,Tname,Type).
-gen_value_match(Module) ->
- case get(value_match) of
- {true,Module} ->
- emit(["value_match([{Index,Cname}|Rest],Value) ->",nl,
- " Value2 =",nl,
- " case element(Index,Value) of",nl,
- " {Cname,Val2} -> Val2;",nl,
- " X -> X",nl,
- " end,",nl,
- " value_match(Rest,Value2);",nl,
- "value_match([],Value) ->",nl,
- " Value.",nl]);
- _ -> ok
- end,
- put(value_match,undefined).
-
gen_check_defaultval(Erules,Module,[{Name,Type}|Rest]) ->
gen_check_func(Name,Type),
gen_check_defaultval(Erules,Module,Rest);
@@ -1131,7 +1107,7 @@ pgen_info() ->
open_hrl(OutFile,Module) ->
File = lists:concat([OutFile,".hrl"]),
- Fid = fopen(File,[write]),
+ Fid = fopen(File),
put(gen_file_out,Fid),
gen_hrlhead(Module).
@@ -1146,80 +1122,67 @@ demit(Term) ->
end.
% always generation
+emit(Term) ->
+ ok = file:write(get(gen_file_out), do_emit(Term)).
-emit({external,_M,T}) ->
- emit(T);
+do_emit({external,_M,T}) ->
+ do_emit(T);
-emit({prev,Variable}) when is_atom(Variable) ->
- emit({var,asn1ct_name:prev(Variable)});
+do_emit({prev,Variable}) when is_atom(Variable) ->
+ do_emit({var,asn1ct_name:prev(Variable)});
-emit({next,Variable}) when is_atom(Variable) ->
- emit({var,asn1ct_name:next(Variable)});
+do_emit({next,Variable}) when is_atom(Variable) ->
+ do_emit({var,asn1ct_name:next(Variable)});
-emit({curr,Variable}) when is_atom(Variable) ->
- emit({var,asn1ct_name:curr(Variable)});
+do_emit({curr,Variable}) when is_atom(Variable) ->
+ do_emit({var,asn1ct_name:curr(Variable)});
-emit({var,Variable}) when is_atom(Variable) ->
+do_emit({var,Variable}) when is_atom(Variable) ->
[Head|V] = atom_to_list(Variable),
- emit([Head-32|V]);
+ [Head-32|V];
-emit({var,Variable}) ->
+do_emit({var,Variable}) ->
[Head|V] = Variable,
- emit([Head-32|V]);
-
-emit({asis,What}) ->
- format(get(gen_file_out),"~w",[What]);
-
-emit({call,M,F,A}) ->
- asn1ct_func:call(M, F, A);
-
-emit(nl) ->
- nl(get(gen_file_out));
-
-emit(com) ->
- emit(",");
+ [Head-32|V];
-emit(tab) ->
- put_chars(get(gen_file_out)," ");
+do_emit({asis,What}) ->
+ io_lib:format("~w", [What]);
-emit(What) when is_integer(What) ->
- put_chars(get(gen_file_out),integer_to_list(What));
+do_emit({call,M,F,A}) ->
+ MFA = {M,F,length(A)},
+ asn1ct_func:need(MFA),
+ [atom_to_list(F),"(",call_args(A, "")|")"];
-emit(What) when is_list(What), is_integer(hd(What)) ->
- put_chars(get(gen_file_out),What);
+do_emit(nl) ->
+ "\n";
-emit(What) when is_atom(What) ->
- put_chars(get(gen_file_out),atom_to_list(What));
+do_emit(com) ->
+ ",";
-emit(What) when is_tuple(What) ->
- emit_parts(tuple_to_list(What));
+do_emit(tab) ->
+ " ";
-emit(What) when is_list(What) ->
- emit_parts(What);
+do_emit(What) when is_integer(What) ->
+ integer_to_list(What);
-emit(X) ->
- exit({'cant emit ',X}).
+do_emit(What) when is_list(What), is_integer(hd(What)) ->
+ What;
-emit_parts([]) -> true;
-emit_parts([H|T]) ->
- emit(H),
- emit_parts(T).
+do_emit(What) when is_atom(What) ->
+ atom_to_list(What);
-format(undefined,X,Y) ->
- io:format(X,Y);
-format(X,Y,Z) ->
- io:format(X,Y,Z).
+do_emit(What) when is_tuple(What) ->
+ [do_emit(E) || E <- tuple_to_list(What)];
-nl(undefined) -> io:nl();
-nl(X) -> io:nl(X).
+do_emit(What) when is_list(What) ->
+ [do_emit(E) || E <- What].
-put_chars(undefined,X) ->
- io:put_chars(X);
-put_chars(Y,X) ->
- io:put_chars(Y,X).
+call_args([A|As], Sep) ->
+ [Sep,do_emit(A)|call_args(As, ", ")];
+call_args([], _) -> [].
-fopen(F, ModeList) ->
- case file:open(F, ModeList) of
+fopen(F) ->
+ case file:open(F, [write,raw,delayed_write]) of
{ok, Fd} ->
Fd;
{error, Reason} ->
@@ -1671,7 +1634,6 @@ unify_if_string(PrimType) ->
get_inner(A) when is_atom(A) -> A;
get_inner(Ext) when is_record(Ext,'Externaltypereference') -> Ext;
-get_inner(Tref) when is_record(Tref,typereference) -> Tref;
get_inner({fixedtypevaluefield,_,Type}) ->
if
is_record(Type,type) ->
@@ -1704,8 +1666,6 @@ get_inner(T) when is_tuple(T) ->
type(X) when is_record(X,'Externaltypereference') ->
X;
-type(X) when is_record(X,typereference) ->
- X;
type('ASN1_OPEN_TYPE') ->
'ASN1_OPEN_TYPE';
type({fixedtypevaluefield,_Name,Type}) when is_record(Type,type) ->
@@ -1713,15 +1673,6 @@ type({fixedtypevaluefield,_Name,Type}) when is_record(Type,type) ->
type({typefield,_}) ->
'ASN1_OPEN_TYPE';
type(X) ->
- %% io:format("asn1_types:type(~p)~n",[X]),
- case catch type2(X) of
- {'EXIT',_} ->
- {notype,X};
- Normal ->
- Normal
- end.
-
-type2(X) ->
case prim_bif(X) of
true ->
{primitive,bif};
@@ -1740,7 +1691,6 @@ prim_bif(X) ->
'REAL',
'OBJECT IDENTIFIER',
'RELATIVE-OID',
- 'ANY',
'NULL',
'BIT STRING' ,
'OCTET STRING' ,
@@ -1784,15 +1734,6 @@ def_to_tag(Def) ->
%% Information Object Class
-type_from_object(X) ->
- case (catch lists:last(element(2,X))) of
- {'EXIT',_} ->
- {notype,X};
- Normal ->
- Normal
- end.
-
-
get_fieldtype([],_FieldName)->
{no_type,no_name};
get_fieldtype([Field|Rest],FieldName) ->
@@ -1808,34 +1749,6 @@ get_fieldtype([Field|Rest],FieldName) ->
get_fieldtype(Rest,FieldName)
end.
-get_fieldcategory([],_FieldName) ->
- no_cat;
-get_fieldcategory([Field|Rest],FieldName) ->
- case element(2,Field) of
- FieldName ->
- element(1,Field);
- _ ->
- get_fieldcategory(Rest,FieldName)
- end.
-
-get_typefromobject(Type) when is_record(Type,type) ->
- case Type#type.def of
- {{objectclass,_,_},TypeFrObj} when is_list(TypeFrObj) ->
- {_,FieldName} = lists:last(TypeFrObj),
- FieldName;
- _ ->
- {no_field}
- end.
-
-get_classfieldcategory(Type,FieldName) ->
- case (catch Type#type.def) of
- {{obejctclass,Fields,_},_} ->
- get_fieldcategory(Fields,FieldName);
- {'EXIT',_} ->
- no_cat;
- _ ->
- no_cat
- end.
%% Information Object Class
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -1902,7 +1815,7 @@ index2suffix(N) ->
ct_gen_module(ber) ->
asn1ct_gen_ber_bin_v2;
ct_gen_module(per) ->
- asn1ct_gen_per_rt2ct;
+ asn1ct_gen_per;
ct_gen_module(uper) ->
asn1ct_gen_per.
diff --git a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl
index de0adef2b2..8ab49aec2c 100644
--- a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl
+++ b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl
@@ -24,9 +24,7 @@
-include("asn1_records.hrl").
--export([pgen/4]).
-export([decode_class/1, decode_type/1]).
--export([add_removed_bytes/0]).
-export([gen_encode/2,gen_encode/3,gen_decode/2,gen_decode/3]).
-export([gen_encode_prim/4]).
-export([gen_dec_prim/7]).
@@ -59,18 +57,6 @@
-define(T_VisibleString, ?UNIVERSAL bor ?PRIMITIVE bor 26). %can be constructed
-define(T_GeneralString, ?UNIVERSAL bor ?PRIMITIVE bor 27). %can be constructed
-%% pgen(Erules, Module, TypeOrVal)
-%% Generate Erlang module (.erl) and (.hrl) file corresponding to an ASN.1 module
-%% .hrl file is only generated if necessary
-%% Erules = per | ber
-%% Module = atom()
-%% TypeOrVal = {TypeList,ValueList,PTypeList}
-%% TypeList = ValueList = [atom()]
-
-pgen(OutFile,Erules,Module,TypeOrVal) ->
- asn1ct_gen:pgen_module(OutFile,Erules,Module,TypeOrVal,[],true).
-
-
%%===============================================================================
%%===============================================================================
%%===============================================================================
@@ -83,8 +69,8 @@ pgen(OutFile,Erules,Module,TypeOrVal) ->
%% encode #{typedef, {pos, name, typespec}}
%%===============================================================================
-gen_encode(Erules,Type) when is_record(Type,typedef) ->
- gen_encode_user(Erules,Type).
+gen_encode(Erules, #typedef{}=D) ->
+ gen_encode_user(Erules, #typedef{}=D, true).
%%===============================================================================
%% encode #{type, {tag, def, constraint}}
@@ -134,20 +120,28 @@ gen_encode(Erules,Tname,#'ComponentType'{name=Cname,typespec=Type}) ->
NewType = Type#type{tag=[]},
gen_encode(Erules,NewTname,NewType).
-gen_encode_user(Erules,D) when is_record(D,typedef) ->
+gen_encode_user(Erules, #typedef{}=D, Wrapper) ->
Typename = [D#typedef.name],
Type = D#typedef.typespec,
InnerType = asn1ct_gen:get_inner(Type#type.def),
- OTag = Type#type.tag,
- Tag = [encode_tag_val(decode_class(X#tag.class),X#tag.form,X#tag.number)|| X <- OTag],
emit([nl,nl,"%%================================"]),
emit([nl,"%% ",Typename]),
emit([nl,"%%================================",nl]),
- emit(["'enc_",asn1ct_gen:list2name(Typename),
- "'(Val",") ->",nl]),
- emit([" 'enc_",asn1ct_gen:list2name(Typename),
- "'(Val, ", {asis,lists:reverse(Tag)},").",nl,nl]),
- emit({"'enc_",asn1ct_gen:list2name(Typename),"'(Val, TagIn) ->",nl}),
+ FuncName = "'enc_" ++ asn1ct_gen:list2name(Typename) ++ "'",
+ case Wrapper of
+ true ->
+ %% This is a top-level type. Generate an 'enc_Type'/1
+ %% wrapper.
+ OTag = Type#type.tag,
+ Tag0 = [encode_tag_val(decode_class(Class), Form, Number) ||
+ #tag{class=Class,form=Form,number=Number} <- OTag],
+ Tag = lists:reverse(Tag0),
+ emit([FuncName,"(Val) ->",nl,
+ " ",FuncName,"(Val, ",{asis,Tag},").",nl,nl]);
+ false ->
+ ok
+ end,
+ emit([FuncName,"(Val, TagIn) ->",nl]),
CurrentMod = get(currmod),
case asn1ct_gen:type(InnerType) of
{constructed,bif} ->
@@ -155,8 +149,6 @@ gen_encode_user(Erules,D) when is_record(D,typedef) ->
{primitive,bif} ->
gen_encode_prim(ber,Type,"TagIn","Val"),
emit([".",nl]);
- #typereference{val=Ename} ->
- emit([" 'enc_",Ename,"'(Val, TagIn).",nl]);
#'Externaltypereference'{module=CurrentMod,type=Etype} ->
emit([" 'enc_",Etype,"'(Val, TagIn).",nl]);
#'Externaltypereference'{module=Emod,type=Etype} ->
@@ -169,8 +161,8 @@ gen_encode_user(Erules,D) when is_record(D,typedef) ->
emit([".",nl])
end.
-gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) ->
- BitStringConstraint = D#type.constraint,
+gen_encode_prim(_Erules, #type{}=D, DoTag, Value) ->
+ BitStringConstraint = get_size_constraint(D#type.constraint),
asn1ct_name:new(enumval),
Type = case D#type.def of
'OCTET STRING' -> restricted_string;
@@ -184,6 +176,8 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) ->
'GeneralString' -> restricted_string;
'PrintableString' -> restricted_string;
'IA5String' -> restricted_string;
+ 'UTCTime' -> restricted_string;
+ 'GeneralizedTime' -> restricted_string;
Other -> Other
end,
case Type of
@@ -208,8 +202,6 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) ->
call(encode_bit_string,
[{asis,BitStringConstraint},Value,
{asis,NamedNumberList},DoTag]);
- 'ANY' ->
- call(encode_open_type, [Value,DoTag]);
'NULL' ->
call(encode_null, [Value,DoTag]);
'OBJECT IDENTIFIER' ->
@@ -222,19 +214,8 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) ->
call(encode_UTF8_string, [Value,DoTag]);
'BMPString' ->
call(encode_BMP_string, [Value,DoTag]);
- 'UTCTime' ->
- call(encode_utc_time, [Value,DoTag]);
- 'GeneralizedTime' ->
- call(encode_generalized_time, [Value,DoTag]);
'ASN1_OPEN_TYPE' ->
- call(encode_open_type, [Value,DoTag]);
- #'ObjectClassFieldType'{} ->
- case asn1ct_gen:get_inner(D#type.def) of
- {fixedtypevaluefield,_,InnerType} ->
- gen_encode_prim(Erules,InnerType,DoTag,Value);
- 'ASN1_OPEN_TYPE' ->
- call(encode_open_type, [Value,DoTag])
- end
+ call(encode_open_type, [Value,DoTag])
end.
emit_enc_enumerated_cases({L1,L2}, Tags) ->
@@ -470,32 +451,18 @@ gen_decode_user(Erules,D) when is_record(D,typedef) ->
end.
-gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Form,OptOrMand) ->
+gen_dec_prim(_Erules, Att, BytesVar, DoTag, _TagIn, _Form, _OptOrMand) ->
Typename = Att#type.def,
%% Currently not used for BER replaced with [] as place holder
%% Constraint = Att#type.constraint,
%% Constraint = [],
- Constraint =
- case get_constraint(Att#type.constraint,'SizeConstraint') of
- no -> [];
- Tc -> Tc
- end,
- ValueRange =
- case get_constraint(Att#type.constraint,'ValueRange') of
- no -> [];
- Tv -> Tv
- end,
- SingleValue =
- case get_constraint(Att#type.constraint,'SingleValue') of
- no -> [];
- Sv -> Sv
- end,
+ Constraint = get_size_constraint(Att#type.constraint),
+ IntConstr = int_constr(Att#type.constraint),
AsBin = case get(binary_strings) of
true -> "_as_bin";
_ -> ""
end,
NewTypeName = case Typename of
- 'ANY' -> 'ASN1_OPEN_TYPE';
'OCTET STRING' -> restricted_string;
'NumericString' -> restricted_string;
'TeletexString' -> restricted_string;
@@ -506,6 +473,9 @@ gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Form,OptOrMand) ->
'GeneralString' -> restricted_string;
'PrintableString' -> restricted_string;
'IA5String' -> restricted_string;
+ 'ObjectDescriptor'-> restricted_string;
+ 'UTCTime' -> restricted_string;
+ 'GeneralizedTime' -> restricted_string;
_ -> Typename
end,
case NewTypeName of
@@ -513,14 +483,27 @@ gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Form,OptOrMand) ->
emit(["decode_boolean(",BytesVar,","]),
need(decode_boolean, 2);
'INTEGER' ->
- emit(["decode_integer(",BytesVar,",",
- {asis,int_constr(SingleValue,ValueRange)},","]),
- need(decode_integer, 3);
+ case IntConstr of
+ [] ->
+ emit(["decode_integer(",BytesVar,","]),
+ need(decode_integer, 2);
+ {_,_} ->
+ emit(["decode_integer(",BytesVar,",",
+ {asis,IntConstr},","]),
+ need(decode_integer, 3)
+ end;
{'INTEGER',NamedNumberList} ->
- emit(["decode_integer(",BytesVar,",",
- {asis,int_constr(SingleValue,ValueRange)},",",
- {asis,NamedNumberList},","]),
- need(decode_integer, 4);
+ case IntConstr of
+ [] ->
+ emit(["decode_named_integer(",BytesVar,",",
+ {asis,NamedNumberList},","]),
+ need(decode_named_integer, 3);
+ {_,_} ->
+ emit(["decode_named_integer(",BytesVar,",",
+ {asis,IntConstr},",",
+ {asis,NamedNumberList},","]),
+ need(decode_named_integer, 4)
+ end;
{'ENUMERATED',NamedNumberList} ->
emit(["decode_enumerated(",BytesVar,",",
{asis,NamedNumberList},","]),
@@ -538,10 +521,6 @@ gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Form,OptOrMand) ->
'RELATIVE-OID' ->
emit(["decode_relative_oid(",BytesVar,","]),
need(decode_relative_oid, 2);
- 'ObjectDescriptor' ->
- emit(["decode_restricted_string(",
- BytesVar,",",{asis,Constraint},","]),
- need(decode_restricted_string, 3);
restricted_string ->
emit(["decode_restricted_string",AsBin,"(",BytesVar,","]),
case Constraint of
@@ -563,31 +542,10 @@ gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Form,OptOrMand) ->
emit(["decode_BMP_string",AsBin,"(",
BytesVar,",",{asis,Constraint},","]),
need(decode_BMP_string, 3);
- 'UTCTime' ->
- emit(["decode_utc_time",AsBin,"(",
- BytesVar,",",{asis,Constraint},","]),
- need(decode_utc_time, 3);
- 'GeneralizedTime' ->
- emit(["decode_generalized_time",AsBin,"(",
- BytesVar,",",{asis,Constraint},","]),
- need(decode_generalized_time, 3);
'ASN1_OPEN_TYPE' ->
emit(["decode_open_type_as_binary(",
BytesVar,","]),
- need(decode_open_type_as_binary, 2);
- #'ObjectClassFieldType'{} ->
- case asn1ct_gen:get_inner(Att#type.def) of
- {fixedtypevaluefield,_,InnerType} ->
- gen_dec_prim(Erules,InnerType,BytesVar,DoTag,TagIn,Form,OptOrMand);
- 'ASN1_OPEN_TYPE' ->
- emit(["decode_open_type_as_binary(",
- BytesVar,","]),
- need(decode_open_type_as_binary, 2);
- Other ->
- exit({'cannot decode',Other})
- end;
- Other ->
- exit({'cannot decode',Other})
+ need(decode_open_type_as_binary, 2)
end,
TagStr = case DoTag of
@@ -604,25 +562,27 @@ gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Form,OptOrMand) ->
{call,ber,match_tags,[BytesVar,TagStr]},com,nl,
{call,real_common,decode_real,[{curr,tmpbuf}]},nl,
"end",nl]);
- #'ObjectClassFieldType'{} ->
- case asn1ct_gen:get_inner(Att#type.def) of
- 'ASN1_OPEN_TYPE' ->
- emit([TagStr,")"]);
- _ -> ok
- end;
_ ->
emit([TagStr,")"])
end.
-
-int_constr([],[]) ->
- [];
-int_constr([],ValueRange) ->
- ValueRange;
-int_constr(SingleValue,[]) ->
- SingleValue;
-int_constr(SV,VR) ->
- [SV,VR].
+%% Simplify an integer constraint so that we can efficiently test it.
+-spec int_constr(term()) -> [] | {integer(),integer()|'MAX'}.
+int_constr(C) ->
+ case asn1ct_imm:effective_constraint(integer, C) of
+ [{_,[]}] ->
+ %% Extension - ignore constraint.
+ [];
+ [{'ValueRange',{'MIN',_}}] ->
+ %% Tricky to implement efficiently - ignore it.
+ [];
+ [{'ValueRange',{_,_}=Range}] ->
+ Range;
+ [{'SingleValue',Sv}] ->
+ {Sv,Sv};
+ [] ->
+ []
+ end.
gen_dec_bit_string(BytesVar, _Constraint, [_|_]=NNL, TagStr) ->
call(decode_named_bit_string,
@@ -664,9 +624,7 @@ gen_obj_code(Erules,_Module,Obj) when is_record(Obj,typedef) ->
ObjName,Fields,[]),
emit(nl),
gen_decode_constr_type(Erules,DecConstructed),
- emit_tlv_format_function();
-gen_obj_code(_Erules,_Module,Obj) when is_record(Obj,pobjectdef) ->
- ok.
+ emit_tlv_format_function().
gen_encode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest],
ObjName,ObjectFields,ConstrAcc) ->
@@ -757,7 +715,7 @@ gen_encode_objectfields(_,[],_,_,Acc) ->
gen_encode_constr_type(Erules,[TypeDef|Rest]) when is_record(TypeDef,typedef) ->
case is_already_generated(enc,TypeDef#typedef.name) of
true -> ok;
- _ -> gen_encode_user(Erules,TypeDef)
+ false -> gen_encode_user(Erules, TypeDef, false)
end,
gen_encode_constr_type(Erules,Rest);
gen_encode_constr_type(_,[]) ->
@@ -815,8 +773,8 @@ gen_encode_default_call(ClassName,FieldName,Type) ->
Tag = [encode_tag_val(decode_class(X#tag.class),X#tag.form,X#tag.number)|| X <- OTag],
case asn1ct_gen:type(InnerType) of
{constructed,bif} ->
-%% asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,Type);
- emit([" 'enc_",ClassName,'_',FieldName,"'(Bytes)"]),
+ emit([" 'enc_",ClassName,'_',FieldName,"'",
+ "(Val, ",{asis,Tag},")"]),
[#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])),
typespec=Type}];
{primitive,bif} ->
@@ -964,7 +922,10 @@ gen_decode_constr_type(Erules,[TypeDef|Rest]) when is_record(TypeDef,typedef) ->
case is_already_generated(dec,TypeDef#typedef.name) of
true -> ok;
_ ->
- gen_decode(Erules,TypeDef)
+ emit([nl,nl,
+ "'dec_",TypeDef#typedef.name,
+ "'(Tlv, TagIn) ->",nl]),
+ gen_decode_user(Erules, TypeDef)
end,
gen_decode_constr_type(Erules,Rest);
gen_decode_constr_type(_,[]) ->
@@ -1108,54 +1069,29 @@ gen_objset_enc(_,_,{unique,undefined},_,_,_,_,_) ->
%% There is no unique field in the class of this object set
%% don't bother about the constraint
[];
-gen_objset_enc(Erules,ObjSName,UniqueName,
- [{ObjName,Val,Fields},T|Rest],ClName,ClFields,
+gen_objset_enc(Erules, ObjSetName, UniqueName,
+ [{ObjName,Val,Fields}|T], ClName, ClFields,
NthObj,Acc)->
- emit({"'getenc_",ObjSName,"'(",{asis,UniqueName},",",{asis,Val},
- ") ->",nl}),
+ emit(["'getenc_",ObjSetName,"'(",{asis,UniqueName},",",{asis,Val},
+ ") ->",nl]),
CurrMod = get(currmod),
{InternalFunc,NewNthObj}=
case ObjName of
{no_mod,no_name} ->
- gen_inlined_enc_funs(Fields,ClFields,ObjSName,NthObj);
- {CurrMod,Name} ->
- emit({" fun 'enc_",Name,"'/3"}),
- {[],NthObj};
- {ModuleName,Name} ->
- emit_ext_fun(enc,ModuleName,Name),
-% emit([" {'",ModuleName,"', 'enc_",Name,"'}"]),
- {[],NthObj};
- _ ->
- emit({" fun 'enc_",ObjName,"'/3"}),
- {[],NthObj}
- end,
- emit({";",nl}),
- gen_objset_enc(Erules,ObjSName,UniqueName,[T|Rest],ClName,ClFields,
- NewNthObj,InternalFunc ++ Acc);
-gen_objset_enc(_,ObjSetName,UniqueName,
- [{ObjName,Val,Fields}],_ClName,ClFields,NthObj,Acc) ->
- emit({"'getenc_",ObjSetName,"'(",{asis,UniqueName},",",
- {asis,Val},") ->",nl}),
- CurrMod = get(currmod),
- {InternalFunc,_} =
- case ObjName of
- {no_mod,no_name} ->
gen_inlined_enc_funs(Fields,ClFields,ObjSetName,NthObj);
{CurrMod,Name} ->
emit({" fun 'enc_",Name,"'/3"}),
{[],NthObj};
{ModuleName,Name} ->
emit_ext_fun(enc,ModuleName,Name),
-% emit([" {'",ModuleName,"', 'enc_",Name,"'}"]),
{[],NthObj};
_ ->
emit({" fun 'enc_",ObjName,"'/3"}),
{[],NthObj}
end,
- emit([";",nl]),
- emit_default_getenc(ObjSetName,UniqueName),
- emit({".",nl,nl}),
- InternalFunc ++ Acc;
+ emit({";",nl}),
+ gen_objset_enc(Erules, ObjSetName, UniqueName, T, ClName, ClFields,
+ NewNthObj, InternalFunc ++ Acc);
%% See X.681 Annex E for the following case
gen_objset_enc(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName,
_ClFields,_NthObj,Acc) ->
@@ -1167,7 +1103,9 @@ gen_objset_enc(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName,
emit({indent(6),"{Val,Len}",nl}),
emit({indent(3),"end.",nl,nl}),
Acc;
-gen_objset_enc(_,_,_,[],_,_,_,Acc) ->
+gen_objset_enc(_, ObjSetName, UniqueName, [], _, _, _, Acc) ->
+ emit_default_getenc(ObjSetName, UniqueName),
+ emit({".",nl,nl}),
Acc.
emit_ext_fun(EncDec,ModuleName,Name) ->
@@ -1181,78 +1119,34 @@ emit_default_getenc(ObjSetName,UniqueName) ->
%% gen_inlined_enc_funs for each object iterates over all fields of a
%% class, and for each typefield it checks if the object has that
%% field and emits the proper code.
-gen_inlined_enc_funs(Fields,[{typefield,Name,_}|Rest],
- ObjSetName,NthObj) ->
- CurrMod = get(currmod),
- InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]),
- case lists:keysearch(Name,1,Fields) of
- {value,{_,Type}} when is_record(Type,type) ->
- emit({indent(3),"fun(Type, Val, _RestPrimFieldName) ->",nl,
- indent(6),"case Type of",nl}),
- {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName),
- gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+N,Ret);
- {value,{_,Type}} when is_record(Type,typedef) ->
- emit({indent(3),"fun(Type, Val, _RestPrimFieldName) ->",nl,
- indent(6),"case Type of",nl}),
- emit({indent(9),{asis,Name}," ->",nl}),
- {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName),
- gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+N,Ret);
- {value,{_,#'Externaltypereference'{module=M,type=T}}} ->
- emit([indent(3),"fun(Type, Val, _RestPrimFieldName) ->",nl,
- indent(6),"case Type of",nl]),
- emit([indent(9),{asis,Name}," ->",nl]),
- if
- M == CurrMod ->
- emit([indent(12),"'enc_",T,"'(Val)"]);
- true ->
- #typedef{typespec=Type} = asn1_db:dbget(M,T),
- OTag = Type#type.tag,
-%% Tag = [encode_tag_val((decode_class(X#tag.class) bsl 10) +
-%% X#tag.number) ||
-%% X <- OTag],
- Tag = [encode_tag_val(decode_class(X#tag.class),
- X#tag.form,X#tag.number) ||
- X <- OTag],
- emit([indent(12),"'",M,"':'enc_",T,"'(Val, ",{asis,Tag},")"])
- end,
- gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj,[]);
- false ->
- %% This field was not present in the object thus there
- %% were no type in the table and we therefore generate
- %% code that returns the input for application treatment.
- emit([indent(3),"fun(Type, Val, _RestPrimFieldName) ->",nl,
- indent(6),"case Type of",nl,
- indent(9),{asis,Name}," ->",nl,
- indent(12),"Len = case Val of",nl,
- indent(15),"B when is_binary(B) -> size(B);",nl,
- indent(15),"_ -> length(Val)",nl,
- indent(12),"end,",nl,
- indent(12),"{Val,Len}"]),
- gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj,[])
- end;
+gen_inlined_enc_funs(Fields, [{typefield,_,_}|_]=T, ObjSetName, NthObj) ->
+ emit([indent(3),"fun(Type, Val, _RestPrimFieldName) ->",nl,
+ indent(6),"case Type of",nl]),
+ gen_inlined_enc_funs1(Fields, T, ObjSetName, [], NthObj, []);
gen_inlined_enc_funs(Fields,[_|Rest],ObjSetName,NthObj) ->
gen_inlined_enc_funs(Fields,Rest,ObjSetName,NthObj);
gen_inlined_enc_funs(_,[],_,NthObj) ->
{[],NthObj}.
-gen_inlined_enc_funs1(Fields,[{typefield,Name,_}|Rest],ObjSetName,
- NthObj,Acc) ->
+gen_inlined_enc_funs1(Fields, [{typefield,Name,_}|Rest], ObjSetName,
+ Sep0, NthObj, Acc0) ->
+ emit(Sep0),
+ Sep = [";",nl],
CurrMod = get(currmod),
InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]),
- {Acc2,NAdd}=
- case lists:keysearch(Name,1,Fields) of
- {value,{_,Type}} when is_record(Type,type) ->
- emit({";",nl}),
- {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName),
- {Ret++Acc,N};
- {value,{_,Type}} when is_record(Type,typedef) ->
- emit({";",nl,indent(9),{asis,Name}," ->",nl}),
- {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName),
- {Ret++Acc,N};
- {value,{_,#'Externaltypereference'{module=M,type=T}}} ->
- emit({";",nl,indent(9),{asis,Name}," ->",nl}),
+ {Acc,NAdd} =
+ case lists:keyfind(Name,1,Fields) of
+ {_,#type{}=Type} ->
+ {Ret,N} = emit_inner_of_fun(Type,InternalDefFunName),
+ {Ret++Acc0,N};
+ {_,#typedef{}=Type} ->
+ emit([indent(9),{asis,Name}," ->",nl]),
+ {Ret,N} = emit_inner_of_fun(Type, InternalDefFunName),
+ {Ret++Acc0,N};
+ {_,#'Externaltypereference'{module=M,type=T}} ->
+ emit([indent(9),{asis,Name}," ->",nl]),
if
- M == CurrMod ->
+ M =:= CurrMod ->
emit([indent(12),"'enc_",T,"'(Val)"]);
true ->
#typedef{typespec=Type} = asn1_db:dbget(M,T),
@@ -1260,27 +1154,30 @@ gen_inlined_enc_funs1(Fields,[{typefield,Name,_}|Rest],ObjSetName,
Tag = [encode_tag_val(decode_class(X#tag.class),
X#tag.form,X#tag.number) ||
X <- OTag],
- emit([indent(12),"'",M,"':'enc_",T,"'(Val, ",{asis,Tag},")"])
+ emit([indent(12),"'",M,"':'enc_",T,"'(Val, ",
+ {asis,Tag},")"])
end,
- {Acc,0};
+ {Acc0,0};
false ->
%% This field was not present in the object thus there
%% were no type in the table and we therefore generate
%% code that returns the input for application
%% treatment.
- emit([";",nl,indent(9),{asis,Name}," ->",nl]),
- emit([indent(12),"Len = case Val of",nl,
- indent(15),"Bin when is_binary(Bin) -> byte_size(Bin);",nl,
- indent(15),"_ -> length(Val)",nl,indent(12),"end,",nl,
+ emit([indent(9),{asis,Name}," ->",nl,
+ indent(12),"Len = case Val of",nl,
+ indent(15),"Bin when is_binary(Bin) -> "
+ "byte_size(Bin);",nl,
+ indent(15),"_ -> length(Val)",nl,
+ indent(12),"end,",nl,
indent(12),"{Val,Len}"]),
- {Acc,0}
+ {Acc0,0}
end,
- gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+NAdd,Acc2);
-gen_inlined_enc_funs1(Fields,[_|Rest],ObjSetName,NthObj,Acc)->
- gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj,Acc);
-gen_inlined_enc_funs1(_,[],_,NthObj,Acc) ->
- emit({nl,indent(6),"end",nl}),
- emit({indent(3),"end"}),
+ gen_inlined_enc_funs1(Fields, Rest, ObjSetName, Sep, NthObj+NAdd, Acc);
+gen_inlined_enc_funs1(Fields,[_|Rest], ObjSetName, Sep, NthObj, Acc)->
+ gen_inlined_enc_funs1(Fields, Rest, ObjSetName, Sep, NthObj, Acc);
+gen_inlined_enc_funs1(_, [], _, _, NthObj, Acc) ->
+ emit([nl,indent(6),"end",nl,
+ indent(3),"end"]),
{Acc,NthObj}.
emit_inner_of_fun(TDef=#typedef{name={ExtMod,Name},typespec=Type},
@@ -1319,10 +1216,6 @@ emit_inner_of_fun(Type,_) when is_record(Type,type) ->
X#tag.form,X#tag.number)||X <- OTag],
emit([indent(9),Def," ->",nl,indent(12)]),
gen_encode_prim(ber,Type,{asis,lists:reverse(Tag)},"Val");
- TRef when is_record(TRef,typereference) ->
- T = TRef#typereference.val,
- emit([indent(9),T," ->",nl,indent(12),"'enc_",T,
- "'(Val)"]);
#'Externaltypereference'{module=CurrMod,type=T} ->
emit([indent(9),T," ->",nl,indent(12),"'enc_",T,
"'(Val)"]);
@@ -1345,8 +1238,8 @@ gen_objset_dec(_,_,{unique,undefined},_,_,_,_) ->
%% There is no unique field in the class of this object set
%% don't bother about the constraint
ok;
-gen_objset_dec(Erules,ObjSName,UniqueName,[{ObjName,Val,Fields},T|Rest],
- ClName,ClFields,NthObj)->
+gen_objset_dec(Erules, ObjSName, UniqueName, [{ObjName,Val,Fields}|T],
+ ClName, ClFields, NthObj)->
emit(["'getdec_",ObjSName,"'(",{asis,UniqueName},",",
{asis,Val},") ->",nl]),
CurrMod = get(currmod),
@@ -1359,35 +1252,14 @@ gen_objset_dec(Erules,ObjSName,UniqueName,[{ObjName,Val,Fields},T|Rest],
NthObj;
{ModuleName,Name} ->
emit_ext_fun(dec,ModuleName,Name),
-% emit([" {'",ModuleName,"', 'dec_",Name,"'}"]),
NthObj;
_ ->
emit([" fun 'dec_",ObjName,"'/3"]),
NthObj
end,
emit([";",nl]),
- gen_objset_dec(Erules,ObjSName,UniqueName,[T|Rest],ClName,
- ClFields,NewNthObj);
-gen_objset_dec(_,ObjSetName,UniqueName,[{ObjName,Val,Fields}],
- _ClName,ClFields,NthObj) ->
- emit(["'getdec_",ObjSetName,"'(",{asis,UniqueName},",",
- {asis,Val},") ->",nl]),
- CurrMod = get(currmod),
- case ObjName of
- {no_mod,no_name} ->
- gen_inlined_dec_funs(Fields,ClFields,ObjSetName,NthObj);
- {CurrMod,Name} ->
- emit([" fun 'dec_",Name,"'/3"]);
- {ModuleName,Name} ->
- emit_ext_fun(dec,ModuleName,Name);
-% emit([" {'",ModuleName,"', 'dec_",Name,"'}"]);
- _ ->
- emit([" fun 'dec_",ObjName,"'/3"])
- end,
- emit([";",nl]),
- emit_default_getdec(ObjSetName,UniqueName),
- emit([".",nl,nl]),
- ok;
+ gen_objset_dec(Erules, ObjSName, UniqueName, T, ClName,
+ ClFields, NewNthObj);
gen_objset_dec(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName,
_ClFields,_NthObj) ->
emit(["'getdec_",ObjSetName,"'(_, _) ->",nl]),
@@ -1401,86 +1273,41 @@ gen_objset_dec(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName,
indent(4),"end",nl]),
emit([indent(2),"end.",nl,nl]),
ok;
-gen_objset_dec(_,_,_,[],_,_,_) ->
+gen_objset_dec(_, ObjSetName, UniqueName, [], _, _, _) ->
+ emit_default_getdec(ObjSetName, UniqueName),
+ emit([".",nl,nl]),
ok.
emit_default_getdec(ObjSetName,UniqueName) ->
emit(["'getdec_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]),
emit([indent(2), "fun(C,V,_) -> exit({{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},", ErrV}}) end"]).
-gen_inlined_dec_funs(Fields,[{typefield,Name,Prop}|Rest],
- ObjSetName,NthObj) ->
- DecProp = case Prop of
- 'OPTIONAL' -> opt_or_default;
- {'DEFAULT',_} -> opt_or_default;
- _ -> mandatory
- end,
- CurrMod = get(currmod),
- InternalDefFunName = [NthObj,Name,ObjSetName],
- case lists:keysearch(Name,1,Fields) of
- {value,{_,Type}} when is_record(Type,type) ->
- emit([indent(3),"fun(Type, Bytes, _RestPrimFieldName) ->",
- nl,indent(6),"case Type of",nl]),
- N=emit_inner_of_decfun(Type,DecProp,InternalDefFunName),
- gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj+N);
- {value,{_,Type}} when is_record(Type,typedef) ->
- emit([indent(3),"fun(Type, Bytes, _RestPrimFieldName) ->",
- nl,indent(6),"case Type of",nl]),
- emit([indent(9),{asis,Name}," ->",nl]),
- N=emit_inner_of_decfun(Type,DecProp,InternalDefFunName),
- gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj+N);
- {value,{_,#'Externaltypereference'{module=M,type=T}}} ->
- emit([indent(3),"fun(Type, Bytes, _RestPrimFieldName) ->",
- nl,indent(6),"case Type of",nl]),
- emit([indent(9),{asis,Name}," ->",nl]),
- if
- M == CurrMod ->
- emit([indent(12),"'dec_",T,"'(Bytes)"]);
- true ->
- #typedef{typespec=Type} = asn1_db:dbget(M,T),
- OTag = Type#type.tag,
- Tag = [(decode_class(X#tag.class) bsl 10) + X#tag.number ||
- X <- OTag],
- emit([indent(12),"'",M,"':'dec_",T,"'(Bytes, ",{asis,Tag},")"])
- end,
- gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj);
- false ->
- emit([indent(3),"fun(Type, Bytes, _RestPrimFieldName) ->",
- nl,indent(6),"case Type of",nl,
- indent(9),{asis,Name}," ->",nl,
- indent(12),"Len = case Bytes of",nl,
- indent(15),"B when is_binary(B) -> byte_size(B);",nl,
- indent(15),"_ -> length(Bytes)",nl,
- indent(12),"end,",nl,
- indent(12),"{Bytes,[],Len}"]),
- gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj)
- end;
-gen_inlined_dec_funs(Fields,[_H|Rest],ObjSetName,NthObj) ->
- gen_inlined_dec_funs(Fields,Rest,ObjSetName,NthObj);
-gen_inlined_dec_funs(_,[],_,NthObj) ->
- NthObj.
+gen_inlined_dec_funs(Fields, ClFields, ObjSetName, NthObj) ->
+ emit([indent(3),"fun(Type, Bytes, _RestPrimFieldName) ->",nl,
+ indent(6),"case Type of",nl]),
+ gen_inlined_dec_funs1(Fields, ClFields, ObjSetName, "", NthObj).
-gen_inlined_dec_funs1(Fields,[{typefield,Name,Prop}|Rest],
- ObjSetName,NthObj) ->
+gen_inlined_dec_funs1(Fields, [{typefield,Name,Prop}|Rest],
+ ObjSetName, Sep0, NthObj) ->
+ emit(Sep0),
+ Sep = [";",nl],
DecProp = case Prop of
'OPTIONAL' -> opt_or_default;
{'DEFAULT',_} -> opt_or_default;
_ -> mandatory
end,
- CurrMod = get(currmod),
InternalDefFunName = [NthObj,Name,ObjSetName],
- N=
- case lists:keysearch(Name,1,Fields) of
- {value,{_,Type}} when is_record(Type,type) ->
- emit([";",nl]),
+ N = case lists:keyfind(Name, 1, Fields) of
+ {_,#type{}=Type} ->
emit_inner_of_decfun(Type,DecProp,InternalDefFunName);
- {value,{_,Type}} when is_record(Type,typedef) ->
- emit([";",nl,indent(9),{asis,Name}," ->",nl]),
+ {_,#typedef{}=Type} ->
+ emit([indent(9),{asis,Name}," ->",nl]),
emit_inner_of_decfun(Type,DecProp,InternalDefFunName);
- {value,{_,#'Externaltypereference'{module=M,type=T}}} ->
- emit([";",nl,indent(9),{asis,Name}," ->",nl]),
+ {_,#'Externaltypereference'{module=M,type=T}} ->
+ emit([indent(9),{asis,Name}," ->",nl]),
+ CurrMod = get(currmod),
if
- M == CurrMod ->
+ M =:= CurrMod ->
emit([indent(12),"'dec_",T,"'(Bytes)"]);
true ->
#typedef{typespec=Type} = asn1_db:dbget(M,T),
@@ -1491,21 +1318,20 @@ gen_inlined_dec_funs1(Fields,[{typefield,Name,Prop}|Rest],
end,
0;
false ->
- emit([";",nl,
- indent(9),{asis,Name}," ->",nl,
+ emit([indent(9),{asis,Name}," ->",nl,
indent(12),"Len = case Bytes of",nl,
- indent(15),"B when is_binary(B) -> size(B);",nl,
+ indent(15),"B when is_binary(B) -> byte_size(B);",nl,
indent(15),"_ -> length(Bytes)",nl,
indent(12),"end,",nl,
indent(12),"{Bytes,[],Len}"]),
0
end,
- gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj+N);
-gen_inlined_dec_funs1(Fields,[_|Rest],ObjSetName,NthObj)->
- gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj);
-gen_inlined_dec_funs1(_,[],_,NthObj) ->
- emit([nl,indent(6),"end",nl]),
- emit([indent(3),"end"]),
+ gen_inlined_dec_funs1(Fields, Rest, ObjSetName, Sep, NthObj+N);
+gen_inlined_dec_funs1(Fields, [_|Rest], ObjSetName, Sep, NthObj)->
+ gen_inlined_dec_funs1(Fields, Rest, ObjSetName, Sep, NthObj);
+gen_inlined_dec_funs1(_, [], _, _, NthObj) ->
+ emit([nl,indent(6),"end",nl,
+ indent(3),"end"]),
NthObj.
emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type},Prop,
@@ -1561,10 +1387,9 @@ emit_inner_of_decfun(Type,Prop,_) when is_record(Type,type) ->
gen_internal_funcs(_,[]) ->
ok;
gen_internal_funcs(Erules,[TypeDef|Rest]) ->
- gen_encode_user(Erules,TypeDef),
- emit([nl,nl,"'dec_",TypeDef#typedef.name,
-% "'(Tlv, OptOrMand, TagIn) ->",nl]),
- "'(Tlv, TagIn) ->",nl]),
+ gen_encode_user(Erules, TypeDef, false),
+ emit([nl,nl,
+ "'dec_",TypeDef#typedef.name,"'(Tlv, TagIn) ->",nl]),
gen_decode_user(Erules,TypeDef),
gen_internal_funcs(Erules,Rest).
@@ -1615,46 +1440,23 @@ decode_type('BMPString') -> 30;
decode_type('CHOICE') -> 'CHOICE'; % choice gets the tag from the actual alternative
decode_type(Else) -> exit({error,{asn1,{unrecognized_type,Else}}}).
-add_removed_bytes() ->
- asn1ct_name:delete(rb),
- add_removed_bytes(asn1ct_name:all(rb)).
-
-add_removed_bytes([H,T1|T]) ->
- emit({{var,H},"+"}),
- add_removed_bytes([T1|T]);
-add_removed_bytes([H|T]) ->
- emit({{var,H}}),
- add_removed_bytes(T);
-add_removed_bytes([]) ->
- true.
-
-mkfuncname(WhatKind,DecOrEnc) ->
- case WhatKind of
- #'Externaltypereference'{module=Mod,type=EType} ->
- CurrMod = get(currmod),
- case CurrMod of
- Mod ->
- lists:concat(["'",DecOrEnc,"_",EType,"'"]);
- _ ->
-% io:format("CurrMod: ~p, Mod: ~p~n",[CurrMod,Mod]),
- lists:concat(["'",Mod,"':'",DecOrEnc,"_",EType,"'"])
- end;
- #'typereference'{val=EType} ->
+mkfuncname(#'Externaltypereference'{module=Mod,type=EType}, DecOrEnc) ->
+ CurrMod = get(currmod),
+ case CurrMod of
+ Mod ->
lists:concat(["'",DecOrEnc,"_",EType,"'"]);
- 'ASN1_OPEN_TYPE' ->
- lists:concat(["'",DecOrEnc,"_",WhatKind,"'"])
-
+ _ ->
+ lists:concat(["'",Mod,"':'",DecOrEnc,"_",EType,"'"])
end.
-get_constraint(C,Key) ->
- case lists:keysearch(Key,1,C) of
- false ->
- no;
- {value,{_,V}} ->
- V
+get_size_constraint(C) ->
+ case lists:keyfind('SizeConstraint', 1, C) of
+ false -> [];
+ {_,{_,[]}} -> []; %Extensible.
+ {_,{Sv,Sv}} -> Sv;
+ {_,{_,_}=Tc} -> Tc
end.
-
get_class_fields(#classdef{typespec=ObjClass}) ->
ObjClass#objectclass.fields;
get_class_fields(#objectclass{fields=Fields}) ->
diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl
index fac233532b..30c9ab9365 100644
--- a/lib/asn1/src/asn1ct_gen_per.erl
+++ b/lib/asn1/src/asn1ct_gen_per.erl
@@ -26,28 +26,16 @@
%-compile(export_all).
-export([gen_dec_imm/2]).
--export([pgen/4,gen_dec_prim/3,gen_encode_prim/4]).
+-export([gen_dec_prim/3,gen_encode_prim/3]).
-export([gen_obj_code/3,gen_objectset_code/2]).
-export([gen_decode/2, gen_decode/3]).
-export([gen_encode/2, gen_encode/3]).
--export([is_already_generated/2,more_genfields/1,get_class_fields/1,
- get_object_field/2]).
+-export([gen_dec_external/2]).
-export([extaddgroup2sequence/1]).
-import(asn1ct_gen, [emit/1,demit/1]).
-import(asn1ct_func, [call/3]).
-%% pgen(Erules, Module, TypeOrVal)
-%% Generate Erlang module (.erl) and (.hrl) file corresponding to an ASN.1 module
-%% .hrl file is only generated if necessary
-%% Erules = per | ber
-%% Module = atom()
-%% TypeOrVal = {TypeList,ValueList}
-%% TypeList = ValueList = [atom()]
-
-pgen(OutFile,Erules,Module,TypeOrVal) ->
- asn1ct_gen:pgen_module(OutFile,Erules,Module,TypeOrVal,[],true).
-
%% Generate ENCODING ******************************
%%****************************************x
@@ -96,36 +84,44 @@ gen_encode_user(Erules,D) when is_record(D,typedef) ->
emit({"'enc_",asn1ct_gen:list2name(Typename),"'(Val) ->",nl}),
case asn1ct_gen:type(InnerType) of
{primitive,bif} ->
- gen_encode_prim(Erules,Def,"false"),
+ gen_encode_prim(Erules, Def),
emit({".",nl});
'ASN1_OPEN_TYPE' ->
- gen_encode_prim(Erules,Def#type{def='ASN1_OPEN_TYPE'},"false"),
+ gen_encode_prim(Erules, Def#type{def='ASN1_OPEN_TYPE'}),
emit({".",nl});
{constructed,bif} ->
asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,D);
#'Externaltypereference'{module=CurrMod,type=Etype} ->
emit({"'enc_",Etype,"'(Val).",nl,nl});
#'Externaltypereference'{module=Emod,type=Etype} ->
- emit({"'",Emod,"':'enc_",Etype,"'(Val).",nl,nl});
- #typereference{val=Ename} ->
- emit({"'enc_",Ename,"'(Val).",nl,nl});
- {notype,_} ->
- emit({"'enc_",InnerType,"'(Val).",nl,nl})
+ emit({"'",Emod,"':'enc_",Etype,"'(Val).",nl,nl})
end.
-gen_encode_prim(Erules,D,DoTag) ->
- Value = case asn1ct_name:active(val) of
- true ->
- asn1ct_gen:mk_var(asn1ct_name:curr(val));
- false ->
- "Val"
- end,
- gen_encode_prim(Erules,D,DoTag,Value).
-
-gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) ->
+gen_encode_prim(Erules, D) ->
+ Value = asn1ct_gen:mk_var(asn1ct_name:curr(val)),
+ gen_encode_prim(Erules, D, Value).
+
+gen_encode_prim(Erules, #type{def={'ENUMERATED',{N1,N2}}}, Value) ->
+ NewList = [{0,X} || {X,_} <- N1] ++ ['EXT_MARK'] ++
+ [{1,X} || {X,_} <- N2],
+ NewC = {0,length(N1)-1},
+ emit(["case ",Value," of",nl]),
+ emit_enc_enumerated_cases(Erules, NewC, NewList, 0);
+gen_encode_prim(Erules, #type{def={'ENUMERATED',NNL}}, Value) ->
+ NewList = [X || {X,_} <- NNL],
+ NewC = {0,length(NewList)-1},
+ emit(["case ",Value," of",nl]),
+ emit_enc_enumerated_cases(Erules, NewC, NewList, 0);
+gen_encode_prim(per=Erules, D, Value) ->
+ asn1ct_gen_per_rt2ct:gen_encode_prim(Erules, D, Value);
+gen_encode_prim(Erules, #type{}=D, Value) ->
Constraint = D#type.constraint,
- asn1ct_name:new(enumval),
+ SizeConstr = asn1ct_imm:effective_constraint(bitstring, Constraint),
+ Pa = case lists:keyfind('PermittedAlphabet', 1, Constraint) of
+ false -> no;
+ {_,Pa0} -> Pa0
+ end,
case D#type.def of
'INTEGER' ->
Args = [{asis,asn1ct_imm:effective_constraint(integer,Constraint)},
@@ -135,23 +131,10 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) ->
Args = [{asis,asn1ct_imm:effective_constraint(integer,Constraint)},
Value,{asis,NamedNumberList}],
call(Erules, encode_integer, Args);
- {'ENUMERATED',{Nlist1,Nlist2}} ->
- NewList = [{0,X} || {X,_} <- Nlist1] ++ ['EXT_MARK'] ++
- [{1,X} || {X,_} <- Nlist2],
- NewC = {0,length(Nlist1)-1},
- emit(["case ",Value," of",nl]),
- emit_enc_enumerated_cases(Erules, NewC, NewList, 0);
- {'ENUMERATED',NamedNumberList} ->
- NewList = [X || {X,_} <- NamedNumberList],
- NewC = {0,length(NewList)-1},
- emit(["case ",Value," of",nl]),
- emit_enc_enumerated_cases(Erules, NewC, NewList, 0);
-
'REAL' ->
emit_enc_real(Erules, Value);
{'BIT STRING',NamedNumberList} ->
- SizeConstr = get_constraint(Constraint, 'SizeConstraint'),
call(Erules, encode_bit_string,
[{asis,SizeConstr},Value,
{asis,NamedNumberList}]);
@@ -167,7 +150,7 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) ->
'BOOLEAN' ->
call(Erules, encode_boolean, [Value]);
'OCTET STRING' ->
- case get_constraint(Constraint, 'SizeConstraint') of
+ case SizeConstr of
0 ->
emit("[]");
no ->
@@ -176,34 +159,40 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) ->
call(Erules, encode_octet_string, [{asis,C},Value])
end;
'NumericString' ->
- call(Erules, encode_NumericString, [{asis,Constraint},Value]);
+ call(Erules, encode_NumericString, [{asis,SizeConstr},
+ {asis,Pa},Value]);
TString when TString == 'TeletexString';
TString == 'T61String' ->
call(Erules, encode_TeletexString, [{asis,Constraint},Value]);
'VideotexString' ->
call(Erules, encode_VideotexString, [{asis,Constraint},Value]);
'UTCTime' ->
- call(Erules, encode_VisibleString, [{asis,Constraint},Value]);
+ call(Erules, encode_VisibleString, [{asis,SizeConstr},
+ {asis,Pa},Value]);
'GeneralizedTime' ->
- call(Erules, encode_VisibleString, [{asis,Constraint},Value]);
+ call(Erules, encode_VisibleString, [{asis,SizeConstr},
+ {asis,Pa},Value]);
'GraphicString' ->
call(Erules, encode_GraphicString, [{asis,Constraint},Value]);
'VisibleString' ->
- call(Erules, encode_VisibleString, [{asis,Constraint},Value]);
+ call(Erules, encode_VisibleString, [{asis,SizeConstr},
+ {asis,Pa},Value]);
'GeneralString' ->
call(Erules, encode_GeneralString, [{asis,Constraint},Value]);
'PrintableString' ->
- call(Erules, encode_PrintableString, [{asis,Constraint},Value]);
+ call(Erules, encode_PrintableString, [{asis,SizeConstr},
+ {asis,Pa},Value]);
'IA5String' ->
- call(Erules, encode_IA5String, [{asis,Constraint},Value]);
+ call(Erules, encode_IA5String, [{asis,SizeConstr},
+ {asis,Pa},Value]);
'BMPString' ->
- call(Erules, encode_BMPString, [{asis,Constraint},Value]);
+ call(Erules, encode_BMPString, [{asis,SizeConstr},
+ {asis,Pa},Value]);
'UniversalString' ->
- call(Erules, encode_UniversalString, [{asis,Constraint},Value]);
+ call(Erules, encode_UniversalString, [{asis,SizeConstr},
+ {asis,Pa},Value]);
'UTF8String' ->
call(Erules, encode_UTF8String, [Value]);
- 'ANY' ->
- call(Erules, encode_open_type, [Value]);
'ASN1_OPEN_TYPE' ->
NewValue = case Constraint of
[#'Externaltypereference'{type=Tname}] ->
@@ -215,18 +204,11 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) ->
io_lib:format(
"complete(enc_~s(~s))",
[Tname,Value]);
- _ -> Value
+ _ ->
+ io_lib:format("iolist_to_binary(~s)",
+ [Value])
end,
- call(Erules, encode_open_type, [NewValue]);
- #'ObjectClassFieldType'{} ->
- case asn1ct_gen:get_inner(D#type.def) of
- {fixedtypevaluefield,_,InnerType} ->
- gen_encode_prim(Erules,InnerType,DoTag,Value);
- T -> %% 'ASN1_OPEN_TYPE'
- gen_encode_prim(Erules,D#type{def=T},DoTag,Value)
- end;
- XX ->
- exit({asn1_error,nyi,XX})
+ call(Erules, encode_open_type, [NewValue])
end.
emit_enc_real(Erules, Real) ->
@@ -271,16 +253,6 @@ enc_ext_and_val(uper, E, F, Args) ->
<<E:1,(apply(asn1ct_eval_uper, F, Args))/bitstring>>.
-get_constraint([{Key,V}], Key) ->
- V;
-get_constraint([], _) ->
- no;
-get_constraint(C, Key) ->
- case lists:keyfind(Key, 1, C) of
- false -> no;
- {Key,V} -> V
- end.
-
%% Object code generating for encoding and decoding
%% ------------------------------------------------
@@ -301,17 +273,16 @@ gen_obj_code(Erules,_Module,Obj) when is_record(Obj,typedef) ->
gen_encode_constr_type(Erules,EncConstructed),
emit(nl),
DecConstructed =
- gen_decode_objectfields(ClassName,get_class_fields(Class),
- ObjName,Fields,[]),
+ gen_decode_objectfields(Erules, ClassName, get_class_fields(Class),
+ ObjName, Fields, []),
emit(nl),
gen_decode_constr_type(Erules,DecConstructed),
- emit(nl);
-gen_obj_code(_,_,Obj) when is_record(Obj,pobjectdef) ->
- ok.
+ emit(nl).
-gen_encode_objectfields(Erule,ClassName,[{typefield,Name,OptOrMand}|Rest],
- ObjName,ObjectFields,ConstrAcc) ->
+gen_encode_objectfields(Erule, ClassName,
+ [{typefield,Name,OptOrMand}|Rest],
+ ObjName, ObjectFields, ConstrAcc) ->
EmitFuncClause =
fun(V) ->
emit(["'enc_",ObjName,"'(",{asis,Name},
@@ -329,18 +300,24 @@ gen_encode_objectfields(Erule,ClassName,[{typefield,Name,OptOrMand}|Rest],
case Erule of
uper ->
emit(" Val");
- _ ->
- emit(" [{octets,Val}]")
+ per ->
+ emit([" if",nl,
+ " is_list(Val) ->",nl,
+ " NewVal = list_to_binary(Val),",nl,
+ " [20,byte_size(NewVal),NewVal];",nl,
+ " is_binary(Val) ->",nl,
+ " [20,byte_size(Val),Val]",nl,
+ " end"])
end,
[];
{false,{'DEFAULT',DefaultType}} ->
EmitFuncClause("Val"),
- gen_encode_default_call(ClassName,Name,DefaultType);
+ gen_encode_default_call(Erule, ClassName, Name, DefaultType);
{{Name,TypeSpec},_} ->
%% A specified field owerwrites any 'DEFAULT' or
%% 'OPTIONAL' field in the class
EmitFuncClause("Val"),
- gen_encode_field_call(ObjName,Name,TypeSpec)
+ gen_encode_field_call(Erule, ObjName, Name, TypeSpec)
end,
case more_genfields(Rest) of
true ->
@@ -416,7 +393,7 @@ gen_encode_constr_type(Erules,[TypeDef|Rest]) when is_record(TypeDef,typedef) ->
gen_encode_constr_type(_,[]) ->
ok.
-gen_encode_field_call(_ObjName,_FieldName,
+gen_encode_field_call(_Erules, _ObjName, _FieldName,
#'Externaltypereference'{module=M,type=T}) ->
CurrentMod = get(currmod),
if
@@ -427,12 +404,11 @@ gen_encode_field_call(_ObjName,_FieldName,
emit({" '",M,"':'enc_",T,"'(Val)"}),
[]
end;
-gen_encode_field_call(ObjName,FieldName,Type) ->
+gen_encode_field_call(Erules, ObjName, FieldName, Type) ->
Def = Type#typedef.typespec,
case Type#typedef.name of
{primitive,bif} ->
- gen_encode_prim(uper,Def,"false",
- "Val"),
+ gen_encode_prim(Erules, Def, "Val"),
[];
{constructed,bif} ->
emit({" 'enc_",ObjName,'_',FieldName,
@@ -448,7 +424,7 @@ gen_encode_field_call(ObjName,FieldName,Type) ->
[]
end.
-gen_encode_default_call(ClassName,FieldName,Type) ->
+gen_encode_default_call(Erules, ClassName, FieldName, Type) ->
CurrentMod = get(currmod),
InnerType = asn1ct_gen:get_inner(Type#type.def),
case asn1ct_gen:type(InnerType) of
@@ -459,7 +435,7 @@ gen_encode_default_call(ClassName,FieldName,Type) ->
[#typedef{name=[FieldName,ClassName],
typespec=Type}];
{primitive,bif} ->
- gen_encode_prim(per,Type,"false","Val"),
+ gen_encode_prim(Erules, Type, "Val"),
[];
#'Externaltypereference'{module=CurrentMod,type=Etype} ->
emit([" 'enc_",Etype,"'(Val)",nl]),
@@ -470,8 +446,9 @@ gen_encode_default_call(ClassName,FieldName,Type) ->
end.
-gen_decode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest],
- ObjName,ObjectFields,ConstrAcc) ->
+gen_decode_objectfields(Erules, ClassName,
+ [{typefield,Name,OptOrMand}|Rest],
+ ObjName, ObjectFields, ConstrAcc) ->
EmitFuncClause =
fun(Bytes) ->
emit(["'dec_",ObjName,"'(",{asis,Name},",",Bytes,
@@ -488,12 +465,13 @@ gen_decode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest],
[];
{false,{'DEFAULT',DefaultType}} ->
EmitFuncClause("Bytes"),
- gen_decode_default_call(ClassName,Name,"Bytes",DefaultType);
+ gen_decode_default_call(Erules, ClassName, Name, "Bytes",
+ DefaultType);
{{Name,TypeSpec},_} ->
%% A specified field owerwrites any 'DEFAULT' or
%% 'OPTIONAL' field in the class
EmitFuncClause("Bytes"),
- gen_decode_field_call(ObjName,Name,"Bytes",TypeSpec)
+ gen_decode_field_call(Erules, ObjName, Name, "Bytes", TypeSpec)
end,
case more_genfields(Rest) of
true ->
@@ -501,9 +479,11 @@ gen_decode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest],
false ->
emit([".",nl])
end,
- gen_decode_objectfields(ClassName,Rest,ObjName,ObjectFields,MaybeConstr++ConstrAcc);
-gen_decode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest],
- ObjName,ObjectFields,ConstrAcc) ->
+ gen_decode_objectfields(Erules, ClassName, Rest, ObjName,
+ ObjectFields, MaybeConstr++ConstrAcc);
+gen_decode_objectfields(Erules, ClassName,
+ [{objectfield,Name,_,_,OptOrMand}|Rest],
+ ObjName, ObjectFields, ConstrAcc) ->
CurrentMod = get(currmod),
EmitFuncClause =
fun(Attrs) ->
@@ -546,30 +526,25 @@ gen_decode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest],
false ->
emit([".",nl])
end,
- gen_decode_objectfields(ClassName,Rest,ObjName,ObjectFields,ConstrAcc);
-gen_decode_objectfields(CN,[_C|Cs],O,OF,CAcc) ->
- gen_decode_objectfields(CN,Cs,O,OF,CAcc);
-gen_decode_objectfields(_,[],_,_,CAcc) ->
+ gen_decode_objectfields(Erules, ClassName, Rest, ObjName,
+ ObjectFields, ConstrAcc);
+gen_decode_objectfields(Erules, CN, [_C|Cs], O, OF, CAcc) ->
+ gen_decode_objectfields(Erules, CN, Cs, O, OF, CAcc);
+gen_decode_objectfields(_, _, [], _, _, CAcc) ->
CAcc.
-gen_decode_field_call(_ObjName,_FieldName,Bytes,
- #'Externaltypereference'{module=M,type=T}) ->
- CurrentMod = get(currmod),
- if
- M == CurrentMod ->
- emit([" 'dec_",T,"'(",Bytes,", telltype)"]),
- [];
- true ->
- emit([" '",M,"':'dec_",T,"'(",Bytes,", telltype)"]),
- []
- end;
-gen_decode_field_call(ObjName,FieldName,Bytes,Type) ->
+gen_decode_field_call(_Erules, _ObjName, _FieldName, Bytes,
+ #'Externaltypereference'{}=Etype) ->
+ emit(" "),
+ gen_dec_external(Etype, Bytes),
+ [];
+gen_decode_field_call(Erules, ObjName, FieldName, Bytes, Type) ->
Def = Type#typedef.typespec,
case Type#typedef.name of
{primitive,bif} ->
- gen_dec_prim(uper, Def, Bytes),
+ gen_dec_prim(Erules, Def, Bytes),
[];
{constructed,bif} ->
emit({" 'dec_",ObjName,'_',FieldName,
@@ -585,8 +560,7 @@ gen_decode_field_call(ObjName,FieldName,Bytes,Type) ->
[]
end.
-gen_decode_default_call(ClassName,FieldName,Bytes,Type) ->
- CurrentMod = get(currmod),
+gen_decode_default_call(Erules, ClassName, FieldName, Bytes, Type) ->
InnerType = asn1ct_gen:get_inner(Type#type.def),
case asn1ct_gen:type(InnerType) of
{constructed,bif} ->
@@ -595,13 +569,10 @@ gen_decode_default_call(ClassName,FieldName,Bytes,Type) ->
[#typedef{name=[FieldName,ClassName],
typespec=Type}];
{primitive,bif} ->
- gen_dec_prim(per,Type,Bytes),
+ gen_dec_prim(Erules, Type, Bytes),
[];
- #'Externaltypereference'{module=CurrentMod,type=Etype} ->
- emit([" 'dec_",Etype,"'(",Bytes,", telltype)",nl]),
- [];
- #'Externaltypereference'{module=Emod,type=Etype} ->
- emit([" '",Emod,"':'dec_",Etype,"'(",Bytes,", telltype)",nl]),
+ #'Externaltypereference'{}=Etype ->
+ asn1ct_gen_per:gen_dec_external(Etype, Bytes),
[]
end.
@@ -657,7 +628,7 @@ gen_objset_code(Erules,ObjSetName,UniqueFName,Set,ClassName,ClassDef)->
ClassFields = (ClassDef#classdef.typespec)#objectclass.fields,
InternalFuncs=
gen_objset_enc(Erules,ObjSetName,UniqueFName,Set,ClassName,ClassFields,1,[]),
- gen_objset_dec(ObjSetName,UniqueFName,Set,ClassName,ClassFields,1),
+ gen_objset_dec(Erules, ObjSetName,UniqueFName,Set,ClassName,ClassFields,1),
gen_internal_funcs(Erules,InternalFuncs).
%% gen_objset_enc iterates over the objects of the object set
@@ -665,67 +636,56 @@ gen_objset_enc(_,_,{unique,undefined},_,_,_,_,_) ->
%% There is no unique field in the class of this object set
%% don't bother about the constraint
[];
-gen_objset_enc(Erule,ObjSName,UniqueName,[{ObjName,Val,Fields},T|Rest],
- ClName,ClFields,NthObj,Acc)->
- emit({"'getenc_",ObjSName,"'(",{asis,UniqueName},",",{asis,Val},
- ") ->",nl}),
+gen_objset_enc(Erule, ObjSetName, UniqueName, [{ObjName,Val,Fields}|T],
+ ClName, ClFields, NthObj, Acc)->
+ emit(["'getenc_",ObjSetName,"'(",{asis,UniqueName},",",{asis,Val},
+ ") ->",nl]),
CurrMod = get(currmod),
{InternalFunc,NewNthObj}=
case ObjName of
{no_mod,no_name} ->
- gen_inlined_enc_funs(Erule,Fields,ClFields,ObjSName,NthObj);
+ gen_inlined_enc_funs(Erule, Fields, ClFields,
+ ObjSetName, NthObj);
{CurrMod,Name} ->
emit({" fun 'enc_",Name,"'/3"}),
{[],0};
{ModName,Name} ->
emit_ext_encfun(ModName,Name),
-% emit([" {'",ModName,"', 'enc_",Name,"'}"]),
{[],0};
_Other ->
emit({" fun 'enc_",ObjName,"'/3"}),
{[],0}
end,
emit({";",nl}),
- gen_objset_enc(Erule,ObjSName,UniqueName,[T|Rest],ClName,ClFields,
- NewNthObj,InternalFunc ++ Acc);
-gen_objset_enc(Erule,ObjSetName,UniqueName,
- [{ObjName,Val,Fields}],_ClName,ClFields,NthObj,Acc) ->
-
- emit({"'getenc_",ObjSetName,"'(",{asis,UniqueName},",",
- {asis,Val},") ->",nl}),
- CurrMod = get(currmod),
- {InternalFunc,_}=
- case ObjName of
- {no_mod,no_name} ->
- gen_inlined_enc_funs(Erule,Fields,ClFields,ObjSetName,NthObj);
- {CurrMod,Name} ->
- emit({" fun 'enc_",Name,"'/3"}),
- {[],NthObj};
- {ModName,Name} ->
- emit_ext_encfun(ModName,Name),
-% emit([" {'",ModName,"', 'enc_",Name,"'}"]),
- {[],NthObj};
- _Other ->
- emit({" fun 'enc_",ObjName,"'/3"}),
- {[],NthObj}
- end,
- emit([";",nl]),
- emit_default_getenc(ObjSetName,UniqueName),
- emit({".",nl,nl}),
- InternalFunc++Acc;
-gen_objset_enc(Erule,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName,
- _ClFields,_NthObj,Acc) ->
+ gen_objset_enc(Erule, ObjSetName, UniqueName, T, ClName, ClFields,
+ NewNthObj, InternalFunc ++ Acc);
+gen_objset_enc(uper, ObjSetName, _UniqueName, ['EXTENSIONMARK'],
+ _ClName, _ClFields, _NthObj, Acc) ->
emit({"'getenc_",ObjSetName,"'(_, _) ->",nl}),
emit({indent(3),"fun(_, Val, _) ->",nl}),
- case Erule of
- uper ->
- emit([indent(6),"Val",nl]);
- _ ->
- emit([indent(6),"[{octets,Val}]",nl])
- end,
- emit({indent(3),"end.",nl,nl}),
+ emit([indent(6),"Val",nl,
+ indent(3),"end.",nl,nl]),
+ Acc;
+gen_objset_enc(per, ObjSetName, _UniqueName, ['EXTENSIONMARK'],
+ _ClName, _ClFields, _NthObj, Acc) ->
+ emit(["'getenc_",ObjSetName,"'(_, _) ->",nl,
+ indent(3),"fun(_, Val, _) ->",nl,
+ indent(6),"BinVal = if",nl,
+ indent(9),"is_list(Val) -> list_to_binary(Val);",nl,
+ indent(9),"true -> Val",nl,
+ indent(6),"end,",nl,
+ indent(6),"Size = byte_size(BinVal),",nl,
+ indent(6),"if",nl,
+ indent(9),"Size < 256 ->",nl,
+ indent(12),"[20,Size,BinVal];",nl,
+ indent(9),"true ->",nl,
+ indent(12),"[21,<<Size:16>>,Val]",nl,
+ indent(6),"end",nl,
+ indent(3),"end.",nl,nl]),
Acc;
-gen_objset_enc(_,_,_,[],_,_,_,Acc) ->
+gen_objset_enc(_, ObjSetName, UniqueName, [], _, _, _, Acc) ->
+ emit_default_getenc(ObjSetName, UniqueName),
+ emit([".",nl,nl]),
Acc.
emit_ext_encfun(ModuleName,Name) ->
@@ -740,97 +700,70 @@ emit_default_getenc(ObjSetName,UniqueName) ->
%% gen_inlined_enc_funs for each object iterates over all fields of a
%% class, and for each typefield it checks if the object has that
%% field and emits the proper code.
-gen_inlined_enc_funs(Erule,Fields,[{typefield,Name,_}|Rest],ObjSetName,NthObj) ->
- CurrMod = get(currmod),
- InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]),
- case lists:keysearch(Name,1,Fields) of
- {value,{_,Type}} when is_record(Type,type) ->
- emit({indent(3),"fun(Type, Val, _) ->",nl,
- indent(6),"case Type of",nl}),
- {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName),
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj+N,Ret);
- {value,{_,Type}} when is_record(Type,typedef) ->
- emit({indent(3),"fun(Type, Val, _) ->",nl,
- indent(6),"case Type of",nl}),
- emit({indent(9),{asis,Name}," ->",nl}),
- {Ret,N} = emit_inner_of_fun(Type,InternalDefFunName),
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj+N,Ret);
- {value,{_,#'Externaltypereference'{module=CurrMod,type=T}}} ->
- emit({indent(3),"fun(Type, Val, _) ->",nl,
- indent(6),"case Type of",nl}),
- emit({indent(9),{asis,Name}," ->",nl}),
- emit([indent(12),"'enc_",T,"'(Val)"]),
-% {Ret,N} = emit_inner_of_fun(TDef,InternalDefFunName),
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,[]);
- {value,{_,#'Externaltypereference'{module=M,type=T}}} ->
- emit({indent(3),"fun(Type, Val, _) ->",nl,
- indent(6),"case Type of",nl}),
- emit({indent(9),{asis,Name}," ->",nl}),
- emit([indent(12),"'",M,"'",":'enc_",T,"'(Val)"]),
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,[]);
- false when Erule =:= uper ->
- emit([indent(3),"fun(Type,Val,_) ->",nl,
- indent(6),"case Type of",nl,
- indent(9),{asis,Name}," -> Val",nl]),
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,[]);
- false ->
- emit([indent(3),"fun(Type,Val,_) ->",nl,
- indent(6),"case Type of",nl,
- indent(9),{asis,Name}," -> [{octets,Val}]",nl]),
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,[])
- end;
+gen_inlined_enc_funs(Erule, Fields, [{typefield,_,_}|_]=T,
+ ObjSetName, NthObj) ->
+ emit([indent(3),"fun(Type, Val, _) ->",nl,
+ indent(6),"case Type of",nl]),
+ gen_inlined_enc_funs1(Erule, Fields, T, ObjSetName, [], NthObj, []);
gen_inlined_enc_funs(Erule,Fields,[_H|Rest],ObjSetName,NthObj) ->
gen_inlined_enc_funs(Erule,Fields,Rest,ObjSetName,NthObj);
gen_inlined_enc_funs(_,_,[],_,NthObj) ->
{[],NthObj}.
-gen_inlined_enc_funs1(Erule,Fields,[{typefield,Name,_}|Rest],ObjSetName,
- NthObj,Acc) ->
+gen_inlined_enc_funs1(Erule, Fields, [{typefield,Name,_}|Rest], ObjSetName,
+ Sep0, NthObj, Acc0) ->
+ emit(Sep0),
+ Sep = [";",nl],
CurrentMod = get(currmod),
InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]),
- {Acc2,NAdd}=
- case lists:keysearch(Name,1,Fields) of
- {value,{_,Type}} when is_record(Type,type) ->
- emit({";",nl}),
- {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName),
- {Ret++Acc,N};
- {value,{_,Type}} when is_record(Type,typedef) ->
- emit({";",nl,indent(9),{asis,Name}," ->",nl}),
- {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName),
- {Ret++Acc,N};
- {value,{_,#'Externaltypereference'{module=CurrentMod,type=T}}} ->
- emit({";",nl,indent(9),{asis,Name}," ->",nl}),
- emit([indent(12),"'enc_",T,"'(Val)"]),
- {Acc,0};
- {value,{_,#'Externaltypereference'{module=M,type=T}}} ->
- emit({";",nl,indent(9),{asis,Name}," ->",nl}),
- emit([indent(12),"'",M,"'",":'enc_",T,"'(Val)"]),
- {Acc,0};
+ {Acc,NAdd} =
+ case lists:keyfind(Name, 1, Fields) of
+ {_,#type{}=Type} ->
+ {Ret,N} = emit_inner_of_fun(Erule, Type, InternalDefFunName),
+ {Ret++Acc0,N};
+ {_,#typedef{}=Type} ->
+ emit([indent(9),{asis,Name}," ->",nl]),
+ {Ret,N} = emit_inner_of_fun(Erule, Type, InternalDefFunName),
+ {Ret++Acc0,N};
+ {_,#'Externaltypereference'{module=CurrentMod,type=T}} ->
+ emit([indent(9),{asis,Name}," ->",nl,
+ indent(12),"'enc_",T,"'(Val)"]),
+ {Acc0,0};
+ {_,#'Externaltypereference'{module=M,type=T}} ->
+ emit([indent(9),{asis,Name}," ->",nl,
+ indent(12),"'",M,"'",":'enc_",T,"'(Val)"]),
+ {Acc0,0};
false when Erule =:= uper ->
- emit([";",nl,
- indent(9),{asis,Name}," -> ",nl,
- "Val",nl]),
- {Acc,0};
- false ->
- emit([";",nl,
- indent(9),{asis,Name}," -> ",nl,
- "[{octets,Val}]",nl]),
- {Acc,0}
+ emit([indent(9),{asis,Name}," ->",nl,
+ indent(12),"Val",nl]),
+ {Acc0,0};
+ false when Erule =:= per ->
+ emit([indent(9),{asis,Name}," ->",nl,
+ indent(12),"Size = case Val of",nl,
+ indent(15),"B when is_binary(B) -> size(B);",nl,
+ indent(15),"_ -> length(Val)",nl,
+ indent(12),"end,",nl,
+ indent(12),"if",nl,
+ indent(15),"Size < 256 -> [20,Size,Val];",nl,
+ indent(15),"true -> [21,<<Size:16>>,Val]",nl,
+ indent(12),"end"]),
+ {Acc0,0}
end,
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj+NAdd,Acc2);
-gen_inlined_enc_funs1(Erule,Fields,[_H|Rest],ObjSetName,NthObj,Acc)->
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,Acc);
-gen_inlined_enc_funs1(_,_,[],_,NthObj,Acc) ->
- emit({nl,indent(6),"end",nl}),
- emit({indent(3),"end"}),
+ gen_inlined_enc_funs1(Erule, Fields, Rest, ObjSetName, Sep,
+ NthObj+NAdd, Acc);
+gen_inlined_enc_funs1(Erule, Fields, [_|T], ObjSetName, Sep, NthObj, Acc)->
+ gen_inlined_enc_funs1(Erule, Fields, T, ObjSetName, Sep, NthObj, Acc);
+gen_inlined_enc_funs1(_, _, [], _, _, NthObj, Acc) ->
+ emit([nl,indent(6),"end",nl,
+ indent(3),"end"]),
{Acc,NthObj}.
-emit_inner_of_fun(TDef=#typedef{name={ExtMod,Name},typespec=Type},
+emit_inner_of_fun(Erule, #typedef{name={ExtMod,Name},typespec=Type}=TDef,
InternalDefFunName) ->
case {ExtMod,Name} of
{primitive,bif} ->
emit(indent(12)),
- gen_encode_prim(uper,Type,dotag,"Val"),
+ gen_encode_prim(Erule, Type, "Val"),
{[],0};
{constructed,bif} ->
emit([indent(12),"'enc_",
@@ -840,18 +773,15 @@ emit_inner_of_fun(TDef=#typedef{name={ExtMod,Name},typespec=Type},
emit({indent(12),"'",ExtMod,"':'enc_",Name,"'(Val)"}),
{[],0}
end;
-emit_inner_of_fun(#typedef{name=Name},_) ->
+emit_inner_of_fun(_Erule, #typedef{name=Name}, _) ->
emit({indent(12),"'enc_",Name,"'(Val)"}),
{[],0};
-emit_inner_of_fun(Type,_) when is_record(Type,type) ->
+emit_inner_of_fun(Erule, #type{}=Type, _) ->
CurrMod = get(currmod),
case Type#type.def of
Def when is_atom(Def) ->
emit({indent(9),Def," ->",nl,indent(12)}),
- gen_encode_prim(erules,Type,dotag,"Val");
- TRef when is_record(TRef,typereference) ->
- T = TRef#typereference.val,
- emit({indent(9),T," ->",nl,indent(12),"'enc_",T,"'(Val)"});
+ gen_encode_prim(Erule, Type, "Val");
#'Externaltypereference'{module=CurrMod,type=T} ->
emit({indent(9),T," ->",nl,indent(12),"'enc_",T,"'(Val)"});
#'Externaltypereference'{module=ExtMod,type=T} ->
@@ -864,62 +794,42 @@ indent(N) ->
lists:duplicate(N,32). % 32 = space
-gen_objset_dec(_,{unique,undefined},_,_,_,_) ->
+gen_objset_dec(_, _, {unique,undefined}, _, _, _, _) ->
%% There is no unique field in the class of this object set
%% don't bother about the constraint
ok;
-gen_objset_dec(ObjSName,UniqueName,[{ObjName,Val,Fields},T|Rest],ClName,
- ClFields,NthObj)->
-
+gen_objset_dec(Erule, ObjSName, UniqueName, [{ObjName,Val,Fields}|T], ClName,
+ ClFields, NthObj)->
emit({"'getdec_",ObjSName,"'(",{asis,UniqueName},",",{asis,Val},
") ->",nl}),
CurrMod = get(currmod),
NewNthObj=
case ObjName of
{no_mod,no_name} ->
- gen_inlined_dec_funs(Fields,ClFields,ObjSName,NthObj);
+ gen_inlined_dec_funs(Erule, Fields, ClFields,
+ ObjSName, NthObj);
{CurrMod,Name} ->
emit([" fun 'dec_",Name,"'/4"]),
NthObj;
{ModName,Name} ->
emit_ext_decfun(ModName,Name),
-% emit([" {'",ModName,"', 'dec_",Name,"'}"]),
NthObj;
_Other ->
emit({" fun 'dec_",ObjName,"'/4"}),
NthObj
end,
emit({";",nl}),
- gen_objset_dec(ObjSName,UniqueName,[T|Rest],ClName,ClFields,NewNthObj);
-gen_objset_dec(ObjSetName,UniqueName,[{ObjName,Val,Fields}],_ClName,
- ClFields,NthObj) ->
-
- emit({"'getdec_",ObjSetName,"'(",{asis,UniqueName},",",{asis,Val},
- ") ->",nl}),
- CurrMod=get(currmod),
- case ObjName of
- {no_mod,no_name} ->
- gen_inlined_dec_funs(Fields,ClFields,ObjSetName,NthObj);
- {CurrMod,Name} ->
- emit([" fun 'dec_",Name,"'/4"]);
- {ModName,Name} ->
- emit_ext_decfun(ModName,Name);
-% emit([" {'",ModName,"', 'dec_",Name,"'}"]);
- _Other ->
- emit({" fun 'dec_",ObjName,"'/4"})
- end,
- emit([";",nl]),
- emit_default_getdec(ObjSetName,UniqueName),
- emit({".",nl,nl}),
- ok;
-gen_objset_dec(ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName,_ClFields,
- _NthObj) ->
+ gen_objset_dec(Erule, ObjSName, UniqueName, T, ClName, ClFields, NewNthObj);
+gen_objset_dec(_Erule, ObjSetName, _UniqueName, ['EXTENSIONMARK'],
+ _ClName, _ClFields, _NthObj) ->
emit({"'getdec_",ObjSetName,"'(_, _) ->",nl}),
emit({indent(3),"fun(Attr1, Bytes, _,_) ->",nl}),
emit({indent(6),"{Bytes,Attr1}",nl}),
emit({indent(3),"end.",nl,nl}),
ok;
-gen_objset_dec(_,_,[],_,_,_) ->
+gen_objset_dec(_Erule, ObjSetName, UniqueName, [], _, _, _) ->
+ emit_default_getdec(ObjSetName, UniqueName),
+ emit([".",nl,nl]),
ok.
emit_ext_decfun(ModuleName,Name) ->
@@ -931,49 +841,46 @@ emit_default_getdec(ObjSetName,UniqueName) ->
emit([indent(2), "fun(C,V,_,_) -> exit({{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},",ErrV}}) end"]).
-gen_inlined_dec_funs(Fields, List, ObjSetName, NthObj0) ->
+gen_inlined_dec_funs(Erule, Fields, List, ObjSetName, NthObj0) ->
emit([indent(3),"fun(Type, Val, _, _) ->",nl,
indent(6),"case Type of",nl]),
- NthObj = gen_inlined_dec_funs1(Fields, List, ObjSetName, "", NthObj0),
+ NthObj = gen_inlined_dec_funs1(Erule, Fields, List,
+ ObjSetName, "", NthObj0),
emit([nl,indent(6),"end",nl,
indent(3),"end"]),
NthObj.
-gen_inlined_dec_funs1(Fields, [{typefield,Name,_}|Rest],
+gen_inlined_dec_funs1(Erule, Fields, [{typefield,Name,_}|Rest],
ObjSetName, Sep0, NthObj) ->
- CurrentMod = get(currmod),
InternalDefFunName = [NthObj,Name,ObjSetName],
emit(Sep0),
Sep = [";",nl],
N = case lists:keyfind(Name, 1, Fields) of
{_,#type{}=Type} ->
- emit_inner_of_decfun(Type, InternalDefFunName);
+ emit_inner_of_decfun(Erule, Type, InternalDefFunName);
{_,#typedef{}=Type} ->
emit([indent(9),{asis,Name}," ->",nl]),
- emit_inner_of_decfun(Type, InternalDefFunName);
- {_,#'Externaltypereference'{module=CurrentMod,type=T}} ->
+ emit_inner_of_decfun(Erule, Type, InternalDefFunName);
+ {_,#'Externaltypereference'{}=Etype} ->
emit([indent(9),{asis,Name}," ->",nl,
- indent(12),"'dec_",T,"'(Val,telltype)"]),
- 0;
- {_,#'Externaltypereference'{module=M,type=T}} ->
- emit([indent(9),{asis,Name}," ->",nl,
- indent(12),"'",M,"':'dec_",T,"'(Val,telltype)"]),
+ indent(12)]),
+ gen_dec_external(Etype, "Val"),
0;
false ->
emit([indent(9),{asis,Name}," -> {Val,Type}"]),
0
end,
- gen_inlined_dec_funs1(Fields, Rest, ObjSetName, Sep, NthObj+N);
-gen_inlined_dec_funs1(Fields, [_|Rest], ObjSetName, Sep, NthObj) ->
- gen_inlined_dec_funs1(Fields, Rest, ObjSetName, Sep, NthObj);
-gen_inlined_dec_funs1(_, [], _, _, NthObj) -> NthObj.
+ gen_inlined_dec_funs1(Erule, Fields, Rest, ObjSetName, Sep, NthObj+N);
+gen_inlined_dec_funs1(Erule, Fields, [_|Rest], ObjSetName, Sep, NthObj) ->
+ gen_inlined_dec_funs1(Erule, Fields, Rest, ObjSetName, Sep, NthObj);
+gen_inlined_dec_funs1(_, _, [], _, _, NthObj) -> NthObj.
-emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type},
+emit_inner_of_decfun(Erule, #typedef{name={ExtName,Name},typespec=Type},
InternalDefFunName) ->
case {ExtName,Name} of
{primitive,bif} ->
emit(indent(12)),
- gen_dec_prim(uper, Type, "Val"),
+ gen_dec_prim(Erule, Type, "Val"),
0;
{constructed,bif} ->
emit({indent(12),"'dec_",
@@ -983,18 +890,15 @@ emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type},
emit({indent(12),"'",ExtName,"':'dec_",Name,"'(Val, telltype)"}),
0
end;
-emit_inner_of_decfun(#typedef{name=Name},_) ->
+emit_inner_of_decfun(_Erule, #typedef{name=Name}, _) ->
emit({indent(12),"'dec_",Name,"'(Val, telltype)"}),
0;
-emit_inner_of_decfun(Type,_) when is_record(Type,type) ->
+emit_inner_of_decfun(Erule, #type{}=Type, _) ->
CurrMod = get(currmod),
case Type#type.def of
Def when is_atom(Def) ->
emit({indent(9),Def," ->",nl,indent(12)}),
- gen_dec_prim(uper, Type, "Val");
- TRef when is_record(TRef,typereference) ->
- T = TRef#typereference.val,
- emit({indent(9),T," ->",nl,indent(12),"'dec_",T,"'(Val)"});
+ gen_dec_prim(Erule, Type, "Val");
#'Externaltypereference'{module=CurrMod,type=T} ->
emit({indent(9),T," ->",nl,indent(12),"'dec_",T,"'(Val)"});
#'Externaltypereference'{module=ExtMod,type=T} ->
@@ -1017,7 +921,6 @@ gen_internal_funcs(Erules,[TypeDef|Rest]) ->
%% DECODING *****************************
%%***************************************
-
gen_decode(Erules,Type) when is_record(Type,typedef) ->
D = Type,
emit({nl,nl}),
@@ -1054,7 +957,6 @@ dbdec(Type) ->
demit({"io:format(\"decoding: ",{asis,Type},"~w~n\",[Bytes]),",nl}).
gen_decode_user(Erules,D) when is_record(D,typedef) ->
- CurrMod = get(currmod),
Typename = [D#typedef.name],
Def = D#typedef.typespec,
InnerType = asn1ct_gen:get_inner(Def#type.def),
@@ -1067,17 +969,21 @@ gen_decode_user(Erules,D) when is_record(D,typedef) ->
emit({".",nl,nl});
{constructed,bif} ->
asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,D);
- #typereference{val=Dname} ->
- emit({"'dec_",Dname,"'(Bytes,telltype)"}),
- emit({".",nl,nl});
- #'Externaltypereference'{module=CurrMod,type=Etype} ->
- emit({"'dec_",Etype,"'(Bytes,telltype).",nl,nl});
- #'Externaltypereference'{module=Emod,type=Etype} ->
- emit({"'",Emod,"':'dec_",Etype,"'(Bytes,telltype).",nl,nl});
+ #'Externaltypereference'{}=Etype ->
+ gen_dec_external(Etype, "Bytes"),
+ emit([".",nl,nl]);
Other ->
exit({error,{asn1,{unknown,Other}}})
end.
+gen_dec_external(Ext, BytesVar) ->
+ CurrMod = get(currmod),
+ #'Externaltypereference'{module=Mod,type=Type} = Ext,
+ emit([case CurrMod of
+ Mod -> [];
+ _ -> ["'",Mod,"':"]
+ end,"'dec_",Type,"'(",BytesVar,",telltype)"]).
+
gen_dec_imm(Erule, #type{def=Name,constraint=C}) ->
Aligned = case Erule of
uper -> false;
@@ -1087,10 +993,8 @@ gen_dec_imm(Erule, #type{def=Name,constraint=C}) ->
gen_dec_imm_1('ASN1_OPEN_TYPE', Constraint, Aligned) ->
imm_decode_open_type(Constraint, Aligned);
-gen_dec_imm_1('ANY', _Constraint, Aligned) ->
- imm_decode_open_type([], Aligned);
gen_dec_imm_1({'BIT STRING',NNL}, Constr0, Aligned) ->
- Constr = get_constraint(Constr0, 'SizeConstraint'),
+ Constr = asn1ct_imm:effective_constraint(bitstring, Constr0),
Imm = asn1ct_imm:per_dec_raw_bitstring(Constr, Aligned),
case NNL of
[] ->
@@ -1143,7 +1047,7 @@ gen_dec_imm_1('UTCTime', Constraint, Aligned) ->
gen_dec_imm_1('GeneralizedTime', Constraint, Aligned) ->
gen_dec_k_m_string('VisibleString', Constraint, Aligned);
gen_dec_imm_1('OCTET STRING', Constraint, Aligned) ->
- SzConstr = get_constraint(Constraint, 'SizeConstraint'),
+ SzConstr = asn1ct_imm:effective_constraint(bitstring, Constraint),
Imm = asn1ct_imm:per_dec_octet_string(SzConstr, Aligned),
{convert,binary_to_list,Imm};
gen_dec_imm_1('TeletexString', _Constraint, Aligned) ->
@@ -1173,14 +1077,7 @@ gen_dec_imm_1('RELATIVE-OID', _Constraint, Aligned) ->
gen_dec_imm_1('UTF8String', _Constraint, Aligned) ->
asn1ct_imm:per_dec_restricted_string(Aligned);
gen_dec_imm_1('REAL', _Constraint, Aligned) ->
- asn1ct_imm:per_dec_real(Aligned);
-gen_dec_imm_1(#'ObjectClassFieldType'{}=TypeName, _Constraint, Aligned) ->
- case asn1ct_gen:get_inner(TypeName) of
- {fixedtypevaluefield,_,#type{def=InnerType,constraint=C}} ->
- gen_dec_imm_1(InnerType, C, Aligned);
- #type{def=T,constraint=C} ->
- gen_dec_imm_1(T, C, Aligned)
- end.
+ asn1ct_imm:per_dec_real(Aligned).
gen_dec_bit_string(F, Imm) ->
D = fun(V, Buf) ->
diff --git a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl
index 81d8cdcae6..012d54e7a1 100644
--- a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl
+++ b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl
@@ -19,105 +19,16 @@
%%
-module(asn1ct_gen_per_rt2ct).
-%% Generate erlang module which handles (PER) encode and decode for
-%% all types in an ASN.1 module
+%% Handle encoding of primitives for aligned PER.
-include("asn1_records.hrl").
-%-compile(export_all).
--export([pgen/4,gen_dec_prim/3,gen_encode_prim/4]).
--export([gen_obj_code/3,gen_objectset_code/2]).
--export([gen_decode/2, gen_decode/3]).
--export([gen_encode/2, gen_encode/3]).
--export([extaddgroup2sequence/1]).
+-export([gen_encode_prim/3]).
-import(asn1ct_gen, [emit/1,demit/1]).
--import(asn1ct_gen_per, [is_already_generated/2,more_genfields/1,
- get_class_fields/1,get_object_field/2]).
-import(asn1ct_func, [call/3]).
-%% pgen(Erules, Module, TypeOrVal)
-%% Generate Erlang module (.erl) and (.hrl) file corresponding to an ASN.1 module
-%% .hrl file is only generated if necessary
-%% Erules = per | ber
-%% Module = atom()
-%% TypeOrVal = {TypeList,ValueList}
-%% TypeList = ValueList = [atom()]
-
-pgen(OutFile,Erules,Module,TypeOrVal) ->
- asn1ct_gen:pgen_module(OutFile,Erules,Module,TypeOrVal,[],true).
-
-
-%% Generate ENCODING ******************************
-%%****************************************x
-
-
-gen_encode(Erules,Type) when is_record(Type,typedef) ->
- gen_encode_user(Erules,Type).
-
-gen_encode(Erules,Typename,#'ComponentType'{name=Cname,typespec=Type}) ->
- NewTypename = [Cname|Typename],
- gen_encode(Erules,NewTypename,Type);
-
-gen_encode(Erules,Typename,Type) when is_record(Type,type) ->
- InnerType = asn1ct_gen:get_inner(Type#type.def),
- ObjFun =
- case lists:keysearch(objfun,1,Type#type.tablecinf) of
- {value,{_,_Name}} ->
- ", ObjFun";
- false ->
- ""
- end,
- case asn1ct_gen:type(InnerType) of
- {constructed,bif} ->
- emit({"'enc_",asn1ct_gen:list2name(Typename),"'(Val",ObjFun,
- ") ->",nl}),
- asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,Type);
- _ ->
- true
- end.
-
-
-gen_encode_user(Erules,D) when is_record(D,typedef) ->
- CurrMod = get(currmod),
- Typename = [D#typedef.name],
- Def = D#typedef.typespec,
- InnerType = asn1ct_gen:get_inner(Def#type.def),
- emit({"'enc_",asn1ct_gen:list2name(Typename),"'(Val) ->",nl}),
- case asn1ct_gen:type(InnerType) of
- {primitive,bif} ->
- gen_encode_prim(Erules,Def,"false"),
- emit({".",nl});
- 'ASN1_OPEN_TYPE' ->
- gen_encode_prim(Erules,Def#type{def='ASN1_OPEN_TYPE'},"false"),
- emit({".",nl});
- {constructed,bif} ->
- asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,D);
- #'Externaltypereference'{module=CurrMod,type=Etype} ->
- emit({"'enc_",Etype,"'(Val).",nl,nl});
- #'Externaltypereference'{module=Emod,type=Etype} ->
- emit({"'",Emod,"':'enc_",Etype,"'(Val).",nl,nl});
- #typereference{val=Ename} ->
- emit({"'enc_",Ename,"'(Val).",nl,nl});
- {notype,_} ->
- emit({"'enc_",InnerType,"'(Val).",nl,nl})
- end.
-
-
-gen_encode_prim(Erules,D,DoTag) ->
- Value = case asn1ct_name:active(val) of
- true ->
- asn1ct_gen:mk_var(asn1ct_name:curr(val));
- false ->
- "Val"
- end,
- gen_encode_prim(Erules,D,DoTag,Value).
-
-
-
-
-
-gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) ->
+gen_encode_prim(Erules, #type{}=D, Value) ->
Constraint = D#type.constraint,
case D#type.def of
'INTEGER' ->
@@ -131,8 +42,6 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) ->
emit([" %%INTEGER with effective constraint: ",
{asis,EffectiveConstr},nl]),
emit_enc_integer_NNL(Erules,EffectiveConstr,Value,NamedNumberList);
- {'ENUMERATED',_} ->
- asn1ct_gen_per:gen_encode_prim(Erules, D, DoTag, Value);
'REAL' ->
emit_enc_real(Erules, Value);
@@ -191,8 +100,6 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) ->
emit_enc_known_multiplier_string('UniversalString',Constraint,Value);
'UTF8String' ->
call(Erules, encode_UTF8String, [Value]);
- 'ANY' ->
- call(Erules, encode_open_type, [Value]);
'ASN1_OPEN_TYPE' ->
NewValue = case Constraint of
[#'Externaltypereference'{type=Tname}] ->
@@ -204,18 +111,11 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) ->
io_lib:format(
"complete(enc_~s(~s))",
[Tname,Value]);
- _ -> Value
+ _ ->
+ io_lib:format("iolist_to_binary(~s)",
+ [Value])
end,
- call(Erules, encode_open_type, [NewValue]);
- #'ObjectClassFieldType'{} ->
- case asn1ct_gen:get_inner(D#type.def) of
- {fixedtypevaluefield,_,InnerType} ->
- gen_encode_prim(Erules,InnerType,DoTag,Value);
- T -> %% 'ASN1_OPEN_TYPE'
- gen_encode_prim(Erules,D#type{def=T},DoTag,Value)
- end;
- XX ->
- exit({asn1_error,nyi,XX})
+ call(Erules, encode_open_type, [NewValue])
end.
emit_enc_real(Erules, Real) ->
@@ -230,11 +130,7 @@ emit_enc_real(Erules, Real) ->
"end"]).
emit_enc_known_multiplier_string(StringType,C,Value) ->
- SizeC =
- case get_constraint(C,'SizeConstraint') of
- L when is_list(L) -> {lists:min(L),lists:max(L)};
- L -> L
- end,
+ SizeC = effective_constraint(bitstring, C),
PAlphabC = get_constraint(C,'PermittedAlphabet'),
case {StringType,PAlphabC} of
{'UniversalString',{_,_}} ->
@@ -359,7 +255,7 @@ charbits1(NumOfChars) ->
%% copied from run time module
emit_enc_octet_string(Erules, Constraint, Value) ->
- case get_constraint(Constraint,'SizeConstraint') of
+ case effective_constraint(bitstring, Constraint) of
0 ->
emit({" []"});
1 ->
@@ -408,7 +304,7 @@ emit_enc_octet_string(Erules, Constraint, Value) ->
" end"]);
C ->
call(Erules, encode_octet_string,
- [{asis,C},false,Value])
+ [{asis,C},Value])
end.
emit_enc_integer_case(Value) ->
@@ -563,825 +459,3 @@ no_bits(N) when N=<32 -> 5;
no_bits(N) when N=<64 -> 6;
no_bits(N) when N=<128 -> 7;
no_bits(N) when N=<255 -> 8.
-
-%% Object code generating for encoding and decoding
-%% ------------------------------------------------
-
-gen_obj_code(Erules,_Module,Obj) when is_record(Obj,typedef) ->
- ObjName = Obj#typedef.name,
- Def = Obj#typedef.typespec,
- #'Externaltypereference'{module=Mod,type=ClassName} =
- Def#'Object'.classname,
- Class = asn1_db:dbget(Mod,ClassName),
- {object,_,Fields} = Def#'Object'.def,
- emit({nl,nl,nl,"%%================================"}),
- emit({nl,"%% ",ObjName}),
- emit({nl,"%%================================",nl}),
- EncConstructed =
- gen_encode_objectfields(Erules,ClassName,get_class_fields(Class),
- ObjName,Fields,[]),
- emit(nl),
- gen_encode_constr_type(Erules,EncConstructed),
- emit(nl),
- DecConstructed =
- gen_decode_objectfields(ClassName,get_class_fields(Class),
- ObjName,Fields,[]),
- emit(nl),
- gen_decode_constr_type(Erules,DecConstructed),
- emit(nl);
-gen_obj_code(_Erules,_Module,Obj) when is_record(Obj,pobjectdef) ->
- ok.
-
-gen_encode_objectfields(Erules,ClassName,[{typefield,Name,OptOrMand}|Rest],
- ObjName,ObjectFields,ConstrAcc) ->
- EmitFuncClause =
- fun(V) ->
- emit(["'enc_",ObjName,"'(",{asis,Name},
- ",",V,",_RestPrimFieldName) ->",nl])
- end,
-
- MaybeConstr =
- case {get_object_field(Name,ObjectFields),OptOrMand} of
- {false,'MANDATORY'} -> %% this case is illegal
- exit({error,{asn1,{"missing mandatory field in object",
- ObjName}}});
- {false,'OPTIONAL'} ->
- EmitFuncClause("Val"),
- emit([" if",nl,
- " is_list(Val) ->",nl,
- " NewVal = list_to_binary(Val),",nl,
- " [20,byte_size(NewVal),NewVal];",nl,
- " is_binary(Val) ->",nl,
- " [20,byte_size(Val),Val]",nl,
- " end"]),
- [];
- {false,{'DEFAULT',DefaultType}} ->
- EmitFuncClause("Val"),
- gen_encode_default_call(Erules,ClassName,Name,DefaultType);
- {{Name,TypeSpec},_} ->
- %% A specified field owerwrites any 'DEFAULT' or
- %% 'OPTIONAL' field in the class
- EmitFuncClause("Val"),
- gen_encode_field_call(Erules,ObjName,Name,TypeSpec)
- end,
- case more_genfields(Rest) of
- true ->
- emit([";",nl]);
- false ->
- emit([".",nl])
- end,
- gen_encode_objectfields(Erules,ClassName,Rest,ObjName,ObjectFields,
- MaybeConstr++ConstrAcc);
-gen_encode_objectfields(Erules,ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest],
- ObjName,ObjectFields,ConstrAcc) ->
- CurrentMod = get(currmod),
- EmitFuncClause =
- fun(Attrs) ->
- emit(["'enc_",ObjName,"'(",{asis,Name},
- ",",Attrs,") ->",nl])
- end,
-% emit(["'enc_",ObjName,"'(",{asis,Name},
-% ", Val,[H|T]) ->",nl]),
- case {get_object_field(Name,ObjectFields),OptOrMand} of
- {false,'MANDATORY'} ->
- exit({error,{asn1,{"missing mandatory field in object",
- ObjName}}});
- {false,'OPTIONAL'} ->
- EmitFuncClause("_,_"),
- emit([" exit({error,{'use of missing field in object', ",{asis,Name},
- "}})"]);
- {false,{'DEFAULT',_DefaultObject}} ->
- exit({error,{asn1,{"not implemented yet",Name}}});
- {{Name,#'Externalvaluereference'{module=CurrentMod,
- value=TypeName}},_} ->
- EmitFuncClause(" Val, [H|T]"),
- emit({indent(3),"'enc_",TypeName,"'(H, Val, T)"});
- {{Name,#'Externalvaluereference'{module=M,value=TypeName}},_} ->
- EmitFuncClause(" Val, [H|T]"),
- emit({indent(3),"'",M,"':'enc_",TypeName,"'(H, Val, T)"});
- {{Name,TypeSpec},_} ->
- EmitFuncClause("Val,[H|T]"),
- case TypeSpec#typedef.name of
- {ExtMod,TypeName} ->
- emit({indent(3),"'",ExtMod,"':'enc_",TypeName,
- "'(H, Val, T)"});
- TypeName ->
- emit({indent(3),"'enc_",TypeName,"'(H, Val, T)"})
- end
- end,
- case more_genfields(Rest) of
- true ->
- emit([";",nl]);
- false ->
- emit([".",nl])
- end,
- gen_encode_objectfields(Erules,ClassName,Rest,ObjName,ObjectFields,ConstrAcc);
-gen_encode_objectfields(Erules,ClassName,[_C|Cs],O,OF,Acc) ->
- gen_encode_objectfields(Erules,ClassName,Cs,O,OF,Acc);
-gen_encode_objectfields(_Erules,_,[],_,_,Acc) ->
- Acc.
-
-
-
-gen_encode_constr_type(Erules,[TypeDef|Rest]) when is_record(TypeDef,typedef) ->
- case is_already_generated(enc,TypeDef#typedef.name) of
- true -> ok;
- _ ->
- Name = lists:concat(["enc_",TypeDef#typedef.name]),
- emit({Name,"(Val) ->",nl}),
- Def = TypeDef#typedef.typespec,
- InnerType = asn1ct_gen:get_inner(Def#type.def),
- asn1ct_gen:gen_encode_constructed(Erules,Name,InnerType,Def),
- gen_encode_constr_type(Erules,Rest)
- end;
-gen_encode_constr_type(_,[]) ->
- ok.
-
-gen_encode_field_call(_Erule,_ObjName,_FieldName,
- #'Externaltypereference'{module=M,type=T}) ->
- CurrentMod = get(currmod),
- if
- M == CurrentMod ->
- emit({" 'enc_",T,"'(Val)"}),
- [];
- true ->
- emit({" '",M,"':'enc_",T,"'(Val)"}),
- []
- end;
-gen_encode_field_call(Erule,ObjName,FieldName,Type) ->
- Def = Type#typedef.typespec,
- case Type#typedef.name of
- {primitive,bif} ->
- gen_encode_prim(Erule,Def,"false",
- "Val"),
- [];
- {constructed,bif} ->
- emit({" 'enc_",ObjName,'_',FieldName,
- "'(Val)"}),
- [Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}];
- {ExtMod,TypeName} ->
- emit({" '",ExtMod,"':'enc_",TypeName,
- "'(Val)"}),
- [];
- TypeName ->
- emit({" 'enc_",TypeName,"'(Val)"}),
- []
- end.
-
-gen_encode_default_call(Erules,ClassName,FieldName,Type) ->
- CurrentMod = get(currmod),
- InnerType = asn1ct_gen:get_inner(Type#type.def),
- case asn1ct_gen:type(InnerType) of
- {constructed,bif} ->
-%% asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,Type);
- emit([" 'enc_",ClassName,'_',FieldName,"'(Val)"]),
- [#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])),
- typespec=Type}];
- {primitive,bif} ->
- gen_encode_prim(Erules,Type,"false","Val"),
- [];
- #'Externaltypereference'{module=CurrentMod,type=Etype} ->
- emit([" 'enc_",Etype,"'(Val)",nl]),
- [];
- #'Externaltypereference'{module=Emod,type=Etype} ->
- emit([" '",Emod,"':'enc_",Etype,"'(Val)",nl]),
- []
- end.
-
-
-
-gen_decode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest],
- ObjName,ObjectFields,ConstrAcc) ->
- EmitFuncClause =
- fun(Bytes) ->
- emit(["'dec_",ObjName,"'(",{asis,Name},",",Bytes,
- ",_,_RestPrimFieldName) ->",nl])
- end,
-% emit(["'dec_",ObjName,"'(",{asis,Name},
-% ", Bytes, _, RestPrimFieldName) ->",nl]),
- MaybeConstr=
- case {get_object_field(Name,ObjectFields),OptOrMand} of
- {false,'MANDATORY'} -> %% this case is illegal
- exit({error,{asn1,{"missing mandatory field in object",
- ObjName}}});
- {false,'OPTIONAL'} ->
- EmitFuncClause("Bytes"),
- emit([" {Bytes,[]}"]),
- [];
- {false,{'DEFAULT',DefaultType}} ->
- EmitFuncClause("Bytes"),
- gen_decode_default_call(ClassName,Name,"Bytes",DefaultType);
- {{Name,TypeSpec},_} ->
- %% A specified field owerwrites any 'DEFAULT' or
- %% 'OPTIONAL' field in the class
- EmitFuncClause("Bytes"),
- gen_decode_field_call(ObjName,Name,"Bytes",TypeSpec)
- end,
- case more_genfields(Rest) of
- true ->
- emit([";",nl]);
- false ->
- emit([".",nl])
- end,
- gen_decode_objectfields(ClassName,Rest,ObjName,ObjectFields,MaybeConstr++ConstrAcc);
-gen_decode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest],
- ObjName,ObjectFields,ConstrAcc) ->
- CurrentMod = get(currmod),
- EmitFuncClause =
- fun(Attrs) ->
- emit(["'dec_",ObjName,"'(",{asis,Name},
- ",",Attrs,") ->",nl])
- end,
-% emit(["'dec_",ObjName,"'(",{asis,Name},
-% ", Bytes,_,[H|T]) ->",nl]),
- case {get_object_field(Name,ObjectFields),OptOrMand} of
- {false,'MANDATORY'} ->
- exit({error,{asn1,{"missing mandatory field in object",
- ObjName}}});
- {false,'OPTIONAL'} ->
- EmitFuncClause("_,_,_"),
- emit([" exit({error,{'illegal use of missing field in object', ",{asis,Name},
- "}})"]);
- {false,{'DEFAULT',_DefaultObject}} ->
- exit({error,{asn1,{"not implemented yet",Name}}});
- {{Name,#'Externalvaluereference'{module=CurrentMod,
- value=TypeName}},_} ->
- EmitFuncClause("Bytes,_,[H|T]"),
- emit({indent(3),"'dec_",TypeName,"'(H, Bytes, telltype, T)"});
- {{Name,#'Externalvaluereference'{module=M,value=TypeName}},_} ->
- EmitFuncClause("Bytes,_,[H|T]"),
- emit({indent(3),"'",M,"':'dec_",TypeName,
- "'(H, Bytes, telltype, T)"});
- {{Name,TypeSpec},_} ->
- EmitFuncClause("Bytes,_,[H|T]"),
- case TypeSpec#typedef.name of
- {ExtMod,TypeName} ->
- emit({indent(3),"'",ExtMod,"':'dec_",TypeName,
- "'(H, Bytes, telltype, T)"});
- TypeName ->
- emit({indent(3),"'dec_",TypeName,"'(H, Bytes, telltype, T)"})
- end
- end,
- case more_genfields(Rest) of
- true ->
- emit([";",nl]);
- false ->
- emit([".",nl])
- end,
- gen_decode_objectfields(ClassName,Rest,ObjName,ObjectFields,ConstrAcc);
-gen_decode_objectfields(CN,[_C|Cs],O,OF,CAcc) ->
- gen_decode_objectfields(CN,Cs,O,OF,CAcc);
-gen_decode_objectfields(_,[],_,_,CAcc) ->
- CAcc.
-
-
-gen_decode_field_call(_ObjName,_FieldName,Bytes,
- #'Externaltypereference'{module=M,type=T}) ->
- CurrentMod = get(currmod),
- if
- M == CurrentMod ->
- emit([" 'dec_",T,"'(",Bytes,", telltype)"]),
- [];
- true ->
- emit([" '",M,"':'dec_",T,"'(",Bytes,", telltype)"]),
- []
- end;
-gen_decode_field_call(ObjName,FieldName,Bytes,Type) ->
- Def = Type#typedef.typespec,
- case Type#typedef.name of
- {primitive,bif} ->
- gen_dec_prim(per,Def,Bytes),
- [];
- {constructed,bif} ->
- emit({" 'dec_",ObjName,'_',FieldName,
- "'(",Bytes,",telltype)"}),
- [Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}];
- {ExtMod,TypeName} ->
- emit({" '",ExtMod,"':'dec_",TypeName,
- "'(",Bytes,", telltype)"}),
- [];
- TypeName ->
- emit({" 'dec_",TypeName,"'(",Bytes,", telltype)"}),
- []
- end.
-
-gen_decode_default_call(ClassName,FieldName,Bytes,Type) ->
- CurrentMod = get(currmod),
- InnerType = asn1ct_gen:get_inner(Type#type.def),
- case asn1ct_gen:type(InnerType) of
- {constructed,bif} ->
- emit([" 'dec_",ClassName,'_',FieldName,"'(",Bytes,", telltype)"]),
- [#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])),
- typespec=Type}];
- {primitive,bif} ->
- gen_dec_prim(per,Type,Bytes),
- [];
- #'Externaltypereference'{module=CurrentMod,type=Etype} ->
- emit([" 'dec_",Etype,"'(",Bytes,", telltype)",nl]),
- [];
- #'Externaltypereference'{module=Emod,type=Etype} ->
- emit([" '",Emod,"':'dec_",Etype,"'(",Bytes,", telltype)",nl]),
- []
- end.
-
-%%%%%%%%%%%%%%%
-
-
-gen_decode_constr_type(Erules,[TypeDef|Rest]) when is_record(TypeDef,typedef) ->
- case is_already_generated(dec,TypeDef#typedef.name) of
- true -> ok;
- _ ->
- gen_decode(Erules,TypeDef)
- end,
- gen_decode_constr_type(Erules,Rest);
-gen_decode_constr_type(_,[]) ->
- ok.
-
-%% Object Set code generating for encoding and decoding
-%% ----------------------------------------------------
-gen_objectset_code(Erules,ObjSet) ->
- ObjSetName = ObjSet#typedef.name,
- Def = ObjSet#typedef.typespec,
-%% {ClassName,ClassDef} = Def#'ObjectSet'.class,
- #'Externaltypereference'{module=ClassModule,
- type=ClassName} = Def#'ObjectSet'.class,
- ClassDef = asn1_db:dbget(ClassModule,ClassName),
- UniqueFName = Def#'ObjectSet'.uniquefname,
- Set = Def#'ObjectSet'.set,
- emit({nl,nl,nl,"%%================================"}),
- emit({nl,"%% ",ObjSetName}),
- emit({nl,"%%================================",nl}),
- case ClassName of
- {_Module,ExtClassName} ->
- gen_objset_code(Erules,ObjSetName,UniqueFName,Set,
- ExtClassName,ClassDef);
- _ ->
- gen_objset_code(Erules,ObjSetName,UniqueFName,Set,
- ClassName,ClassDef)
- end,
- emit(nl).
-
-gen_objset_code(Erule,ObjSetName,UniqueFName,Set,ClassName,ClassDef)->
- ClassFields = (ClassDef#classdef.typespec)#objectclass.fields,
- InternalFuncs=
- gen_objset_enc(Erule,ObjSetName,UniqueFName,Set,ClassName,
- ClassFields,1,[]),
- gen_objset_dec(ObjSetName,UniqueFName,Set,ClassName,ClassFields,1),
- gen_internal_funcs(Erule,InternalFuncs).
-
-gen_objset_enc(_Erule,_,{unique,undefined},_,_,_,_,_) ->
- %% There is no unique field in the class of this object set
- %% don't bother about the constraint
- [];
-gen_objset_enc(Erule,ObjSName,UniqueName,[{ObjName,Val,Fields},T|Rest],
- ClName,ClFields,NthObj,Acc)->
- emit({"'getenc_",ObjSName,"'(",{asis,UniqueName},",",
- {asis,Val},") ->",nl}),
- CurrMod = get(currmod),
- {InternalFunc,NewNthObj}=
- case ObjName of
- {no_mod,no_name} ->
- gen_inlined_enc_funs(Erule,Fields,ClFields,ObjSName,NthObj);
- {CurrMod,Name} ->
- emit({" fun 'enc_",Name,"'/3"}),
- {[],NthObj};
- {ModName,Name} ->
- emit_ext_encfun(ModName,Name),
-% emit([" {'",ModName,"', 'enc_",Name,"'}"]),
- {[],NthObj};
- _ ->
- emit({" fun 'enc_",ObjName,"'/3"}),
- {[],NthObj}
- end,
- emit({";",nl}),
- gen_objset_enc(Erule,ObjSName,UniqueName,[T|Rest],ClName,ClFields,
- NewNthObj,InternalFunc++Acc);
-gen_objset_enc(Erule,ObjSetName,UniqueName,
- [{ObjName,Val,Fields}],_ClName,ClFields,NthObj,Acc) ->
-
- emit({"'getenc_",ObjSetName,"'(",{asis,UniqueName},",",
- {asis,Val},") ->",nl}),
- CurrMod = get(currmod),
- {InternalFunc,_}=
- case ObjName of
- {no_mod,no_name} ->
- gen_inlined_enc_funs(Erule,Fields,ClFields,ObjSetName,NthObj);
- {CurrMod,Name} ->
- emit({" fun 'enc_",Name,"'/3"}),
- {[],NthObj};
- {ModName,Name} ->
- emit_ext_encfun(ModName,Name),
-% emit([" {'",ModName,"', 'enc_",Name,"'}"]),
- {[],NthObj};
- _ ->
- emit({" fun 'enc_",ObjName,"'/3"}),
- {[],NthObj}
- end,
- emit([";",nl]),
- emit_default_getenc(ObjSetName,UniqueName),
- emit({".",nl,nl}),
- InternalFunc++Acc;
-gen_objset_enc(_Erule,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName,
- _ClFields,_NthObj,Acc) ->
- emit({"'getenc_",ObjSetName,"'(_, _) ->",nl}),
- emit({indent(3),"fun(_, Val, _) ->",nl}),
- emit({indent(6),"BinVal = if",nl}),
- emit({indent(9),"is_list(Val) -> list_to_binary(Val);",nl}),
- emit({indent(9),"true -> Val",nl}),
- emit({indent(6),"end,",nl}),
- emit({indent(6),"Size = byte_size(BinVal),",nl}),
- emit({indent(6),"if",nl}),
- emit({indent(9),"Size < 256 ->",nl}),
- emit({indent(12),"[20,Size,BinVal];",nl}),
- emit({indent(9),"true ->",nl}),
- emit({indent(12),"[21,<<Size:16>>,Val]",nl}),
- emit({indent(6),"end",nl}),
- emit({indent(3),"end.",nl,nl}),
- Acc;
-gen_objset_enc(_Erule,_,_,[],_,_,_,Acc) ->
- Acc.
-
-emit_ext_encfun(ModuleName,Name) ->
- emit([indent(4),"fun(T,V,O) -> '",ModuleName,"':'enc_",
- Name,"'(T,V,O) end"]).
-
-emit_default_getenc(ObjSetName,UniqueName) ->
- emit(["'getenc_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]),
- emit([indent(4),"fun(C,V,_) -> exit({'Type not compatible with table constraint',{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},",ErrV}}) end"]).
-
-
-%% gen_inlined_enc_funs for each object iterates over all fields of a
-%% class, and for each typefield it checks if the object has that
-%% field and emits the proper code.
-gen_inlined_enc_funs(Erule,Fields,[{typefield,Name,_}|Rest],ObjSetName,NthObj) ->
- CurrMod = get(currmod),
- InternalDefFunName=asn1ct_gen:list2name([NthObj,Name,ObjSetName]),
- case lists:keysearch(Name,1,Fields) of
- {value,{_,Type}} when is_record(Type,type) ->
- emit({indent(3),"fun(Type, Val, _) ->",nl,
- indent(6),"case Type of",nl}),
- {Ret,N}=emit_inner_of_fun(Erule,Type,InternalDefFunName),
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj+N,Ret);
- {value,{_,Type}} when is_record(Type,typedef) ->
- emit({indent(3),"fun(Type, Val, _) ->",nl,
- indent(6),"case Type of",nl}),
- emit({indent(9),{asis,Name}," ->",nl}),
- {Ret,N}=emit_inner_of_fun(Erule,Type,InternalDefFunName),
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj+N,Ret);
- {value,{_,#'Externaltypereference'{module=CurrMod,type=T}}} ->
- emit({indent(3),"fun(Type, Val, _) ->",nl,
- indent(6),"case Type of",nl}),
- emit({indent(9),{asis,Name}," ->",nl}),
- emit([indent(12),"'enc_",T,"'(Val)"]),
-% {Ret,N} = emit_inner_of_fun(Erule,TDef,InternalDefFunName),
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,[]);
- {value,{_,#'Externaltypereference'{module=M,type=T}}} ->
- emit({indent(3),"fun(Type, Val, _) ->",nl,
- indent(6),"case Type of",nl}),
- emit({indent(9),{asis,Name}," ->",nl}),
- emit([indent(12),"'",M,"'",":'enc_",T,"'(Val)"]),
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,[]);
- false ->
- emit([indent(3),"fun(Type, Val, _) ->",nl,
- indent(6),"case Type of",nl,
- indent(9),{asis,Name}," ->",nl,
- indent(12),"Size = case Val of",nl,
- indent(15),"B when is_binary(B) -> size(B);",nl,
- indent(15),"_ -> length(Val)",nl,
- indent(12),"end,",nl,
- indent(12),"if",nl,
- indent(15),"Size < 256 -> [20,Size,Val];",nl,
- indent(15),"true -> [21,<<Size:16>>,Val]",nl,
- indent(12),"end"]),
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,[])
- end;
-gen_inlined_enc_funs(Erule,Fields,[_|Rest],ObjSetName,NthObj) ->
- gen_inlined_enc_funs(Erule,Fields,Rest,ObjSetName,NthObj);
-gen_inlined_enc_funs(_Erule,_,[],_,NthObj) ->
- {[],NthObj}.
-
-gen_inlined_enc_funs1(Erule,Fields,[{typefield,Name,_}|Rest],ObjSetName,
- NthObj,Acc) ->
- CurrentMod = get(currmod),
- InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]),
- {Acc2,NAdd}=
- case lists:keysearch(Name,1,Fields) of
- {value,{_,Type}} when is_record(Type,type) ->
- emit({";",nl}),
- {Ret,N}=emit_inner_of_fun(Erule,Type,InternalDefFunName),
- {Ret++Acc,N};
- {value,{_,Type}} when is_record(Type,typedef) ->
- emit({";",nl,indent(9),{asis,Name}," ->",nl}),
- {Ret,N}=emit_inner_of_fun(Erule,Type,InternalDefFunName),
- {Ret++Acc,N};
- {value,{_,#'Externaltypereference'{module=CurrentMod,type=T}}} ->
- emit({";",nl,indent(9),{asis,Name}," ->",nl}),
- emit([indent(12),"'enc_",T,"'(Val)"]),
- {Acc,0};
- {value,{_,#'Externaltypereference'{module=M,type=T}}} ->
- emit({";",nl,indent(9),{asis,Name}," ->",nl}),
- emit([indent(12),"'",M,"'",":'enc_",T,"'(Val)"]),
- {Acc,0};
- false ->
- emit([";",nl,
- indent(9),{asis,Name}," ->",nl,
- indent(12),"Size = case Val of",nl,
- indent(15),"B when is_binary(B) -> size(B);",nl,
- indent(15),"_ -> length(Val)",nl,
- indent(12),"end,",nl,
- indent(12),"if",nl,
- indent(15),"Size < 256 -> [20,Size,Val];",nl,
- indent(15),"true -> [21,<<Size:16>>,Val]",nl,
- indent(12),"end"]),
- {Acc,0}
- end,
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj+NAdd,Acc2);
-gen_inlined_enc_funs1(Erule,Fields,[_|Rest],ObjSetName,NthObj,Acc)->
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,Acc);
-gen_inlined_enc_funs1(_Erule,_,[],_,NthObj,Acc) ->
- emit({nl,indent(6),"end",nl}),
- emit({indent(3),"end"}),
- {Acc,NthObj}.
-
-emit_inner_of_fun(Erule,TDef=#typedef{name={ExtMod,Name},typespec=Type},
- InternalDefFunName) ->
- case {ExtMod,Name} of
- {primitive,bif} ->
- emit(indent(12)),
- gen_encode_prim(Erule,Type,dotag,"Val"),
- {[],0};
- {constructed,bif} ->
- emit([indent(12),"'enc_",
- InternalDefFunName,"'(Val)"]),
- {[TDef#typedef{name=InternalDefFunName}],1};
- _ ->
- emit({indent(12),"'",ExtMod,"':'enc_",Name,"'(Val)"}),
- {[],0}
- end;
-emit_inner_of_fun(_Erule,#typedef{name=Name},_) ->
- emit({indent(12),"'enc_",Name,"'(Val)"}),
- {[],0};
-emit_inner_of_fun(Erule,Type,_) when is_record(Type,type) ->
- CurrMod = get(currmod),
- case Type#type.def of
- Def when is_atom(Def) ->
- emit({indent(9),Def," ->",nl,indent(12)}),
- gen_encode_prim(Erule,Type,dotag,"Val");
- TRef when is_record(TRef,typereference) ->
- T = TRef#typereference.val,
- emit({indent(9),T," ->",nl,indent(12),"'enc_",T,"'(Val)"});
- #'Externaltypereference'{module=CurrMod,type=T} ->
- emit({indent(9),T," ->",nl,indent(12),"'enc_",T,"'(Val)"});
- #'Externaltypereference'{module=ExtMod,type=T} ->
- emit({indent(9),T," ->",nl,indent(12),ExtMod,":'enc_",
- T,"'(Val)"})
- end,
- {[],0}.
-
-indent(N) ->
- lists:duplicate(N,32). % 32 = space
-
-
-gen_objset_dec(_,{unique,undefined},_,_,_,_) ->
- %% There is no unique field in the class of this object set
- %% don't bother about the constraint
- ok;
-gen_objset_dec(ObjSName,UniqueName,[{ObjName,Val,Fields},T|Rest],ClName,
- ClFields,NthObj)->
-
- emit({"'getdec_",ObjSName,"'(",{asis,UniqueName},",",
- {asis,Val},") ->",nl}),
- CurrMod = get(currmod),
- NewNthObj=
- case ObjName of
- {no_mod,no_name} ->
- gen_inlined_dec_funs(Fields,ClFields,ObjSName,NthObj);
- {CurrMod,Name} ->
- emit([" fun 'dec_",Name,"'/4"]),
- NthObj;
- {ModName,Name} ->
- emit_ext_decfun(ModName,Name),
-% emit([" {'",ModName,"', 'dec_",Name,"'}"]),
- NthObj;
- _ ->
- emit({" fun 'dec_",ObjName,"'/4"}),
- NthObj
- end,
- emit({";",nl}),
- gen_objset_dec(ObjSName,UniqueName,[T|Rest],ClName,ClFields,NewNthObj);
-gen_objset_dec(ObjSetName,UniqueName,[{ObjName,Val,Fields}],_ClName,
- ClFields,NthObj) ->
-
- emit({"'getdec_",ObjSetName,"'(",{asis,UniqueName},",",
- {asis,Val},") ->",nl}),
- CurrMod=get(currmod),
- case ObjName of
- {no_mod,no_name} ->
- gen_inlined_dec_funs(Fields,ClFields,ObjSetName,NthObj);
- {CurrMod,Name} ->
- emit([" fun 'dec_",Name,"'/4"]);
- {ModName,Name} ->
- emit_ext_decfun(ModName,Name);
-% emit([" {'",ModName,"', 'dec_",Name,"'}"]);
- _ ->
- emit({" fun 'dec_",ObjName,"'/4"})
- end,
- emit([";",nl]),
- emit_default_getdec(ObjSetName,UniqueName),
- emit({".",nl,nl}),
- ok;
-gen_objset_dec(ObjSetName,_,['EXTENSIONMARK'],_ClName,_ClFields,
- _NthObj) ->
- emit({"'getdec_",ObjSetName,"'(_, _) ->",nl}),
- emit({indent(3),"fun(Attr1, Bytes, _, _) ->",nl}),
- emit({indent(6),"{Bytes,Attr1}",nl}),
- emit({indent(3),"end.",nl,nl}),
- ok;
-gen_objset_dec(_,_,[],_,_,_) ->
- ok.
-
-emit_ext_decfun(ModuleName,Name) ->
- emit([indent(3),"fun(T,V,O1,O2) -> '",ModuleName,"':'dec_",
- Name,"'(T,V,O1,O2) end"]).
-
-emit_default_getdec(ObjSetName,UniqueName) ->
- emit(["'getdec_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]),
- emit([indent(2), "fun(C,V,_,_) -> exit({{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},",ErrV}}) end"]).
-
-
-gen_inlined_dec_funs(Fields, List, ObjSetName, NthObj0) ->
- emit([indent(3),"fun(Type, Val, _, _) ->",nl,
- indent(6),"case Type of",nl]),
- NthObj = gen_inlined_dec_funs1(Fields, List, ObjSetName, "", NthObj0),
- emit([nl,indent(6),"end",nl,
- indent(3),"end"]),
- NthObj.
-
-gen_inlined_dec_funs1(Fields, [{typefield,Name,_}|Rest],
- ObjSetName, Sep0, NthObj) ->
- CurrentMod = get(currmod),
- InternalDefFunName = [NthObj,Name,ObjSetName],
- emit(Sep0),
- Sep = [";",nl],
- N = case lists:keyfind(Name, 1, Fields) of
- {_,#type{}=Type} ->
- emit_inner_of_decfun(Type, InternalDefFunName);
- {_,#typedef{}=Type} ->
- emit([indent(9),{asis,Name}," ->",nl]),
- emit_inner_of_decfun(Type, InternalDefFunName);
- {_,#'Externaltypereference'{module=CurrentMod,type=T}} ->
- emit([indent(9),{asis,Name}," ->",nl,
- indent(12),"'dec_",T,"'(Val,telltype)"]),
- 0;
- {_,#'Externaltypereference'{module=M,type=T}} ->
- emit([indent(9),{asis,Name}," ->",nl,
- indent(12),"'",M,"':'dec_",T,"'(Val,telltype)"]),
- 0;
- false ->
- emit([indent(9),{asis,Name}," -> {Val,Type}"]),
- 0
- end,
- gen_inlined_dec_funs1(Fields, Rest, ObjSetName, Sep, NthObj+N);
-gen_inlined_dec_funs1(Fields, [_|Rest], ObjSetName, Sep, NthObj) ->
- gen_inlined_dec_funs1(Fields, Rest, ObjSetName, Sep, NthObj);
-gen_inlined_dec_funs1(_, [], _, _, NthObj) -> NthObj.
-
-emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type},
- InternalDefFunName) ->
- case {ExtName,Name} of
- {primitive,bif} ->
- emit(indent(12)),
- gen_dec_prim(per,Type,"Val"),
- 0;
- {constructed,bif} ->
- emit({indent(12),"'dec_",
- asn1ct_gen:list2name(InternalDefFunName),"'(Val)"}),
- 1;
- _ ->
- emit({indent(12),"'",ExtName,"':'dec_",Name,
- "'(Val, telltype)"}),
- 0
- end;
-emit_inner_of_decfun(#typedef{name=Name},_) ->
- emit({indent(12),"'dec_",Name,"'(Val, telltype)"}),
- 0;
-emit_inner_of_decfun(Type,_) when is_record(Type,type) ->
- CurrMod = get(currmod),
- case Type#type.def of
- Def when is_atom(Def) ->
- emit({indent(9),Def," ->",nl,indent(12)}),
- gen_dec_prim(per, Type, "Val");
- TRef when is_record(TRef,typereference) ->
- T = TRef#typereference.val,
- emit({indent(9),T," ->",nl,indent(12),"'dec_",T,"'(Val)"});
- #'Externaltypereference'{module=CurrMod,type=T} ->
- emit({indent(9),T," ->",nl,indent(12),"'dec_",T,"'(Val)"});
- #'Externaltypereference'{module=ExtMod,type=T} ->
- emit({indent(9),T," ->",nl,indent(12),ExtMod,":'dec_",
- T,"'(Val)"})
- end,
- 0.
-
-
-gen_internal_funcs(_Erules,[]) ->
- ok;
-gen_internal_funcs(Erules,[TypeDef|Rest]) ->
- gen_encode_user(Erules,TypeDef),
- emit([nl,nl,"'dec_",TypeDef#typedef.name,"'(Bytes) ->",nl]),
- gen_decode_user(Erules,TypeDef),
- gen_internal_funcs(Erules,Rest).
-
-
-
-%% DECODING *****************************
-%%***************************************
-
-
-gen_decode(Erules,Type) when is_record(Type,typedef) ->
- D = Type,
- emit({nl,nl}),
- emit({"'dec_",Type#typedef.name,"'(Bytes,_) ->",nl}),
- dbdec(Type#typedef.name),
- gen_decode_user(Erules,D).
-
-gen_decode(Erules,Tname,#'ComponentType'{name=Cname,typespec=Type}) ->
- NewTname = [Cname|Tname],
- gen_decode(Erules,NewTname,Type);
-
-gen_decode(Erules,Typename,Type) when is_record(Type,type) ->
- InnerType = asn1ct_gen:get_inner(Type#type.def),
- case asn1ct_gen:type(InnerType) of
- {constructed,bif} ->
- ObjFun =
- case Type#type.tablecinf of
- [{objfun,_}|_R] ->
- ", ObjFun";
- _ ->
- ""
- end,
- emit({nl,"'dec_",asn1ct_gen:list2name(Typename),
- "'(Bytes,_",ObjFun,") ->",nl}),
- dbdec(Typename),
- asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,Type);
- _ ->
- true
- end.
-
-dbdec(Type) when is_list(Type)->
- demit({"io:format(\"decoding: ",asn1ct_gen:list2name(Type),"~w~n\",[Bytes]),",nl});
-dbdec(Type) ->
- demit({"io:format(\"decoding: ",{asis,Type},"~w~n\",[Bytes]),",nl}).
-
-gen_decode_user(Erules,D) when is_record(D,typedef) ->
- CurrMod = get(currmod),
- Typename = [D#typedef.name],
- Def = D#typedef.typespec,
- InnerType = asn1ct_gen:get_inner(Def#type.def),
- case asn1ct_gen:type(InnerType) of
- {primitive,bif} ->
- gen_dec_prim(Erules,Def,"Bytes"),
- emit({".",nl,nl});
- 'ASN1_OPEN_TYPE' ->
- gen_dec_prim(Erules,Def#type{def='ASN1_OPEN_TYPE'},"Bytes"),
- emit({".",nl,nl});
- {constructed,bif} ->
- asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,D);
- #typereference{val=Dname} ->
- emit({"'dec_",Dname,"'(Bytes,telltype)"}),
- emit({".",nl,nl});
- #'Externaltypereference'{module=CurrMod,type=Etype} ->
- emit({"'dec_",Etype,"'(Bytes,telltype).",nl,nl});
- #'Externaltypereference'{module=Emod,type=Etype} ->
- emit({"'",Emod,"':'dec_",Etype,"'(Bytes,telltype).",nl,nl});
- Other ->
- exit({error,{asn1,{unknown,Other}}})
- end.
-
-
-
-gen_dec_prim(Erules, Att, BytesVar) ->
- asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar).
-
-%% For PER the ExtensionAdditionGroup notation has significance for the encoding and decoding
-%% the components within the ExtensionAdditionGroup is treated in a similar way as if they
-%% have been specified within a SEQUENCE, therefore we construct a fake sequence type here
-%% so that we can generate code for it
-extaddgroup2sequence(ExtList) ->
- extaddgroup2sequence(ExtList,0,[]).
-
-extaddgroup2sequence([{'ExtensionAdditionGroup',Number0}|T],ExtNum,Acc) ->
- Number = case Number0 of undefined -> 1; _ -> Number0 end,
- {ExtGroupComps,['ExtensionAdditionGroupEnd'|T2]} =
- lists:splitwith(fun(Elem) -> is_record(Elem,'ComponentType') end,T),
- extaddgroup2sequence(T2,ExtNum+1,
- [#'ComponentType'{
- name=list_to_atom("ExtAddGroup"++
- integer_to_list(ExtNum+1)),
- typespec=#type{def=#'SEQUENCE'{
- extaddgroup=Number,
- components=ExtGroupComps}},
- prop='OPTIONAL'}|Acc]);
-extaddgroup2sequence([C|T],ExtNum,Acc) ->
- extaddgroup2sequence(T,ExtNum,[C|Acc]);
-extaddgroup2sequence([],_,Acc) ->
- lists:reverse(Acc).
diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl
index 4b2c3b1b65..c6803a0f96 100644
--- a/lib/asn1/src/asn1ct_imm.erl
+++ b/lib/asn1/src/asn1ct_imm.erl
@@ -25,6 +25,7 @@
per_dec_length/3,per_dec_named_integer/3,
per_dec_octet_string/2,per_dec_open_type/1,per_dec_real/1,
per_dec_restricted_string/1]).
+-export([per_dec_constrained/3,per_dec_normally_small_number/1]).
-export([optimize_alignment/1,optimize_alignment/2,
dec_slim_cg/2,dec_code_gen/2]).
-export([effective_constraint/2]).
@@ -94,18 +95,16 @@ per_dec_integer(Constraint0, Aligned) ->
per_dec_length(SingleValue, _, _Aligned) when is_integer(SingleValue) ->
{value,SingleValue};
-per_dec_length({S,S}, _, _Aligned) when is_integer(S) ->
- {value,S};
-per_dec_length({{_,_}=Constr,_}, AllowZero, Aligned) ->
+per_dec_length({{Fixed,Fixed},[]}, AllowZero, Aligned) ->
+ bit_case(per_dec_length(Fixed, AllowZero, Aligned),
+ per_dec_length(no, AllowZero, Aligned));
+per_dec_length({{_,_}=Constr,[]}, AllowZero, Aligned) ->
bit_case(per_dec_length(Constr, AllowZero, Aligned),
- per_dec_length(undefined, AllowZero, Aligned));
+ per_dec_length(no, AllowZero, Aligned));
per_dec_length({Lb,Ub}, _AllowZero, Aligned) when is_integer(Lb),
- is_integer(Lb),
- Ub =< 65535 ->
+ is_integer(Lb) ->
per_dec_constrained(Lb, Ub, Aligned);
-per_dec_length({_,_}, AllowZero, Aligned) ->
- decode_unconstrained_length(AllowZero, Aligned);
-per_dec_length(undefined, AllowZero, Aligned) ->
+per_dec_length(no, AllowZero, Aligned) ->
decode_unconstrained_length(AllowZero, Aligned).
per_dec_named_integer(Constraint, NamedList0, Aligned) ->
@@ -114,17 +113,27 @@ per_dec_named_integer(Constraint, NamedList0, Aligned) ->
{map,Int,NamedList}.
per_dec_k_m_string(StringType, Constraint, Aligned) ->
- SzConstr = get_constraint(Constraint, 'SizeConstraint'),
+ SzConstr = effective_constraint(bitstring, Constraint),
N = string_num_bits(StringType, Constraint, Aligned),
- Imm = dec_string(SzConstr, N, Aligned),
+ %% X.691 (07/2002) 27.5.7 says if the upper bound times the number
+ %% of bits is greater than or equal to 16, then the bit field should
+ %% be aligned.
+ Imm = dec_string(SzConstr, N, Aligned, fun(_, Ub) -> Ub >= 16 end),
Chars = char_tab(Constraint, StringType, N),
convert_string(N, Chars, Imm).
per_dec_octet_string(Constraint, Aligned) ->
- dec_string(Constraint, 8, Aligned).
+ dec_string(Constraint, 8, Aligned,
+ %% Aligned unless the size is fixed and =< 16.
+ fun(Sv, Sv) -> Sv > 16;
+ (_, _) -> true
+ end).
per_dec_raw_bitstring(Constraint, Aligned) ->
- dec_string(Constraint, 1, Aligned).
+ dec_string(Constraint, 1, Aligned,
+ fun(Sv, Sv) -> Sv > 16;
+ (_, _) -> true
+ end).
per_dec_open_type(Aligned) ->
{get_bits,decode_unconstrained_length(true, Aligned),
@@ -148,21 +157,21 @@ per_dec_restricted_string(Aligned) ->
%%% Local functions.
%%%
-dec_string(Sv, U, _Aligned) when is_integer(Sv), U*Sv =< 16 ->
- {get_bits,Sv,[U,binary]};
-dec_string(Sv, U, Aligned) when is_integer(Sv), Sv < 16#10000 ->
+dec_string(Sv, U, Aligned0, AF) when is_integer(Sv) ->
+ Bits = U*Sv,
+ Aligned = Aligned0 andalso AF(Bits, Bits),
{get_bits,Sv,[U,binary,{align,Aligned}]};
-dec_string([_|_]=C, U, Aligned) when is_list(C) ->
- dec_string({hd(C),lists:max(C)}, U, Aligned);
-dec_string({Sv,Sv}, U, Aligned) ->
- dec_string(Sv, U, Aligned);
-dec_string({{_,_}=C,_}, U, Aligned) ->
- bit_case(dec_string(C, U, Aligned),
- dec_string(no, U, Aligned));
-dec_string({Lb,Ub}, U, Aligned) when Ub < 16#10000 ->
- Len = per_dec_constrained(Lb, Ub, Aligned),
+dec_string({{Sv,Sv},[]}, U, Aligned, AF) ->
+ bit_case(dec_string(Sv, U, Aligned, AF),
+ dec_string(no, U, Aligned, AF));
+dec_string({{_,_}=C,[]}, U, Aligned, AF) ->
+ bit_case(dec_string(C, U, Aligned, AF),
+ dec_string(no, U, Aligned, AF));
+dec_string({Lb,Ub}, U, Aligned0, AF) ->
+ Len = per_dec_constrained(Lb, Ub, Aligned0),
+ Aligned = Aligned0 andalso AF(Lb*U, Ub*U),
{get_bits,Len,[U,binary,{align,Aligned}]};
-dec_string(_, U, Aligned) ->
+dec_string(_, U, Aligned, _AF) ->
Al = [{align,Aligned}],
DecRest = fun(V, Buf) ->
asn1ct_func:call(per_common,
@@ -189,7 +198,7 @@ per_dec_enumerated_fix_list([], Tail, _) -> Tail.
per_dec_integer_1([{'SingleValue',Value}], _Aligned) ->
{value,Value};
per_dec_integer_1([{'ValueRange',{Lb,'MAX'}}], Aligned) when is_integer(Lb) ->
- per_dec_unconstrained(Aligned);
+ per_decode_semi_constrained(Lb, Aligned);
per_dec_integer_1([{'ValueRange',{Lb,Ub}}], Aligned) when is_integer(Lb),
is_integer(Ub) ->
per_dec_constrained(Lb, Ub, Aligned);
@@ -700,7 +709,27 @@ effective_constraint(integer, C) ->
VR = effective_constr('ValueRange', VRs),
greatest_common_range(SV, VR);
effective_constraint(bitstring, C) ->
- get_constraint(C, 'SizeConstraint').
+ case get_constraint(C, 'SizeConstraint') of
+ {{Lb,Ub},[]}=Range when is_integer(Lb) ->
+ if
+ is_integer(Ub), Ub < 16#10000 ->
+ Range;
+ true ->
+ no
+ end;
+ {Lb,Ub}=Range when is_integer(Lb) ->
+ if
+ is_integer(Ub), Ub < 16#10000 ->
+ if
+ Lb =:= Ub -> Lb;
+ true -> Range
+ end;
+ true ->
+ no
+ end;
+ no ->
+ no
+ end.
effective_constr(_, []) -> [];
effective_constr('SingleValue', List) ->
diff --git a/lib/asn1/src/asn1ct_name.erl b/lib/asn1/src/asn1ct_name.erl
index 3ab6f7b0ed..c0c2ed302c 100644
--- a/lib/asn1/src/asn1ct_name.erl
+++ b/lib/asn1/src/asn1ct_name.erl
@@ -21,13 +21,8 @@
%%-compile(export_all).
-export([start/0,
- stop/0,
- push/1,
- pop/1,
curr/1,
clear/0,
- delete/1,
- active/1,
prev/1,
next/1,
all/1,
@@ -43,30 +38,19 @@ start() ->
end)),
ok;
_Pid ->
- already_started
+ %% Already started. Clear the variables.
+ clear()
end.
-stop() ->
- req(stop),
- erase(?MODULE).
-
name_server_loop({Ref, Parent} = Monitor,Vars) ->
%% io:format("name -- ~w~n",[Vars]),
receive
+ {_From,clear} ->
+ name_server_loop(Monitor, []);
{From,{current,Variable}} ->
From ! {?MODULE,get_curr(Vars,Variable)},
name_server_loop(Monitor,Vars);
- {From,{pop,Variable}} ->
- From ! {?MODULE,done},
- name_server_loop(Monitor,pop_var(Vars,Variable));
- {From,{push,Variable}} ->
- From ! {?MODULE,done},
- name_server_loop(Monitor,push_var(Vars,Variable));
- {From,{delete,Variable}} ->
- From ! {?MODULE,done},
- name_server_loop(Monitor,delete_var(Vars,Variable));
- {From,{new,Variable}} ->
- From ! {?MODULE,done},
+ {_From,{new,Variable}} ->
name_server_loop(Monitor,new_var(Vars,Variable));
{From,{prev,Variable}} ->
From ! {?MODULE,get_prev(Vars,Variable)},
@@ -74,32 +58,29 @@ name_server_loop({Ref, Parent} = Monitor,Vars) ->
{From,{next,Variable}} ->
From ! {?MODULE,get_next(Vars,Variable)},
name_server_loop(Monitor,Vars);
- {'DOWN', Ref, process, Parent, Reason} ->
- exit(Reason);
- {From,stop} ->
- From ! {?MODULE,stopped}
- end.
-
-active(V) ->
- case curr(V) of
- nil -> false;
- _ -> true
+ {'DOWN', Ref, process, Parent, Reason} ->
+ exit(Reason)
end.
req(Req) ->
- get(?MODULE) ! {self(), Req},
+ Pid = get(?MODULE),
+ Ref = monitor(process, Pid),
+ Pid ! {self(), Req},
receive
- {?MODULE, Reply} -> Reply
- after 5000 ->
- exit(name_server_timeout)
+ {?MODULE, Reply} ->
+ Reply;
+ {'DOWN', Ref, process, Pid, Reason} ->
+ error({name_server_died,Reason})
end.
-pop(V) -> req({pop,V}).
-push(V) -> req({push,V}).
-clear() -> stop(), start().
+cast(Req) ->
+ get(?MODULE) ! {self(), Req},
+ ok.
+
+clear() -> cast(clear).
curr(V) -> req({current,V}).
-new(V) -> req({new,V}).
-delete(V) -> req({delete,V}).
+new(V) -> cast({new,V}).
+
prev(V) ->
case req({prev,V}) of
none ->
@@ -108,11 +89,7 @@ prev(V) ->
end.
next(V) ->
- case req({next,V}) of
- none ->
- exit('cant get next of none');
- Rep -> Rep
- end.
+ req({next,V}).
all(V) ->
Curr = curr(V),
@@ -146,81 +123,36 @@ get_digs([H|T]) ->
[]
end.
-push_var(Vars,Variable) ->
- case lists:keysearch(Variable,1,Vars) of
- false ->
- [{Variable,[0]}|Vars];
- {value,{Variable,[Digit|Drest]}} ->
- NewVars = lists:keydelete(Variable,1,Vars),
- [{Variable,[Digit,Digit|Drest]}|NewVars]
- end.
-
-pop_var(Vars,Variable) ->
- case lists:keysearch(Variable,1,Vars) of
- false ->
- ok;
- {value,{Variable,[_Dig]}} ->
- lists:keydelete(Variable,1,Vars);
- {value,{Variable,[_Dig|Digits]}} ->
- NewVars = lists:keydelete(Variable,1,Vars),
- [{Variable,Digits}|NewVars]
- end.
-
-get_curr([],Variable) ->
+get_curr([], Variable) ->
Variable;
-get_curr([{Variable,[0|_Drest]}|_Tail],Variable) ->
- Variable;
-get_curr([{Variable,[Digit|_Drest]}|_Tail],Variable) ->
- list_to_atom(lists:concat([Variable,integer_to_list(Digit)]));
-
-get_curr([_|Tail],Variable) ->
- get_curr(Tail,Variable).
-
-new_var(Vars,Variable) ->
- case lists:keysearch(Variable,1,Vars) of
- false ->
- [{Variable,[1]}|Vars];
- {value,{Variable,[Digit|Drest]}} ->
- NewVars = lists:keydelete(Variable,1,Vars),
- [{Variable,[Digit+1|Drest]}|NewVars]
- end.
+get_curr([{Variable,Digit}|_Tail], Variable) ->
+ list_to_atom(lists:concat([Variable,Digit]));
+get_curr([_|Tail], Variable) ->
+ get_curr(Tail, Variable).
-delete_var(Vars,Variable) ->
- case lists:keysearch(Variable,1,Vars) of
+new_var(Vars, Variable) ->
+ case lists:keyfind(Variable, 1, Vars) of
false ->
- Vars;
- {value,{Variable,[N]}} when N =< 1 ->
- lists:keydelete(Variable,1,Vars);
- {value,{Variable,[Digit|Drest]}} ->
- case Digit of
- 0 ->
- Vars;
- _ ->
- NewVars = lists:keydelete(Variable,1,Vars),
- [{Variable,[Digit-1|Drest]}|NewVars]
- end
+ [{Variable,1}|Vars];
+ {Variable,Digit} ->
+ NewVars = lists:keydelete(Variable, 1, Vars),
+ [{Variable,Digit+1}|NewVars]
end.
-get_prev(Vars,Variable) ->
- case lists:keysearch(Variable,1,Vars) of
+get_prev(Vars, Variable) ->
+ case lists:keyfind(Variable, 1, Vars) of
false ->
none;
- {value,{Variable,[Digit|_]}} when Digit =< 1 ->
+ {Variable,Digit} when Digit =< 1 ->
Variable;
- {value,{Variable,[Digit|_]}} when Digit > 1 ->
- list_to_atom(lists:concat([Variable,
- integer_to_list(Digit-1)]));
- _ ->
- none
+ {Variable,Digit} when Digit > 1 ->
+ list_to_atom(lists:concat([Variable,Digit-1]))
end.
-get_next(Vars,Variable) ->
- case lists:keysearch(Variable,1,Vars) of
+get_next(Vars, Variable) ->
+ case lists:keyfind(Variable, 1, Vars) of
false ->
list_to_atom(lists:concat([Variable,"1"]));
- {value,{Variable,[Digit|_]}} when Digit >= 0 ->
- list_to_atom(lists:concat([Variable,
- integer_to_list(Digit+1)]));
- _ ->
- none
+ {Variable,Digit} when Digit >= 0 ->
+ list_to_atom(lists:concat([Variable,Digit+1]))
end.
diff --git a/lib/asn1/src/asn1ct_parser2.erl b/lib/asn1/src/asn1ct_parser2.erl
index 9e1fcce2b1..344fdf44dd 100644
--- a/lib/asn1/src/asn1ct_parser2.erl
+++ b/lib/asn1/src/asn1ct_parser2.erl
@@ -23,6 +23,10 @@
-export([parse/1]).
-include("asn1_records.hrl").
+%% Only used internally within this module.
+-record(typereference, {pos,val}).
+-record(constraint,{c,e}).
+
%% parse all types in module
parse(Tokens) ->
case catch parse_ModuleDefinition(Tokens) of
@@ -458,7 +462,8 @@ parse_BuiltinType([{'INSTANCE',_},{'OF',_}|Rest]) ->
{DefinedObjectClass,Rest2} = parse_DefinedObjectClass(Rest),
case Rest2 of
[{'(',_}|_] ->
- {Constraint,Rest3} = parse_Constraint(Rest2),
+ {Constraint0,Rest3} = parse_Constraint(Rest2),
+ Constraint = merge_constraints([Constraint0]),
{#type{def={'INSTANCE OF',DefinedObjectClass,Constraint}},Rest3};
_ ->
{#type{def={'INSTANCE OF',DefinedObjectClass,[]}},Rest2}
diff --git a/lib/asn1/src/asn1ct_value.erl b/lib/asn1/src/asn1ct_value.erl
index 764555c4d2..ecdfa3f645 100644
--- a/lib/asn1/src/asn1ct_value.erl
+++ b/lib/asn1/src/asn1ct_value.erl
@@ -51,8 +51,6 @@ from_type(M,Typename,Type) when is_record(Type,type) ->
from_type(Emod,Etype);
{_,user} ->
from_type(M,InnerType);
- {notype,_} ->
- true;
{primitive,bif} ->
from_type_prim(M, Type);
'ASN1_OPEN_TYPE' ->
@@ -216,8 +214,6 @@ from_type_prim(M, D) ->
_ ->
[lists:nth(random(length(NN)),NN)]
end;
- 'ANY' ->
- exit({asn1_error,nyi,'ANY'});
'NULL' ->
'NULL';
'OBJECT IDENTIFIER' ->
diff --git a/lib/asn1/src/asn1rtt_ber.erl b/lib/asn1/src/asn1rtt_ber.erl
index 5fbf116747..b5429fe324 100644
--- a/lib/asn1/src/asn1rtt_ber.erl
+++ b/lib/asn1/src/asn1rtt_ber.erl
@@ -27,7 +27,8 @@
skip_ExtensionAdditions/2]).
-export([encode_boolean/2,decode_boolean/2,
encode_integer/2,encode_integer/3,
- decode_integer/3,decode_integer/4,
+ decode_integer/2,decode_integer/3,
+ decode_named_integer/3,decode_named_integer/4,
encode_enumerated/2,decode_enumerated/3,
encode_bit_string/4,
decode_named_bit_string/3,
@@ -41,9 +42,7 @@
decode_restricted_string/2,decode_restricted_string/3,
encode_universal_string/2,decode_universal_string/3,
encode_UTF8_string/2,decode_UTF8_string/2,
- encode_BMP_string/2,decode_BMP_string/3,
- encode_generalized_time/2,decode_generalized_time/3,
- encode_utc_time/2,decode_utc_time/3]).
+ encode_BMP_string/2,decode_BMP_string/3]).
-export([encode_open_type/2,decode_open_type/2,
decode_open_type_as_binary/2]).
@@ -700,11 +699,20 @@ encode_integer_neg(N, Acc) ->
%% (Buffer, Range, NamedNumberList, HasTag, TotalLen) -> {Integer, Remain, RemovedBytes}
%%===============================================================================
-decode_integer(Tlv, Range, NamedNumberList, TagIn) ->
+decode_named_integer(Tlv, NamedNumberList, TagIn) ->
+ V = match_tags(Tlv, TagIn),
+ Int = decode_integer(V),
+ number2name(Int, NamedNumberList).
+
+decode_named_integer(Tlv, Range, NamedNumberList, TagIn) ->
V = match_tags(Tlv, TagIn),
Int = range_check_integer(decode_integer(V), Range),
number2name(Int, NamedNumberList).
+decode_integer(Tlv, TagIn) ->
+ V = match_tags(Tlv, TagIn),
+ decode_integer(V).
+
decode_integer(Tlv, Range, TagIn) ->
V = match_tags(Tlv, TagIn),
Int = decode_integer(V),
@@ -715,21 +723,10 @@ decode_integer(Bin) ->
<<Int:Len/signed-unit:8>> = Bin,
Int.
+range_check_integer(Int, {Lb,Ub}) when Lb =< Int, Int =< Ub ->
+ Int;
range_check_integer(Int, Range) ->
- case Range of
- [] -> % No length constraint
- Int;
- {Lb,Ub} when Int >= Lb, Ub >= Int -> % variable length constraint
- Int;
- {_,_} ->
- exit({error,{asn1,{integer_range,Range,Int}}});
- Int -> % fixed value constraint
- Int;
- SingleValue when is_integer(SingleValue) ->
- exit({error,{asn1,{integer_range,Range,Int}}});
- _ -> % some strange constraint that we don't support yet
- Int
- end.
+ exit({error,{asn1,{integer_range,Range,Int}}}).
number2name(Int, []) ->
Int;
@@ -838,8 +835,8 @@ int_to_bitlist(Int) when is_integer(Int), Int >= 0 ->
%% and BinBits is a binary representing the BIT STRING.
%%=================================================================
encode_bin_bit_string(C,{Unused,BinBits},_NamedBitList,TagIn)->
- case get_constraint(C,'SizeConstraint') of
- no ->
+ case C of
+ [] ->
remove_unused_then_dotag(TagIn, Unused, BinBits);
{_Min,Max} ->
BBLen = (byte_size(BinBits)*8)-Unused,
@@ -885,8 +882,8 @@ remove_unused_then_dotag(TagIn,Unused,BinBits) ->
encode_bit_string_named(C, [FirstVal | RestVal], NamedBitList, TagIn) ->
ToSetPos = get_all_bitposes([FirstVal | RestVal], NamedBitList, []),
Size =
- case get_constraint(C,'SizeConstraint') of
- no ->
+ case C of
+ [] ->
lists:max(ToSetPos)+1;
{_Min,Max} ->
Max;
@@ -943,8 +940,8 @@ make_and_set_list(Len, [], XPos) ->
%% Encode bit string for lists of ones and zeroes
%%=================================================================
encode_bit_string_bits(C, BitListVal, _NamedBitList, TagIn) when is_list(BitListVal) ->
- case get_constraint(C,'SizeConstraint') of
- no ->
+ case C of
+ [] ->
{Len, Unused, OctetList} = encode_bitstring(BitListVal),
%%add unused byte to the Len
encode_tags(TagIn, [Unused | OctetList], Len+1);
@@ -957,7 +954,7 @@ encode_bit_string_bits(C, BitListVal, _NamedBitList, TagIn) when is_list(BitList
Constr={{_,_},{_,_}} ->%{{Min1,Max1},{Min2,Max2}}
%% constraint with extension mark
encode_constr_bit_str_bits(Constr,BitListVal,TagIn);
- Size ->
+ Size when is_integer(Size) ->
case length(BitListVal) of
BitSize when BitSize == Size ->
{Len, Unused, OctetList} = encode_bitstring(BitListVal),
@@ -1266,27 +1263,14 @@ decode_restricted_string(Tlv, Range, TagsIn) ->
Bin = match_and_collect(Tlv, TagsIn),
check_restricted_string(binary_to_list(Bin), byte_size(Bin), Range).
-check_restricted_string(Val, StrLen, Range) ->
- case Range of
- {Lb,Ub} when StrLen >= Lb, Ub >= StrLen -> % variable length constraint
- Val;
- {{Lb,_Ub},[]} when StrLen >= Lb ->
- Val;
- {{Lb,_Ub},_Ext=[Min|_]} when StrLen >= Lb; StrLen >= Min ->
- Val;
- {{Lb1,Ub1},{Lb2,Ub2}} when StrLen >= Lb1, StrLen =< Ub1;
- StrLen =< Ub2, StrLen >= Lb2 ->
- Val;
- StrLen -> % fixed length constraint
- Val;
- {_,_} ->
- exit({error,{asn1,{length,Range,Val}}});
- _Len when is_integer(_Len) ->
- exit({error,{asn1,{length,Range,Val}}});
- _ -> % some strange constraint that we don't support yet
- Val
- end.
-
+check_restricted_string(Val, _Len, []) ->
+ Val;
+check_restricted_string(Val, Len, {Lb,Ub}) when Lb =< Len, Len =< Ub ->
+ Val;
+check_restricted_string(Val, Len, Len) ->
+ Val;
+check_restricted_string(Val, _Len, Range) ->
+ exit({error,{asn1,{length,Range,Val}}}).
%%============================================================================
%% encode Universal string
@@ -1390,56 +1374,6 @@ mk_BMP_string([0,B|T], US) ->
mk_BMP_string([C,D|T], US) ->
mk_BMP_string(T, [{0,0,C,D}|US]).
-
-%%============================================================================
-%% Generalized time, ITU_T X.680 Chapter 39
-%%
-%% encode Generalized time
-%%============================================================================
-
-encode_generalized_time(OctetList, TagIn) ->
- encode_tags(TagIn, OctetList, length(OctetList)).
-
-%%============================================================================
-%% decode Generalized time
-%% (Buffer, Range, HasTag, TotalLen) -> {String, Remain, RemovedBytes}
-%%============================================================================
-
-decode_generalized_time(Tlv, _Range, Tags) ->
- Val = match_tags(Tlv, Tags),
- NewVal = case Val of
- [_H|_T]=PartList -> % constructed
- collect_parts(PartList);
- Bin ->
- Bin
- end,
- binary_to_list(NewVal).
-
-%%============================================================================
-%% Universal time, ITU_T X.680 Chapter 40
-%%
-%% encode UTC time
-%%============================================================================
-
-encode_utc_time(OctetList, TagIn) ->
- encode_tags(TagIn, OctetList, length(OctetList)).
-
-%%============================================================================
-%% decode UTC time
-%% (Buffer, Range, HasTag, TotalLen) -> {String, Remain, RemovedBytes}
-%%============================================================================
-
-decode_utc_time(Tlv, _Range, Tags) ->
- Val = match_tags(Tlv, Tags),
- NewVal = case Val of
- [_|_]=PartList -> % constructed
- collect_parts(PartList);
- Bin ->
- Bin
- end,
- binary_to_list(NewVal).
-
-
%%============================================================================
%% Length handling
%%
@@ -1535,14 +1469,6 @@ match_and_collect(Tlv, TagsIn) ->
Bin
end.
-get_constraint(C, Key) ->
- case lists:keyfind(Key, 1, C) of
- false ->
- no;
- {_,V} ->
- V
- end.
-
collect_parts(TlvList) ->
collect_parts(TlvList, []).
diff --git a/lib/asn1/src/asn1rtt_per.erl b/lib/asn1/src/asn1rtt_per.erl
index aa6cf4da0a..9f4b7500d8 100644
--- a/lib/asn1/src/asn1rtt_per.erl
+++ b/lib/asn1/src/asn1rtt_per.erl
@@ -19,7 +19,7 @@
-module(asn1rtt_per).
-export([setext/1, fixextensions/2,
- skipextensions/3, getbit/1, getchoice/3,
+ skipextensions/3,
set_choice/3,encode_integer/2,
encode_small_number/1,
encode_constrained_number/2,
@@ -36,7 +36,7 @@
encode_VideotexString/2,
encode_ObjectDescriptor/2,
encode_UTF8String/1,
- encode_octet_string/3,
+ encode_octet_string/2,
encode_known_multiplier_string/4,
octets_to_complete/2]).
@@ -88,23 +88,6 @@ skipextensions(Bytes0, Nr, ExtensionBitstr) when is_bitstring(ExtensionBitstr) -
Bytes0
end.
-
-getchoice(Bytes, 1, 0) -> % only 1 alternative is not encoded
- {0,Bytes};
-getchoice(Bytes, _, 1) ->
- decode_small_number(Bytes);
-getchoice(Bytes, NumChoices, 0) ->
- decode_constrained_number(Bytes, {0,NumChoices-1}).
-
-
-getbit(Buffer) ->
- <<B:1,Rest/bitstring>> = Buffer,
- {B,Rest}.
-
-getbits(Buffer, Num) when is_bitstring(Buffer) ->
- <<Bs:Num,Rest/bitstring>> = Buffer,
- {Bs,Rest}.
-
align(Bin) when is_binary(Bin) ->
Bin;
align(BitStr) when is_bitstring(BitStr) ->
@@ -112,28 +95,6 @@ align(BitStr) when is_bitstring(BitStr) ->
<<_:AlignBits,Rest/binary>> = BitStr,
Rest.
-
-%% First align buffer, then pick the first Num octets.
-%% Returns octets as an integer with bit significance as in buffer.
-getoctets(Buffer, Num) when is_binary(Buffer) ->
- <<Val:Num/integer-unit:8,RestBin/binary>> = Buffer,
- {Val,RestBin};
-getoctets(Buffer, Num) when is_bitstring(Buffer) ->
- AlignBits = bit_size(Buffer) rem 8,
- <<_:AlignBits,Val:Num/integer-unit:8,RestBin/binary>> = Buffer,
- {Val,RestBin}.
-
-
-%% First align buffer, then pick the first Num octets.
-%% Returns octets as a binary
-getoctets_as_bin(Bin,Num) when is_binary(Bin) ->
- <<Octets:Num/binary,RestBin/binary>> = Bin,
- {Octets,RestBin};
-getoctets_as_bin(Bin,Num) when is_bitstring(Bin) ->
- AlignBits = bit_size(Bin) rem 8,
- <<_:AlignBits,Val:Num/binary,RestBin/binary>> = Bin,
- {Val,RestBin}.
-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% set_choice(Alt,Choices,Altnum) -> ListofBitSettings
%% Alt = atom()
@@ -185,15 +146,7 @@ set_choice_tag(_Alt,[],_Tag) ->
%% | binary
%% Contraint = not used in this version
%%
-encode_open_type(Val) when is_list(Val) ->
- Bin = list_to_binary(Val),
- case byte_size(Bin) of
- Size when Size > 255 ->
- [encode_length(Size),21,<<Size:16>>,Bin];
- Size ->
- [encode_length(Size),20,Size,Bin]
- end;
-encode_open_type(Val) when is_binary(Val) ->
+encode_open_type(Val) ->
case byte_size(Val) of
Size when Size > 255 ->
[encode_length(Size),21,<<Size:16>>,Val]; % octets implies align
@@ -220,7 +173,7 @@ encode_integer([{'ValueRange',{Lb,Ub}=VR,Range,PreEnc}],Val)
when Val >= Lb, Ub >= Val ->
%% this case when NamedNumberList
encode_constrained_number(VR, Range, PreEnc, Val);
-encode_integer([{'ValueRange',{Lb,'MAX'}}], Val) ->
+encode_integer([{'ValueRange',{Lb,'MAX'}}], Val) when Lb =< Val ->
encode_semi_constrained_number(Lb, Val);
encode_integer([{'ValueRange',{'MIN',_}}], Val) ->
encode_unconstrained_number(Val);
@@ -238,15 +191,6 @@ encode_small_number(Val) when Val < 64 ->
encode_small_number(Val) ->
[1|encode_semi_constrained_number(0, Val)].
-decode_small_number(Bytes) ->
- {Bit,Bytes2} = getbit(Bytes),
- case Bit of
- 0 ->
- getbits(Bytes2, 6);
- 1 ->
- decode_semi_constrained_number(Bytes2)
- end.
-
%% X.691:10.7 Encoding of a semi-constrained whole number
encode_semi_constrained_number(Lb, Val) ->
Val2 = Val - Lb,
@@ -261,10 +205,6 @@ encode_semi_constrained_number(Lb, Val) ->
[encode_length(Len),21,<<Len:16>>|Oct]
end.
-decode_semi_constrained_number(Bytes) ->
- {Len,Bytes2} = decode_length(Bytes),
- getoctets(Bytes2, Len).
-
encode_constrained_number({Lb,_Ub},_Range,{bits,N},Val) ->
Val2 = Val-Lb,
[10,N,Val2];
@@ -333,47 +273,6 @@ encode_constrained_number({Lb,Ub}, Val) when Val >= Lb, Ub >= Val ->
encode_constrained_number({_,_},Val) ->
exit({error,{asn1,{illegal_value,Val}}}).
-decode_constrained_number(Buffer,VR={Lb,Ub}) ->
- Range = Ub - Lb + 1,
- decode_constrained_number(Buffer,VR,Range).
-
-decode_constrained_number(Buffer,{Lb,_Ub},Range) ->
- % Val2 = Val - Lb,
- {Val,Remain} =
- if
- Range == 1 ->
- {0,Buffer};
- Range == 2 ->
- getbits(Buffer,1);
- Range =< 4 ->
- getbits(Buffer,2);
- Range =< 8 ->
- getbits(Buffer,3);
- Range =< 16 ->
- getbits(Buffer,4);
- Range =< 32 ->
- getbits(Buffer,5);
- Range =< 64 ->
- getbits(Buffer,6);
- Range =< 128 ->
- getbits(Buffer,7);
- Range =< 255 ->
- getbits(Buffer,8);
- Range =< 256 ->
- getoctets(Buffer,1);
- Range =< 65536 ->
- getoctets(Buffer,2);
- Range =< (1 bsl (255*8)) ->
- OList = binary:bin_to_list(binary:encode_unsigned(Range - 1)),
- RangeOctLen = length(OList),
- {Len, Bytes} = decode_length(Buffer, {1, RangeOctLen}),
- {Octs, RestBytes} = getoctets_as_bin(Bytes, Len),
- {binary:decode_unsigned(Octs), RestBytes};
- true ->
- exit({not_supported,{integer_range,Range}})
- end,
- {Val+Lb,Remain}.
-
%% For some reason the minimum bits needed in the length field in
%% the encoding of constrained whole numbers must always be at least 2?
minimum_bits(N) when N < 4 -> 2;
@@ -440,22 +339,17 @@ encode_length(Len) -> % unconstrained
exit({error,{asn1,{encode_length,{nyi,above_16k}}}})
end.
-encode_length(undefined, Len) -> % un-constrained
- encode_length(Len);
-encode_length({0,'MAX'},Len) ->
- encode_length(undefined,Len);
-encode_length({Lb,Ub}=Vr, Len) when Ub =< 65535 ,Lb >= 0 -> % constrained
- encode_constrained_number(Vr,Len);
-encode_length({Lb,_Ub}, Len) when is_integer(Lb), Lb >= 0 -> % Ub > 65535
- encode_length(Len);
-encode_length({{Lb,Ub}=Vr,Ext}, Len)
- when Ub =< 65535 ,Lb >= 0,Len=<Ub, is_list(Ext) ->
- %% constrained extensible
- [0|encode_constrained_number(Vr,Len)];
-encode_length({{Lb,_},Ext},Len) when is_list(Ext) ->
- [1|encode_semi_constrained_number(Lb, Len)];
-encode_length(SingleValue, _Len) when is_integer(SingleValue) ->
- [].
+encode_length({C,[]}, Len) ->
+ case C of
+ {Lb,Ub}=Vr when Lb =< Len, Len =< Ub ->
+ [0|encode_constrained_number(Vr, Len)];
+ _ ->
+ [1|encode_length(Len)]
+ end;
+encode_length(Len, Len) ->
+ [];
+encode_length(Vr, Len) ->
+ encode_constrained_number(Vr, Len).
%% X.691 10.9.3.4 (only used for length of bitmap that prefixes extension
%% additions in a sequence or set
@@ -476,11 +370,6 @@ decode_length(Buffer) -> % un-constrained
exit({error,{asn1,{decode_length,{nyi,above_16k}}}})
end.
-decode_length(Buffer, {Lb,Ub}) when Ub =< 65535, Lb >= 0 -> % constrained
- decode_constrained_number(Buffer, {Lb,Ub});
-decode_length(Buffer, {Lb,_Ub}) when is_integer(Lb), Lb >= 0 -> % Ub > 65535
- decode_length(Buffer).
-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% bitstring NamedBitList
%% Val can be of:
@@ -758,40 +647,40 @@ make_and_set_list([], _) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% X.691:16
-%% encode_octet_string(Constraint,ExtensionMarker,Val)
+%% encode_octet_string(Constraint, Val)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-encode_octet_string(_C, true, _Val) ->
- exit({error,{asn1,{'not_supported',extensionmarker}}});
-encode_octet_string({_,_}=SZ, false, Val) ->
+encode_octet_string({{Sv,Sv},Ext}=SZ, Val) when is_list(Ext), Sv =< 2 ->
Len = length(Val),
try
- [encode_length(SZ, Len),2|octets_to_complete(Len, Val)]
+ case encode_length(SZ, Len) of
+ [0|_]=EncLen ->
+ [EncLen,45,Sv*8,Sv,Val];
+ [_|_]=EncLen ->
+ [EncLen|octets_to_complete(Len, Val)]
+ end
catch
exit:{error,{asn1,{encode_length,_}}} ->
encode_fragmented_octet_string(Val)
end;
-encode_octet_string(SZ, false, Val) when is_list(SZ) ->
+encode_octet_string({_,_}=SZ, Val) ->
Len = length(Val),
try
- [encode_length({hd(SZ),lists:max(SZ)},Len),2|
- octets_to_complete(Len,Val)]
+ [encode_length(SZ, Len),2|octets_to_complete(Len, Val)]
catch
exit:{error,{asn1,{encode_length,_}}} ->
encode_fragmented_octet_string(Val)
end;
-encode_octet_string(Sv, false, Val) when is_integer(Sv) ->
+encode_octet_string(Sv, Val) when is_integer(Sv) ->
encode_fragmented_octet_string(Val);
-encode_octet_string(no, false, Val) ->
+encode_octet_string(no, Val) ->
Len = length(Val),
try
[encode_length(Len),2|octets_to_complete(Len, Val)]
catch
exit:{error,{asn1,{encode_length,_}}} ->
encode_fragmented_octet_string(Val)
- end;
-encode_octet_string(C, _, _) ->
- exit({error,{not_implemented,C}}).
+ end.
encode_fragmented_octet_string(Val) ->
Bin = iolist_to_binary(Val),
@@ -825,12 +714,24 @@ encode_restricted_string(Val) when is_list(Val)->
encode_known_multiplier_string(SizeC, NumBits, CharOutTab, Val) ->
Result = chars_encode2(Val, NumBits, CharOutTab),
case SizeC of
- Ub when is_integer(Ub), Ub*NumBits =< 16 ->
+ Ub when is_integer(Ub), Ub*NumBits < 16 ->
Result;
- Ub when is_integer(Ub), Ub =<65535 -> % fixed length
+ Ub when is_integer(Ub) ->
[2,Result];
- {Ub,Lb} ->
- [encode_length({Ub,Lb},length(Val)),2,Result];
+ {{_,Ub},Ext}=SZ when is_list(Ext) ->
+ Len = length(Val),
+ case encode_length(SZ, Len) of
+ [0|_]=EncLen when Ub*NumBits < 16 ->
+ [EncLen,45,Len*NumBits,Len,Val];
+ [_|_]=EncLen ->
+ [EncLen,2|Result]
+ end;
+ {_,Ub}=Range ->
+ [encode_length(Range, length(Val))|
+ if
+ Ub*NumBits < 16 -> Result;
+ true -> [2|Result]
+ end];
no ->
[encode_length(length(Val)),2,Result]
end.
diff --git a/lib/asn1/src/asn1rtt_uper.erl b/lib/asn1/src/asn1rtt_uper.erl
index 8efe9a7b0f..a5035c6660 100644
--- a/lib/asn1/src/asn1rtt_uper.erl
+++ b/lib/asn1/src/asn1rtt_uper.erl
@@ -21,7 +21,7 @@
-export([setext/1, fixoptionals/3,
fixextensions/2,
- skipextensions/3, getbit/1, getchoice/3 ]).
+ skipextensions/3]).
-export([set_choice/3, encode_integer/2, encode_integer/3]).
-export([encode_small_number/1, encode_constrained_number/2,
encode_boolean/1,
@@ -34,17 +34,17 @@
-export([encode_open_type/1]).
- -export([encode_UniversalString/2,
- encode_PrintableString/2,
+ -export([encode_UniversalString/3,
+ encode_PrintableString/3,
encode_GeneralString/2,
encode_GraphicString/2,
encode_TeletexString/2,
encode_VideotexString/2,
- encode_VisibleString/2,
+ encode_VisibleString/3,
encode_UTF8String/1,
- encode_BMPString/2,
- encode_IA5String/2,
- encode_NumericString/2,
+ encode_BMPString/3,
+ encode_IA5String/3,
+ encode_NumericString/3,
encode_ObjectDescriptor/2
]).
@@ -123,29 +123,6 @@ skipextensions(Bytes0, Nr, ExtensionBitstr) when is_bitstring(ExtensionBitstr) -
end.
-getchoice(Bytes,1,0) -> % only 1 alternative is not encoded
- {0,Bytes};
-getchoice(Bytes,_,1) ->
- decode_small_number(Bytes);
-getchoice(Bytes,NumChoices,0) ->
- decode_constrained_number(Bytes,{0,NumChoices-1}).
-
-
-getbit(Buffer) ->
- <<B:1,Rest/bitstring>> = Buffer,
- {B,Rest}.
-
-getbits(Buffer, Num) when is_bitstring(Buffer) ->
- <<Bs:Num,Rest/bitstring>> = Buffer,
- {Bs,Rest}.
-
-
-%% Pick the first Num octets.
-%% Returns octets as an integer with bit significance as in buffer.
-getoctets(Buffer, Num) when is_bitstring(Buffer) ->
- <<Val:Num/integer-unit:8,RestBitStr/bitstring>> = Buffer,
- {Val,RestBitStr}.
-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% set_choice(Alt,Choices,Altnum) -> ListofBitSettings
%% Alt = atom()
@@ -198,9 +175,7 @@ set_choice_tag(_Alt,[],_Tag) ->
%% | binary
%% Contraint = not used in this version
%%
-encode_open_type(Val) when is_list(Val) ->
- encode_open_type(list_to_binary(Val));
-encode_open_type(Val) when is_binary(Val) ->
+encode_open_type(Val) ->
[encode_length(byte_size(Val)),Val].
@@ -248,7 +223,7 @@ encode_integer1(C, Val) ->
case VR = get_constraint(C, 'ValueRange') of
no ->
encode_unconstrained_number(Val);
- {Lb,'MAX'} ->
+ {Lb,'MAX'} when Lb =< Val ->
encode_semi_constrained_number(Lb, Val);
%% positive with range
{Lb,Ub} when Val >= Lb, Ub >= Val ->
@@ -265,15 +240,6 @@ encode_small_number(Val) when Val < 64 ->
encode_small_number(Val) ->
[<<1:1>>|encode_semi_constrained_number(0, Val)].
-decode_small_number(Bytes) ->
- {Bit,Bytes2} = getbit(Bytes),
- case Bit of
- 0 ->
- getbits(Bytes2,6);
- 1 ->
- decode_semi_constrained_number(Bytes2)
- end.
-
%% X.691:10.7 Encoding of a semi-constrained whole number
encode_semi_constrained_number(Lb, Val) ->
%% encoding in minimum number of octets preceeded by a length
@@ -289,11 +255,6 @@ encode_semi_constrained_number(Lb, Val) ->
[encode_length(Size),Bin]
end.
-decode_semi_constrained_number(Bytes) ->
- {Len,Bytes2} = decode_length(Bytes),
- {V,Bytes3} = getoctets(Bytes2,Len),
- {V,Bytes3}.
-
encode_constrained_number({Lb,Ub}, Val) when Val >= Lb, Ub >= Val ->
Range = Ub - Lb + 1,
Val2 = Val - Lb,
@@ -302,13 +263,6 @@ encode_constrained_number({Lb,Ub}, Val) when Val >= Lb, Ub >= Val ->
encode_constrained_number(Range,Val) ->
exit({error,{asn1,{integer_range,Range,value,Val}}}).
-
-decode_constrained_number(Buffer, {Lb,Ub}) ->
- Range = Ub - Lb + 1,
- NumBits = num_bits(Range),
- {Val,Remain} = getbits(Buffer,NumBits),
- {Val+Lb,Remain}.
-
%% X.691:10.8 Encoding of an unconstrained whole number
encode_unconstrained_number(Val) when Val >= 0 ->
@@ -390,22 +344,18 @@ encode_length(Len) -> % un-constrained
error({error,{asn1,{encode_length,{nyi,above_16k}}}})
end.
-encode_length(undefined, Len) -> % unconstrained
- encode_length(Len);
-encode_length({0,'MAX'},Len) ->
- encode_length(undefined, Len);
-encode_length({Lb,Ub}=Vr, Len) when Ub =< 65535, Lb >= 0 -> % constrained
- encode_constrained_number(Vr,Len);
-encode_length({Lb,_Ub}, Len) when is_integer(Lb), Lb >= 0 -> % Ub > 65535
- encode_length(Len);
-encode_length({{Lb,Ub}=Vr,Ext},Len)
- when Ub =< 65535, Lb >= 0, Len =< Ub, is_list(Ext) ->
- %% constrained extensible
- [<<0:1>>,encode_constrained_number(Vr,Len)];
-encode_length({{Lb,_Ub},Ext}, Len) when is_list(Ext) ->
- [<<1:1>>,encode_semi_constrained_number(Lb, Len)];
-encode_length(SingleValue, _Len) when is_integer(SingleValue) ->
- [].
+encode_length({C,[]}, Len) ->
+ case C of
+ {Lb,Ub}=Vr when Lb =< Len, Len =< Ub ->
+ [<<0:1>>|encode_constrained_number(Vr, Len)];
+ _ ->
+ [<<1:1>>|encode_length(Len)]
+ end;
+encode_length(Len, Len) ->
+ [];
+encode_length(Vr, Len) ->
+ encode_constrained_number(Vr, Len).
+
%% X.691 10.9.3.4 (only used for length of bitmap that prefixes extension
%% additions in a sequence or set
@@ -687,10 +637,6 @@ encode_octet_string(Val) ->
encode_octet_string(C, Val) ->
case C of
- 1 ->
- list_to_binary(Val);
- 2 ->
- list_to_binary(Val);
{_,_}=VR ->
try
[encode_length(VR, length(Val)),list_to_binary(Val)]
@@ -699,20 +645,7 @@ encode_octet_string(C, Val) ->
encode_fragmented_octet_string(Val)
end;
Sv when is_integer(Sv), Sv =:= length(Val) -> % fixed length
- if
- Sv =< 65535 ->
- list_to_binary(Val);
- true ->
- encode_fragmented_octet_string(Val)
- end;
- Sv when is_list(Sv) ->
- try
- [encode_length({hd(Sv),lists:max(Sv)},
- length(Val)),list_to_binary(Val)]
- catch
- error:{error,{asn1,{encode_length,_}}} ->
- encode_fragmented_octet_string(Val)
- end
+ list_to_binary(Val)
end.
@@ -742,41 +675,34 @@ efos_1(<<B/bitstring>>) ->
encode_restricted_string(Val) when is_list(Val)->
[encode_length(length(Val)),list_to_binary(Val)].
-encode_known_multiplier_string(StringType, C, Val) ->
- Result = chars_encode(C, StringType, Val),
- NumBits = get_NumBits(C, StringType),
- case get_constraint(C, 'SizeConstraint') of
- Ub when is_integer(Ub), Ub*NumBits =< 16 ->
- Result;
- 0 ->
- [];
- Ub when is_integer(Ub),Ub =<65535 -> % fixed length
+encode_known_multiplier_string(StringType, C, Pa, Val) ->
+ Result = chars_encode(Pa, StringType, Val),
+ case C of
+ Ub when is_integer(Ub) ->
Result;
- {Ub,Lb} ->
- [encode_length({Ub,Lb}, length(Val)),Result];
- Vl when is_list(Vl) ->
- [encode_length({lists:min(Vl),lists:max(Vl)}, length(Val)),Result];
+ {_,_}=Range ->
+ [encode_length(Range, length(Val)),Result];
no ->
[encode_length(length(Val)),Result]
end.
-encode_NumericString(C,Val) ->
- encode_known_multiplier_string('NumericString',C,Val).
+encode_NumericString(C, Pa, Val) ->
+ encode_known_multiplier_string('NumericString', C, Pa, Val).
-encode_PrintableString(C,Val) ->
- encode_known_multiplier_string('PrintableString',C,Val).
+encode_PrintableString(C, Pa, Val) ->
+ encode_known_multiplier_string('PrintableString', C, Pa, Val).
-encode_VisibleString(C,Val) -> % equivalent with ISO646String
- encode_known_multiplier_string('VisibleString',C,Val).
+encode_VisibleString(C, Pa, Val) -> % equivalent with ISO646String
+ encode_known_multiplier_string('VisibleString', C, Pa, Val).
-encode_IA5String(C,Val) ->
- encode_known_multiplier_string('IA5String',C,Val).
+encode_IA5String(C, Pa, Val) ->
+ encode_known_multiplier_string('IA5String', C, Pa, Val).
-encode_BMPString(C,Val) ->
- encode_known_multiplier_string('BMPString',C,Val).
+encode_BMPString(C, Pa, Val) ->
+ encode_known_multiplier_string('BMPString', C, Pa, Val).
-encode_UniversalString(C,Val) ->
- encode_known_multiplier_string('UniversalString',C,Val).
+encode_UniversalString(C, Pa, Val) ->
+ encode_known_multiplier_string('UniversalString', C, Pa, Val).
%% end of known-multiplier strings for which PER visible constraints are
@@ -805,14 +731,15 @@ encode_VideotexString(_C,Val) ->
%% into account.
%% This function does only encode the value part and NOT the length
-chars_encode(C,StringType,Value) ->
- case {StringType,get_constraint(C,'PermittedAlphabet')} of
+chars_encode(Pa, StringType, Value) ->
+ case {StringType,Pa} of
{'UniversalString',{_,_Sv}} ->
exit({error,{asn1,{'not implemented',"UniversalString with PermittedAlphabet constraint"}}});
{'BMPString',{_,_Sv}} ->
exit({error,{asn1,{'not implemented',"BMPString with PermittedAlphabet constraint"}}});
_ ->
- {NumBits,CharOutTab} = {get_NumBits(C,StringType),get_CharOutTab(C,StringType)},
+ {NumBits,CharOutTab} = {get_NumBits(Pa, StringType),
+ get_CharOutTab(Pa, StringType)},
chars_encode2(Value,NumBits,CharOutTab)
end.
@@ -839,8 +766,8 @@ exit_if_false(V,false)->
exit_if_false(_,V) ->V.
-get_NumBits(C,StringType) ->
- case get_constraint(C,'PermittedAlphabet') of
+get_NumBits(Pa, StringType) ->
+ case Pa of
{'SingleValue',Sv} ->
charbits(length(Sv));
no ->
@@ -860,22 +787,23 @@ get_NumBits(C,StringType) ->
end
end.
-get_CharOutTab(C,StringType) ->
- case get_constraint(C,'PermittedAlphabet') of
+get_CharOutTab(Pa, StringType) ->
+ case Pa of
{'SingleValue',Sv} ->
- get_CharTab2(C,StringType,hd(Sv),lists:max(Sv),Sv);
+ get_CharTab2(Pa, StringType, hd(Sv), lists:max(Sv), Sv);
no ->
case StringType of
'IA5String' ->
{0,16#7F,notab};
'VisibleString' ->
- get_CharTab2(C,StringType,16#20,16#7F,notab);
+ get_CharTab2(Pa, StringType, 16#20, 16#7F, notab);
'PrintableString' ->
Chars = lists:sort(
" '()+,-./0123456789:=?ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"),
- get_CharTab2(C,StringType,hd(Chars),lists:max(Chars),Chars);
+ get_CharTab2(Pa, StringType, hd(Chars),
+ lists:max(Chars), Chars);
'NumericString' ->
- get_CharTab2(C,StringType,16#20,$9," 0123456789");
+ get_CharTab2(Pa, StringType, 16#20, $9, " 0123456789");
'UniversalString' ->
{0,16#FFFFFFFF,notab};
'BMPString' ->
diff --git a/lib/asn1/test/Makefile b/lib/asn1/test/Makefile
index 6e6ab4639c..15b97df972 100644
--- a/lib/asn1/test/Makefile
+++ b/lib/asn1/test/Makefile
@@ -114,7 +114,8 @@ MODULES= \
asn1_app_test \
asn1_appup_test \
asn1_wrapper \
- asn1_SUITE
+ asn1_SUITE \
+ error_SUITE
SUITE= asn1_SUITE.erl
diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl
index 8deabece37..6be493320c 100644
--- a/lib/asn1/test/asn1_SUITE.erl
+++ b/lib/asn1/test/asn1_SUITE.erl
@@ -139,7 +139,6 @@ groups() ->
testSetOfCho,
testEnumExt,
value_test,
- value_bad_enum_test,
testSeq2738,
% Uses 'Constructed'
{group, [], [constructed,
@@ -177,6 +176,7 @@ groups() ->
testX420]},
testTcapsystem,
testNBAPsystem,
+ testS1AP,
test_compile_options,
testDoubleEllipses,
test_x691,
@@ -655,7 +655,6 @@ constraint_equivalence(Config) ->
AbsFile = filename:join(CaseDir, Asn1Spec++".abs"),
{ok,Terms} = file:consult(AbsFile),
Cs = [begin
- 'INTEGER' = element(3, Type), %Assertion.
Constraints = element(4, Type),
Name1 = atom_to_list(Name0),
{Name,_} = lists:splitwith(fun(C) -> C =/= $X end, Name1),
@@ -741,11 +740,6 @@ value_test(Config, Rule, Opts) ->
{ok, _} = asn1ct:test('ObjIdValues', 'ObjIdType',
'ObjIdValues':'mobileDomainId'()).
-value_bad_enum_test(Config) ->
- {error, _} = asn1ct:compile(?config(data_dir, Config) ++
- "BadEnumValue1",
- [{outdir, ?config(case_dir, Config)}]).
-
constructed(Config) ->
test(Config, fun constructed/3, [ber]).
constructed(Config, Rule, Opts) ->
@@ -860,7 +854,7 @@ testInvokeMod(Config, Rule, Opts) ->
{ok, _Result2} = 'PrimStrings':encode('Bs1', [1, 0, 1, 0]).
testExport(Config) ->
- {error, {asn1, _Reason}} =
+ {error, _} =
asn1ct:compile(filename:join(?config(data_dir, Config),
"IllegalExport"),
[{outdir, ?config(case_dir, Config)}]).
@@ -906,8 +900,8 @@ testOpenTypeImplicitTag(Config, Rule, Opts) ->
duplicate_tags(Config) ->
DataDir = ?config(data_dir, Config),
CaseDir = ?config(case_dir, Config),
- {error, {asn1, [{error, {type, _, _, 'SeqOpt1Imp',
- {asn1, {duplicates_of_the_tags, _}}}}]}} =
+ {error, [{error, {type, _, _, 'SeqOpt1Imp',
+ {asn1, {duplicates_of_the_tags, _}}}}]} =
asn1ct:compile(filename:join(DataDir, "SeqOptional2"),
[abs, {outdir, CaseDir}]).
@@ -1024,6 +1018,16 @@ testNBAPsystem(Config, Rule, Opts) ->
testNBAPsystem:compile(Config, [Rule|Opts]),
testNBAPsystem:test(Rule, Config).
+testS1AP(Config) -> test(Config, fun testS1AP/3).
+testS1AP(Config, Rule, Opts) ->
+ S1AP = ["S1AP-CommonDataTypes",
+ "S1AP-Constants",
+ "S1AP-Containers",
+ "S1AP-IEs",
+ "S1AP-PDU-Contents",
+ "S1AP-PDU-Descriptions"],
+ asn1_test_lib:compile_all(S1AP, Config, [Rule|Opts]).
+
test_compile_options(Config) ->
ok = test_compile_options:wrong_path(Config),
ok = test_compile_options:path(Config),
@@ -1077,17 +1081,14 @@ ticket_6143(Config) ->
ok = test_compile_options:ticket_6143(Config).
testExtensionAdditionGroup(Config) ->
- %% FIXME problems with automatic tags [ber_bin], [ber_bin, optimize]
- test(Config, fun testExtensionAdditionGroup/3, [per, uper]).
+ test(Config, fun testExtensionAdditionGroup/3).
testExtensionAdditionGroup(Config, Rule, Opts) ->
asn1_test_lib:compile("Extension-Addition-Group", Config, [Rule|Opts]),
asn1_test_lib:compile_erlang("extensionAdditionGroup", Config,
[debug_info]),
- extensionAdditionGroup:run([Rule|Opts]),
- extensionAdditionGroup:run2([Rule|Opts]),
- extensionAdditionGroup:run3(),
- asn1_test_lib:compile("EUTRA-RRC-Definitions", Config, [Rule, {record_name_prefix, "RRC-"}|Opts]),
- extensionAdditionGroup:run3([Rule|Opts]).
+ asn1_test_lib:compile("EUTRA-RRC-Definitions", Config,
+ [Rule,{record_name_prefix,"RRC-"}|Opts]),
+ extensionAdditionGroup:run(Rule).
% parse_modules() ->
% ["ImportsFrom"].
@@ -1097,11 +1098,8 @@ per_modules() ->
ber_modules() ->
[X || X <- test_modules(),
- X =/= "CommonDataTypes",
- X =/= "DS-EquipmentUser-CommonFunctionOrig-TransmissionPath",
X =/= "H323-MESSAGES",
- X =/= "H235-SECURITY-MESSAGES",
- X =/= "MULTIMEDIA-SYSTEM-CONTROL"].
+ X =/= "H235-SECURITY-MESSAGES"].
test_modules() ->
["BitStr",
diff --git a/lib/asn1/test/asn1_SUITE_data/BadEnumValue1.asn b/lib/asn1/test/asn1_SUITE_data/BadEnumValue1.asn
deleted file mode 100644
index dbc224a74b..0000000000
--- a/lib/asn1/test/asn1_SUITE_data/BadEnumValue1.asn
+++ /dev/null
@@ -1,8 +0,0 @@
-BadEnumValue1 DEFINITIONS AUTOMATIC TAGS ::=
-
-BEGIN
-
-E3 ::= ENUMERATED {monday,thuesday(0)}
-enumWrongVal E3 ::= sunday
-
-END
diff --git a/lib/asn1/test/asn1_SUITE_data/Certificate.asn b/lib/asn1/test/asn1_SUITE_data/Certificate.asn
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/asn1/test/asn1_SUITE_data/Certificate.asn
+++ /dev/null
diff --git a/lib/asn1/test/asn1_SUITE_data/ChoExtension.asn1 b/lib/asn1/test/asn1_SUITE_data/ChoExtension.asn1
index 18473bae30..f6fe18be10 100644
--- a/lib/asn1/test/asn1_SUITE_data/ChoExtension.asn1
+++ b/lib/asn1/test/asn1_SUITE_data/ChoExtension.asn1
@@ -41,4 +41,10 @@ ChoExt4 ::= CHOICE
str OCTET STRING
}
+ChoEmptyRoot ::= CHOICE {
+ ...,
+ bool BOOLEAN,
+ int INTEGER (0..7)
+}
+
END
diff --git a/lib/asn1/test/asn1_SUITE_data/ConstraintEquivalence.asn1 b/lib/asn1/test/asn1_SUITE_data/ConstraintEquivalence.asn1
index 6a97c1b38e..8b3d151502 100644
--- a/lib/asn1/test/asn1_SUITE_data/ConstraintEquivalence.asn1
+++ b/lib/asn1/test/asn1_SUITE_data/ConstraintEquivalence.asn1
@@ -8,6 +8,9 @@ BEGIN
SingleValueX5 ::= INTEGER ((42) INTERSECTION (MIN..MAX))
SingleValueX6 ::= INTEGER ((42) INTERSECTION (40..49))
SingleValueX7 ::= INTEGER (42..42)
+ SingleValueX8 ::= INTEGER (integer42)
+ SingleValueX9 ::= INTEGER (integer42..integer42)
+ SingleValueX10 ::= INTEGER ((integer42) INTERSECTION (40..49))
UnconstrainedX0 ::= INTEGER
UnconstrainedX1 ::= INTEGER (MIN..MAX)
@@ -24,6 +27,7 @@ BEGIN
RangeX04 ::= INTEGER (5|6|7|8|9|10)
RangeX05 ::= INTEGER (10|9|8|7|6|5)
RangeX06 ::= INTEGER (5|6|7..10)
+ RangeX07 ::= INTEGER (integer4<..<integer11)
RangeX10 ::= INTEGER ((5..6) UNION (7..8) UNION (9|10))
RangeX11 ::= INTEGER ((5|6) UNION (7..8) UNION (9|10))
@@ -39,4 +43,20 @@ BEGIN
RangeX23 ::= INTEGER ((0..10) INTERSECTION (5..20) ^ (MIN..MAX))
RangeX24 ::= INTEGER ((5|6|7|8|9|10) INTERSECTION (5..20) ^ (MIN..MAX))
+ UnconstrainedStringX00 ::= IA5String
+ UnconstrainedStringX01 ::= IA5String (SIZE (0..MAX))
+
+ ConstrainedStringX00 ::= IA5String (SIZE (0..5))
+ ConstrainedStringX01 ::= IA5String (SIZE (0|1|2|3|4|5))
+
+ -- Note: None of the back-ends care about the exact values
+ -- outside of the root range.
+ ExtConstrainedStringX00 ::= IA5String (SIZE (1..2, ...))
+ ExtConstrainedStringX01 ::= IA5String (SIZE (1|2, ..., 3))
+ ExtConstrainedStringX02 ::= IA5String (SIZE (1|2, ..., 3|4|5))
+
+ integer4 INTEGER ::= 4
+ integer11 INTEGER ::= 11
+ integer42 INTEGER ::= 42
+
END
diff --git a/lib/asn1/test/asn1_SUITE_data/Constraints.py b/lib/asn1/test/asn1_SUITE_data/Constraints.py
index 87243121f7..e4bc987e4c 100644
--- a/lib/asn1/test/asn1_SUITE_data/Constraints.py
+++ b/lib/asn1/test/asn1_SUITE_data/Constraints.py
@@ -12,6 +12,12 @@ ContainedSubtype ::= INTEGER (INCLUDES Range10to20)
-- Some ranges for additional constrained number testing.
LongLong ::= INTEGER (0..18446744073709551615)
Range256to65536 ::= INTEGER (256..65536)
+SemiConstrained ::= INTEGER (100..MAX)
+NegSemiConstrained ::= INTEGER (-128..MAX)
+SemiConstrainedExt ::= INTEGER (42..MAX, ...)
+NegSemiConstrainedExt ::= INTEGER (-128..MAX, ...)
+
+-- Other constraints
FixedSize ::= OCTET STRING (SIZE(10))
FixedSize2 ::= OCTET STRING (SIZE(10|20))
VariableSize ::= OCTET STRING (SIZE(1..10))
@@ -86,5 +92,6 @@ Document ::= OCTET STRING (ENCODED BY pdf)
pdf OBJECT IDENTIFIER ::= {1,2,3,4,5}
+ShorterExt ::= IA5String (SIZE (5, ...))
END
diff --git a/lib/asn1/test/asn1_SUITE_data/EUTRA-InterNodeDefinitions.asn b/lib/asn1/test/asn1_SUITE_data/EUTRA-InterNodeDefinitions.asn
deleted file mode 100644
index 5e6313dc02..0000000000
--- a/lib/asn1/test/asn1_SUITE_data/EUTRA-InterNodeDefinitions.asn
+++ /dev/null
@@ -1,123 +0,0 @@
--- 3GPP TS 36.331 V8.8.0 (2009-12)
--- $Id$
---
-EUTRA-InterNodeDefinitions DEFINITIONS AUTOMATIC TAGS ::=
-
-BEGIN
-
-
-HandoverCommand ::= SEQUENCE {
- criticalExtensions CHOICE {
- c1 CHOICE{
- handoverCommand-r8 HandoverCommand-r8-IEs,
- spare7 NULL,
- spare6 NULL, spare5 NULL, spare4 NULL,
- spare3 NULL, spare2 NULL, spare1 NULL
- },
- criticalExtensionsFuture SEQUENCE {}
- }
-}
-
-HandoverCommand-r8-IEs ::= SEQUENCE {
- handoverCommandMessage OCTET STRING (CONTAINING DL-DCCH-Message),
- nonCriticalExtension SEQUENCE {} OPTIONAL
-}
-
-
-HandoverPreparationInformation ::= SEQUENCE {
- criticalExtensions CHOICE {
- c1 CHOICE{
- handoverPreparationInformation-r8 HandoverPreparationInformation-r8-IEs,
- spare7 NULL,
- spare6 NULL, spare5 NULL, spare4 NULL,
- spare3 NULL, spare2 NULL, spare1 NULL
- },
- criticalExtensionsFuture SEQUENCE {}
- }
-}
-
-HandoverPreparationInformation-r8-IEs ::= SEQUENCE {
- ue-RadioAccessCapabilityInfo UE-CapabilityRAT-ContainerList,
- as-Config AS-Config OPTIONAL, -- Cond HO
- rrm-Config RRM-Config OPTIONAL,
- as-Context AS-Context OPTIONAL, -- Cond HO
- nonCriticalExtension SEQUENCE {} OPTIONAL
-}
-
-
-UERadioAccessCapabilityInformation ::= SEQUENCE {
- criticalExtensions CHOICE {
- c1 CHOICE{
- ueRadioAccessCapabilityInformation-r8
- UERadioAccessCapabilityInformation-r8-IEs,
- spare7 NULL,
- spare6 NULL, spare5 NULL, spare4 NULL,
- spare3 NULL, spare2 NULL, spare1 NULL
- },
- criticalExtensionsFuture SEQUENCE {}
- }
-}
-
-UERadioAccessCapabilityInformation-r8-IEs ::= SEQUENCE {
- ue-RadioAccessCapabilityInfo OCTET STRING (CONTAINING UECapabilityInformation),
- nonCriticalExtension SEQUENCE {} OPTIONAL
-}
-
-
-AS-Config ::= SEQUENCE {
- sourceMeasConfig MeasConfig,
- sourceRadioResourceConfig RadioResourceConfigDedicated,
- sourceSecurityAlgorithmConfig SecurityAlgorithmConfig,
- sourceUE-Identity C-RNTI,
- sourceMasterInformationBlock MasterInformationBlock,
- sourceSystemInformationBlockType1 SystemInformationBlockType1,
- sourceSystemInformationBlockType2 SystemInformationBlockType2,
- antennaInfoCommon AntennaInfoCommon,
- sourceDl-CarrierFreq ARFCN-ValueEUTRA,
- ...
-}
-
-
-AS-Context ::= SEQUENCE {
- reestablishmentInfo ReestablishmentInfo OPTIONAL -- Cond HO
-}
-
-
-ReestablishmentInfo ::= SEQUENCE {
- sourcePhysCellId PhysCellId,
- targetCellShortMAC-I ShortMAC-I,
- additionalReestabInfoList AdditionalReestabInfoList OPTIONAL,
- ...
-}
-
-AdditionalReestabInfoList ::= SEQUENCE ( SIZE (1..maxReestabInfo) ) OF AdditionalReestabInfo
-
-AdditionalReestabInfo ::= SEQUENCE{
- cellIdentity CellIdentity,
- key-eNodeB-Star Key-eNodeB-Star,
- shortMAC-I ShortMAC-I
-}
-
-Key-eNodeB-Star ::= BIT STRING (SIZE (256))
-
-
-RRM-Config ::= SEQUENCE {
- ue-InactiveTime ENUMERATED {
- s1, s2, s3, s5, s7, s10, s15, s20,
- s25, s30, s40, s50, min1, min1s20c, min1s40,
- min2, min2s30, min3, min3s30, min4, min5, min6,
- min7, min8, min9, min10, min12, min14, min17, min20,
- min24, min28, min33, min38, min44, min50, hr1,
- hr1min30, hr2, hr2min30, hr3, hr3min30, hr4, hr5, hr6,
- hr8, hr10, hr13, hr16, hr20, day1, day1hr12, day2,
- day2hr12, day3, day4, day5, day7, day10, day14, day19,
- day24, day30, dayMoreThan30} OPTIONAL,
- ...
-}
-
-
-maxReestabInfo INTEGER ::= 32 -- Maximum number of KeNB* and shortMAC-I forwarded
- -- at handover for re-establishment preparation
-
-
-END
diff --git a/lib/asn1/test/asn1_SUITE_data/EUTRA-UE-Variables.asn b/lib/asn1/test/asn1_SUITE_data/EUTRA-UE-Variables.asn
deleted file mode 100644
index 414140a6fb..0000000000
--- a/lib/asn1/test/asn1_SUITE_data/EUTRA-UE-Variables.asn
+++ /dev/null
@@ -1,49 +0,0 @@
--- 3GPP TS 36.331 V8.8.0 (2009-12)
--- $Id$
---
-EUTRA-UE-Variables DEFINITIONS AUTOMATIC TAGS ::=
-
-BEGIN
-
-
-VarMeasConfig ::= SEQUENCE {
- -- Measurement identities
- measIdList MeasIdToAddModList OPTIONAL,
- -- Measurement objects
- measObjectList MeasObjectToAddModList OPTIONAL,
- -- Reporting configurations
- reportConfigList ReportConfigToAddModList OPTIONAL,
- -- Other parameters
- quantityConfig QuantityConfig OPTIONAL,
- s-Measure RSRP-Range OPTIONAL,
- speedStatePars CHOICE {
- release NULL,
- setup SEQUENCE {
- mobilityStateParameters MobilityStateParameters,
- timeToTrigger-SF SpeedStateScaleFactors
- }
- } OPTIONAL
-}
-
-
-VarMeasReportList ::= SEQUENCE (SIZE (1..maxMeasId)) OF VarMeasReport
-
-VarMeasReport ::= SEQUENCE {
- -- List of measurement that have been triggered
- measId MeasId,
- cellsTriggeredList CellsTriggeredList OPTIONAL,
- numberOfReportsSent INTEGER
-}
-
-CellsTriggeredList ::= SEQUENCE (SIZE (1..maxCellMeas)) OF PhysCellId
-
-
-VarShortMAC-Input ::= SEQUENCE {
- cellIdentity CellIdentity,
- physCellId PhysCellId,
- c-RNTI C-RNTI
-}
-
-
-
-END \ No newline at end of file
diff --git a/lib/asn1/test/asn1_SUITE_data/EnumExt.asn1 b/lib/asn1/test/asn1_SUITE_data/EnumExt.asn1
index 9ad1f6299e..3a727e46bb 100644
--- a/lib/asn1/test/asn1_SUITE_data/EnumExt.asn1
+++ b/lib/asn1/test/asn1_SUITE_data/EnumExt.asn1
@@ -1,28 +1,35 @@
-EnumExt DEFINITIONS AUTOMATIC TAGS ::=
-BEGIN
-
-Ext ::= ENUMERATED {
- blue(0),
- red(1),
- green(2),
- ...
-}
-
-Ext1 ::= ENUMERATED {
- blue(0),
- red(1),
- green(2),
- ...,
- orange(7)
-}
-
-Noext ::= ENUMERATED {
- blue(0),
- red(1),
- green(2)
-}
-
-Globalstate ::= ENUMERATED {def(1),com(2),preop(3),oper(4),noop(5),fail(6)}
-
-END
-
+EnumExt DEFINITIONS AUTOMATIC TAGS ::=
+BEGIN
+
+Ext ::= ENUMERATED {
+ blue(0),
+ red(1),
+ green(2),
+ ...
+}
+
+Ext1 ::= ENUMERATED {
+ blue(0),
+ red(1),
+ green(2),
+ ...,
+ orange(7),
+ black(8),
+ magenta(9)
+}
+
+Noext ::= ENUMERATED {
+ blue(0),
+ red(1),
+ green(2)
+}
+
+Globalstate ::= ENUMERATED {def(1),com(2),preop(3),oper(4),noop(5),fail(6)}
+
+Seq ::= SEQUENCE {
+ e Ext1,
+ i INTEGER
+}
+
+END
+
diff --git a/lib/asn1/test/asn1_SUITE_data/InfObj.asn b/lib/asn1/test/asn1_SUITE_data/InfObj.asn
index 0a437e12df..53e5043cb7 100644
--- a/lib/asn1/test/asn1_SUITE_data/InfObj.asn
+++ b/lib/asn1/test/asn1_SUITE_data/InfObj.asn
@@ -39,21 +39,6 @@ RANAP-PDU ::= CHOICE {
CLASS2 ::= RANAP-ELEMENTARY-PROCEDURE
-MY-CLASS ::= CLASS {
- &integerValue INTEGER UNIQUE,
- &booleanValue BOOLEAN,
- &stringValue PrintableString
- }
-
-myobject MY-CLASS ::= {
- &integerValue 12,
- &booleanValue TRUE,
- &stringValue "hejsan"
- }
-MyObjectSet MY-CLASS ::= {
- myobject
- }
-
InitiatingMessage ::= SEQUENCE {
procedureCode RANAP-ELEMENTARY-PROCEDURE.&procedureCode ({RANAP-ELEMENTARY-PROCEDURES}),
criticality RANAP-ELEMENTARY-PROCEDURE.&criticality ({RANAP-ELEMENTARY-PROCEDURES}{@procedureCode}),
@@ -148,6 +133,83 @@ id-Iu-Release3 INTEGER ::= 3
id-Iu-Release4 INTEGER ::= 4
id-Iu-Release5 INTEGER ::= 5
+--
+-- MY-CLASS
+--
+
+Seq ::= SEQUENCE {
+ int INTEGER,
+ str OCTET STRING
+}
+
+MY-CLASS ::= CLASS {
+ &Count DEFAULT INTEGER,
+ &integerValue INTEGER UNIQUE,
+ &booleanValue BOOLEAN,
+ &stringValue PrintableString
+}
+
+myobject MY-CLASS ::= {
+ &integerValue 12,
+ &booleanValue TRUE,
+ &stringValue "hejsan"
+}
+
+myotherobject MY-CLASS ::= {
+ &Count Seq,
+ &integerValue 42,
+ &booleanValue FALSE,
+ &stringValue "hoppsan"
+}
+
+MyObjectSet MY-CLASS ::= {
+ myobject | myotherobject |
+ {
+ -- Each character will be encoded in 3 bits in UPER, 4 bits in PER.
+ &Count NumericString (FROM("01234567") ^ SIZE(8)),
+ &integerValue 43,
+ &booleanValue TRUE,
+ &stringValue "tjosan"
+ }
+}
+
+MyPdu ::= SEQUENCE {
+ count MY-CLASS.&Count ({MyObjectSet}{@int}),
+ int MY-CLASS.&integerValue ({MyObjectSet}),
+ bool MY-CLASS.&booleanValue ({MyObjectSet}{@int}),
+ str MY-CLASS.&stringValue ({MyObjectSet}{@int})
+}
+
+Seq2 ::= SEQUENCE {
+ int MY-CLASS.&integerValue ({MyObjectSet}),
+ seqof SEQUENCE (1..10) OF MY-CLASS.&booleanValue ({MyObjectSet}{@int}),
+ setof SET (1..10) OF MY-CLASS.&booleanValue ({MyObjectSet}{@int})
+}
+
+--
+-- Class with constructed default
+--
+
+CONSTRUCTED-DEFAULT ::= CLASS {
+ &id INTEGER UNIQUE,
+ &Type DEFAULT SEQUENCE { a INTEGER, b BOOLEAN },
+ &ok BOOLEAN DEFAULT TRUE
+}
+
+constructed1 CONSTRUCTED-DEFAULT ::= { &id 1 }
+constructed2 CONSTRUCTED-DEFAULT ::= { &id 2, &ok false }
+
+ConstructedDefaultSet CONSTRUCTED-DEFAULT ::= {
+ constructed1 |
+ constructed2 |
+ { &id 3, &Type BOOLEAN }
+}
+
+ConstructedPdu ::= SEQUENCE {
+ id CONSTRUCTED-DEFAULT.&id ({ConstructedDefaultSet}),
+ content CONSTRUCTED-DEFAULT.&Type ({ConstructedDefaultSet}{@id})
+}
+
END
diff --git a/lib/asn1/test/asn1_SUITE_data/InfObj2.asn b/lib/asn1/test/asn1_SUITE_data/InfObj2.asn
deleted file mode 100644
index faba7371a4..0000000000
--- a/lib/asn1/test/asn1_SUITE_data/InfObj2.asn
+++ /dev/null
@@ -1,156 +0,0 @@
-InfObj2 DEFINITIONS ::=
-BEGIN
-
-
-RANAP-ELEMENTARY-PROCEDURE ::= CLASS {
- &InitiatingMessage ,
- &SuccessfulOutcome OPTIONAL,
- &Outcome DEFAULT NULL,
- &vartypvalue &Outcome,
- &FixTypeValSet PrintableString,
- &VarTypeValSet &InitiatingMessage,
- &infoObject RANAP-ELEMENTARY-PROCEDURE,
- &InfObjectSet CLASS2,
- &UnsuccessfulOutcome OPTIONAL,
- &procedureCode ProcedureCode UNIQUE,
- &criticality Criticality DEFAULT ignore
-}
-WITH SYNTAX {
- INITIATING MESSAGE &InitiatingMessage
- [SUCCESSFUL OUTCOME &SuccessfulOutcome]
- [UNSUCCESSFUL OUTCOME &UnsuccessfulOutcome]
- [OUTCOME &Outcome]
- PROCEDURE CODE &procedureCode
- [CRITICALITY &criticality]
-}
-
-RANAP-PDU ::= CHOICE {
- initiatingMessage [0] InitiatingMessage,
- substrings [1] SEQUENCE {
- type RANAP-ELEMENTARY-PROCEDURE.&procedureCode({RANAP-ELEMENTARY-PROCEDURES}),
- strings SEQUENCE OF CHOICE {
- initial [0] RANAP-ELEMENTARY-PROCEDURE.&Outcome({
- RANAP-ELEMENTARY-PROCEDURES}{@substrings.type}),
- final [1] RANAP-ELEMENTARY-PROCEDURE.&Outcome({RANAP-ELEMENTARY-PROCEDURES}{@substrings.type})
- }
- },
--- successfulOutcome SuccessfulOutcome,
--- unsuccessfulOutcome UnsuccessfulOutcome,
--- outcome Outcome,
- ...
- }
-
-CLASS2 ::= RANAP-ELEMENTARY-PROCEDURE
-
-MY-CLASS ::= CLASS {
- &integerValue INTEGER UNIQUE,
- &booleanValue BOOLEAN,
- &stringValue PrintableString
- }
-
-myobject MY-CLASS ::= {
- &integerValue 12,
- &booleanValue TRUE,
- &stringValue "hejsan"
- }
-MyObjectSet MY-CLASS ::= {
- myobject
- }
-
-InitiatingMessage ::= SEQUENCE {
- procedureCode RANAP-ELEMENTARY-PROCEDURE.&procedureCode ({RANAP-ELEMENTARY-PROCEDURES}),
- criticality RANAP-ELEMENTARY-PROCEDURE.&criticality ({RANAP-ELEMENTARY-PROCEDURES}{@procedureCode}),
- value RANAP-ELEMENTARY-PROCEDURE.&InitiatingMessage ({RANAP-ELEMENTARY-PROCEDURES}{@procedureCode})
- }
-
-iu-Release RANAP-ELEMENTARY-PROCEDURE ::= {
- INITIATING MESSAGE Iu-ReleaseCommand
- SUCCESSFUL OUTCOME Iu-ReleaseComplete
- PROCEDURE CODE id-Iu-Release1
- CRITICALITY ignore
- }
-
-relocationPreparation RANAP-ELEMENTARY-PROCEDURE ::= {
- INITIATING MESSAGE INTEGER --Iu-ReleaseCommand
- SUCCESSFUL OUTCOME Iu-ReleaseComplete
- PROCEDURE CODE id-Iu-Release2
- CRITICALITY notify
- }
-
-object3 RANAP-ELEMENTARY-PROCEDURE ::= {
- &InitiatingMessage Iu-ReleaseCommand,
- &SuccessfulOutcome Iu-ReleaseComplete,
- &procedureCode id-Iu-Release3,
- &criticality reject
- }
-
-object4 RANAP-ELEMENTARY-PROCEDURE ::= {
- &InitiatingMessage INTEGER,
- &SuccessfulOutcome PrintableString,
- &procedureCode id-Iu-Release4,
- &criticality reject
- }
-
-object5 RANAP-ELEMENTARY-PROCEDURE ::= {
- &InitiatingMessage INTEGER,
- &SuccessfulOutcome PrintableString,
- &Outcome ProcedureCode,
- &vartypvalue 12,
- &infoObject object4,
- &InfObjectSet MyObjectSet,
- &procedureCode id-Iu-Release5,
- &criticality reject
- }
-
-
-RANAP-ELEMENTARY-PROCEDURES RANAP-ELEMENTARY-PROCEDURE ::= {
- iu-Release |
- relocationPreparation ,
- ...
- }
-
-RANAP-ELEMENTARY-PROCEDURES2 RANAP-ELEMENTARY-PROCEDURE ::= {
- iu-Release |
- relocationPreparation
- }
-
-
-OBJECTSET1 RANAP-ELEMENTARY-PROCEDURE ::= {
- {INITIATING MESSAGE Iu-ReleaseCommand SUCCESSFUL OUTCOME Iu-ReleaseComplete PROCEDURE CODE id-Iu-Release1 CRITICALITY ignore} | {INITIATING MESSAGE Iu-ReleaseCommand PROCEDURE CODE id-Iu-Release2}
- }
-
-OBJECTSET2 RANAP-ELEMENTARY-PROCEDURE ::= {
- iu-Release |
- {INITIATING MESSAGE Iu-ReleaseCommand SUCCESSFUL OUTCOME Iu-ReleaseComplete PROCEDURE CODE id-Iu-Release4 CRITICALITY ignore} |
- relocationPreparation |
- {INITIATING MESSAGE Iu-ReleaseCommand PROCEDURE CODE id-Iu-Release5} ,
- ...
- }
-
-OBJECTSET3 RANAP-ELEMENTARY-PROCEDURE ::= {
- iu-Release,
- ...
- }
-
-OBJECTSET4 RANAP-ELEMENTARY-PROCEDURE ::= {
- iu-Release
- }
-
-Iu-ReleaseCommand ::= SEQUENCE {
- first INTEGER,
- second BOOLEAN
- }
-
-Iu-ReleaseComplete ::= INTEGER (1..510)
-
-ProcedureCode ::= INTEGER (0..255)
-Criticality ::= ENUMERATED { reject, ignore, notify }
-id-Iu-Release1 INTEGER ::= 1
-id-Iu-Release2 INTEGER ::= 2
-id-Iu-Release3 INTEGER ::= 3
-id-Iu-Release4 INTEGER ::= 4
-id-Iu-Release5 INTEGER ::= 5
-
-END
-
-
diff --git a/lib/asn1/test/asn1_SUITE_data/MAP-insertSubscriberData-def.py b/lib/asn1/test/asn1_SUITE_data/MAP-insertSubscriberData-def.py
deleted file mode 100644
index 298319b0ed..0000000000
--- a/lib/asn1/test/asn1_SUITE_data/MAP-insertSubscriberData-def.py
+++ /dev/null
@@ -1,102 +0,0 @@
-MAP-insertSubscriberData-def
- { ccitt (0) identified-organization( 4) etsi( 0) mobileDomain(0)
- gsm-Network( 1) modules( 3) map-Protocol( 4) version2(2) }
-DEFINITIONS ::=
-
-BEGIN
-
-EXPORTS
-InsertSubsDataArg, InsertSubsDatRes;
-IMPORTS
-IMSI, ISDN-AddressString, LMSI FROM MAP-commonDataTypes;
-
-InsertSubsDataArg ::= SEQUENCE{
- imsi [0] IMPLICIT IMSI OPTIONAL,
- msisdn [1] IMPLICIT ISDN-AddressString OPTIONAL,
- category [2] IMPLICIT OCTET STRING (SIZE(1)) OPTIONAL,
- subscriberStatus [3] IMPLICIT SubscriberStatus OPTIONAL,
- bearerServiceList [4] IMPLICIT SEQUENCE OF
- OCTET STRING(SIZE(1)) OPTIONAL,
- teleServiceList [6] IMPLICIT SEQUENCE OF
- OCTET STRING(SIZE(1)) OPTIONAL,
- provisionedSS [7] IMPLICIT SEQUENCE OF SS-Information OPTIONAL
- }
-
-SS-Information ::= CHOICE{
- forwardingInfo [0] IMPLICIT ForwardingInfo,
- callBarringInfoInfo [1] IMPLICIT CallBarringInfoInfo,
- ss-Data [3] IMPLICIT SS-Data }
-
-SS-Data ::= SEQUENCE {
- ss-Code OCTET STRING (SIZE(1)),
- ss-Status [4] IMPLICIT OCTET STRING (SIZE(1))
- }
-
-
-ForwardingInfo ::= SEQUENCE {
- ss-Code OCTET STRING(SIZE(1)) OPTIONAL,
- forwardingFeatureList ForwardingFeatureList
- }
-
-CallBarringInfoInfo ::= SEQUENCE {
- ss-Code OCTET STRING(SIZE(1)) OPTIONAL,
- callBarringFeatureList CallBarringFeatureList}
-
-CallBarringFeatureList ::= SEQUENCE OF CallBarringFeature
-
-CallBarringFeature ::= SEQUENCE{
- basicService BasicServiceCode OPTIONAL,
- ss-Status [2] IMPLICIT OCTET STRING(SIZE(1)) OPTIONAL
- }
-
-InsertSubsDatRes ::=
- SEQUENCE {
- teleServiceList [1] IMPLICIT SEQUENCE OF
- OCTET STRING (SIZE(1)) OPTIONAL,
- bearerServiceList [2] IMPLICIT SEQUENCE OF
- OCTET STRING (SIZE(1)) OPTIONAL,
- ss-List [3] IMPLICIT SEQUENCE OF
- OCTET STRING (SIZE(1)) OPTIONAL,
- odb-GeneralData [4] IMPLICIT BIT STRING {
- allOG-CallsBarred (0),
- internationalOGCallsBarred (1),
- internationalOGCallsNotToHPLMN-CountryBarred (2),
- premiumRateInformationOGCallsBarred (3),
- premiumRateEntertainementOGCallsBarred (4),
- ss-AccessBarred (5) } (SIZE(6)) OPTIONAL,
- regionalSubscriptionResponse [5] IMPLICIT ENUMERATED{
- msc-AreaRestricted (0),
- tooManyZoneCodes (1),
- zoneCodeConflict (2),
- regionalSubscNotSupported (3) } OPTIONAL
- }
-
-
-ForwardingFeatureList ::= SEQUENCE OF ForwardingFeature
-
-ForwardingFeature ::= SEQUENCE{
- basicService BasicServiceCode OPTIONAL,
- ss-Status [4] IMPLICIT OCTET STRING(SIZE(1)) OPTIONAL,
- forwardedToNumber [5] ISDN-AddressString OPTIONAL,
- forwardingOptions [6] IMPLICIT OCTET STRING(SIZE(1)) OPTIONAL,
- noReplyConditionTime [7] IMPLICIT INTEGER(5..30) OPTIONAL
- }
-
-
-BasicServiceCode ::= CHOICE {
- bearerService [2] IMPLICIT OCTET STRING(SIZE(1)),
- teleService [3] IMPLICIT OCTET STRING(SIZE(1))
- }
-
-
-BasicServiceGroupList ::= SEQUENCE OF
- BasicServiceCode
-
-
-SubscriberStatus ::= ENUMERATED {
- serviceGranted (0),
- operatorDeterminedBarring (1)
- }
-
-END -- of MAP-insertSubscriberData-def
-
diff --git a/lib/asn1/test/asn1_SUITE_data/Mod.set.asn b/lib/asn1/test/asn1_SUITE_data/Mod.set.asn
deleted file mode 100644
index 5dcd8706ae..0000000000
--- a/lib/asn1/test/asn1_SUITE_data/Mod.set.asn
+++ /dev/null
@@ -1,5 +0,0 @@
-Mod1.asn
-Mod2.asn
-Mod3.asn
-Mod4.asn
-Mod5.asn
diff --git a/lib/asn1/test/asn1_SUITE_data/Mod1.asn b/lib/asn1/test/asn1_SUITE_data/Mod1.asn
deleted file mode 100644
index cb29997985..0000000000
--- a/lib/asn1/test/asn1_SUITE_data/Mod1.asn
+++ /dev/null
@@ -1,18 +0,0 @@
-Mod1 DEFINITIONS AUTOMATIC TAGS ::=
-
-BEGIN
-
-IMPORTS
- Co,Reg
- FROM Mod5
- Name
- FROM Mod4;
-
-
-L ::= SEQUENCE {
- country Co,
- region Reg,
- name Name
-}
-
-END
diff --git a/lib/asn1/test/asn1_SUITE_data/Mod2.asn b/lib/asn1/test/asn1_SUITE_data/Mod2.asn
deleted file mode 100644
index cc22c6f13c..0000000000
--- a/lib/asn1/test/asn1_SUITE_data/Mod2.asn
+++ /dev/null
@@ -1,43 +0,0 @@
-Mod2 DEFINITIONS AUTOMATIC TAGS ::=
-
-BEGIN
-
-IMPORTS
- Stat,Country
- FROM Mod3
- L
- FROM Mod1
- Time,LocName,ThingName,Name
- FROM Mod4;
-
-T ::= SEQUENCE {
- unit ENUMERATED{celsius,fahrenheit,kelvin},
- degree INTEGER,
- location L,
- time Time,
- statistics Stat
-}
-
-OtherName ::= SEQUENCE {
- locationName LocName,
- thingName ThingName
-}
-
-FirstName ::= CHOICE {
- firstname PrintableString,
- nickname PrintableString
-}
-
-FamilyName ::= SEQUENCE{
- prefix ENUMERATED{none,von,af},
- secondname PrintableString
-}
-
-Lang ::= SEQUENCE{
- l PrintableString}
-
-Inhabitant ::= SEQUENCE {
- name Name,
- country Country}
-
-END
diff --git a/lib/asn1/test/asn1_SUITE_data/Mod3.asn b/lib/asn1/test/asn1_SUITE_data/Mod3.asn
deleted file mode 100644
index 8069bedcf9..0000000000
--- a/lib/asn1/test/asn1_SUITE_data/Mod3.asn
+++ /dev/null
@@ -1,33 +0,0 @@
-Mod3 DEFINITIONS AUTOMATIC TAGS ::=
-
-BEGIN
-
-IMPORTS
- Name
- FROM Mod4
- Lang, Inhabitant,FirstName,FamilyName
- FROM Mod2
- TS, RFS, WS, HS
- FROM Mod5;
-
-Stat ::= SEQUENCE {
- tempstat TS,
- rainfallstat RFS,
- windstat WS,
- humiditystat HS
-}
-
-Country ::= SEQUENCE{
- name Name,
- language Lang
-}
-
-RegionName ::= Name
-Inhabitants ::= SEQUENCE OF Inhabitant
-
-PersonName ::= SEQUENCE {
- name1 FirstName,
- name2 FamilyName
-}
-
-END
diff --git a/lib/asn1/test/asn1_SUITE_data/Mod4.asn b/lib/asn1/test/asn1_SUITE_data/Mod4.asn
deleted file mode 100644
index 4a1aaff9dc..0000000000
--- a/lib/asn1/test/asn1_SUITE_data/Mod4.asn
+++ /dev/null
@@ -1,33 +0,0 @@
-Mod4 DEFINITIONS AUTOMATIC TAGS ::=
-
-
-BEGIN
-
-IMPORTS
- PersonName
- FROM Mod3
- OtherName,FirstName,FamilyName
- FROM Mod2;
-
-Time ::= SEQUENCE {
- year OCTET STRING(SIZE(4)),
- month OCTET STRING(SIZE(2)),
- hour INTEGER,
- minute INTEGER
-}
-
-Name ::= CHOICE {
- person PersonName,
- othername OtherName
-}
-
-
-
-LocName ::= SEQUENCE {
- region ENUMERATED{gotaland,svealand,norrland},
- name PrintableString
-}
-
-ThingName ::= PrintableString
-
-END
diff --git a/lib/asn1/test/asn1_SUITE_data/Mod5.asn b/lib/asn1/test/asn1_SUITE_data/Mod5.asn
deleted file mode 100644
index 71b483d0e0..0000000000
--- a/lib/asn1/test/asn1_SUITE_data/Mod5.asn
+++ /dev/null
@@ -1,37 +0,0 @@
-Mod5 DEFINITIONS AUTOMATIC TAGS ::=
-
-BEGIN
-
-IMPORTS
- Country,RegionName,Inhabitants
- FROM Mod3;
-TS ::= SEQUENCE {
- average INTEGER,
- highest INTEGER,
- lowest INTEGER
-}
-
-RFS ::= SEQUENCE {
- average INTEGER,
- highest INTEGER
-}
-
-WS ::= SEQUENCE {
- average INTEGER,
- highest INTEGER
-}
-
-HS ::= SEQUENCE {
- average INTEGER,
- highest INTEGER,
- lowest INTEGER
-}
-
-Co ::= Country
-
-Reg ::= SEQUENCE {
- name RegionName,
- inhabitants Inhabitants
-}
-
-END
diff --git a/lib/asn1/test/asn1_SUITE_data/Mvrasn.set.asn b/lib/asn1/test/asn1_SUITE_data/Mvrasn.set.asn
deleted file mode 100644
index 8a61da0160..0000000000
--- a/lib/asn1/test/asn1_SUITE_data/Mvrasn.set.asn
+++ /dev/null
@@ -1,7 +0,0 @@
-Mvrasn-11-6.asn
-Mvrasn-21-4.asn
-Mvrasn-20-6.asn
-Mvrasn-19-6.asn
-Mvrasn-15-6.asn
-Mvrasn-18-6.asn
-Mvrasn-14-6.asn
diff --git a/lib/asn1/test/asn1_SUITE_data/P-Record.asn1db b/lib/asn1/test/asn1_SUITE_data/P-Record.asn1db
deleted file mode 100644
index 13e1162c64..0000000000
--- a/lib/asn1/test/asn1_SUITE_data/P-Record.asn1db
+++ /dev/null
Binary files differ
diff --git a/lib/asn1/test/asn1_SUITE_data/P-Record.erl b/lib/asn1/test/asn1_SUITE_data/P-Record.erl
deleted file mode 100644
index 9fc6f50d64..0000000000
--- a/lib/asn1/test/asn1_SUITE_data/P-Record.erl
+++ /dev/null
@@ -1,244 +0,0 @@
-%% Generated by the Erlang ASN.1 BER-compiler version, utilizing bit-syntax:1.3.1.4
-%% Purpose: encoder and decoder to the types in mod P-Record
-
--module('P-Record').
--include("P-Record.hrl").
--define('RT_PER',asn1rt_per_bin).
--export([encoding_rule/0]).
--export([
-'enc_PersonnelRecord'/1,
-'enc_ChildInformation'/1,
-'enc_Name'/1,
-'enc_EmployeeNumber'/1,
-'enc_Date'/1
-]).
-
--export([
-'dec_PersonnelRecord'/2,
-'dec_ChildInformation'/2,
-'dec_Name'/2,
-'dec_EmployeeNumber'/2,
-'dec_Date'/2
-]).
-
--export([
-'v'/0
-]).
-
-
-
--export([encode/2,decode/2,encode_disp/2,decode_disp/2]).
-
-encoding_rule() ->
- per_bin.
-
-encode(Type,Data) ->
-case catch ?RT_PER:complete(encode_disp(Type,Data)) of
- {'EXIT',{error,Reason}} ->
- {error,Reason};
- {'EXIT',Reason} ->
- {error,{asn1,Reason}};
- {Bytes,Len} ->
- {ok,Bytes};
- X ->
- {ok,X}
-end.
-
-decode(Type,Data) ->
-case catch decode_disp(Type,Data) of
- {'EXIT',{error,Reason}} ->
- {error,Reason};
- {'EXIT',Reason} ->
- {error,{asn1,Reason}};
- {X,_Rest} ->
- {ok,X};
- {X,_Rest,_Len} ->
- {ok,X}
-end.
-
-encode_disp('PersonnelRecord',Data) -> 'enc_PersonnelRecord'(Data);
-encode_disp('ChildInformation',Data) -> 'enc_ChildInformation'(Data);
-encode_disp('Name',Data) -> 'enc_Name'(Data);
-encode_disp('EmployeeNumber',Data) -> 'enc_EmployeeNumber'(Data);
-encode_disp('Date',Data) -> 'enc_Date'(Data);
-encode_disp(Type,Data) -> exit({error,{asn1,{undefined_type,Type}}}).
-
-
-decode_disp('PersonnelRecord',Data) -> 'dec_PersonnelRecord'(Data,mandatory);
-decode_disp('ChildInformation',Data) -> 'dec_ChildInformation'(Data,mandatory);
-decode_disp('Name',Data) -> 'dec_Name'(Data,mandatory);
-decode_disp('EmployeeNumber',Data) -> 'dec_EmployeeNumber'(Data,mandatory);
-decode_disp('Date',Data) -> 'dec_Date'(Data,mandatory);
-decode_disp(Type,Data) -> exit({error,{asn1,{undefined_type,Type}}}).
-
-
-
-
-
-'enc_PersonnelRecord'(Val) ->
-{Val1,Opt} = ?RT_PER:fixoptionals([{children,6}],Val),
-[
-?RT_PER:setoptionals(Opt),
-
-%% attribute number 1 with type Externaltypereference6P-RecordName
-'enc_Name'(?RT_PER:cindex(2,Val1,name)),
-
-%% attribute number 2 with type VisibleString
-?RT_PER:encode_VisibleString([],?RT_PER:cindex(3,Val1,title)),
-
-%% attribute number 3 with type INTEGER
-?RT_PER:encode_integer([],?RT_PER:cindex(4,Val1,number)),
-
-%% attribute number 4 with type VisibleString
-?RT_PER:encode_VisibleString([],?RT_PER:cindex(5,Val1,dateOfHire)),
-
-%% attribute number 5 with type Externaltypereference10P-RecordName
-'enc_Name'(?RT_PER:cindex(6,Val1,nameOfSpouse)),
-case ?RT_PER:cindex(7,Val1,children) of
-asn1_DEFAULT -> [];
-_ ->
-
-%% attribute number 6 with type SEQUENCE OF
-'enc_PersonnelRecord_children'(?RT_PER:cindex(7,Val1,children))
-end].
-
-'enc_PersonnelRecord_children'({'PersonnelRecord_children',Val}) ->
-'enc_PersonnelRecord_children'(Val);
-
-'enc_PersonnelRecord_children'(Val) ->
-[
-
- ?RT_PER:encode_length(undefined,length(Val)),
- 'enc_PersonnelRecord_children_components'(Val, [])
-].
-'enc_PersonnelRecord_children_components'([], Acc) -> lists:reverse(Acc);
-
-'enc_PersonnelRecord_children_components'([H|T], Acc) ->
-'enc_PersonnelRecord_children_components'(T, ['enc_ChildInformation'(H)
-
- | Acc]).
-
-'dec_PersonnelRecord_children'(Bytes,Telltype) ->
-
-{Num,Bytes1} = ?RT_PER:decode_length(Bytes,undefined),
-'dec_PersonnelRecord_children_components'(Num, Bytes1, Telltype, []).
-'dec_PersonnelRecord_children_components'(0, Bytes, Telltype, Acc) ->
- {lists:reverse(Acc), Bytes};
-'dec_PersonnelRecord_children_components'(Num, Bytes, Telltype, Acc) ->
- {Term,Remain} = 'P-Record':'dec_ChildInformation'(Bytes,Telltype),
- 'dec_PersonnelRecord_children_components'(Num-1, Remain, Telltype, [Term|Acc]).
-
-
-'dec_PersonnelRecord'(Bytes,Telltype) ->
-{Opt,Bytes1} = ?RT_PER:getoptionals(Bytes,1),
-%% attribute number 1 with type Name
-{Term1,Bytes2} = 'dec_Name'(Bytes1,telltype),
-
-%% attribute number 2 with type VisibleString
-{Term2,Bytes3} = ?RT_PER:decode_VisibleString(Bytes2,[]),
-
-%% attribute number 3 with type INTEGER
-{Term3,Bytes4} = ?RT_PER:decode_integer(Bytes3,[]),
-
-%% attribute number 4 with type VisibleString
-{Term4,Bytes5} = ?RT_PER:decode_VisibleString(Bytes4,[]),
-
-%% attribute number 5 with type Name
-{Term5,Bytes6} = 'dec_Name'(Bytes5,telltype),
-
-%% attribute number 6 with type SEQUENCE OF
-{Term6,Bytes7} = case element(1,Opt) of
-1 ->'dec_PersonnelRecord_children'(Bytes6, Telltype);
-0 ->{[],Bytes6}
-
-end,
-{{'PersonnelRecord',Term1,Term2,Term3,Term4,Term5,Term6},Bytes7}.
-
-'enc_ChildInformation'(Val) ->
-{Val1,Opt} = ?RT_PER:fixoptionals([{name,1},{dateOfBirth,2}],Val),
-[
-?RT_PER:setoptionals(Opt),
-case ?RT_PER:cindex(2,Val1,name) of
-asn1_NOVALUE -> [];
-_ ->
-
-%% attribute number 1 with type Externaltypereference15P-RecordName
-'enc_Name'(?RT_PER:cindex(2,Val1,name))
-end,
-case ?RT_PER:cindex(3,Val1,dateOfBirth) of
-asn1_NOVALUE -> [];
-_ ->
-
-%% attribute number 2 with type VisibleString
-?RT_PER:encode_VisibleString([],?RT_PER:cindex(3,Val1,dateOfBirth))
-end].
-
-
-'dec_ChildInformation'(Bytes,Telltype) ->
-{Opt,Bytes1} = ?RT_PER:getoptionals(Bytes,2),
-%% attribute number 1 with type Name
-{Term1,Bytes2} = case element(1,Opt) of
-1 ->'dec_Name'(Bytes1,telltype);
-0 ->{asn1_NOVALUE,Bytes1}
-
-end,
-
-%% attribute number 2 with type VisibleString
-{Term2,Bytes3} = case element(2,Opt) of
-1 ->?RT_PER:decode_VisibleString(Bytes2,[]);
-0 ->{asn1_NOVALUE,Bytes2}
-
-end,
-{{'ChildInformation',Term1,Term2},Bytes3}.
-
-'enc_Name'(Val) ->
-Val1 = ?RT_PER:list_to_record('Name', Val),
-[
-
-%% attribute number 1 with type VisibleString
-?RT_PER:encode_VisibleString([],?RT_PER:cindex(2,Val1,givenName)),
-
-%% attribute number 2 with type VisibleString
-?RT_PER:encode_VisibleString([],?RT_PER:cindex(3,Val1,initial)),
-
-%% attribute number 3 with type VisibleString
-?RT_PER:encode_VisibleString([],?RT_PER:cindex(4,Val1,familyName))].
-
-
-'dec_Name'(Bytes,Telltype) ->
-
-%% attribute number 1 with type VisibleString
-{Term1,Bytes1} = ?RT_PER:decode_VisibleString(Bytes,[]),
-
-%% attribute number 2 with type VisibleString
-{Term2,Bytes2} = ?RT_PER:decode_VisibleString(Bytes1,[]),
-
-%% attribute number 3 with type VisibleString
-{Term3,Bytes3} = ?RT_PER:decode_VisibleString(Bytes2,[]),
-{{'Name',Term1,Term2,Term3},Bytes3}.
-
-
-'enc_EmployeeNumber'({'EmployeeNumber',Val}) ->
-'enc_EmployeeNumber'(Val);
-
-'enc_EmployeeNumber'(Val) ->
-?RT_PER:encode_integer([],Val).
-
-
-'dec_EmployeeNumber'(Bytes,Telltype) ->
-?RT_PER:decode_integer(Bytes,[]).
-
-
-'enc_Date'({'Date',Val}) ->
-'enc_Date'(Val);
-
-'enc_Date'(Val) ->
-?RT_PER:encode_VisibleString([],Val).
-
-
-'dec_Date'(Bytes,Telltype) ->
-?RT_PER:decode_VisibleString(Bytes,[]).
-
-'v'() ->
-{'PersonnelRecord',{'Name',{74,111,104,110},[80],[83,109,105,116,104]},[68,105,114,101,99,116,111,114],51,[49,57,55,49,48,57,49,55],{'Name',{77,97,114,121},[84],[83,109,105,116,104]},[{'ChildInformation',{'Name',[82,97,108,112,104],[84],[83,109,105,116,104]},[49,57,53,55,49,49,49,49]},{'ChildInformation',{'Name',[83,117,115,97,110],[66],[74,111,110,101,115]},[49,57,53,57,48,55,49,55]}]}.
-
diff --git a/lib/asn1/test/asn1_SUITE_data/P-Record.hrl b/lib/asn1/test/asn1_SUITE_data/P-Record.hrl
deleted file mode 100644
index 92aa1a44e2..0000000000
--- a/lib/asn1/test/asn1_SUITE_data/P-Record.hrl
+++ /dev/null
@@ -1,17 +0,0 @@
-%% Generated by the Erlang ASN.1 compiler version:1.3.1.4
-%% Purpose: Erlang record definitions for each named and unnamed
-%% SEQUENCE and SET, and macro definitions for each value
-%% definition,in module P-Record
-
-
-
--record('PersonnelRecord',{
-name, title, number, dateOfHire, nameOfSpouse, children = asn1_DEFAULT}).
-
--record('ChildInformation',{
-name = asn1_NOVALUE, dateOfBirth = asn1_NOVALUE}).
-
--record('Name',{
-givenName, initial, familyName}).
-
--define('v', {'PersonnelRecord',{'Name',{74,111,104,110},[80],[83,109,105,116,104]},[68,105,114,101,99,116,111,114],51,[49,57,55,49,48,57,49,55],{'Name',{77,97,114,121},[84],[83,109,105,116,104]},[{'ChildInformation',{'Name',[82,97,108,112,104],[84],[83,109,105,116,104]},[49,57,53,55,49,49,49,49]},{'ChildInformation',{'Name',[83,117,115,97,110],[66],[74,111,110,101,115]},[49,57,53,57,48,55,49,55]}]}).
diff --git a/lib/asn1/test/asn1_SUITE_data/PDUs.py b/lib/asn1/test/asn1_SUITE_data/PDUs.py
deleted file mode 100644
index 907348193f..0000000000
--- a/lib/asn1/test/asn1_SUITE_data/PDUs.py
+++ /dev/null
@@ -1,325 +0,0 @@
-PDUs DEFINITIONS ::=
-
--- Search for 'org' to find changes for erlang.
-
--- SnmpMgmtCom and PDUs only for dbg.
-
-
-BEGIN
-EXPORTS SnmpPrivMsg, SnmpAuthMsg, SnmpMgmtCom, PDUs;
-
--- From RFC 1442
-
- -- names of objects
-
- ObjectName ::=
- OBJECT IDENTIFIER
-
-
- -- syntax of objects
-
- ObjectSyntax ::=
- CHOICE {
- simple
- SimpleSyntax,
-
- -- note that SEQUENCEs for conceptual tables and
- -- rows are not mentioned here...
-
- applicationWide
- ApplicationSyntax
- }
-
-
- -- built-in ASN.1 types
-
- SimpleSyntax ::=
- CHOICE {
- -- INTEGERs with a more restrictive range
- -- may also be used
- integerValue
- INTEGER,
-
- stringValue
- OCTET STRING,
-
- objectIDValue
- OBJECT IDENTIFIER,
-
- -- only the enumerated form is allowed
- bitValue
- BIT STRING
- }
-
-
- -- indistinguishable from INTEGER, but never needs more than
- -- 32Bits for a two's complement representation
- Integer32 ::=
- [UNIVERSAL 2]
- IMPLICIT INTEGER (-2147483648..2147483647)
-
-
- -- applicationWide types
-
- ApplicationSyntax ::=
- CHOICE {
- ipAddressValue
- IpAddress,
-
- counterValue
- Counter32,
-
- gaugeValue
- Gauge32,
-
- timeticksValue
- TimeTicks,
-
- arbitraryValue
- Opaque,
-
- nsapAddressValue
- NsapAddress,
-
- bigCounterValue
- Counter64,
-
- unsignedIntegerValue
- UInteger32
- }
-
- -- in networkByte order
- -- (this is a tagged type for historical reasons)
- IpAddress ::=
- [APPLICATION 0]
- IMPLICIT OCTET STRING (SIZE (4))
-
-
-
-
- -- this wraps
- Counter32 ::=
- [APPLICATION 1]
- IMPLICIT INTEGER (0..4294967295)
-
- -- this doesn't wrap
- Gauge32 ::=
- [APPLICATION 2]
- IMPLICIT INTEGER (0..4294967295)
-
- -- hundredths of seconds since an epoch
- TimeTicks ::=
- [APPLICATION 3]
- IMPLICIT INTEGER (0..4294967295)
-
- -- for backwardCompatibility only
- Opaque ::=
- [APPLICATION 4]
- IMPLICIT OCTET STRING
-
- -- for OSI NSAP addresses
- -- (this is a tagged type for historical reasons)
- NsapAddress ::=
- [APPLICATION 5]
--- org: IMPLICIT OCTET STRING (SIZE (1 | 4..21))
- IMPLICIT OCTET STRING
-
- -- for counters that wrap in less than one hour with only 32 bits
- Counter64 ::=
- [APPLICATION 6]
- IMPLICIT INTEGER (0..18446744073709551615)
-
- -- an unsigned 32Bit quantity
- UInteger32 ::=
- [APPLICATION 7]
- IMPLICIT INTEGER (0..4294967295)
-
-
--- From RFC 1445
-
- SnmpPrivMsg ::= [1] IMPLICIT SEQUENCE {
- privDst
- OBJECT IDENTIFIER,
- privData
- [1] IMPLICIT OCTET STRING
- }
-
- SnmpAuthMsg ::= [1] IMPLICIT SEQUENCE {
- authInfo
- ANY, -- defined by authentication protocol
- authData
- SnmpMgmtCom
- }
-
- SnmpMgmtCom ::= [2] IMPLICIT SEQUENCE {
- dstParty
- OBJECT IDENTIFIER,
- srcParty
- OBJECT IDENTIFIER,
- context
- OBJECT IDENTIFIER,
- pdu
- PDUs
- }
-
-
--- From RFC 1448
-
- -- org: no tag at all. we need a tag to test 'PDUs'.
- PDUs ::= [PRIVATE 1]
- -- remove tag when 'PDUs' only is used in another type.
- CHOICE {
- getRequest
- GetRequestPdu,
-
- getNextRequest
- GetNextRequestPdu,
-
- getBulkRequest
- GetBulkRequestPdu,
-
- response
- ResponsePdu,
-
- setRequest
- SetRequestPdu,
-
- informRequest
- InformRequestPdu,
-
- snmpV2Trap
- SNMPv2TrapPdu
- }
-
- -- PDUs
-
- GetRequestPdu ::=
- [0]
- IMPLICIT PDU
-
- GetNextRequestPdu ::=
- [1]
- IMPLICIT PDU
-
- ResponsePdu ::=
- [2]
- IMPLICIT PDU
-
- SetRequestPdu ::=
- [3]
- IMPLICIT PDU
-
- -- [4] is obsolete
-
- GetBulkRequestPdu ::=
- [5]
- IMPLICIT BulkPDU
-
- InformRequestPdu ::=
- [6]
- IMPLICIT PDU
-
- SNMPv2TrapPdu ::=
- [7]
- IMPLICIT PDU
-
-
- maxBindings
- INTEGER ::= 2147483647
-
- PDU ::=
- SEQUENCE {
- requestId
- Integer32,
-
- errorStatus -- sometimes ignored
- INTEGER {
- noError(0),
- tooBig(1),
- noSuchName(2), -- for proxy compatibility
- badValue(3), -- for proxy compatibility
- readOnly(4), -- for proxy compatibility
- genErr(5),
- noAccess(6),
- wrongType(7),
- wrongLength(8),
- wrongEncoding(9),
- wrongValue(10),
- noCreation(11),
- inconsistentValue(12),
- resourceUnavailable(13),
- commitFailed(14),
- undoFailed(15),
- authorizationError(16),
- notWritable(17),
- inconsistentName(18)
- },
-
- errorIndex -- sometimes ignored
- INTEGER (0..maxBindings),
-
- variableBindings -- values are sometimes ignored
- VarBindList
- }
-
-
- BulkPDU ::= -- MUST be identical in
- SEQUENCE { -- structure to PDU
- requestId
- Integer32,
-
- nonRepeaters
- INTEGER (0..maxBindings),
-
- maxRepetitions
- INTEGER (0..maxBindings),
-
- variableBindings -- values are ignored
- VarBindList
- }
-
-
- VarBind ::=
- SEQUENCE {
- name
- ObjectName,
-
- data CHOICE {
- value
- ObjectSyntax,
-
- unSpecified -- in retrieval requests
- NULL,
-
- -- exceptions in responses
- noSuchObject[0]
- IMPLICIT NULL,
-
- noSuchInstance[1]
- IMPLICIT NULL,
-
- endOfMibView[2]
- IMPLICIT NULL
- }
- }
-
-
- -- variableBinding list
-
- VarBindList ::=
- SEQUENCE OF VarBind
-
--- org:
--- VarBindList ::=
--- SEQUENCE (SIZE (0..maxBindings)) OF
--- VarBind
-
-END
-
-
-
-
-
-
-
-
diff --git a/lib/asn1/test/asn1_SUITE_data/Pattern.asn b/lib/asn1/test/asn1_SUITE_data/Pattern.asn
deleted file mode 100644
index 730b4ba32a..0000000000
--- a/lib/asn1/test/asn1_SUITE_data/Pattern.asn
+++ /dev/null
@@ -1,8 +0,0 @@
-Pattern DEFINITIONS AUTOMATIC TAGS ::=
-
-BEGIN
-
-DateAndTime ::= VisibleString (PATTERN "\d#2/\d#2/\d#4-\d#2:\d#2")
--- DD/MM/YYY-HH:MM
-
-END \ No newline at end of file
diff --git a/lib/asn1/test/asn1_SUITE_data/Prim.asn1 b/lib/asn1/test/asn1_SUITE_data/Prim.asn1
index c3d54dbbb3..cc0e61422a 100644
--- a/lib/asn1/test/asn1_SUITE_data/Prim.asn1
+++ b/lib/asn1/test/asn1_SUITE_data/Prim.asn1
@@ -47,5 +47,15 @@ BEGIN
b Bool,
i4 INTEGER (0..63)
}
-
+
+ ASeq ::= SEQUENCE {
+ e254 BOOLEAN,
+ i254 INTEGER (0..254),
+ e255 BOOLEAN,
+ i255 INTEGER (0..255),
+ e256 BOOLEAN,
+ i256 INTEGER (0..256),
+ e BOOLEAN,
+ magic INTEGER
+ }
END
diff --git a/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 b/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1
index cfaf4cf034..08e7f94ab6 100644
--- a/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1
+++ b/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1
@@ -5,7 +5,7 @@ BEGIN
Bs1 ::= BIT STRING
Bs2 ::= BIT STRING {su(0), mo(1), tu(2), we(3), th(4), fr(5), sa(6) } (SIZE (7))
Bs3 ::= BIT STRING {su(0), mo(1), tu(2), we(3), th(4), fr(5), sa(6) } (SIZE (1..7))
- Bs4 ::= BIT STRING {su(0), mo(1), tu(2), we(3), th(4), fr(5), sa(6) } (SIZE (1..32))
+ Bs4 ::= BIT STRING {su(0), mo(1), tu(2), we(3), th(4), fr(5), sa(6) }
Bs5 ::= BIT STRING {su(0), mo(17), tu(2), we(3), th(4), fr(5), sa(6) } (SIZE (1..32))
Bs6 ::= BIT STRING {su(0), mo(17), tu(2), we(3), th(4), fr(5), sa(6)} (SIZE (16..32))
Bs7 ::= BIT STRING (SIZE (24))
@@ -55,10 +55,15 @@ BS1024 ::= BIT STRING (SIZE (1024))
OsExpCon ::= [60] EXPLICIT OCTET STRING
OsExpPri ::= [PRIVATE 61] EXPLICIT OCTET STRING
OsExpApp ::= [APPLICATION 62] EXPLICIT OCTET STRING
+
OsFrag ::= OCTET STRING (SIZE (0..100000))
FixedOs65536 ::= OCTET STRING (SIZE (65536))
FixedOs65537 ::= OCTET STRING (SIZE (65537))
+ OsFragExt ::= OCTET STRING (SIZE (0..100000, ...))
+ FixedOs65536Ext ::= OCTET STRING (SIZE (65536, ...))
+ FixedOs65537Ext ::= OCTET STRING (SIZE (65537, ...))
+
OsFixedStrings ::= SEQUENCE {
b1 BOOLEAN, -- Unalign
s0 OCTET STRING (SIZE (0)),
@@ -72,6 +77,32 @@ BS1024 ::= BIT STRING (SIZE (1024))
i INTEGER (0..1024)
}
+ OsFixedStringsExt ::= SEQUENCE {
+ b1 BOOLEAN, -- Unalign
+ s0 OCTET STRING (SIZE (0, ...)),
+ s1 OCTET STRING (SIZE (1, ...)),
+ s2 OCTET STRING (SIZE (2, ...)),
+ s3 OCTET STRING (SIZE (3, ...)),
+ b2 BOOLEAN, -- Unalign
+ s255 OCTET STRING (SIZE (255, ...)),
+ s256 OCTET STRING (SIZE (256, ...)),
+ s257 OCTET STRING (SIZE (257, ...)),
+ i INTEGER (0..1024)
+ }
+
+ OsVarStringsExt ::= SEQUENCE {
+ b1 BOOLEAN, -- Unalign
+ s0 OCTET STRING (SIZE (0, ...)),
+ s1 OCTET STRING (SIZE (0..1, ...)),
+ s2 OCTET STRING (SIZE (1..2, ...)),
+ s3 OCTET STRING (SIZE (2..3, ...)),
+ b2 BOOLEAN, -- Unalign
+ s255 OCTET STRING (SIZE (254..255, ...)),
+ s256 OCTET STRING (SIZE (255..256, ...)),
+ s257 OCTET STRING (SIZE (256..257, ...)),
+ i INTEGER (0..1024)
+ }
+
OsAlignment ::= SEQUENCE {
b1 BOOLEAN,
s1 Os,
@@ -82,6 +113,52 @@ BS1024 ::= BIT STRING (SIZE (1024))
i INTEGER (0..63)
}
+ IA5FixedStrings ::= SEQUENCE {
+ b1 BOOLEAN, -- Unalign
+ s0 IA5String (SIZE (0)),
+ s1 IA5String (SIZE (1)),
+ s2 IA5String (SIZE (2)),
+ s3 IA5String (SIZE (3)),
+ b2 BOOLEAN, -- Unalign
+ s4 IA5String (SIZE (4)),
+ b3 BOOLEAN, -- Unalign
+ s255 IA5String (SIZE (255)),
+ s256 IA5String (SIZE (256)),
+ s257 IA5String (SIZE (257)),
+ i INTEGER (0..1024)
+ }
+
+ IA5FixedStringsExt ::= SEQUENCE {
+ b1 BOOLEAN, -- Unalign
+ s0 IA5String (SIZE (0, ...)),
+ s1 IA5String (SIZE (1, ...)),
+ s2 IA5String (SIZE (2, ...)),
+ s3 IA5String (SIZE (3, ...)),
+ b2 BOOLEAN, -- Unalign
+ s4 IA5String (SIZE (4, ...)),
+ b3 BOOLEAN, -- Unalign
+ s255 IA5String (SIZE (255, ...)),
+ s256 IA5String (SIZE (256, ...)),
+ s257 IA5String (SIZE (257, ...)),
+ i INTEGER (0..1024)
+ }
+
+ IA5VarStringsExt ::= SEQUENCE {
+ b1 BOOLEAN, -- Unalign
+ s0 IA5String (SIZE (0, ...)),
+ s1 IA5String (SIZE (0..1, ...)),
+ s2 IA5String (SIZE (1..2, ...)),
+ s3 IA5String (SIZE (2..3, ...)),
+ b2 BOOLEAN, -- Unalign
+ s4 IA5String (SIZE (3..4, ...)),
+ b3 BOOLEAN, -- Unalign
+ s255 IA5String (SIZE (254..255, ...)),
+ s256 IA5String (SIZE (255..256, ...)),
+ s257 IA5String (SIZE (256..257, ...)),
+ i INTEGER (0..1024)
+ }
+
+
Ns ::= NumericString
NsCon ::= [70] NumericString
NsExpCon ::= [71] EXPLICIT NumericString
diff --git a/lib/asn1/test/asn1_SUITE_data/ROSE.asn1 b/lib/asn1/test/asn1_SUITE_data/ROSE.asn1
deleted file mode 100644
index 2fefae3caf..0000000000
--- a/lib/asn1/test/asn1_SUITE_data/ROSE.asn1
+++ /dev/null
@@ -1,449 +0,0 @@
-ROSE DEFINITIONS IMPLICIT TAGS ::=
-
-
-BEGIN
-
-OPERATION ::= CLASS
-{
- &ArgumentType OPTIONAL,
- &argumentTypeOptional BOOLEAN OPTIONAL,
- &returnResult BOOLEAN DEFAULT TRUE,
- &ResultType OPTIONAL,
- &resultTypeOptional BOOLEAN OPTIONAL,
- &Errors ERROR OPTIONAL,
- &Linked OPERATION OPTIONAL,
- &synchronous BOOLEAN DEFAULT FALSE,
- &idempotent BOOLEAN DEFAULT FALSE,
- &alwaysReturns BOOLEAN DEFAULT TRUE,
- &InvokePriority Priority OPTIONAL,
- &ResultPriority Priority OPTIONAL,
- &operationCode Code UNIQUE OPTIONAL
- }
-WITH SYNTAX
- {
- [ARGUMENT &ArgumentType [OPTIONAL &argumentTypeOptional]]
- [RESULT &ResultType [OPTIONAL &resultTypeOptional]]
- [RETURN RESULT &returnResult]
- [ERRORS &Errors]
- [LINKED &Linked]
- [SYNCHRONOUS &synchronous]
- [IDEMPOTENT &idempotent]
- [ALWAYS RESPONDS &alwaysReturns]
- [INVOKE PRIORITY &InvokePriority]
- [RESULT-PRIORITY &ResultPriority]
- [CODE &operationCode]
- }
-
-ERROR ::= CLASS
-{
- &ParameterType OPTIONAL,
- &parameterTypeOptional BOOLEAN OPTIONAL,
- &ErrorPriority Priority OPTIONAL,
- &errorCode Code UNIQUE OPTIONAL
- }
-WITH SYNTAX
-{
- [PARAMETER &ParameterType [OPTIONAL &parameterTypeOptional]]
- [PRIORITY &ErrorPriority]
- [CODE &errorCode]
- }
-
-OPERATION-PACKAGE ::= CLASS
-{
- &Both OPERATION OPTIONAL,
- &Consumer OPERATION OPTIONAL,
- &Supplier OPERATION OPTIONAL,
- &id OBJECT IDENTIFIER UNIQUE OPTIONAL
- }
-WITH SYNTAX
-{
- [OPERATIONS &Both]
- [CONSUMER INVOKES &Supplier]
- [SUPPLIER INVOKES &Consumer]
- [ID &id]
- }
-
-CONNECTION-PACKAGE ::= CLASS
-{
- &bind OPERATION DEFAULT emptyBind,
- &unbind OPERATION DEFAULT emptyUnbind,
- &responderCanUnbind BOOLEAN DEFAULT FALSE,
- &unbindCanFail BOOLEAN DEFAULT FALSE,
- &id OBJECT IDENTIFIER UNIQUE OPTIONAL
- }
-WITH SYNTAX
-{
- [BIND &bind]
- [UNBIND &unbind]
- [RESPONDER UNBIND &responderCanUnbind]
- [FAILURE TO UNBIND &unbindCanFail]
- [ID &id]
- }
-
-CONTRACT ::= CLASS
-{
- &connection CONNECTION-PACKAGE OPTIONAL,
- &OperationsOf OPERATION-PACKAGE OPTIONAL,
- &InitiatorConsumerOf OPERATION-PACKAGE OPTIONAL,
- &InitiatorSupplierOf OPERATION-PACKAGE OPTIONAL,
- &id OBJECT IDENTIFIER UNIQUE OPTIONAL
- }
-WITH SYNTAX
-{
- [CONNECTION &connection]
- [OPERATIONS OF &OperationsOf]
- [INITIATOR CONSUMER OF &InitiatorConsumerOf]
- [RESPONDER CONSUMER OF &InitiatorSupplierOf]
- [ID &id]
-}
-
-ROS-OBJECT-CLASS ::= CLASS
-{
- &Is ROS-OBJECT-CLASS OPTIONAL,
- &Initiates CONTRACT OPTIONAL,
- &Responds CONTRACT OPTIONAL,
- &InitiatesAndResponds CONTRACT OPTIONAL,
- &id OBJECT IDENTIFIER UNIQUE
- }
-WITH SYNTAX
-{
- [IS &Is]
- [BOTH &InitiatesAndResponds]
- [INITIATES &Initiates]
- [RESPONDS &Responds]
- ID &id
- }
-
-Code ::= CHOICE
-{
- local INTEGER,
- global OBJECT IDENTIFIER
- }
-
-Priority ::= INTEGER (0..MAX)
-
-ROS {InvokeId:InvokeIdSet,OPERATION:Invokable,OPERATION:Returnable} ::= CHOICE
- {
- invoke [1] Invoke {{InvokeIdSet}, {Invokable}},
- returnResult [2] ReturnResult {{Returnable}},
- returnError [3] ReturnError {{Errors{{Returnable}}}},
- reject [4] Reject
- }
-(CONSTRAINED BY {-- must conform to the above definition --}
- ! RejectProblem : general-unrecognizedPDU)
-
-Invoke {InvokeId:InvokeIdSet, OPERATION:Operations} ::= SEQUENCE
-{
- invokeId InvokeId (InvokeIdSet)
- (CONSTRAINED BY {-- must be unambiguous --}
- ! RejectProblem : invoke-duplicateInvocation),
- linkedId CHOICE {
- present [0] IMPLICIT present < InvokeId,
- absent [1] IMPLICIT NULL
- }
- (CONSTRAINED BY {-- must identify an outstanding operation --}
- ! RejectProblem : invoke-unrecognizedLinkedId)
- (CONSTRAINED BY {-- which has one or more linked operations--}
- ! RejectProblem : invoke-linkedResponseUnexpected)
- OPTIONAL,
- opcode OPERATION.&operationCode
- ({Operations}
- ! RejectProblem : invoke-unrecognizedOperation),
- argument OPERATION.&ArgumentType
- ({Operations} {@opcode}
- ! RejectProblem : invoke-mistypedArgument)
- OPTIONAL
- }
-(CONSTRAINED BY {-- must conform to the above definition --}
- ! RejectProblem : general-mistypedPDU)
-(
-WITH COMPONENTS
-{...,
- linkedId ABSENT
- }
-| WITH COMPONENTS
-{...,
- linkedId PRESENT,
- opcode
- (CONSTRAINED BY {-- must be in the &Linked field of the associated operation --
- }
- ! RejectProblem : invoke-unexpectedLinkedOperation)
- }
-)
-
-ReturnResult {OPERATION:Operations}::= SEQUENCE
-{
- invokeId InvokeId
- (CONSTRAINED BY {-- must be that for an outstanding operation --}
- ! RejectProblem:returnResult-unrecognizedInvocation)
- (CONSTRAINED BY {-- which returns a result --}
- ! RejectProblem:returnResult-resultResponseUnexpected),
- result SEQUENCE
- {
- opcode OPERATION.&operationCode
- ({Operations})(CONSTRAINED BY {-- identified by invokeId --}
- ! RejectProblem:returnResult-unrecognizedInvocation),
- result OPERATION.&ResultType ({Operations} {@.opcode}
- ! RejectProblem:returnResult-mistypedResult)
- }
- OPTIONAL
- }
-(CONSTRAINED BY {-- must conform to the above definition --
- }
-! RejectProblem:general-mistypedPDU)
-
-ReturnError {ERROR:Errors} ::= SEQUENCE
-{
- invokeId InvokeId
- (CONSTRAINED BY {-- must be that for an outstanding operation --
- }
- ! RejectProblem : returnError-unrecognizedInvocation)
- (CONSTRAINED BY {-- which returns an error --
- }
- ! RejectProblem : returnError-errorResponseUnexpected),
- errcode ERROR.&errorCode
- ({Errors}
- ! RejectProblem : returnError-unrecognizedError)
- (CONSTRAINED BY {-- must be in the &Errors field of the associated operation --
- }
- ! RejectProblem : returnError-unexpectedError),
- parameter ERROR.&ParameterType
- ({Errors}{@errcode}
- ! RejectProblem : returnError-mistypedParameter) OPTIONAL
- }
-(CONSTRAINED BY {-- must conform to the above definition --
- }
-! RejectProblem : general-mistypedPDU)
-
-Reject ::= SEQUENCE
-{
- invokeId InvokeId,
- problem CHOICE
- {
- general [0] GeneralProblem,
- invoke [1] InvokeProblem,
- returnResult [2] ReturnResultProblem,
- returnError [3] ReturnErrorProblem
- }
- }
-(CONSTRAINED BY {-- must conform to the above definition --
- }
-! RejectProblem : general-mistypedPDU)
-
-GeneralProblem ::= INTEGER
-{
- unrecognizedPDU (0),
- mistypedPDU (1),
- badlyStructuredPDU (2)
- }
-
-InvokeProblem ::= INTEGER
-{
- duplicateInvocation (0),
- unrecognizedOperation (1),
- mistypedArgument (2),
- resourceLimitation (3),
- releaseInProgress (4),
- unrecognizedLinkedId (5),
- linkedResponseUnexpected (6),
- unexpectedLinkedOperation (7)
- }
-
-ReturnResultProblem ::= INTEGER
-{
- unrecognizedInvocation (0),
- resultResponseUnexpected (1),
- mistypedResult (2)
- }
-
-ReturnErrorProblem ::= INTEGER
-{
- unrecognizedInvocation (0),
- errorResponseUnexpected (1),
- unrecognizedError (2),
- unexpectedError (3),
- mistypedParameter (4)
- }
-
-RejectProblem ::= INTEGER
-{
- general-unrecognizedPDU (0),
- general-mistypedPDU (1),
- general-badlyStructuredPDU (2),
- invoke-duplicateInvocation (10),
- invoke-unrecognizedOperation (11),
- invoke-mistypedArgument (12),
- invoke-resourceLimitation (13),
- invoke-releaseInProgress (14),
- invoke-unrecognizedLinkedId (15),
- invoke-linkedResponseUnexpected (16),
- invoke-unexpectedLinkedOperation (17),
- returnResult-unrecognizedInvocation (20),
- returnResult-resultResponseUnexpected (21),
- returnResult-mistypedResult (22),
- returnError-unrecognizedInvocation (30),
- returnError-errorResponseUnexpected (31),
- returnError-unrecognizedError (32),
- returnError-unexpectedError (33),
- returnError-mistypedParameter (34)
- }
-
-InvokeId ::= CHOICE
-{
- present INTEGER,
- absent NULL
- }
-
-noInvokeId InvokeId ::= absent:NULL
-
-NoInvokeId InvokeId ::= {noInvokeId}
-
-Errors {OPERATION:Operations} ERROR ::= {Operations.&Errors}
-
-Bind {OPERATION:operation} ::= CHOICE
-{
- bind-invoke [16] OPERATION.&ArgumentType({operation}),
- bind-result [17] OPERATION.&ResultType ({operation}),
- bind-error [18] OPERATION.&Errors.&ParameterType ({operation})
- }
-
-Unbind {OPERATION:operation} ::= CHOICE
-{
- unbind-invoke [19] OPERATION.&ArgumentType({operation}),
- unbind-result [20] OPERATION.&ResultType ({operation}),
- unbind-error [21] OPERATION.&Errors.&ParameterType ({operation})
- }
-
-emptyBind OPERATION ::= {ERRORS {refuse} SYNCHRONOUS TRUE}
-
-emptyUnbind OPERATION ::= { SYNCHRONOUS TRUE }
-
-refuse ERROR ::= {CODE local:-1}
-
-no-op OPERATION ::=
- {
- IDEMPOTENT TRUE
- ALWAYS RESPONDS FALSE
- CODE local:-1
- }
-
-Forward {OPERATION:OperationSet} OPERATION ::=
-{
- OperationSet |
- OperationSet.&Linked.&Linked |
- OperationSet.&Linked.&Linked.&Linked.&Linked
- }
-
-Reverse {OPERATION:OperationSet} OPERATION ::=
-{Forward{{OperationSet.&Linked}}}
-
-ConsumerPerforms {OPERATION-PACKAGE:package} OPERATION ::=
-{
- Forward{{package.&Consumer}} |
- Forward{{package.&Both}} |
- Reverse{{package.&Supplier}} |
- Reverse{{package.&Both}}
- }
-
-SupplierPerforms {OPERATION-PACKAGE:package} OPERATION ::=
-{
- Forward{{package.&Supplier}} |
- Forward{{package.&Both}} |
- Reverse{{package.&Consumer}} |
- Reverse{{package.&Both}}
- }
-
-AllOperations {OPERATION-PACKAGE:package} OPERATION ::=
-{
- ConsumerPerforms {package} |
- SupplierPerforms {package}
- }
-
-recode {OPERATION:operation, Code:code} OPERATION ::=
-{
- ARGUMENT operation.&ArgumentType
- OPTIONAL operation.&argumentTypeOptional
- RESULT operation.&ResultType
- OPTIONAL operation.&resultTypeOptional
- RETURN RESULT operation.&returnResult
- ERRORS {operation.&Errors}
- LINKED {operation.&Linked}
- SYNCHRONOUS operation.&synchronous
- ALWAYS RESPONDS operation.&alwaysReturns
- INVOKE PRIORITY {operation.&InvokePriority}
- RESULT-PRIORITY {operation.&ResultPriority}
- CODE code
- }
-
-switch {OPERATION-PACKAGE:package, OBJECT IDENTIFIER:id} OPERATION-PACKAGE ::=
-{
- OPERATIONS {package.&Both}
- CONSUMER INVOKES {package.&Consumer}
- SUPPLIER INVOKES {package.&Supplier}
- ID id
- }
-
-combine {OPERATION-PACKAGE:ConsumerConsumes,OPERATION-PACKAGE:ConsumerSupplies,
- OPERATION-PACKAGE:base
- } OPERATION-PACKAGE ::=
-{
- OPERATIONS {ConsumerConsumes.&Both | ConsumerSupplies.&Both}
- CONSUMER INVOKES {ConsumerConsumes.&Consumer | ConsumerSupplies.&Supplier}
- SUPPLIER INVOKES {ConsumerConsumes.&Supplier | ConsumerSupplies.&Consumer}
- ID base.&id
- }
-
-ROS-SingleAS {InvokeId:InvokeIdSet, OPERATION-PACKAGE:package} ::= ROS
-{{InvokeIdSet}, {AllOperations{package}}, {AllOperations{package}}}
-
-ROS-ConsumerAS {InvokeId:InvokeIdSet, OPERATION-PACKAGE:package} ::= ROS
-{{InvokeIdSet}, {ConsumerPerforms{package}}, {SupplierPerforms{package}}}
-
-ROS-SupplierAS {InvokeId:InvokeIdSet, OPERATION-PACKAGE:package} ::= ROS
-{{InvokeIdSet}, {SupplierPerforms{package}}, {ConsumerPerforms{package}}}
-
-probe OPERATION ::=
- {
- ARGUMENT SEQUENCE
- {
- invokeId [0] InvokeId
- }
- RESULT ENUMERATED{running(0), finished(1), unknown(2), ...}
- IDEMPOTENT TRUE
- CODE local:-2
- }
-
-acknowledge OPERATION ::=
- {
- ARGUMENT InvokeId
- RESULT ENUMERATED{acknowledged(0), unknown(1), ...}
- IDEMPOTENT TRUE
- CODE local:-3
- }
-
-ProbeAndAcknowledge OPERATION ::= {probe | acknowledge}
-
-cancel OPERATION ::=
- {
- ARGUMENT InvokeId
- ERRORS {cancelFailed}
- IDEMPOTENT TRUE
- CODE local:-4
- }
-
-cancelFailed ERROR ::=
- {
- PARAMETER SET
- {
- problem [0] CancelProblem,
- operation [1] InvokeId
- }
- CODE local:-2
- }
-
-CancelProblem ::= ENUMERATED
-{unknownOperation(0), tooLate(1), operationNotCancellable(2), ...}
-
-cancelled ERROR ::= {CODE local:-3}
-
-END -- end of useful definitions.
diff --git a/lib/asn1/test/asn1_SUITE_data/SeqDefault.asn1 b/lib/asn1/test/asn1_SUITE_data/SeqDefault.asn1
index 99e79da972..5c8583884a 100644
--- a/lib/asn1/test/asn1_SUITE_data/SeqDefault.asn1
+++ b/lib/asn1/test/asn1_SUITE_data/SeqDefault.asn1
@@ -74,4 +74,15 @@ SeqIn ::= SEQUENCE
intIn INTEGER DEFAULT 12
}
+SeqExp ::= SEQUENCE
+{
+ bool BOOLEAN,
+ ...,
+ int INTEGER
+}
+
+SeqDef4 ::= SEQUENCE {
+ seq SeqExp DEFAULT { bool TRUE, int 42 }
+}
+
END
diff --git a/lib/asn1/test/asn1_SUITE_data/SeqOf.asn1 b/lib/asn1/test/asn1_SUITE_data/SeqOf.asn1
index 330944cf5c..888dbe5dd7 100644
--- a/lib/asn1/test/asn1_SUITE_data/SeqOf.asn1
+++ b/lib/asn1/test/asn1_SUITE_data/SeqOf.asn1
@@ -62,4 +62,13 @@ Empty ::= SEQUENCE
{
}
+SeqExt ::= SEQUENCE
+{
+ b1 BOOLEAN,
+ s1 SEQUENCE SIZE (1..3, ...) OF SeqIn,
+ b2 BOOLEAN,
+ s2 SEQUENCE SIZE (0..1024, ...) OF SeqIn,
+ magic INTEGER
+}
+
END
diff --git a/lib/asn1/test/asn1_SUITE_data/SetDefault.asn1 b/lib/asn1/test/asn1_SUITE_data/SetDefault.asn1
index cb9e0ead62..0bbe301ae7 100644
--- a/lib/asn1/test/asn1_SUITE_data/SetDefault.asn1
+++ b/lib/asn1/test/asn1_SUITE_data/SetDefault.asn1
@@ -30,4 +30,15 @@ SetIn ::= SET
intIn INTEGER DEFAULT 12
}
+SetDef4 ::= SET {
+ set SetExt DEFAULT { intIn 42, boolIn TRUE }
+}
+
+SetExt ::= SET
+{
+ boolIn BOOLEAN,
+ ...,
+ intIn INTEGER
+}
+
END
diff --git a/lib/asn1/test/asn1_SUITE_data/TConstr.asn1 b/lib/asn1/test/asn1_SUITE_data/TConstr.asn1
index 63f5dbde77..e2e0a11dc4 100644
--- a/lib/asn1/test/asn1_SUITE_data/TConstr.asn1
+++ b/lib/asn1/test/asn1_SUITE_data/TConstr.asn1
@@ -51,6 +51,12 @@ Seq2 ::= SEQUENCE {
}
}
+Deeper ::= SEQUENCE {
+ a SEQUENCE {aa INTEGER,
+ s SEQUENCE { ab MYCLASS.&id ({ObjectSet}),
+ ac INTEGER }},
+ b SEQUENCE {ba INTEGER, bb MYCLASS.&Type ({ObjectSet}{@a.s.ab})}
+}
-- following from Peter's definitions
diff --git a/lib/asn1/test/asn1_SUITE_data/Tst.py b/lib/asn1/test/asn1_SUITE_data/Tst.py
deleted file mode 100644
index d80b32dad5..0000000000
--- a/lib/asn1/test/asn1_SUITE_data/Tst.py
+++ /dev/null
@@ -1,153 +0,0 @@
-Tst { 2 6 6 24 7 1 } DEFINITIONS IMPLICIT TAGS ::=
-
-BEGIN
-
---EXPORTS SomeSet , Id0 , Aset,Id1 ,A,B,C,
--- Uhh ,Foo ,Cho,Person,Hobbe,Robbe,X,Y;
-
-IMPORTS Fooo FROM Bobby;
-
-
-Robbe ::= SET {
- ttt TT }
-
-Koo ::= SET {
- c CHOICE {
- a INTEGER,
- b BOOLEAN },
- s SET OF Id0 }
-
-
-Hobbe ::= [APPLICATION 1] SET {
- aaa [0] SET OF INTEGER,
- bbb [1] UU
- }
-
-UU ::= PP
-PP ::= CHOICE {
- cc [1] CHOICE {
- a [0] INTEGER,
- b [1] BOOLEAN,
- c [2] BIT STRING },
- ii [0] Id0
- }
-
-
-TT ::= SS
-SS ::= SET {
- b BOOLEAN DEFAULT TRUE
- }
-
-Aset ::= [PRIVATE 2] SET OF Uhh
-
-
-
-SomeSet ::= [PRIVATE 3] IMPLICIT SET {
- aaaa [2] SET{
- ggg [0] INTEGER},
- kkkk [1] SET OF Id2,
- booby [4] OCTET STRING,
- puck [3] INTEGER {red(0),blue(1),yellow(-2)},
- baby [5] IMPLICIT Id1,
- bool [6] BOOLEAN }
-
-
-Id0 ::= INTEGER (4 .. 99)
-
-Id1 ::= Id0
-
-Id2 ::= [PRIVATE 4] EXPLICIT Id1
-
-
-Uhh ::= SET {
- a [1] IMPLICIT Id1}
-
-
-
-Soon ::= [PRIVATE 5] Moon
-
-Moon ::= [PRIVATE 6] IMPLICIT Person
-
-
-Person ::= [PRIVATE 7] IMPLICIT SEQUENCE {
- szzzs SET OF SET {
- aaa [0] INTEGER,
- bbb [1] Id0},
- cho Cho,
- name OCTET STRING ,
- location INTEGER,
- asss Aset,
- oops [2] IMPLICIT SET {
- q [0] INTEGER,
- p [1] Uhh},
- on INTEGER,
- mybits [3] IMPLICIT BIT STRING,
- foo Foo,
- age INTEGER,
- hobbe [5] SEQUENCE {
- a [4] CHOICE {
- a INTEGER,
- b BOOLEAN },
- b [5] Id0}}
-
-
-
-
-
-Foo ::= [PRIVATE 8] IMPLICIT SEQUENCE {
- goofy [3] INTEGER OPTIONAL,
- somestring [10] IMPLICIT OCTET STRING DEFAULT '77BB'H,
- hoohoo [11] IMPLICIT SEQUENCE {
- bar [1] Id1 OPTIONAL,
- foo INTEGER,
- zombie [9] CHOICE {
- a [1] IMPLICIT INTEGER,
- b [2] IMPLICIT BOOLEAN }
- },
- moon [4] IMPLICIT INTEGER }
-
-
-
-Cho ::= [PRIVATE 9] EXPLICIT CHOICE {
- somestring [2] IMPLICIT OCTET STRING,
- goofy [9] INTEGER,
- moon [4] IMPLICIT INTEGER }
-
-
-A ::= [APPLICATION 2] SET {
- ppp IA5String ,
- a [0] INTEGER {aaa(6),bbb(77)} DEFAULT 998,
- b [1] Id1 OPTIONAL,
- c [2] OCTET STRING (SIZE(8)),
- dd [3] BIT STRING DEFAULT '11001'B }
-
-B ::= [APPLICATION 3] SET {
- ww [1] SET {
- a A OPTIONAL,
- goofy [3] INTEGER OPTIONAL,
- somestring [10] IMPLICIT OCTET STRING DEFAULT '77BB'H }
- }
-
-
-C::= [APPLICATION 4] SEQUENCE OF X
-
-Y ::= OBJECT IDENTIFIER
-
-X ::= SET {
- a NULL,
- b GeneralString,
- c UTCTime,
- d VideotexString,
- g GeneralizedTime,
- h GraphicString,
- i VisibleString,
- j IA5String,
- k PrintableString,
- l OCTET STRING,
- e TeletexString,
- m ANY,
- n ObjectDescriptor,
- o OBJECT IDENTIFIER,
- f NumericString }
-
-END
diff --git a/lib/asn1/test/asn1_SUITE_data/Two.py b/lib/asn1/test/asn1_SUITE_data/Two.py
deleted file mode 100644
index c8e6f1a55b..0000000000
--- a/lib/asn1/test/asn1_SUITE_data/Two.py
+++ /dev/null
@@ -1,34 +0,0 @@
-Two { 1 2 3} DEFINITIONS EXPLICIT TAGS ::=
-
-BEGIN
-EXPORTS A, D,Boo,Szz;
-
-
-
-D ::= [PRIVATE 1] SEQUENCE {
- a INTEGER,
- b Boo,
- c ANY DEFINED BY a ,
- d ANY }
-
-
-Boo ::= SEQUENCE OF INTEGER (198..200)
-
-A ::= [PRIVATE 2] SEQUENCE {
- a INTEGER (1..1),
- b INTEGER (3..3) }
-
-
-Szz ::= CHOICE {
- one INTEGER,
- two BOOLEAN }
-
-C ::= SET {
- a [0] INTEGER (0..8),
- xx [4] CHOICE {
- [7] INTEGER (9..10),
- a INTEGER (11 ..13) },
- f Boo,
- r [2] INTEGER (20..22)}
-END
-
diff --git a/lib/asn1/test/asn1_SUITE_data/UPERDefault.asn b/lib/asn1/test/asn1_SUITE_data/UPERDefault.asn
deleted file mode 100644
index 7b81a0e09f..0000000000
--- a/lib/asn1/test/asn1_SUITE_data/UPERDefault.asn
+++ /dev/null
@@ -1,18 +0,0 @@
-UPERDefault DEFINITIONS AUTOMATIC TAGS ::=
-
-BEGIN
-
--- OTP-7681
-Int ::= INTEGER (0..32767)
-
-Seq ::= SEQUENCE {
- a Int,
- b INTEGER (-27..27) DEFAULT 0, -- OTP-7678
- c INTEGER OPTIONAL
-}
-
-seq Seq ::=
-{a 12,
- b 0}
-
-END \ No newline at end of file
diff --git a/lib/asn1/test/asn1_SUITE_data/UndefType.py b/lib/asn1/test/asn1_SUITE_data/UndefType.py
deleted file mode 100644
index cdbe083803..0000000000
--- a/lib/asn1/test/asn1_SUITE_data/UndefType.py
+++ /dev/null
@@ -1,14 +0,0 @@
-Person DEFINITIONS IMPLICIT TAGS ::=
-BEGIN
-EXPORTS Person;
-IMPORTS
- ImportedFromUndefined FROM UndefinedModule;
-
-Feltyp ::= UndefinedType
-Feltyp2 ::= ImportedFromUndefined
-Person ::= [PRIVATE 19] SEQUENCE {
- name Undefined,
- location INTEGER {home(0),field(1),roving(2)},
- age ImportedFromUndefined OPTIONAL
- }
-END
diff --git a/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl b/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl
index d46560979d..00e4c707dd 100644
--- a/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl
+++ b/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl
@@ -1,9 +1,3 @@
-%%%-------------------------------------------------------------------
-%%% File : extensionAdditionGroup.erl
-%%% Author : Kenneth Lundin
-%%% Description :
-%%%
-%%% Created : 18 May 2010 by kenneth
%%
%% %CopyrightBegin%
%%
@@ -25,36 +19,38 @@
%%%-------------------------------------------------------------------
-module(extensionAdditionGroup).
-include("Extension-Addition-Group.hrl").
-
+-export([run/1]).
-compile(export_all).
run(Erule) ->
- Val = #'Ax'{a=253, b = true, c= {e,true}, g="123", h = true},
- io:format("~p:~p~n",[Erule,Val]),
- {ok,List}= asn1rt:encode('Extension-Addition-Group','Ax',Val),
- Enc = iolist_to_binary(List),
- io:format("~p~n",[Enc]),
- {ok,Val2} = asn1rt:decode('Extension-Addition-Group','Ax',Enc),
- io:format("~p~n",[Val2]),
- case Val2 of
- Val -> ok;
- _ -> exit({expected,Val, got, Val2})
- end.
+ Val = #'Ax'{a=253,b=true,c={e,true},g="123",h=true},
+ Enc = hex_to_binary(encoded_ax(Erule)),
+ roundtrip('Ax', Val, Enc),
-run2(Erule) ->
- Val = #'Ax3'{a=253, b = true, s = #'Ax3_s'{sa = 11, sb = true, sextaddgroup = 17}},
- io:format("~p:~p~n",[Erule,Val]),
- {ok,List}= asn1rt:encode('Extension-Addition-Group','Ax3',Val),
- Enc = iolist_to_binary(List),
- io:format("~p~n",[Enc]),
- {ok,Val2} = asn1rt:decode('Extension-Addition-Group','Ax3',Enc),
- io:format("~p~n",[Val2]),
- case Val2 of
- Val -> ok;
- _ -> exit({expected,Val, got, Val2})
- end.
+ Val2 = #'Ax3'{a=253,b=true,s=#'Ax3_s'{sa=11,sb=true,sextaddgroup=17}},
+ roundtrip('Ax3', Val2),
+
+ run3(),
+ run3(Erule),
+
+ ok.
+
+%% From X.691 (07/2002) A.4.
+encoded_ax(per) -> "9E000180 010291A4";
+encoded_ax(uper) -> "9E000600 040A4690";
+encoded_ax(ber) -> none.
+hex_to_binary(none) ->
+ none;
+hex_to_binary(L) ->
+ << <<(hex_digit_to_binary(D)):4>> || D <- L, D =/= $\s >>.
+
+hex_digit_to_binary(D) ->
+ if
+ $0 =< D, D =< $9 -> D - $0;
+ $A =< D, D =< $F -> D - ($A-10)
+ end.
run3(Erule) ->
Val =
{'RRC-DL-DCCH-Message',
@@ -141,15 +137,23 @@ run3() ->
'ac-BarringFactor' = p00,
'ac-BarringTime' = s4,
'ac-BarringForSpecialAC' = <<0:5>>},
- roundtrip(SI),
- roundtrip(SI#'SystemInformationBlockType2'{
- 'ssac-BarringForMMTEL-Voice-r9'=Barring}),
- roundtrip(SI#'SystemInformationBlockType2'{
+ T = 'SystemInformationBlockType2',
+ roundtrip(T, SI),
+ roundtrip(T, SI#'SystemInformationBlockType2'{
+ 'ssac-BarringForMMTEL-Voice-r9'=Barring}),
+ roundtrip(T, SI#'SystemInformationBlockType2'{
'ssac-BarringForMMTEL-Video-r9'=Barring}),
- roundtrip(SI#'SystemInformationBlockType2'{
- 'ac-BarringForCSFB-r10'=Barring}).
+ roundtrip(T, SI#'SystemInformationBlockType2'{
+ 'ac-BarringForCSFB-r10'=Barring}).
-roundtrip(V) ->
+roundtrip(T, V) ->
+ roundtrip(T, V, none).
+
+roundtrip(T, V, Expected) ->
Mod = 'Extension-Addition-Group',
- {ok,E} = Mod:encode('SystemInformationBlockType2', V),
- {ok,V} = Mod:decode('SystemInformationBlockType2', iolist_to_binary(E)).
+ {ok,E} = Mod:encode(T, V),
+ {ok,V} = Mod:decode(T, E),
+ case Expected of
+ none -> ok;
+ E -> ok
+ end.
diff --git a/lib/asn1/test/asn1_test_lib.erl b/lib/asn1/test/asn1_test_lib.erl
index 1e40fd7b9e..b839dfcf2a 100644
--- a/lib/asn1/test/asn1_test_lib.erl
+++ b/lib/asn1/test/asn1_test_lib.erl
@@ -39,17 +39,18 @@ compile_all(Files, Config, Options) ->
compile_file(File, Options) ->
try
- ok = asn1ct:compile(File, Options),
+ ok = asn1ct:compile(File, [warnings_as_errors|Options]),
case should_load(File, Options) of
false ->
ok;
{module, Module} ->
code:purge(Module),
- true = code:soft_purge(Module),
- {module, Module} = code:load_file(Module)
+ {module, Module} = code:load_file(Module),
+ code:purge(Module)
end
catch
Class:Reason ->
+ ct:print("Failed to compile ~s\n", [File]),
erlang:error({compile_failed, {File, Options}, {Class, Reason}})
end.
@@ -58,7 +59,7 @@ compile_erlang(Mod, Config, Options) ->
CaseDir = ?config(case_dir, Config),
M = list_to_atom(Mod),
{ok, M} = compile:file(filename:join(DataDir, Mod),
- [{i, CaseDir}, {outdir, CaseDir}|Options]).
+ [report,{i,CaseDir},{outdir,CaseDir}|Options]).
should_load(File, Options) ->
case lists:member(abs, Options) of
diff --git a/lib/asn1/test/error_SUITE.erl b/lib/asn1/test/error_SUITE.erl
new file mode 100644
index 0000000000..a94a6d95a0
--- /dev/null
+++ b/lib/asn1/test/error_SUITE.erl
@@ -0,0 +1,104 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2013. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(error_SUITE).
+-export([suite/0,all/0,groups/0,
+ already_defined/1,enumerated/1]).
+
+-include_lib("test_server/include/test_server.hrl").
+
+suite() -> [{ct_hooks, [ts_install_cth]}].
+
+all() ->
+ [{group,p}].
+
+groups() ->
+ [{p,parallel(),[already_defined,
+ enumerated]}].
+
+parallel() ->
+ case erlang:system_info(schedulers) > 1 of
+ true -> [parallel];
+ false -> []
+ end.
+
+already_defined(Config) ->
+ M = 'Already',
+ P = {M,
+ <<"Already DEFINITIONS ::= BEGIN\n"
+ " I ::= INTEGER\n"
+ " i I ::= 42\n"
+ " I ::= OCTET STRING\n"
+ " I ::= CLASS { &Type }\n"
+ " MYCLASS ::= CLASS { &Type }\n"
+ " i MYCLASS ::= { &Type INTEGER }\n"
+ " o MYCLASS ::= { &Type INTEGER }\n"
+ " I MYCLASS ::= { o }\n"
+ " I{T} ::= SEQUENCE OF T\n"
+ " I{INTEGER:x} INTEGER ::= { 1 | 2 | x }\n"
+ " i{T} MYCLASS ::= { &Type T }\n"
+ "END\n">>},
+ {error,
+ [
+ {structured_error,{M,4},asn1ct_check,{already_defined,'I',2}},
+ {structured_error,{M,5},asn1ct_check,{already_defined,'I',2}},
+ {structured_error,{M,7},asn1ct_check,{already_defined,'i',3}},
+ {structured_error,{M,9},asn1ct_check,{already_defined,'I',2}},
+ {structured_error,{M,10},asn1ct_check,{already_defined,'I',2}},
+ {structured_error,{M,11},asn1ct_check,{already_defined,'I',2}},
+ {structured_error,{M,12},asn1ct_check,{already_defined,'i',3}}
+ ]
+ } = run(P, Config),
+ ok.
+
+enumerated(Config) ->
+ M = 'Enumerated',
+ P = {M,
+ <<"Enumerated DEFINITIONS AUTOMATIC TAGS ::= BEGIN\n"
+ " Enum ::= ENUMERATED { a, b, c }\n"
+ " e Enum ::= d\n"
+ " EnumExt ::= ENUMERATED { x, ..., y }\n"
+ " ext EnumExt ::= z\n"
+ " S1 ::= SEQUENCE {\n"
+ " ge1 Enum DEFAULT a,\n"
+ " ge2 EnumExt DEFAULT x,\n"
+ " ge3 EnumExt DEFAULT y,\n"
+ " e Enum DEFAULT aa\n"
+ " }\n"
+ " S2 ::= SEQUENCE {\n"
+ " e2 EnumExt DEFAULT xyz\n"
+ " }\n"
+ "END\n">>},
+ {error,
+ [
+ {structured_error,{'Enumerated',3},asn1ct_check,{undefined,d}},
+ {structured_error,{'Enumerated',5},asn1ct_check,{undefined,z}},
+ {structured_error,{'Enumerated',10},asn1ct_check,{undefined,aa}},
+ {structured_error,{'Enumerated',13},asn1ct_check,{undefined,xyz}}
+ ]
+ } = run(P, Config),
+ ok.
+
+
+
+run({Mod,Spec}, Config) ->
+ Base = atom_to_list(Mod) ++ ".asn1",
+ File = filename:join(?config(priv_dir, Config), Base),
+ ok = file:write_file(File, Spec),
+ asn1ct:compile(File).
diff --git a/lib/asn1/test/testChoExtension.erl b/lib/asn1/test/testChoExtension.erl
index 067d4d2bf7..5c67ff62ce 100644
--- a/lib/asn1/test/testChoExtension.erl
+++ b/lib/asn1/test/testChoExtension.erl
@@ -42,6 +42,11 @@ extension(_Rules) ->
roundtrip('ChoExt3', {int,33}),
roundtrip('ChoExt4', {str,"abc"}),
+ roundtrip('ChoEmptyRoot', {bool,false}),
+ roundtrip('ChoEmptyRoot', {bool,true}),
+ roundtrip('ChoEmptyRoot', {int,0}),
+ roundtrip('ChoEmptyRoot', {int,7}),
+
ok.
diff --git a/lib/asn1/test/testCompactBitString.erl b/lib/asn1/test/testCompactBitString.erl
index 96d9f0fdcb..28ab2464e9 100644
--- a/lib/asn1/test/testCompactBitString.erl
+++ b/lib/asn1/test/testCompactBitString.erl
@@ -150,4 +150,6 @@ roundtrip(Type, Val1, Val2) ->
roundtrip_1(Mod, Type, In, Out) ->
{ok,Encoded} = Mod:encode(Type, In),
{ok,Out} = Mod:decode(Type, Encoded),
+ %% Test that compact BIT STRINGs can be encoded.
+ {ok,Encoded} = Mod:encode(Type, Out),
ok.
diff --git a/lib/asn1/test/testConstraints.erl b/lib/asn1/test/testConstraints.erl
index c8d9008641..e825302629 100644
--- a/lib/asn1/test/testConstraints.erl
+++ b/lib/asn1/test/testConstraints.erl
@@ -122,13 +122,61 @@ int_constraints(Rules) ->
range_error(Rules, 'X1', 21),
%%==========================================================
+ %% SemiConstrained
+ %%==========================================================
+
+ roundtrip('SemiConstrained', 100),
+ roundtrip('SemiConstrained', 397249742397243),
+ roundtrip('NegSemiConstrained', -128),
+ roundtrip('NegSemiConstrained', -1),
+ roundtrip('NegSemiConstrained', 500),
+
+ roundtrip('SemiConstrainedExt', -65536),
+ roundtrip('SemiConstrainedExt', 0),
+ roundtrip('SemiConstrainedExt', 42),
+ roundtrip('SemiConstrainedExt', 100),
+ roundtrip('SemiConstrainedExt', 47777789),
+ roundtrip('NegSemiConstrainedExt', -1023),
+ roundtrip('NegSemiConstrainedExt', -128),
+ roundtrip('NegSemiConstrainedExt', -1),
+ roundtrip('NegSemiConstrainedExt', 500),
+
+ %%==========================================================
%% SIZE Constraint (Duboisson p. 268)
%% T ::= IA5String (SIZE (1|2, ..., SIZE (1|2|3)))
%% T2 ::= IA5String (SIZE (1|2, ..., 3))
%%==========================================================
roundtrip('T', "IA"),
- roundtrip('T2', "IA").
+ roundtrip('T', "IAB"),
+ roundtrip('T', "IABC"),
+ roundtrip('T2', "IA"),
+ roundtrip('T2', "IAB"),
+ roundtrip('T2', "IABC"),
+
+ %%==========================================================
+ %% More SIZE Constraints
+ %%==========================================================
+
+ roundtrip('FixedSize', "0123456789"),
+ roundtrip('FixedSize2', "0123456789"),
+ roundtrip('FixedSize2', "0123456789abcdefghij"),
+
+ range_error(Rules, 'FixedSize', "short"),
+ range_error(Rules, 'FixedSize2', "short"),
+
+ [roundtrip('VariableSize', lists:seq($A, $A+L-1)) ||
+ L <- lists:seq(1, 10)],
+
+ roundtrip_enc('ShorterExt', "a", shorter_ext(Rules, "a")),
+ roundtrip('ShorterExt', "abcde"),
+ roundtrip('ShorterExt', "abcdef"),
+
+ ok.
+
+shorter_ext(per, "a") -> <<16#80,16#01,16#61>>;
+shorter_ext(uper, "a") -> <<16#80,16#E1>>;
+shorter_ext(ber, _) -> none.
refed_NNL_name(_Erule) ->
?line {ok,_} = asn1_wrapper:encode('Constraints','AnotherThing',fred),
@@ -143,11 +191,20 @@ roundtrip(Module, Type, Value) ->
{ok,Value} = Module:decode(Type, Encoded),
ok.
+roundtrip_enc(Type, Value, Enc) ->
+ Module = 'Constraints',
+ {ok,Encoded} = Module:encode(Type, Value),
+ {ok,Value} = Module:decode(Type, Encoded),
+ case Enc of
+ none -> ok;
+ Encoded -> ok
+ end.
+
range_error(ber, Type, Value) ->
%% BER: Values outside the effective range should be rejected
%% on decode.
{ok,Encoded} = 'Constraints':encode(Type, Value),
- {error,{asn1,{integer_range,_,_}}} = 'Constraints':decode(Type, Encoded),
+ {error,{asn1,_}} = 'Constraints':decode(Type, Encoded),
ok;
range_error(Per, Type, Value) when Per =:= per; Per =:= uper ->
%% (U)PER: Values outside the effective range should be rejected
diff --git a/lib/asn1/test/testDeepTConstr.erl b/lib/asn1/test/testDeepTConstr.erl
index 3df7bcbaa0..e826cafa0c 100644
--- a/lib/asn1/test/testDeepTConstr.erl
+++ b/lib/asn1/test/testDeepTConstr.erl
@@ -40,53 +40,40 @@ main(_Erule) ->
{any,"DK"},
{final,"NO"}]}},
- ?line {ok,Bytes1} =
- asn1_wrapper:encode('TConstrChoice','FilterItem',Val1),
-
- ?line {error,Reason} = asn1_wrapper:decode('TConstrChoice','FilterItem',Bytes1),
-
+ {ok,Bytes1} = 'TConstrChoice':encode('FilterItem', Val1),
+ {error,Reason} = asn1_wrapper:decode('TConstrChoice','FilterItem',Bytes1),
io:format("Reason: ~p~n~n",[Reason]),
-
- ?line {ok,Bytes2} =
- asn1_wrapper:encode('TConstrChoice','FilterItem',Val2),
-
- ?line {ok,Res} = asn1_wrapper:decode('TConstrChoice','FilterItem',Bytes2),
-
-
+ {ok,Bytes2} = 'TConstrChoice':encode('FilterItem', Val2),
+ {ok,Res} = 'TConstrChoice':decode('FilterItem', Bytes2),
%% test of OTP-4248.
- ?line {ok,Bytes3} =
- asn1_wrapper:encode('TConstrChoice','Seq',{'Seq',3,Bytes2}),
-
- ?line {ok,{'Seq',3,Bytes4}} =
- asn1_wrapper:decode('TConstrChoice','Seq',Bytes3),
-
- ?line {ok,Res} = asn1_wrapper:decode('TConstrChoice','FilterItem',Bytes4),
+ {ok,Bytes3} = 'TConstrChoice':encode('Seq', {'Seq',3,Bytes2}),
+ {ok,{'Seq',3,Bytes4}} = 'TConstrChoice':decode('Seq', Bytes3),
+ {ok,Res} = 'TConstrChoice':decode('FilterItem', Bytes4),
%% test of TConstr
- Seq1Val = {'Seq1',{'Seq1_a',12,{2,4}},{'Seq1_b',13,{'Type-object1',14,true}}},
- ?line {ok,Bytes5} =
- asn1_wrapper:encode('TConstr','Seq1',Seq1Val),
-
- ?line {ok,Seq1Val} =
- asn1_wrapper:decode('TConstr','Seq1',Bytes5),
+ Seq1Val = {'Seq1',{'Seq1_a',12,{2,4}},
+ {'Seq1_b',13,{'Type-object1',14,true}}},
+ roundtrip('TConstr', 'Seq1', Seq1Val),
Seq2Val = {'Seq2',123,{'Seq2_content',{2,6,7},
{first,{'Type-object3_first',false,47}},
false}},
-
- ?line {ok,Bytes6} =
- asn1_wrapper:encode('TConstr','Seq2',Seq2Val),
+ roundtrip('TConstr', 'Seq2', Seq2Val),
- ?line {ok,Seq2Val} =
- asn1_wrapper:decode('TConstr','Seq2',Bytes6),
+ roundtrip('TConstr', 'Info', {'Info',{'Info_xyz',{1,2}},1234}),
+
+ roundtrip('TConstr', 'Deeper',
+ {'Deeper',
+ {'Deeper_a',12,
+ {'Deeper_a_s',{2,4},42}},
+ {'Deeper_b',13,{'Type-object1',14,true}}}),
+ ok.
- InfoVal = {'Info',{'Info_xyz',{1,2}},1234},
-
- ?line {ok,Bytes7} =
- asn1_wrapper:encode('TConstr','Info',InfoVal),
- ?line {ok,InfoVal} =
- asn1_wrapper:decode('TConstr','Info',Bytes7).
+roundtrip(M, T, V) ->
+ {ok,E} = M:encode(T, V),
+ {ok,V} = M:decode(T, E),
+ ok.
diff --git a/lib/asn1/test/testEnumExt.erl b/lib/asn1/test/testEnumExt.erl
index 0811f20571..8840ed6d2f 100644
--- a/lib/asn1/test/testEnumExt.erl
+++ b/lib/asn1/test/testEnumExt.erl
@@ -38,8 +38,7 @@ main(Rule) when Rule =:= per; Rule =:= uper ->
%% ENUMERATED no extensionmark
B64 = <<64>>,
B64 = roundtrip('Noext', red),
- ok;
-
+ common();
main(ber) ->
io:format("main(ber)~n",[]),
%% ENUMERATED with extensionmark (value is in root set)
@@ -57,6 +56,15 @@ main(ber) ->
roundtrip('Globalstate', preop),
roundtrip('Globalstate', com),
+ common().
+
+common() ->
+ roundtrip('Seq', {'Seq',blue,42}),
+ roundtrip('Seq', {'Seq',red,42}),
+ roundtrip('Seq', {'Seq',green,42}),
+ roundtrip('Seq', {'Seq',orange,47}),
+ roundtrip('Seq', {'Seq',black,4711}),
+ roundtrip('Seq', {'Seq',magenta,4712}),
ok.
roundtrip(Type, Value) ->
diff --git a/lib/asn1/test/testInfObj.erl b/lib/asn1/test/testInfObj.erl
index 03e70c730a..75f4dae310 100644
--- a/lib/asn1/test/testInfObj.erl
+++ b/lib/asn1/test/testInfObj.erl
@@ -22,8 +22,6 @@
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
-
-record('InitiatingMessage',{procedureCode,criticality,value}).
-record('InitiatingMessage2',{procedureCode,criticality,value}).
-record('Iu-ReleaseCommand',{first,second}).
@@ -34,22 +32,11 @@ main(_Erule) ->
value=#'Iu-ReleaseCommand'{
first=13,
second=true}},
- ?line {ok,Bytes1} =
- asn1_wrapper:encode('RANAPextract1','InitiatingMessage',Val1),
-
- ?line {ok,{'InitiatingMessage',1,ignore,{'Iu-ReleaseCommand',13,true}}}=
- asn1_wrapper:decode('RANAPextract1','InitiatingMessage',Bytes1),
-
- ?line {ok,Bytes2} =
- asn1_wrapper:encode('InfObj','InitiatingMessage',Val1),
-
- ?line {ok,Val1} =
- asn1_wrapper:decode('InfObj','InitiatingMessage',Bytes2),
+ roundtrip('RANAPextract1', 'InitiatingMessage', Val1),
+ roundtrip('InfObj', 'InitiatingMessage', Val1),
Val2 = Val1#'InitiatingMessage'{procedureCode=2},
-
- ?line {error,_R1} =
- asn1_wrapper:encode('InfObj','InitiatingMessage',Val2),
+ {error,_R1} = 'InfObj':encode('InitiatingMessage', Val2),
%% Test case for OTP-4275
@@ -59,10 +46,26 @@ main(_Erule) ->
first=13,
second=true}},
- ?line {ok,Bytes3} =
- asn1_wrapper:encode('RANAPextract1','InitiatingMessage2',Val3),
+ roundtrip('RANAPextract1', 'InitiatingMessage2', Val3),
-
- ?line {ok,{'InitiatingMessage2',3,reject,{'Iu-ReleaseCommand',13,true}}}=
- asn1_wrapper:decode('RANAPextract1','InitiatingMessage2',Bytes3).
-
+ roundtrip('InfObj', 'MyPdu', {'MyPdu',42,12,false,"string"}),
+ roundtrip('InfObj', 'MyPdu', {'MyPdu',{'Seq',1023,"hello"},
+ 42,true,"longer string"}),
+ roundtrip('InfObj', 'MyPdu', {'MyPdu',"75712346",43,true,"string"}),
+
+ roundtrip('InfObj', 'ConstructedPdu',
+ {'ConstructedPdu',1,{'CONSTRUCTED-DEFAULT_Type',-2001,true}}),
+ roundtrip('InfObj', 'ConstructedPdu',
+ {'ConstructedPdu',2,{'CONSTRUCTED-DEFAULT_Type',999,false}}),
+ roundtrip('InfObj', 'ConstructedPdu',
+ {'ConstructedPdu',3,true}),
+
+ roundtrip('InfObj', 'Seq2',
+ {'Seq2',42,[true,false,false,true],
+ [false,true,false]}).
+
+
+roundtrip(M, T, V) ->
+ {ok,Enc} = M:encode(T, V),
+ {ok,V} = M:decode(T, Enc),
+ ok.
diff --git a/lib/asn1/test/testPrim.erl b/lib/asn1/test/testPrim.erl
index 91fb9fffca..990e7adcd9 100644
--- a/lib/asn1/test/testPrim.erl
+++ b/lib/asn1/test/testPrim.erl
@@ -30,465 +30,57 @@
-include_lib("test_server/include/test_server.hrl").
bool(Rules) ->
-
- %%==========================================================
- %% Bool ::= BOOLEAN
- %%==========================================================
-
- ?line {ok,Bytes1} = asn1_wrapper:encode('Prim','Bool',true),
- ?line {ok,true} = asn1_wrapper:decode('Prim','Bool',lists:flatten(Bytes1)),
-
- ?line {ok,Bytes2} = asn1_wrapper:encode('Prim','Bool',false),
- ?line {ok,false} = asn1_wrapper:decode('Prim','Bool',lists:flatten(Bytes2)),
-
- ?line case asn1_wrapper:erule(Rules) of
- ber ->
- ?line {error,{asn1,{encode_boolean,517}}} =
- (catch asn1_wrapper:encode('Prim','Bool',517)),
- ok;
- per ->
- ok
- end,
-
-
-
-
-
- %%==========================================================
- %% BoolCon ::= [20] BOOLEAN
- %%==========================================================
-
-
- ?line {ok,BytesCon1} = asn1_wrapper:encode('Prim','BoolCon',true),
- ?line {ok,true} = asn1_wrapper:decode('Prim','BoolCon',lists:flatten(BytesCon1)),
-
- ?line {ok,BytesCon2} = asn1_wrapper:encode('Prim','BoolCon',false),
- ?line {ok,false} = asn1_wrapper:decode('Prim','BoolCon',lists:flatten(BytesCon2)),
-
- ?line case asn1_wrapper:erule(Rules) of
- ber ->
- ?line {error,{asn1,{encode_boolean,517}}} =
- (catch asn1_wrapper:encode('Prim','BoolCon',517)),
- ok;
- per ->
- ok
- end,
-
-
-
-
-
- %%==========================================================
- %% BoolPri ::= [PRIVATE 21] BOOLEAN
- %%==========================================================
-
- ?line {ok,BytesPri1} = asn1_wrapper:encode('Prim','BoolPri',true),
- ?line {ok,true} = asn1_wrapper:decode('Prim','BoolPri',lists:flatten(BytesPri1)),
-
- ?line {ok,BytesPri2} = asn1_wrapper:encode('Prim','BoolPri',false),
- ?line {ok,false} = asn1_wrapper:decode('Prim','BoolPri',lists:flatten(BytesPri2)),
-
- ?line case asn1_wrapper:erule(Rules) of
- ber ->
- ?line {error,{asn1,{encode_boolean,517}}} =
- (catch asn1_wrapper:encode('Prim','BoolPri',517)),
- ok;
- per ->
- ok
- end,
-
-
- %%==========================================================
- %% BoolApp ::= [APPLICATION 22] BOOLEAN
- %%==========================================================
-
- ?line {ok,BytesApp1} = asn1_wrapper:encode('Prim','BoolApp',true),
- ?line {ok,true} = asn1_wrapper:decode('Prim','BoolApp',lists:flatten(BytesApp1)),
-
- ?line {ok,BytesApp2} = asn1_wrapper:encode('Prim','BoolApp',false),
- ?line {ok,false} = asn1_wrapper:decode('Prim','BoolApp',lists:flatten(BytesApp2)),
-
- ?line case asn1_wrapper:erule(Rules) of
- ber ->
- ?line {error,{asn1,{encode_boolean,517}}} =
- (catch asn1_wrapper:encode('Prim','BoolApp',517)),
- ok;
- per ->
- ok
- end,
-
-
- %%==========================================================
- %% BoolExpCon ::= [30] EXPLICIT BOOLEAN
- %%==========================================================
-
- ?line {ok,BytesExpCon1} = asn1_wrapper:encode('Prim','BoolExpCon',true),
- ?line {ok,true} = asn1_wrapper:decode('Prim','BoolExpCon',lists:flatten(BytesExpCon1)),
-
- ?line {ok,BytesExpCon2} = asn1_wrapper:encode('Prim','BoolExpCon',false),
- ?line {ok,false} = asn1_wrapper:decode('Prim','BoolExpCon',lists:flatten(BytesExpCon2)),
-
- ?line case asn1_wrapper:erule(Rules) of
- ber ->
- ?line {error,{asn1,{encode_boolean,517}}} =
- (catch asn1_wrapper:encode('Prim','BoolExpCon',517)),
- ok;
- per ->
- ok
- end,
-
-
-
- %%==========================================================
- %% BoolExpPri ::= [PRIVATE 31] EXPLICIT BOOLEAN
- %%==========================================================
-
- ?line {ok,BytesExpPri1} = asn1_wrapper:encode('Prim','BoolExpPri',true),
- ?line {ok,true} = asn1_wrapper:decode('Prim','BoolExpPri',lists:flatten(BytesExpPri1)),
-
- ?line {ok,BytesExpPri2} = asn1_wrapper:encode('Prim','BoolExpPri',false),
- ?line {ok,false} = asn1_wrapper:decode('Prim','BoolExpPri',lists:flatten(BytesExpPri2)),
-
- ?line case asn1_wrapper:erule(Rules) of
- ber ->
- ?line {error,{asn1,{encode_boolean,517}}} =
- (catch asn1_wrapper:encode('Prim','BoolExpPri',517)),
- ok;
- per ->
- ok
- end,
-
-
- %%==========================================================
- %% BoolExpApp ::= [APPLICATION 32] EXPLICIT BOOLEAN
- %%==========================================================
-
- ?line {ok,BytesExpApp1} = asn1_wrapper:encode('Prim','BoolExpApp',true),
- ?line {ok,true} = asn1_wrapper:decode('Prim','BoolExpApp',lists:flatten(BytesExpApp1)),
-
- ?line {ok,BytesExpApp2} = asn1_wrapper:encode('Prim','BoolExpApp',false),
- ?line {ok,false} = asn1_wrapper:decode('Prim','BoolExpApp',lists:flatten(BytesExpApp2)),
-
- ?line case asn1_wrapper:erule(Rules) of
- ber ->
- ?line {error,{asn1,{encode_boolean,517}}} =
- (catch asn1_wrapper:encode('Prim','BoolExpApp',517)),
- ok;
- per ->
- ok
- end,
-
- ok.
+ Types = ['Bool','BoolCon','BoolPri','BoolApp',
+ 'BoolExpCon','BoolExpPri','BoolExpApp'],
+ [roundtrip(T, V) || T <- Types, V <- [true,false]],
+ case Rules of
+ ber ->
+ [begin
+ {error,{asn1,{encode_boolean,517}}} =
+ (catch 'Prim':encode(T, 517))
+ end || T <- Types],
+ ok;
+ _ ->
+ ok
+ end.
int(Rules) ->
-
-
- %%==========================================================
- %% Int ::= INTEGER
- %%==========================================================
-
- %% test of OTP-2666 encoding should use minimum number of octets x.690 8.3.2
- ?line {ok,Bytes0} = asn1_wrapper:encode('Prim','Int',-128),
- ?line L0 = lists:flatten(Bytes0),
- ?line {ok,-128} = asn1_wrapper:decode('Prim','Int',lists:flatten(L0)),
- case asn1_wrapper:erule(Rules) of
+ %% OTP-2666: encoding should use minimum number of octets; x.690 8.3.2
+ Bytes0 = roundtrip('Int', -128),
+ case Rules of
ber ->
- ?line [_,1,128] = L0;
- per -> ok
+ <<_,1,128>> = Bytes0;
+ _ ->
+ ok
end,
- ?line {ok,Bytes1} = asn1_wrapper:encode('Prim','Int',4),
- ?line {ok,4} = asn1_wrapper:decode('Prim','Int',lists:flatten(Bytes1)),
-
- ?line {ok,Bytes2} = asn1_wrapper:encode('Prim','Int',444),
- ?line {ok,444} = asn1_wrapper:decode('Prim','Int',lists:flatten(Bytes2)),
-
- ?line {ok,Bytes3} = asn1_wrapper:encode('Prim','Int',123456789),
- ?line {ok,123456789} = asn1_wrapper:decode('Prim','Int',lists:flatten(Bytes3)),
-
- ?line {ok,Bytes4} = asn1_wrapper:encode('Prim','Int',12345678901234567890),
- ?line {ok,12345678901234567890} = asn1_wrapper:decode('Prim','Int',lists:flatten(Bytes4)),
-
- ?line {ok,Bytes5} = asn1_wrapper:encode('Prim','Int',-100),
- ?line {ok,-100} = asn1_wrapper:decode('Prim','Int',lists:flatten(Bytes5)),
-
- ?line {ok,Bytes6} = asn1_wrapper:encode('Prim','Int',-255),
- ?line {ok,-255} = asn1_wrapper:decode('Prim','Int',lists:flatten(Bytes6)),
-
- ?line {ok,Bytes7} = asn1_wrapper:encode('Prim','Int',-256),
- ?line {ok,-256} = asn1_wrapper:decode('Prim','Int',lists:flatten(Bytes7)),
-
- ?line {ok,Bytes8} = asn1_wrapper:encode('Prim','Int',-257),
- ?line {ok,-257} = asn1_wrapper:decode('Prim','Int',lists:flatten(Bytes8)),
-
- ?line {ok,Bytes9} = asn1_wrapper:encode('Prim','Int',-1234567890),
- ?line {ok,-1234567890} = asn1_wrapper:decode('Prim','Int',lists:flatten(Bytes9)),
-
- ?line {ok,Bytes10} = asn1_wrapper:encode('Prim','Int',-2147483648),
- ?line {ok,-2147483648} = asn1_wrapper:decode('Prim','Int',lists:flatten(Bytes10)),
-
-
-
-
-
- %%==========================================================
- %% IntCon ::= [40] INTEGER
- %%==========================================================
-
- ?line {ok,BytesCon1} = asn1_wrapper:encode('Prim','IntCon',4),
- ?line {ok,4} = asn1_wrapper:decode('Prim','IntCon',lists:flatten(BytesCon1)),
-
- ?line {ok,BytesCon2} = asn1_wrapper:encode('Prim','IntCon',444),
- ?line {ok,444} = asn1_wrapper:decode('Prim','IntCon',lists:flatten(BytesCon2)),
-
- ?line {ok,BytesCon3} = asn1_wrapper:encode('Prim','IntCon',123456789),
- ?line {ok,123456789} = asn1_wrapper:decode('Prim','IntCon',lists:flatten(BytesCon3)),
-
- ?line {ok,BytesCon4} = asn1_wrapper:encode('Prim','IntCon',12345678901234567890),
- ?line {ok,12345678901234567890} = asn1_wrapper:decode('Prim','IntCon',lists:flatten(BytesCon4)),
-
- ?line {ok,BytesCon5} = asn1_wrapper:encode('Prim','IntCon',-100),
- ?line {ok,-100} = asn1_wrapper:decode('Prim','IntCon',lists:flatten(BytesCon5)),
-
- ?line {ok,BytesCon6} = asn1_wrapper:encode('Prim','IntCon',-255),
- ?line {ok,-255} = asn1_wrapper:decode('Prim','IntCon',lists:flatten(BytesCon6)),
-
- ?line {ok,BytesCon7} = asn1_wrapper:encode('Prim','IntCon',-256),
- ?line {ok,-256} = asn1_wrapper:decode('Prim','IntCon',lists:flatten(BytesCon7)),
-
- ?line {ok,BytesCon8} = asn1_wrapper:encode('Prim','IntCon',-257),
- ?line {ok,-257} = asn1_wrapper:decode('Prim','IntCon',lists:flatten(BytesCon8)),
-
- ?line {ok,BytesCon9} = asn1_wrapper:encode('Prim','IntCon',-1234567890),
- ?line {ok,-1234567890} = asn1_wrapper:decode('Prim','IntCon',lists:flatten(BytesCon9)),
-
- ?line {ok,BytesCon10} = asn1_wrapper:encode('Prim','Int',-2147483648),
- ?line {ok,-2147483648} = asn1_wrapper:decode('Prim','Int',lists:flatten(BytesCon10)),
-
-
-
- %%==========================================================
- %% IntPri ::= [PRIVATE 41] INTEGER
- %%==========================================================
-
- ?line {ok,BytesPri1} = asn1_wrapper:encode('Prim','IntPri',4),
- ?line {ok,4} = asn1_wrapper:decode('Prim','IntPri',lists:flatten(BytesPri1)),
-
- ?line {ok,BytesPri2} = asn1_wrapper:encode('Prim','IntPri',444),
- ?line {ok,444} = asn1_wrapper:decode('Prim','IntPri',lists:flatten(BytesPri2)),
-
- ?line {ok,BytesPri3} = asn1_wrapper:encode('Prim','IntPri',123456789),
- ?line {ok,123456789} = asn1_wrapper:decode('Prim','IntPri',lists:flatten(BytesPri3)),
-
- ?line {ok,BytesPri4} = asn1_wrapper:encode('Prim','IntPri',12345678901234567890),
- ?line {ok,12345678901234567890} = asn1_wrapper:decode('Prim','IntPri',lists:flatten(BytesPri4)),
-
- ?line {ok,BytesPri5} = asn1_wrapper:encode('Prim','IntPri',-100),
- ?line {ok,-100} = asn1_wrapper:decode('Prim','IntPri',lists:flatten(BytesPri5)),
-
- ?line {ok,BytesPri6} = asn1_wrapper:encode('Prim','IntPri',-255),
- ?line {ok,-255} = asn1_wrapper:decode('Prim','IntPri',lists:flatten(BytesPri6)),
-
- ?line {ok,BytesPri7} = asn1_wrapper:encode('Prim','IntPri',-256),
- ?line {ok,-256} = asn1_wrapper:decode('Prim','IntPri',lists:flatten(BytesPri7)),
-
- ?line {ok,BytesPri8} = asn1_wrapper:encode('Prim','IntPri',-257),
- ?line {ok,-257} = asn1_wrapper:decode('Prim','IntPri',lists:flatten(BytesPri8)),
-
- ?line {ok,BytesPri9} = asn1_wrapper:encode('Prim','IntPri',-1234567890),
- ?line {ok,-1234567890} = asn1_wrapper:decode('Prim','IntPri',lists:flatten(BytesPri9)),
-
- ?line {ok,BytesPri10} = asn1_wrapper:encode('Prim','Int',-2147483648),
- ?line {ok,-2147483648} = asn1_wrapper:decode('Prim','Int',lists:flatten(BytesPri10)),
-
-
-
- %%==========================================================
- %% IntApp ::= [APPLICATION 42] INTEGER
- %%==========================================================
-
- ?line {ok,BytesApp1} = asn1_wrapper:encode('Prim','IntApp',4),
- ?line {ok,4} = asn1_wrapper:decode('Prim','IntApp',lists:flatten(BytesApp1)),
-
- ?line {ok,BytesApp2} = asn1_wrapper:encode('Prim','IntApp',444),
- ?line {ok,444} = asn1_wrapper:decode('Prim','IntApp',lists:flatten(BytesApp2)),
-
- ?line {ok,BytesApp3} = asn1_wrapper:encode('Prim','IntApp',123456789),
- ?line {ok,123456789} = asn1_wrapper:decode('Prim','IntApp',lists:flatten(BytesApp3)),
-
- ?line {ok,BytesApp4} = asn1_wrapper:encode('Prim','IntApp',12345678901234567890),
- ?line {ok,12345678901234567890} = asn1_wrapper:decode('Prim','IntApp',lists:flatten(BytesApp4)),
-
- ?line {ok,BytesApp5} = asn1_wrapper:encode('Prim','IntApp',-100),
- ?line {ok,-100} = asn1_wrapper:decode('Prim','IntApp',lists:flatten(BytesApp5)),
-
- ?line {ok,BytesApp6} = asn1_wrapper:encode('Prim','IntApp',-255),
- ?line {ok,-255} = asn1_wrapper:decode('Prim','IntApp',lists:flatten(BytesApp6)),
-
- ?line {ok,BytesApp7} = asn1_wrapper:encode('Prim','IntApp',-256),
- ?line {ok,-256} = asn1_wrapper:decode('Prim','IntApp',lists:flatten(BytesApp7)),
-
- ?line {ok,BytesApp8} = asn1_wrapper:encode('Prim','IntApp',-257),
- ?line {ok,-257} = asn1_wrapper:decode('Prim','IntApp',lists:flatten(BytesApp8)),
-
- ?line {ok,BytesApp9} = asn1_wrapper:encode('Prim','IntApp',-1234567890),
- ?line {ok,-1234567890} = asn1_wrapper:decode('Prim','IntApp',lists:flatten(BytesApp9)),
-
- ?line {ok,BytesApp10} = asn1_wrapper:encode('Prim','Int',-2147483648),
- ?line {ok,-2147483648} = asn1_wrapper:decode('Prim','Int',lists:flatten(BytesApp10)),
-
-
- %%==========================================================
- %% IntExpCon ::= [50] EXPLICIT INTEGER
- %%==========================================================
-
- ?line {ok,BytesExpCon1} = asn1_wrapper:encode('Prim','IntExpCon',4),
- ?line {ok,4} = asn1_wrapper:decode('Prim','IntExpCon',lists:flatten(BytesExpCon1)),
-
- ?line {ok,BytesExpCon2} = asn1_wrapper:encode('Prim','IntExpCon',444),
- ?line {ok,444} = asn1_wrapper:decode('Prim','IntExpCon',lists:flatten(BytesExpCon2)),
-
- ?line {ok,BytesExpCon3} = asn1_wrapper:encode('Prim','IntExpCon',123456789),
- ?line {ok,123456789} = asn1_wrapper:decode('Prim','IntExpCon',lists:flatten(BytesExpCon3)),
-
- ?line {ok,BytesExpCon4} = asn1_wrapper:encode('Prim','IntExpCon',12345678901234567890),
- ?line {ok,12345678901234567890} = asn1_wrapper:decode('Prim','IntExpCon',lists:flatten(BytesExpCon4)),
-
- ?line {ok,BytesExpCon5} = asn1_wrapper:encode('Prim','IntExpCon',-100),
- ?line {ok,-100} = asn1_wrapper:decode('Prim','IntExpCon',lists:flatten(BytesExpCon5)),
-
- ?line {ok,BytesExpCon6} = asn1_wrapper:encode('Prim','IntExpCon',-255),
- ?line {ok,-255} = asn1_wrapper:decode('Prim','IntExpCon',lists:flatten(BytesExpCon6)),
-
- ?line {ok,BytesExpCon7} = asn1_wrapper:encode('Prim','IntExpCon',-256),
- ?line {ok,-256} = asn1_wrapper:decode('Prim','IntExpCon',lists:flatten(BytesExpCon7)),
-
- ?line {ok,BytesExpCon8} = asn1_wrapper:encode('Prim','IntExpCon',-257),
- ?line {ok,-257} = asn1_wrapper:decode('Prim','IntExpCon',lists:flatten(BytesExpCon8)),
-
- ?line {ok,BytesExpCon9} = asn1_wrapper:encode('Prim','IntExpCon',-1234567890),
- ?line {ok,-1234567890} = asn1_wrapper:decode('Prim','IntExpCon',lists:flatten(BytesExpCon9)),
-
- ?line {ok,BytesExpCon10} = asn1_wrapper:encode('Prim','Int',-2147483648),
- ?line {ok,-2147483648} = asn1_wrapper:decode('Prim','Int',lists:flatten(BytesExpCon10)),
-
- %%==========================================================
- %% IntExpPri ::= [PRIVATE 51] EXPLICIT INTEGER
- %%==========================================================
-
- ?line {ok,BytesExpPri1} = asn1_wrapper:encode('Prim','IntExpPri',4),
- ?line {ok,4} = asn1_wrapper:decode('Prim','IntExpPri',lists:flatten(BytesExpPri1)),
-
- ?line {ok,BytesExpPri2} = asn1_wrapper:encode('Prim','IntExpPri',444),
- ?line {ok,444} = asn1_wrapper:decode('Prim','IntExpPri',lists:flatten(BytesExpPri2)),
-
- ?line {ok,BytesExpPri3} = asn1_wrapper:encode('Prim','IntExpPri',123456789),
- ?line {ok,123456789} = asn1_wrapper:decode('Prim','IntExpPri',lists:flatten(BytesExpPri3)),
-
- ?line {ok,BytesExpPri4} = asn1_wrapper:encode('Prim','IntExpPri',12345678901234567890),
- ?line {ok,12345678901234567890} = asn1_wrapper:decode('Prim','IntExpPri',lists:flatten(BytesExpPri4)),
-
- ?line {ok,BytesExpPri5} = asn1_wrapper:encode('Prim','IntExpPri',-100),
- ?line {ok,-100} = asn1_wrapper:decode('Prim','IntExpPri',lists:flatten(BytesExpPri5)),
-
- ?line {ok,BytesExpPri6} = asn1_wrapper:encode('Prim','IntExpPri',-255),
- ?line {ok,-255} = asn1_wrapper:decode('Prim','IntExpPri',lists:flatten(BytesExpPri6)),
-
- ?line {ok,BytesExpPri7} = asn1_wrapper:encode('Prim','IntExpPri',-256),
- ?line {ok,-256} = asn1_wrapper:decode('Prim','IntExpPri',lists:flatten(BytesExpPri7)),
-
- ?line {ok,BytesExpPri8} = asn1_wrapper:encode('Prim','IntExpPri',-257),
- ?line {ok,-257} = asn1_wrapper:decode('Prim','IntExpPri',lists:flatten(BytesExpPri8)),
-
- ?line {ok,BytesExpPri9} = asn1_wrapper:encode('Prim','IntExpPri',-1234567890),
- ?line {ok,-1234567890} = asn1_wrapper:decode('Prim','IntExpPri',lists:flatten(BytesExpPri9)),
-
- ?line {ok,BytesExpPri10} = asn1_wrapper:encode('Prim','Int',-2147483648),
- ?line {ok,-2147483648} = asn1_wrapper:decode('Prim','Int',lists:flatten(BytesExpPri10)),
-
- %%==========================================================
- %% IntExpApp ::= [APPLICATION 52] EXPLICIT INTEGER
- %%==========================================================
-
- ?line {ok,BytesExpApp1} = asn1_wrapper:encode('Prim','IntExpApp',4),
- ?line {ok,4} = asn1_wrapper:decode('Prim','IntExpApp',lists:flatten(BytesExpApp1)),
-
- ?line {ok,BytesExpApp2} = asn1_wrapper:encode('Prim','IntExpApp',444),
- ?line {ok,444} = asn1_wrapper:decode('Prim','IntExpApp',lists:flatten(BytesExpApp2)),
-
- ?line {ok,BytesExpApp3} = asn1_wrapper:encode('Prim','IntExpApp',123456789),
- ?line {ok,123456789} = asn1_wrapper:decode('Prim','IntExpApp',lists:flatten(BytesExpApp3)),
-
- ?line {ok,BytesExpApp4} = asn1_wrapper:encode('Prim','IntExpApp',12345678901234567890),
- ?line {ok,12345678901234567890} = asn1_wrapper:decode('Prim','IntExpApp',lists:flatten(BytesExpApp4)),
-
- ?line {ok,BytesExpApp5} = asn1_wrapper:encode('Prim','IntExpApp',-100),
- ?line {ok,-100} = asn1_wrapper:decode('Prim','IntExpApp',lists:flatten(BytesExpApp5)),
-
- ?line {ok,BytesExpApp6} = asn1_wrapper:encode('Prim','IntExpApp',-255),
- ?line {ok,-255} = asn1_wrapper:decode('Prim','IntExpApp',lists:flatten(BytesExpApp6)),
-
- ?line {ok,BytesExpApp7} = asn1_wrapper:encode('Prim','IntExpApp',-256),
- ?line {ok,-256} = asn1_wrapper:decode('Prim','IntExpApp',lists:flatten(BytesExpApp7)),
-
- ?line {ok,BytesExpApp8} = asn1_wrapper:encode('Prim','IntExpApp',-257),
- ?line {ok,-257} = asn1_wrapper:decode('Prim','IntExpApp',lists:flatten(BytesExpApp8)),
-
- ?line {ok,BytesExpApp9} = asn1_wrapper:encode('Prim','IntExpApp',-1234567890),
- ?line {ok,-1234567890} = asn1_wrapper:decode('Prim','IntExpApp',lists:flatten(BytesExpApp9)),
-
- ?line {ok,BytesExpApp10} = asn1_wrapper:encode('Prim','Int',-2147483648),
- ?line {ok,-2147483648} = asn1_wrapper:decode('Prim','Int',lists:flatten(BytesExpApp10)),
-
+ Values = [0,2,3,4,127,128,254,255,256,257,444,
+ 16383,16384,16385,65534,65535,65536,65537,
+ 123456789,12345678901234567890,
+ -1,-2,-3,-4,-100,-127,-255,-256,-257,
+ -1234567890,-2147483648],
+ [roundtrip(T, V) ||
+ T <- ['Int','IntCon','IntPri','IntApp',
+ 'IntExpCon','IntExpPri','IntExpApp'],
+ V <- [1|Values]],
%%==========================================================
%% IntEnum ::= INTEGER {first(1),last(31)}
%%==========================================================
- ?line {ok,BytesEnum1} = asn1_wrapper:encode('Prim','IntEnum',4),
- ?line {ok,4} = asn1_wrapper:decode('Prim','IntEnum',lists:flatten(BytesEnum1)),
-
- ?line {ok,BytesEnum2} = asn1_wrapper:encode('Prim','IntEnum',444),
- ?line {ok,444} = asn1_wrapper:decode('Prim','IntEnum',lists:flatten(BytesEnum2)),
-
- ?line {ok,BytesEnum3} = asn1_wrapper:encode('Prim','IntEnum',123456789),
- ?line {ok,123456789} = asn1_wrapper:decode('Prim','IntEnum',lists:flatten(BytesEnum3)),
-
- ?line {ok,BytesEnum4} = asn1_wrapper:encode('Prim','IntEnum',12345678901234567890),
- ?line {ok,12345678901234567890} = asn1_wrapper:decode('Prim','IntEnum',lists:flatten(BytesEnum4)),
+ [roundtrip('IntEnum', V) || V <- Values],
- ?line {ok,BytesEnum5} = asn1_wrapper:encode('Prim','IntEnum',-100),
- ?line {ok,-100} = asn1_wrapper:decode('Prim','IntEnum',lists:flatten(BytesEnum5)),
-
- ?line {ok,BytesEnum6} = asn1_wrapper:encode('Prim','IntEnum',-255),
- ?line {ok,-255} = asn1_wrapper:decode('Prim','IntEnum',lists:flatten(BytesEnum6)),
-
- ?line {ok,BytesEnum7} = asn1_wrapper:encode('Prim','IntEnum',-256),
- ?line {ok,-256} = asn1_wrapper:decode('Prim','IntEnum',lists:flatten(BytesEnum7)),
-
- ?line {ok,BytesEnum8} = asn1_wrapper:encode('Prim','IntEnum',-257),
- ?line {ok,-257} = asn1_wrapper:decode('Prim','IntEnum',lists:flatten(BytesEnum8)),
-
- ?line {ok,BytesEnum9} = asn1_wrapper:encode('Prim','IntEnum',-1234567890),
- ?line {ok,-1234567890} = asn1_wrapper:decode('Prim','IntEnum',lists:flatten(BytesEnum9)),
-
- ?line {ok,BytesEnum910} = asn1_wrapper:encode('Prim','Int',-2147483648),
- ?line {ok,-2147483648} = asn1_wrapper:decode('Prim','Int',lists:flatten(BytesEnum910)),
-
-
- ?line {ok,BytesEnum10} = asn1_wrapper:encode('Prim','IntEnum',first),
- ?line {ok,first} = asn1_wrapper:decode('Prim','IntEnum',lists:flatten(BytesEnum10)),
-
- ?line {ok,BytesEnum11} = asn1_wrapper:encode('Prim','IntEnum',last),
- ?line {ok,last} = asn1_wrapper:decode('Prim','IntEnum',lists:flatten(BytesEnum11)),
-
+ roundtrip('IntEnum', first),
+ roundtrip('IntEnum', last),
+ roundtrip('ASeq', {'ASeq',true,254,false,255,true,256,true,68789}),
+ roundtrip('ASeq', {'ASeq',false,250,true,200,true,199,true,77788}),
+ roundtrip('ASeq', {'ASeq',true,0,false,0,true,0,true,68789}),
ok.
-
enum(Rules) ->
%%==========================================================
@@ -496,23 +88,9 @@ enum(Rules) ->
%% friday(5),saturday(6),sunday(7)}
%%==========================================================
- ?line {ok,BytesEnum1} = asn1_wrapper:encode('Prim','Enum',monday),
- ?line {ok,monday} = asn1_wrapper:decode('Prim','Enum',lists:flatten(BytesEnum1)),
-
- ?line {ok,BytesEnum2} = asn1_wrapper:encode('Prim','Enum',thursday),
- ?line {ok,thursday} = asn1_wrapper:decode('Prim','Enum',lists:flatten(BytesEnum2)),
-
-
- ?line case asn1_wrapper:erule(Rules) of
- ber ->
- ?line {error,{asn1,{_,4}}} =
- case catch asn1_wrapper:encode('Prim','Enum',4) of Enum -> Enum end,
- ok;
- per ->
- ?line {error,{asn1,{_,4}}} =
- case catch asn1_wrapper:encode('Prim','Enum',4) of Enum -> Enum end,
- ok
- end,
+ roundtrip('Enum', monday),
+ roundtrip('Enum', thursday),
+ {error,{asn1,{_,4}}} = (catch 'Prim':encode('Enum', 4)),
case Rules of
Per when Per =:= per; Per =:= uper ->
@@ -524,88 +102,41 @@ enum(Rules) ->
ok.
-
-obj_id(Rules) ->
+obj_id(_) ->
%%==========================================================
%% ObjId ::= OBJECT IDENTIFIER
%%==========================================================
- ?line {ok,Bytes1} = asn1_wrapper:encode('Prim','ObjId',{0,22,3}),
- ?line {ok,{0,22,3}} = asn1_wrapper:decode('Prim','ObjId',lists:flatten(Bytes1)),
-
- ?line {ok,Bytes2} = asn1_wrapper:encode('Prim','ObjId',{1,39,3}),
- ?line {ok,{1,39,3}} = asn1_wrapper:decode('Prim','ObjId',lists:flatten(Bytes2)),
-
- ?line {ok,Bytes3} = asn1_wrapper:encode('Prim','ObjId',{2,100,3}),
- ?line {ok,{2,100,3}} = asn1_wrapper:decode('Prim','ObjId',lists:flatten(Bytes3)),
-
- ?line {ok,Bytes4} = asn1_wrapper:encode('Prim','ObjId',{2,16303,3}),
- ?line {ok,{2,16303,3}} = asn1_wrapper:decode('Prim','ObjId',lists:flatten(Bytes4)),
-
- ?line case asn1_wrapper:erule(Rules) of
- ber ->
- ?line {ok,Bytes5} = asn1_wrapper:encode('Prim','ObjId',{2,16304,3}),
- ?line {ok,{2,16304,3}} = asn1_wrapper:decode('Prim','ObjId',lists:flatten(Bytes5)),
- ok;
- per ->
- ?line {ok,Bytes5} = asn1_wrapper:encode('Prim','ObjId',{2,16304,3}),
- ?line {ok,{2,16304,3}} = asn1_wrapper:decode('Prim','ObjId',lists:flatten(Bytes5)),
-%% ?line test_server:format("~p~n",[Kurt]),
-% ?line {ok,{2,16304,3}} = asn1_wrapper:decode('Prim','ObjId',lists:flatten(Bytes5)),
- ok
- end,
-
-
-
+ [roundtrip('ObjId', V) ||
+ V <- [{0,22,3},{1,39,3},{2,100,3},{2,16303,3},{2,16304,3}]],
ok.
rel_oid(_Rules) ->
-
%%==========================================================
%% RelOid ::= RELATIVE-OID
%%==========================================================
- ?line {ok,Bytes1} = asn1_wrapper:encode('Prim','RelOid',{0,22,3}),
- ?line {ok,{0,22,3}} = asn1_wrapper:decode('Prim','RelOid',lists:flatten(Bytes1)),
-
- ?line {ok,Bytes2} = asn1_wrapper:encode('Prim','RelOid',{1,39,3}),
- ?line {ok,{1,39,3}} = asn1_wrapper:decode('Prim','RelOid',lists:flatten(Bytes2)),
-
- ?line {ok,Bytes3} = asn1_wrapper:encode('Prim','RelOid',{2,100,3}),
- ?line {ok,{2,100,3}} = asn1_wrapper:decode('Prim','RelOid',lists:flatten(Bytes3)),
-
- ?line {ok,Bytes4} = asn1_wrapper:encode('Prim','RelOid',{2,16303,3}),
- ?line {ok,{2,16303,3}} = asn1_wrapper:decode('Prim','RelOid',lists:flatten(Bytes4)),
-
- ?line {ok,Bytes5} = asn1_wrapper:encode('Prim','RelOid',{2,16304,3}),
- ?line {ok,{2,16304,3}} = asn1_wrapper:decode('Prim','RelOid',lists:flatten(Bytes5)),
-
- ?line {ok,Bytes6} = asn1_wrapper:encode('Prim','RelOid',{8,16304,16#ffff}),
- ?line {ok,{8,16304,16#ffff}} = asn1_wrapper:decode('Prim','RelOid',lists:flatten(Bytes6)),
-
-
-
+ [roundtrip('RelOid', V) ||
+ V <- [{0,22,3},{1,39,3},{2,100,3},{2,16303,3},
+ {2,16304,3},{8,16304,16#ffff}]],
ok.
-
-
-
null(_Rules) ->
%%==========================================================
%% Null ::= NULL
%%==========================================================
- ?line {ok,Bytes1} = asn1_wrapper:encode('Prim','Null',monday),
- ?line {ok,'NULL'} = asn1_wrapper:decode('Prim','Null',lists:flatten(Bytes1)),
-
-
-
-ok.
-
+ {ok,Bytes1} = asn1_wrapper:encode('Prim','Null',monday),
+ {ok,'NULL'} = asn1_wrapper:decode('Prim','Null',lists:flatten(Bytes1)),
+ ok.
+roundtrip(T, V) ->
+ {ok,E} = 'Prim':encode(T, V),
+ {ok,V} = 'Prim':decode(T, E),
+ E.
real(_Rules) ->
%%==========================================================
diff --git a/lib/asn1/test/testPrimStrings.erl b/lib/asn1/test/testPrimStrings.erl
index f8b0c5b05a..e2322c92a9 100644
--- a/lib/asn1/test/testPrimStrings.erl
+++ b/lib/asn1/test/testPrimStrings.erl
@@ -54,7 +54,7 @@ bit_string(Rules) ->
bs_roundtrip('Bs1', [1,0,0,0,0,0,0,0,0]),
bs_roundtrip('Bs1', [0,1,0,0,1,0,1,1,1,1,1,0,0,0,1,0,0,1,1]),
- case asn1_wrapper:erule(Rules) of
+ case Rules of
ber ->
bs_decode('Bs1', <<35,8,3,2,0,73,3,2,4,32>>,
[0,1,0,0,1,0,0,1,0,0,1,0]),
@@ -62,7 +62,7 @@ bit_string(Rules) ->
[1,1,1,0,1,0,1,0,1,0,0,1,1,1,0,0,0]),
bs_decode('Bs1', <<35,128,3,2,0,234,3,3,7,156,0,0,0>>,
[1,1,1,0,1,0,1,0,1,0,0,1,1,1,0,0,0]);
- per ->
+ _ ->
ok
end,
@@ -71,35 +71,16 @@ bit_string(Rules) ->
%% Bs2 ::= BIT STRING {su(0), mo(1), tu(2), we(3), th(4), fr(5), sa(6) } (SIZE (7))
%%==========================================================
- ?line {ok,Bytes21} = asn1_wrapper:encode('PrimStrings','Bs2',[mo,tu,fr]),
- ?line {ok,[mo,tu,fr]} = asn1_wrapper:decode('PrimStrings','Bs2',lists:flatten(Bytes21)),
-
- ?line {ok,Bytes22} = asn1_wrapper:encode('PrimStrings','Bs2',[0,1,1,0,0,1,0]),
- ?line {ok,[mo,tu,fr]} = asn1_wrapper:decode('PrimStrings','Bs2',lists:flatten(Bytes22)),
- ok,
-%% skip this because it is wrong
-% ?line case asn1_wrapper:erule(Rules) of
-% ber ->
-% ?line {ok,[mo,tu,fr,su,mo,th]} =
-% asn1_wrapper:decode('PrimStrings','Bs2',[35,8,3,2,0,101,3,2,2,200]),
-
-% ?line {ok,[mo,tu,fr,su,mo,th]} =
-% asn1_wrapper:decode('PrimStrings','Bs2',[35,128,3,2,1,100,3,2,2,200,0,0]),
-% ok;
-
-% per ->
-% ok
-% end,
-
-
-
+ roundtrip('Bs2', [mo,tu,fr]),
+ roundtrip('Bs2', [0,1,1,0,0,1,0], [mo,tu,fr]),
+
%%==========================================================
%% Bs3 ::= BIT STRING {su(0), mo(1), tu(2), we(3), th(4), fr(5), sa(6) } (SIZE (1..7))
%%==========================================================
roundtrip('Bs3', [mo,tu,fr]),
bs_roundtrip('Bs3', [0,1,1,0,0,1,0], [mo,tu,fr]),
-
+
%%==========================================================
%% Bs7 ::= BIT STRING (SIZE (24))
%%==========================================================
@@ -114,10 +95,9 @@ bit_string(Rules) ->
%%==========================================================
bs_roundtrip('BsPri', 45, [1,0,1,1,0,1]),
-
bs_roundtrip('BsPri', 211, [1,1,0,0,1,0,1,1]),
- case asn1_wrapper:erule(Rules) of
+ case Rules of
ber ->
bs_decode('BsPri', <<223,61,4,5,75,226,96>>,
[0,1,0,0,1,0,1,1,1,1,1,0,0,0,1,0,0,1,1]),
@@ -127,7 +107,7 @@ bit_string(Rules) ->
[0,1,0,0,1,0,1,1,1,1,1,0,0,0,1,0,0,1,1]),
bs_decode('BsPri', <<255,61,128,3,2,0,75,3,3,5,226,96,0,0>>,
[0,1,0,0,1,0,1,1,1,1,1,0,0,0,1,0,0,1,1]);
- per ->
+ _ ->
ok
end,
@@ -139,11 +119,11 @@ bit_string(Rules) ->
bs_roundtrip('BsExpPri', 45, [1,0,1,1,0,1]),
bs_roundtrip('BsExpPri', 211, [1,1,0,0,1,0,1,1]),
- case asn1_wrapper:erule(Rules) of
+ case Rules of
ber ->
bs_decode('BsExpPri', <<255,61,6,3,4,5,75,226,96>>,
[0,1,0,0,1,0,1,1,1,1,1,0,0,0,1,0,0,1,1]);
- per ->
+ _ ->
ok
end,
@@ -151,24 +131,22 @@ bit_string(Rules) ->
%% TestS ::= BIT STRING {a(0),b(1)} (SIZE (3..8)), test case for OTP-4353
%%==========================================================
- ?line {ok,Bytes53} = asn1_wrapper:encode('PrimStrings','TestS',[a]),
- ?line {ok,[a]} =
- asn1_wrapper:decode('PrimStrings','TestS',lists:flatten(Bytes53)),
+ roundtrip('TestS', [a]),
%%==========================================================
%% PersonalStatus ::= BIT STRING {married(0),employed(1),
%% veteran(2), collegeGraduate(3)}, test case for OTP-5710
%%==========================================================
- ?line {ok,Bytes54} = asn1_wrapper:encode('BitStr','PersonalStatus',[]),
- ?line {ok,[]} = asn1_wrapper:decode('BitStr','PersonalStatus',Bytes54),
+ {ok,Bytes54} = 'BitStr':encode('PersonalStatus', []),
+ {ok,[]} = 'BitStr':decode('PersonalStatus', Bytes54),
%%==========================================================
%% BS5932 ::= BIT STRING (SIZE (5..MAX))
%% test case for OTP-5932
%%==========================================================
bs_roundtrip('BSMAX', [1,0,1,0,1]),
- case asn1_wrapper:erule(Rules) of
+ case Rules of
ber ->
{error,_} = 'PrimStrings':encode('BSMAX', [1,0,1]);
_ ->
@@ -195,7 +173,91 @@ bit_string(Rules) ->
BSList1024 = BSmaker(BSmaker,0,1024,{1,0},[]),
bs_roundtrip('BS1024', BSList1024),
- bs_roundtrip('TransportLayerAddress', [0,1,1,0]).
+ bs_roundtrip('TransportLayerAddress', [0,1,1,0]),
+
+ case Rules of
+ ber -> ok;
+ _ -> per_bs_strings()
+ end.
+
+%% The PER encoding rules requires that a BIT STRING with
+%% named positions should never have any trailing zeroes
+%% (except to reach the minimum number of bits as given by
+%% a SIZE constraint).
+
+per_bs_strings() ->
+ bs_roundtrip('Bs3', [0,0,1,0,0,0,0], [tu]),
+ bs_roundtrip('Bs3', <<2#0010000:7>>, [tu]),
+ bs_roundtrip('Bs3', {1,<<2#00100000:8>>}, [tu]),
+
+ bs_roundtrip('Bs4', [0,1,1,0,0,1,0], [mo,tu,fr]),
+ bs_roundtrip('Bs4', <<2#0110010:7>>, [mo,tu,fr]),
+ bs_roundtrip('Bs4', {1,<<2#01100100:8>>}, [mo,tu,fr]),
+
+ bs_roundtrip('Bs4', [0,1,1,0,0,0,0], [mo,tu]),
+ bs_roundtrip('Bs4', <<2#011:3,0:32>>, [mo,tu]),
+ bs_roundtrip('Bs4', {5,<<2#011:3,0:32,0:5>>}, [mo,tu]),
+
+ [per_trailing_zeroes(B) || B <- lists:seq(0, 255)],
+ ok.
+
+%% Trailing zeroes should be removed from BIT STRINGs with named
+%% bit positions.
+
+per_trailing_zeroes(Byte) ->
+ L = lists:reverse(make_bit_list(Byte+16#10000)),
+ L = make_bit_list(Byte+16#10000, []),
+ Pos = positions(L, 0),
+ ExpectedSz = case lists:last(Pos) of
+ su -> 1;
+ {bit,LastBitPos} -> LastBitPos+1
+ end,
+
+ %% List of zeroes and ones.
+ named_roundtrip(L, Pos, ExpectedSz),
+ named_roundtrip(L++[0,0,0,0,0], Pos, ExpectedSz),
+
+ %% Bitstrings.
+ Bs = << <<B:1>> || B <- L >>,
+ Sz = bit_size(Bs),
+ named_roundtrip(Bs, Pos, ExpectedSz),
+ Bin = <<Bs:Sz/bits,0:16,0:7>>,
+ named_roundtrip(Bin, Pos, ExpectedSz),
+
+ %% Compact bitstring.
+ named_roundtrip({7,Bin}, Pos, ExpectedSz),
+
+ %% Integer bitstring (obsolete).
+ IntBs = intlist_to_integer(L, 0, 0),
+ named_roundtrip(IntBs, Pos, ExpectedSz),
+
+ ok.
+
+make_bit_list(0) -> [];
+make_bit_list(B) -> [B band 1|make_bit_list(B bsr 1)].
+
+make_bit_list(0, Acc) -> Acc;
+make_bit_list(B, Acc) -> make_bit_list(B bsr 1, [B band 1|Acc]).
+
+positions([1|T], 0) -> [su|positions(T, 1)];
+positions([1|T], Pos) -> [{bit,Pos}|positions(T, Pos+1)];
+positions([0|T], Pos) -> positions(T, Pos+1);
+positions([], _) -> [].
+
+intlist_to_integer([B|T], Shift, Acc) ->
+ intlist_to_integer(T, Shift+1, (B bsl Shift) + Acc);
+intlist_to_integer([], _, Acc) -> Acc.
+
+named_roundtrip(Value, Expected, ExpectedSz) ->
+ M = 'PrimStrings',
+ Type = 'Bs4',
+ {ok,Encoded} = M:encode(Type, Value),
+ {ok,Encoded} = M:encode(Type, Expected),
+ {ok,Expected} = M:decode(Type, Encoded),
+
+ %% Verify the size in the first byte.
+ <<ExpectedSz:8,_/bits>> = Encoded,
+ ok.
octet_string(Rules) ->
@@ -203,21 +265,18 @@ octet_string(Rules) ->
%% Os ::= OCTET STRING
%%==========================================================
- ?line case asn1_wrapper:erule(Rules) of
- ber ->
- ?line {ok,"Jones"} =
- asn1_wrapper:decode('PrimStrings','Os',[4,5,16#4A,16#6F,16#6E,16#65,16#73]),
-
- ?line {ok,"Jones"} =
- asn1_wrapper:decode('PrimStrings','Os',[36,9,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73]),
-
- ?line {ok,"Jones"} =
- asn1_wrapper:decode('PrimStrings','Os',[36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0]),
- ok;
-
- per ->
- ok
- end,
+ case Rules of
+ ber ->
+ {ok,"Jones"} =
+ 'PrimStrings':decode('Os', <<4,5,16#4A,16#6F,16#6E,16#65,16#73>>),
+ {ok,"Jones"} =
+ 'PrimStrings':decode('Os', <<36,9,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73>>),
+ {ok,"Jones"} =
+ 'PrimStrings':decode('Os', <<36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0>>),
+ ok;
+ _ ->
+ ok
+ end,
roundtrip('Os', [47,23,99,255,1]),
roundtrip('OsCon', [47,23,99,255,1]),
@@ -239,27 +298,32 @@ octet_string(Rules) ->
roundtrip('OsExpApp', OsR),
- ?line case asn1_wrapper:erule(Rules) of
- ber ->
- ?line {ok,"Jones"} = asn1_wrapper:decode('PrimStrings','OsExpApp',[127,62,7,4,5,16#4A,16#6F,16#6E,16#65,16#73]),
- ?line {ok,"Jones"} = asn1_wrapper:decode('PrimStrings','OsExpApp',[127,62,11,36,9,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73]),
- ?line {ok,"Jones"} = asn1_wrapper:decode('PrimStrings','OsExpApp',[127,62,13,36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0]),
- ?line {ok,"Jones"} = asn1_wrapper:decode('PrimStrings','OsExpApp',[127,62,128,36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0,0,0]),
- ?line {ok,"JonesJones"} = asn1_wrapper:decode('PrimStrings','OsExpApp',[127,62,128,36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0,36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0,0,0]),
- ok;
-
- per ->
- ok
- end,
+ case Rules of
+ ber ->
+ {ok,"Jones"} = 'PrimStrings':decode('OsExpApp', <<127,62,7,4,5,16#4A,16#6F,16#6E,16#65,16#73>>),
+ {ok,"Jones"} = 'PrimStrings':decode('OsExpApp', <<127,62,11,36,9,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73>>),
+ {ok,"Jones"} = 'PrimStrings':decode('OsExpApp', <<127,62,13,36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0>>),
+ {ok,"Jones"} = 'PrimStrings':decode('OsExpApp', <<127,62,128,36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0,0,0>>),
+ {ok,"JonesJones"} = 'PrimStrings':decode('OsExpApp', <<127,62,128,36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0,36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0,0,0>>),
+ ok;
+
+ _->
+ ok
+ end,
fragmented_octet_string(Rules),
S255 = lists:seq(1, 255),
- FixedStrings = {'OsFixedStrings',true,"","1","12","345",true,
- S255,[$a|S255],[$a,$b|S255],397},
- roundtrip('OsFixedStrings', FixedStrings),
+ Strings = {type,true,"","1","12","345",true,
+ S255,[$a|S255],[$a,$b|S255],397},
+ p_roundtrip('OsFixedStrings', Strings),
+ p_roundtrip('OsFixedStringsExt', Strings),
+ p_roundtrip('OsVarStringsExt', Strings),
+ ShortenedStrings = shorten_by_two(Strings),
+ p_roundtrip('OsFixedStringsExt', ShortenedStrings),
+ p_roundtrip('OsVarStringsExt', ShortenedStrings),
ok.
-
+
fragmented_octet_string(Erules) ->
K16 = 1 bsl 14,
K32 = K16 + K16,
@@ -271,10 +335,12 @@ fragmented_octet_string(Erules) ->
K48-1,K48,K48+1,K48+(1 bsl 7)-1,K48+(1 bsl 7),K48+(1 bsl 7)+1,
K64-1,K64,K64+1,K64+(1 bsl 7)-1,K64+(1 bsl 7),K64+(1 bsl 7)+1,
K64+K16-1,K64+K16,K64+K16+1],
- Types = ['Os','OsFrag'],
+ Types = ['Os','OsFrag','OsFragExt'],
[fragmented_octet_string(Erules, Types, L) || L <- Lens],
fragmented_octet_string(Erules, ['FixedOs65536'], 65536),
fragmented_octet_string(Erules, ['FixedOs65537'], 65537),
+ fragmented_octet_string(Erules, ['FixedOs65536Ext'], 65536),
+ fragmented_octet_string(Erules, ['FixedOs65537Ext'], 65537),
%% Make sure that octet alignment works.
roundtrip('OsAlignment',
@@ -336,75 +402,58 @@ numeric_string(Rules) ->
%%==========================================================
roundtrip('Ns', []),
+ roundtrip('Ns', "01 34"),
+ case Rules of
+ ber ->
+ {ok,"Jones"} = 'PrimStrings':decode('Ns',
+ <<16#12,5,16#4A,16#6F,
+ 16#6E,16#65,16#73>>),
+ {ok,"Jones"} = 'PrimStrings':decode('Ns',
+ <<16#32,9,18,3,16#4A,16#6F,
+ 16#6E,18,2,16#65,16#73>>),
+ {ok,"Jones"} = 'PrimStrings':decode('Ns',
+ <<16#32,128,18,3,16#4A,16#6F,
+ 16#6E,18,2,16#65,16#73,0,0>>),
+ ok;
+ _ ->
+ ok
+ end,
- ?line case asn1_wrapper:erule(Rules) of
- ber ->
- ?line {ok,BytesNs1} = asn1_wrapper:encode('PrimStrings','Ns',[48,49,32,51,52]),
- ?line {ok,[48,49,32,51,52]} = asn1_wrapper:decode('PrimStrings','Ns',lists:flatten(BytesNs1)),
-
- ?line {ok,"Jones"} = asn1_wrapper:decode('PrimStrings','Ns',[16#12,5,16#4A,16#6F,16#6E,16#65,16#73]),
- ?line {ok,"Jones"} = asn1_wrapper:decode('PrimStrings','Ns',[16#32,9,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73]),
- ?line {ok,"Jones"} = asn1_wrapper:decode('PrimStrings','Ns',[16#32,128,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73,0,0]),
- ok;
-
- per ->
- ?line {ok,BytesNs1} = asn1_wrapper:encode('PrimStrings','Ns',[48,49,32,51,52]),
- ?line {ok,"01 34"} = asn1_wrapper:decode('PrimStrings','Ns',lists:flatten(BytesNs1)),
- ok
- end,
-
-
-
-
%%==========================================================
%% NsCon ::= [70] NumericString
%%==========================================================
roundtrip('NsCon', []),
+ roundtrip('NsCon', "01 34"),
- ?line case asn1_wrapper:erule(Rules) of
- ber ->
- ?line {ok,BytesNs11} = asn1_wrapper:encode('PrimStrings','NsCon',[48,49,32,51,52]),
- ?line {ok,[48,49,32,51,52]} = asn1_wrapper:decode('PrimStrings','NsCon',lists:flatten(BytesNs11)),
-
- ?line {ok,"Jones"} = asn1_wrapper:decode('PrimStrings','NsCon',[16#9F,16#46,5,16#4A,16#6F,16#6E,16#65,16#73]),
- ?line {ok,"Jones"} = asn1_wrapper:decode('PrimStrings','NsCon',[16#BF,16#46,9,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73]),
- ?line {ok,"Jones"} = asn1_wrapper:decode('PrimStrings','NsCon',[16#BF,16#46,128,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73,0,0]),
- ok;
-
- per ->
- ?line {ok,BytesNs11} = asn1_wrapper:encode('PrimStrings','NsCon',[48,49,32,51,52]),
- ?line {ok,"01 34"} = asn1_wrapper:decode('PrimStrings','NsCon',lists:flatten(BytesNs11)),
- ok
- end,
-
+ case Rules of
+ ber ->
+ {ok,"Jones"} = 'PrimStrings':decode('NsCon', <<16#9F,16#46,5,16#4A,16#6F,16#6E,16#65,16#73>>),
+ {ok,"Jones"} = 'PrimStrings':decode('NsCon', <<16#BF,16#46,9,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73>>),
+ {ok,"Jones"} = 'PrimStrings':decode('NsCon', <<16#BF,16#46,128,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73,0,0>>),
+ ok;
+ _ ->
+ ok
+ end,
-
%%==========================================================
%% NsExpCon ::= [71] EXPLICIT NumericString
%%==========================================================
roundtrip('NsExpCon', []),
+ roundtrip('NsExpCon', "01 34"),
- ?line case asn1_wrapper:erule(Rules) of
- ber ->
- ?line {ok,BytesNs21} = asn1_wrapper:encode('PrimStrings','NsExpCon',[48,49,32,51,52]),
- ?line {ok,[48,49,32,51,52]} = asn1_wrapper:decode('PrimStrings','NsExpCon',lists:flatten(BytesNs21)),
-
- ?line {ok,"Jones"} = asn1_wrapper:decode('PrimStrings','NsExpCon',[16#BF,16#47,16#07,16#12,16#05,16#4A,16#6F,16#6E,16#65,16#73]),
- ?line {ok,"Jones"} = asn1_wrapper:decode('PrimStrings','NsExpCon',[16#BF,16#47,11,16#32,9,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73]),
- ?line {ok,"Jones"} = asn1_wrapper:decode('PrimStrings','NsExpCon',[16#BF,16#47,128,16#32,128,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73,0,0,0,0]),
- ?line {ok,"JonesJones"} = asn1_wrapper:decode('PrimStrings','NsExpCon',[16#BF,16#47,26,16#32,128,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73,0,0,16#32,128,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73,0,0]),
- ?line {ok,"JonesJones"} = asn1_wrapper:decode('PrimStrings','NsExpCon',[16#BF,16#47,128,16#32,128,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73,0,0,16#32,128,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73,0,0,0,0]),
- ok;
-
- per ->
- ?line {ok,BytesNs21} = asn1_wrapper:encode('PrimStrings','NsExpCon',[48,49,32,51,52]),
- ?line {ok,"01 34"} = asn1_wrapper:decode('PrimStrings','NsExpCon',lists:flatten(BytesNs21)),
- ok
- end,
-
- ok.
+ case Rules of
+ ber ->
+ {ok,"Jones"} = 'PrimStrings':decode('NsExpCon', <<16#BF,16#47,16#07,16#12,16#05,16#4A,16#6F,16#6E,16#65,16#73>>),
+ {ok,"Jones"} = 'PrimStrings':decode('NsExpCon', <<16#BF,16#47,11,16#32,9,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73>>),
+ {ok,"Jones"} = 'PrimStrings':decode('NsExpCon', <<16#BF,16#47,128,16#32,128,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73,0,0,0,0>>),
+ {ok,"JonesJones"} = 'PrimStrings':decode('NsExpCon', <<16#BF,16#47,26,16#32,128,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73,0,0,16#32,128,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73,0,0>>),
+ {ok,"JonesJones"} = 'PrimStrings':decode('NsExpCon', <<16#BF,16#47,128,16#32,128,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73,0,0,16#32,128,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73,0,0,0,0>>),
+ ok;
+ _ ->
+ ok
+ end.
other_strings(_Rules) ->
@@ -438,6 +487,15 @@ other_strings(_Rules) ->
roundtrip('IA5Visible', lists:seq($\s, $~)),
+ S255 = lists:seq(0, 127) ++ lists:seq(1, 127),
+ Strings = {type,true,"","1","12","345",true,"6789",true,
+ S255,[$a|S255],[$a,$b|S255],397},
+ p_roundtrip('IA5FixedStrings', Strings),
+ p_roundtrip('IA5FixedStringsExt', Strings),
+ p_roundtrip('IA5VarStringsExt', Strings),
+ ShortenedStrings = shorten_by_two(Strings),
+ p_roundtrip('IA5VarStringsExt', ShortenedStrings),
+
ok.
@@ -491,23 +549,19 @@ universal_string(Rules) ->
%%==========================================================
roundtrip('Us', [{47,23,99,47},{0,0,55,66}]),
-
- ?line {ok,Bytes2} =
- asn1_wrapper:encode('PrimStrings','Us',[{47,23,99,255},{0,0,0,201}]),
- ?line {ok,[{47,23,99,255},201]} =
- asn1_wrapper:decode('PrimStrings','Us',lists:flatten(Bytes2)),
-
+ roundtrip('Us',
+ [{47,23,99,255},{0,0,0,201}],
+ [{47,23,99,255},201]),
roundtrip('Us', "Universal String"),
roundtrip('Us', []),
roundtrip('Us', [{47,23,99,47}]),
- ?line case asn1_wrapper:erule(Rules) of
- ber ->
-
- ?line {ok,[{47,23,99,255},{0,0,2,201}]} =
- asn1_wrapper:decode('PrimStrings','Us',lists:flatten([16#3C,12,28,4,47,23,99,255,28,4,0,0,2,201])),
- ?line {ok,[{47,23,99,255},{0,0,2,201}]} =
- asn1_wrapper:decode('PrimStrings','Us',lists:flatten([16#3C,16#80,28,4,47,23,99,255,28,4,0,0,2,201,0,0]));
+ case Rules of
+ ber ->
+ {ok,[{47,23,99,255},{0,0,2,201}]} =
+ 'PrimStrings':decode('Us', <<16#3C,12,28,4,47,23,99,255,28,4,0,0,2,201>>),
+ {ok,[{47,23,99,255},{0,0,2,201}]} =
+ 'PrimStrings':decode('Us', <<16#3C,16#80,28,4,47,23,99,255,28,4,0,0,2,201,0,0>>);
_ ->
ok
end,
@@ -522,24 +576,21 @@ universal_string(Rules) ->
%%==========================================================
roundtrip('UsCon', [{47,23,99,255},{0,0,2,201}]),
-
- ?line {ok,Bytes12} =
- asn1_wrapper:encode('PrimStrings','UsCon',[{47,23,99,255},{0,0,0,201}]),
- ?line {ok,[{47,23,99,255},201]} =
- asn1_wrapper:decode('PrimStrings','UsCon',lists:flatten(Bytes12)),
-
+ roundtrip('UsCon',
+ [{47,23,99,255},{0,0,0,201}],
+ [{47,23,99,255},201]),
roundtrip('UsCon', "Universal String"),
roundtrip('UsCon', []),
- ?line case asn1_wrapper:erule(Rules) of
- ber ->
- ?line {ok,[{47,23,99,255},{0,0,2,201}]} =
- asn1_wrapper:decode('PrimStrings','UsCon',lists:flatten([16#BF,16#46,12,28,4,47,23,99,255,28,4,0,0,2,201])),
- ?line {ok,[{47,23,99,255},{0,0,2,201}]} =
- asn1_wrapper:decode('PrimStrings','UsCon',lists:flatten([16#BF,16#46,16#80,28,4,47,23,99,255,28,4,0,0,2,201,0,0]));
- _ -> ok
- end,
-
+ case Rules of
+ ber ->
+ {ok,[{47,23,99,255},{0,0,2,201}]} =
+ 'PrimStrings':decode('UsCon', <<16#BF,16#46,12,28,4,47,23,99,255,28,4,0,0,2,201>>),
+ {ok,[{47,23,99,255},{0,0,2,201}]} =
+ 'PrimStrings':decode('UsCon', <<16#BF,16#46,16#80,28,4,47,23,99,255,28,4,0,0,2,201,0,0>>);
+ _ ->
+ ok
+ end,
%%==========================================================
@@ -547,25 +598,21 @@ universal_string(Rules) ->
%%==========================================================
roundtrip('UsExpCon', [{47,23,99,255},{0,0,2,201}]),
-
- ?line {ok,Bytes22} =
- asn1_wrapper:encode('PrimStrings','UsExpCon',[{47,23,99,255},{0,0,0,201}]),
- ?line {ok,[{47,23,99,255},201]} =
- asn1_wrapper:decode('PrimStrings','UsExpCon',lists:flatten(Bytes22)),
-
+ roundtrip('UsExpCon',
+ [{47,23,99,255},{0,0,0,201}],
+ [{47,23,99,255},201]),
roundtrip('UsExpCon', "Universal String"),
roundtrip('UsExpCon', []),
- ?line case asn1_wrapper:erule(Rules) of
- ber ->
- ?line {ok,[{47,23,99,255},{0,0,2,201}]} =
- asn1_wrapper:decode('PrimStrings','UsExpCon',lists:flatten([16#BF,16#47,14,60,12,28,4,47,23,99,255,28,4,0,0,2,201])),
- ?line {ok,[{47,23,99,255},{0,0,2,201}]} =
- asn1_wrapper:decode('PrimStrings','UsExpCon',lists:flatten([16#BF,16#47,16,60,16#80,28,4,47,23,99,255,28,4,0,0,2,201,0,0]));
- _ -> ok
- end,
-
- ok.
+ case Rules of
+ ber ->
+ {ok,[{47,23,99,255},{0,0,2,201}]} =
+ 'PrimStrings':decode('UsExpCon', <<16#BF,16#47,14,60,12,28,4,47,23,99,255,28,4,0,0,2,201>>),
+ {ok,[{47,23,99,255},{0,0,2,201}]} =
+ 'PrimStrings':decode('UsExpCon', <<16#BF,16#47,16,60,16#80,28,4,47,23,99,255,28,4,0,0,2,201,0,0>>);
+ _ ->
+ ok
+ end.
bmp_string(_Rules) ->
@@ -575,12 +622,9 @@ bmp_string(_Rules) ->
%%==========================================================
roundtrip('BMP', [{0,0,99,48},{0,0,2,201}]),
-
- ?line {ok,Bytes2} =
- asn1_wrapper:encode('PrimStrings','BMP',[{0,0,0,48},{0,0,2,201}]),
- ?line {ok,[48,{0,0,2,201}]} =
- asn1_wrapper:decode('PrimStrings','BMP',lists:flatten(Bytes2)),
-
+ roundtrip('BMP',
+ [{0,0,0,48},{0,0,2,201}],
+ [48,{0,0,2,201}]),
roundtrip('BMP', "BMP String"),
roundtrip('BMP', []),
@@ -589,9 +633,6 @@ bmp_string(_Rules) ->
ok.
-
-
-
times(_Rules) ->
@@ -620,106 +661,58 @@ utf8_string(_Rules) ->
%% UTF ::= UTF8String
%%==========================================================
- %% test values in all ranges
-
- ValLbR1 = [16#00],
- ValUbR1 = [16#7f],
- ValLbR2 = [16#80],
- ValUbR2 = [16#7ff],
- ValLbR3 = [16#800],
- ValUbR3 = [16#ffff],
- ValLbR4 = [16#10000],
- ValUbR4 = [16#1fffff],
- ValLbR5 = [16#200000],
- ValUbR5 = [16#3ffffff],
- ValLbR6 = [16#4000000],
- ValUbR6 = [16#7fffffff],
-
- ?line {ok,UTF8L1} = asn1rt:utf8_list_to_binary(ValLbR1),
- ?line {ok,Bytes1} = asn1_wrapper:encode('PrimStrings','UTF',UTF8L1),
- ?line {ok,Bin1} = asn1_wrapper:decode('PrimStrings','UTF',Bytes1),
- ?line {ok,ValLbR1} = wrapper_utf8_binary_to_list(Bin1),
-
- ?line {ok,UTF8L2} = asn1rt:utf8_list_to_binary(ValUbR1),
- ?line {ok,Bytes2} = asn1_wrapper:encode('PrimStrings','UTF',UTF8L2),
- ?line {ok,Bin2} = asn1_wrapper:decode('PrimStrings','UTF',Bytes2),
- ?line {ok,ValUbR1} = wrapper_utf8_binary_to_list(Bin2),
-
- ?line {ok,UTF8L3} = asn1rt:utf8_list_to_binary(ValLbR2),
- ?line {ok,Bytes3} = asn1_wrapper:encode('PrimStrings','UTF',UTF8L3),
- ?line {ok,Bin3} = asn1_wrapper:decode('PrimStrings','UTF',Bytes3),
- ?line {ok,ValLbR2} = wrapper_utf8_binary_to_list(Bin3),
-
- ?line {ok,UTF8L4} = asn1rt:utf8_list_to_binary(ValUbR2),
- ?line {ok,Bytes4} = asn1_wrapper:encode('PrimStrings','UTF',UTF8L4),
- ?line {ok,Bin4} = asn1_wrapper:decode('PrimStrings','UTF',Bytes4),
- ?line {ok,ValUbR2} = wrapper_utf8_binary_to_list(Bin4),
-
- ?line {ok,UTF8L5} = asn1rt:utf8_list_to_binary(ValLbR3),
- ?line {ok,Bytes5} = asn1_wrapper:encode('PrimStrings','UTF',UTF8L5),
- ?line {ok,Bin5} = asn1_wrapper:decode('PrimStrings','UTF',Bytes5),
- ?line {ok,ValLbR3} = wrapper_utf8_binary_to_list(Bin5),
-
- ?line {ok,UTF8L6} = asn1rt:utf8_list_to_binary(ValUbR3),
- ?line {ok,Bytes6} = asn1_wrapper:encode('PrimStrings','UTF',UTF8L6),
- ?line {ok,Bin6} = asn1_wrapper:decode('PrimStrings','UTF',Bytes6),
- ?line {ok,ValUbR3} = wrapper_utf8_binary_to_list(Bin6),
-
- ?line {ok,UTF8L7} = asn1rt:utf8_list_to_binary(ValLbR4),
- ?line {ok,Bytes7} = asn1_wrapper:encode('PrimStrings','UTF',UTF8L7),
- ?line {ok,Bin7} = asn1_wrapper:decode('PrimStrings','UTF',Bytes7),
- ?line {ok,ValLbR4} = wrapper_utf8_binary_to_list(Bin7),
-
- ?line {ok,UTF8L8} = asn1rt:utf8_list_to_binary(ValUbR4),
- ?line {ok,Bytes8} = asn1_wrapper:encode('PrimStrings','UTF',UTF8L8),
- ?line {ok,Bin8} = asn1_wrapper:decode('PrimStrings','UTF',Bytes8),
- ?line {ok,ValUbR4} = wrapper_utf8_binary_to_list(Bin8),
-
- ?line {ok,UTF8L9} = asn1rt:utf8_list_to_binary(ValLbR5),
- ?line {ok,Bytes9} = asn1_wrapper:encode('PrimStrings','UTF',UTF8L9),
- ?line {ok,Bin9} = asn1_wrapper:decode('PrimStrings','UTF',Bytes9),
- ?line {ok,ValLbR5} = wrapper_utf8_binary_to_list(Bin9),
-
- ?line {ok,UTF8L10} = asn1rt:utf8_list_to_binary(ValUbR5),
- ?line {ok,Bytes10} = asn1_wrapper:encode('PrimStrings','UTF',UTF8L10),
- ?line {ok,Bin10} = asn1_wrapper:decode('PrimStrings','UTF',Bytes10),
- ?line {ok,ValUbR5} = wrapper_utf8_binary_to_list(Bin10),
-
- ?line {ok,UTF8L11} = asn1rt:utf8_list_to_binary(ValLbR6),
- ?line {ok,Bytes11} = asn1_wrapper:encode('PrimStrings','UTF',UTF8L11),
- ?line {ok,Bin11} = asn1_wrapper:decode('PrimStrings','UTF',Bytes11),
- ?line {ok,ValLbR6} = wrapper_utf8_binary_to_list(Bin11),
-
- ?line {ok,UTF8L12} = asn1rt:utf8_list_to_binary(ValUbR6),
- ?line {ok,Bytes12} = asn1_wrapper:encode('PrimStrings','UTF',UTF8L12),
- ?line {ok,Bin12} = asn1_wrapper:decode('PrimStrings','UTF',Bytes12),
- ?line {ok,ValUbR6} = wrapper_utf8_binary_to_list(Bin12),
-
- LVal = ValLbR1++ValUbR1++ValLbR2++ValUbR2++ValLbR3++ValUbR3++
- ValLbR4++ValUbR4++ValLbR5++ValUbR5++ValLbR6++ValUbR6,
- LongVal = LVal++LVal++LVal++LVal++LVal++LVal++LVal++"hello",
-
- ?line {ok,UTF8L13} = asn1rt:utf8_list_to_binary(LongVal),
- ?line {ok,Bytes13} = asn1_wrapper:encode('PrimStrings','UTF',UTF8L13),
- ?line {ok,Bin13} = asn1_wrapper:decode('PrimStrings','UTF',Bytes13),
- ?line {ok,LongVal} = wrapper_utf8_binary_to_list(Bin13).
+ AllRanges = [16#00,
+ 16#7f,
+ 16#80,
+ 16#7ff,
+ 16#800,
+ 16#ffff,
+ 16#10000,
+ 16#1fffff,
+ 16#200000,
+ 16#3ffffff,
+ 16#4000000,
+ 16#7fffffff],
+ [begin
+ {ok,UTF8} = asn1rt:utf8_list_to_binary([Char]),
+ {ok,[Char]} = asn1rt:utf8_binary_to_list(UTF8),
+ roundtrip('UTF', UTF8)
+ end || Char <- AllRanges],
+
+ {ok,UTF8} = asn1rt:utf8_list_to_binary(AllRanges),
+ {ok,AllRanges} = asn1rt:utf8_binary_to_list(UTF8),
+ roundtrip('UTF', UTF8),
+ ok.
+
+
+shorten_by_two(Tuple) ->
+ L = [case E of
+ [_,_|T] -> T;
+ _ -> E
+ end || E <- tuple_to_list(Tuple)],
+ list_to_tuple(L).
-wrapper_utf8_binary_to_list(L) when is_list(L) ->
- asn1rt:utf8_binary_to_list(list_to_binary(L));
-wrapper_utf8_binary_to_list(B) ->
- asn1rt:utf8_binary_to_list(B).
+p_roundtrip(Type, Value0) ->
+ Value = setelement(1, Value0, Type),
+ roundtrip(Type, Value).
roundtrip(Type, Value) ->
{ok,Encoded} = 'PrimStrings':encode(Type, Value),
{ok,Value} = 'PrimStrings':decode(Type, Encoded),
ok.
+roundtrip(Type, Value, Expected) ->
+ {ok,Encoded} = 'PrimStrings':encode(Type, Value),
+ {ok,Expected} = 'PrimStrings':decode(Type, Encoded),
+ ok.
+
bs_roundtrip(Type, Value) ->
bs_roundtrip(Type, Value, Value).
bs_roundtrip(Type, Value, Expected) ->
M = 'PrimStrings',
{ok,Encoded} = M:encode(Type, Value),
+ {ok,Encoded} = M:encode(Type, Expected),
case M:decode(Type, Encoded) of
{ok,Expected} ->
ok;
diff --git a/lib/asn1/test/testSeqOf.erl b/lib/asn1/test/testSeqOf.erl
index 1aa1eab26d..c1af0d7a32 100644
--- a/lib/asn1/test/testSeqOf.erl
+++ b/lib/asn1/test/testSeqOf.erl
@@ -28,193 +28,110 @@
-record('Seq3',{bool3, seq3 = asn1_DEFAULT, int3}).
-record('Seq4',{seq41 = asn1_DEFAULT, seq42 = asn1_DEFAULT, seq43 = asn1_DEFAULT}).
-record('SeqIn',{boolIn, intIn}).
-%-record('SeqCho',{bool1, int1, seq1 = asn1_DEFAULT}).
-%-record('SeqChoInline',{bool1, int1, seq1 = asn1_DEFAULT}).
-%-record('SeqChoOfInline_SEQOF',{bool1, int1, seq1 = asn1_DEFAULT}).
-record('SeqEmp',{seq1}).
-record('Empty',{}).
-main(Rules) ->
-
- ?line {ok,Bytes11} =
- asn1_wrapper:encode('SeqOf','Seq1',#'Seq1'{bool1 = true,
- int1 = 17}),
- ?line {ok,{'Seq1',true,17,[]}} =
- asn1_wrapper:decode('SeqOf','Seq1',lists:flatten(Bytes11)),
-
-
- ?line {ok,Bytes12} =
- asn1_wrapper:encode('SeqOf','Seq1',#'Seq1'{bool1 = true,
- int1 = 17,
- seq1 = [#'SeqIn'{boolIn = true,
- intIn = 25}]}),
- ?line {ok,{'Seq1',true,17,[{'SeqIn',true,25}]}} =
- asn1_wrapper:decode('SeqOf','Seq1',lists:flatten(Bytes12)),
-
-
-
- ?line {ok,Bytes13} =
- asn1_wrapper:encode('SeqOf','Seq1',#'Seq1'{bool1 = true,
- int1 = 17,
- seq1 = [#'SeqIn'{boolIn = true,
- intIn = 25},
- #'SeqIn'{boolIn = false,
- intIn = 125},
- #'SeqIn'{boolIn = false,
- intIn = 225}]}),
- ?line {ok,{'Seq1',true,17,[{'SeqIn',true,25},{'SeqIn',false,125},{'SeqIn',false,225}]}} =
- asn1_wrapper:decode('SeqOf','Seq1',lists:flatten(Bytes13)),
-
-
-
-
-
-
- ?line {ok,Bytes21} =
- asn1_wrapper:encode('SeqOf','Seq2',#'Seq2'{bool2 = true,
- int2 = 17}),
-
- ?line {ok,{'Seq2',[],true,17}} =
- asn1_wrapper:decode('SeqOf','Seq2',lists:flatten(Bytes21)),
-
-
- ?line {ok,Bytes22} =
- asn1_wrapper:encode('SeqOf','Seq2',#'Seq2'{bool2 = true,
- int2 = 17,
- seq2 = [#'SeqIn'{boolIn = true,
- intIn = 25}]}),
- ?line {ok,{'Seq2',[{'SeqIn',true,25}],true,17}} =
- asn1_wrapper:decode('SeqOf','Seq2',lists:flatten(Bytes22)),
-
-
- ?line {ok,Bytes23} =
- asn1_wrapper:encode('SeqOf','Seq2',#'Seq2'{bool2 = true,
- int2 = 17,
- seq2 = [#'SeqIn'{boolIn = true,
- intIn = 25},
- #'SeqIn'{boolIn = false,
- intIn = 125},
- #'SeqIn'{boolIn = false,
- intIn = 225}]}),
- ?line {ok,{'Seq2',[{'SeqIn',true,25},{'SeqIn',false,125},{'SeqIn',false,225}],true,17}} =
- asn1_wrapper:decode('SeqOf','Seq2',lists:flatten(Bytes23)),
-
-
-
-
-
-
- ?line {ok,Bytes31} =
- asn1_wrapper:encode('SeqOf','Seq3',#'Seq3'{bool3 = true,
- int3 = 17}),
- ?line {ok,{'Seq3',true,[],17}} =
- asn1_wrapper:decode('SeqOf','Seq3',lists:flatten(Bytes31)),
-
-
- ?line {ok,Bytes32} =
- asn1_wrapper:encode('SeqOf','Seq3',#'Seq3'{bool3 = true,
- int3 = 17,
- seq3 = [#'SeqIn'{boolIn = true,
- intIn = 25}]}),
- ?line {ok,{'Seq3',true,[{'SeqIn',true,25}],17}} =
- asn1_wrapper:decode('SeqOf','Seq3',lists:flatten(Bytes32)),
-
-
- ?line {ok,Bytes33} =
- asn1_wrapper:encode('SeqOf','Seq3',#'Seq3'{bool3 = true,
- int3 = 17,
- seq3 = [#'SeqIn'{boolIn = true,
- intIn = 25},
- #'SeqIn'{boolIn = false,
- intIn = 125},
- #'SeqIn'{boolIn = false,
- intIn = 225}]}),
- ?line {ok,{'Seq3',true,[{'SeqIn',true,25},{'SeqIn',false,125},{'SeqIn',false,225}],17}} =
- asn1_wrapper:decode('SeqOf','Seq3',lists:flatten(Bytes33)),
-
-
+main(_Rules) ->
+ SeqIn3 = [#'SeqIn'{boolIn=true,intIn=25},
+ #'SeqIn'{boolIn=false,intIn=125},
+ #'SeqIn'{boolIn=false,intIn=225}],
+
+ roundtrip('Seq1', #'Seq1'{bool1=true,int1=17},
+ #'Seq1'{bool1=true,int1=17,seq1=[]}),
+
+ roundtrip('Seq1', #'Seq1'{bool1=true,int1 = 17,
+ seq1=[#'SeqIn'{boolIn=true,
+ intIn=25}]}),
+ roundtrip('Seq1', #'Seq1'{bool1=true,
+ int1=17,
+ seq1=SeqIn3}),
+
+ roundtrip('Seq2', #'Seq2'{bool2=true,int2=17},
+ #'Seq2'{seq2=[],bool2=true,int2=17}),
+ roundtrip('Seq2',#'Seq2'{bool2=true,int2=17,
+ seq2=[#'SeqIn'{boolIn=true,
+ intIn=25}]}),
+ roundtrip('Seq2', #'Seq2'{bool2=true,
+ int2=17,
+ seq2=SeqIn3}),
+
+ roundtrip('Seq3', #'Seq3'{bool3=true,int3=17},
+ #'Seq3'{bool3=true,seq3=[],int3=17}),
+ roundtrip('Seq3',#'Seq3'{bool3=true,
+ int3=17,
+ seq3=[#'SeqIn'{boolIn=true,
+ intIn=25}]}),
+ roundtrip('Seq3', #'Seq3'{bool3=true,int3=17,seq3=SeqIn3}),
+
+ roundtrip('Seq4', #'Seq4'{}, #'Seq4'{seq41=[],seq42=[],seq43=[]}),
+
+ roundtrip('Seq4', #'Seq4'{seq41=[#'SeqIn'{boolIn=true,intIn=25}]},
+ #'Seq4'{seq41=[#'SeqIn'{boolIn=true,intIn=25}],
+ seq42=[],seq43=[]}),
+
+ roundtrip('Seq4', #'Seq4'{seq41=SeqIn3},
+ #'Seq4'{seq41=SeqIn3,seq42=[],seq43=[]}),
+ roundtrip('Seq4', #'Seq4'{seq42=[#'SeqIn'{boolIn=true,intIn=25}]},
+ #'Seq4'{seq41=[],seq42=[#'SeqIn'{boolIn=true,intIn=25}],
+ seq43=[]}),
+ roundtrip('Seq4', #'Seq4'{seq42=SeqIn3},
+ #'Seq4'{seq41=[],seq42=SeqIn3,seq43=[]}),
+
+ roundtrip('Seq4', #'Seq4'{seq43=[#'SeqIn'{boolIn=true,intIn=25}]},
+ #'Seq4'{seq41=[],seq42=[],
+ seq43=[#'SeqIn'{boolIn=true,intIn=25}]}),
+ roundtrip('Seq4', #'Seq4'{seq43=SeqIn3},
+ #'Seq4'{seq41=[],seq42=[],
+ seq43=SeqIn3}),
+
+ roundtrip('SeqEmp', #'SeqEmp'{seq1=[#'Empty'{}]}),
+
+ %% Test constrained, extensible size.
+
+ SeqIn = #'SeqIn'{boolIn=true,intIn=978654321},
+ roundtrip('SeqExt', {'SeqExt',true,[],true,[],789}),
+ roundtrip('SeqExt', {'SeqExt',true,lists:duplicate(1, SeqIn),
+ true,lists:duplicate(0, SeqIn),777}),
+ roundtrip('SeqExt', {'SeqExt',true,lists:duplicate(1, SeqIn),
+ true,lists:duplicate(1, SeqIn),777}),
+ roundtrip('SeqExt', {'SeqExt',true,lists:duplicate(1, SeqIn),
+ true,lists:duplicate(127, SeqIn),777}),
+ roundtrip('SeqExt', {'SeqExt',true,lists:duplicate(2, SeqIn),
+ true,lists:duplicate(128, SeqIn),1777}),
+ roundtrip('SeqExt', {'SeqExt',true,lists:duplicate(2, SeqIn),
+ true,lists:duplicate(255, SeqIn),7773}),
+ roundtrip('SeqExt', {'SeqExt',true,lists:duplicate(2, SeqIn),
+ true,lists:duplicate(256, SeqIn),77755}),
+ roundtrip('SeqExt', {'SeqExt',true,lists:duplicate(2, SeqIn),
+ true,lists:duplicate(257, SeqIn),8888}),
+ roundtrip('SeqExt', {'SeqExt',true,lists:duplicate(3, SeqIn),
+ true,lists:duplicate(1024, SeqIn),999988888}),
+ roundtrip('SeqExt', {'SeqExt',true,lists:duplicate(15, SeqIn),
+ true,lists:duplicate(2000, SeqIn),555555}),
+
+ %% Test OTP-4590: correct encoding of the length of SEQUENC OF.
+ DayNames = ["Monday","Tuesday","Wednesday",
+ "Thursday","Friday","Saturday","Sunday"],
+ xroundtrip('DayNames1', 'DayNames3', DayNames),
+ xroundtrip('DayNames2', 'DayNames4', DayNames),
+ xroundtrip('DayNames2', 'DayNames4', [hd(DayNames)]),
+ xroundtrip('DayNames2', 'DayNames4', tl(DayNames)),
+ ok.
+roundtrip(T, V) ->
+ roundtrip(T, V, V).
-
-
- ?line {ok,Bytes41} = asn1_wrapper:encode('SeqOf','Seq4',#'Seq4'{}),
- ?line {ok,{'Seq4',[],[],[]}} = asn1_wrapper:decode('SeqOf','Seq4',lists:flatten(Bytes41)),
-
-
- ?line {ok,Bytes42} =
- asn1_wrapper:encode('SeqOf','Seq4',#'Seq4'{seq41 = [#'SeqIn'{boolIn = true,
- intIn = 25}]}),
- ?line {ok,{'Seq4',[{'SeqIn',true,25}],[],[]}} =
- asn1_wrapper:decode('SeqOf','Seq4',lists:flatten(Bytes42)),
-
-
- ?line {ok,Bytes43} =
- asn1_wrapper:encode('SeqOf','Seq4',#'Seq4'{seq41 = [#'SeqIn'{boolIn = true,
- intIn = 25},
- #'SeqIn'{boolIn = false,
- intIn = 125},
- #'SeqIn'{boolIn = false,
- intIn = 225}]}),
- ?line {ok,{'Seq4',[{'SeqIn',true,25},{'SeqIn',false,125},{'SeqIn',false,225}],[],[]}} =
- asn1_wrapper:decode('SeqOf','Seq4',lists:flatten(Bytes43)),
-
-
- ?line {ok,Bytes44} =
- asn1_wrapper:encode('SeqOf','Seq4',#'Seq4'{seq42 = [#'SeqIn'{boolIn = true,
- intIn = 25}]}),
- ?line {ok,{'Seq4',[],[{'SeqIn',true,25}],[]}} =
- asn1_wrapper:decode('SeqOf','Seq4',lists:flatten(Bytes44)),
-
-
- ?line {ok,Bytes45} =
- asn1_wrapper:encode('SeqOf','Seq4',#'Seq4'{seq42 = [#'SeqIn'{boolIn = true,
- intIn = 25},
- #'SeqIn'{boolIn = false,
- intIn = 125},
- #'SeqIn'{boolIn = false,
- intIn = 225}]}),
- ?line {ok,{'Seq4',[],[{'SeqIn',true,25},{'SeqIn',false,125},{'SeqIn',false,225}],[]}} =
- asn1_wrapper:decode('SeqOf','Seq4',lists:flatten(Bytes45)),
-
-
- ?line {ok,Bytes46} =
- asn1_wrapper:encode('SeqOf','Seq4',#'Seq4'{seq43 = [#'SeqIn'{boolIn = true,
- intIn = 25}]}),
- ?line {ok,{'Seq4',[],[],[{'SeqIn',true,25}]}} =
- asn1_wrapper:decode('SeqOf','Seq4',lists:flatten(Bytes46)),
-
-
- ?line {ok,Bytes47} =
- asn1_wrapper:encode('SeqOf','Seq4',#'Seq4'{seq43 = [#'SeqIn'{boolIn = true,
- intIn = 25},
- #'SeqIn'{boolIn = false,
- intIn = 125},
- #'SeqIn'{boolIn = false,
- intIn = 225}]}),
- ?line {ok,{'Seq4',[],[],[{'SeqIn',true,25},{'SeqIn',false,125},{'SeqIn',false,225}]}} =
- asn1_wrapper:decode('SeqOf','Seq4',lists:flatten(Bytes47)),
-
-
- ?line {ok,Bytes51} = asn1_wrapper:encode('SeqOf','SeqEmp',#'SeqEmp'{seq1 = [#'Empty'{}]}),
- ?line {ok,{'SeqEmp',[{'Empty'}]}} = asn1_wrapper:decode('SeqOf','SeqEmp',lists:flatten(Bytes51)),
-
- %% tests of OTP-4590
- case Rules of
- per ->
- DayNames = ["Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"],
- ?line {ok,Bytes60} = asn1_wrapper:encode('XSeqOf','DayNames2',DayNames),
- ?line {ok,Bytes60} = asn1_wrapper:encode('XSeqOf','DayNames4',DayNames),
- ?line {ok,DayNames} = asn1_wrapper:decode('XSeqOf','DayNames2',Bytes60),
- ?line {ok,DayNames} = asn1_wrapper:decode('XSeqOf','DayNames4',Bytes60),
- ?line {ok,Bytes61} = asn1_wrapper:encode('XSeqOf','DayNames1',DayNames),
- ?line {ok,Bytes61} = asn1_wrapper:encode('XSeqOf','DayNames3',DayNames),
- ?line {ok,DayNames} = asn1_wrapper:decode('XSeqOf','DayNames1',Bytes61),
- ?line {ok,DayNames} = asn1_wrapper:decode('XSeqOf','DayNames3',Bytes61);
- _ ->
- ok
- end,
-
+roundtrip(Type, Val, Expected) ->
+ M = 'SeqOf',
+ {ok,Enc} = M:encode(Type, Val),
+ {ok,Expected} = M:decode(Type, Enc),
ok.
-
+xroundtrip(T1, T2, Val) ->
+ M = 'XSeqOf',
+ {ok,Enc} = M:encode(T1, Val),
+ {ok,Enc} = M:encode(T2, Val),
+ {ok,Val} = M:decode(T1, Enc),
+ {ok,Val} = M:decode(T2, Enc),
+ ok.
diff --git a/lib/common_test/src/ct_config.erl b/lib/common_test/src/ct_config.erl
index 9bb9817001..5c80a299f8 100644
--- a/lib/common_test/src/ct_config.erl
+++ b/lib/common_test/src/ct_config.erl
@@ -46,7 +46,7 @@
decrypt_config_file/2, decrypt_config_file/3,
get_crypt_key_from_file/0, get_crypt_key_from_file/1]).
--export([get_ref_from_name/1, get_name_from_ref/1, get_key_from_name/1]).
+-export([get_key_from_name/1]).
-export([check_config_files/1, add_default_callback/1, prepare_config_list/1]).
@@ -56,7 +56,7 @@
-define(cryptfile, ".ct_config.crypt").
--record(ct_conf,{key,value,handler,config,ref,name='_UNDEF',default=false}).
+-record(ct_conf,{key,value,handler,config,name='_UNDEF',default=false}).
start(Mode) ->
case whereis(ct_config_server) of
@@ -275,7 +275,6 @@ store_config(Config, Callback, File) when is_list(Config) ->
value=Val,
handler=Callback,
config=File,
- ref=ct_util:ct_make_ref(),
default=false}) ||
{Key,Val} <- Config].
@@ -296,13 +295,11 @@ rewrite_config(Config, Callback, File) ->
#ct_conf{key=Key,
value=Value,
handler=Callback,
- config=File,
- ref=ct_util:ct_make_ref()});
+ config=File});
RowsToUpdate ->
Inserter = fun(Row) ->
ets:insert(?attr_table,
- Row#ct_conf{value=Value,
- ref=ct_util:ct_make_ref()})
+ Row#ct_conf{value=Value})
end,
lists:foreach(Inserter, RowsToUpdate)
end
@@ -314,7 +311,7 @@ set_config(Config,Default) ->
set_config(Name,Config,Default) ->
[ets:insert(?attr_table,
- #ct_conf{key=Key,value=Val,ref=ct_util:ct_make_ref(),
+ #ct_conf{key=Key,value=Val,
name=Name,default=Default}) ||
{Key,Val} <- Config].
@@ -559,26 +556,6 @@ encrypt_config_file(SrcFileName, EncryptFileName) ->
encrypt_config_file(SrcFileName, EncryptFileName, {key,Key})
end.
-get_ref_from_name(Name) ->
- case ets:select(?attr_table,[{#ct_conf{name=Name,ref='$1',_='_'},
- [],
- ['$1']}]) of
- [Ref] ->
- {ok,Ref};
- _ ->
- {error,{no_such_name,Name}}
- end.
-
-get_name_from_ref(Ref) ->
- case ets:select(?attr_table,[{#ct_conf{name='$1',ref=Ref,_='_'},
- [],
- ['$1']}]) of
- [Name] ->
- {ok,Name};
- _ ->
- {error,{no_such_ref,Ref}}
- end.
-
get_key_from_name(Name) ->
case ets:select(?attr_table,[{#ct_conf{name=Name,key='$1',_='_'},
[],
diff --git a/lib/common_test/src/ct_ftp.erl b/lib/common_test/src/ct_ftp.erl
index 8790393b36..b91a521bd4 100644
--- a/lib/common_test/src/ct_ftp.erl
+++ b/lib/common_test/src/ct_ftp.erl
@@ -348,10 +348,10 @@ terminate(FtpPid,State) ->
get_handle(Pid) when is_pid(Pid) ->
{ok,Pid};
get_handle(Name) ->
- case ct_util:get_connections(Name,?MODULE) of
- {ok,[{Pid,_}|_]} ->
+ case ct_util:get_connection(Name,?MODULE) of
+ {ok,{Pid,_}} ->
{ok,Pid};
- {ok,[]} ->
+ {error,no_registered_connection} ->
open(Name);
Error ->
Error
diff --git a/lib/common_test/src/ct_gen_conn.erl b/lib/common_test/src/ct_gen_conn.erl
index 2d4b1d1f52..a5b736136f 100644
--- a/lib/common_test/src/ct_gen_conn.erl
+++ b/lib/common_test/src/ct_gen_conn.erl
@@ -26,7 +26,7 @@
-compile(export_all).
--export([start/4, stop/1]).
+-export([start/4, stop/1, get_conn_pid/1]).
-export([call/2, call/3, return/2, do_within_time/2]).
-ifdef(debug).
@@ -120,8 +120,16 @@ start(Name,Address,InitData,CallbackMod) ->
%%% Handle = handle()
%%%
%%% @doc Close the connection and stop the process managing it.
-stop(Pid) ->
- call(Pid,stop,5000).
+stop(Handle) ->
+ call(Handle,stop,5000).
+
+%%%-----------------------------------------------------------------
+%%% @spec get_conn_pid(Handle) -> ok
+%%% Handle = handle()
+%%%
+%%% @doc Return the connection pid associated with Handle
+get_conn_pid(Handle) ->
+ call(Handle,get_conn_pid).
%%%-----------------------------------------------------------------
%%% @spec log(Heading,Format,Args) -> ok
@@ -222,7 +230,8 @@ do_start(Opts) ->
receive
{connected,Pid} ->
erlang:demonitor(MRef, [flush]),
- ct_util:register_connection(Opts#gen_opts.name, Opts#gen_opts.address,
+ ct_util:register_connection(Opts#gen_opts.name,
+ Opts#gen_opts.address,
Opts#gen_opts.callback, Pid),
{ok,Pid};
{Error,Pid} ->
@@ -315,10 +324,12 @@ loop(Opts) ->
{ok, NewPid, NewState} ->
link(NewPid),
put(conn_pid,NewPid),
- loop(Opts#gen_opts{conn_pid=NewPid,cb_state=NewState});
+ loop(Opts#gen_opts{conn_pid=NewPid,
+ cb_state=NewState});
Error ->
ct_util:unregister_connection(self()),
- log("Reconnect failed. Giving up!","Reason: ~p\n",
+ log("Reconnect failed. Giving up!",
+ "Reason: ~p\n",
[Error])
end;
false ->
@@ -338,7 +349,8 @@ loop(Opts) ->
Opts#gen_opts.cb_state),
return(From,ok),
ok;
- {{retry,{Error,_Name,CPid,_Msg}}, From} when CPid == Opts#gen_opts.conn_pid ->
+ {{retry,{Error,_Name,CPid,_Msg}}, From} when
+ CPid == Opts#gen_opts.conn_pid ->
%% only retry if failure is because of a reconnection
Return = case Error of
{error,_} -> Error;
@@ -347,12 +359,16 @@ loop(Opts) ->
return(From, Return),
loop(Opts);
{{retry,{_Error,_Name,_CPid,Msg}}, From} ->
- log("Rerunning command","Connection reestablished. Rerunning command...",[]),
+ log("Rerunning command","Connection reestablished. "
+ "Rerunning command...",[]),
{Return,NewState} =
(Opts#gen_opts.callback):handle_msg(Msg,Opts#gen_opts.cb_state),
return(From, Return),
loop(Opts#gen_opts{cb_state=NewState});
- {Msg,From={Pid,_Ref}} when is_pid(Pid), Opts#gen_opts.old==true ->
+ {get_conn_pid, From} ->
+ return(From, Opts#gen_opts.conn_pid),
+ loop(Opts);
+ {Msg, From={Pid,_Ref}} when is_pid(Pid), Opts#gen_opts.old==true ->
{Return,NewState} =
(Opts#gen_opts.callback):handle_msg(Msg,Opts#gen_opts.cb_state),
return(From, Return),
@@ -372,7 +388,8 @@ loop(Opts) ->
return(From,Reply)
end;
Msg when Opts#gen_opts.forward==true ->
- case (Opts#gen_opts.callback):handle_msg(Msg,Opts#gen_opts.cb_state) of
+ case (Opts#gen_opts.callback):handle_msg(Msg,
+ Opts#gen_opts.cb_state) of
{noreply,NewState} ->
loop(Opts#gen_opts{cb_state=NewState});
{stop,NewState} ->
diff --git a/lib/common_test/src/ct_netconfc.erl b/lib/common_test/src/ct_netconfc.erl
index 1339e53780..e094ee877a 100644
--- a/lib/common_test/src/ct_netconfc.erl
+++ b/lib/common_test/src/ct_netconfc.erl
@@ -1164,13 +1164,11 @@ call(Client, Msg, Timeout, WaitStop) ->
get_handle(Client) when is_pid(Client) ->
{ok,Client};
get_handle(Client) ->
- case ct_util:get_connections(Client, ?MODULE) of
- {ok,[{Pid,_}]} ->
+ case ct_util:get_connection(Client, ?MODULE) of
+ {ok,{Pid,_}} ->
{ok,Pid};
- {ok,[]} ->
+ {error,no_registered_connection} ->
{error,{no_connection_found,Client}};
- {ok,Conns} ->
- {error,{multiple_connections_found,Client,Conns}};
Error ->
Error
end.
@@ -1302,7 +1300,8 @@ handle_data(NewData,#state{connection=Connection,buff=Buff} = State) ->
decode(Simple,State#state{buff=Rest});
{fatal_error,_Loc,Reason,_EndTags,_EventState} ->
?error(Connection#connection.name,[{parse_error,Reason},
- {data,Data}]),
+ {buffer,Buff},
+ {new_data,NewData}]),
case Reason of
{could_not_fetch_data,Msg} ->
handle_msg(Msg,State#state{buff = <<>>});
diff --git a/lib/common_test/src/ct_ssh.erl b/lib/common_test/src/ct_ssh.erl
index c6ea27b10e..1adc79d358 100644
--- a/lib/common_test/src/ct_ssh.erl
+++ b/lib/common_test/src/ct_ssh.erl
@@ -1328,10 +1328,10 @@ do_recv_response(SSH, Chn, Data, End, Timeout) ->
get_handle(SSH) when is_pid(SSH) ->
{ok,SSH};
get_handle(SSH) ->
- case ct_util:get_connections(SSH, ?MODULE) of
- {ok,[{Pid,_}]} ->
+ case ct_util:get_connection(SSH, ?MODULE) of
+ {ok,{Pid,_}} ->
{ok,Pid};
- {ok,[]} ->
+ {error,no_registered_connection} ->
connect(SSH);
Error ->
Error
diff --git a/lib/common_test/src/ct_telnet.erl b/lib/common_test/src/ct_telnet.erl
index 4755d939e0..4092d33bc0 100644
--- a/lib/common_test/src/ct_telnet.erl
+++ b/lib/common_test/src/ct_telnet.erl
@@ -183,7 +183,8 @@ open(KeyOrName,ConnType,TargetMod,Extra) ->
end;
Bool -> Bool
end,
- log(heading(open,{KeyOrName,ConnType}),"Opening connection to: ~p",[Addr1]),
+ log(heading(open,{KeyOrName,ConnType}),
+ "Opening connection to: ~p",[Addr1]),
ct_gen_conn:start(KeyOrName,full_addr(Addr1,ConnType),
{TargetMod,KeepAlive,Extra},?MODULE)
end.
@@ -591,9 +592,9 @@ terminate(TelnPid,State) ->
get_handle(Pid) when is_pid(Pid) ->
{ok,Pid};
get_handle({Name,Type}) when Type==telnet;Type==ts1;Type==ts2 ->
- case ct_util:get_connections(Name,?MODULE) of
- {ok,Conns} when Conns /= [] ->
- case get_handle(Type,Conns) of
+ case ct_util:get_connection(Name,?MODULE) of
+ {ok,Conn} ->
+ case get_handle(Type,Conn) of
{ok,Pid} ->
{ok,Pid};
_Error ->
@@ -608,19 +609,15 @@ get_handle({Name,Type}) when Type==telnet;Type==ts1;Type==ts2 ->
Error
end
end;
- {ok,[]} ->
- {error,already_closed};
Error ->
Error
end;
get_handle(Name) ->
get_handle({Name,telnet}).
-get_handle(Type,[{Pid,{_,_,Type}}|_]) ->
+get_handle(Type,{Pid,{_,_,Type}}) ->
{ok,Pid};
-get_handle(Type,[_H|T]) ->
- get_handle(Type,T);
-get_handle(Type,[]) ->
+get_handle(Type,_) ->
{error,{no_such_connection,Type}}.
full_addr({Ip,Port},Type) ->
diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl
index b77845eb5b..68e76c2396 100644
--- a/lib/common_test/src/ct_util.erl
+++ b/lib/common_test/src/ct_util.erl
@@ -25,13 +25,13 @@
%%%
-module(ct_util).
--export([start/0,start/1,start/2,start/3,
- stop/1,update_last_run_index/0]).
+-export([start/0, start/1, start/2, start/3,
+ stop/1, update_last_run_index/0]).
--export([register_connection/4,unregister_connection/1,
- does_connection_exist/3,get_key_from_name/1]).
+-export([register_connection/4, unregister_connection/1,
+ does_connection_exist/3, get_key_from_name/1]).
--export([close_connections/0]).
+-export([get_connections/1, close_connections/0]).
-export([save_suite_data/3, save_suite_data/2,
save_suite_data_async/3, save_suite_data_async/2,
@@ -56,11 +56,11 @@
-export([listenv/1]).
--export([get_target_name/1, get_connections/2]).
+-export([get_target_name/1, get_connection/2]).
-export([is_test_dir/1, get_testdir/2]).
--export([kill_attached/2, get_attached/1, ct_make_ref/0]).
+-export([kill_attached/2, get_attached/1]).
-export([warn_duplicates/1]).
@@ -417,7 +417,8 @@ loop(Mode,TestData,StartDir) ->
?MAX_IMPORTANCE,
"CT Error Notification",
"Connection process died: "
- "Pid: ~w, Address: ~p, Callback: ~w\n"
+ "Pid: ~w, Address: ~p, "
+ "Callback: ~w\n"
"Reason: ~p\n\n",
[Pid,A,CB,Reason]),
catch CB:close(Pid),
@@ -426,8 +427,8 @@ loop(Mode,TestData,StartDir) ->
loop(Mode,TestData,StartDir);
_ ->
%% Let process crash in case of error, this shouldn't happen!
- io:format("\n\nct_util_server got EXIT from ~w: ~p\n\n",
- [Pid,Reason]),
+ io:format("\n\nct_util_server got EXIT "
+ "from ~w: ~p\n\n", [Pid,Reason]),
file:set_cwd(StartDir),
exit(Reason)
end
@@ -457,10 +458,13 @@ get_key_from_name(Name)->
%%% table, and ct_util will close all registered connections when the
%%% test is finished by calling <code>Callback:close/1</code>.</p>
register_connection(TargetName,Address,Callback,Handle) ->
+ %% If TargetName is a registered alias for a config
+ %% variable, use it as reference for the connection,
+ %% otherwise use the Handle value.
TargetRef =
- case ct_config:get_ref_from_name(TargetName) of
- {ok,Ref} ->
- Ref;
+ case ct_config:get_key_from_name(TargetName) of
+ {ok,_Key} ->
+ TargetName;
_ ->
%% no config name associated with connection,
%% use handle for identification instead
@@ -496,10 +500,10 @@ unregister_connection(Handle) ->
%%%
%%% @doc Check if a connection already exists.
does_connection_exist(TargetName,Address,Callback) ->
- case ct_config:get_ref_from_name(TargetName) of
- {ok,TargetRef} ->
+ case ct_config:get_key_from_name(TargetName) of
+ {ok,_Key} ->
case ets:select(?conn_table,[{#conn{handle='$1',
- targetref=TargetRef,
+ targetref=TargetName,
address=Address,
callback=Callback},
[],
@@ -514,41 +518,76 @@ does_connection_exist(TargetName,Address,Callback) ->
end.
%%%-----------------------------------------------------------------
-%%% @spec get_connections(TargetName,Callback) ->
-%%% {ok,Connections} | {error,Reason}
+%%% @spec get_connection(TargetName,Callback) ->
+%%% {ok,Connection} | {error,Reason}
%%% TargetName = ct:target_name()
%%% Callback = atom()
-%%% Connections = [Connection]
%%% Connection = {Handle,Address}
%%% Handle = term()
%%% Address = term()
%%%
-%%% @doc Return all connections for the <code>Callback</code> on the
+%%% @doc Return the connection for <code>Callback</code> on the
%%% given target (<code>TargetName</code>).
-get_connections(TargetName,Callback) ->
- case ct_config:get_ref_from_name(TargetName) of
- {ok,Ref} ->
- {ok,ets:select(?conn_table,[{#conn{handle='$1',
- address='$2',
- targetref=Ref,
- callback=Callback},
- [],
- [{{'$1','$2'}}]}])};
+get_connection(TargetName,Callback) ->
+ %% check that TargetName is a registered alias
+ case ct_config:get_key_from_name(TargetName) of
+ {ok,_Key} ->
+ case ets:select(?conn_table,[{#conn{handle='$1',
+ address='$2',
+ targetref=TargetName,
+ callback=Callback},
+ [],
+ [{{'$1','$2'}}]}]) of
+ [Result] ->
+ {ok,Result};
+ [] ->
+ {error,no_registered_connection}
+ end;
Error ->
Error
end.
%%%-----------------------------------------------------------------
+%%% @spec get_connections(ConnPid) ->
+%%% {ok,Connections} | {error,Reason}
+%%% Connections = [Connection]
+%%% Connection = {TargetName,Handle,Callback,Address}
+%%% TargetName = ct:target_name() | undefined
+%%% Handle = term()
+%%% Callback = atom()
+%%% Address = term()
+%%%
+%%% @doc Get data for all connections associated with a particular
+%%% connection pid (see Callback:init/3).
+get_connections(ConnPid) ->
+ Conns = ets:tab2list(?conn_table),
+ lists:flatmap(fun(#conn{targetref=TargetName,
+ handle=Handle,
+ callback=Callback,
+ address=Address}) ->
+ case ct_gen_conn:get_conn_pid(Handle) of
+ ConnPid when is_atom(TargetName) ->
+ [{TargetName,Handle,
+ Callback,Address}];
+ ConnPid ->
+ [{undefined,Handle,
+ Callback,Address}];
+ _ ->
+ []
+ end
+ end, Conns).
+
+%%%-----------------------------------------------------------------
%%% @hidden
%%% @equiv ct:get_target_name/1
-get_target_name(ConnPid) ->
- case ets:select(?conn_table,[{#conn{handle=ConnPid,targetref='$1',_='_'},
+get_target_name(Handle) ->
+ case ets:select(?conn_table,[{#conn{handle=Handle,targetref='$1',_='_'},
[],
['$1']}]) of
- [TargetRef] ->
- ct_config:get_name_from_ref(TargetRef);
- [] ->
- {error,{unknown_connection,ConnPid}}
+ [TargetName] when is_atom(TargetName) ->
+ {ok,TargetName};
+ _ ->
+ {error,{unknown_connection,Handle}}
end.
%%%-----------------------------------------------------------------
@@ -922,29 +961,6 @@ cast(Msg) ->
seconds(T) ->
test_server:seconds(T).
-ct_make_ref() ->
- Pid = case whereis(ct_make_ref) of
- undefined ->
- spawn_link(fun() -> ct_make_ref_init() end);
- P ->
- P
- end,
- Pid ! {self(),ref_req},
- receive
- {Pid,Ref} -> Ref
- end.
-
-ct_make_ref_init() ->
- register(ct_make_ref,self()),
- ct_make_ref_loop(0).
-
-ct_make_ref_loop(N) ->
- receive
- {From,ref_req} ->
- From ! {self(),N},
- ct_make_ref_loop(N+1)
- end.
-
abs_name("/") ->
"/";
abs_name(Dir0) ->
diff --git a/lib/common_test/test/Makefile b/lib/common_test/test/Makefile
index 31ab28c41d..9d2edcd653 100644
--- a/lib/common_test/test/Makefile
+++ b/lib/common_test/test/Makefile
@@ -30,6 +30,7 @@ MODULES= \
ct_userconfig_callback \
telnet_server \
ct_smoke_test_SUITE \
+ ct_gen_conn_SUITE \
ct_priv_dir_SUITE \
ct_event_handler_SUITE \
ct_config_info_SUITE \
diff --git a/lib/common_test/test/ct_gen_conn_SUITE.erl b/lib/common_test/test/ct_gen_conn_SUITE.erl
new file mode 100644
index 0000000000..2a2183854e
--- /dev/null
+++ b/lib/common_test/test/ct_gen_conn_SUITE.erl
@@ -0,0 +1,135 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-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%
+%%
+
+%%%-------------------------------------------------------------------
+%%% File: ct_gen_conn_SUITE
+%%%
+%%% Description:
+%%% Test that the generic connection handling in CT works as expected.
+%%%
+%%% The suite used for the test is located in the data directory.
+%%%-------------------------------------------------------------------
+-module(ct_gen_conn_SUITE).
+
+-compile(export_all).
+
+-include_lib("common_test/include/ct.hrl").
+-include_lib("common_test/include/ct_event.hrl").
+
+-define(eh, ct_test_support_eh).
+
+%%--------------------------------------------------------------------
+%% TEST SERVER CALLBACK FUNCTIONS
+%%--------------------------------------------------------------------
+
+%%--------------------------------------------------------------------
+%% Description: Since Common Test starts another Test Server
+%% instance, the tests need to be performed on a separate node (or
+%% there will be clashes with logging processes etc).
+%%--------------------------------------------------------------------
+init_per_suite(Config) ->
+ ct_test_support:init_per_suite(Config).
+
+end_per_suite(Config) ->
+ ct_test_support:end_per_suite(Config).
+
+init_per_testcase(TestCase, Config) ->
+ ct_test_support:init_per_testcase(TestCase, Config).
+
+end_per_testcase(TestCase, Config) ->
+ ct_test_support:end_per_testcase(TestCase, Config).
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [handles_to_multi_conn_pids, handles_to_single_conn_pids,
+ names_to_multi_conn_pids, names_to_single_conn_pids].
+
+%%--------------------------------------------------------------------
+%% TEST CASES
+%%--------------------------------------------------------------------
+handles_to_multi_conn_pids(Config) ->
+ run_test(handles_to_multi_conn_pids, Config).
+
+handles_to_single_conn_pids(Config) ->
+ run_test(handles_to_single_conn_pids, Config).
+
+names_to_multi_conn_pids(Config) ->
+ run_test(names_to_multi_conn_pids, Config).
+
+names_to_single_conn_pids(Config) ->
+ run_test(names_to_single_conn_pids, Config).
+
+%%%-----------------------------------------------------------------
+%%% HELP FUNCTIONS
+%%%-----------------------------------------------------------------
+run_test(TestCase, Config) ->
+ DataDir = ?config(data_dir, Config),
+ {Opts,ERPid} = setup_env([{dir,DataDir},
+ {suite,conn_SUITE},
+ {testcase,TestCase},
+ {config,filename:join(DataDir,"conn.conf")}],
+ Config),
+ ok = ct_test_support:run(Opts, Config),
+ TestEvents = ct_test_support:get_events(ERPid, Config),
+ ct_test_support:log_events(TestCase,
+ reformat_events(TestEvents, ?eh),
+ ?config(priv_dir, Config),
+ Opts),
+ ExpEvents = events_to_check(TestCase),
+ ok = ct_test_support:verify_events(ExpEvents, TestEvents, Config).
+
+setup_env(Test, Config) ->
+ Opts0 = ct_test_support:get_opts(Config),
+ Level = ?config(trace_level, Config),
+ EvHArgs = [{cbm,ct_test_support},{trace_level,Level}],
+ Opts = Opts0 ++ [{event_handler,{?eh,EvHArgs}} | Test],
+ ERPid = ct_test_support:start_event_receiver(Config),
+ {Opts,ERPid}.
+
+reformat_events(Events, EH) ->
+ ct_test_support:reformat(Events, EH).
+
+%%%-----------------------------------------------------------------
+%%% TEST EVENTS
+%%%-----------------------------------------------------------------
+events_to_check(Test) ->
+ %% 2 tests (ct:run_test + script_start) is default
+ events_to_check(Test, 2).
+
+events_to_check(_, 0) ->
+ [];
+events_to_check(Test, N) ->
+ test_events(Test) ++ events_to_check(Test, N-1).
+
+test_events(Name) ->
+ [
+ {?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,start_info,{1,1,1}},
+ {?eh,tc_start,{conn_SUITE,init_per_suite}},
+ {?eh,tc_done,{conn_SUITE,init_per_suite,ok}},
+ {?eh,tc_start,{conn_SUITE,Name}},
+ {?eh,tc_done,{conn_SUITE,Name,ok}},
+ {?eh,test_stats,{1,0,{0,0}}},
+ {?eh,tc_start,{conn_SUITE,end_per_suite}},
+ {?eh,tc_done,{conn_SUITE,end_per_suite,ok}},
+ {?eh,test_done,{'DEF','STOP_TIME'}},
+ {?eh,stop_logging,[]}
+ ].
diff --git a/lib/common_test/test/ct_gen_conn_SUITE_data/conn.conf b/lib/common_test/test/ct_gen_conn_SUITE_data/conn.conf
new file mode 100644
index 0000000000..09f3c11e10
--- /dev/null
+++ b/lib/common_test/test/ct_gen_conn_SUITE_data/conn.conf
@@ -0,0 +1,8 @@
+{multi_conn_pid, [{addr,"localhost"},
+ {port,8383},
+ {multiple_conn_pids,true}]}.
+
+{single_conn_pid, [{addr,"localhost"},
+ {port,8383},
+ {multiple_conn_pids,false},
+ {conn_mgr_name,conn_mgr}]}.
diff --git a/lib/common_test/test/ct_gen_conn_SUITE_data/conn_SUITE.erl b/lib/common_test/test/ct_gen_conn_SUITE_data/conn_SUITE.erl
new file mode 100644
index 0000000000..6877e0c2d2
--- /dev/null
+++ b/lib/common_test/test/ct_gen_conn_SUITE_data/conn_SUITE.erl
@@ -0,0 +1,240 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2010. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%%-------------------------------------------------------------------
+%%% File : conn_SUITE
+%%% Description : Check that the generic connection handling in CT
+%%% works as expected.
+%%%-------------------------------------------------------------------
+-module(conn_SUITE).
+
+%% Note: This directive should only be used in test suites.
+-compile(export_all).
+
+-include_lib("common_test/include/ct.hrl").
+
+%%--------------------------------------------------------------------
+%% COMMON TEST CALLBACK FUNCTIONS
+%%--------------------------------------------------------------------
+
+suite() ->
+ [{timetrap,{seconds,5}}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_testcase(_TestCase, Config) ->
+ Config.
+
+end_per_testcase(_TestCase, _Config) ->
+ ok.
+
+all() ->
+ [handles_to_multi_conn_pids, handles_to_single_conn_pids,
+ names_to_multi_conn_pids, names_to_single_conn_pids].
+
+%%--------------------------------------------------------------------
+%% TEST CASES
+%%--------------------------------------------------------------------
+
+handles_to_multi_conn_pids() ->
+ [{require,multi_conn_pid}].
+
+handles_to_multi_conn_pids(_Config) ->
+ application:set_env(ct_test, reconnect, true),
+
+ Handle1 = proto:open(multi_conn_pid),
+ ConnPid1 = ct_gen_conn:get_conn_pid(Handle1),
+ {true,true} = {is_process_alive(Handle1),is_process_alive(ConnPid1)},
+ Handle2 = proto:open(multi_conn_pid),
+ ConnPid2 = ct_gen_conn:get_conn_pid(Handle2),
+ {true,true} = {is_process_alive(Handle2),is_process_alive(ConnPid2)},
+ Handle3 = proto:open(multi_conn_pid),
+ ConnPid3 = ct_gen_conn:get_conn_pid(Handle3),
+ {true,true} = {is_process_alive(Handle3),is_process_alive(ConnPid3)},
+
+ ok = proto:close(Handle1),
+ timer:sleep(100),
+ {false,false} = {is_process_alive(Handle1),is_process_alive(ConnPid1)},
+ {true,true} = {is_process_alive(Handle2),is_process_alive(ConnPid2)},
+
+ ok = proto:kill_conn_proc(Handle2),
+ timer:sleep(100),
+ {true,false} = {is_process_alive(Handle2),is_process_alive(ConnPid2)},
+ ConnPid2x = ct_gen_conn:get_conn_pid(Handle2),
+ true = is_process_alive(ConnPid2x),
+
+ ok = proto:close(Handle2),
+ timer:sleep(100),
+ {false,false} = {is_process_alive(Handle2),is_process_alive(ConnPid2x)},
+
+ application:set_env(ct_test, reconnect, false),
+ ok = proto:kill_conn_proc(Handle3),
+ timer:sleep(100),
+ {false,false} = {is_process_alive(Handle3),is_process_alive(ConnPid3)},
+
+ ok.
+
+handles_to_single_conn_pids() ->
+ [{require,single_conn_pid}].
+
+handles_to_single_conn_pids(_Config) ->
+ application:set_env(ct_test, reconnect, true),
+
+ Handle1 = proto:open(single_conn_pid),
+ ConnPid = ct_gen_conn:get_conn_pid(Handle1),
+ {true,true} = {is_process_alive(Handle1),is_process_alive(ConnPid)},
+ Handle2 = proto:open(single_conn_pid),
+ ConnPid = ct_gen_conn:get_conn_pid(Handle2),
+ {true,true} = {is_process_alive(Handle2),is_process_alive(ConnPid)},
+ Handle3 = proto:open(single_conn_pid),
+ ConnPid = ct_gen_conn:get_conn_pid(Handle3),
+ {true,true} = {is_process_alive(Handle3),is_process_alive(ConnPid)},
+
+ Conns = [{undefined,Handle1,_,_},
+ {undefined,Handle2,_,_},
+ {undefined,Handle3,_,_}] = lists:sort(ct_util:get_connections(ConnPid)),
+ ct:pal("CONNS = ~n~p", [Conns]),
+
+ ok = proto:close(Handle1),
+ timer:sleep(100),
+ {false,true} = {is_process_alive(Handle1),is_process_alive(ConnPid)},
+
+ ok = proto:kill_conn_proc(Handle2),
+ timer:sleep(100),
+ NewConnPid = ct_gen_conn:get_conn_pid(Handle2),
+ NewConnPid = ct_gen_conn:get_conn_pid(Handle3),
+ true = is_process_alive(Handle2),
+ true = is_process_alive(Handle3),
+
+ ok = proto:close(Handle2),
+ timer:sleep(100),
+ {false,true} = {is_process_alive(Handle2),is_process_alive(NewConnPid)},
+
+ application:set_env(ct_test, reconnect, false),
+ ok = proto:kill_conn_proc(Handle3),
+ timer:sleep(100),
+ {false,false} = {is_process_alive(Handle3),is_process_alive(NewConnPid)},
+
+ ok.
+
+names_to_multi_conn_pids() ->
+ [{require,mconn1,multi_conn_pid},
+ {require,mconn2,multi_conn_pid},
+ {require,mconn3,multi_conn_pid}].
+
+names_to_multi_conn_pids(_Config) ->
+ application:set_env(ct_test, reconnect, true),
+
+ Handle1 = proto:open(mconn1),
+ ConnPid1 = ct_gen_conn:get_conn_pid(Handle1),
+ {true,true} = {is_process_alive(Handle1),is_process_alive(ConnPid1)},
+ Handle2 = proto:open(mconn2),
+ ConnPid2 = ct_gen_conn:get_conn_pid(Handle2),
+ {true,true} = {is_process_alive(Handle2),is_process_alive(ConnPid2)},
+ Handle3 = proto:open(mconn3),
+ ConnPid3 = ct_gen_conn:get_conn_pid(Handle3),
+ {true,true} = {is_process_alive(Handle3),is_process_alive(ConnPid3)},
+
+ Handle1 = proto:open(mconn1),
+
+ ok = proto:close(mconn1),
+ timer:sleep(100),
+ {false,false} = {is_process_alive(Handle1),is_process_alive(ConnPid1)},
+
+ ok = proto:kill_conn_proc(Handle2),
+ timer:sleep(100),
+ Handle2 = proto:open(mconn2), % should've been reconnected already
+ {true,false} = {is_process_alive(Handle2),is_process_alive(ConnPid2)},
+ ConnPid2x = ct_gen_conn:get_conn_pid(Handle2),
+ true = is_process_alive(ConnPid2x),
+
+ ok = proto:close(mconn2),
+ timer:sleep(100),
+ {false,false} = {is_process_alive(Handle2),is_process_alive(ConnPid2x)},
+ Handle2y = proto:open(mconn2),
+ ConnPid2y = ct_gen_conn:get_conn_pid(Handle2y),
+ {true,true} = {is_process_alive(Handle2y),is_process_alive(ConnPid2y)},
+ ok = proto:close(mconn2),
+ timer:sleep(100),
+ {false,false} = {is_process_alive(Handle2y),is_process_alive(ConnPid2y)},
+
+ application:set_env(ct_test, reconnect, false),
+ ok = proto:kill_conn_proc(Handle3),
+ timer:sleep(100),
+ {false,false} = {is_process_alive(Handle3),is_process_alive(ConnPid3)},
+
+ ok.
+
+names_to_single_conn_pids() ->
+ [{require,sconn1,single_conn_pid},
+ {require,sconn2,single_conn_pid},
+ {require,sconn3,single_conn_pid}].
+
+names_to_single_conn_pids(_Config) ->
+ application:set_env(ct_test, reconnect, true),
+
+ Handle1 = proto:open(sconn1),
+ ConnPid = ct_gen_conn:get_conn_pid(Handle1),
+ {true,true} = {is_process_alive(Handle1),is_process_alive(ConnPid)},
+ Handle2 = proto:open(sconn2),
+ ConnPid = ct_gen_conn:get_conn_pid(Handle2),
+ {true,true} = {is_process_alive(Handle2),is_process_alive(ConnPid)},
+ Handle3 = proto:open(sconn3),
+ ConnPid = ct_gen_conn:get_conn_pid(Handle3),
+ {true,true} = {is_process_alive(Handle3),is_process_alive(ConnPid)},
+
+ Handle1 = proto:open(sconn1),
+
+ Conns = [{sconn1,Handle1,_,_},
+ {sconn2,Handle2,_,_},
+ {sconn3,Handle3,_,_}] = lists:sort(ct_util:get_connections(ConnPid)),
+ ct:pal("CONNS on ~p = ~n~p", [ConnPid,Conns]),
+
+ ok = proto:close(sconn1),
+ timer:sleep(100),
+ {false,true} = {is_process_alive(Handle1),is_process_alive(ConnPid)},
+
+ ok = proto:kill_conn_proc(Handle2),
+ timer:sleep(100),
+ {true,false} = {is_process_alive(Handle2),is_process_alive(ConnPid)},
+ Handle2 = proto:open(sconn2), % should've been reconnected already
+ NewConnPid = ct_gen_conn:get_conn_pid(Handle2),
+ true = is_process_alive(NewConnPid),
+
+ Conns1 = [{sconn2,Handle2,_,_},
+ {sconn3,Handle3,_,_}] =
+ lists:sort(ct_util:get_connections(NewConnPid)),
+ ct:pal("CONNS on ~p = ~n~p", [NewConnPid,Conns1]),
+
+ ok = proto:close(sconn2),
+ timer:sleep(100),
+ {false,true} = {is_process_alive(Handle2),is_process_alive(NewConnPid)},
+
+ application:set_env(ct_test, reconnect, false),
+ ok = proto:kill_conn_proc(Handle3),
+ timer:sleep(100),
+ {false,false} = {is_process_alive(Handle3),is_process_alive(NewConnPid)},
+
+ ok.
+
+
diff --git a/lib/common_test/test/ct_gen_conn_SUITE_data/proto.erl b/lib/common_test/test/ct_gen_conn_SUITE_data/proto.erl
new file mode 100644
index 0000000000..8fcd35e0a4
--- /dev/null
+++ b/lib/common_test/test/ct_gen_conn_SUITE_data/proto.erl
@@ -0,0 +1,196 @@
+%%% @author Peter Andersson <[email protected]>
+%%% @copyright (C) 2013, Peter Andersson
+%%% @doc
+%%%
+%%% @end
+%%% Created : 24 May 2013 by Peter Andersson <[email protected]>
+
+-module(proto).
+
+-compile(export_all).
+
+-record(conn_state, {id, pid, ref, data}).
+
+%% TEST1: N connections (same key) -> N conn pids
+%% TEST2: N connections (same key) -> 1 conn pid
+%% TEST3: N aliases (same key) -> N conn pids
+%% TEST4: N aliases (same key) -> 1 conn pid
+
+open(KeyOrAlias) ->
+ case ct:get_config(KeyOrAlias) of
+ undefined ->
+ {error,{not_available,KeyOrAlias}};
+ ConnData ->
+ io:format("Opening connection with ~p~n", [ConnData]),
+
+ %% if KeyOrAlias == Key, each call returns unique handle
+ %% if KeyOrAlias == Alias, successive calls return same handle
+ {ok,Handle} = ct_gen_conn:start(ConnData,
+ [],
+ ?MODULE,
+ [{name,KeyOrAlias}]),
+ io:format("Handle for ~p = ~p~n", [KeyOrAlias,Handle]),
+ Handle
+ end.
+
+close(AliasOrHandle) ->
+ Handle = get_handle(AliasOrHandle),
+ io:format("Closing connection for ~p (~p)~n", [AliasOrHandle,Handle]),
+ case ct_gen_conn:stop(Handle) of
+ E = {error,_} ->
+ E;
+ Result ->
+ Result
+ end.
+
+kill_conn_proc(AliasOrHandle) ->
+ ConnPid = ct_gen_conn:get_conn_pid(get_handle(AliasOrHandle)),
+ io:format("Killing connection process ~p~n", [ConnPid]),
+ ConnPid ! fail,
+ ok.
+
+send(_) ->
+ ok.
+
+%%%-----------------------------------------------------------------
+%%%
+
+init(KeyOrAlias, ConnData, []) ->
+ Addr = proplists:get_value(addr, ConnData),
+ Port = proplists:get_value(port, ConnData),
+ Ref = make_ref(),
+ Starter = self(),
+ MultConnPids = proplists:get_value(multiple_conn_pids, ConnData),
+ ConnPid =
+ case MultConnPids of
+ true ->
+ spawn(fun() -> active_conn(Starter, KeyOrAlias, Ref,
+ ConnData) end);
+ _ ->
+ ConnMgr = proplists:get_value(conn_mgr_name, ConnData),
+ case whereis(ConnMgr) of
+ undefined ->
+ MgrPid =
+ spawn(fun() -> active_conn(Starter, KeyOrAlias,
+ Ref, ConnData) end),
+ receive MgrPid ->
+ MgrPid
+ end;
+ MgrPid when is_pid(MgrPid) ->
+ MgrPid ! {connect,Ref},
+ MgrPid
+ end
+ end,
+ io:format("Connection ~p opened on ~p:~p -> ~p (~p)~n",
+ [KeyOrAlias,Addr,Port,ConnPid,Ref]),
+ {ok,ConnPid,#conn_state{id=KeyOrAlias, pid=ConnPid, ref=Ref, data=ConnData}}.
+
+
+terminate(ConnPid, #conn_state{id=Id, pid=ConnPid, ref = Ref, data=Data}) ->
+ case proplists:get_value(multiple_conn_pids, Data) of
+ true ->
+ ConnPid ! close;
+ _ ->
+ ConnPid ! {close,Ref}
+ end,
+ io:format("Connection ~p on ~p (~p) closing!~n", [Id,ConnPid,Ref]),
+ ok.
+
+
+reconnect(ConnData, State = #conn_state{id=Id, ref=DeadRef}) ->
+ io:format("Reconnect for ~p initiated...~n", [DeadRef]),
+ case application:get_env(ct_test, reconnect) of
+ {ok,true} ->
+ ConnMgr = proplists:get_value(conn_mgr_name, ConnData),
+ NewRef = make_ref(),
+ Starter = self(),
+ ConnPid =
+ case proplists:get_value(multiple_conn_pids, ConnData) of
+ true ->
+ spawn(fun() ->
+ active_conn(Starter, Id, NewRef,
+ ConnData)
+ end);
+ _ ->
+ case whereis(ConnMgr) of
+ undefined ->
+ MgrPid =
+ spawn(fun() ->
+ active_conn(Starter, Id,
+ NewRef, ConnData)
+ end),
+ receive MgrPid ->
+ MgrPid
+ end;
+ MgrPid ->
+ MgrPid ! {reconnect,DeadRef,NewRef},
+ MgrPid
+ end
+ end,
+ io:format("Connection ~p reopened on ~p (~p)~n",
+ [Id,ConnPid,NewRef]),
+ {ok,ConnPid,State#conn_state{pid=ConnPid, ref=NewRef}};
+ _ ->
+ {error,no_reconnection_allowed}
+ end.
+
+%%%-----------------------------------------------------------------
+%%%
+
+active_conn(Starter, Id, Ref, ConnData) ->
+ ConnMgr = proplists:get_value(conn_mgr_name, ConnData),
+ case proplists:get_value(multiple_conn_pids, ConnData) of
+ true ->
+ ok;
+ _ ->
+ register(ConnMgr,self()),
+ io:format("Connection manager ~p on ~p started for "
+ "~p and ~p~n",
+ [ConnMgr,self(),Id,Ref])
+ end,
+ Starter ! self(),
+ active_conn_loop(ConnData, [Ref]).
+
+active_conn_loop(ConnData, Conns) ->
+ receive
+ {connect,Ref} ->
+ io:format("Connecting ~p on ~p~n",
+ [Ref,self()]),
+ active_conn_loop(ConnData, [Ref | Conns]);
+ {reconnect,DeadRef,NewRef} ->
+ Conns1 = [NewRef | lists:delete(DeadRef, Conns)],
+ io:format("Reconnecting on ~p: ~p -> ~p~n",
+ [self(),DeadRef,NewRef]),
+ active_conn_loop(ConnData, Conns1);
+ close ->
+ io:format("Conn process ~p shutting down~n", [self()]),
+ ok;
+ {close,Ref} ->
+ io:format("Closing connection ~p on ~p~n", [Ref,self()]),
+ case proplists:delete(Ref, Conns) of
+ [] ->
+ io:format("Last connection on ~p closed, "
+ "now stopping~n", [self()]),
+ ok;
+ Conns1 ->
+ active_conn_loop(ConnData, Conns1)
+ end;
+ fail ->
+ io:format("Connection process not feeling good...~n", []),
+ exit(kaboom);
+ {respond,To} ->
+ To ! {self(),hello},
+ active_conn_loop(ConnData, Conns)
+ end.
+
+%%%-----------------------------------------------------------------
+%%%
+
+get_handle(AliasOrHandle) when is_pid(AliasOrHandle) ->
+ AliasOrHandle;
+
+get_handle(AliasOrHandle) ->
+ {ok,{H,_}} = ct_util:get_connection(AliasOrHandle,
+ ?MODULE),
+ H.
+
diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl
index 1c51226314..b348e854a0 100644
--- a/lib/compiler/src/beam_a.erl
+++ b/lib/compiler/src/beam_a.erl
@@ -70,8 +70,8 @@ rename_instr({bs_put_utf16=I,F,Fl,Src}) ->
{bs_put,F,{I,Fl},[Src]};
rename_instr({bs_put_utf32=I,F,Fl,Src}) ->
{bs_put,F,{I,Fl},[Src]};
-%% rename_instr({bs_put_string,_,_}=I) ->
-%% {bs_put,{f,0},I,[]};
+rename_instr({bs_put_string,_,_}=I) ->
+ {bs_put,{f,0},I,[]};
rename_instr({bs_add=I,F,[Src1,Src2,U],Dst}) when is_integer(U) ->
{bif,I,F,[Src1,Src2,{integer,U}],Dst};
rename_instr({bs_utf8_size=I,F,Src,Dst}) ->
diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl
index 554c14f57a..e623bcc6a5 100644
--- a/lib/compiler/src/beam_utils.erl
+++ b/lib/compiler/src/beam_utils.erl
@@ -734,6 +734,8 @@ live_opt([{loop_rec,_Fail,_Dst}=I|Is], _, D, Acc) ->
live_opt(Is, 0, D, [I|Acc]);
live_opt([timeout=I|Is], _, D, Acc) ->
live_opt(Is, 0, D, [I|Acc]);
+live_opt([{wait,_}=I|Is], _, D, Acc) ->
+ live_opt(Is, 0, D, [I|Acc]);
%% Transparent instructions - they neither use nor modify x registers.
live_opt([{deallocate,_}=I|Is], Regs, D, Acc) ->
@@ -744,8 +746,6 @@ live_opt([{try_end,_}=I|Is], Regs, D, Acc) ->
live_opt(Is, Regs, D, [I|Acc]);
live_opt([{loop_rec_end,_}=I|Is], Regs, D, Acc) ->
live_opt(Is, Regs, D, [I|Acc]);
-live_opt([{wait,_}=I|Is], Regs, D, Acc) ->
- live_opt(Is, Regs, D, [I|Acc]);
live_opt([{wait_timeout,_,{Tag,_}}=I|Is], Regs, D, Acc) when Tag =/= x ->
live_opt(Is, Regs, D, [I|Acc]);
live_opt([{line,_}=I|Is], Regs, D, Acc) ->
diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl
index e60584d4ab..ec49267ded 100644
--- a/lib/compiler/test/receive_SUITE.erl
+++ b/lib/compiler/test/receive_SUITE.erl
@@ -23,7 +23,8 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
init_per_testcase/2,end_per_testcase/2,
- export/1,recv/1,coverage/1,otp_7980/1,ref_opt/1]).
+ export/1,recv/1,coverage/1,otp_7980/1,ref_opt/1,
+ wait/1]).
-include_lib("test_server/include/test_server.hrl").
@@ -44,7 +45,7 @@ all() ->
groups() ->
[{p,test_lib:parallel(),
- [recv,coverage,otp_7980,ref_opt,export]}].
+ [recv,coverage,otp_7980,ref_opt,export,wait]}].
init_per_suite(Config) ->
@@ -252,4 +253,20 @@ export_1(Reference) ->
id({build,self()}),
Result.
+wait(Config) when is_list(Config) ->
+ self() ! <<42>>,
+ <<42>> = wait_1(r, 1, 2),
+ {1,2,3} = wait_1(1, 2, 3),
+ ok.
+
+wait_1(r, _, _) ->
+ receive
+ B when byte_size(B) > 0 ->
+ B
+ end;
+%% beam_utils would wrongly assume that wait/1 could fall through
+%% to the next clause.
+wait_1(A, B, C) ->
+ {A,B,C}.
+
id(I) -> I.
diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml
index bdccfee341..2df407018e 100644
--- a/lib/crypto/doc/src/crypto.xml
+++ b/lib/crypto/doc/src/crypto.xml
@@ -249,7 +249,7 @@
<name>hash(Type, Data) -> Digest</name>
<fsummary></fsummary>
<type>
- <v>Type = md4 | message_digest_algorithms()</v>
+ <v>Type = md4 | hash_algorithms()</v>
<v>Data = iodata()</v>
<v>Digest = binary()</v>
</type>
@@ -264,7 +264,7 @@
<name>hash_init(Type) -> Context</name>
<fsummary></fsummary>
<type>
- <v>Type = md4 | message_digest_algorithms()</v>
+ <v>Type = md4 | hash_algorithms()</v>
</type>
<desc>
<p>Initializes the context for streaming hash operations. <c>Type</c> determines
@@ -308,7 +308,7 @@
<name>hmac(Type, Key, Data, MacLength) -> Mac</name>
<fsummary></fsummary>
<type>
- <v>Type = message_digest_algorithms() </v>
+ <v>Type = hash_algorithms() - except ripemd160</v>
<v>Key = iodata()</v>
<v>Data = iodata()</v>
<v>MacLength = integer()</v>
@@ -325,7 +325,7 @@
<name>hmac_init(Type, Key) -> Context</name>
<fsummary></fsummary>
<type>
- <v>Type = message_digest_algorithms()</v>
+ <v>Type = hash_algorithms() - except ripemd160</v>
<v>Key = iodata()</v>
<v>Context = binary()</v>
</type>
@@ -475,7 +475,7 @@
used mode.
The size of the <c>Msg</c> must be less than <c>byte_size(N)-11</c> if
<c>rsa_pkcs1_padding</c> is used, and <c>byte_size(N)</c> if <c>rsa_no_padding</c>
- is used.
+ is used, where N is public modulus of the RSA key.
See also <seealso marker="public_key:public_key#encrypt_private/2">public_key:encrypt_private/[2,3]</seealso>
</p>
</desc>
@@ -513,18 +513,20 @@
<v>ChipherText = binary()</v>
</type>
<desc>
- <p>Encrypts the <c>PlainText</c> (usually a session key) using the <c>PublicKey</c>
- and returns the <c>CipherText</c>. The <c>Padding</c> decides what padding mode is used,
- <c>rsa_pkcs1_padding</c> is PKCS #1 v1.5 currently the most
- used mode and <c>rsa_pkcs1_oaep_padding</c> is EME-OAEP as
- defined in PKCS #1 v2.0 with SHA-1, MGF1 and an empty encoding
- parameter. This mode is recommended for all new applications.
- The size of the <c>Msg</c> must be less
- than <c>byte_size(N)-11</c> if
- <c>rsa_pkcs1_padding</c> is used, <c>byte_size(N)-41</c> if
- <c>rsa_pkcs1_oaep_padding</c> is used and <c>byte_size(N)</c> if <c>rsa_no_padding</c>
- is used.
- See also <seealso marker="public_key:public_key#encrypt_public/2">public_key:encrypt_public/[2,3]</seealso>
+ <p>Encrypts the <c>PlainText</c> (usually a session key) using
+ the <c>PublicKey</c> and returns the <c>CipherText</c>. The
+ <c>Padding</c> decides what padding mode is used,
+ <c>rsa_pkcs1_padding</c> is PKCS #1 v1.5 currently the most
+ used mode and <c>rsa_pkcs1_oaep_padding</c> is EME-OAEP as
+ defined in PKCS #1 v2.0 with SHA-1, MGF1 and an empty encoding
+ parameter. This mode is recommended for all new
+ applications. The size of the <c>Msg</c> must be less than
+ <c>byte_size(N)-11</c> if <c>rsa_pkcs1_padding</c> is
+ used, <c>byte_size(N)-41</c> if
+ <c>rsa_pkcs1_oaep_padding</c> is used and
+ <c>byte_size(N)</c> if <c>rsa_no_padding</c> is used, where N is public modulus of the RSA key.
+ See also <seealso
+ marker="public_key:public_key#encrypt_public/2">public_key:encrypt_public/[2,3]</seealso>
</p>
</desc>
</func>
diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl
index c007ecac86..b3bb5dbd17 100644
--- a/lib/crypto/test/crypto_SUITE.erl
+++ b/lib/crypto/test/crypto_SUITE.erl
@@ -48,7 +48,7 @@ all() ->
{group, des_cfb},
{group, des3_cbc},
{group, des3_cbf},
- %%{group, des_ede3},
+ {group, des_ede3},
{group, blowfish_cbc},
{group, blowfish_ecb},
{group, blowfish_cfb64},
@@ -60,7 +60,8 @@ all() ->
{group, rc4},
{group, aes_ctr},
mod_pow,
- exor
+ exor,
+ rand_uniform
].
groups() ->
@@ -83,6 +84,7 @@ groups() ->
{des_cbc, [], [block]},
{des_cfb, [], [block]},
{des3_cbc,[], [block]},
+ {des_ede3,[], [block]},
{des3_cbf,[], [block]},
{rc2_cbc,[], [block]},
{aes_cbc128,[], [block]},
@@ -220,7 +222,13 @@ exor(Config) when is_list(Config) ->
Z2 = crypto:exor(B2, B2),
R = xor_bytes(B1, B2),
R = crypto:exor(B1, B2).
-
+%%--------------------------------------------------------------------
+rand_uniform() ->
+ [{doc, "rand_uniform and random_bytes testing"}].
+rand_uniform(Config) when is_list(Config) ->
+ rand_uniform_aux_test(10),
+ 10 = byte_size(crypto:rand_bytes(10)),
+ 10 = byte_size(crypto:strong_rand_bytes(10)).
%%--------------------------------------------------------------------
%% Internal functions ------------------------------------------------
%%--------------------------------------------------------------------
@@ -398,16 +406,19 @@ negative_verify(Type, Hash, Msg, Signature, Public) ->
end.
do_public_encrypt({Type, Public, Private, Msg, Padding}) ->
- PublicEcn = crypto:public_encrypt(Type, Msg, Public, Padding),
+ PublicEcn = (catch crypto:public_encrypt(Type, Msg, Public, Padding)),
case crypto:private_decrypt(Type, PublicEcn, Private, Padding) of
Msg ->
ok;
Other ->
ct:fail({{crypto, private_decrypt, [Type, PublicEcn, Private, Padding]}, {expected, Msg}, {got, Other}})
end.
+
+do_private_encrypt({_Type, _Public, _Private, _Msg, rsa_pkcs1_oaep_padding}) ->
+ ok; %% Not supported by openssl
do_private_encrypt({Type, Public, Private, Msg, Padding}) ->
- PrivEcn = crypto:private_encrypt(Type, Msg, Private, Padding),
- case crypto:public_decrypt(Type, PrivEcn, Public, Padding) of
+ PrivEcn = (catch crypto:private_encrypt(Type, Msg, Private, Padding)),
+ case crypto:public_decrypt(rsa, PrivEcn, Public, Padding) of
Msg ->
ok;
Other ->
@@ -451,8 +462,6 @@ mkint(C) when $A =< C, C =< $F ->
mkint(C) when $a =< C, C =< $f ->
C - $a + 10.
-is_supported(cipher) ->
- true;
is_supported(Group) ->
lists:member(Group, lists:append([Algo || {_, Algo} <- crypto:supports()])).
@@ -472,6 +481,8 @@ do_block_iolistify({des3_cbc = Type, Key, IV, PlainText}) ->
{Type, Key, IV, des_iolistify(PlainText)};
do_block_iolistify({des3_cbf = Type, Key, IV, PlainText}) ->
{Type, Key, IV, des_iolistify(PlainText)};
+do_block_iolistify({des_ede3 = Type, Key, IV, PlainText}) ->
+ {Type, Key, IV, des_iolistify(PlainText)};
do_block_iolistify({Type, Key, PlainText}) ->
{Type, iolistify(Key), iolistify(PlainText)};
do_block_iolistify({Type, Key, IV, PlainText}) ->
@@ -545,6 +556,25 @@ xor_bytes([], [], Acc) ->
lists:reverse(Acc);
xor_bytes([N1 | Tl1], [N2 | Tl2], Acc) ->
xor_bytes(Tl1, Tl2, [N1 bxor N2 | Acc]).
+rand_uniform_aux_test(0) ->
+ ok;
+rand_uniform_aux_test(N) ->
+ L = N*1000,
+ H = N*100000+1,
+ crypto_rand_uniform(L, H),
+ crypto_rand_uniform(-L, L),
+ crypto_rand_uniform(-H, -L),
+ crypto_rand_uniform(-H, L),
+ rand_uniform_aux_test(N-1).
+
+crypto_rand_uniform(L,H) ->
+ R1 = crypto:rand_uniform(L, H),
+ case (R1 >= L) and (R1 < H) of
+ true ->
+ ok;
+ false ->
+ ct:fail({"Not in interval", R1, L, H})
+ end.
%%--------------------------------------------------------------------
%% Test data ------------------------------------------------
@@ -603,17 +633,13 @@ group_config(rsa = Type, Config) ->
Msg = rsa_plain(),
Public = rsa_public(),
Private = rsa_private(),
- SignVerify = [{Type, md5, Public, Private, Msg},
- {Type, sha, Public, Private, Msg},
- {Type, sha224, Public, Private,Msg},
- {Type, sha256, Public, Private,Msg}
- %% {Type, sha384, Public, Private,Msg},
- %% {Type, sha512, Public, Private, Msg}
- ],
+ PublicS = rsa_public_stronger(),
+ PrivateS = rsa_private_stronger(),
+ SignVerify = sign_verify_tests(Type, Msg, Public, Private, PublicS, PrivateS),
MsgPubEnc = <<"7896345786348 Asldi">>,
- PubPrivEnc = [{rsa, Public, Private, MsgPubEnc, rsa_pkcs1_padding}
- %%{rsa, Public, Private, MsgPubEnc, rsa_pkcs1_oaep_padding}
- %%{rsa, Public, Private, MsgPubEnc, rsa_no_padding}
+ PubPrivEnc = [{rsa, Public, Private, MsgPubEnc, rsa_pkcs1_padding},
+ rsa_oaep(),
+ no_padding()
],
[{sign_verify, SignVerify}, {pub_priv_encrypt, PubPrivEnc} | Config];
group_config(dss = Type, Config) ->
@@ -649,6 +675,9 @@ group_config(des3_cbc, Config) ->
group_config(des3_cbf, Config) ->
Block = des3_cbf(),
[{block, Block} | Config];
+group_config(des_ede3, Config) ->
+ Block = des_ede3(),
+ [{block, Block} | Config];
group_config(rc2_cbc, Config) ->
Block = rc2_cbc(),
[{block, Block} | Config];
@@ -682,6 +711,20 @@ group_config(aes_ctr, Config) ->
group_config(_, Config) ->
Config.
+sign_verify_tests(Type, Msg, Public, Private, PublicS, PrivateS) ->
+ sign_verify_tests(Type, [md5, sha, sha224, sha256], Msg, Public, Private) ++
+ sign_verify_tests(Type, [sha384, sha512], Msg, PublicS, PrivateS).
+
+sign_verify_tests(Type, Hashs, Msg, Public, Private) ->
+ lists:foldl(fun(Hash, Acc) ->
+ case is_supported(Hash) of
+ true ->
+ [{Type, Hash, Public, Private, Msg}|Acc];
+ false ->
+ Acc
+ end
+ end, [], Hashs).
+
rfc_1321_msgs() ->
[<<"">>,
<<"a">>,
@@ -950,6 +993,15 @@ des3_cbc() ->
<<"Now is the time for all ">>
}].
+des_ede3() ->
+ [{des_ede3,
+ [hexstr2bin("8000000000000000"),
+ hexstr2bin("4000000000000000"),
+ hexstr2bin("2000000000000000")],
+ hexstr2bin("7AD16FFB79C45926"),
+ hexstr2bin("0000000000000000")
+ }].
+
des3_cbf() ->
[{des3_cbf,
[hexstr2bin("0123456789abcdef"),
@@ -1196,6 +1248,12 @@ rsa_public() ->
rsa_private() ->
rsa_public() ++ [7531712708607620783801185371644749935066152052780368689827275932079815492940396744378735701395659435842364793962992309884847527234216715366607660219930945].
+rsa_public_stronger() ->
+ [65537, 24629450921918866883077380602720734920775458960049554761386137065662137652635369332143446151320538248280934442179850504891395344346514465469955766163141133564033962851182759993807898821114734943339732032639891483186089941567854227407119560631150779000222837755424893038740314247760600374970909894211201220612920040986106639419467243909950276018045907029941478599124238353052062083560294570722081552510960894164859765695309596889747541376908786225647625736062865138957717982693312699025417086612046330464651009693307624955796202070510577399561730651967517158452930742355327167632521808183383868100102455048819375344881].
+
+rsa_private_stronger() ->
+ rsa_public_stronger() ++ [13565232776562604620467234237694854016819673873109064019820773052201665024482754648718278717031083946624786145611240731564761987114634269887293030432042088547345315212418830656522115993209293567218379960177754901461542373481136856927955012596579314262051109321754382091434920473734937991286600905464814063189230779981494358415076362038786197620360127262110530926733754185204773610295221669711309000953136320804528874719105049753061737780710448207922456570922652651354760939379096788728229638142403068102990416717272880560951246813789730402978652924934794503277969128609831043469924881848849409122972426787999886557185].
+
dss_plain() ->
rsa_plain().
dss_public() ->
@@ -1355,3 +1413,37 @@ ecdh() ->
dh() ->
{dh, 0087761979513264537414556992123116644042638206717762626089877284926656954974893442000747478454809111207351620687968672207938731607963470779396984752680274820156266685080223616226905101126463253150237669547023934604953898814222890239130021414026118792251620881355456432549881723310342870016961804255746630219, 2}.
+
+rsa_oaep() ->
+ %% ftp://ftp.rsa.com/pub/rsalabs/tmp/pkcs1v15crypt-vectors.txt
+ Public = [hexstr2bin("010001"),
+ hexstr2bin("a8b3b284af8eb50b387034a860f146c4919f318763cd6c5598c8ae4811a1e0abc4c7e0b082d693a5e7fced675cf4668512772c0cbc64a742c6c630f533c8cc72f62ae833c40bf25842e984bb78bdbf97c0107d55bdb662f5c4e0fab9845cb5148ef7392dd3aaff93ae1e6b667bb3d4247616d4f5ba10d4cfd226de88d39f16fb")],
+ Private = Public ++ [hexstr2bin("53339cfdb79fc8466a655c7316aca85c55fd8f6dd898fdaf119517ef4f52e8fd8e258df93fee180fa0e4ab29693cd83b152a553d4ac4d1812b8b9fa5af0e7f55fe7304df41570926f3311f15c4d65a732c483116ee3d3d2d0af3549ad9bf7cbfb78ad884f84d5beb04724dc7369b31def37d0cf539e9cfcdd3de653729ead5d1"),
+ hexstr2bin("d32737e7267ffe1341b2d5c0d150a81b586fb3132bed2f8d5262864a9cb9f30af38be448598d413a172efb802c21acf1c11c520c2f26a471dcad212eac7ca39d"),
+ hexstr2bin("cc8853d1d54da630fac004f471f281c7b8982d8224a490edbeb33d3e3d5cc93c4765703d1dd791642f1f116a0dd852be2419b2af72bfe9a030e860b0288b5d77"),
+ hexstr2bin("0e12bf1718e9cef5599ba1c3882fe8046a90874eefce8f2ccc20e4f2741fb0a33a3848aec9c9305fbecbd2d76819967d4671acc6431e4037968db37878e695c1"),
+ hexstr2bin("95297b0f95a2fa67d00707d609dfd4fc05c89dafc2ef6d6ea55bec771ea333734d9251e79082ecda866efef13c459e1a631386b7e354c899f5f112ca85d71583"),
+ hexstr2bin("4f456c502493bdc0ed2ab756a3a6ed4d67352a697d4216e93212b127a63d5411ce6fa98d5dbefd73263e3728142743818166ed7dd63687dd2a8ca1d2f4fbd8e1")],
+ %%Msg = hexstr2bin("6628194e12073db03ba94cda9ef9532397d50dba79b987004afefe34"),
+ Msg = hexstr2bin("750c4047f547e8e41411856523298ac9bae245efaf1397fbe56f9dd5"),
+ {rsa, Public, Private, Msg, rsa_pkcs1_oaep_padding}.
+
+no_padding() ->
+ Public = [_, Mod] = rsa_public(),
+ Private = rsa_private(),
+ MsgLen = erlang:byte_size(int_to_bin(Mod)),
+ Msg = list_to_binary(lists:duplicate(MsgLen, $X)),
+ {rsa, Public, Private, Msg, rsa_no_padding}.
+
+int_to_bin(X) when X < 0 -> int_to_bin_neg(X, []);
+int_to_bin(X) -> int_to_bin_pos(X, []).
+
+int_to_bin_pos(0,Ds=[_|_]) ->
+ list_to_binary(Ds);
+int_to_bin_pos(X,Ds) ->
+ int_to_bin_pos(X bsr 8, [(X band 255)|Ds]).
+
+int_to_bin_neg(-1, Ds=[MSB|_]) when MSB >= 16#80 ->
+ list_to_binary(Ds);
+int_to_bin_neg(X,Ds) ->
+ int_to_bin_neg(X bsr 8, [(X band 255)|Ds]).
diff --git a/lib/diameter/doc/src/diameter_app.xml b/lib/diameter/doc/src/diameter_app.xml
index d4fb792787..e6c9cc9a90 100644
--- a/lib/diameter/doc/src/diameter_app.xml
+++ b/lib/diameter/doc/src/diameter_app.xml
@@ -565,7 +565,8 @@ Equivalent to</p>
</pre>
<p>
where <c>Avps</c> sets the Origin-Host, Origin-Realm, the specified
-Result-Code and (if the request contained one) Session-Id AVP's.</p>
+Result-Code and (if the request contained one) Session-Id AVP's, and
+possibly Failed-AVP as described below.</p>
<p>
Returning a value other than 3xxx or 5xxx will cause the request
@@ -573,6 +574,14 @@ process in question to fail, as will returning a 5xxx value if the
peer connection in question has been configured with the RFC 3588
common dictionary <c>diameter_gen_base_rfc3588</c>.
(Since RFC 3588 only allows 3xxx values in an answer-message.)</p>
+
+<p>
+When returning 5xxx, Failed-AVP will be populated with the AVP of the
+first matching Result-Code/AVP pair in the <c>errors</c> field of the
+argument &packet;, if found.
+If this is not appropriate then an answer-message should be
+constructed explicitly and returned in a <c>reply</c> tuple
+instead.</p>
</item>
<tag><c>{relay, Opts}</c></tag>
@@ -592,8 +601,7 @@ header of the relayed request.</p>
The returned <c>Opts</c> should not specify <c>detach</c>.
A subsequent &handle_answer;
callback for the relayed request must return its first
-argument, the <c>#diameter_packet{}</c> record containing the answer
-message.
+argument, the &packet; containing the answer message.
Note that the <c>extra</c> option can be specified to supply arguments
that can distinguish the relay case from others if so desired.
Any other return value (for example, from a
diff --git a/lib/diameter/doc/src/diameter_transport.xml b/lib/diameter/doc/src/diameter_transport.xml
index 8bccf6521e..9161bd1f48 100644
--- a/lib/diameter/doc/src/diameter_transport.xml
+++ b/lib/diameter/doc/src/diameter_transport.xml
@@ -137,15 +137,14 @@ passed to the former.</p>
<p>
The start function should use the <c>Host-IP-Address</c> list in
-<c>Svc</c> and/or <c>Config</c> to select an appropriate list of local
-IP addresses, and should return this list if different from the
-<c>Svc</c> addresses.
+<c>Svc</c> and/or <c>Config</c> to select and return an appropriate
+list of local IP addresses.
In the connecting case, the local address list can instead be
communicated in a <c>connected</c> message (see &MESSAGES; below)
following connection establishment.
In either case, the local address list is used to populate
<c>Host-IP-Address</c> AVPs in outgoing capabilities exchange
-messages.</p>
+messages if <c>Host-IP-Address</c> is unspecified.</p>
<p>
A transport process must implement the message interface documented below.
diff --git a/lib/diameter/include/diameter_gen.hrl b/lib/diameter/include/diameter_gen.hrl
index 03aa557c2e..55aae3a243 100644
--- a/lib/diameter/include/diameter_gen.hrl
+++ b/lib/diameter/include/diameter_gen.hrl
@@ -25,11 +25,23 @@
-define(THROW(T), throw({?MODULE, T})).
-%%% ---------------------------------------------------------------------------
-%%% # encode_avps/3
-%%%
-%%% Returns: binary()
-%%% ---------------------------------------------------------------------------
+-type parent_name() :: atom(). %% parent = Message or AVP
+-type parent_record() :: tuple(). %%
+-type avp_name() :: atom().
+-type avp_record() :: tuple().
+-type avp_values() :: [{avp_name(), term()}].
+
+-type non_grouped_avp() :: #diameter_avp{}.
+-type grouped_avp() :: nonempty_improper_list(#diameter_avp{}, [avp()]).
+-type avp() :: non_grouped_avp() | grouped_avp().
+
+%% ---------------------------------------------------------------------------
+%% # encode_avps/2
+%% ---------------------------------------------------------------------------
+
+-spec encode_avps(parent_name(), parent_record() | avp_values())
+ -> binary()
+ | no_return().
encode_avps(Name, Vals)
when is_list(Vals) ->
@@ -129,42 +141,26 @@ pack_AVP(Name, #diameter_avp{name = AvpName,
orelse ?THROW([known_avp_as_AVP, Name, AvpName, Data]),
e(AvpName, [Data]).
-%%% ---------------------------------------------------------------------------
-%%% # decode_avps/2
-%%%
-%%% Returns: {Rec, Avps, Failed}
-%%%
-%%% Rec = decoded message record
-%%% Avps = list of Avp
-%%% Failed = list of {ResultCode, #diameter_avp{}}
-%%%
-%%% Avp = #diameter_avp{} if type is not Grouped
-%%% | list of Avp where first element has type Grouped
-%%% and following elements are its component
-%%% AVP's.
-%%% ---------------------------------------------------------------------------
+%% ---------------------------------------------------------------------------
+%% # decode_avps/2
+%% ---------------------------------------------------------------------------
+
+-spec decode_avps(parent_name(), [#diameter_avp{}])
+ -> {parent_record(), [avp()], Failed}
+ when Failed :: [{5000..5999, #diameter_avp{}}].
decode_avps(Name, Recs) ->
- d_rc(Name, lists:foldl(fun(T,A) -> decode(Name, T, A) end,
- {[], {newrec(Name), []}},
- Recs)).
+ {Avps, {Rec, Failed}}
+ = lists:foldl(fun(T,A) -> decode(Name, T, A) end,
+ {[], {newrec(Name), []}},
+ Recs),
+ {Rec, Avps, Failed ++ missing(Rec, Name)}.
+%% Append 5005 errors so that a 5014 for the same AVP will take
+%% precedence in a Result-Code/Failed-AVP setting.
newrec(Name) ->
'#new-'(name2rec(Name)).
-%% No errors so far: keep looking.
-d_rc(Name, {Avps, {Rec, [] = Failed}}) ->
- try
- true = have_required_avps(Rec, Name),
- {Rec, Avps, Failed}
- catch
- throw: {?MODULE, {AvpName, Reason}} ->
- diameter_lib:log({decode, error},
- ?MODULE,
- ?LINE,
- {AvpName, Reason, Rec}),
- {Rec, Avps, [{5005, empty_avp(AvpName)}]}
- end;
%% 3588:
%%
%% DIAMETER_MISSING_AVP 5005
@@ -175,9 +171,17 @@ d_rc(Name, {Avps, {Rec, [] = Failed}}) ->
%% Vendor-Id if applicable. The value field of the missing AVP
%% should be of correct minimum length and contain zeroes.
-%% Or not. Only need to report the first error so look no further.
-d_rc(_, {Avps, {Rec, Failed}}) ->
- {Rec, Avps, lists:reverse(Failed)}.
+missing(Rec, Name) ->
+ [{5005, empty_avp(F)} || F <- '#info-'(element(1, Rec), fields),
+ A <- [avp_arity(Name, F)],
+ false <- [have_arity(A, '#get-'(F, Rec))]].
+
+%% Maximum arities have already been checked in building the record.
+
+have_arity({Min, _}, L) ->
+ Min =< length(L);
+have_arity(N, V) ->
+ N /= 1 orelse V /= undefined.
%% empty_avp/1
@@ -192,25 +196,6 @@ empty_avp(Name) ->
data = empty_value(Name),
type = Type}.
-%% have_required_avps/2
-
-have_required_avps(Rec, Name) ->
- lists:foreach(fun(F) -> hra(Name, F, Rec) end,
- '#info-'(element(1, Rec), fields)),
- true.
-
-hra(Name, AvpName, Rec) ->
- Arity = avp_arity(Name, AvpName),
- hra(Arity, '#get-'(AvpName, Rec))
- orelse ?THROW({AvpName, {insufficient_arity, Arity}}).
-
-%% Maximum arities have already been checked in building the record.
-
-hra({Min, _}, L) ->
- Min =< length(L);
-hra(N, V) ->
- N /= 1 orelse V /= undefined.
-
%% 3588, ch 7:
%%
%% The Result-Code AVP describes the error that the Diameter node
@@ -227,23 +212,22 @@ decode(Name, #diameter_avp{code = Code, vendor_id = Vid} = Avp, Acc) ->
%% decode/4
-%% Don't know this AVP: see if it can be packed in an 'AVP' field
-%% undecoded, unless it's mandatory. Need to give Failed-AVP special
-%% treatment since it'll contain any unrecognized mandatory AVP's.
-decode(Name, 'AVP', #diameter_avp{is_mandatory = M} = Avp, {Avps, Acc}) ->
- {[Avp | Avps], if M, Name /= 'Failed-AVP' ->
- unknown(Avp, Acc);
- true ->
- pack_AVP(Name, Avp, Acc)
- end};
-%% Note that the type field is 'undefined' in this case.
-
-%% Or try to decode.
decode(Name, {AvpName, Type}, Avp, Acc) ->
- d(Name, Avp#diameter_avp{name = AvpName, type = Type}, Acc).
+ d(Name, Avp#diameter_avp{name = AvpName, type = Type}, Acc);
+
+decode(Name, 'AVP', Avp, Acc) ->
+ decode_AVP(Name, Avp, Acc).
%% d/3
+%% Don't try to decode the value of a Failed-AVP component since it
+%% probably won't. Note that matching on 'Failed-AVP' assumes that
+%% this is the RFC AVP, with code 279. Strictly, this doesn't need to
+%% be the case, so we're assuming no one defines another Failed-AVP.
+d('Failed-AVP' = Name, Avp, Acc) ->
+ decode_AVP(Name, Avp, Acc);
+
+%% Or try to decode.
d(Name, Avp, {Avps, Acc}) ->
#diameter_avp{name = AvpName,
data = Data}
@@ -265,17 +249,25 @@ d(Name, Avp, {Avps, Acc}) ->
?LINE,
{Reason, Avp, erlang:get_stacktrace()}),
{Rec, Failed} = Acc,
- {[Avp|Avps], {Rec, [{rc(Reason), Avp} | Failed]}}
+ {[Avp|Avps], {Rec, [rc(Reason, Avp) | Failed]}}
end.
+%% decode_AVP/3
+%%
+%% Don't know this AVP: see if it can be packed in an 'AVP' field
+%% undecoded. Note that the type field is 'undefined' in this case.
+
+decode_AVP(Name, Avp, {Avps, Acc}) ->
+ {[Avp | Avps], pack_AVP(Name, Avp, Acc)}.
+
%% rc/1
%% diameter_types will raise an error of this form to communicate
%% DIAMETER_INVALID_AVP_LENGTH (5014). A module specified to a
%% @custom_types tag in a spec file can also raise an error of this
%% form.
-rc({'DIAMETER', RC, _}) ->
- RC;
+rc({'DIAMETER', 5014 = RC, _}, #diameter_avp{name = AvpName} = Avp) ->
+ {RC, Avp#diameter_avp{data = empty_value(AvpName)}};
%% 3588:
%%
@@ -283,20 +275,13 @@ rc({'DIAMETER', RC, _}) ->
%% The request contained an AVP with an invalid value in its data
%% portion. A Diameter message indicating this error MUST include
%% the offending AVPs within a Failed-AVP AVP.
-rc(_) ->
- 5004.
+rc(_, Avp) ->
+ {5004, Avp}.
%% ungroup/2
-%%
-%% Returns: {Avp, Dec}
-%%
-%% Avp = #diameter_avp{} if type is not Grouped
-%% | list of Avp where first element has type Grouped
-%% and following elements are its component
-%% AVP's.
-%% = as for decode_avps/2
-%%
-%% Dec = #diameter_avp{}, either Avp or its head in the list case.
+
+-spec ungroup(term(), #diameter_avp{})
+ -> {avp(), #diameter_avp{}}.
%% The decoded value in the Grouped case is as returned by grouped_avp/3:
%% a record and a list of component AVP's.
@@ -325,10 +310,18 @@ pack_avp(_, Arity, Avp, Acc) ->
%% pack_AVP/3
-pack_AVP(Name, Avp, Acc) ->
+%% Give Failed-AVP special treatment since it'll contain any
+%% unrecognized mandatory AVP's.
+pack_AVP(Name, #diameter_avp{is_mandatory = true} = Avp, Acc)
+ when Name /= 'Failed-AVP' ->
+ {Rec, Failed} = Acc,
+ {Rec, [{5001, Avp} | Failed]};
+
+pack_AVP(Name, #diameter_avp{is_mandatory = M} = Avp, Acc) ->
case avp_arity(Name, 'AVP') of
0 ->
- unknown(Avp, Acc);
+ {Rec, Failed} = Acc,
+ {Rec, [{if M -> 5001; true -> 5008 end, Avp} | Failed]};
Arity ->
pack(Arity, 'AVP', Avp, Acc)
end.
@@ -345,9 +338,6 @@ pack_AVP(Name, Avp, Acc) ->
%% A message was received with an AVP that MUST NOT be present. The
%% Failed-AVP AVP MUST be included and contain a copy of the
%% offending AVP.
-%%
-unknown(#diameter_avp{is_mandatory = B} = Avp, {Rec, Failed}) ->
- {Rec, [{if B -> 5001; true -> 5008 end, Avp} | Failed]}.
%% pack/4
@@ -386,23 +376,29 @@ value('AVP', Avp) ->
value(_, Avp) ->
Avp#diameter_avp.value.
-%%% ---------------------------------------------------------------------------
-%%% # grouped_avp/3
-%%% ---------------------------------------------------------------------------
+%% ---------------------------------------------------------------------------
+%% # grouped_avp/3
+%% ---------------------------------------------------------------------------
+
+-spec grouped_avp(decode, avp_name(), binary())
+ -> {avp_record(), [avp()]};
+ (encode, avp_name(), avp_record() | avp_values())
+ -> binary()
+ | no_return().
grouped_avp(decode, Name, Data) ->
{Rec, Avps, []} = decode_avps(Name, diameter_codec:collect_avps(Data)),
{Rec, Avps};
-%% Note that a failed match here will result in 5004. Note that this is
-%% the only AVP type that doesn't just return the decoded value, also
-%% returning the list of component #diameter_avp{}'s.
+%% A failed match here will result in 5004. Note that this is the only
+%% AVP type that doesn't just return the decoded record, also
+%% returning the list of component AVP's.
grouped_avp(encode, Name, Data) ->
encode_avps(Name, Data).
-%%% ---------------------------------------------------------------------------
-%%% # empty_group/1
-%%% ---------------------------------------------------------------------------
+%% ---------------------------------------------------------------------------
+%% # empty_group/1
+%% ---------------------------------------------------------------------------
empty_group(Name) ->
list_to_binary(empty_body(Name)).
@@ -423,9 +419,9 @@ z(Name) ->
Bin = diameter_codec:pack_avp(avp_header(Name), empty_value(Name)),
<< <<0>> || <<_>> <= Bin >>.
-%%% ---------------------------------------------------------------------------
-%%% # empty/1
-%%% ---------------------------------------------------------------------------
+%% ---------------------------------------------------------------------------
+%% # empty/1
+%% ---------------------------------------------------------------------------
empty(AvpName) ->
avp(encode, zero, AvpName).
diff --git a/lib/diameter/src/base/diameter_capx.erl b/lib/diameter/src/base/diameter_capx.erl
index 9a443fead0..4b821f5139 100644
--- a/lib/diameter/src/base/diameter_capx.erl
+++ b/lib/diameter/src/base/diameter_capx.erl
@@ -282,9 +282,26 @@ build_CEA(_, LCaps, RCaps, Dict, CEA) ->
[] ->
Dict:'#set-'({'Result-Code', ?NOSECURITY}, CEA);
[_] = IS ->
- Dict:'#set-'({'Inband-Security-Id', IS}, CEA)
+ Dict:'#set-'({'Inband-Security-Id', inband_security(IS)}, CEA)
end.
+%% Only set Inband-Security-Id if different from the default, since
+%% RFC 6733 recommends against the AVP:
+%%
+%% 6.10. Inband-Security-Id AVP
+%%
+%% The Inband-Security-Id AVP (AVP Code 299) is of type Unsigned32 and
+%% is used in order to advertise support of the security portion of the
+%% application. The use of this AVP in CER and CEA messages is NOT
+%% RECOMMENDED. Instead, discovery of a Diameter entity's security
+%% capabilities can be done either through static configuration or via
+%% Diameter Peer Discovery as described in Section 5.2.
+
+inband_security([?NO_INBAND_SECURITY]) ->
+ [];
+inband_security([_] = IS) ->
+ IS.
+
%% common_security/2
common_security(#diameter_caps{inband_security_id = LS},
diff --git a/lib/diameter/src/base/diameter_codec.erl b/lib/diameter/src/base/diameter_codec.erl
index e446a0209c..6c0e73de36 100644
--- a/lib/diameter/src/base/diameter_codec.erl
+++ b/lib/diameter/src/base/diameter_codec.erl
@@ -38,6 +38,10 @@
-define(MASK(N,I), ((I) band (1 bsl (N)))).
+-type u32() :: 0..16#FFFFFFFF.
+-type u24() :: 0..16#FFFFFF.
+-type u1() :: 0..1.
+
%% 0 1 2 3
%% 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1
%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
@@ -55,9 +59,13 @@
%% +-+-+-+-+-+-+-+-+-+-+-+-+-
%%% ---------------------------------------------------------------------------
-%%% # encode/[2-4]
+%%% # encode/2
%%% ---------------------------------------------------------------------------
+-spec encode(module(), Msg :: term())
+ -> #diameter_packet{}
+ | no_return().
+
encode(Mod, #diameter_packet{} = Pkt) ->
try
e(Mod, Pkt)
@@ -217,6 +225,9 @@ rec2msg(Mod, Rec) ->
%% Unsuccessfully decoded AVPs will be placed in #diameter_packet.errors.
+-spec decode(module(), #diameter_packet{} | bitstring())
+ -> #diameter_packet{}.
+
decode(Mod, Pkt) ->
decode(Mod:id(), Mod, Pkt).
@@ -225,9 +236,9 @@ decode(Mod, Pkt) ->
%% question.
decode(?APP_ID_RELAY, _, #diameter_packet{} = Pkt) ->
case collect_avps(Pkt) of
- {Bs, As} ->
+ {E, As} ->
Pkt#diameter_packet{avps = As,
- errors = [Bs]};
+ errors = [E]};
As ->
Pkt#diameter_packet{avps = As}
end;
@@ -251,12 +262,12 @@ decode(Id, Mod, Bin)
when is_bitstring(Bin) ->
decode(Id, Mod, #diameter_packet{header = decode_header(Bin), bin = Bin}).
-decode_avps(MsgName, Mod, Pkt, {Bs, Avps}) -> %% invalid avp bits ...
+decode_avps(MsgName, Mod, Pkt, {E, Avps}) ->
?LOG(invalid, Pkt#diameter_packet.bin),
#diameter_packet{errors = Failed}
= P
= decode_avps(MsgName, Mod, Pkt, Avps),
- P#diameter_packet{errors = [Bs | Failed]};
+ P#diameter_packet{errors = [E | Failed]};
decode_avps('', Mod, Pkt, Avps) -> %% unknown message ...
?LOG(unknown, {Mod, Pkt#diameter_packet.header}),
@@ -275,6 +286,10 @@ decode_avps(MsgName, Mod, Pkt, Avps) -> %% ... or not
%%% # decode_header/1
%%% ---------------------------------------------------------------------------
+-spec decode_header(bitstring())
+ -> #diameter_header{}
+ | false.
+
decode_header(<<Version:8,
MsgLength:24,
CmdFlags:1/binary,
@@ -324,6 +339,13 @@ decode_header(_) ->
%% wraparound counter. The 8-bit counter is incremented each time the
%% system is restarted.
+-spec sequence_numbers(#diameter_packet{}
+ | #diameter_header{}
+ | binary()
+ | Seq)
+ -> Seq
+ when Seq :: {HopByHopId :: u32(), EndToEndId :: u32()}.
+
sequence_numbers({_,_} = T) ->
T;
@@ -345,6 +367,9 @@ sequence_numbers(<<_:12/binary, H:32, E:32, _/binary>>) ->
%%% # hop_by_hop_id/2
%%% ---------------------------------------------------------------------------
+-spec hop_by_hop_id(u32(), binary())
+ -> binary().
+
hop_by_hop_id(Id, <<H:12/binary, _:32, T/binary>>) ->
<<H/binary, Id:32, T/binary>>.
@@ -352,6 +377,10 @@ hop_by_hop_id(Id, <<H:12/binary, _:32, T/binary>>) ->
%%% # msg_name/2
%%% ---------------------------------------------------------------------------
+-spec msg_name(module(), #diameter_header{})
+ -> atom()
+ | {ApplicationId :: u32(), CommandCode :: u24(), Rbit :: u1()}.
+
msg_name(Dict0, #diameter_header{application_id = ?APP_ID_COMMON,
cmd_code = C,
is_request = R}) ->
@@ -367,6 +396,9 @@ msg_name(_, Hdr) ->
%%% # msg_id/1
%%% ---------------------------------------------------------------------------
+-spec msg_id(#diameter_packet{} | #diameter_header{})
+ -> {ApplicationId :: u32(), CommandCode :: u24(), Rbit :: u1()}.
+
msg_id(#diameter_packet{msg = [#diameter_header{} = Hdr | _]}) ->
msg_id(Hdr);
@@ -389,6 +421,12 @@ msg_id(<<_:32, Rbit:1, _:7, CmdCode:24, ApplId:32, _/bitstring>>) ->
%% order in the binary. Note also that grouped avp's aren't unraveled,
%% only those at the top level.
+-spec collect_avps(#diameter_packet{} | bitstring())
+ -> [Avp]
+ | {Error, [Avp]}
+ when Avp :: #diameter_avp{},
+ Error :: {5014, #diameter_avp{}}.
+
collect_avps(#diameter_packet{bin = Bin}) ->
<<_:20/binary, Avps/bitstring>> = Bin,
collect_avps(Avps);
@@ -403,8 +441,8 @@ collect_avps(Bin, N, Acc) ->
{Rest, AVP} ->
collect_avps(Rest, N+1, [AVP#diameter_avp{index = N} | Acc])
catch
- ?FAILURE(_) ->
- {Bin, Acc}
+ ?FAILURE(Error) ->
+ {Error, Acc}
end.
%% 0 1 2 3
@@ -422,42 +460,87 @@ collect_avps(Bin, N, Acc) ->
%% split_avp/1
split_avp(Bin) ->
- 8 =< size(Bin) orelse ?THROW(truncated_header),
+ {Code, V, M, P, Len, HdrLen} = split_head(Bin),
+ {Data, B} = split_data(Bin, HdrLen, Len - HdrLen),
- <<Code:32, Flags:1/binary, Length:24, Rest/bitstring>>
- = Bin,
+ {B, #diameter_avp{code = Code,
+ vendor_id = V,
+ is_mandatory = 1 == M,
+ need_encryption = 1 == P,
+ data = Data}}.
- DataSize = Length - 8, % size(Code+Flags+Length) = 8 octets
- PadSize = (4 - (DataSize rem 4)) rem 4,
+%% split_head/1
- DataSize + PadSize =< size(Rest)
- orelse ?THROW(truncated_data),
+split_head(<<Code:32, 1:1, M:1, P:1, _:5, Len:24, V:32, _/bitstring>>) ->
+ {Code, V, M, P, Len, 12};
- <<Data:DataSize/binary, _:PadSize/binary, R/bitstring>>
- = Rest,
- <<Vbit:1, Mbit:1, Pbit:1, _Reserved:5>>
- = Flags,
+split_head(<<Code:32, 0:1, M:1, P:1, _:5, Len:24, _/bitstring>>) ->
+ {Code, undefined, M, P, Len, 8};
- 0 == Vbit orelse 4 =< size(Data)
- orelse ?THROW(truncated_vendor_id),
+split_head(Bin) ->
+ ?THROW({5014, #diameter_avp{data = Bin}}).
+
+%% 3588:
+%%
+%% DIAMETER_INVALID_AVP_LENGTH 5014
+%% The request contained an AVP with an invalid length. A Diameter
+%% message indicating this error MUST include the offending AVPs
+%% within a Failed-AVP AVP.
- {Vid, D} = vid(Vbit, Data),
- {R, #diameter_avp{code = Code,
- vendor_id = Vid,
- is_mandatory = 1 == Mbit,
- need_encryption = 1 == Pbit,
- data = D}}.
+%% 6733:
+%%
+%% DIAMETER_INVALID_AVP_LENGTH 5014
+%%
+%% The request contained an AVP with an invalid length. A Diameter
+%% message indicating this error MUST include the offending AVPs
+%% within a Failed-AVP AVP. In cases where the erroneous AVP length
+%% value exceeds the message length or is less than the minimum AVP
+%% ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+%% header length, it is sufficient to include the offending AVP
+%% ^^^^^^^^^^^^^
+%% header and a zero filled payload of the minimum required length
+%% for the payloads data type. If the AVP is a Grouped AVP, the
+%% Grouped AVP header with an empty payload would be sufficient to
+%% indicate the offending AVP. In the case where the offending AVP
+%% header cannot be fully decoded when the AVP length is less than
+%% the minimum AVP header length, it is sufficient to include an
+%% offending AVP header that is formulated by padding the incomplete
+%% AVP header with zero up to the minimum AVP header length.
+%%
+%% The underlined clause must be in error since (1) a header less than
+%% the minimum value mean we don't know the identity of the AVP and
+%% (2) the last sentence covers this case.
-%% The RFC is a little misleading when stating that OctetString is
-%% padded to a 32-bit boundary while other types align naturally. All
-%% other types are already multiples of 32 bits so there's no need to
-%% distinguish between types here. Any invalid lengths will result in
-%% decode error in diameter_types.
+%% split_data/3
-vid(1, <<Vid:32, Data/bitstring>>) ->
- {Vid, Data};
-vid(0, Data) ->
- {undefined, Data}.
+split_data(Bin, HdrLen, Len)
+ when 0 =< Len ->
+ split_data(Bin, HdrLen, Len, (4 - (Len rem 4)) rem 4);
+
+split_data(_, _, _) ->
+ invalid_avp_length().
+
+%% split_data/4
+
+split_data(Bin, HdrLen, Len, Pad) ->
+ <<_:HdrLen/binary, T/bitstring>> = Bin,
+ case T of
+ <<Data:Len/binary, _:Pad/binary, Rest/bitstring>> ->
+ {Data, Rest};
+ _ ->
+ invalid_avp_length()
+ end.
+
+%% invalid_avp_length/0
+%%
+%% AVP Length doesn't mesh with payload. Induce a decode error by
+%% returning a payload that no valid Diameter type can have. This is
+%% so that a known AVP will result in 5014 error with a zero'd
+%% payload. Here we simply don't know how to construct this payload.
+%% (Yes, this solution is an afterthought.)
+
+invalid_avp_length() ->
+ {<<0:1>>, <<>>}.
%%% ---------------------------------------------------------------------------
%%% # pack_avp/1
@@ -472,20 +555,35 @@ vid(0, Data) ->
pack_avp(#diameter_avp{data = [#diameter_avp{} | _] = Avps} = A) ->
pack_avp(A#diameter_avp{data = encode_avps(Avps)});
-%% ... data as a type/value tuple, possibly with header data, ...
+%% ... data as a type/value tuple ...
pack_avp(#diameter_avp{data = {Type, Value}} = A)
when is_atom(Type) ->
pack_avp(A#diameter_avp{data = diameter_types:Type(encode, Value)});
+
+%% ... with a header in various forms ...
pack_avp(#diameter_avp{data = {{_,_,_} = T, {Type, Value}}}) ->
pack_avp(T, iolist_to_binary(diameter_types:Type(encode, Value)));
+
pack_avp(#diameter_avp{data = {{_,_,_} = T, Bin}})
when is_binary(Bin) ->
pack_avp(T, Bin);
+
pack_avp(#diameter_avp{data = {Dict, Name, Value}} = A) ->
{Code, _Flags, Vid} = Hdr = Dict:avp_header(Name),
{Name, Type} = Dict:avp_name(Code, Vid),
pack_avp(A#diameter_avp{data = {Hdr, {Type, Value}}});
+pack_avp(#diameter_avp{code = undefined, data = Bin})
+ when is_binary(Bin) ->
+ %% Reset the AVP Length of an AVP Header resulting from a 5014
+ %% error. The RFC doesn't explicitly say to do this but the
+ %% receiver can't correctly extract this and following AVP's
+ %% without a correct length. On the downside, the header doesn't
+ %% reveal if the received header has been padded.
+ Pad = 8*header_length(Bin) - bit_size(Bin),
+ Len = size(<<H:5/binary, _:24, T/binary>> = <<Bin/bitstring, 0:Pad>>),
+ <<H/binary, Len:24, T/binary>>;
+
%% ... or as an iolist.
pack_avp(#diameter_avp{code = Code,
vendor_id = V,
@@ -497,6 +595,11 @@ pack_avp(#diameter_avp{code = Code,
{P, 2#00100000}]),
pack_avp({Code, Flags, V}, iolist_to_binary(Data)).
+header_length(<<_:32, 1:1, _/bitstring>>) ->
+ 12;
+header_length(_) ->
+ 8.
+
flag_avp({true, B}, F) ->
F bor B;
flag_avp({false, _}, F) ->
diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl
index 6be4259510..4e55864168 100644
--- a/lib/diameter/src/base/diameter_peer_fsm.erl
+++ b/lib/diameter/src/base/diameter_peer_fsm.erl
@@ -233,20 +233,21 @@ start_transport(Addrs0, T) ->
{TPid, Addrs, Tmo, Data} ->
erlang:monitor(process, TPid),
q_next(TPid, Addrs0, Tmo, Data),
- {TPid, addrs(Addrs, Addrs0)};
+ {TPid, Addrs};
No ->
exit({shutdown, No})
end.
-addrs([], Addrs0) ->
- Addrs0;
-addrs(Addrs, _) ->
- Addrs.
-
-svc(Svc, []) ->
- Svc;
-svc(Svc, Addrs) ->
- readdr(Svc, Addrs).
+svc(#diameter_service{capabilities = LCaps0} = Svc, Addrs) ->
+ #diameter_caps{host_ip_address = Addrs0}
+ = LCaps0,
+ case Addrs0 of
+ [] ->
+ LCaps = LCaps0#diameter_caps{host_ip_address = Addrs},
+ Svc#diameter_service{capabilities = LCaps};
+ [_|_] ->
+ Svc
+ end.
readdr(#diameter_service{capabilities = LCaps0} = Svc, Addrs) ->
LCaps = LCaps0#diameter_caps{host_ip_address = Addrs},
@@ -360,7 +361,7 @@ transition({diameter, {TPid, connected, Remote, LAddrs}},
service = Svc}
= S) ->
transition({diameter, {TPid, connected, Remote}},
- S#state{service = readdr(Svc, LAddrs)});
+ S#state{service = svc(Svc, LAddrs)});
%% Connection from peer.
transition({diameter, {TPid, connected}},
@@ -702,13 +703,13 @@ build_answer('CER',
N -> {cea(CEA, N, Dict0), [fun open/5, Pkt,
SupportedApps,
Caps,
- {accept, hd([_] = IS)}]}
+ {accept, inband_security(IS)}]}
catch
?FAILURE(Reason) ->
rejected(Reason, {'CER', Reason, Caps, Pkt}, S)
end;
-%% The error checks below are similar to those in diameter_service for
+%% The error checks below are similar to those in diameter_traffic for
%% other messages. Should factor out the commonality.
build_answer(Type,
@@ -719,6 +720,11 @@ build_answer(Type,
RC = rc(H, Es),
{answer(Type, RC, Es, S), post(Type, RC, Pkt, S)}.
+inband_security([]) ->
+ ?NO_INBAND_SECURITY;
+inband_security([IS]) ->
+ IS.
+
cea(CEA, ok, _) ->
CEA;
cea(CEA, 2001, _) ->
@@ -742,7 +748,14 @@ rejected(N, T, S) ->
rejected({N, []}, T, S).
answer(Type, RC, Es, S) ->
- set(answer(Type, RC, S), failed_avp([A || {_,A} <- Es])).
+ set(answer(Type, RC, S), failed_avp(RC, Es)).
+
+failed_avp(RC, [{RC, Avp} | _]) ->
+ [{'Failed-AVP', [{'AVP', [Avp]}]}];
+failed_avp(RC, [_ | Es]) ->
+ failed_avp(RC, Es);
+failed_avp(_, [] = No) ->
+ No.
answer(Type, RC, S) ->
answer_message(answer(Type, S), RC).
@@ -762,13 +775,6 @@ is_origin({N, _}) ->
orelse N == 'Origin-Realm'
orelse N == 'Origin-State-Id'.
-%% failed_avp/1
-
-failed_avp([] = No) ->
- No;
-failed_avp(Avps) ->
- [{'Failed-AVP', [[{'AVP', Avps}]]}].
-
%% set/2
set(Ans, []) ->
@@ -784,7 +790,7 @@ rc(#diameter_header{is_error = true}, _) ->
3008; %% DIAMETER_INVALID_HDR_BITS
rc(_, [Bs|_])
- when is_bitstring(Bs) ->
+ when is_bitstring(Bs) -> %% from old code
3009; %% DIAMETER_INVALID_HDR_BITS
rc(#diameter_header{version = ?DIAMETER_VERSION}, Es) ->
diff --git a/lib/diameter/src/base/diameter_traffic.erl b/lib/diameter/src/base/diameter_traffic.erl
index 25b902e3f2..0b15e68ec7 100644
--- a/lib/diameter/src/base/diameter_traffic.erl
+++ b/lib/diameter/src/base/diameter_traffic.erl
@@ -226,10 +226,10 @@ recv_R(false = No, _, _, _, _) -> %% transport has gone down
collect_avps(Pkt) ->
case diameter_codec:collect_avps(Pkt) of
- {_Bs, As} ->
- As;
- As ->
- As
+ {_Error, Avps} ->
+ Avps;
+ Avps ->
+ Avps
end.
%% recv_R/6
@@ -300,7 +300,7 @@ errors(_, #diameter_packet{header = #diameter_header{version = V},
%% AVP's definition.
errors(_, #diameter_packet{errors = [Bs | Es]} = Pkt)
- when is_bitstring(Bs) ->
+ when is_bitstring(Bs) -> %% from old code
Pkt#diameter_packet{errors = [3009 | Es]};
%% DIAMETER_COMMAND_UNSUPPORTED 3001
@@ -479,10 +479,9 @@ answer_message(RC,
#diameter_caps{origin_host = {OH,_},
origin_realm = {OR,_}},
Dict0,
- #diameter_packet{avps = Avps}
- = Pkt) ->
+ Pkt) ->
?LOG({error, RC}, Pkt),
- {Dict0, answer_message(OH, OR, RC, Dict0, Avps)}.
+ {Dict0, answer_message(OH, OR, RC, Dict0, Pkt)}.
%% resend/7
@@ -595,71 +594,87 @@ reply([Msg], Dict, TPid, Dict0, Fs, ReqPkt)
is_tuple(Msg) ->
reply(Msg, Dict, TPid, Dict0, Fs, ReqPkt#diameter_packet{errors = []});
-%% No errors or a diameter_header/avp list.
reply(Msg, Dict, TPid, Dict0, Fs, ReqPkt) ->
- Pkt = encode(Dict, reset(make_answer_packet(Msg, ReqPkt), Dict), Fs),
+ Pkt = encode(Dict,
+ reset(make_answer_packet(Msg, ReqPkt), Dict, Dict0),
+ Fs),
incr(send, Pkt, Dict, TPid, Dict0), %% count outgoing result codes
send(TPid, Pkt).
-%% reset/2
+%% reset/3
%% Header/avps list: send as is.
-reset(#diameter_packet{msg = [#diameter_header{} | _]} = Pkt, _) ->
+reset(#diameter_packet{msg = [#diameter_header{} | _]} = Pkt, _, _) ->
Pkt;
%% No errors to set or errors explicitly ignored.
-reset(#diameter_packet{errors = Es} = Pkt, _)
+reset(#diameter_packet{errors = Es} = Pkt, _, _)
when Es == [];
Es == false ->
Pkt;
%% Otherwise possibly set Result-Code and/or Failed-AVP.
-reset(#diameter_packet{msg = Msg, errors = Es} = Pkt, Dict) ->
- Pkt#diameter_packet{msg = reset(Msg, Dict, Es)}.
-
-%% reset/3
-
-reset(Msg, Dict, Es)
- when is_list(Es) ->
- {E3, E5, Fs} = partition(Es),
- FailedAVP = failed_avp(Msg, lists:reverse(Fs), Dict),
- reset(set(Msg, FailedAVP, Dict),
- Dict,
- choose(is_answer_message(Msg, Dict), E3, E5));
-
-reset(Msg, Dict, N)
- when is_integer(N) ->
- ResultCode = rc(Msg, {'Result-Code', N}, Dict),
- set(Msg, ResultCode, Dict);
-
-reset(Msg, _, _) ->
- Msg.
+reset(#diameter_packet{msg = Msg, errors = Es} = Pkt, Dict, Dict0) ->
+ {RC, Failed} = select_error(Msg, Es, Dict0),
+ Pkt#diameter_packet{msg = reset(Msg, Dict, RC, Failed)}.
-partition(Es) ->
- lists:foldl(fun pacc/2, {false, false, []}, Es).
-
-%% Note that the errors list can contain not only integer() and
-%% {integer(), #diameter_avp{}} but also #diameter_avp{}. The latter
-%% isn't something that's returned by decode but can be set in a reply
-%% for encode.
+%% select_error/3
+%%
+%% Extract the first appropriate RC or {RC, #diameter_avp{}}
+%% pair from an errors list, and accumulate all #diameter_avp{}.
+%%
+%% RFC 6733:
+%%
+%% 7.5. Failed-AVP AVP
+%%
+%% The Failed-AVP AVP (AVP Code 279) is of type Grouped and provides
+%% debugging information in cases where a request is rejected or not
+%% fully processed due to erroneous information in a specific AVP. The
+%% value of the Result-Code AVP will provide information on the reason
+%% for the Failed-AVP AVP. A Diameter answer message SHOULD contain an
+%% instance of the Failed-AVP AVP that corresponds to the error
+%% indicated by the Result-Code AVP. For practical purposes, this
+%% Failed-AVP would typically refer to the first AVP processing error
+%% that a Diameter node encounters.
+
+select_error(Msg, Es, Dict0) ->
+ {RC, Avps} = lists:foldl(fun(T,A) -> select(T, A, Dict0) end,
+ {is_answer_message(Msg, Dict0), []},
+ Es),
+ {RC, lists:reverse(Avps)}.
+
+%% Only integer() and {integer(), #diameter_avp{}} are the result of
+%% decode. #diameter_avp{} can only be set in a reply for encode.
+
+select(#diameter_avp{} = A, {RC, As}, _) ->
+ {RC, [A|As]};
+
+select(_, {RC, _} = Acc, _)
+ when is_integer(RC) ->
+ Acc;
-pacc({RC, #diameter_avp{} = A}, {E3, E5, Acc})
+select({RC, #diameter_avp{} = A}, {IsAns, As} = Acc, Dict0)
when is_integer(RC) ->
- pacc(RC, {E3, E5, [A|Acc]});
+ case is_result(RC, IsAns, Dict0) of
+ true -> {RC, [A|As]};
+ false -> Acc
+ end;
-pacc(#diameter_avp{} = A, {E3, E5, Acc}) ->
- {E3, E5, [A|Acc]};
+select(RC, {IsAns, As} = Acc, Dict0)
+ when is_boolean(IsAns), is_integer(RC) ->
+ case is_result(RC, IsAns, Dict0) of
+ true -> {RC, As};
+ false -> Acc
+ end.
-pacc(RC, {false, E5, Acc})
- when 3 == RC div 1000 ->
- {RC, E5, Acc};
+%% reset/4
-pacc(RC, {E3, false, Acc})
- when 5 == RC div 1000 ->
- {E3, RC, Acc};
+reset(Msg, Dict, RC, Avps) ->
+ FailedAVP = failed_avp(Msg, Avps, Dict),
+ ResultCode = rc(Msg, RC, Dict),
+ set(set(Msg, FailedAVP, Dict), ResultCode, Dict).
-pacc(_, Acc) ->
- Acc.
+%% eval_packet/2
eval_packet(Pkt, Fs) ->
lists:foreach(fun(F) -> diameter_lib:eval([F,Pkt]) end, Fs).
@@ -725,29 +740,34 @@ set(Rec, Avps, Dict) ->
%% the arity is 1 or {0,1}. In other cases (which probably shouldn't
%% exist in practise) we can't know what's appropriate.
-rc([MsgName | _], {'Result-Code' = K, RC} = T, Dict) ->
- case Dict:avp_arity(MsgName, 'Result-Code') of
- 1 -> [T];
+rc(_, B, _)
+ when is_boolean(B) ->
+ [];
+
+rc([MsgName | _], RC, Dict) ->
+ K = 'Result-Code',
+ case Dict:avp_arity(MsgName, K) of
+ 1 -> [{K, RC}];
{0,1} -> [{K, [RC]}];
_ -> []
end;
-rc(Rec, T, Dict) ->
- rc([Dict:rec2msg(element(1, Rec))], T, Dict).
+rc(Rec, RC, Dict) ->
+ rc([Dict:rec2msg(element(1, Rec))], RC, Dict).
%% failed_avp/3
failed_avp(_, [] = No, _) ->
No;
-failed_avp(Rec, Failed, Dict) ->
- [fa(Rec, [{'AVP', Failed}], Dict)].
+failed_avp(Rec, Avps, Dict) ->
+ [failed(Rec, [{'AVP', Avps}], Dict)].
%% Reply as name and tuple list ...
-fa([MsgName | Values], FailedAvp, Dict) ->
- R = Dict:msg2rec(MsgName),
+failed([MsgName | Values], FailedAvp, Dict) ->
+ RecName = Dict:msg2rec(MsgName),
try
- Dict:'#info-'(R, {index, 'Failed-AVP'}),
+ Dict:'#info-'(RecName, {index, 'Failed-AVP'}),
{'Failed-AVP', [FailedAvp]}
catch
error: _ ->
@@ -758,8 +778,10 @@ fa([MsgName | Values], FailedAvp, Dict) ->
end;
%% ... or record.
-fa(Rec, FailedAvp, Dict) ->
+failed(Rec, FailedAvp, Dict) ->
try
+ RecName = element(1, Rec),
+ Dict:'#info-'(RecName, {index, 'Failed-AVP'}),
{'Failed-AVP', [FailedAvp]}
catch
error: _ ->
@@ -838,12 +860,14 @@ fa(Rec, FailedAvp, Dict) ->
%% answer_message/5
-answer_message(OH, OR, RC, Dict0, Avps) ->
+answer_message(OH, OR, RC, Dict0, #diameter_packet{avps = Avps,
+ errors = Es}) ->
{Code, _, Vid} = Dict0:avp_header('Session-Id'),
['answer-message', {'Origin-Host', OH},
{'Origin-Realm', OR},
- {'Result-Code', RC}
- | session_id(Code, Vid, Dict0, Avps)].
+ {'Result-Code', RC}]
+ ++ session_id(Code, Vid, Dict0, Avps)
+ ++ failed_avp(RC, Es).
session_id(Code, Vid, Dict0, Avps)
when is_list(Avps) ->
@@ -855,6 +879,15 @@ session_id(Code, Vid, Dict0, Avps)
[]
end.
+%% Note that this should only match 5xxx result codes currently but
+%% don't bother distinguishing this case.
+failed_avp(RC, [{RC, Avp} | _]) ->
+ [{'Failed-AVP', [{'AVP', [Avp]}]}];
+failed_avp(RC, [_ | Es]) ->
+ failed_avp(RC, Es);
+failed_avp(_, [] = No) ->
+ No.
+
%% find_avp/3
find_avp(Code, Vid, Avps)
diff --git a/lib/diameter/src/base/diameter_watchdog.erl b/lib/diameter/src/base/diameter_watchdog.erl
index 41c493ff20..88ccf630e2 100644
--- a/lib/diameter/src/base/diameter_watchdog.erl
+++ b/lib/diameter/src/base/diameter_watchdog.erl
@@ -505,7 +505,9 @@ set_watchdog(#watchdog{tw = TwInit,
tref = TRef}
= S) ->
cancel(TRef),
- S#watchdog{tref = erlang:start_timer(tw(TwInit), self(), tw)}.
+ S#watchdog{tref = erlang:start_timer(tw(TwInit), self(), tw)};
+set_watchdog(stop = No) ->
+ No.
cancel(undefined) ->
ok;
diff --git a/lib/diameter/src/compiler/diameter_codegen.erl b/lib/diameter/src/compiler/diameter_codegen.erl
index 80036879ea..e687145263 100644
--- a/lib/diameter/src/compiler/diameter_codegen.erl
+++ b/lib/diameter/src/compiler/diameter_codegen.erl
@@ -574,12 +574,12 @@ cs_enumerated_avp({AvpName, Values}) ->
lists:flatmap(fun(V) -> c_enumerated_avp(AvpName, V) end, Values).
c_enumerated_avp(AvpName, {_,I}) ->
- [{?clause, [?ATOM(decode), ?Atom(AvpName), ?TERM(<<I:32/integer>>)],
+ [{?clause, [?ATOM(decode), ?Atom(AvpName), ?TERM(<<I:32>>)],
[],
[?TERM(I)]},
{?clause, [?ATOM(encode), ?Atom(AvpName), ?INTEGER(I)],
[],
- [?TERM(<<I:32/integer>>)]}].
+ [?TERM(<<I:32>>)]}].
%%% ------------------------------------------------------------------------
%%% msg_header/1
@@ -700,7 +700,7 @@ c_empty_value({Name, _, _, _}) ->
c_empty_value({Name, _}) ->
{?clause, [?Atom(Name)],
[],
- [?TERM(<<0:32/integer>>)]}.
+ [?TERM(<<0:32>>)]}.
%%% ------------------------------------------------------------------------
%%% # dict/0
diff --git a/lib/diameter/test/diameter_3xxx_SUITE.erl b/lib/diameter/test/diameter_3xxx_SUITE.erl
index 89c78d8b57..071b1a1177 100644
--- a/lib/diameter/test/diameter_3xxx_SUITE.erl
+++ b/lib/diameter/test/diameter_3xxx_SUITE.erl
@@ -40,9 +40,10 @@
send_unknown_application/1,
send_unknown_command/1,
send_ok/1,
- send_invalid_avp_bits/1,
+ send_invalid_hdr_bits/1,
send_missing_avp/1,
send_ignore_missing_avp/1,
+ send_5xxx_missing_avp/1,
send_double_error/1,
send_3xxx/1,
send_5xxx/1,
@@ -136,9 +137,10 @@ tc() ->
[send_unknown_application,
send_unknown_command,
send_ok,
- send_invalid_avp_bits,
+ send_invalid_hdr_bits,
send_missing_avp,
send_ignore_missing_avp,
+ send_5xxx_missing_avp,
send_double_error,
send_3xxx,
send_5xxx].
@@ -216,27 +218,26 @@ send_ok([_,_]) ->
send_ok(Config) ->
send_ok(?group(Config)).
-%% send_invalid_avp_bits/1
+%% send_invalid_hdr_bits/1
%%
-%% Send a request with an incorrect length on the optional
-%% Origin-State-Id that a callback ignores.
+%% Send a request with an incorrect E-bit that a callback ignores.
%% Callback answers.
-send_invalid_avp_bits([callback, _]) ->
+send_invalid_hdr_bits([callback, _]) ->
#diameter_base_STA{'Result-Code' = 2001, %% SUCCESS
'Failed-AVP' = [],
'AVP' = []}
= call();
%% diameter answers.
-send_invalid_avp_bits([_,_]) ->
- #'diameter_base_answer-message'{'Result-Code' = 3009, %% INVALID_AVP_BITS
+send_invalid_hdr_bits([_,_]) ->
+ #'diameter_base_answer-message'{'Result-Code' = 3008, %% INVALID_HDR_BITS
'Failed-AVP' = [],
'AVP' = []}
= call();
-send_invalid_avp_bits(Config) ->
- send_invalid_avp_bits(?group(Config)).
+send_invalid_hdr_bits(Config) ->
+ send_invalid_hdr_bits(?group(Config)).
%% send_missing_avp/1
%%
@@ -280,10 +281,35 @@ send_ignore_missing_avp([_,_]) ->
send_ignore_missing_avp(Config) ->
send_ignore_missing_avp(?group(Config)).
+%% send_5xxx_missing_avp/1
+%%
+%% Send a request with a missing AVP that a callback answers
+%% with {answer_message, 5005}.
+
+%% RFC 6733 allows 5xxx in an answer-message.
+send_5xxx_missing_avp([_, rfc6733]) ->
+ #'diameter_base_answer-message'{'Result-Code' = 5005, %% MISSING_AVP
+ 'Failed-AVP' = [_],
+ 'AVP' = []}
+ = call();
+
+%% RFC 3588 doesn't: sending answer fails.
+send_5xxx_missing_avp([_, rfc3588]) ->
+ {error, timeout} = call();
+
+%% Callback answers, ignores the error
+send_5xxx_missing_avp([_,_]) ->
+ #diameter_base_STA{'Result-Code' = 2001, %% SUCCESS
+ 'Failed-AVP' = [],
+ 'AVP' = []}
+ = call();
+
+send_5xxx_missing_avp(Config) ->
+ send_5xxx_missing_avp(?group(Config)).
+
%% send_double_error/1
%%
-%% Send a request with both an incorrect length on the optional
-%% Origin-State-Id and a missing AVP.
+%% Send a request with both an invalid E-bit and a missing AVP.
%% Callback answers with STA.
send_double_error([callback, _]) ->
@@ -294,8 +320,8 @@ send_double_error([callback, _]) ->
%% diameter answers with answer-message.
send_double_error([_,_]) ->
- #'diameter_base_answer-message'{'Result-Code' = 3009, %% INVALID_AVP_BITS
- 'Failed-AVP' = [_],
+ #'diameter_base_answer-message'{'Result-Code' = 3008, %% INVALID_HDR_BITS
+ 'Failed-AVP' = [],
'AVP' = []}
= call();
@@ -392,24 +418,21 @@ prepare(Pkt, Caps, T)
T == send_5xxx ->
sta(Pkt, Caps);
-prepare(Pkt0, Caps, send_invalid_avp_bits) ->
- Req0 = sta(Pkt0, Caps),
- %% Append an Origin-State-Id with an incorrect AVP Length in order
- %% to force 3009.
- Req = Req0#diameter_base_STR{'Origin-State-Id' = [7]},
- #diameter_packet{bin = Bin}
+prepare(Pkt0, Caps, send_invalid_hdr_bits) ->
+ Req = sta(Pkt0, Caps),
+ %% Set the E-bit to force 3008.
+ #diameter_packet{bin = <<H:34, 0:1, T/bitstring>>}
= Pkt
= diameter_codec:encode(?DICT, Pkt0#diameter_packet{msg = Req}),
- Offset = size(Bin) - 12 + 5,
- <<H:Offset/binary, Len:24, T/binary>> = Bin,
- Pkt#diameter_packet{bin = <<H/binary, (Len + 2):24, T/binary>>};
+ Pkt#diameter_packet{bin = <<H:34, 1:1, T/bitstring>>};
prepare(Pkt0, Caps, send_double_error) ->
- dehost(prepare(Pkt0, Caps, send_invalid_avp_bits));
+ dehost(prepare(Pkt0, Caps, send_invalid_hdr_bits));
prepare(Pkt, Caps, T)
when T == send_missing_avp;
- T == send_ignore_missing_avp ->
+ T == send_ignore_missing_avp;
+ T == send_5xxx_missing_avp ->
Req = sta(Pkt, Caps),
dehost(diameter_codec:encode(?DICT, Pkt#diameter_packet{msg = Req})).
@@ -480,9 +503,7 @@ request(send_3xxx, _Req, _Caps) ->
request(send_5xxx, _Req, _Caps) ->
{answer_message, 5999};
-request(send_invalid_avp_bits, Req, Caps) ->
- #diameter_base_STR{'Origin-State-Id' = []}
- = Req,
+request(send_invalid_hdr_bits, Req, Caps) ->
%% Default errors field but a non-answer-message and only 3xxx
%% errors detected means diameter sets neither Result-Code nor
%% Failed-AVP.
@@ -495,7 +516,10 @@ request(T, Req, Caps)
request(send_ignore_missing_avp, Req, Caps) ->
{reply, #diameter_packet{msg = answer(Req, Caps),
- errors = false}}. %% ignore errors
+ errors = false}}; %% ignore errors
+
+request(send_5xxx_missing_avp, _Req, _Caps) ->
+ {answer_message, 5005}. %% MISSING_AVP
answer(Req, Caps) ->
#diameter_base_STR{'Session-Id' = SId}
diff --git a/lib/diameter/test/diameter_app_SUITE.erl b/lib/diameter/test/diameter_app_SUITE.erl
index 209f72adf1..1e262895a6 100644
--- a/lib/diameter/test/diameter_app_SUITE.erl
+++ b/lib/diameter/test/diameter_app_SUITE.erl
@@ -56,7 +56,7 @@
%% ===========================================================================
suite() ->
- [{timetrap, {seconds, 10}}].
+ [{timetrap, {seconds, 60}}].
all() ->
[keys,
diff --git a/lib/diameter/test/diameter_codec_SUITE_data/diameter_test_unknown.erl b/lib/diameter/test/diameter_codec_SUITE_data/diameter_test_unknown.erl
index bce3d78a37..49f2158b1a 100644
--- a/lib/diameter/test/diameter_codec_SUITE_data/diameter_test_unknown.erl
+++ b/lib/diameter/test/diameter_codec_SUITE_data/diameter_test_unknown.erl
@@ -71,6 +71,6 @@ dec('AR', #diameter_packet
dec('BR', #diameter_packet
{msg = #recv_BR{'Origin-Host' = ?HOST,
'Origin-Realm' = ?REALM},
- errors = [{5008, ?NOT_MANDATORY_YYY},
- {5001, ?MANDATORY_XXX}]}) ->
+ errors = [{5001, ?MANDATORY_XXX},
+ {5008, ?NOT_MANDATORY_YYY}]}) ->
ok.
diff --git a/lib/diameter/test/diameter_codec_test.erl b/lib/diameter/test/diameter_codec_test.erl
index 0baac59c1a..24d4c7665e 100644
--- a/lib/diameter/test/diameter_codec_test.erl
+++ b/lib/diameter/test/diameter_codec_test.erl
@@ -265,7 +265,7 @@ arity(M, Name, AvpName, Rec) ->
%% enum/3
enum(M, Name, {_,E}) ->
- B = <<E:32/integer>>,
+ B = <<E:32>>,
B = M:avp(encode, E, Name),
E = M:avp(decode, B, Name).
@@ -322,15 +322,15 @@ values('Unsigned64') ->
values('Float32') ->
E = (1 bsl 8) - 2,
F = (1 bsl 23) - 1,
- <<Mx:32/float>> = <<0:1/integer, E:8/integer, F:23/integer>>,
- <<Mn:32/float>> = <<1:1/integer, E:8/integer, F:23/integer>>,
+ <<Mx:32/float>> = <<0:1, E:8, F:23>>,
+ <<Mn:32/float>> = <<1:1, E:8, F:23>>,
{[0.0, infinity, '-infinity', Mx, Mn], [0]};
values('Float64') ->
E = (1 bsl 11) - 2,
F = (1 bsl 52) - 1,
- <<Mx:64/float>> = <<0:1/integer, E:11/integer, F:52/integer>>,
- <<Mn:64/float>> = <<1:1/integer, E:11/integer, F:52/integer>>,
+ <<Mx:64/float>> = <<0:1, E:11, F:52>>,
+ <<Mn:64/float>> = <<1:1, E:11, F:52>>,
{[0.0, infinity, '-infinity', Mx, Mn], [0]};
values('Address') ->
diff --git a/lib/diameter/test/diameter_distribution_SUITE.erl b/lib/diameter/test/diameter_distribution_SUITE.erl
index 01d3507b27..f069abbe2f 100644
--- a/lib/diameter/test/diameter_distribution_SUITE.erl
+++ b/lib/diameter/test/diameter_distribution_SUITE.erl
@@ -28,7 +28,7 @@
all/0]).
%% testcases
--export([enslave/1,
+-export([enslave/1, enslave/0,
ping/1,
start/1,
connect/1,
@@ -36,7 +36,7 @@
send_remote/1,
send_timeout/1,
send_failover/1,
- stop/1]).
+ stop/1, stop/0]).
%% diameter callbacks
-export([peer_up/3,
@@ -126,6 +126,9 @@ all() ->
%% Start four slave nodes, one to implement a Diameter server,
%% two three to implement a client.
+enslave() ->
+ [{timetrap, {seconds, 30*length(?NODES)}}].
+
enslave(Config) ->
Here = filename:dirname(code:which(?MODULE)),
Ebin = filename:join([Here, "..", "ebin"]),
@@ -225,6 +228,9 @@ connect(Config) ->
%%
%% Stop the slave nodes.
+stop() ->
+ [{timetrap, {seconds, 30*length(?NODES)}}].
+
stop(_Config) ->
[] = [{N,E} || {N,_} <- ?NODES,
{error, _, _} = E <- [ct_slave:stop(N)]].
diff --git a/lib/diameter/test/diameter_examples_SUITE.erl b/lib/diameter/test/diameter_examples_SUITE.erl
index 585fc9d3b8..1954bc319b 100644
--- a/lib/diameter/test/diameter_examples_SUITE.erl
+++ b/lib/diameter/test/diameter_examples_SUITE.erl
@@ -29,6 +29,7 @@
%% testcases
-export([dict/1, dict/0,
code/1,
+ slave/1, slave/0,
enslave/1,
start/1,
traffic/1,
@@ -65,11 +66,12 @@
%% ===========================================================================
suite() ->
- [{timetrap, {seconds, 45}}].
+ [{timetrap, {minutes, 2}}].
all() ->
[dict,
code,
+ slave,
enslave,
start,
traffic,
@@ -250,6 +252,29 @@ store(Path, Dict) ->
%% ===========================================================================
+%% slave/1
+%%
+%% Return how long slave start/stop is taking since it seems to be
+%% ridiculously long on some hosts.
+
+slave() ->
+ [{timetrap, {minutes, 10}}].
+
+slave(_) ->
+ T0 = now(),
+ {ok, Node} = ct_slave:start(?MODULE, ?TIMEOUTS),
+ T1 = now(),
+ T2 = rpc:call(Node, erlang, now, []),
+ {ok, Node} = ct_slave:stop(?MODULE),
+ now_diff([T0, T1, T2, now()]).
+
+now_diff([T1,T2|_] = Ts) ->
+ [timer:now_diff(T2,T1) | now_diff(tl(Ts))];
+now_diff(_) ->
+ [].
+
+%% ===========================================================================
+
%% enslave/1
%%
%% Start two nodes: one for the server, one for the client.
diff --git a/lib/diameter/test/diameter_gen_tcp_SUITE.erl b/lib/diameter/test/diameter_gen_tcp_SUITE.erl
new file mode 100644
index 0000000000..7e232edb44
--- /dev/null
+++ b/lib/diameter/test/diameter_gen_tcp_SUITE.erl
@@ -0,0 +1,106 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2013. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% Some gen_sctp-specific tests demonstrating problems that were
+%% encountered during diameter development but have nothing
+%% specifically to do with diameter. At least one of them can cause
+%% diameter_traffic_SUITE testcases to fail.
+%%
+
+-module(diameter_gen_tcp_SUITE).
+
+-export([suite/0,
+ all/0]).
+
+%% testcases
+-export([send_long/1]).
+
+-define(LOOPBACK, {127,0,0,1}).
+-define(GEN_OPTS, [binary, {active, true}, {ip, ?LOOPBACK}]).
+
+%% ===========================================================================
+
+suite() ->
+ [{timetrap, {minutes, 2}}].
+
+all() ->
+ [send_long].
+
+%% ===========================================================================
+
+%% send_long/1
+%%
+%% Test that a long message is received.
+
+send_long(_) ->
+ {Sock, SendF} = connection(),
+ B = list_to_binary(lists:duplicate(1 bsl 20, $X)),
+ ok = SendF(B),
+ B = recv(Sock, size(B), []).
+
+recv(_, 0, Acc) ->
+ list_to_binary(lists:reverse(Acc));
+recv(Sock, N, Acc) ->
+ receive
+ {tcp, Sock, Bin} ->
+ recv(Sock, N - size(Bin), [Bin | Acc]);
+ T ->
+ {T, Acc}
+ end.
+
+%% connection/0
+
+connection() ->
+ {ok, LSock} = gen_tcp:listen(0, ?GEN_OPTS),
+ {ok, PortNr} = inet:port(LSock),
+ LPid = self(),
+ {Pid, MRef} = spawn_monitor(fun() -> connect(PortNr, LPid) end),
+ {ok, Sock} = gen_tcp:accept(LSock),
+ receive
+ {Pid, F} ->
+ {Sock, F};
+ {'DOWN', MRef, process, _, _} = T ->
+ T
+ end.
+
+%% connect/2
+
+connect(PortNr, LPid) ->
+ {ok, Sock} = gen_tcp:connect(?LOOPBACK, PortNr, ?GEN_OPTS),
+ LPid ! {self(), fun(B) -> send(Sock, B) end},
+ down(LPid).
+
+%% down/1
+
+down(Pid)
+ when is_pid(Pid) ->
+ down(erlang:monitor(process, Pid));
+
+down(MRef) ->
+ receive {'DOWN', MRef, process, _, Reason} -> Reason end.
+
+%% send/2
+%%
+%% Send from a spawned process just to avoid sending from the
+%% receiving process, in case it's significant.
+
+send(Sock, Bin) ->
+ {_, MRef} = spawn_monitor(fun() -> exit(gen_tcp:send(Sock, Bin)) end),
+ down(MRef).
diff --git a/lib/diameter/test/diameter_tls_SUITE.erl b/lib/diameter/test/diameter_tls_SUITE.erl
index 5a79c63d36..55565692ec 100644
--- a/lib/diameter/test/diameter_tls_SUITE.erl
+++ b/lib/diameter/test/diameter_tls_SUITE.erl
@@ -181,7 +181,7 @@ start_diameter(_Config) ->
ok = diameter:start().
make_certs() ->
- [{timetrap, {seconds, 30}}].
+ [{timetrap, {minutes, 2}}].
make_certs(Config) ->
Dir = proplists:get_value(priv_dir, Config),
@@ -302,9 +302,7 @@ set([H|T], Vs) ->
disconnect({{LRef, _PortNr}, CRef}) ->
ok = diameter:remove_transport(?CLIENT, CRef),
- ok = receive #diameter_event{info = {down, LRef, _, _}} -> ok
- after 2000 -> false
- end.
+ receive #diameter_event{info = {down, LRef, _, _}} -> ok end.
realm(Host) ->
tl(lists:dropwhile(fun(C) -> C /= $. end, Host)).
@@ -365,13 +363,11 @@ ssl([{ssl_options = T, Opts}]) ->
connect(Host, {_LRef, PortNr}, {Caps, Opts}) ->
{ok, Ref} = diameter:add_transport(Host, ?CONNECT(PortNr, Caps, Opts)),
- ok = receive
- #diameter_event{service = Host,
- info = {up, Ref, _, _, #diameter_packet{}}} ->
- ok
- after 2000 ->
- false
- end,
+ receive
+ #diameter_event{service = Host,
+ info = {up, Ref, _, _, #diameter_packet{}}} ->
+ ok
+ end,
Ref.
copts(S, Opts)
diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl
index 781ed234cc..38bdf55af8 100644
--- a/lib/diameter/test/diameter_traffic_SUITE.erl
+++ b/lib/diameter/test/diameter_traffic_SUITE.erl
@@ -49,9 +49,12 @@
send_unsupported_app/1,
send_error_bit/1,
send_unsupported_version/1,
- send_invalid_avp_bits/1,
+ send_long_avp_length/1,
+ send_short_avp_length/1,
+ send_zero_avp_length/1,
send_invalid_avp_length/1,
send_invalid_reject/1,
+ send_unrecognized_mandatory/1,
send_long/1,
send_nopeer/1,
send_noapp/1,
@@ -268,9 +271,12 @@ tc() ->
send_unsupported_app,
send_error_bit,
send_unsupported_version,
- send_invalid_avp_bits,
+ send_long_avp_length,
+ send_short_avp_length,
+ send_zero_avp_length,
send_invalid_avp_length,
send_invalid_reject,
+ send_unrecognized_mandatory,
send_long,
send_nopeer,
send_noapp,
@@ -405,7 +411,7 @@ send_eval(Config) ->
send_bad_answer(Config) ->
Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD},
{'Accounting-Record-Number', 2}],
- {error, timeout} = call(Config, Req).
+ {timeout, _} = call(Config, Req).
%% Send an ACR that the server callback answers explicitly with a
%% protocol error.
@@ -416,13 +422,14 @@ send_protocol_error(Config) ->
?answer_message(?TOO_BUSY)
= call(Config, Req).
-%% Send an ASR with an arbitrary AVP and expect success and the same
-%% AVP in the reply.
+%% Send an ASR with an arbitrary non-mandatory AVP and expect success
+%% and the same AVP in the reply.
send_arbitrary(Config) ->
- Req = ['ASR', {'AVP', [#diameter_avp{name = 'Class', value = "XXX"}]}],
+ Req = ['ASR', {'AVP', [#diameter_avp{name = 'Product-Name',
+ value = "XXX"}]}],
['ASA', _SessionId, {'Result-Code', ?SUCCESS} | Avps]
= call(Config, Req),
- {'AVP', [#diameter_avp{name = 'Class',
+ {'AVP', [#diameter_avp{name = 'Product-Name',
value = "XXX"}]}
= lists:last(Avps).
@@ -455,7 +462,7 @@ send_unknown_mandatory(Config) ->
%% Send an STR that the server ignores.
send_noreply(Config) ->
Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}],
- {error, timeout} = call(Config, Req).
+ {timeout, _} = call(Config, Req).
%% Send an unsupported command and expect 3001.
send_unsupported(Config) ->
@@ -481,19 +488,33 @@ send_unsupported_version(Config) ->
['STA', _SessionId, {'Result-Code', ?UNSUPPORTED_VERSION} | _]
= call(Config, Req).
-%% Send a request containing an incorrect AVP length.
-send_invalid_avp_bits(Config) ->
- Req = ['STR', {'Termination-Cause', ?LOGOUT}],
+%% Send a request containing an AVP length > data size.
+send_long_avp_length(Config) ->
+ send_invalid_avp_length(Config).
- ?answer_message(?INVALID_AVP_BITS)
- = call(Config, Req).
+%% Send a request containing an AVP length < data size.
+send_short_avp_length(Config) ->
+ send_invalid_avp_length(Config).
+
+%% Send a request containing an AVP whose advertised length is < 8.
+send_zero_avp_length(Config) ->
+ send_invalid_avp_length(Config).
%% Send a request containing an AVP length that doesn't match the
%% AVP's type.
send_invalid_avp_length(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT}],
- ['STA', _SessionId, {'Result-Code', ?INVALID_AVP_LENGTH} | _]
+ ['STA', _SessionId,
+ {'Result-Code', ?INVALID_AVP_LENGTH},
+ _OriginHost,
+ _OriginRealm,
+ _UserName,
+ _Class,
+ _ErrorMessage,
+ _ErrorReportingHost,
+ {'Failed-AVP', [#'diameter_base_Failed-AVP'{'AVP' = [_]}]}
+ | _]
= call(Config, Req).
%% Send a request containing 5xxx errors that the server rejects with
@@ -504,6 +525,14 @@ send_invalid_reject(Config) ->
?answer_message(?TOO_BUSY)
= call(Config, Req).
+%% Send an STR containing a known AVP, but one that's not allowed and
+%% sets the M-bit.
+send_unrecognized_mandatory(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT}],
+
+ ['STA', _SessionId, {'Result-Code', ?AVP_UNSUPPORTED} | _]
+ = call(Config, Req).
+
%% Send something long that will be fragmented by TCP.
send_long(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT},
@@ -552,7 +581,7 @@ send_all_2(Config) ->
%% Timeout before the server manages an answer.
send_timeout(Config) ->
Req = ['RAR', {'Re-Auth-Request-Type', ?AUTHORIZE_ONLY}],
- {error, timeout} = call(Config, Req, [{timeout, 1000}]).
+ {timeout, _} = call(Config, Req, [{timeout, 1000}]).
%% Explicitly answer with an answer-message and ensure that we
%% received the Session-Id.
@@ -560,7 +589,7 @@ send_error(Config) ->
Req = ['RAR', {'Re-Auth-Request-Type', ?AUTHORIZE_AUTHENTICATE}],
?answer_message(SId, ?TOO_BUSY)
= call(Config, Req),
- undefined /= SId.
+ true = undefined /= SId.
%% Send a request with the detached option and receive it as a message
%% from handle_answer instead.
@@ -568,7 +597,7 @@ send_detach(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT}],
Ref = make_ref(),
ok = call(Config, Req, [{extra, [{self(), Ref}]}, detach]),
- Ans = receive {Ref, T} -> T after 2000 -> false end,
+ Ans = receive {Ref, T} -> T end,
['STA', _SessionId, {'Result-Code', ?SUCCESS} | _]
= Ans.
@@ -683,7 +712,7 @@ call(Config, Req, Opts) ->
diameter:call(?CLIENT,
dict(Req, Dict0),
msg(Req, ReqEncoding, Dict0),
- [{extra, [Name, Group]} | Opts]).
+ [{extra, [{Name, Group}, now()]} | Opts]).
origin({A,C}) ->
2*codec(A) + container(C);
@@ -767,14 +796,14 @@ peer_down(_SvcName, _Peer, State) ->
%% pick_peer/6-7
-pick_peer(Peers, _, ?CLIENT, _State, Name, Group)
+pick_peer(Peers, _, ?CLIENT, _State, {Name, Group}, _)
when Name /= send_detach ->
find(Group, Peers).
-pick_peer(_Peers, _, ?CLIENT, _State, send_nopeer, _, ?EXTRA) ->
+pick_peer(_Peers, _, ?CLIENT, _State, {send_nopeer, _}, _, ?EXTRA) ->
false;
-pick_peer(Peers, _, ?CLIENT, _State, send_detach, Group, {_,_}) ->
+pick_peer(Peers, _, ?CLIENT, _State, {send_detach, Group}, _, {_,_}) ->
find(Group, Peers).
find(#group{server_encoding = A, server_container = C}, Peers) ->
@@ -789,13 +818,13 @@ id(Id, {Pid, _Caps}) ->
%% prepare_request/5-6
-prepare_request(_Pkt, ?CLIENT, {_Ref, _Caps}, send_discard, _) ->
+prepare_request(_Pkt, ?CLIENT, {_Ref, _Caps}, {send_discard, _}, _) ->
{discard, unprepared};
-prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, Name, Group) ->
+prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, {Name, Group}, _) ->
{send, prepare(Pkt, Caps, Name, Group)}.
-prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, send_detach, Group, _) ->
+prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, {send_detach, Group}, _, _) ->
{eval_packet, {send, prepare(Pkt, Caps, Group)}, [fun log/2, detach]}.
log(#diameter_packet{bin = Bin} = P, T)
@@ -804,45 +833,63 @@ log(#diameter_packet{bin = Bin} = P, T)
%% prepare/4
-prepare(Pkt, Caps, send_invalid_avp_bits, #group{client_dict0 = Dict0}
- = Group) ->
+prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group)
+ when N == send_long_avp_length;
+ N == send_short_avp_length;
+ N == send_zero_avp_length ->
Req = prepare(Pkt, Caps, Group),
- %% Last AVP in our STR is Termination-Cause of type Unsigned32:
- %% set its length improperly.
+ %% Second last AVP in our STR is Auth-Application-Id of type
+ %% Unsigned32: set AVP Length to a value other than 12 and place
+ %% it last in the message (so as not to mess with Termination-Cause).
#diameter_packet{header = #diameter_header{length = L},
bin = B}
= E
= diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}),
- Offset = L - 7, %% to AVP Length
- <<H:Offset/binary, 12:24/integer, T:4/binary>> = B,
- E#diameter_packet{bin = <<H/binary, 13:24/integer, T/binary>>};
+ Offset = L - 24, %% to Auth-Application-Id
+ <<H:Offset/binary,
+ Hdr:5/binary, 12:24, Data:4/binary,
+ T:12/binary>>
+ = B,
+ AL = case N of
+ send_long_avp_length -> 13;
+ send_short_avp_length -> 11;
+ send_zero_avp_length -> 0
+ end,
+ E#diameter_packet{bin = <<H/binary,
+ T/binary,
+ Hdr/binary, AL:24, Data/binary>>};
prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group)
when N == send_invalid_avp_length;
N == send_invalid_reject ->
Req = prepare(Pkt, Caps, Group),
%% Second last AVP in our STR is Auth-Application-Id of type
- %% Unsigned32: Send a value of length 8.
+ %% Unsigned32: send data of length 8.
#diameter_packet{header = #diameter_header{length = L},
bin = B0}
= E
= diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}),
Offset = L - 7 - 12, %% to AVP Length
- <<H0:Offset/binary, 12:24/integer, T:16/binary>> = B0,
- <<V, L:24/integer, H/binary>> = H0, %% assert
- E#diameter_packet{bin = <<V,
- (L+4):24/integer,
- H/binary,
- 16:24/integer,
- 0:32/integer,
- T/binary>>};
+ <<H0:Offset/binary, 12:24, T:16/binary>> = B0,
+ <<V, L:24, H/binary>> = H0, %% assert
+ E#diameter_packet{bin = <<V, (L+4):24, H/binary, 16:24, 0:32, T/binary>>};
+
+prepare(Pkt, Caps, send_unrecognized_mandatory, #group{client_dict0 = Dict0}
+ = Group) ->
+ Req = prepare(Pkt, Caps, Group),
+ #diameter_packet{bin = <<V, Len:24, T/binary>>}
+ = E
+ = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}),
+ {Code, Flags, undefined} = Dict0:avp_header('Proxy-State'),
+ Avp = <<Code:32, Flags, 8:24>>,
+ E#diameter_packet{bin = <<V, (Len+8):24, T/binary, Avp/binary>>};
prepare(Pkt, Caps, send_unsupported, #group{client_dict0 = Dict0} = Group) ->
Req = prepare(Pkt, Caps, Group),
#diameter_packet{bin = <<H:5/binary, _CmdCode:3/binary, T/binary>>}
= E
= diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}),
- E#diameter_packet{bin = <<H/binary, 42:24/integer, T/binary>>};
+ E#diameter_packet{bin = <<H/binary, 42:24, T/binary>>};
prepare(Pkt, Caps, send_unsupported_app, #group{client_dict0 = Dict0}
= Group) ->
@@ -850,7 +897,7 @@ prepare(Pkt, Caps, send_unsupported_app, #group{client_dict0 = Dict0}
#diameter_packet{bin = <<H:8/binary, _ApplId:4/binary, T/binary>>}
= E
= diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}),
- E#diameter_packet{bin = <<H/binary, ?BAD_APP:32/integer, T/binary>>};
+ E#diameter_packet{bin = <<H/binary, ?BAD_APP:32, T/binary>>};
prepare(Pkt, Caps, send_error_bit, Group) ->
#diameter_packet{header = Hdr} = Pkt,
@@ -928,10 +975,10 @@ prepare_retransmit(_Pkt, false, _Peer, _Name, _Group) ->
%% handle_answer/6-7
-handle_answer(Pkt, Req, ?CLIENT, Peer, Name, Group) ->
+handle_answer(Pkt, Req, ?CLIENT, Peer, {Name, Group}, _) ->
answer(Pkt, Req, Peer, Name, Group).
-handle_answer(Pkt, Req, ?CLIENT, Peer, send_detach = Name, Group, X) ->
+handle_answer(Pkt, Req, ?CLIENT, Peer, {send_detach = Name, Group}, _, X) ->
{Pid, Ref} = X,
Pid ! {Ref, answer(Pkt, Req, Peer, Name, Group)}.
@@ -944,7 +991,9 @@ answer(Pkt, Req, _Peer, Name, #group{client_dict0 = Dict0}) ->
[Dict:rec2msg(R) | Vs].
answer(Rec, [_|_], N)
- when N == send_invalid_avp_bits;
+ when N == send_long_avp_length;
+ N == send_short_avp_length;
+ N == send_zero_avp_length;
N == send_invalid_avp_length;
N == send_invalid_reject ->
Rec;
@@ -959,7 +1008,11 @@ app(Req, _, Dict0) ->
%% handle_error/6
-handle_error(Reason, _Req, ?CLIENT, _Peer, _Name, _Group) ->
+handle_error(timeout = Reason, _Req, ?CLIENT, _Peer, _, Time) ->
+ Now = now(),
+ {Reason, {Time, Now, timer:now_diff(Now, Time)}};
+
+handle_error(Reason, _Req, ?CLIENT, _Peer, _, _Time) ->
{error, Reason}.
%% handle_request/3
@@ -1085,7 +1138,6 @@ request(#diameter_base_STR{'Session-Id' = SId},
{'Origin-Host', OH},
{'Origin-Realm', OR}]};
-%% send_error
+%% send_error/send_timeout
request(#diameter_base_RAR{}, _Caps) ->
- receive after 2000 -> ok end,
- {protocol_error, ?TOO_BUSY}.
+ receive after 2000 -> {protocol_error, ?TOO_BUSY} end.
diff --git a/lib/diameter/test/modules.mk b/lib/diameter/test/modules.mk
index 1a829f8031..4fea62461c 100644
--- a/lib/diameter/test/modules.mk
+++ b/lib/diameter/test/modules.mk
@@ -38,6 +38,7 @@ MODULES = \
diameter_examples_SUITE \
diameter_failover_SUITE \
diameter_gen_sctp_SUITE \
+ diameter_gen_tcp_SUITE \
diameter_length_SUITE \
diameter_reg_SUITE \
diameter_relay_SUITE \
diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl
index f6b13c2998..55794f57dc 100644
--- a/lib/inets/src/http_client/httpc_handler.erl
+++ b/lib/inets/src/http_client/httpc_handler.erl
@@ -33,7 +33,6 @@
%% connect_and_send/2,
send/2,
cancel/3,
- stream/3,
stream_next/1,
info/1
]).
@@ -65,7 +64,7 @@
options, % #options{}
timers = #timers{}, % #timers{}
profile_name, % atom() - id of httpc_manager process.
- once % send | undefined
+ once = inactive % inactive | once
}).
@@ -231,6 +230,8 @@ init([Parent, Request, Options, ProfileName]) ->
ProxyOptions = handle_proxy_options(Request#request.scheme, Options),
Address = handle_proxy(Request#request.address, ProxyOptions),
{ok, State} =
+ %% #state.once should initially be 'inactive' because we
+ %% activate the socket at first regardless of the state.
case {Address /= Request#request.address, Request#request.scheme} of
{true, https} ->
connect_and_send_upgrade_request(Address, Request,
@@ -425,7 +426,9 @@ handle_cast({cancel, RequestId, From},
handle_cast(stream_next, #state{session = Session} = State) ->
activate_once(Session),
- {noreply, State#state{once = once}}.
+ %% Inactivate the #state.once here because we don't want
+ %% next_body_chunk/1 to activate the socket twice.
+ {noreply, State#state{once = inactive}}.
%%--------------------------------------------------------------------
@@ -478,6 +481,41 @@ handle_info({Proto, _Socket, Data},
NewMFA = {Module, whole_body, [NewBody, NewLength]},
{noreply, NewState#state{mfa = NewMFA,
request = NewRequest}};
+ {Module, decode_size,
+ [TotalChunk, HexList,
+ {MaxBodySize, BodySoFar, AccLength, MaxHeaderSize}]}
+ when BodySoFar =/= <<>> ->
+ ?hcrd("data processed - decode_size", []),
+ %% The response body is chunk-encoded. Steal decoded
+ %% chunks as much as possible to stream.
+ {_, Code, _} = StatusLine,
+ {NewBody, NewRequest} = stream(BodySoFar, Request, Code),
+ NewState = next_body_chunk(State),
+ NewMFA = {Module, decode_size,
+ [TotalChunk, HexList,
+ {MaxBodySize, NewBody, AccLength, MaxHeaderSize}]},
+ {noreply, NewState#state{mfa = NewMFA,
+ request = NewRequest}};
+ {Module, decode_data,
+ [ChunkSize, TotalChunk,
+ {MaxBodySize, BodySoFar, AccLength, MaxHeaderSize}]}
+ when TotalChunk =/= <<>> orelse BodySoFar =/= <<>> ->
+ ?hcrd("data processed - decode_data", []),
+ %% The response body is chunk-encoded. Steal decoded
+ %% chunks as much as possible to stream.
+ ChunkSizeToSteal = min(ChunkSize, byte_size(TotalChunk)),
+ <<StolenChunk:ChunkSizeToSteal/binary, NewTotalChunk/binary>> = TotalChunk,
+ StolenBody = <<BodySoFar/binary, StolenChunk/binary>>,
+ NewChunkSize = ChunkSize - ChunkSizeToSteal,
+ {_, Code, _} = StatusLine,
+
+ {NewBody, NewRequest} = stream(StolenBody, Request, Code),
+ NewState = next_body_chunk(State),
+ NewMFA = {Module, decode_data,
+ [NewChunkSize, NewTotalChunk,
+ {MaxBodySize, NewBody, AccLength, MaxHeaderSize}]},
+ {noreply, NewState#state{mfa = NewMFA,
+ request = NewRequest}};
NewMFA ->
?hcrd("data processed - new mfa", []),
activate_once(Session),
@@ -1027,11 +1065,15 @@ handle_http_msg({Version, StatusCode, ReasonPharse, Headers, Body},
status_line = StatusLine,
headers = Headers})
end;
-handle_http_msg({ChunkedHeaders, Body}, #state{headers = Headers} = State) ->
+handle_http_msg({ChunkedHeaders, Body},
+ #state{status_line = {_, Code, _}, headers = Headers} = State) ->
?hcrt("handle_http_msg",
[{chunked_headers, ChunkedHeaders}, {headers, Headers}]),
NewHeaders = http_chunk:handle_headers(Headers, ChunkedHeaders),
- handle_response(State#state{headers = NewHeaders, body = Body});
+ {NewBody, NewRequest} = stream(Body, State#state.request, Code),
+ handle_response(State#state{headers = NewHeaders,
+ body = NewBody,
+ request = NewRequest});
handle_http_msg(Body, #state{status_line = {_,Code, _}} = State) ->
?hcrt("handle_http_msg", [{code, Code}]),
{NewBody, NewRequest} = stream(Body, State#state.request, Code),
@@ -1070,8 +1112,7 @@ handle_http_body(Body, #state{headers = Headers,
"chunked" ->
?hcrt("handle_http_body - chunked", []),
case http_chunk:decode(Body, State#state.max_body_size,
- State#state.max_header_size,
- {Code, Request}) of
+ State#state.max_header_size) of
{Module, Function, Args} ->
?hcrt("handle_http_body - new mfa",
[{module, Module},
diff --git a/lib/inets/src/http_lib/http_chunk.erl b/lib/inets/src/http_lib/http_chunk.erl
index 57647438e9..24c939e80c 100644
--- a/lib/inets/src/http_lib/http_chunk.erl
+++ b/lib/inets/src/http_lib/http_chunk.erl
@@ -24,7 +24,7 @@
-include("http_internal.hrl").
%% API
--export([decode/3, decode/4, encode/1, encode_last/0, handle_headers/2]).
+-export([decode/3, encode/1, encode_last/0, handle_headers/2]).
%% Callback API - used for example if the chunkedbody is received a
%% little at a time on a socket.
-export([decode_size/1, ignore_extensions/1, decode_data/1, decode_trailer/1]).
@@ -34,20 +34,14 @@
%%% API
%%%=========================================================================
%%-------------------------------------------------------------------------
-%% decode(ChunkedBody, MaxBodySize, MaxHeaderSize, <Stream>) ->
+%% decode(ChunkedBody, MaxBodySize, MaxHeaderSize) ->
%% {ok, {Headers, Body}} | {Module, Function, Args}
%%
%% Headers = ["Header:Value"]
%% ChunkedBody = binary()
%% MaxBodySize = integer()
%% MaxHeaderSize = integer()
-%% Stream = {Code, Request} - if Request#request.stream =/= none
-%% and Code == 200 the side effect of sending each decode chunk to the
-%% client/file before the whole body is received will take place.
%%
-%% Note: decode/4 should only be used from httpc_handler module.
-%% Otherwhise use the side effect free decode/3.
-%%
%% Description: Decodes a body encoded by the chunked transfer
%% encoding. If the ChunkedBody is not compleate it returns {Module,
%% Function, Args} so that decoding can be continued when more of the
@@ -61,12 +55,9 @@
%% the next pass in the loop.
%%-------------------------------------------------------------------------
decode(ChunkedBody, MaxBodySize, MaxHeaderSize) ->
- decode(ChunkedBody, MaxBodySize, MaxHeaderSize, false).
-
-decode(ChunkedBody, MaxBodySize, MaxHeaderSize, Stream) ->
%% Note decode_size will call decode_data.
- decode_size([ChunkedBody, <<>>, [],
- {MaxBodySize, <<>>, 0, MaxHeaderSize, Stream}]).
+ decode_size([ChunkedBody, <<>>, [],
+ {MaxBodySize, <<>>, 0, MaxHeaderSize}]).
%%-------------------------------------------------------------------------
%% encode(Chunk) -> EncodedChunk
@@ -150,7 +141,7 @@ decode_size(<<>>, HexList, Info) ->
decode_size(Data = <<?CR, ?LF, ChunkRest/binary>>, HexList,
{MaxBodySize, Body,
AccLength,
- MaxHeaderSize, Stream}) ->
+ MaxHeaderSize}) ->
ChunkSize = http_util:hexlist_to_integer(lists:reverse(HexList)),
case ChunkSize of
0 -> % Last chunk, there was no data
@@ -164,7 +155,7 @@ decode_size(Data = <<?CR, ?LF, ChunkRest/binary>>, HexList,
%% to this function comes in.
decode_data(ChunkSize, ChunkRest, {MaxBodySize, Body,
ChunkSize + AccLength ,
- MaxHeaderSize, Stream})
+ MaxHeaderSize})
end;
decode_size(<<";", Rest/binary>>, HexList, Info) ->
%% Note ignore_extensions will call decode_size/1 again when
@@ -189,50 +180,42 @@ ignore_extensions(<<_Octet, Rest/binary>>, NextFunction) ->
ignore_extensions(Rest, NextFunction).
decode_data(ChunkSize, TotalChunk,
- Info = {MaxBodySize, BodySoFar, AccLength, MaxHeaderSize, Stream})
+ Info = {MaxBodySize, BodySoFar, AccLength, MaxHeaderSize})
when ChunkSize =< size(TotalChunk) ->
case TotalChunk of
%% Last chunk
<<Data:ChunkSize/binary, ?CR, ?LF, "0", ";">> ->
%% Note ignore_extensions will call decode_trailer/1
%% once it ignored all extensions.
- {NewBody, _} =
- stream(<<BodySoFar/binary, Data/binary>>, Stream),
{?MODULE, ignore_extensions,
[<<>>,
{?MODULE, decode_trailer, [<<>>, [],[], MaxHeaderSize,
- NewBody,
+ <<BodySoFar/binary, Data/binary>>,
integer_to_list(AccLength)]}]};
<<Data:ChunkSize/binary, ?CR, ?LF, "0", ";", Rest/binary>> ->
%% Note ignore_extensions will call decode_trailer/1
%% once it ignored all extensions.
- {NewBody, _} = stream(<<BodySoFar/binary, Data/binary>>, Stream),
ignore_extensions(Rest, {?MODULE, decode_trailer,
[<<>>, [],[], MaxHeaderSize,
- NewBody,
+ <<BodySoFar/binary, Data/binary>>,
integer_to_list(AccLength)]});
<<Data:ChunkSize/binary, ?CR, ?LF, "0", ?CR, ?LF>> ->
- {NewBody, _} = stream(<<BodySoFar/binary, Data/binary>>, Stream),
{?MODULE, decode_trailer, [<<?CR, ?LF>>, [],[], MaxHeaderSize,
- NewBody,
+ <<BodySoFar/binary, Data/binary>>,
integer_to_list(AccLength)]};
<<Data:ChunkSize/binary, ?CR, ?LF, "0", ?CR, ?LF, Rest/binary>> ->
- {NewBody,_}= stream(<<BodySoFar/binary, Data/binary>>, Stream),
decode_trailer(<<?CR, ?LF, Rest/binary>>, [],[], MaxHeaderSize,
- NewBody,
+ <<BodySoFar/binary, Data/binary>>,
integer_to_list(AccLength));
%% There are more chunks, so here we go agin...
<<Data:ChunkSize/binary, ?CR, ?LF>> ->
- {NewBody, NewStream} =
- stream(<<BodySoFar/binary, Data/binary>>, Stream),
- {?MODULE, decode_size, [<<>>, [], {MaxBodySize, NewBody, AccLength, MaxHeaderSize, NewStream}]};
+ NewBody = <<BodySoFar/binary, Data/binary>>,
+ {?MODULE, decode_size, [<<>>, [], {MaxBodySize, NewBody, AccLength, MaxHeaderSize}]};
<<Data:ChunkSize/binary, ?CR, ?LF, Rest/binary>>
when (AccLength < MaxBodySize) or (MaxBodySize == nolimit) ->
- {NewBody, NewStream} =
- stream(<<BodySoFar/binary, Data/binary>>, Stream),
decode_size(Rest, [],
- {MaxBodySize, NewBody,
- AccLength, MaxHeaderSize, NewStream});
+ {MaxBodySize, <<BodySoFar/binary, Data/binary>>,
+ AccLength, MaxHeaderSize});
<<_:ChunkSize/binary, ?CR, ?LF, _/binary>> ->
throw({error, body_too_big});
_ ->
@@ -286,9 +269,3 @@ decode_trailer(<<Octet, Rest/binary>>, Header, Headers, MaxHeaderSize, Body,
BodyLength) ->
decode_trailer(Rest, [Octet | Header], Headers, MaxHeaderSize,
Body, BodyLength).
-
-stream(BodyPart, false) ->
- {BodyPart, false};
-stream(BodyPart, {Code, Request}) ->
- {NewBody, NewRequest} = httpc_handler:stream(BodyPart, Request, Code),
- {NewBody, {Code, NewRequest}}.
diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl
index 350192464e..0c35f284f7 100644
--- a/lib/inets/test/httpc_SUITE.erl
+++ b/lib/inets/test/httpc_SUITE.erl
@@ -1693,6 +1693,15 @@ receive_streamed_body(RequestId, Body, Pid) ->
ct:print("~p:receive_streamed_body -> requested next stream ~n", [?MODULE]),
receive
{http, {RequestId, stream, BinBodyPart}} ->
+ %% Make sure the httpc hasn't sent us the next 'stream'
+ %% without our request.
+ receive
+ {http, {RequestId, stream, _}} = Msg ->
+ ct:fail({unexpected_flood_of_stream, Msg})
+ after
+ 1000 ->
+ ok
+ end,
receive_streamed_body(RequestId,
<<Body/binary, BinBodyPart/binary>>,
Pid);
diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl
index 4218cfa646..e4c8f0ffaf 100644
--- a/lib/kernel/test/file_SUITE.erl
+++ b/lib/kernel/test/file_SUITE.erl
@@ -2651,6 +2651,8 @@ symlinks(Config) when is_list(Config) ->
?line #file_info{links=1, type=symlink} = Info2,
?line {ok, Name} = ?FILE_MODULE:read_link(Alias),
{ok, Name} = ?FILE_MODULE:read_link_all(Alias),
+ %% If all is good, delete dir again (avoid hanging dir on windows)
+ rm_rf(?FILE_MODULE,NewDir),
ok
end,
@@ -4304,3 +4306,18 @@ disc_free(Path) ->
memsize() ->
{Tot,_Used,_} = memsup:get_memory_data(),
Tot.
+
+%%%-----------------------------------------------------------------
+%%% Utilities
+rm_rf(Mod,Dir) ->
+ case Mod:read_link_info(Dir) of
+ {ok, #file_info{type = directory}} ->
+ {ok, Content} = Mod:list_dir_all(Dir),
+ [ rm_rf(Mod,filename:join(Dir,C)) || C <- Content ],
+ Mod:del_dir(Dir),
+ ok;
+ {ok, #file_info{}} ->
+ Mod:delete(Dir);
+ _ ->
+ ok
+ end.
diff --git a/lib/kernel/test/file_name_SUITE.erl b/lib/kernel/test/file_name_SUITE.erl
index a6728564e4..0c8082026a 100644
--- a/lib/kernel/test/file_name_SUITE.erl
+++ b/lib/kernel/test/file_name_SUITE.erl
@@ -197,7 +197,10 @@ normal(Config) when is_list(Config) ->
put(file_module,prim_file),
ok = check_normal(prim_file),
put(file_module,file),
- ok = check_normal(file)
+ ok = check_normal(file),
+ %% If all is good, delete dir again (avoid hanging dir on windows)
+ rm_rf(file,"normal_dir"),
+ ok
after
file:set_cwd(Dir)
end.
@@ -219,7 +222,10 @@ icky(Config) when is_list(Config) ->
put(file_module,prim_file),
ok = check_icky(prim_file),
put(file_module,file),
- ok = check_icky(file)
+ ok = check_icky(file),
+ %% If all is good, delete dir again (avoid hanging dir on windows)
+ rm_rf(file,"icky_dir"),
+ ok
after
file:set_cwd(Dir)
end
@@ -243,7 +249,11 @@ very_icky(Config) when is_list(Config) ->
{skipped,"VM needs to be started in Unicode filename mode"};
ok ->
put(file_module,file),
- ok = check_very_icky(file)
+ ok = check_very_icky(file),
+ %% If all is good, delete dir again
+ %% (avoid hanging dir on windows)
+ rm_rf(file,"very_icky_dir"),
+ ok
end
after
file:set_cwd(Dir)
diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl
index 6b672004ec..2d5827282f 100644
--- a/lib/kernel/test/gen_tcp_misc_SUITE.erl
+++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl
@@ -602,7 +602,7 @@ iter_max_socks(Config) when is_list(Config) ->
%% Run on a different node in order to limit the effect if this test fails.
Dir = filename:dirname(code:which(?MODULE)),
{ok,Node} = test_server:start_node(test_iter_max_socks,slave,
- [{args,"-pa " ++ Dir}]),
+ [{args,"+Q 2048 -pa " ++ Dir}]),
L = rpc:call(Node,?MODULE,do_iter_max_socks,[N, initalize]),
test_server:stop_node(Node),
diff --git a/lib/kernel/test/interactive_shell_SUITE.erl b/lib/kernel/test/interactive_shell_SUITE.erl
index dac021c6c6..d7d9434b1f 100644
--- a/lib/kernel/test/interactive_shell_SUITE.erl
+++ b/lib/kernel/test/interactive_shell_SUITE.erl
@@ -211,7 +211,7 @@ job_control_remote(Config) when is_list(Config) ->
{sleep,timeout(short)},
{putline,""},
{getline," -->"},
- {putline,"r "++MyNode},
+ {putline,"r '"++MyNode++"'"},
{putline,"c"},
{putline_raw,""},
{getline,"Eshell"},
@@ -265,7 +265,7 @@ job_control_remote_noshell(Config) when is_list(Config) ->
{sleep,timeout(short)},
{putline,""},
{getline," -->"},
- {putline,"r "++NSNodeStr},
+ {putline,"r '"++NSNodeStr++"'"},
{putline,"c"},
{putline_raw,""},
{getline,"Eshell"},
@@ -721,4 +721,4 @@ get_default_shell() ->
end.
atom2list(A) ->
- lists:flatten(io_lib:format("~w", [A])).
+ lists:flatten(io_lib:format("~s", [A])).
diff --git a/lib/kernel/test/prim_file_SUITE.erl b/lib/kernel/test/prim_file_SUITE.erl
index ac75037536..199e597e78 100644
--- a/lib/kernel/test/prim_file_SUITE.erl
+++ b/lib/kernel/test/prim_file_SUITE.erl
@@ -2039,6 +2039,8 @@ symlinks(Config, Handle, Suffix) ->
?PRIM_FILE_call(read_link, Handle, [Alias]),
{ok, Name} =
?PRIM_FILE_call(read_link_all, Handle, [Alias]),
+ %% If all is good, delete dir again (avoid hanging dir on windows)
+ rm_rf(?PRIM_FILE,NewDir),
ok
end,
@@ -2245,3 +2247,18 @@ zip_data([], Bs) ->
Bs;
zip_data(As, []) ->
As.
+
+%%%-----------------------------------------------------------------
+%%% Utilities
+rm_rf(Mod,Dir) ->
+ case Mod:read_link_info(Dir) of
+ {ok, #file_info{type = directory}} ->
+ {ok, Content} = Mod:list_dir_all(Dir),
+ [ rm_rf(Mod,filename:join(Dir,C)) || C <- Content ],
+ Mod:del_dir(Dir),
+ ok;
+ {ok, #file_info{}} ->
+ Mod:delete(Dir);
+ _ ->
+ ok
+ end.
diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl
index 64a8457d16..e7d71c581e 100644
--- a/lib/observer/src/crashdump_viewer.erl
+++ b/lib/observer/src/crashdump_viewer.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2013. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -41,6 +41,7 @@
%% Process state
%% -------------
%% file: The name of the crashdump currently viewed.
+%% dump_vsn: The version number of the crashdump
%% procs_summary: Process summary represented by a list of
%% #proc records. This is used for efficiency reasons when sorting the
%% process summary table instead of reading all processes from the
@@ -127,6 +128,8 @@
% timers, funs...
% Must be equal to
% ?max_sort_process_num!
+-define(not_available,"N/A").
+
%% All possible tags - use macros in order to avoid misspelling in the code
-define(allocated_areas,allocated_areas).
@@ -161,7 +164,7 @@
-define(visible_node,visible_node).
--record(state,{file,procs_summary,sorted,shared_heap=false,
+-record(state,{file,dump_vsn,procs_summary,sorted,shared_heap=false,
wordsize=4,num_atoms="unknown",binaries,bg_status}).
%%%-----------------------------------------------------------------
@@ -499,6 +502,7 @@ handle_call(filename_frame,_From,State=#state{file=File}) ->
{reply,Reply,State};
handle_call(initial_info_frame,_From,State=#state{file=File}) ->
GenInfo = general_info(File),
+ [{DumpVsn,_}] = lookup_index(?erl_crash_dump),
NumAtoms = GenInfo#general_info.num_atoms,
{WS,SH} = parse_vsn_str(GenInfo#general_info.system_vsn,4,false),
NumProcs = list_to_integer(GenInfo#general_info.num_procs),
@@ -506,7 +510,9 @@ handle_call(initial_info_frame,_From,State=#state{file=File}) ->
if NumProcs > ?max_sort_process_num -> too_many;
true -> State#state.procs_summary
end,
- NewState = State#state{shared_heap=SH,
+ NewState = State#state{dump_vsn=[list_to_integer(L) ||
+ L<-string:tokens(DumpVsn,".")],
+ shared_heap=SH,
wordsize=WS,
num_atoms=NumAtoms,
procs_summary=ProcsSummary},
@@ -577,7 +583,7 @@ handle_call({sort_procs,SessionId,Input}, _From, State) ->
handle_call({proc_details,Input},_From,State=#state{file=File,shared_heap=SH}) ->
{ok,Pid} = get_value("pid",httpd:parse_query(Input)),
Reply =
- case get_proc_details(File,Pid) of
+ case get_proc_details(File,Pid,State#state.dump_vsn) of
{ok,Proc} ->
TW = truncated_warning([{?proc,Pid}]),
crashdump_viewer_html:proc_details(Pid,Proc,TW,SH);
@@ -1298,7 +1304,6 @@ find_truncated_proc({Tag,Pid}) ->
is_proc_tag(Tag) when Tag==?proc;
Tag==?proc_dictionary;
Tag==?proc_messages;
- Tag==?proc_dictionary;
Tag==?debug_proc_dictionary;
Tag==?proc_stack;
Tag==?proc_heap ->
@@ -1451,7 +1456,8 @@ count() ->
%% avoid really big data in the server state.
procs_summary(SessionId,TW,_,State=#state{procs_summary=too_many}) ->
chunk_page(SessionId,State#state.file,TW,?proc,processes,
- {no_sort,State#state.shared_heap},procs_summary_parsefun()),
+ {no_sort,State#state.shared_heap,State#state.dump_vsn},
+ procs_summary_parsefun()),
State;
procs_summary(SessionId,TW,SortOn,State) ->
ProcsSummary =
@@ -1465,10 +1471,12 @@ procs_summary(SessionId,TW,SortOn,State) ->
PS ->
PS
end,
- {SortedPS,NewSorted} = do_sort_procs(SortOn,ProcsSummary,State#state.sorted),
+ {SortedPS,NewSorted} = do_sort_procs(SortOn,ProcsSummary,State),
HtmlInfo =
crashdump_viewer_html:chunk_page(processes,SessionId,TW,
- {SortOn,State#state.shared_heap},
+ {SortOn,
+ State#state.shared_heap,
+ State#state.dump_vsn},
SortedPS),
crashdump_viewer_html:chunk(SessionId,done,HtmlInfo),
State#state{procs_summary=ProcsSummary,sorted=NewSorted}.
@@ -1480,15 +1488,14 @@ procs_summary_parsefun() ->
%%-----------------------------------------------------------------
%% Page with one process
-get_proc_details(File,Pid) ->
- [{DumpVsn,_}] = lookup_index(?erl_crash_dump),
+get_proc_details(File,Pid,DumpVsn) ->
case lookup_index(?proc,Pid) of
[{_,Start}] ->
Fd = open(File),
pos_bof(Fd,Start),
Proc0 =
case DumpVsn of
- "0.0" ->
+ [0,0] ->
%% Old version (translated)
#proc{pid=Pid};
_ ->
@@ -1597,6 +1604,9 @@ get_procinfo(Fd,Fun,Proc) ->
get_procinfo(Fd,Fun,Proc#proc{old_heap_top=val(Fd)});
"Old heap end" ->
get_procinfo(Fd,Fun,Proc#proc{old_heap_end=val(Fd)});
+ "Memory" ->
+ %% stored as integer so we can sort on it
+ get_procinfo(Fd,Fun,Proc#proc{memory=list_to_integer(val(Fd))});
{eof,_} ->
Proc; % truncated file
Other ->
@@ -1865,35 +1875,41 @@ parse(Line0, Dict0) ->
Dict.
-do_sort_procs("state",Procs,"state") ->
+do_sort_procs("state",Procs,#state{sorted="state"}) ->
{lists:reverse(lists:keysort(#proc.state,Procs)),"rstate"};
do_sort_procs("state",Procs,_) ->
{lists:keysort(#proc.state,Procs),"state"};
-do_sort_procs("pid",Procs,"pid") ->
+do_sort_procs("pid",Procs,#state{sorted="pid"}) ->
{lists:reverse(Procs),"rpid"};
do_sort_procs("pid",Procs,_) ->
{Procs,"pid"};
-do_sort_procs("msg_q_len",Procs,"msg_q_len") ->
+do_sort_procs("msg_q_len",Procs,#state{sorted="msg_q_len"}) ->
{lists:keysort(#proc.msg_q_len,Procs),"rmsg_q_len"};
do_sort_procs("msg_q_len",Procs,_) ->
{lists:reverse(lists:keysort(#proc.msg_q_len,Procs)),"msg_q_len"};
-do_sort_procs("reds",Procs,"reds") ->
+do_sort_procs("reds",Procs,#state{sorted="reds"}) ->
{lists:keysort(#proc.reds,Procs),"rreds"};
do_sort_procs("reds",Procs,_) ->
{lists:reverse(lists:keysort(#proc.reds,Procs)),"reds"};
-do_sort_procs("mem",Procs,"mem") ->
- {lists:keysort(#proc.stack_heap,Procs),"rmem"};
-do_sort_procs("mem",Procs,_) ->
- {lists:reverse(lists:keysort(#proc.stack_heap,Procs)),"mem"};
-do_sort_procs("init_func",Procs,"init_func") ->
+do_sort_procs("mem",Procs,#state{sorted="mem",dump_vsn=DumpVsn}) ->
+ KeyPos = if DumpVsn>=?r16b01_dump_vsn -> #proc.memory;
+ true -> #proc.stack_heap
+ end,
+ {lists:keysort(KeyPos,Procs),"rmem"};
+do_sort_procs("mem",Procs,#state{dump_vsn=DumpVsn}) ->
+ KeyPos = if DumpVsn>=?r16b01_dump_vsn -> #proc.memory;
+ true -> #proc.stack_heap
+ end,
+ {lists:reverse(lists:keysort(KeyPos,Procs)),"mem"};
+do_sort_procs("init_func",Procs,#state{sorted="init_func"}) ->
{lists:reverse(lists:keysort(#proc.init_func,Procs)),"rinit_func"};
do_sort_procs("init_func",Procs,_) ->
{lists:keysort(#proc.init_func,Procs),"init_func"};
-do_sort_procs("name_func",Procs,"name_func") ->
+do_sort_procs("name_func",Procs,#state{sorted="name_func"}) ->
{lists:reverse(lists:keysort(#proc.name,Procs)),"rname_func"};
do_sort_procs("name_func",Procs,_) ->
{lists:keysort(#proc.name,Procs),"name_func"};
-do_sort_procs("name",Procs,Sorted) ->
+do_sort_procs("name",Procs,#state{sorted=Sorted}) ->
{No,Yes} =
lists:foldl(fun(P,{N,Y}) ->
case P#proc.name of
@@ -2349,7 +2365,7 @@ allocator_info(File) ->
end,
AllAllocators),
close(Fd),
- R
+ [allocator_summary(R) | R]
end.
get_allocatorinfo(Fd,Start) ->
@@ -2374,6 +2390,213 @@ get_all_vals([],Acc) ->
get_all_vals([Char|Rest],Acc) ->
get_all_vals(Rest,[Char|Acc]).
+%% Calculate allocator summary:
+%%
+%% System totals:
+%% blocks size = sum of mbcs, mbcs_pool and sbcs blocks size over
+%% all allocator instances of all types
+%% carriers size = sum of mbcs, mbcs_pool and sbcs carriers size over
+%% all allocator instances of all types
+%%
+%% I any allocator except sbmbc_alloc has "option e: false" then don't
+%% present system totals.
+%%
+%% For each allocator type:
+%% blocks size = sum of sbmbcs, mbcs, mbcs_pool and sbcs blocks
+%% size over all allocator instances of this type
+%% carriers size = sum of sbmbcs, mbcs, mbcs_pool and sbcs carriers
+%% size over all allocator instances of this type
+%% mseg carriers size = sum of mbcs and sbcs mseg carriers size over all
+%% allocator instances of this type
+%%
+
+-define(sbmbcs_blocks_size,"sbmbcs blocks size").
+-define(mbcs_blocks_size,"mbcs blocks size").
+-define(sbcs_blocks_size,"sbcs blocks size").
+-define(sbmbcs_carriers_size,"sbmbcs carriers size").
+-define(mbcs_carriers_size,"mbcs carriers size").
+-define(sbcs_carriers_size,"sbcs carriers size").
+-define(mbcs_mseg_carriers_size,"mbcs mseg carriers size").
+-define(sbcs_mseg_carriers_size,"sbcs mseg carriers size").
+-define(segments_size,"segments_size").
+-define(mbcs_pool_blocks_size,"mbcs_pool blocks size").
+-define(mbcs_pool_carriers_size,"mbcs_pool carriers size").
+
+-define(type_blocks_size,[?sbmbcs_blocks_size,
+ ?mbcs_blocks_size,
+ ?mbcs_pool_blocks_size,
+ ?sbcs_blocks_size]).
+-define(type_carriers_size,[?sbmbcs_carriers_size,
+ ?mbcs_carriers_size,
+ ?mbcs_pool_carriers_size,
+ ?sbcs_carriers_size]).
+-define(type_mseg_carriers_size,[?mbcs_mseg_carriers_size,
+ ?sbcs_mseg_carriers_size]).
+-define(total_blocks_size,[?mbcs_blocks_size,
+ ?mbcs_pool_blocks_size,
+ ?sbcs_blocks_size]).
+-define(total_carriers_size,[?mbcs_carriers_size,
+ ?mbcs_pool_carriers_size,
+ ?sbcs_carriers_size]).
+-define(total_mseg_carriers_size,[?mbcs_mseg_carriers_size,
+ ?sbcs_mseg_carriers_size]).
+-define(interesting_allocator_info, [?sbmbcs_blocks_size,
+ ?mbcs_blocks_size,
+ ?mbcs_pool_blocks_size,
+ ?sbcs_blocks_size,
+ ?sbmbcs_carriers_size,
+ ?mbcs_carriers_size,
+ ?sbcs_carriers_size,
+ ?mbcs_mseg_carriers_size,
+ ?mbcs_pool_carriers_size,
+ ?sbcs_mseg_carriers_size,
+ ?segments_size]).
+-define(mseg_alloc,"mseg_alloc").
+-define(seg_size,"segments_size").
+-define(sbmbc_alloc,"sbmbc_alloc").
+-define(opt_e_false,{"option e","false"}).
+
+allocator_summary(Allocators) ->
+ {Sorted,DoTotal} = sort_allocator_types(Allocators,[],true),
+ {TypeTotals0,Totals} = sum_allocator_data(Sorted,DoTotal),
+ {TotalMCS,TypeTotals} =
+ case lists:keytake(?mseg_alloc,1,TypeTotals0) of
+ {value,{_,[{?seg_size,SegSize}]},Rest} ->
+ {integer_to_list(SegSize),Rest};
+ false ->
+ {?not_available,TypeTotals0}
+ end,
+ {TotalBS,TotalCS} =
+ case Totals of
+ false ->
+ {?not_available,?not_available};
+ {TBS,TCS} ->
+ {integer_to_list(TBS),integer_to_list(TCS)}
+ end,
+ {{"Summary",["blocks size","carriers size","mseg carriers size"]},
+ [{"total",[TotalBS,TotalCS,TotalMCS]} |
+ format_allocator_summary(lists:reverse(TypeTotals))]}.
+
+format_allocator_summary([{Type,Data}|Rest]) ->
+ [format_allocator_summary(Type,Data) | format_allocator_summary(Rest)];
+format_allocator_summary([]) ->
+ [].
+
+format_allocator_summary(Type,Data) ->
+ BS = get_size_value(blocks_size,Data),
+ CS = get_size_value(carriers_size,Data),
+ MCS = get_size_value(mseg_carriers_size,Data),
+ {Type,[BS,CS,MCS]}.
+
+get_size_value(Key,Data) ->
+ case proplists:get_value(Key,Data) of
+ undefined ->
+ ?not_available;
+ Int ->
+ integer_to_list(Int)
+ end.
+
+%% Sort allocator data per type
+%% Input = [{Instance,[{Key,Data}]}]
+%% Output = [{Type,[{Key,Value}]}]
+%% where Key in Output is one of ?interesting_allocator_info
+%% and Value is the sum over all allocator instances of each type.
+sort_allocator_types([{Name,Data}|Allocators],Acc,DoTotal) ->
+ Type =
+ case string:tokens(Name,"[]") of
+ [T,_Id] -> T;
+ [Name] -> Name
+ end,
+ TypeData = proplists:get_value(Type,Acc,[]),
+ {NewTypeData,NewDoTotal} = sort_type_data(Type,Data,TypeData,DoTotal),
+ NewAcc = lists:keystore(Type,1,Acc,{Type,NewTypeData}),
+ sort_allocator_types(Allocators,NewAcc,NewDoTotal);
+sort_allocator_types([],Acc,DoTotal) ->
+ {Acc,DoTotal}.
+
+sort_type_data(Type,[?opt_e_false|Data],Acc,_) when Type=/=?sbmbc_alloc->
+ sort_type_data(Type,Data,Acc,false);
+sort_type_data(Type,[{Key,Val0}|Data],Acc,DoTotal) ->
+ case lists:member(Key,?interesting_allocator_info) of
+ true ->
+ Val = list_to_integer(hd(Val0)),
+ sort_type_data(Type,Data,update_value(Key,Val,Acc),DoTotal);
+ false ->
+ sort_type_data(Type,Data,Acc,DoTotal)
+ end;
+sort_type_data(_Type,[],Acc,DoTotal) ->
+ {Acc,DoTotal}.
+
+%% Sum up allocator data in total blocks- and carriers size for all
+%% allocators and per type of allocator.
+%% Input = Output from sort_allocator_types/3
+%% Output = {[{"mseg_alloc",[{"segments_size",Value}]},
+%% {Type,[{blocks_size,Value},
+%% {carriers_size,Value},
+%% {mseg_carriers_size,Value}]},
+%% ...],
+%% {TotalBlocksSize,TotalCarriersSize}}
+sum_allocator_data(AllocData,false) ->
+ sum_allocator_data(AllocData,[],false);
+sum_allocator_data(AllocData,true) ->
+ sum_allocator_data(AllocData,[],{0,0}).
+
+sum_allocator_data([{_Type,[]}|AllocData],TypeAcc,Total) ->
+ sum_allocator_data(AllocData,TypeAcc,Total);
+sum_allocator_data([{Type,Data}|AllocData],TypeAcc,Total) ->
+ {TypeSum,NewTotal} = sum_type_data(Data,[],Total),
+ sum_allocator_data(AllocData,[{Type,TypeSum}|TypeAcc],NewTotal);
+sum_allocator_data([],TypeAcc,Total) ->
+ {TypeAcc,Total}.
+
+sum_type_data([{Key,Value}|Data],TypeAcc,Total) ->
+ NewTotal =
+ case Total of
+ false ->
+ false;
+ {TotalBS,TotalCS} ->
+ case lists:member(Key,?total_blocks_size) of
+ true ->
+ {TotalBS+Value,TotalCS};
+ false ->
+ case lists:member(Key,?total_carriers_size) of
+ true ->
+ {TotalBS,TotalCS+Value};
+ false ->
+ {TotalBS,TotalCS}
+ end
+ end
+ end,
+ NewTypeAcc =
+ case lists:member(Key,?type_blocks_size) of
+ true ->
+ update_value(blocks_size,Value,TypeAcc);
+ false ->
+ case lists:member(Key,?type_carriers_size) of
+ true ->
+ update_value(carriers_size,Value,TypeAcc);
+ false ->
+ case lists:member(Key,?type_mseg_carriers_size) of
+ true ->
+ update_value(mseg_carriers_size,Value,TypeAcc);
+ false ->
+ %% "segments_size" for "mseg_alloc"
+ update_value(Key,Value,TypeAcc)
+ end
+ end
+ end,
+ sum_type_data(Data,NewTypeAcc,NewTotal);
+sum_type_data([],TypeAcc,Total) ->
+ {TypeAcc,Total}.
+
+update_value(Key,Value,Acc) ->
+ case lists:keytake(Key,1,Acc) of
+ false ->
+ [{Key,Value}|Acc];
+ {value,{Key,Old},Acc1} ->
+ [{Key,Old+Value}|Acc1]
+ end.
+
%%-----------------------------------------------------------------
%% Page with hash table information
hash_tables(File) ->
diff --git a/lib/observer/src/crashdump_viewer.hrl b/lib/observer/src/crashdump_viewer.hrl
index 466f33b63b..2e0ea5cf96 100644
--- a/lib/observer/src/crashdump_viewer.hrl
+++ b/lib/observer/src/crashdump_viewer.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2013. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -18,7 +18,7 @@
%%
-define(space, "&nbsp;").
-define(unknown, "unknown").
-
+-define(r16b01_dump_vsn, [0,2]). % =erl_crash_dump:0.2
-record(menu_item,{index,picture,text,depth,children,state,target}).
@@ -83,6 +83,7 @@
old_heap_start=?space,
old_heap_top=?space,
old_heap_end=?space,
+ memory,
stack_dump=?space}).
-record(port,
diff --git a/lib/observer/src/crashdump_viewer_html.erl b/lib/observer/src/crashdump_viewer_html.erl
index 3151b83bfb..93c1a842b5 100644
--- a/lib/observer/src/crashdump_viewer_html.erl
+++ b/lib/observer/src/crashdump_viewer_html.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2013. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -333,7 +333,13 @@ proc_details_body(Heading,Proc,TW,SharedHeap) ->
td("COLSPAN=1",href_proc_port(Proc#proc.parent))]),
tr(
[td("NOWRAP=true",b("Reductions")),
- td("COLSPAN=3",integer_to_list(Proc#proc.reds))]),
+ td("COLSPAN=1",integer_to_list(Proc#proc.reds))] ++
+ case Proc#proc.memory of
+ undefined -> []; % before R16B01
+ Mem ->
+ [td("NOWRAP=true",b("Memory (bytes)")),
+ td("COLSPAN=1",integer_to_list(Mem))]
+ end),
if SharedHeap ->
Stack = case Proc#proc.stack_heap of
-1 -> "unknown";
@@ -815,12 +821,26 @@ allocator_info_body(Heading,Allocators,TW) ->
[heading(Heading,"memory"),
warn(TW),
p(b("Sizes are in bytes")),
- lists:map(fun({SubTitle,Allocator}) ->
+ lists:map(fun({Head,Allocator}) ->
+ TableHead =
+ case Head of
+ {SubTitle,Columns} ->
+ tr("BGCOLOR=\"#8899AA\"",
+ [th("ALIGN=left",
+ font("SIZE=+1",SubTitle)) |
+ lists:map(
+ fun(CH) ->
+ th("ALIGN=right",CH)
+ end,
+ Columns)]);
+ SubTitle ->
+ tr("BGCOLOR=\"#8899AA\"",
+ th("COLSPAN=10 ALIGN=left",
+ font("SIZE=+1",SubTitle)))
+ end,
[table(
"BORDER=4 CELLPADDING=4",
- [tr("BGCOLOR=\"#8899AA\"",
- th("COLSPAN=10 ALIGN=left",
- font("SIZE=+1",SubTitle))) |
+ [TableHead |
lists:map(
fun({Key,Values}) ->
tr([th("ALIGN=left",Key) |
@@ -1243,8 +1263,8 @@ replace_insrt([],[],Acc) ->
%%% Create a page with one table by delivering chunk by chunk to
%%% inets. crashdump_viewer first calls chunk_page/5 once, then
%%% chunk/3 multiple times until all data is delivered.
-chunk_page(processes,SessionId,TW,{Sorted,SharedHeap},FirstChunk) ->
- Columns = procs_summary_table_head(Sorted,SharedHeap),
+chunk_page(processes,SessionId,TW,{Sorted,SharedHeap,DumpVsn},FirstChunk) ->
+ Columns = procs_summary_table_head(Sorted,SharedHeap,DumpVsn),
chunk_page(SessionId, "Process Information", TW, FirstChunk,
"processes", Columns, fun procs_summary_table/1);
chunk_page(ports,SessionId,TW,_,FirstChunk) ->
@@ -1321,35 +1341,45 @@ deliver(SessionId,IoList) ->
%%%-----------------------------------------------------------------
%%% Page specific stuff for chunk pages
-procs_summary_table_head(Sorted,SharedHeap) ->
+procs_summary_table_head(Sorted,SharedHeap,DumpVsn) ->
MemHeading =
- if SharedHeap ->
- "Stack";
+ if DumpVsn>=?r16b01_dump_vsn ->
+ "Memory (bytes)";
true ->
- "Stack+heap"
+ if SharedHeap ->
+ "Stack";
+ true ->
+ "Stack+heap"
+ end
end,
- [procs_summary_table_head("pid","Pid",Sorted),
- procs_summary_table_head("name_func","Name/Spawned as",Sorted),
- procs_summary_table_head("state","State",Sorted),
- procs_summary_table_head("reds","Reductions",Sorted),
- procs_summary_table_head("mem",MemHeading,Sorted),
- procs_summary_table_head("msg_q_len","MsgQ Length",Sorted)].
-
-procs_summary_table_head(_,Text,no_sort) ->
+ [procs_summary_table_head1("pid","Pid",Sorted),
+ procs_summary_table_head1("name_func","Name/Spawned as",Sorted),
+ procs_summary_table_head1("state","State",Sorted),
+ procs_summary_table_head1("reds","Reductions",Sorted),
+ procs_summary_table_head1("mem",MemHeading,Sorted),
+ procs_summary_table_head1("msg_q_len","MsgQ Length",Sorted)].
+
+procs_summary_table_head1(_,Text,no_sort) ->
Text;
-procs_summary_table_head(Sorted,Text,Sorted) ->
+procs_summary_table_head1(Sorted,Text,Sorted) ->
%% Mark the sorted column (bigger and italic)
font("SIZE=\"+1\"",em(href("./sort_procs?sort="++Sorted,Text)));
-procs_summary_table_head(SortOn,Text,_Sorted) ->
+procs_summary_table_head1(SortOn,Text,_Sorted) ->
href("./sort_procs?sort="++SortOn,Text).
procs_summary_table(Proc) ->
#proc{pid=Pid,name=Name,state=State,
- reds=Reds,stack_heap=Mem0,msg_q_len=MsgQLen}=Proc,
- Mem = case Mem0 of
- -1 -> "unknown";
- _ -> integer_to_list(Mem0)
- end,
+ reds=Reds,stack_heap=Stack,memory=Memory,msg_q_len=MsgQLen}=Proc,
+ Mem =
+ case Memory of
+ undefined -> % assuming pre-R16B01
+ case Stack of
+ -1 -> "unknown";
+ _ -> integer_to_list(Stack)
+ end;
+ _ ->
+ integer_to_list(Memory)
+ end,
tr(
[td(href(["./proc_details?pid=",Pid],Pid)),
td(Name),
diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl
index 4077f8371a..f7712cf3da 100644
--- a/lib/observer/src/observer_lib.erl
+++ b/lib/observer/src/observer_lib.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2011-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2011-2013. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -122,7 +122,10 @@ fill_info([{Str, Key}|Rest], Data) when is_atom(Key); is_function(Key) ->
[{Str, get_value(Key, Data)} | fill_info(Rest, Data)];
fill_info([{Str, {Format, Key}}|Rest], Data)
when is_atom(Key); is_function(Key), is_atom(Format) ->
- [{Str, {Format, get_value(Key,Data)}} | fill_info(Rest, Data)];
+ case get_value(Key, Data) of
+ undefined -> [{Str, undefined} | fill_info(Rest, Data)];
+ Value -> [{Str, {Format, Value}} | fill_info(Rest, Data)]
+ end;
fill_info([{Str,SubStructure}|Rest], Data) when is_list(SubStructure) ->
[{Str, fill_info(SubStructure, Data)}|fill_info(Rest,Data)];
fill_info([{Str,Attrib,SubStructure}|Rest], Data) ->
diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl
index 45218c177b..f234218017 100644
--- a/lib/observer/src/observer_procinfo.erl
+++ b/lib/observer/src/observer_procinfo.erl
@@ -64,6 +64,7 @@ init([Pid, ParentFrame, Parent]) ->
MessagePage = init_panel(Notebook, "Messages", Pid, fun init_message_page/2),
DictPage = init_panel(Notebook, "Dictionary", Pid, fun init_dict_page/2),
StackPage = init_panel(Notebook, "Stack Trace", Pid, fun init_stack_page/2),
+ StatePage = init_panel(Notebook, "State", Pid, fun init_state_page/2),
wxFrame:connect(Frame, close_window),
wxMenu:connect(Frame, command_menu_selected),
@@ -72,7 +73,7 @@ init([Pid, ParentFrame, Parent]) ->
{Frame, #state{parent=Parent,
pid=Pid,
frame=Frame,
- pages=[ProcessPage,MessagePage,DictPage,StackPage]
+ pages=[ProcessPage,MessagePage,DictPage,StackPage,StatePage]
}}
catch error:{badrpc, _} ->
observer_wx:return_to_localnode(ParentFrame, node(Pid)),
@@ -235,6 +236,59 @@ init_stack_page(Parent, Pid) ->
Update(),
{LCtrl, Update}.
+
+init_state_page(Parent, Pid) ->
+ Text = init_text_page(Parent),
+ Update = fun() ->
+ %% First, test if sys:get_status/2 have any chance to return an answer
+ case rpc:call(node(Pid), proc_lib, translate_initial_call, [Pid])
+ of
+ %% Not a gen process
+ {proc_lib,init_p,5} -> Misc = [{"Information", "Not available"}];
+ %% May be a gen process
+ {M, _F, _A} ->
+ %% Get the behavio(u)r
+ I = rpc:call(node(Pid), M, module_info, [attributes]),
+ case lists:keyfind(behaviour, 1, I) of
+ false -> case lists:keyfind(behavior, 1, I) of
+ false -> B = undefined;
+ {behavior, [B]} -> B
+ end;
+ {behaviour, [B]} -> B
+ end,
+ %% but not sure that system messages are treated by this process
+ %% so using a rpc with a small timeout in order not to lag the display
+ case rpc:call(node(Pid), sys, get_status, [Pid, 200])
+ of
+ {status, _, {module, _}, [_PDict, _SysState, _Parent, _Dbg,
+ [Header,{data, First},{data, Second}]]} ->
+ Misc = [{"Behaviour", B}] ++ [Header] ++ First ++ Second;
+ {status, _, {module, _}, [_PDict, _SysState, _Parent, _Dbg,
+ [Header,{data, First}, OtherFormat]]} ->
+ Misc = [{"Behaviour", B}] ++ [Header] ++ First ++ [{"State",OtherFormat}];
+ {status, _, {module, _}, [_PDict, _SysState, _Parent, _Dbg,
+ OtherFormat]} ->
+ %% Formatted status ?
+ case lists:keyfind(format_status, 1, rpc:call(node(Pid), M, module_info, [exports])) of
+ false -> Opt = {"Format", unknown};
+ _ -> Opt = {"Format", overriden}
+ end,
+ Misc = [{"Behaviour", B}] ++ [Opt, {"State",OtherFormat}];
+ {badrpc,{'EXIT',{timeout, _}}} ->
+ Misc = [{"Information","Timed out"},
+ {"Tip","system messages are probably not treated by this process"}]
+ end;
+ _ -> Misc=[], throw(process_undefined)
+ end,
+ Dict = [io_lib:format("~-20.s ~tp~n", [K, V]) || {K, V} <- Misc],
+ Last = wxTextCtrl:getLastPosition(Text),
+ wxTextCtrl:remove(Text, 0, Last),
+ wxTextCtrl:writeText(Text, Dict)
+ end,
+ Update(),
+ {Text, Update}.
+
+
create_menus(MenuBar) ->
Menus = [{"File", [#create_menu{id=?wxID_CLOSE, text="Close"}]},
{"View", [#create_menu{id=?REFRESH, text="Refresh\tCtrl-R"}]}],
diff --git a/lib/observer/src/observer_sys_wx.erl b/lib/observer/src/observer_sys_wx.erl
index f00a666a35..31800cf12a 100644
--- a/lib/observer/src/observer_sys_wx.erl
+++ b/lib/observer/src/observer_sys_wx.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2011-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2011-2013. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -37,6 +37,7 @@
parent_notebook,
panel, sizer,
menubar,
+ alloc,
fields,
timer}).
@@ -47,22 +48,28 @@ start_link(Notebook, Parent) ->
init([Notebook, Parent]) ->
SysInfo = observer_backend:sys_info(),
+ AllocInfo = proplists:get_value(alloc_info, SysInfo, []),
{Info, Stat} = info_fields(),
Panel = wxPanel:new(Notebook),
- Sizer = wxBoxSizer:new(?wxHORIZONTAL),
+ Sizer = wxBoxSizer:new(?wxVERTICAL),
+ TopSizer = wxBoxSizer:new(?wxHORIZONTAL),
{FPanel0, _FSizer0, Fields0} =
observer_lib:display_info(Panel, observer_lib:fill_info(Info, SysInfo)),
{FPanel1, _FSizer1, Fields1} =
observer_lib:display_info(Panel, observer_lib:fill_info(Stat, SysInfo)),
- wxSizer:add(Sizer, FPanel0, [{flag, ?wxEXPAND bor ?wxTOP bor ?wxBOTTOM bor ?wxLEFT},
- {proportion, 1}, {border, 5}]),
- wxSizer:add(Sizer, FPanel1, [{flag, ?wxEXPAND bor ?wxTOP bor ?wxBOTTOM bor ?wxRIGHT},
- {proportion, 1}, {border, 5}]),
+ wxSizer:add(TopSizer, FPanel0, [{flag, ?wxEXPAND}, {proportion, 1}]),
+ wxSizer:add(TopSizer, FPanel1, [{flag, ?wxEXPAND}, {proportion, 1}]),
+ BorderFlags = ?wxLEFT bor ?wxRIGHT,
+ MemoryInfo = create_mem_info(Panel, AllocInfo),
+ wxSizer:add(Sizer, TopSizer, [{flag, ?wxEXPAND bor BorderFlags bor ?wxTOP},
+ {proportion, 0}, {border, 5}]),
+ wxSizer:add(Sizer, MemoryInfo, [{flag, ?wxEXPAND bor BorderFlags bor ?wxBOTTOM},
+ {proportion, 1}, {border, 5}]),
wxPanel:setSizer(Panel, Sizer),
Timer = observer_lib:start_timer(10),
{Panel, #sys_wx_state{parent=Parent,
parent_notebook=Notebook,
- panel=Panel, sizer=Sizer,
+ panel=Panel, sizer=Sizer, alloc=MemoryInfo,
timer=Timer, fields=Fields0 ++ Fields1}}.
create_sys_menu(Parent) ->
@@ -70,13 +77,84 @@ create_sys_menu(Parent) ->
#create_menu{id = ?ID_REFRESH_INTERVAL, text = "Refresh interval"}]},
observer_wx:create_menus(Parent, [View]).
-update_syspage(#sys_wx_state{node = Node, fields=Fields, sizer=Sizer}) ->
+update_syspage(#sys_wx_state{node = Node, fields=Fields, sizer=Sizer, alloc=AllocCtrl}) ->
SysInfo = observer_wx:try_rpc(Node, observer_backend, sys_info, []),
+ AllocInfo = proplists:get_value(alloc_info, SysInfo, []),
{Info, Stat} = info_fields(),
observer_lib:update_info(Fields, observer_lib:fill_info(Info, SysInfo) ++
observer_lib:fill_info(Stat, SysInfo)),
+ update_alloc(AllocCtrl, AllocInfo),
wxSizer:layout(Sizer).
+create_mem_info(Panel, Fields) ->
+ Style = ?wxLC_REPORT bor ?wxLC_SINGLE_SEL bor ?wxLC_HRULES bor ?wxLC_VRULES,
+ Grid = wxListCtrl:new(Panel, [{style, Style}]),
+ Li = wxListItem:new(),
+ AddListEntry = fun({Name, Align, DefSize}, Col) ->
+ wxListItem:setText(Li, Name),
+ wxListItem:setAlign(Li, Align),
+ wxListCtrl:insertColumn(Grid, Col, Li),
+ wxListCtrl:setColumnWidth(Grid, Col, DefSize),
+ Col + 1
+ end,
+ ListItems = [{"Allocator Type", ?wxLIST_FORMAT_LEFT, 200},
+ {"Block size (kB)", ?wxLIST_FORMAT_RIGHT, 150},
+ {"Carrier size (kB)",?wxLIST_FORMAT_RIGHT, 150}],
+ lists:foldl(AddListEntry, 0, ListItems),
+ wxListItem:destroy(Li),
+ update_alloc(Grid, Fields),
+ Grid.
+
+update_alloc(Grid, AllocInfo) ->
+ Fields = alloc_info(AllocInfo, [], 0, 0, true),
+ wxListCtrl:deleteAllItems(Grid),
+ Update = fun({Name, BS, CS}, Row) ->
+ wxListCtrl:insertItem(Grid, Row, ""),
+ wxListCtrl:setItem(Grid, Row, 0, observer_lib:to_str(Name)),
+ wxListCtrl:setItem(Grid, Row, 1, observer_lib:to_str(BS div 1024)),
+ wxListCtrl:setItem(Grid, Row, 2, observer_lib:to_str(CS div 1024)),
+ Row + 1
+ end,
+ lists:foldl(Update, 0, Fields),
+ Fields.
+
+alloc_info([{Type,Instances}|Allocators],TypeAcc,TotalBS,TotalCS,IncludeTotal) ->
+ {BS,CS,NewTotalBS,NewTotalCS,NewIncludeTotal} =
+ sum_alloc_instances(Instances,0,0,TotalBS,TotalCS),
+ alloc_info(Allocators,[{Type,BS,CS}|TypeAcc],NewTotalBS,NewTotalCS,
+ IncludeTotal andalso NewIncludeTotal);
+alloc_info([],TypeAcc,TotalBS,TotalCS,IncludeTotal) ->
+ Types = [X || X={_,BS,CS} <- TypeAcc, (BS>0 orelse CS>0)],
+ case IncludeTotal of
+ true ->
+ [{total,TotalBS,TotalCS} | lists:reverse(Types)];
+ false ->
+ lists:reverse(Types)
+ end.
+
+sum_alloc_instances(false,BS,CS,TotalBS,TotalCS) ->
+ {BS,CS,TotalBS,TotalCS,false};
+sum_alloc_instances([{_,_,Data}|Instances],BS,CS,TotalBS,TotalCS) ->
+ {NewBS,NewCS,NewTotalBS,NewTotalCS} =
+ sum_alloc_one_instance(Data,BS,CS,TotalBS,TotalCS),
+ sum_alloc_instances(Instances,NewBS,NewCS,NewTotalBS,NewTotalCS);
+sum_alloc_instances([],BS,CS,TotalBS,TotalCS) ->
+ {BS,CS,TotalBS,TotalCS,true}.
+
+sum_alloc_one_instance([{sbmbcs,[{blocks_size,BS,_,_},{carriers_size,CS,_,_}]}|
+ Rest],OldBS,OldCS,TotalBS,TotalCS) ->
+ sum_alloc_one_instance(Rest,OldBS+BS,OldCS+CS,TotalBS,TotalCS);
+sum_alloc_one_instance([{_,[{blocks_size,BS,_,_},{carriers_size,CS,_,_}]}|
+ Rest],OldBS,OldCS,TotalBS,TotalCS) ->
+ sum_alloc_one_instance(Rest,OldBS+BS,OldCS+CS,TotalBS+BS,TotalCS+CS);
+sum_alloc_one_instance([{_,[{blocks_size,BS},{carriers_size,CS}]}|
+ Rest],OldBS,OldCS,TotalBS,TotalCS) ->
+ sum_alloc_one_instance(Rest,OldBS+BS,OldCS+CS,TotalBS+BS,TotalCS+CS);
+sum_alloc_one_instance([_|Rest],BS,CS,TotalBS,TotalCS) ->
+ sum_alloc_one_instance(Rest,BS,CS,TotalBS,TotalCS);
+sum_alloc_one_instance([],BS,CS,TotalBS,TotalCS) ->
+ {BS,CS,TotalBS,TotalCS}.
+
info_fields() ->
Info = [{"System and Architecture",
[{"System Version", otp_release},
diff --git a/lib/odbc/configure.in b/lib/odbc/configure.in
index fd28830c0c..83f7a47434 100644
--- a/lib/odbc/configure.in
+++ b/lib/odbc/configure.in
@@ -167,7 +167,8 @@ AC_SUBST(TARGET_FLAGS)
AC_CHECK_SIZEOF(void *)
AC_MSG_CHECKING([for odbc in standard locations])
for rdir in /usr/local/odbc /usr/local /usr/odbc \
- /usr /opt/local/pgm/odbc /usr/local/pgm/odbc; do
+ /usr /opt/local/pgm/odbc /usr/local/pgm/odbc \
+ "$with_odbc"; do
test -f "$erl_xcomp_isysroot$rdir/include/sql.h" || continue
is_odbc_std_location=yes
libdir="$erl_xcomp_sysroot$rdir/lib"
diff --git a/lib/reltool/doc/src/reltool_examples.xml b/lib/reltool/doc/src/reltool_examples.xml
index 19a3f37819..de243343ff 100644
--- a/lib/reltool/doc/src/reltool_examples.xml
+++ b/lib/reltool/doc/src/reltool_examples.xml
@@ -261,7 +261,8 @@ Eshell V5.7.3 (abort with ^G)
8&gt; reltool:get_script(Server, "NAME").
{ok,{script,{"NAME","VSN"},
[{preLoaded,[erl_prim_loader,erlang,init,otp_ring0,
- prim_file,prim_inet,prim_zip,zlib]},
+ prim_eval,prim_file,prim_inet,prim_zip,
+ zlib]},
{progress,preloaded},
{path,["$ROOT/lib/kernel-2.13/ebin",
"$ROOT/lib/stdlib-1.16/ebin"]},
diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl
index d1d291d5cb..670e216d97 100644
--- a/lib/runtime_tools/src/observer_backend.erl
+++ b/lib/runtime_tools/src/observer_backend.erl
@@ -49,6 +49,10 @@ vsn() ->
%% observer backend
%%
sys_info() ->
+ MemInfo = try erlang:memory() of
+ Mem -> Mem
+ catch _:_ -> []
+ end,
{{_,Input},{_,Output}} = erlang:statistics(io),
[{process_count, erlang:system_info(process_count)},
{process_limit, erlang:system_info(process_limit)},
@@ -68,9 +72,16 @@ sys_info() ->
{threads, erlang:system_info(threads)},
{thread_pool_size, erlang:system_info(thread_pool_size)},
{wordsize_internal, erlang:system_info({wordsize, internal})},
- {wordsize_external, erlang:system_info({wordsize, external})} |
- erlang:memory()
- ].
+ {wordsize_external, erlang:system_info({wordsize, external})},
+ {alloc_info, alloc_info()}
+ | MemInfo].
+
+alloc_info() ->
+ {_,_,AllocTypes,_} = erlang:system_info(allocator),
+ try erlang:system_info({allocator_sizes,AllocTypes}) of
+ Allocators -> Allocators
+ catch _:_ -> []
+ end.
get_table(Parent, Table, Module) ->
spawn(fun() ->
@@ -274,7 +285,7 @@ etop_collect([P|Ps], Acc) ->
[{registered_name,Reg},{initial_call,Initial},{memory,Mem},
{reductions,Reds},{current_function,Current},{message_queue_len,Qlen}] ->
Name = case Reg of
- [] -> Initial;
+ [] -> initial_call(Initial, P);
_ -> Reg
end,
Info = #etop_proc_info{pid=P,mem=Mem,reds=Reds,name=Name,
@@ -283,6 +294,11 @@ etop_collect([P|Ps], Acc) ->
end;
etop_collect([], Acc) -> Acc.
+initial_call({proc_lib, init_p, _}, Pid) ->
+ proc_lib:translate_initial_call(Pid);
+initial_call(Initial, _Pid) ->
+ Initial.
+
%%
%% ttb backend
%%
diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl
index 193dbb64bf..b2e95fdbee 100644
--- a/lib/sasl/src/systools_make.erl
+++ b/lib/sasl/src/systools_make.erl
@@ -1461,8 +1461,8 @@ mandatory_modules() ->
preloaded() ->
%% Sorted
- [erl_prim_loader,erlang,erts_internal,init,otp_ring0,prim_file,prim_inet,
- prim_zip,zlib].
+ [erl_prim_loader,erlang,erts_internal,init,otp_ring0,prim_eval,prim_file,
+ prim_inet,prim_zip,zlib].
%%______________________________________________________________________
%% Kernel processes; processes that are specially treated by the init
diff --git a/lib/snmp/.gitignore b/lib/snmp/.gitignore
index b82d23e7bd..650c1d6865 100644
--- a/lib/snmp/.gitignore
+++ b/lib/snmp/.gitignore
@@ -1,4 +1,9 @@
# Match at any level.
*.BKP
+*.orig
+*.rej
+
+doc/index.html
+
diff --git a/lib/snmp/doc/src/files.mk b/lib/snmp/doc/src/files.mk
index 61c91c9729..494c550fff 100644
--- a/lib/snmp/doc/src/files.mk
+++ b/lib/snmp/doc/src/files.mk
@@ -41,6 +41,8 @@ XML_AGENT_REF3_FILES = \
snmpa_error_io.xml \
snmpa_error_logger.xml \
snmpa_local_db.xml \
+ snmpa_mib_data.xml \
+ snmpa_mib_storage.xml \
snmpa_mpd.xml \
snmpa_network_interface.xml \
snmpa_network_interface_filter.xml \
diff --git a/lib/snmp/doc/src/notes.xml b/lib/snmp/doc/src/notes.xml
index 5222922848..80de9738f1 100644
--- a/lib/snmp/doc/src/notes.xml
+++ b/lib/snmp/doc/src/notes.xml
@@ -34,6 +34,88 @@
<section>
+ <title>SNMP Development Toolkit 4.24</title>
+ <p>Version 4.24 supports code replacement in runtime from/to
+ version 4.23.1 and 4.23. </p>
+
+ <section>
+ <title>Improvements and new features</title>
+<!--
+ <p>-</p>
+-->
+
+ <list type="bulleted">
+ <item>
+ <p>[agent,manager] Updated to support the new crypto interface. </p>
+ <p>Own Id: OTP-11009</p>
+ </item>
+
+ <item>
+ <p>[agent] Introduced a documented behaviour for the mib-server
+ <seealso marker="snmpa_mib_data">mib-data backend</seealso>.
+ At present only the default module (<c>snmpa_mib_data_tttn</c>) is
+ provided. </p>
+ <p>A config option for the (agent)
+ <seealso marker="snmp_config#agent_mib_server">mib-servers</seealso>
+ mib-data backend module has been added to the agent config options,
+ <seealso marker="snmp_config#agent_ms_data_module">data_module</seealso>. </p>
+ <p>Own Id: OTP-11101</p>
+ </item>
+
+ <item>
+ <p>[agent] Introduced a documented behaviour for the
+ <seealso marker="snmpa_mib_storage">mib storage</seealso>.
+ At present there are three simple modules
+ (<c>snmpa_mib_storage_ets</c>, <c>snmpa_mib_storage_dets</c> and
+ <c>snmpa_mib_storage_mnesia</c>) implement�ng this behaviour,
+ provided with the app. </p>
+ <p>A config option for the (agent)
+ <seealso marker="snmp_config#agent_mib_storage">mib storage</seealso>
+ has been added to the agent config options. </p>
+ <p>Own Id: OTP-11107</p>
+ </item>
+
+ </list>
+
+ </section>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <p>-</p>
+
+<!--
+ <list type="bulleted">
+ <item>
+ <p>[agent,manager] Updated to support the new crypto interface. </p>
+ <p>Own Id: OTP-11009</p>
+ </item>
+
+ </list>
+-->
+
+ </section>
+
+ <section>
+ <title>Incompatibilities</title>
+ <p>-</p>
+
+<!--
+ <list type="bulleted">
+ <item>
+ <p>[manager] The old Addr-and-Port based API functions, previously
+ long deprecated and marked for deletion in R16B, has now been
+ removed. </p>
+ <p>Own Id: OTP-10027</p>
+ </item>
+
+ </list>
+-->
+ </section>
+
+ </section> <!-- 4.24 -->
+
+
+ <section>
<title>SNMP Development Toolkit 4.23.1</title>
<p>Version 4.23.1 supports code replacement in runtime from/to
version 4.23. </p>
@@ -1017,135 +1099,6 @@
</section> <!-- 4.20 -->
- <section>
- <title>SNMP Development Toolkit 4.19</title>
- <p>Version 4.19 supports code replacement in runtime from/to
- version 4.18.</p>
-
- <section>
- <title>Improvements and new features</title>
-<!--
- <p>-</p>
--->
- <list type="bulleted">
- <item>
- <p>[compiler] Added support for textual convention
- <c>AGENT-CAPABILITIES</c> and "full" support for textual
- convention MODULE-COMPLIANCE, both defined by the SNMPv2-CONF
- mib.</p>
- <p>The <c>reference</c> and <c>modules</c> part(s) are
- stored in the <c>assocList</c> of the mib-entry (<c>me</c>)
- record.
- Only handled <em>if</em> the option(s) <c>agent_capabilities</c>
- and <c>module_compliance</c> (respectively) are provided to the
- compiler. </p>
- <p>See <seealso marker="snmpc#compile">compile/2</seealso>
- for more info. </p>
- <p>For backward compatibillity, the MIBs provided with
- this application are <em>not</em> compiled with these
- options. </p>
- <p>Own Id: OTP-8966</p>
- </item>
-
- <item>
- <p>[agent] Added a "complete" set of (snmp) table and variable
- print functions, for each mib handled by the SNMP (agent)
- application. This will be usefull when debugging a running agent.</p>
- <p>See
- <seealso marker="snmpa#print_mib_info">print_mib_info/0</seealso>,
- <seealso marker="snmpa#print_mib_tables">print_mib_tables/0</seealso>
- and
- <seealso marker="snmpa#print_mib_variables">print_mib_variables/0</seealso>
- for more info. </p>
- <p>Own Id: OTP-8977</p>
- </item>
-
- <item>
- <p>[compiler] Added a MIB compiler (frontend) escript,
- <c>snmpc</c>. </p>
- <p>Own Id: OTP-9004</p>
- </item>
-
- </list>
- </section>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
-<!--
- <p>-</p>
--->
- <list type="bulleted">
- <item>
- <p>[agent] For the table vacmAccessTable,
- when performing the is_set_ok and set operation(s),
- all values of the vacmAccessSecurityModel column was
- incorrectly translated to <c>any</c>. </p>
-<!--
-that is when calling:
-snmp_view_basec_acm_mib:vacmAccessTable(set, RowIndex, Cols).
--->
- <p>Own Id: OTP-8980</p>
- </item>
-
- <item>
- <p>[agent] When calling
- <seealso marker="snmp_view_based_acm_mib#reconfigure">snmp_view_based_acm_mib:reconfigure/1</seealso>
- on a running node, the table <c>vacmAccessTable</c> was not properly
- cleaned.
- This meant that if some entries in the vacm.conf file was removed
- (compared to the <c>current</c> config),
- while others where modified and/or added, the removed entrie(s)
- would still exist in the <c>vacmAccessTable</c> table. </p>
- <p>Own Id: OTP-8981</p>
- <p>Aux Id: Seq 11750</p>
- </item>
-
- </list>
- </section>
-
-
- <section>
- <title>Incompatibilities</title>
- <p>-</p>
- </section>
-
- </section> <!-- 4.19 -->
-
-
- <section>
- <title>SNMP Development Toolkit 4.18</title>
- <p>Version 4.18 supports code replacement in runtime from/to
- version 4.17.1 and 4.17.</p>
-
- <section>
- <title>Improvements and new features</title>
- <list type="bulleted">
- <item>
- <p>Prepared for R14B release.</p>
- </item>
- </list>
- </section>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <p>-</p>
-<!--
- <list type="bulleted">
- <item>
- <p>[agent] When the function FilterMod:accept_recv/2 returned false
- the SNMP agent stopped collecting messages from UDP.</p>
- <p>Own Id: OTP-8761</p>
- </item>
- </list>
--->
- </section>
-
- <section>
- <title>Incompatibilities</title>
- <p>-</p>
- </section>
- </section> <!-- 4.18 -->
-
-
<!-- section>
<title>Release notes history</title>
<p>For information about older versions see
diff --git a/lib/snmp/doc/src/ref_man.xml b/lib/snmp/doc/src/ref_man.xml
index 92e8927f6d..628b30b11a 100644
--- a/lib/snmp/doc/src/ref_man.xml
+++ b/lib/snmp/doc/src/ref_man.xml
@@ -44,6 +44,8 @@
<xi:include href="snmpa_error_io.xml"/>
<xi:include href="snmpa_error_logger.xml"/>
<xi:include href="snmpa_local_db.xml"/>
+ <xi:include href="snmpa_mib_data.xml"/>
+ <xi:include href="snmpa_mib_storage.xml"/>
<xi:include href="snmpa_mpd.xml"/>
<xi:include href="snmpa_network_interface.xml"/>
<xi:include href="snmpa_network_interface_filter.xml"/>
diff --git a/lib/snmp/doc/src/snmp_app.xml b/lib/snmp/doc/src/snmp_app.xml
index 62dfa515d1..e5a05342c1 100644
--- a/lib/snmp/doc/src/snmp_app.xml
+++ b/lib/snmp/doc/src/snmp_app.xml
@@ -4,7 +4,7 @@
<appref>
<header>
<copyright>
- <year>1997</year><year>2012</year>
+ <year>1997</year><year>2013</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -311,36 +311,125 @@
<p>Default is <c>[]</c>.</p>
</item>
- <marker id="agent_mib_storage"></marker>
- <tag><c><![CDATA[mib_storage() = ets | {ets, Dir} | {ets, Dir, Action} | dets | {dets, Dir} | {dets, Dir, Action} | mnesia | {mnesia, Nodes} | {mnesia, Nodes, Action} <optional>]]></c></tag>
- <item>
- <p>Specifies how info retrieved from the mibs will be stored.</p>
- <p>If <c>mib_storage</c> is <c>{ets, Dir}</c>, the table will also be
- stored on file. If <c>Dir</c> is <c>default</c>, then <c>db_dir</c>
- will be used.</p>
- <p>If <c>mib_storage</c> is <c>dets</c> or if <c>Dir</c> is
- <c>default</c>, then <c>db_dir</c> will be used for <c>Dir</c>.</p>
- <p>If <c>mib_storage</c> is <c>mnesia</c> then <c>erlang:nodes()</c>
- will be used for <c>Nodes</c>.</p>
- <p>Default is <c>ets</c>. </p>
- <p><c>Dir = default | string()</c>. Dir is the directory where the
- files will be stored. If <c>default</c>, then <c>db_dir</c> will be
- used.</p>
- <p><c>Nodes = visible | connected | [node()]</c>.
- <c>Nodes = visible</c> is translated to
- <c>erlang:nodes(visible)</c>.
- <c>Nodes = connected</c> is translated to
- <c>erlang:nodes(connected)</c>.
- If <c>Nodes = []</c> then the own node is assumed.</p>
- <p><c>Action = clear | keep</c>. Default is <c>keep</c>.
- <c>Action</c> is used to specify what shall be done if the
- mnesia/dets table already exist.</p>
+ <marker id="agent_mib_storage"></marker>
+ <tag><c><![CDATA[mib_storage() = [mib_storage_opt()] <optional>]]></c></tag>
+ <item>
+ <p><c>mib_storage_opt() = {module, mib_storage_module()} | {options, mib_storage_options()}</c></p>
+ <p>This option specifies how basic mib data is stored.
+ This option is used by two parts of the snmp agent:
+ The mib-server and the symbolic-store. </p>
+ <p>Default is <c>[{module, snmpa_mib_storage_ets}]</c>. </p>
+ </item>
+
+ <marker id="agent_mst_module"></marker>
+ <tag><c><![CDATA[mib_storage_module() = snmpa_mib_data_ets | snmpa_mib_data_dets | snmpa_mib_data_mnesia | module()]]></c></tag>
+ <item>
+ <p>Defines the mib storage module of the SNMP agent as defined by the
+ <seealso marker="snmpa_mib_storage">snmpa_mib_storage</seealso>
+ behaviour. </p>
+ <p>Several entities (<c>mib-server</c> via the its data module and
+ the <c>symbolic-store</c>) of the snmp agent uses this for storage
+ of miscelaneous mib related data retrieved while loading a mib. </p>
+ <p>There are several implementations provided with the agent:
+ <c>snmpa_mib_storage_ets</c>, <c>snmpa_mib_storage_dets</c> and
+ <c>snmpa_mib_storage_mnesia</c>. </p>
+ <p>Default module is <c>snmpa_mib_storage_ets</c>. </p>
+ </item>
+
+ <marker id="agent_mst_options"></marker>
+ <tag><c><![CDATA[mib_storage_options() = list() <optional>]]></c></tag>
+ <item>
+ <p>This is implementattion depended. That is, it depends on the
+ module. For each module a specific set of options are valid.
+ For the module provided with the app, these options are supported: </p>
+ <list type="bulleted">
+ <item>
+ <p><c>snmpa_mib_storage_ets</c>: <c>{dir, filename()} | {action, keep | clear}, {checksum, boolean()}</c></p>
+ <list>
+ <item>
+ <p><c>dir</c> - If present, points to a directory where a file
+ to which all data in the ets table is "synced". </p>
+ <p>Also, when a table is opened this file is read,
+ if it exists. </p>
+ <p>By default, this will <em>not</em> be used. </p>
+ </item>
+ <item>
+ <p><c>action</c> - Specifies the behaviour when a non-empty
+ file is found: Keep its content or clear it out. </p>
+ <p>Default is <c>keep</c>. </p>
+ </item>
+ <item>
+ <p><c>checksum</c> - Defines if the file is checksummed
+ or not. </p>
+ <p>Default is <c>false</c>. </p>
+ </item>
+ </list>
+ </item>
+ <item>
+ <p><c>snmpa_mib_storage_dets</c>: <c>{dir, filename()} | {action, keep | clear}, {auto_save, default | pos_integer()} | {repair, force | boolean()}</c></p>
+ <list>
+ <item>
+ <p><c>dir</c> - This <em>mandatory</em> option points to a
+ directory where to place the file of a dets table. </p>
+ </item>
+ <item>
+ <p><c>action</c> - Specifies the behaviour when a non-empty
+ file is found: Keep its content or clear it out. </p>
+ <p>Default is <c>keep</c>. </p>
+ </item>
+ <item>
+ <p><c>auto_save</c> - Defines the dets auto-save frequency. </p>
+ <p>Default is <c>default</c>. </p>
+ </item>
+ <item>
+ <p><c>repair</c> - Defines the dets repair behaviour. </p>
+ <p>Default is <c>false</c>. </p>
+ </item>
+ </list>
+ </item>
+ <item>
+ <p><c>snmpa_mib_storage_mnesia</c>: <c>{action, keep | clear}, {nodes, [node()]}</c></p>
+ <list>
+ <item>
+ <p><c>action</c> - Specifies the behaviour when a non-empty,
+ already existing, table: Keep its content or clear it out. </p>
+ <p>Default is <c>keep</c>. </p>
+ </item>
+ <item>
+ <p><c>nodes</c> - A list of node names (or an atom
+ describing a list of nodes) defining where to open the table.
+ Its up to the user to ensure that mnesia is actually running
+ on the specified nodes. </p>
+ <p>The following distinct values are recognised: </p>
+ <list>
+ <item>
+ <p><c>[]</c> - Translated into a list of the own node: <c>[node()]</c></p>
+ </item>
+ <item>
+ <p><c>all</c> - <c>erlang:nodes()</c></p>
+ </item>
+ <item>
+ <p><c>visible</c> - <c>erlang:nodes(visible)</c></p>
+ </item>
+ <item>
+ <p><c>connected</c> - <c>erlang:nodes(connected)</c></p>
+ </item>
+ <item>
+ <p><c>db_nodes</c> - <c>mnesia:system_info(db_nodes)</c></p>
+ </item>
+ </list>
+
+ <p>Default is the result of the call: <c>erlang:nodes()</c>. </p>
+ </item>
+ </list>
+ </item>
+ </list>
</item>
<marker id="agent_mib_server"></marker>
<tag><c><![CDATA[mib_server() = [mib_server_opt()] <optional>]]></c></tag>
<item>
- <p><c>mib_server_opt() = {mibentry_override, mibentry_override()} | {trapentry_override, trapentry_override()} | {verbosity, verbosity()} | {cache, mibs_cache()}</c></p>
+ <p><c>mib_server_opt() = {mibentry_override, mibentry_override()} | {trapentry_override, trapentry_override()} | {verbosity, verbosity()} | {cache, mibs_cache()} | {data_module, mib_server_data_module()}</c></p>
<p>Defines options specific for the SNMP agent mib server. </p>
<p>For defaults see the options in <c>mib_server_opt()</c>.</p>
</item>
@@ -365,7 +454,28 @@
<p>Default is <c>false</c>.</p>
</item>
- <marker id="agent_ms_cache"></marker>
+ <marker id="agent_ms_data_module"></marker>
+<!--
+ <tag><c><![CDATA[mib_server_data_module() = snmpa_mib_data_tttn | snmpa_mib_data_ttln | module() <optional>]]></c></tag>
+-->
+ <tag><c><![CDATA[mib_server_data_module() = snmpa_mib_data_tttn | module() <optional>]]></c></tag>
+ <item>
+ <p>Defines the backend data module of the SNMP agent mib-server as
+ defined by the
+ <seealso marker="snmpa_mib_data">snmpa_mib_data</seealso>
+ behaviour. </p>
+ <p>At present only the default module is provided with the agent,
+ <c>snmpa_mib_data_tttn</c>. </p>
+<!--
+ <p>Two modules is provided with the agent
+ <c>snmpa_mib_data_tttn</c> (this is the old implementation) and
+ <c>snmpa_mib_data_ttln</c> (for a mib tree with many holes,
+ this algorithm can be more price efficient). </p>
+-->
+ <p>Default module is <c>snmpa_mib_data_tttn</c>. </p>
+ </item>
+
+ <marker id="agent_ms_cache"></marker>
<tag><c><![CDATA[mibs_cache() = bool() | mibs_cache_opts() <optional>]]></c></tag>
<item>
<p>Shall the agent utilize the mib server lookup cache or not.</p>
@@ -385,30 +495,30 @@
<tag><c><![CDATA[mibs_cache_autogc() = bool() <optional>]]></c></tag>
<item>
<p>Defines if the mib server shall perform cache gc automatically or
- leave it to the user (see
- <seealso marker="snmpa#gc_mibs_cache">gc_mibs_cache/0,1,2,3</seealso>). </p>
+ leave it to the user (see
+ <seealso marker="snmpa#gc_mibs_cache">gc_mibs_cache/0,1,2,3</seealso>). </p>
<p>Default is <c>true</c>.</p>
</item>
<marker id="agent_ms_cache_age"></marker>
<tag><c><![CDATA[mibs_cache_age() = integer() > 0 <optional>]]></c></tag>
<item>
- <p>Defines how old the entries in the cache will be allowed before
- they are GC'ed (assuming GC is performed). Each entry in the
- cache is "touched" whenever it is accessed. </p>
- <p>The age is defined in milliseconds. </p>
- <p>Default is <c>10 timutes</c>.</p>
+ <p>Defines how old the entries in the cache will be allowed
+ to become before they are GC'ed (assuming GC is performed).
+ Each entry in the cache is "touched" whenever it is accessed. </p>
+ <p>The age is defined in milliseconds. </p>
+ <p>Default is <c>10 timutes</c>.</p>
</item>
<marker id="agent_ms_cache_gclimit"></marker>
<tag><c><![CDATA[mibs_cache_gclimit() = integer() > 0 | infinity <optional>]]></c></tag>
<item>
<p>When performing a GC, this is the max number of cache entries
- that will be deleted from the cache. </p>
+ that will be deleted from the cache. </p>
<p>The reason for having this limit is that if the cache is
- large, the GC can potentially take a long time, during which
- the agent is locked. </p>
- <p>Default is <c>100</c>.</p>
+ large, the GC can potentially take a long time, during which
+ the agent is locked. </p>
+ <p>Default is <c>100</c>.</p>
</item>
<marker id="agent_error_report_mod"></marker>
diff --git a/lib/snmp/doc/src/snmp_config.xml b/lib/snmp/doc/src/snmp_config.xml
index eec53162a1..61ee7f00ee 100644
--- a/lib/snmp/doc/src/snmp_config.xml
+++ b/lib/snmp/doc/src/snmp_config.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>1997</year><year>2012</year>
+ <year>1997</year><year>2013</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -308,6 +308,126 @@
<p>Default is <c>[]</c>.</p>
</item>
+ <marker id="agent_mib_storage"></marker>
+ <tag><c><![CDATA[mib_storage() = [mib_storage_opt()] <optional>]]></c></tag>
+ <item>
+ <p><c>mib_storage_opt() = {module, mib_storage_module()} | {options, mib_storage_options()}</c></p>
+ <p>This option specifies how basic mib data is stored.
+ This option is used by two parts of the snmp agent:
+ The mib-server and the symbolic-store. </p>
+ <p>Default is <c>[{module, snmpa_mib_storage_ets}]</c>. </p>
+ </item>
+
+ <marker id="agent_mst_module"></marker>
+ <tag><c><![CDATA[mib_storage_module() = snmpa_mib_data_ets | snmpa_mib_data_dets | snmpa_mib_data_mnesia | module()]]></c></tag>
+ <item>
+ <p>Defines the mib storage module of the SNMP agent as defined by the
+ <seealso marker="snmpa_mib_storage">snmpa_mib_storage</seealso>
+ behaviour. </p>
+ <p>Several entities (<c>mib-server</c> via the its data module and
+ the <c>symbolic-store</c>) of the snmp agent uses this for storage
+ of miscelaneous mib related data dataretrieved while loading a mib. </p>
+ <p>There are several implementations provided with the agent:
+ <c>snmpa_mib_storage_ets</c>, <c>snmpa_mib_storage_dets</c> and
+ <c>snmpa_mib_storage_mnesia</c>. </p>
+ <p>Default module is <c>snmpa_mib_storage_ets</c>. </p>
+ </item>
+
+ <marker id="agent_mst_options"></marker>
+ <tag><c><![CDATA[mib_storage_options() = list() <optional>]]></c></tag>
+ <item>
+ <p>This is implementattion depended. That is, it depends on the
+ module. For each module a specific set of options are valid.
+ For the module provided with the app, these options are supported: </p>
+ <list type="bulleted">
+ <item>
+ <p><c>snmpa_mib_storage_ets</c>: <c>{dir, filename()} | {action, keep | clear}, {checksum, boolean()}</c></p>
+ <list>
+ <item>
+ <p><c>dir</c> - If present, points to a directory where a file
+ to which all data in the ets table is "synced". </p>
+ <p>Also, when a table is opened this file is read,
+ if it exists. </p>
+ <p>By default, this will <em>not</em> be used. </p>
+ </item>
+ <item>
+ <p><c>action</c> - Specifies the behaviour when a non-empty
+ file is found: Keep its content or clear it out. </p>
+ <p>Default is <c>keep</c>. </p>
+ </item>
+ <item>
+ <p><c>checksum</c> - Defines if the file is checksummed
+ or not. </p>
+ <p>Default is <c>false</c>. </p>
+ </item>
+ </list>
+ </item>
+ <item>
+ <p><c>snmpa_mib_storage_dets</c>: <c>{dir, filename()} | {action, keep | clear}, {auto_save, default | pos_integer()} | {repair, force | boolean()}</c></p>
+ <list>
+ <item>
+ <p><c>dir</c> - This <em>mandatory</em> option points to a
+ directory where to place the file of a dets table. </p>
+ </item>
+ <item>
+ <p><c>action</c> - Specifies the behaviour when a non-empty
+ file is found: Keep its content or clear it out. </p>
+ <p>Default is <c>keep</c>. </p>
+ </item>
+ <item>
+ <p><c>auto_save</c> - Defines the dets auto-save frequency. </p>
+ <p>Default is <c>default</c>. </p>
+ </item>
+ <item>
+ <p><c>repair</c> - Defines the dets repair behaviour. </p>
+ <p>Default is <c>false</c>. </p>
+ </item>
+ </list>
+ </item>
+ <item>
+ <p><c>snmpa_mib_storage_mnesia</c>: <c>{action, keep | clear}, {nodes, [node()]}</c></p>
+ <list>
+ <item>
+ <p><c>action</c> - Specifies the behaviour when a non-empty,
+ already existing, table: Keep its content or clear it out. </p>
+ <p>Default is <c>keep</c>. </p>
+ </item>
+ <item>
+ <p><c>nodes</c> - A list of node names (or an atom
+ describing a list of nodes) defining where to open the table.
+ Its up to the user to ensure that mnesia is actually running
+ on the specified nodes. </p>
+ <p>The following distinct values are recognised: </p>
+ <list>
+ <item>
+ <p><c>[]</c> - Translated into a list of the own node: <c>[node()]</c></p>
+ </item>
+ <item>
+ <p><c>all</c> - <c>erlang:nodes()</c></p>
+ </item>
+ <item>
+ <p><c>visible</c> - <c>erlang:nodes(visible)</c></p>
+ </item>
+ <item>
+ <p><c>connected</c> - <c>erlang:nodes(connected)</c></p>
+ </item>
+ <item>
+ <p><c>db_nodes</c> - <c>mnesia:system_info(db_nodes)</c></p>
+ </item>
+ </list>
+
+ <p>Default is the result of the call: <c>erlang:nodes()</c>. </p>
+ </item>
+ </list>
+ </item>
+ </list>
+ </item>
+
+<!--
+
+This is the old format which is "supported", but not documented,
+in so far as it will be converted to the new format if found.
+
<marker id="agent_mib_storage"></marker>
<tag><c><![CDATA[mib_storage() = ets | {ets, Dir} | {ets, Dir, Action} | dets | {dets, Dir} | {dets, Dir, Action} | mnesia | {mnesia, Nodes} | {mnesia, Nodes, Action} <optional>]]></c></tag>
<item>
@@ -333,11 +453,12 @@
<c>Action</c> is used to specify what shall be done if the
mnesia/dets table already exist.</p>
</item>
+-->
<marker id="agent_mib_server"></marker>
<tag><c><![CDATA[mib_server() = [mib_server_opt()] <optional>]]></c></tag>
<item>
- <p><c>mib_server_opt() = {mibentry_override, mibentry_override()} | {trapentry_override, trapentry_override()} | {verbosity, verbosity()} | {cache, mibs_cache()}</c></p>
+ <p><c>mib_server_opt() = {mibentry_override, mibentry_override()} | {trapentry_override, trapentry_override()} | {verbosity, verbosity()} | {cache, mibs_cache()} | {data_module, mib_server_data_module()}</c></p>
<p>Defines options specific for the SNMP agent mib server. </p>
<p>For defaults see the options in <c>mib_server_opt()</c>.</p>
</item>
@@ -362,6 +483,27 @@
<p>Default is <c>false</c>.</p>
</item>
+ <marker id="agent_ms_data_module"></marker>
+<!--
+ <tag><c><![CDATA[mib_server_data_module() = snmpa_mib_data_tttn | snmpa_mib_data_ttln | module() <optional>]]></c></tag>
+-->
+ <tag><c><![CDATA[mib_server_data_module() = snmpa_mib_data_tttn | module() <optional>]]></c></tag>
+ <item>
+ <p>Defines the backend data module of the SNMP agent mib-server as
+ defined by the
+ <seealso marker="snmpa_mib_data">snmpa_mib_data</seealso>
+ behaviour. </p>
+ <p>At present only the default module is provided with the agent,
+ <c>snmpa_mib_data_tttn</c>. </p>
+<!--
+ <p>Two modules is provided with the agent
+ <c>snmpa_mib_data_tttn</c> (this is the old implementation) and
+ <c>snmpa_mib_data_ttln</c> (for a mib tree with many holes,
+ this algorithm can be more price efficient). </p>
+-->
+ <p>Default module is <c>snmpa_mib_data_tttn</c>. </p>
+ </item>
+
<marker id="agent_ms_cache"></marker>
<tag><c><![CDATA[mibs_cache() = bool() | mibs_cache_opts() <optional>]]></c></tag>
<item>
@@ -382,18 +524,18 @@
<tag><c><![CDATA[mibs_cache_autogc() = bool() <optional>]]></c></tag>
<item>
<p>Defines if the mib server shall perform cache gc automatically or
- leave it to the user (see
- <seealso marker="snmpa#gc_mibs_cache">gc_mibs_cache/0,1,2,3</seealso>). </p>
- <p>Default is <c>true</c>.</p>
+ leave it to the user (see
+ <seealso marker="snmpa#gc_mibs_cache">gc_mibs_cache/0,1,2,3</seealso>). </p>
+ <p>Default is <c>true</c>.</p>
</item>
<marker id="agent_ms_cache_age"></marker>
<tag><c><![CDATA[mibs_cache_age() = integer() > 0 <optional>]]></c></tag>
<item>
- <p>Defines how old the entries in the cache will be allowed before
- they are GC'ed (assuming GC is performed). Each entry in the
- cache is "touched" whenever it is accessed. </p>
- <p>The age is defined in milliseconds. </p>
+ <p>Defines how old the entries in the cache will be allowed
+ to become before they are GC'ed (assuming GC is performed).
+ Each entry in the cache is "touched" whenever it is accessed. </p>
+ <p>The age is defined in milliseconds. </p>
<p>Default is <c>10 timutes</c>.</p>
</item>
@@ -401,11 +543,11 @@
<tag><c><![CDATA[mibs_cache_gclimit() = integer() > 0 | infinity <optional>]]></c></tag>
<item>
<p>When performing a GC, this is the max number of cache entries
- that will be deleted from the cache. </p>
- <p>The reason for having this limit is that if the cache is
- large, the GC can potentially take a long time, during which
- the agent is locked. </p>
- <p>Default is <c>100</c>.</p>
+ that will be deleted from the cache. </p>
+ <p>The reason for having this limit is that if the cache is
+ large, the GC can potentially take a long time, during which
+ the agent is locked. </p>
+ <p>Default is <c>100</c>.</p>
</item>
<marker id="agent_error_report_mod"></marker>
diff --git a/lib/snmp/doc/src/snmpa_mib_data.xml b/lib/snmp/doc/src/snmpa_mib_data.xml
new file mode 100644
index 0000000000..ff07a03b98
--- /dev/null
+++ b/lib/snmp/doc/src/snmpa_mib_data.xml
@@ -0,0 +1,392 @@
+<?xml version="1.0" encoding="iso-8859-1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>2013</year><year>2013</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>snmpa_mib_data</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ <file>snmpa_mib_data.xml</file>
+ </header>
+
+ <module>snmpa_mib_data</module>
+ <modulesummary>Behaviour module for the SNMP agent mib-server
+ data module.</modulesummary>
+ <description>
+ <p>This module defines the behaviour of the SNMP agent mib-server
+ data module. A <c>snmpa_mib_data</c> compliant module
+ must export the following functions: </p>
+ <list type="bulleted">
+ <item>
+ <seealso marker="#new">new/1</seealso>
+ </item>
+ <item>
+ <seealso marker="#close">close/1</seealso>
+ </item>
+ <item>
+ <seealso marker="#sync">sync/1</seealso>
+ </item>
+ <item>
+ <seealso marker="#load_mib">load_mib/4</seealso>
+ </item>
+ <item>
+ <seealso marker="#unload_mib">unload_mib/4</seealso>
+ </item>
+ <item>
+ <seealso marker="#lookup">lookup/2</seealso>
+ </item>
+ <item>
+ <seealso marker="#next">next/3</seealso>
+ </item>
+ <item>
+ <seealso marker="#register_subagent">register_subagent/3</seealso>
+ </item>
+ <item>
+ <seealso marker="#unregister_subagent">unregister_subagent/2</seealso>
+ </item>
+ <item>
+ <seealso marker="#which_mib">which_mib/2</seealso>
+ </item>
+ <item>
+ <seealso marker="#which_mibs">which_mibs/1</seealso>
+ </item>
+ <item>
+ <seealso marker="#whereis_mib">whereis_mib/2</seealso>
+ </item>
+ <item>
+ <seealso marker="#dump">dump/2</seealso>
+ </item>
+ <item>
+ <seealso marker="#info">info/1</seealso>
+ </item>
+ <item>
+ <seealso marker="#backup">backup/2</seealso>
+ </item>
+ <item>
+ <seealso marker="#code_change">code_change/4</seealso>
+ </item>
+ </list>
+
+ <p>The semantics of them and their exact signatures are
+ explained below. </p>
+
+ <p>Note that the data extracted from the imported (loaded)
+ mibs are stored partly by the mib-server and partly by the
+ symbolic-store server. See the default mib-server data
+ module, <c>snmpa_mib_data_tttn</c> for details. </p>
+
+ </description>
+
+ <section>
+ <title>CALLBACK FUNCTIONS</title>
+ <p>The following functions must be exported from a
+ <c>mib-server</c> data callback module: </p>
+
+ <marker id="new"></marker>
+ </section>
+
+ <funcs>
+ <func>
+ <name>Module:new(Storage) -> State</name>
+ <fsummary>Create new (mib-server) data instance</fsummary>
+ <type>
+ <v>Storage = mib_storage()</v>
+ <v>State = term()</v>
+ </type>
+ <desc>
+ <p>Create a new mib-server data instance. </p>
+
+ <marker id="close"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:close(State) -> void()</name>
+ <fsummary>Close the mib-server data instance</fsummary>
+ <type>
+ <v>State = term()</v>
+ </type>
+ <desc>
+ <p>Close the mib-storage.</p>
+
+ <marker id="sync"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:sync(State) -> void()</name>
+ <fsummary>Synchronize to disc</fsummary>
+ <type>
+ <v>State = term()</v>
+ </type>
+ <desc>
+ <p>Synchronize (write to disc, if possible) the mib-server data.
+ This depends on the <c>mib_storage</c> option, and will only have
+ an effect if the mib-storage option has an actual disc component
+ (such as dets, or ets with a file). </p>
+
+ <marker id="load_mib"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:load_mib(State, Filename, MeOverride, TeOverride) -> {ok, NewState} | {error, Reason}</name>
+ <fsummary>Load a mib into the mib-server</fsummary>
+ <type>
+ <v>State = NewState = term()</v>
+ <v>Filename = filename()</v>
+ <v>MeOverride = boolean()</v>
+ <v>TeOverride = boolean()</v>
+ <v>Reason = already_loaded | term()</v>
+ </type>
+ <desc>
+ <p>Load the mib specified by the <c>Filename</c> argument
+ into the mib-server.
+ The <c>MeOverride</c> and <c>TeOverride</c> arguments
+ specifies how the mib-server shall handle duplicate mib- and trap-
+ entries. </p>
+
+ <marker id="unload_mib"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:unload_mib(State, Filename) -> {ok, NewState} | {error, Reason}</name>
+ <fsummary>Unload mib from the mib-server</fsummary>
+ <type>
+ <v>State = NewState = term()</v>
+ <v>Filename = filename()</v>
+ <v>Reason = not_loaded | term()</v>
+ </type>
+ <desc>
+ <p>Unload the mib specified by the <c>Filename</c> argument
+ from the mib-server. </p>
+
+ <marker id="lookup"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:lookup(State, Oid) -> Reply</name>
+ <fsummary>Find the mib-entry corresponding to the Oid</fsummary>
+ <type>
+ <v>State = term()</v>
+ <v>Reply = {variable, ME} | {table_column, ME, TEOid} | {subagent, SAPid, SAOid} | {false, Reason}</v>
+ <v>Oid = TEOid = SAOid = oid()</v>
+ <v>SAPid = pid()</v>
+ <v>ME = me()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Find the mib-entry corresponding to the <c>Oid</c>.
+ If it is a variable, the <c>Oid</c> must be
+ &lt;Oid for var&gt;.0
+ and if it is a table, <c>Oid</c> must be
+ &lt;table&gt;.&lt;entry&gt;.&lt;col&gt;.&lt;any&gt;.</p>
+
+ <marker id="next"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:next(State, Oid, MibView) -> Reply</name>
+ <fsummary>Finds the lexicographically next oid</fsummary>
+ <type>
+ <v>State = term()</v>
+ <v>Reply = false | endOfTable | {subagent, SAPid, SAOid} | {variable, ME, VarOid} | {table, TableOid, TableRestOid, ME}</v>
+ <v>Oid = SAOid = VarOid = TableOid = TableRestOid = oid()</v>
+ <v>SAPid = pid()</v>
+ <v>ME = me()</v>
+ </type>
+ <desc>
+ <p>Finds the lexicographically next oid. </p>
+
+ <marker id="register_subagent"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:register_subagent(State, Oid, Pid) -> Reply</name>
+ <fsummary>Register the subagent</fsummary>
+ <type>
+ <v>State = NewState = term()</v>
+ <v>Reply = {ok, NewState} | {error, Reason}</v>
+ <v>Oid = oid()</v>
+ <v>Pid = pid()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Register the subagent, process,
+ handling part of the mib-tree. </p>
+
+ <marker id="unregister_subagent"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:unregister_subagent(State, PidOrOid) -> Reply</name>
+ <fsummary>Unregister the subagent</fsummary>
+ <type>
+ <v>State = NewState = term()</v>
+ <v>Reply = {ok, NewState} | {ok, NewState, Pid} | {error, Reason}</v>
+ <v>PidOrOid = pid() | oid()</v>
+ <v>Pid = pid()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Unregister the subagent, handling part of the mib-tree,
+ as specified by the <c>oid()</c> or <c>pid()</c>
+ (<c>PidOrOid</c>). </p>
+ <p>When unregister the subagent using an <c>oid()</c>, the <c>pid()</c>
+ of the process handling the sub-tree is also returned. </p>
+
+ <marker id="dump"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:dump(State, Destination) -> Reply</name>
+ <fsummary>Unregister the subagent</fsummary>
+ <type>
+ <v>State = term()</v>
+ <v>Reply = ok | {error, Reason}</v>
+ <v>Destination = io | filename()</v>
+ <v>Pid = pid()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Dump the mib-server data to <c>stdio</c> (Destination = <c>io</c>) or
+ the specified file. </p>
+
+ <marker id="which_mib"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:which_mib(State, Oid) -> Reply</name>
+ <fsummary>Retrieve the mib file for an oid()</fsummary>
+ <type>
+ <v>State = term()</v>
+ <v>Reply = {ok, MibFile} | {error, Reason}</v>
+ <v>Oid = oid()</v>
+ <v>MibFile = string()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Retrieve the mib-file to which an given <c>oid()</c> belongs. </p>
+
+ <marker id="which_mibs"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:which_mibs(State) -> Reply</name>
+ <fsummary>Retrieve all loaded mib files</fsummary>
+ <type>
+ <v>State = term()</v>
+ <v>Reply = [{MibName, Filename}]</v>
+ <v>MibName = atom()</v>
+ <v>Filename = string()</v>
+ </type>
+ <desc>
+ <p>Retrieve all loaded mib-files. </p>
+
+ <marker id="whereis_mib"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:whereis_mib(State, MibName) -> Reply</name>
+ <fsummary>Retrieve the mib file for the mib</fsummary>
+ <type>
+ <v>State = term()</v>
+ <v>MibName = atom()</v>
+ <v>Reply = {ok, Filename} | {error, Reason}</v>
+ <v>Filename = string()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Retrieve the mib file for the mib. </p>
+
+ <marker id="info"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:info(State) -> Reply</name>
+ <fsummary>Retrieve misc info for the mib data</fsummary>
+ <type>
+ <v>State = term()</v>
+ <v>Reply = {ok, Filename} | {error, Reason}</v>
+ <v>Filename = string()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Retrieve misc info for the mib data. </p>
+ <p>This is a utility function used to inspect, for instance,
+ memory usage, in a simple way. </p>
+
+ <marker id="backup"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:backup(State, BackupDir) -> Reply</name>
+ <fsummary>Perform a backup of the mib-server data</fsummary>
+ <type>
+ <v>State = term()</v>
+ <v>Reply = ok | {error, Reason}</v>
+ <v>BackupDir = string()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Perform a backup of the mib-server data. </p>
+ <p>Note that its implementation dependant (and also
+ dependent on mib-storage is used) if a backup is possible. </p>
+
+ <marker id="code_change"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:code_change(Destination, Vsn, Extra, State) -> NewState</name>
+ <fsummary>Perform a code-change</fsummary>
+ <type>
+ <v>Destination = up | down</v>
+ <v>Vsn = term()</v>
+ <v>Extra = term()</v>
+ <v>State = NewState = term()</v>
+ </type>
+ <desc>
+ <p>Perform a code-change (upgrade or downgrade). </p>
+ <p>See
+ <seealso marker="gen_server">gen_server</seealso>
+ for more info regarding the <c>Vsn</c> and <c>Extra</c> arguments. </p>
+
+ </desc>
+ </func>
+
+ </funcs>
+
+</erlref>
+
diff --git a/lib/snmp/doc/src/snmpa_mib_storage.xml b/lib/snmp/doc/src/snmpa_mib_storage.xml
new file mode 100644
index 0000000000..a857ce79e8
--- /dev/null
+++ b/lib/snmp/doc/src/snmpa_mib_storage.xml
@@ -0,0 +1,292 @@
+<?xml version="1.0" encoding="iso-8859-1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>2013</year><year>2013</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>snmpa_mib_storage</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ <file>snmpa_mib_storage.xml</file>
+ </header>
+
+ <module>snmpa_mib_storage</module>
+ <modulesummary>
+ Behaviour module for the SNMP agent mib storage.
+ </modulesummary>
+ <description>
+ <p>This module defines the behaviour of the SNMP agent mib storage. </p>
+ <p>The mib storage is used by the agent to store internal mib-
+ related information. The mib storage module is used by several entities,
+ not just the mib-server. </p>
+
+ <p>A <c>snmpa_mib_storage</c> compliant module
+ must export the following functions: </p>
+ <list type="bulleted">
+ <item>
+ <seealso marker="#open">open/5</seealso>
+ </item>
+ <item>
+ <seealso marker="#close">close/1</seealso>
+ </item>
+ <item>
+ <seealso marker="#read">read/2</seealso>
+ </item>
+ <item>
+ <seealso marker="#write">write/2</seealso>
+ </item>
+ <item>
+ <seealso marker="#delete1">delete/1</seealso>
+ </item>
+ <item>
+ <seealso marker="#delete2">delete/2</seealso>
+ </item>
+ <item>
+ <seealso marker="#match_object">match_object/2</seealso>
+ </item>
+ <item>
+ <seealso marker="#match_delete">match_delete/2</seealso>
+ </item>
+ <item>
+ <seealso marker="#tab2list">tab2list/1</seealso>
+ </item>
+ <item>
+ <seealso marker="#info">info/1</seealso>
+ </item>
+ <item>
+ <seealso marker="#sync">sync/1</seealso>
+ </item>
+ <item>
+ <seealso marker="#backup">backup/2</seealso>
+ </item>
+ </list>
+
+ <p>The semantics of them and their exact signatures are
+ explained below. </p>
+
+ </description>
+
+ <section>
+ <title>CALLBACK FUNCTIONS</title>
+ <p>The following functions must be exported from a
+ <c>mib-server</c> data callback module: </p>
+
+ <marker id="open"></marker>
+ </section>
+
+ <funcs>
+ <func>
+ <name>Module:open(Name, RecordName, Fields, Type, Options) -> {ok, TabId} | {error, Reason}</name>
+ <fsummary>Create new (mib-server) data instance</fsummary>
+ <type>
+ <v>Name = atom()</v>
+ <v>RecordName = atom()</v>
+ <v>Fields = [atom()]</v>
+ <v>Type = set | bag()</v>
+ <v>Options = list()</v>
+ <v>TabId = term()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Create or open a mib storage table. </p>
+ <p>Note that the <c>RecordName</c> and <c>Fields</c> arguments
+ my not be used in all implementations (they are actually only
+ needed for mnesia-based implementations). </p>
+
+ <p>Note also that the <c>Options</c> argument comes from
+ the <c>options</c> config option of the mib-storage config option,
+ and is passed on as is. </p>
+
+ <marker id="close"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:close(TabId) -> void()</name>
+ <fsummary>Close the mib-storage table</fsummary>
+ <type>
+ <v>State = term()</v>
+ </type>
+ <desc>
+ <p>Close the mib-storage table.</p>
+
+ <marker id="read"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:read(TabId, Key) -> false | {value, Record}</name>
+ <fsummary>Read a record from the mib-storage table</fsummary>
+ <type>
+ <v>TabId = term()</v>
+ <v>Key = term()</v>
+ <v>Record = tuple()</v>
+ </type>
+ <desc>
+ <p>Read a record from the mib-storage table. </p>
+
+ <marker id="write"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:write(TabId, Record) -> ok | {error, Reason}</name>
+ <fsummary>Write a record to the mib-storage table</fsummary>
+ <type>
+ <v>TabId = term()</v>
+ <v>Record = tuple()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Write a record to the mib-storage table. </p>
+
+ <marker id="delete1"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:delete(TabId) -> void()</name>
+ <fsummary>Delete an entire mib-storage table</fsummary>
+ <type>
+ <v>TabId = term()</v>
+ </type>
+ <desc>
+ <p>Delete an entire mib-storage table. </p>
+
+ <marker id="delete2"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:delete(TabId, Key) -> ok | {error, Reason}</name>
+ <fsummary>Delete a record from the mib-storage table</fsummary>
+ <type>
+ <v>TabId = term()</v>
+ <v>Key = term()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Delete a record from the mib-storage table. </p>
+
+ <marker id="match_object"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:match_object(TabId, Pattern) -> {ok, Recs} | {error, Reason}</name>
+ <fsummary>Search the mib-storage table for record matching pattern</fsummary>
+ <type>
+ <v>TabId = term()</v>
+ <v>Pattern = match_pattern()</v>
+ <v>Recs = [tuple()]</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Search the mib-storage table for record that match the
+ specified pattern. </p>
+
+ <marker id="match_delete"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:match_delete(TabId, Pattern) -> {ok, Recs} | {error, Reason}</name>
+ <fsummary>Delete records in the mib-storage table matching pattern</fsummary>
+ <type>
+ <v>TabId = term()</v>
+ <v>Pattern = match_pattern()</v>
+ <v>Recs = [tuple()]</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Search the mib-storage table for record that match the
+ specified pattern and then delete them. The records deleted are
+ also returned. </p>
+
+ <marker id="tab2list"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:tab2list(TabId) -> Recs</name>
+ <fsummary>Return all records of the mib-storage table</fsummary>
+ <type>
+ <v>TabId = term()</v>
+ <v>Recs = [tuple()]</v>
+ </type>
+ <desc>
+ <p>Return all records in the mib-storage table in the form
+ of a list. </p>
+
+ <marker id="info"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:info(TabId) -> {ok, Info} | {error, Reason}</name>
+ <fsummary>Returns information about the mib-storage table. </fsummary>
+ <type>
+ <v>TabId = term()</v>
+ <v>Info = term()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Retrieve implementation dependent mib-storage table
+ information. </p>
+
+ <marker id="sync"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:sync(TabId) -> void()</name>
+ <fsummary>Synchronize mib-storage table</fsummary>
+ <type>
+ <v>TabId = term()</v>
+ </type>
+ <desc>
+ <p>Synchronize the mib-storage table. </p>
+ <p>What this means, if anything, is implementation dependent. </p>
+
+ <marker id="backup"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:backup(TabId, BackupDir) -> ok | {error, Reason}</name>
+ <fsummary>Perform a backup of the mib-storage table</fsummary>
+ <type>
+ <v>TabId = term()</v>
+ <v>BackupDir = string()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Perform a backup of the mib-storage table. </p>
+ <p>What this means, if anything, is implementation dependent. </p>
+
+ </desc>
+ </func>
+
+ </funcs>
+
+</erlref>
+
diff --git a/lib/snmp/src/agent/depend.mk b/lib/snmp/src/agent/depend.mk
index ea9261e266..4b12b66e3b 100644
--- a/lib/snmp/src/agent/depend.mk
+++ b/lib/snmp/src/agent/depend.mk
@@ -77,10 +77,6 @@ $(EBIN)/snmpa_error_logger.$(EMULATOR): \
snmpa_error_report.erl \
snmpa_error_logger.erl
-$(EBIN)/snmpa_general_db.$(EMULATOR): \
- snmpa_general_db.erl \
- ../misc/snmp_verbosity.hrl
-
$(EBIN)/snmpa_local_db.$(EMULATOR): \
snmpa_local_db.erl \
../misc/snmp_debug.hrl \
@@ -88,6 +84,18 @@ $(EBIN)/snmpa_local_db.$(EMULATOR): \
../../include/snmp_types.hrl \
../../include/STANDARD-MIB.hrl
+$(EBIN)/snmpa_mib_storage.$(EMULATOR): \
+ snmpa_mib_storage.erl
+
+$(EBIN)/snmpa_mib_storage_ets.$(EMULATOR): \
+ snmpa_mib_storage_ets.erl
+
+$(EBIN)/snmpa_mib_storage_dets.$(EMULATOR): \
+ snmpa_mib_storage_dets.erl
+
+$(EBIN)/snmpa_mib_storage_mnesia.$(EMULATOR): \
+ snmpa_mib_storage_mnesia.erl
+
$(EBIN)/snmpa_mib.$(EMULATOR): \
snmpa_mib.erl \
../misc/snmp_debug.hrl \
@@ -96,6 +104,10 @@ $(EBIN)/snmpa_mib.$(EMULATOR): \
$(EBIN)/snmpa_mib_data.$(EMULATOR): \
snmpa_mib_data.erl \
+ ../../include/snmp_types.hrl
+
+$(EBIN)/snmpa_mib_data_tttn.$(EMULATOR): \
+ snmpa_mib_data_tttn.erl \
../misc/snmp_debug.hrl \
../misc/snmp_verbosity.hrl \
../../include/snmp_types.hrl
diff --git a/lib/snmp/src/agent/modules.mk b/lib/snmp/src/agent/modules.mk
index 33ab41b434..34765475b9 100644
--- a/lib/snmp/src/agent/modules.mk
+++ b/lib/snmp/src/agent/modules.mk
@@ -2,7 +2,7 @@
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2004-2009. All Rights Reserved.
+# Copyright Ericsson AB 2004-2013. All Rights Reserved.
#
# The contents of this file are subject to the Erlang Public License,
# Version 1.1, (the "License"); you may not use this file except in
@@ -21,15 +21,21 @@ BEHAVIOUR_MODULES = \
snmpa_authentication_service \
snmpa_discovery_handler \
snmpa_error_report \
+ snmpa_mib_storage \
+ snmpa_mib_data \
snmpa_network_interface \
snmpa_network_interface_filter \
snmpa_notification_delivery_info_receiver \
snmpa_notification_filter \
snmpa_set_mechanism
+# snmpa is "plain" interface module but also defines some agent specific types
+# and therefor must be compiled before the modules that use them, including
+# the behaviour modules...
+# snmpa_mib_data_ttln
MODULES = \
- $(BEHAVIOUR_MODULES) \
snmpa \
+ $(BEHAVIOUR_MODULES) \
snmpa_acm \
snmpa_agent \
snmpa_agent_sup \
@@ -39,10 +45,12 @@ MODULES = \
snmpa_error \
snmpa_error_io \
snmpa_error_logger \
- snmpa_general_db \
snmpa_local_db \
+ snmpa_mib_storage_ets \
+ snmpa_mib_storage_dets \
+ snmpa_mib_storage_mnesia \
snmpa_mib \
- snmpa_mib_data \
+ snmpa_mib_data_tttn \
snmpa_mib_lib \
snmpa_misc_sup \
snmpa_mpd \
diff --git a/lib/snmp/src/agent/snmp_user_based_sm_mib.erl b/lib/snmp/src/agent/snmp_user_based_sm_mib.erl
index e675cf1b83..223d3f7218 100644
--- a/lib/snmp/src/agent/snmp_user_based_sm_mib.erl
+++ b/lib/snmp/src/agent/snmp_user_based_sm_mib.erl
@@ -1219,16 +1219,10 @@ split(N, [H | T], FirstRev) when N > 0 ->
split(N-1, T, [H | FirstRev]).
-is_crypto_supported(Algo) ->
- %% The 'catch' handles the case when 'crypto' is
- %% not present in the system (or not started).
- Supported = crypto:supports(),
- Hashs = proplists:get_value(hashs, Supported),
- Ciphers = proplists:get_value(ciphers, Supported),
- case catch lists:member(Algo, Hashs ++ Ciphers) of
- true -> true;
- _ -> false
- end.
+-compile({inline, [{is_crypto_supported,1}]}).
+is_crypto_supported(Func) ->
+ snmp_misc:is_crypto_supported(Func).
+
inconsistentValue(V) -> throw({inconsistentValue, V}).
inconsistentName(N) -> throw({inconsistentName, N}).
diff --git a/lib/snmp/src/agent/snmpa.erl b/lib/snmp/src/agent/snmpa.erl
index b45a47ec6b..14b93439df 100644
--- a/lib/snmp/src/agent/snmpa.erl
+++ b/lib/snmp/src/agent/snmpa.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2013. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -111,13 +111,44 @@
-export([print_mib_info/0, print_mib_tables/0, print_mib_variables/0]).
+-export_type([
+ me/0,
+
+ %% Agent config types
+ mib_storage/0,
+ mib_storage_opt/0,
+ mib_storage_module/0,
+ mib_storage_options/0
+ ]).
+
+-deprecated([{old_info_format, 1, next_major_release}]).
+
+
-include("snmpa_atl.hrl").
-include("snmpa_internal.hrl").
+-include_lib("snmp/include/snmp_types.hrl"). % type of me needed.
-define(DISCO_EXTRA_INFO, undefined).
%%-----------------------------------------------------------------
+%% Types
+%%-----------------------------------------------------------------
+
+-type me() :: #me{}.
+
+%% Agent config types
+-type mib_storage() :: [mib_storage_opt()].
+-type mib_storage_opt() :: {module, mib_storage_module()} |
+ {options, mib_storage_options()}.
+
+%% Module implementing the snmpa_mib_storage behaviour
+-type mib_storage_module() :: atom().
+%% Options specific to the above module
+-type mib_storage_options() :: list().
+
+
+%%-----------------------------------------------------------------
%% This utility function is used to convert an old SNMP application
%% config (prior to snmp-4.0) to a SNMP agent config (as of
%% snmp-4.0).
diff --git a/lib/snmp/src/agent/snmpa_agent.erl b/lib/snmp/src/agent/snmpa_agent.erl
index 57846db13b..c267ce5a70 100644
--- a/lib/snmp/src/agent/snmpa_agent.erl
+++ b/lib/snmp/src/agent/snmpa_agent.erl
@@ -159,12 +159,15 @@
%% it is sent to the worker, and the worker is marked as busy.
%% If a request is received when the worker is busy, a new temporary
%% worker is spawned.
+%%
%% Code change
%% ===========
%% Note that the worker(s) execute the same module as the master
%% agent. For code change we have two options - ignore the workers,
%% or send them a code change message.
+%%
%%-----------------------------------------------------------------
+
-record(state, {type,
parent,
worker,
@@ -219,22 +222,19 @@
%%-----------------------------------------------------------------
start_link(Prio, Parent, Ref, Options) ->
?d("start_link -> entry with"
- "~n Prio: ~p"
- "~n Parent: ~p"
- "~n Ref: ~p"
- "~n Options: ~p", [Prio, Parent, Ref, Options]),
- %% gen_server:start_link(?MODULE, [Prio, Parent, Ref, Options], []).
+ "~n Prio: ~p"
+ "~n Parent: ~p"
+ "~n Ref: ~p"
+ "~n Options: ~p", [Prio, Parent, Ref, Options]),
?GS_START_LINK3(Prio, Parent, Ref, Options).
start_link(Prio, Name, Parent, Ref, Options) ->
?d("start_link -> entry with"
- "~n Prio: ~p"
- "~n Name: ~p"
- "~n Parent: ~p"
- "~n Ref: ~p"
- "~n Options: ~p", [Prio, Name, Parent, Ref, Options]),
-% gen_server:start_link({local, Name}, ?MODULE,
-% [Prio, Parent, Ref, Options], []).
+ "~n Prio: ~p"
+ "~n Name: ~p"
+ "~n Parent: ~p"
+ "~n Ref: ~p"
+ "~n Options: ~p", [Prio, Name, Parent, Ref, Options]),
?GS_START_LINK4(Prio, Name, Parent, Ref, Options).
stop(Agent) -> call(Agent, stop).
@@ -335,10 +335,10 @@ increment_counter(Counter, Initial, Max) ->
init([Prio, Parent, Ref, Options]) ->
?d("init -> entry with"
- "~n Prio: ~p"
- "~n Parent: ~p"
- "~n Ref: ~p"
- "~n Options: ~p", [Prio, Parent, Ref, Options]),
+ "~n Prio: ~p"
+ "~n Parent: ~p"
+ "~n Ref: ~p"
+ "~n Options: ~p", [Prio, Parent, Ref, Options]),
case (catch do_init(Prio, Parent, Ref, Options)) of
{ok, State} ->
?vdebug("started",[]),
@@ -1457,80 +1457,80 @@ handle_mibs_cache_request(MibServer, Req) ->
%% Downgrade
%%
-code_change({down, _Vsn}, S1, downgrade_to_pre_4_17_3) ->
- #state{type = Type,
- parent = Parent,
- worker = Worker,
- worker_state = WorkerState,
- set_worker = SetWorker,
- multi_threaded = MT,
- ref = Ref,
- vsns = Vsns,
- nfilters = NF,
- note_store = NoteStore,
- mib_server = MS,
- net_if = NetIf,
- net_if_mod = NetIfMod,
- backup = Backup,
- disco = Disco,
- mibs_cache_request = MCR} = S1,
- S2 = {state,
- type = Type,
- parent = Parent,
- worker = Worker,
- worker_state = WorkerState,
- set_worker = SetWorker,
- multi_threaded = MT,
- ref = Ref,
- vsns = Vsns,
- nfilters = NF,
- note_store = NoteStore,
- mib_server = MS,
- net_if = NetIf,
- net_if_mod = NetIfMod,
- backup = Backup,
- disco = Disco,
- mibs_cache_request = MCR},
- {ok, S2};
-
-%% Upgrade
-%%
-code_change(_Vsn, S1, upgrade_from_pre_4_17_3) ->
- {state,
- type = Type,
- parent = Parent,
- worker = Worker,
- worker_state = WorkerState,
- set_worker = SetWorker,
- multi_threaded = MT,
- ref = Ref,
- vsns = Vsns,
- nfilters = NF,
- note_store = NoteStore,
- mib_server = MS,
- net_if = NetIf,
- net_if_mod = NetIfMod,
- backup = Backup,
- disco = Disco,
- mibs_cache_request = MCR} = S1,
- S2 = #state{type = Type,
- parent = Parent,
- worker = Worker,
- worker_state = WorkerState,
- set_worker = SetWorker,
- multi_threaded = MT,
- ref = Ref,
- vsns = Vsns,
- nfilters = NF,
- note_store = NoteStore,
- mib_server = MS,
- net_if = NetIf,
- net_if_mod = NetIfMod,
- backup = Backup,
- disco = Disco,
- mibs_cache_request = MCR,
- gb_max_vbs = ?DEFAULT_GB_MAX_VBS},
- {ok, S2};
+%% code_change({down, _Vsn}, S1, downgrade_to_pre_4_17_3) ->
+%% #state{type = Type,
+%% parent = Parent,
+%% worker = Worker,
+%% worker_state = WorkerState,
+%% set_worker = SetWorker,
+%% multi_threaded = MT,
+%% ref = Ref,
+%% vsns = Vsns,
+%% nfilters = NF,
+%% note_store = NoteStore,
+%% mib_server = MS,
+%% net_if = NetIf,
+%% net_if_mod = NetIfMod,
+%% backup = Backup,
+%% disco = Disco,
+%% mibs_cache_request = MCR} = S1,
+%% S2 = {state,
+%% type = Type,
+%% parent = Parent,
+%% worker = Worker,
+%% worker_state = WorkerState,
+%% set_worker = SetWorker,
+%% multi_threaded = MT,
+%% ref = Ref,
+%% vsns = Vsns,
+%% nfilters = NF,
+%% note_store = NoteStore,
+%% mib_server = MS,
+%% net_if = NetIf,
+%% net_if_mod = NetIfMod,
+%% backup = Backup,
+%% disco = Disco,
+%% mibs_cache_request = MCR},
+%% {ok, S2};
+
+%% %% Upgrade
+%% %%
+%% code_change(_Vsn, S1, upgrade_from_pre_4_17_3) ->
+%% {state,
+%% type = Type,
+%% parent = Parent,
+%% worker = Worker,
+%% worker_state = WorkerState,
+%% set_worker = SetWorker,
+%% multi_threaded = MT,
+%% ref = Ref,
+%% vsns = Vsns,
+%% nfilters = NF,
+%% note_store = NoteStore,
+%% mib_server = MS,
+%% net_if = NetIf,
+%% net_if_mod = NetIfMod,
+%% backup = Backup,
+%% disco = Disco,
+%% mibs_cache_request = MCR} = S1,
+%% S2 = #state{type = Type,
+%% parent = Parent,
+%% worker = Worker,
+%% worker_state = WorkerState,
+%% set_worker = SetWorker,
+%% multi_threaded = MT,
+%% ref = Ref,
+%% vsns = Vsns,
+%% nfilters = NF,
+%% note_store = NoteStore,
+%% mib_server = MS,
+%% net_if = NetIf,
+%% net_if_mod = NetIfMod,
+%% backup = Backup,
+%% disco = Disco,
+%% mibs_cache_request = MCR,
+%% gb_max_vbs = ?DEFAULT_GB_MAX_VBS},
+%% {ok, S2};
code_change(_Vsn, S, _Extra) ->
{ok, S}.
@@ -4411,7 +4411,7 @@ get_mibs(Opts) ->
get_option(mibs, Opts, []).
get_mib_storage(Opts) ->
- get_option(mib_storage, Opts, ets).
+ get_option(mib_storage, Opts).
get_set_mechanism(Opts) ->
get_option(set_mechanism, Opts, snmpa_set).
@@ -4450,6 +4450,9 @@ net_if_verbosity(_Pid,_Verbosity) ->
ok.
+get_option(Key, Opts) ->
+ snmp_misc:get_option(Key, Opts).
+
get_option(Key, Opts, Default) ->
snmp_misc:get_option(Key, Opts, Default).
diff --git a/lib/snmp/src/agent/snmpa_agent_sup.erl b/lib/snmp/src/agent/snmpa_agent_sup.erl
index 9b8c4d12a6..2805e2dc0d 100644
--- a/lib/snmp/src/agent/snmpa_agent_sup.erl
+++ b/lib/snmp/src/agent/snmpa_agent_sup.erl
@@ -29,10 +29,12 @@
-export([init/1]).
-define(SERVER, ?MODULE).
+%% Always use plain ets for sub-agents
-ifdef(snmp_debug).
--define(DEFAULT_OPTS, [{verbosity, trace}]).
+-define(DEFAULT_SA_OPTS, [{mib_storage, [{module, snmpa_mib_storage_ets}]},
+ {verbosity, trace}]).
-else.
--define(DEFAULT_OPTS, []).
+-define(DEFAULT_SA_OPTS, [{mib_storage, [{module, snmpa_mib_storage_ets}]}]).
-endif.
@@ -63,8 +65,8 @@ start_subagent(ParentAgent, Subtree, Mibs) ->
Ref = make_ref(),
?d("start_subagent -> Ref: ~p", [Ref]),
Options = [{priority, Prio},
- {mibs, Mibs},
- {misc_sup, snmpa_misc_sup} | ?DEFAULT_OPTS],
+ {mibs, Mibs},
+ {misc_sup, snmpa_misc_sup} | ?DEFAULT_SA_OPTS],
Agent = {{sub_agent, Max},
{snmpa_agent, start_link,
[Prio, ParentAgent, Ref, Options]},
diff --git a/lib/snmp/src/agent/snmpa_mib.erl b/lib/snmp/src/agent/snmpa_mib.erl
index 575a018c0c..031309b990 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-2012. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -18,7 +18,6 @@
%%
-module(snmpa_mib).
-%% c(snmpa_mib).
%%%-----------------------------------------------------------------
%%% This module implements a MIB server.
@@ -75,12 +74,14 @@
%% Internal Data structures
%%
%% State
-%% data - is the MIB data (defined in snmpa_mib_data)
+%% data - is the MIB data (defined in mib_data module)
%% meo - mib entry override
%% teo - trap (notification) entry override
%%-----------------------------------------------------------------
--record(state, {data, meo, teo, backup,
- cache, cache_tmr, cache_autogc, cache_gclimit, cache_age}).
+-record(state,
+ {data, meo, teo, backup,
+ cache, cache_tmr, cache_autogc, cache_gclimit, cache_age,
+ data_mod}).
@@ -224,9 +225,9 @@ info(MibServer, Type) ->
call(MibServer, {info, Type}).
dump(MibServer) ->
- call(MibServer, dump).
+ dump(MibServer, io).
-dump(MibServer, File) when is_list(File) ->
+dump(MibServer, File) when (File =:= io) orelse is_list(File) ->
call(MibServer, {dump, File}).
backup(MibServer, BackupDir) when is_list(BackupDir) ->
@@ -256,7 +257,7 @@ init([Prio, Mibs, Opts]) ->
do_init(Prio, Mibs, Opts) ->
process_flag(priority, Prio),
process_flag(trap_exit, true),
- put(sname,ms),
+ put(sname, ms),
put(verbosity, ?vvalidate(get_verbosity(Opts))),
?vlog("starting",[]),
@@ -289,13 +290,19 @@ do_init(Prio, Mibs, Opts) ->
MeOverride = get_me_override(Opts),
TeOverride = get_te_override(Opts),
MibStorage = get_mib_storage(Opts),
- Data = snmpa_mib_data:new(MibStorage),
- ?vtrace("init -> mib data created",[]),
- case (catch mib_operations(load_mib, Mibs, Data,
+ MibDataMod = get_data_mod(Opts),
+ ?vtrace("init -> try create mib data with"
+ "~n MeOverride: ~p"
+ "~n TeOverride: ~p"
+ "~n MibStorage: ~p", [MeOverride, TeOverride, MibStorage]),
+ Data = MibDataMod:new(MibStorage),
+ ?vdebug("init -> mib data created", []),
+ case (catch mib_operations(MibDataMod,
+ load_mib, Mibs, Data,
MeOverride, TeOverride, true)) of
{ok, Data2} ->
?vdebug("started",[]),
- snmpa_mib_data:sync(Data2),
+ MibDataMod:sync(Data2),
?vdebug("mib data synced",[]),
{ok, #state{data = Data2,
teo = TeOverride,
@@ -304,7 +311,8 @@ do_init(Prio, Mibs, Opts) ->
cache_tmr = CacheGcTimer,
cache_autogc = CacheAutoGC,
cache_gclimit = CacheGcLimit,
- cache_age = CacheAge}};
+ cache_age = CacheAge,
+ data_mod = MibDataMod}};
{'aborted at', Mib, _NewData, Reason} ->
?vinfo("failed loading mib ~p: ~p",[Mib,Reason]),
{error, {Mib, Reason}}
@@ -315,32 +323,34 @@ do_init(Prio, Mibs, Opts) ->
%% Returns: {ok, NewMibData} | {'aborted at', Mib, NewData, Reason}
%% Args: Operation is load_mib | unload_mib.
%%----------------------------------------------------------------------
-mib_operations(Operation, Mibs, Data, MeOverride, TeOverride) ->
- mib_operations(Operation, Mibs, Data, MeOverride, TeOverride, false).
+mib_operations(Mod, Operation, Mibs, Data, MeOverride, TeOverride) ->
+ mib_operations(Mod, Operation, Mibs, Data, MeOverride, TeOverride, false).
-mib_operations(_Operation, [], Data, _MeOverride, _TeOverride, _Force) ->
+mib_operations(_Mod, _Operation, [], Data, _MeOverride, _TeOverride, _Force) ->
{ok, Data};
-mib_operations(Operation, [Mib|Mibs], Data0, MeOverride, TeOverride, Force) ->
+mib_operations(Mod, Operation, [Mib|Mibs], Data0, MeOverride, TeOverride, Force) ->
?vtrace("mib operations ~p on"
- "~n Mibs: ~p"
- "~n with "
- "~n MeOverride: ~p"
- "~n TeOverride: ~p"
- "~n Force: ~p", [Operation,Mibs,MeOverride,TeOverride,Force]),
- Data = mib_operation(Operation, Mib, Data0, MeOverride, TeOverride, Force),
- mib_operations(Operation, Mibs, Data, MeOverride, TeOverride, Force).
-
-mib_operation(Operation, Mib, Data0, MeOverride, TeOverride, Force)
+ "~n Mibs: ~p"
+ "~n with "
+ "~n MeOverride: ~p"
+ "~n TeOverride: ~p"
+ "~n Force: ~p",
+ [Operation, Mibs, MeOverride, TeOverride, Force]),
+ Data = mib_operation(Mod,
+ Operation, Mib, Data0, MeOverride, TeOverride, Force),
+ mib_operations(Mod, Operation, Mibs, Data, MeOverride, TeOverride, Force).
+
+mib_operation(Mod, Operation, Mib, Data0, MeOverride, TeOverride, Force)
when is_list(Mib) ->
?vtrace("mib operation on mib ~p", [Mib]),
- case apply(snmpa_mib_data, Operation, [Data0,Mib,MeOverride,TeOverride]) of
- {error, 'already loaded'} when (Operation =:= load_mib) andalso
+ case apply(Mod, Operation, [Data0, Mib, MeOverride, TeOverride]) of
+ {error, already_loaded} when (Operation =:= load_mib) andalso
(Force =:= true) ->
?vlog("ignore mib ~p -> already loaded", [Mib]),
Data0;
- {error, 'not loaded'} when (Operation =:= unload_mib) andalso
- (Force =:= true) ->
+ {error, not_loaded} when (Operation =:= unload_mib) andalso
+ (Force =:= true) ->
?vlog("ignore mib ~p -> not loaded", [Mib]),
Data0;
{error, Reason} ->
@@ -350,7 +360,7 @@ mib_operation(Operation, Mib, Data0, MeOverride, TeOverride, Force)
{ok, Data} ->
Data
end;
-mib_operation(_Op, Mib, Data, _MeOverride, _TeOverride, _Force) ->
+mib_operation(_Mod, _Op, Mib, Data, _MeOverride, _TeOverride, _Force) ->
throw({'aborted at', Mib, Data, bad_mibname}).
@@ -395,15 +405,15 @@ handle_call({update_cache_opts, Key, Value}, _From, State) ->
{reply, Result, NewState};
handle_call({lookup, Oid}, _From,
- #state{data = Data, cache = Cache} = State) ->
+ #state{data = Data, cache = Cache, data_mod = Mod} = State) ->
?vlog("lookup ~p", [Oid]),
Key = {lookup, Oid},
{Reply, NewState} =
case maybe_cache_lookup(Cache, Key) of
?NO_CACHE ->
- {snmpa_mib_data:lookup(Data, Oid), State};
+ {Mod:lookup(Data, Oid), State};
[] ->
- Rep = snmpa_mib_data:lookup(Data, Oid),
+ Rep = Mod:lookup(Data, Oid),
ets:insert(Cache, {Key, Rep, timestamp()}),
{Rep, maybe_start_cache_gc_timer(State)};
[{Key, Rep, _}] ->
@@ -414,22 +424,23 @@ handle_call({lookup, Oid}, _From,
?vdebug("lookup -> Reply: ~p", [Reply]),
{reply, Reply, NewState};
-handle_call({which_mib, Oid}, _From, #state{data = Data} = State) ->
+handle_call({which_mib, Oid}, _From,
+ #state{data = Data, data_mod = Mod} = State) ->
?vlog("which_mib ~p",[Oid]),
- Reply = snmpa_mib_data:which_mib(Data, Oid),
+ Reply = Mod:which_mib(Data, Oid),
?vdebug("which_mib: ~p",[Reply]),
{reply, Reply, State};
handle_call({next, Oid, MibView}, _From,
- #state{data = Data, cache = Cache} = State) ->
+ #state{data = Data, cache = Cache, data_mod = Mod} = State) ->
?vlog("next ~p [~p]", [Oid, MibView]),
Key = {next, Oid, MibView},
{Reply, NewState} =
case maybe_cache_lookup(Cache, Key) of
?NO_CACHE ->
- {snmpa_mib_data:next(Data, Oid, MibView), State};
+ {Mod:next(Data, Oid, MibView), State};
[] ->
- Rep = snmpa_mib_data:next(Data, Oid, MibView),
+ Rep = Mod:next(Data, Oid, MibView),
ets:insert(Cache, {Key, Rep, timestamp()}),
{Rep, maybe_start_cache_gc_timer(State)};
[{Key, Rep, _}] ->
@@ -441,89 +452,99 @@ handle_call({next, Oid, MibView}, _From,
{reply, Reply, NewState};
handle_call({load_mibs, Mibs}, _From,
- #state{data = Data,
- teo = TeOverride,
- meo = MeOverride,
- cache = Cache} = State) ->
+ #state{data = Data,
+ teo = TeOverride,
+ meo = MeOverride,
+ cache = Cache,
+ data_mod = Mod} = State) ->
?vlog("load mibs ~p",[Mibs]),
%% Invalidate cache
NewCache = maybe_invalidate_cache(Cache),
- {NData,Reply} =
- case (catch mib_operations(load_mib, Mibs, Data,
+ {NData, Reply} =
+ case (catch mib_operations(Mod, load_mib, Mibs, Data,
MeOverride, TeOverride)) of
{'aborted at', Mib, NewData, Reason} ->
?vlog("aborted at ~p for reason ~p",[Mib,Reason]),
- {NewData,{error, {'load aborted at', Mib, Reason}}};
+ {NewData, {error, {'load aborted at', Mib, Reason}}};
{ok, NewData} ->
- {NewData,ok}
+ {NewData, ok}
end,
- snmpa_mib_data:sync(NData),
+ Mod:sync(NData),
{reply, Reply, State#state{data = NData, cache = NewCache}};
handle_call({unload_mibs, Mibs}, _From,
- #state{data = Data,
- teo = TeOverride,
- meo = MeOverride,
- cache = Cache} = State) ->
+ #state{data = Data,
+ teo = TeOverride,
+ meo = MeOverride,
+ cache = Cache,
+ data_mod = Mod} = State) ->
?vlog("unload mibs ~p",[Mibs]),
%% Invalidate cache
NewCache = maybe_invalidate_cache(Cache),
%% Unload mib(s)
- {NData,Reply} =
- case (catch mib_operations(unload_mib, Mibs, Data,
+ {NData, Reply} =
+ case (catch mib_operations(Mod, unload_mib, Mibs, Data,
MeOverride, TeOverride)) of
{'aborted at', Mib, NewData, Reason} ->
- ?vlog("aborted at ~p for reason ~p",[Mib,Reason]),
+ ?vlog("aborted at ~p for reason ~p", [Mib,Reason]),
{NewData, {error, {'unload aborted at', Mib, Reason}}};
{ok, NewData} ->
- {NewData,ok}
+ {NewData, ok}
end,
- snmpa_mib_data:sync(NData),
+ Mod:sync(NData),
{reply, Reply, State#state{data = NData, cache = NewCache}};
-handle_call(which_mibs, _From, #state{data = Data} = State) ->
+handle_call(which_mibs, _From, #state{data = Data, data_mod = Mod} = State) ->
?vlog("which mibs",[]),
- Reply = snmpa_mib_data:which_mibs(Data),
+ Reply = Mod:which_mibs(Data),
{reply, Reply, State};
-handle_call({whereis_mib, Mib}, _From, #state{data = Data} = State) ->
+handle_call({whereis_mib, Mib}, _From,
+ #state{data = Data,
+ data_mod = Mod} = State) ->
?vlog("whereis mib: ~p",[Mib]),
- Reply = snmpa_mib_data:whereis_mib(Data, Mib),
+ Reply = Mod:whereis_mib(Data, Mib),
{reply, Reply, State};
handle_call({register_subagent, Oid, Pid}, _From,
- #state{data = Data, cache = Cache} = State) ->
+ #state{data = Data,
+ cache = Cache,
+ data_mod = Mod} = State) ->
?vlog("register subagent ~p, ~p",[Oid,Pid]),
%% Invalidate cache
NewCache = maybe_invalidate_cache(Cache),
- case snmpa_mib_data:register_subagent(Data, Oid, Pid) of
+ case Mod:register_subagent(Data, Oid, Pid) of
{error, Reason} ->
?vlog("registration failed: ~p",[Reason]),
{reply, {error, Reason}, State#state{cache = NewCache}};
- NewData ->
+ {ok, NewData} ->
{reply, ok, State#state{data = NewData, cache = NewCache}}
end;
handle_call({unregister_subagent, OidOrPid}, _From,
- #state{data = Data, cache = Cache} = State) ->
+ #state{data = Data,
+ cache = Cache,
+ data_mod = Mod} = State) ->
?vlog("unregister subagent ~p",[OidOrPid]),
%% Invalidate cache
NewCache = maybe_invalidate_cache(Cache),
- case snmpa_mib_data:unregister_subagent(Data, OidOrPid) of
+ case Mod:unregister_subagent(Data, OidOrPid) of
+ {ok, NewData} ->
+ {reply, ok, State#state{data = NewData, cache = NewCache}};
{ok, NewData, DeletedSubagentPid} ->
{reply, {ok, DeletedSubagentPid}, State#state{data = NewData,
cache = NewCache}};
{error, Reason} ->
?vlog("unregistration failed: ~p",[Reason]),
- {reply, {error, Reason}, State#state{cache = NewCache}};
- NewData ->
- {reply, ok, State#state{data = NewData, cache = NewCache}}
+ {reply, {error, Reason}, State#state{cache = NewCache}}
end;
-handle_call(info, _From, #state{data = Data, cache = Cache} = State) ->
+handle_call(info, _From, #state{data = Data,
+ cache = Cache,
+ data_mod = Mod} = State) ->
?vlog("info",[]),
Reply =
- case (catch snmpa_mib_data:info(Data)) of
+ case (catch Mod:info(Data)) of
Info when is_list(Info) ->
[{cache, size_cache(Cache)} | Info];
E ->
@@ -531,10 +552,12 @@ handle_call(info, _From, #state{data = Data, cache = Cache} = State) ->
end,
{reply, Reply, State};
-handle_call({info, Type}, _From, #state{data = Data} = State) ->
+handle_call({info, Type}, _From,
+ #state{data = Data,
+ data_mod = Mod} = State) ->
?vlog("info ~p",[Type]),
Reply =
- case (catch snmpa_mib_data:info(Data, Type)) of
+ case (catch Mod:info(Data, Type)) of
Info when is_list(Info) ->
Info;
E ->
@@ -542,21 +565,19 @@ handle_call({info, Type}, _From, #state{data = Data} = State) ->
end,
{reply, Reply, State};
-handle_call(dump, _From, State) ->
- ?vlog("dump",[]),
- Reply = snmpa_mib_data:dump(State#state.data),
- {reply, Reply, State};
-
-handle_call({dump, File}, _From, #state{data = Data} = State) ->
+handle_call({dump, File}, _From,
+ #state{data = Data, data_mod = Mod} = State) ->
?vlog("dump on ~s",[File]),
- Reply = snmpa_mib_data:dump(Data, File),
+ Reply = Mod:dump(Data, File),
{reply, Reply, 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, data = Data} = State) ->
+ #state{backup = undefined,
+ data = Data,
+ data_mod = Mod} = State) ->
?vlog("backup to ~s", [BackupDir]),
Pid = self(),
V = get(verbosity),
@@ -568,7 +589,7 @@ handle_call({backup, BackupDir}, From,
put(sname, ambs),
put(verbosity, V),
Dir = filename:join([BackupDir]),
- Reply = snmpa_mib_data:backup(Data, Dir),
+ Reply = Mod:backup(Data, Dir),
Pid ! {backup_done, Reply},
unlink(Pid)
end),
@@ -637,8 +658,8 @@ handle_info(Info, State) ->
warning_msg("received unknown info: ~n~p", [Info]),
{noreply, State}.
-terminate(_Reason, #state{data = Data}) ->
- catch snmpa_mib_data:close(Data),
+terminate(_Reason, #state{data = Data, data_mod = Mod}) ->
+ catch Mod:close(Data),
ok.
@@ -655,6 +676,11 @@ terminate(_Reason, #state{data = Data}) ->
%% S2 = {state, Data, MEO, TEO, B},
%% {ok, S2};
+code_change({down, Vsn}, #state{data = Data0, data_mod = Mod} = State, Extra) ->
+ Data = Mod:code_change(down, Vsn, Extra, Data0),
+ {ok, State#state{data = Data}};
+
+
%% %% upgrade
%% %%
%% code_change(_Vsn, S1, upgrade_from_pre_4_12) ->
@@ -663,8 +689,9 @@ terminate(_Reason, #state{data = Data}) ->
%% S2 = #state{data = Data, meo = MEO, teo = TEO, backup = B, cache = Cache},
%% {ok, S2};
-code_change(_Vsn, State, _Extra) ->
- {ok, State}.
+code_change(Vsn, #state{data = Data0, data_mod = Mod} = State, Extra) ->
+ Data = Mod:code_change(up, Vsn, Extra, Data0),
+ {ok, State#state{data = Data}}.
%%-----------------------------------------------------------------
@@ -681,7 +708,10 @@ get_te_override(Options) ->
get_opt(trapentry_override, Options, false).
get_mib_storage(Options) ->
- get_opt(mib_storage, Options, ets).
+ get_opt(mib_storage, Options).
+
+get_data_mod(Options) ->
+ get_opt(data_module, Options, snmpa_mib_data_tttn).
get_cacheopt_autogc(Cache, CacheOpts) ->
IsValid = fun(AutoGC) when ((AutoGC =:= true) orelse
@@ -868,6 +898,9 @@ timestamp() ->
%% ----------------------------------------------------------------
+get_opt(Key, Options) ->
+ snmp_misc:get_option(Key, Options).
+
get_opt(Key, Options, Default) ->
snmp_misc:get_option(Key, Options, Default).
diff --git a/lib/snmp/src/agent/snmpa_mib_data.erl b/lib/snmp/src/agent/snmpa_mib_data.erl
index b80d85d2ee..4d8a12b6c6 100644
--- a/lib/snmp/src/agent/snmpa_mib_data.erl
+++ b/lib/snmp/src/agent/snmpa_mib_data.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -18,1338 +18,92 @@
%%
-module(snmpa_mib_data).
-%%%-----------------------------------------------------------------
-%%% This module implements the MIB internal data structures.
-%%% An MIB Data Structure consists of three items; an ets-table,
-%%% a tree and a list of registered subagents.
-%%% The subagent information is consequently duplicated. It resides
-%%% both in the tree and in the list.
-%%% The ets-table contains all data associated with each variable,
-%%% table, tableentry and tablecolumn in the MIB.
-%%% The tree contains information of the Oids in the MIB.
-%%%
-%%% When a mib is loaded, the tree is built from the plain list
-%%% in the binary file.
-%%%-----------------------------------------------------------------
--include("snmp_types.hrl").
--include("snmp_debug.hrl").
-
--define(VMODULE,"MDATA").
--include("snmp_verbosity.hrl").
-
--define(MIB_DATA,snmpa_mib_data).
--define(MIB_NODE,snmpa_mib_node).
--define(MIB_TREE,snmpa_mib_tree).
--define(DUMMY_TREE_GENERATION,1).
--define(DEFAULT_TREE,{tree,{undefined_node},internal}).
-%%-define(DUMMY_TREE_DB,dummy_tree_db).
-%%-define(DUMMY_TREE_DB_INIT,{?DUMMY_TREE_DB,?DEFAULT_TREE}).
-
+-include_lib("snmp/include/snmp_types.hrl").
%%%-----------------------------------------------------------------
-%%% Table of contents
-%%% =================
-%%% 1. Interface
-%%% 2. Implementation of tree access
-%%% 3. Tree building functions
-%%% 4. Tree merging
-%%% 5. Tree deletion routines
-%%% 6. Functions for subagent handling
-%%% 7. Misc functions
+%%% This is the behaviour for the MIB server backend internal
+%%% data storage.
%%%-----------------------------------------------------------------
+%% These types should really be defined elsewhere...
+-export_type([
+ mib_view/0,
+ mib_view_elem/0,
+ mib_view_mask/0,
+ mib_view_inclusion/0
+ ]).
-%%----------------------------------------------------------------------
-%% data_db is an database containing loaded mibs as:
-%% {MibName = atom(), Symbolic = ?, FullFileName = string()}
-%% it is either ets or mnesia
-%% tree_db is a database containing _one_ record with the tree!
-%% (the reason for this is part to get replication and part out of convenience)
-%% ref_tree is the root node, without any subagent.
-%% tree is the root node (same as ref_tree but with the subagents added).
-%% subagents is a list of {SAPid, Oid}
-%%----------------------------------------------------------------------
--record(mib_data, {mib_db, % table of #mib_info
- node_db, % table of #node_info
- tree_db, % table of #tree
- tree, % The actual tree
- subagents = []}).
-
--record(mib_info, {name, symbolic, file_name}).
--record(node_info, {oid, mib_name, me}).
-
-
-%% API
--export([new/0, new/1, sync/1, close/1,
- load_mib/4, unload_mib/4, which_mibs/1, whereis_mib/2,
- info/1, info/2,
- dump/1, dump/2,
- backup/2,
- lookup/2, next/3, which_mib/2,
- register_subagent/3, unregister_subagent/2]).
-
-%% Internal exports
--export([code_change/2]).
-
-
-%%-----------------------------------------------------------------
-%% A tree is represented as a N-tuple, where each element is a
-%% node. A node is:
-%% 1) {tree, Tree, Info} where Info can be {table, Id}, {table_entry, Id}
-%% or perhaps 'internal'
-%% 2) undefined_node (memory optimization (instead of {node, undefined}))
-%% 3) {node, Info} where Info can be {subagent, Pid}, {variable, Id},
-%% {table_column, Id}
-%% Id is {MibName, MibEntry}
-%% The over all root is represented as {tree, Tree, internal}.
-%%
-%% tree() = {tree, nodes(), tree_info()}
-%% nodes() = {tree() | node() | undefined_node, ...}
-%% node() = {node, node_info()}
-%% tree_info() = {table, Id} | {table_entry, Id} | internal
-%% node_info() = {subagent, Pid} | {variable, Id} | {table_colum, Id}
-%%-----------------------------------------------------------------
-
-%% This record is what is stored in the database. The 'tree' part
-%% is described above...
--record(tree,{generation = ?DUMMY_TREE_GENERATION, root = ?DEFAULT_TREE}).
-
-
-%%%======================================================================
-%%% 1. Interface
-%%%======================================================================
-
-%%-----------------------------------------------------------------
-%% Func: new/0, new/1
-%% Returns: A representation of mib data.
-%%-----------------------------------------------------------------
-new() ->
- new(ets).
-
-%% Where -> A list of nodes where the tables will be created
-new(Storage) ->
- %% First we must check if there is already something to read
- %% If a database already exists, then the tree structure has to be read
- ?vtrace("open (mib) database",[]),
- MibDb = snmpa_general_db:open(Storage, ?MIB_DATA,
- mib_info,
- record_info(fields,mib_info), set),
- ?vtrace("open (mib) node database",[]),
- NodeDb = snmpa_general_db:open(Storage, ?MIB_NODE,
- node_info,
- record_info(fields,node_info), set),
- ?vtrace("open (mib) tree database",[]),
- TreeDb = snmpa_general_db:open(Storage, ?MIB_TREE,
- tree,
- record_info(fields,tree), set),
- Tree =
- case snmpa_general_db:read(TreeDb, ?DUMMY_TREE_GENERATION) of
- false ->
- T = #tree{},
- snmpa_general_db:write(TreeDb, T),
- T;
- {value, T} ->
- T
- end,
- install_mibs(MibDb, NodeDb),
- #mib_data{mib_db = MibDb,
- node_db = NodeDb,
- tree_db = TreeDb,
- tree = Tree}.
-
-
-%%----------------------------------------------------------------------
-%% Returns: new mib data | {error, Reason}
-%%----------------------------------------------------------------------
-load_mib(MibData,FileName,MeOverride,TeOverride)
- when is_record(MibData,mib_data) andalso is_list(FileName) ->
- ?vlog("load mib file: ~p",[FileName]),
- ActualFileName = filename:rootname(FileName, ".bin") ++ ".bin",
- MibName = list_to_atom(filename:basename(FileName, ".bin")),
- (catch do_load_mib(MibData, ActualFileName, MibName,
- MeOverride, TeOverride)).
-
-do_load_mib(MibData, ActualFileName, MibName, MeOverride, TeOverride) ->
- ?vtrace("do_load_mib -> entry with"
- "~n ActualFileName: ~s"
- "~n MibName: ~p",[ActualFileName, MibName]),
- #mib_data{mib_db = MibDb,
- node_db = NodeDb,
- %% tree_db = TreeDb,
- tree = Tree} = MibData,
- verify_not_loaded(MibDb, MibName),
- ?vtrace("do_load_mib -> already loaded mibs:"
- "~n ~p",[loaded(MibDb)]),
- Mib = do_read_mib(ActualFileName),
- ?vtrace("do_load_mib -> read mib ~s",[Mib#mib.name]),
- NonInternalMes =
- lists:filter(fun(ME) -> maybe_drop_me(ME) end, Mib#mib.mes),
- OldRoot = Tree#tree.root,
- T = build_tree(NonInternalMes, MibName),
- ?d("load_mib -> "
- "~n OldRoot: ~p"
- "~n T: ~p", [OldRoot, T]),
- case (catch merge_nodes(T, OldRoot)) of
- {error_merge_nodes, Node1, Node2} ->
- ?vlog("error merging nodes:"
- "~n~p~nand~n~p", [Node1,Node2]),
- {error, oid_conflict};
- NewRoot when is_tuple(NewRoot) andalso (element(1,NewRoot) =:= tree) ->
- ?d("load_mib -> "
- "~n NewRoot: ~p", [NewRoot]),
- Symbolic = not lists:member(no_symbolic_info, Mib#mib.misc),
- case (catch check_notif_and_mes(TeOverride, MeOverride, Symbolic,
- Mib#mib.traps, NonInternalMes)) of
- true ->
- install_mes(NodeDb, MibName, NonInternalMes),
- install_mib(MibDb, Symbolic, Mib,
- MibName, ActualFileName, NonInternalMes),
- ?vtrace("installed mib ~s", [Mib#mib.name]),
- Tree2 = Tree#tree{root = NewRoot},
- %% snmpa_general_db:write(TreeDb, Tree2), %% Store later?
- {ok, MibData#mib_data{tree = Tree2}};
- Else ->
- Else
- end
- end.
-
-
-verify_not_loaded(Db, Name) ->
- case snmpa_general_db:read(Db, Name) of
- {value, #mib_info{name = Name}} ->
- throw({error, 'already loaded'});
- false ->
- ok
- end.
-
-do_read_mib(ActualFileName) ->
- case snmp_misc:read_mib(ActualFileName) of
- {error, Reason} ->
- ?vlog("Failed reading mib file ~p with reason: ~p",
- [ActualFileName,Reason]),
- throw({error, Reason});
- {ok, Mib} ->
- Mib
- end.
-
-%% The Tree DB is handled in a special way since it can be very large.
-sync(#mib_data{mib_db = M,
- node_db = N,
- tree_db = T, tree = Tree, subagents = []}) ->
- snmpa_general_db:sync(M),
- snmpa_general_db:sync(N),
- snmpa_general_db:write(T, Tree),
- snmpa_general_db:sync(T);
-sync(#mib_data{mib_db = M,
- node_db = N,
- tree_db = T, tree = Tree, subagents = SAs}) ->
-
- snmpa_general_db:sync(M),
- snmpa_general_db:sync(N),
-
- %% Ouch. Since the subagent info is dynamic we do not
- %% want to store the tree containing subagent info. So, we
- %% have to create a tmp tree without those and store it.
-
- case delete_subagents(Tree, SAs) of
- {ok, TreeWithoutSAs} ->
- snmpa_general_db:write(T, TreeWithoutSAs),
- snmpa_general_db:sync(T);
- Error ->
- Error
- end.
-
-delete_subagents(Tree, []) ->
- {ok, Tree};
-delete_subagents(Tree0, [{_, Oid}|SAs]) ->
- case (catch delete_subagent(Tree0, Oid)) of
- {tree, _Tree, _Info} = Tree1 ->
- delete_subagents(Tree1, SAs);
- _Error ->
- {error, {'invalid oid', Oid}}
- end.
-
-%%----------------------------------------------------------------------
-%% (OTP-3601)
-%%----------------------------------------------------------------------
-check_notif_and_mes(TeOverride,MeOverride,Symbolic,Traps,MEs) ->
- ?vtrace("check notifications and mib entries",[]),
- check_notifications(TeOverride,Symbolic,Traps),
- check_mes(MeOverride,MEs).
-
-check_notifications(true, _Symbolic, _Traps) ->
- ?vtrace("trapentry override = true => skip check",[]),
- true;
-check_notifications(_, Symbolic, Traps) ->
- check_notifications(Symbolic, Traps).
-
-check_notifications(true, Traps) ->
- check_notifications(Traps);
-check_notifications(_, _) -> true.
-
-check_notifications([]) -> true;
-check_notifications([#trap{trapname = Key} = Trap | Traps]) ->
- ?vtrace("check notification [trap] with Key: ~p",[Key]),
- case snmpa_symbolic_store:get_notification(Key) of
- {value, Trap} -> check_notifications(Traps);
- {value, _} -> throw({error, {'trap already defined', Key}});
- undefined -> check_notifications(Traps)
- end;
-check_notifications([#notification{trapname = Key} = Notif | Traps]) ->
- ?vtrace("check notification [notification] with Key: ~p",[Key]),
- case snmpa_symbolic_store:get_notification(Key) of
- {value, Notif} ->
- check_notifications(Traps);
- {value, _} ->
- throw({error, {'notification already defined', Key}});
- undefined ->
- check_notifications(Traps)
- end;
-check_notifications([Crap | Traps]) ->
- ?vlog("skipped check of: ~n~p",[Crap]),
- check_notifications(Traps).
-
-check_mes(true,_) ->
- ?vtrace("mibentry override = true => skip check",[]),
- true;
-check_mes(_,MEs) ->
- check_mes(MEs).
-
-check_mes([]) -> true;
-check_mes([#me{aliasname = Name, oid = Oid1} | MEs]) ->
- ?vtrace("check mib entries with aliasname: ~p",[Name]),
- case snmpa_symbolic_store:aliasname_to_oid(Name) of
- {value, Oid1} ->
- check_mes(MEs);
- {value, Oid2} ->
- ?vinfo("~n expecting '~p'~n but found '~p'",[Oid1, Oid2]),
- throw({error, {'mibentry already defined', Name}});
- false ->
- check_mes(MEs)
- end;
-check_mes([Crap | MEs]) ->
- ?vlog("skipped check of: ~n~p",[Crap]),
- check_mes(MEs).
-
-
-
-%%----------------------------------------------------------------------
-%% Returns: new mib data | {error, Reason}
-%%----------------------------------------------------------------------
-unload_mib(MibData, FileName, _, _) when is_list(FileName) ->
- MibName = list_to_atom(filename:basename(FileName, ".bin")),
- (catch do_unload_mib(MibData, MibName)).
-
-do_unload_mib(MibData, MibName) ->
- ?vtrace("do_unload_mib -> entry with"
- "~n MibName: ~p", [MibName]),
- #mib_data{mib_db = MibDb,
- node_db = NodeDb,
- %% tree_db = TreeDb,
- tree = Tree} = MibData,
- #mib_info{symbolic = Symbolic} = verify_loaded(MibDb, MibName),
- NewRoot = delete_mib_from_tree(MibName, Tree#tree.root),
- MEs = uninstall_mes(NodeDb, MibName),
- uninstall_mib(MibDb, Symbolic, MibName, MEs),
- NewMibData = MibData#mib_data{tree = Tree#tree{root = NewRoot}},
- {ok, NewMibData}.
-
-verify_loaded(Db, Name) ->
- case snmpa_general_db:read(Db, Name) of
- {value, MibInfo} ->
- MibInfo;
- false ->
- throw({error, 'not loaded'})
- end.
-
-
-close(#mib_data{mib_db = MibDb, node_db = NodeDb, tree_db = TreeDb}) ->
- snmpa_general_db:close(MibDb),
- snmpa_general_db:close(NodeDb),
- snmpa_general_db:close(TreeDb),
- ok.
-
-register_subagent(#mib_data{tree = T} = MibData, Oid, Pid) ->
- case insert_subagent(Oid, T#tree.root) of
- {error, Reason} ->
- {error, Reason};
- NewRootTree ->
- SAs = [{Pid, Oid} | MibData#mib_data.subagents],
- T2 = T#tree{root = NewRootTree},
- MibData#mib_data{tree = T2, subagents = SAs}
- end.
-
-
-%%----------------------------------------------------------------------
-%% Purpose: Get a list of all loaded mibs
-%% Returns: [{Name, File}]
-%%----------------------------------------------------------------------
-
-which_mibs(#mib_data{mib_db = Db}) ->
- Mibs = snmpa_general_db:tab2list(Db),
- [{Name, File} || #mib_info{name = Name, file_name = File} <- Mibs].
-
-
-%%----------------------------------------------------------------------
-%% Purpose: Get a list of all loaded mibs
-%% Returns: [{Name, File}]
-%%----------------------------------------------------------------------
-
-whereis_mib(#mib_data{mib_db = Db}, Name) ->
- case snmpa_general_db:read(Db, Name) of
- {value, #mib_info{file_name = File}} ->
- {ok, File};
- false ->
- {error, not_found}
- end.
-
-
-%%----------------------------------------------------------------------
-%% Purpose: Deletes SA with Pid from all subtrees it handles.
-%% Returns: NewMibData.
-%%----------------------------------------------------------------------
-unregister_subagent(MibData, Pid) when is_pid(Pid) ->
- SAs = MibData#mib_data.subagents,
- case lists:keysearch(Pid, 1, SAs) of
- false -> MibData;
- {value, {Pid, Oid}} ->
- % we should never get an error since Oid is found in MibData.
- {ok, NewMibData, _DeletedSA} = unregister_subagent(MibData, Oid),
- % continue if the same Pid handles other mib subtrees.
- unregister_subagent(NewMibData, Pid)
- end;
-
-%%----------------------------------------------------------------------
-%% Purpose: Deletes one unique subagent.
-%% Returns: {error, Reason} | {ok, NewMibData, DeletedSubagentPid}
-%%----------------------------------------------------------------------
-unregister_subagent(#mib_data{tree = T} = MibData, Oid) when is_list(Oid) ->
- case catch delete_subagent(T#tree.root, Oid) of
- {tree, Tree, Info} ->
- OldSAs = MibData#mib_data.subagents,
- {value, {Pid, _Oid}} = lists:keysearch(Oid, 2, OldSAs),
- SAs = lists:keydelete(Oid, 2, OldSAs),
- T2 = T#tree{root = {tree, Tree, Info}},
- {ok,
- MibData#mib_data{tree = T2, subagents = SAs},
- Pid};
- _ ->
- {error, {'invalid oid', Oid}}
- end.
-
-%%----------------------------------------------------------------------
-%% Purpose: To inpect memory usage, loaded mibs, registered subagents
-%%----------------------------------------------------------------------
-info(MibData) ->
- ?vtrace("retrieve info",[]),
- #mib_data{mib_db = MibDb, node_db = NodeDb, tree_db = TreeDb,
- tree = Tree, subagents = SAs} = MibData,
- LoadedMibs = old_format(snmpa_general_db:tab2list(MibDb)),
- TreeSize = snmp_misc:mem_size(Tree),
- {memory, ProcSize} = erlang:process_info(self(),memory),
- MibDbSize = snmpa_general_db:info(MibDb, memory),
- NodeDbSize = snmpa_general_db:info(NodeDb, memory),
- TreeDbSize = snmpa_general_db:info(TreeDb, memory),
- [{loaded_mibs, LoadedMibs}, {subagents, SAs}, {tree_size_bytes, TreeSize},
- {process_memory, ProcSize},
- {db_memory, [{mib,MibDbSize},{node,NodeDbSize},{tree,TreeDbSize}]}].
-
-info(#mib_data{mib_db = MibDb}, loaded_mibs) ->
- Mibs = snmpa_general_db:tab2list(MibDb),
- [filename:rootname(FN, ".bin") || #mib_info{file_name = FN} <- Mibs];
-info(#mib_data{tree = Tree}, tree_size_bytes) ->
- snmp_misc:mem_size(Tree);
-info(_, process_memory) ->
- {memory, ProcSize} = erlang:process_info(self(),memory),
- ProcSize;
-info(#mib_data{mib_db = MibDb, node_db = NodeDb, tree_db = TreeDb},
- db_memory) ->
- MibDbSize = snmpa_general_db:info(MibDb, memory),
- NodeDbSize = snmpa_general_db:info(NodeDb, memory),
- TreeDbSize = snmpa_general_db:info(TreeDb, memory),
- [{mib,MibDbSize},{node,NodeDbSize},{tree,TreeDbSize}];
-info(#mib_data{subagents = SAs}, subagents) ->
- SAs.
-
-old_format(LoadedMibs) ->
- ?vtrace("convert mib info to old format",[]),
- [{N,S,F} || #mib_info{name=N,symbolic=S,file_name=F} <- LoadedMibs].
-
-
-%%----------------------------------------------------------------------
-%% A total dump for debugging.
-%%----------------------------------------------------------------------
-dump(#mib_data{mib_db = MibDb, node_db = NodeDb, tree = Tree}) ->
- (catch io:format("MIB-tables:~n~p~n~n",
- [snmpa_general_db:tab2list(MibDb)])),
- (catch io:format("MIB-entries:~n~p~n~n",
- [snmpa_general_db:tab2list(NodeDb)])),
- (catch io:format("Tree:~n~p~n", [Tree])), % good luck reading it!
- ok.
-
-dump(#mib_data{mib_db = MibDb, node_db = NodeDb, tree = Tree}, File) ->
- case file:open(File,[write]) of
- {ok, Fd} ->
- io:format(Fd,"~s~n",
- [snmp:date_and_time_to_string(snmp:date_and_time())]),
- (catch io:format(Fd,"MIB-tables:~n~p~n~n",
- [snmpa_general_db:tab2list(MibDb)])),
- (catch io:format(Fd, "MIB-entries:~n~p~n~n",
- [snmpa_general_db:tab2list(NodeDb)])),
- io:format(Fd,"Tree:~n~p~n", [Tree]), % good luck reading it!
- file:close(Fd),
- ok;
- {error,Reason} ->
- ?vinfo("~n Failed opening file '~s' for reason ~p",
- [File,Reason]),
- {error,Reason}
- end.
-
-
-backup(#mib_data{mib_db = M, node_db = N, tree_db = T}, BackupDir) ->
- MRes = snmpa_general_db:backup(M, BackupDir),
- NRes = snmpa_general_db:backup(N, BackupDir),
- TRes = snmpa_general_db:backup(T, BackupDir),
- handle_backup_res([{mib_db, MRes}, {node_db, NRes}, {tree_db, TRes}]).
-
-handle_backup_res(Res) ->
- handle_backup_res(Res, []).
-
-handle_backup_res([], []) ->
- ok;
-handle_backup_res([], Err) ->
- {error, lists:reverse(Err)};
-handle_backup_res([{_, ok}|Res], Err) ->
- handle_backup_res(Res, Err);
-handle_backup_res([{Tag, {error, Reason}}|Res], Err) ->
- handle_backup_res(Res, [{Tag, Reason}|Err]);
-handle_backup_res([{Tag, Error}|Res], Err) ->
- handle_backup_res(Res, [{Tag, Error}|Err]).
-
-
-%%%======================================================================
-%%% 2. Implementation of tree access
-%%% lookup and next.
-%%%======================================================================
-
-
-which_mib(#mib_data{tree = T} = D, Oid) ->
- ?vtrace("which_mib -> entry with"
- "~n Oid: ~p",[Oid]),
- case (catch find_node(D, T#tree.root, Oid, [])) of
- {variable, _ME, Mib} ->
- ?vtrace("which_mib -> variable:"
- "~n Mib: ~p", [Mib]),
- {ok, Mib};
- {table, _EntryME, _, Mib} ->
- ?vtrace("which_mib -> table:"
- "~n Mib: ~p", [Mib]),
- {ok, Mib};
- {subagent, SubAgentPid, _SANextOid} ->
- ?vtrace("which_mib -> subagent:"
- "~n SubAgentPid: ~p", [SubAgentPid]),
- {error, {subagent, SubAgentPid}};
- {false, ErrorCode} ->
- ?vtrace("which_mib -> false:"
- "~n ErrorCode: ~p",[ErrorCode]),
- {error, ErrorCode};
- false ->
- ?vtrace("which_mib -> false",[]),
- {error, noSuchObject};
- {'EXIT', R} ->
- ?vtrace("which_mib -> exit:"
- "~n R: ~p",[R]),
- {error, noSuchObject}
- end.
-
-
-%%-----------------------------------------------------------------
-%% Func: lookup/2
-%% Purpose: Finds the mib entry corresponding to the Oid. If it is a
-%% variable, the Oid must be <Oid for var>.0 and if it is
-%% a table, Oid must be <table>.<entry>.<col>.<any>
-%% Returns: {variable, MibEntry} |
-%% {table_column, MibEntry, TableEntryOid} |
-%% {subagent, SubAgentPid, SAOid} |
-%% {false, Reason}
-%%-----------------------------------------------------------------
-lookup(#mib_data{tree = T} = D, Oid) ->
- ?vtrace("lookup -> entry with"
- "~n Oid: ~p",[Oid]),
- case (catch find_node(D, T#tree.root, Oid, [])) of
- {variable, ME, _Mib} when is_record(ME, me) ->
- ?vtrace("lookup -> variable:"
- "~n ME: ~p",[ME]),
- {variable, ME};
- {table, EntryME, {ColME, TableEntryOid}, _Mib} ->
- ?vtrace("lookup -> table:"
- "~n EntryME: ~p"
- "~n ColME: ~p"
- "~n RevTableEntryOid: ~p",
- [EntryME, ColME, TableEntryOid]),
- MFA = EntryME#me.mfa,
- RetME = ColME#me{mfa = MFA},
- {table_column, RetME, TableEntryOid};
- {subagent, SubAgentPid, SANextOid} ->
- ?vtrace("lookup -> subagent:"
- "~n SubAgentPid: ~p"
- "~n SANextOid: ~p", [SubAgentPid, SANextOid]),
- {subagent, SubAgentPid, SANextOid};
- {false, ErrorCode} ->
- ?vtrace("lookup -> false:"
- "~n ErrorCode: ~p",[ErrorCode]),
- {false, ErrorCode};
- false ->
- ?vtrace("lookup -> false",[]),
- {false, noSuchObject};
- {'EXIT', R} ->
- ?vtrace("lookup -> exit:"
- "~n R: ~p",[R]),
- {false, noSuchObject}
- end.
-
-
-find_node(D, {tree, Tree, {table, _}}, RestOfOid, RevOid) ->
- ?vtrace("find_node(tree,table) -> entry with"
- "~n RestOfOid: ~p"
- "~n RevOid: ~p",[RestOfOid, RevOid]),
- find_node(D, {tree, Tree, internal}, RestOfOid, RevOid);
-find_node(D, {tree, Tree, {table_entry, _}}, RestOfOid, RevOid) ->
- ?vtrace("find_node(tree,table_entry) -> entry with"
- "~n RestOfOid: ~p"
- "~n RevOid: ~p",[RestOfOid, RevOid]),
- #mib_data{node_db = Db} = D,
- Oid = lists:reverse(RevOid),
- case snmpa_general_db:read(Db, Oid) of
- {value, #node_info{me = ME, mib_name = Mib}} ->
- case find_node(D, {tree, Tree, internal}, RestOfOid, RevOid) of
- {false, ErrorCode} -> {false, ErrorCode};
- Val -> {table, ME, Val, Mib}
- end;
- false ->
- ?vinfo("find_node -> could not find table_entry ME with"
- "~n RevOid: ~p"
- "~n when"
- "~n RestOfOid: ~p",
- [RevOid, RestOfOid]),
- false
- end;
-find_node(D, {tree, Tree, _Internal}, [Int | RestOfOid], RevOid) ->
- ?vtrace("find_node(tree) -> entry with"
- "~n Int: ~p"
- "~n RestOfOid: ~p"
- "~n RevOid: ~p",[Int, RestOfOid, RevOid]),
- find_node(D, element(Int+1, Tree), RestOfOid, [Int | RevOid]);
-find_node(D, {node, {table_column, _}}, RestOfOid, [ColInt | RevOid]) ->
- ?vtrace("find_node(tree,table_column) -> entry with"
- "~n RestOfOid: ~p"
- "~n ColInt: ~p"
- "~n RevOid: ~p",[RestOfOid, ColInt, RevOid]),
- #mib_data{node_db = Db} = D,
- Oid = lists:reverse([ColInt | RevOid]),
- case snmpa_general_db:read(Db, Oid) of
- {value, #node_info{me = ME}} ->
- {ME, lists:reverse(RevOid)};
- false ->
- X = snmpa_general_db:read(Db, lists:reverse([ColInt | RevOid])),
- ?vinfo("find_node -> could not find table_column ME with"
- "~n RevOid: ~p"
- "~n trying [~p|~p]"
- "~n X: ~p",
- [RevOid, [ColInt | RevOid], X]),
- false
- end;
-find_node(D, {node, {variable, _MibName}}, [0], RevOid) ->
- ?vtrace("find_node(tree,variable,[0]) -> entry with"
- "~n RevOid: ~p",[RevOid]),
- #mib_data{node_db = Db} = D,
- Oid = lists:reverse(RevOid),
- %% {value, #node_info{me = ME}} = snmpa_general_db:read(Db, Oid),
- case snmpa_general_db:read(Db, Oid) of
- {value, #node_info{me = ME, mib_name = Mib}} ->
- {variable, ME, Mib};
- false ->
- ?vinfo("find_node -> could not find variable ME with"
- "~n RevOid: ~p", [RevOid]),
- false
- end;
-find_node(_D, {node, {variable, _MibName}}, [], _RevOid) ->
- ?vtrace("find_node(tree,variable,[]) -> entry",[]),
- {false, noSuchObject};
-find_node(_D, {node, {variable, _MibName}}, _, _RevOid) ->
- ?vtrace("find_node(tree,variable) -> entry",[]),
- {false, noSuchInstance};
-find_node(D, {node, subagent}, _RestOfOid, SARevOid) ->
- ?vtrace("find_node(tree,subagent) -> entry with"
- "~n SARevOid: ~p",[SARevOid]),
- #mib_data{subagents = SAs} = D,
- SAOid = lists:reverse(SARevOid),
- case lists:keysearch(SAOid, 2, SAs) of
- {value, {SubAgentPid, SAOid}} ->
- {subagent, SubAgentPid, SAOid};
- false ->
- ?vinfo("find_node -> could not find subagent with"
- "~n SAOid: ~p"
- "~n SAs: ~p", [SAOid, SAs]),
- false
- end;
-find_node(_D, Node, _RestOfOid, _RevOid) ->
- ?vtrace("find_node -> failed:~n~p",[Node]),
- {false, noSuchObject}.
-
-
-%%-----------------------------------------------------------------
-%% Func: next/3
-%% Purpose: Finds the lexicographically next oid.
-%% Returns: endOfMibView |
-%% {subagent, SubAgentPid, SAOid} |
-%% {variable, MibEntry, VarOid} |
-%% {table, TableOid, TableRestOid, MibEntry}
-%% If a variable is returnes, it is in the MibView.
-%% If a table or subagent is returned, it *may* be in the MibView.
-%%-----------------------------------------------------------------
-next(#mib_data{tree = T} = D, Oid, MibView) ->
- case catch next_node(D, T#tree.root, Oid, [], MibView) of
- false -> endOfMibView;
- Else -> Else
- end.
-
-%%-----------------------------------------------------------------
-%% This function is used as long as we have any Oid left. Take
-%% one integer at a time from the Oid, and traverse the tree
-%% accordingly. When the Oid is empty, call find_next.
-%% Returns: {subagent, SubAgentPid, SAOid} |
-%% false |
-%% {variable, MibEntry, VarOid} |
-%% {table, TableOid, TableRestOid, MibEntry}
-%%-----------------------------------------------------------------
-next_node(_D, undefined_node, _Oid, _RevOidSoFar, _MibView) ->
- ?vtrace("next_node(undefined_node) -> entry", []),
- false;
-
-next_node(_D, {tree, Tree, {table_entry, _Id}}, [Int | _Oid],
- _RevOidSoFar, _MibView)
- when Int+1 > size(Tree) ->
- ?vtrace("next_node(tree,table_entry) -> entry when not found whith"
- "~n Int: ~p"
- "~n size(Tree): ~p", [Int, size(Tree)]),
- false;
-next_node(D, {tree, Tree, {table_entry, _MibName}},
- Oid, RevOidSoFar, MibView) ->
- ?vtrace("next_node(tree,table_entry) -> entry when"
- "~n size(Tree): ~p"
- "~n Oid: ~p"
- "~n RevOidSoFar: ~p"
- "~n MibView: ~p", [size(Tree), Oid, RevOidSoFar, MibView]),
- OidSoFar = lists:reverse(RevOidSoFar),
- case snmpa_acm:is_definitely_not_in_mib_view(OidSoFar, MibView) of
- true ->
- ?vdebug("next_node(tree,table_entry) -> not in mib view",[]),
- false;
- _ ->
- #mib_data{node_db = Db} = D,
- case snmpa_general_db:read(Db, OidSoFar) of
- false ->
- ?vinfo("next_node -> could not find table_entry with"
- "~n OidSoFar: ~p", [OidSoFar]),
- false;
- {value, #node_info{me = ME}} ->
- ?vtrace("next_node(tree,table_entry) -> found: ~n ~p",
- [ME]),
- {table, OidSoFar, Oid, ME}
- end
- end;
-
-next_node(D, {tree, Tree, _Info}, [Int | RestOfOid], RevOidSoFar, MibView)
- when (Int < size(Tree)) andalso (Int >= 0) ->
- ?vtrace("next_node(tree) -> entry when"
- "~n size(Tree): ~p"
- "~n Int: ~p"
- "~n RestOfOid: ~p"
- "~n RevOidSoFar: ~p"
- "~n MibView: ~p",
- [size(Tree), Int, RestOfOid, RevOidSoFar, MibView]),
- case next_node(D, element(Int+1,Tree),
- RestOfOid, [Int|RevOidSoFar], MibView) of
- false ->
- find_next(D, {tree, Tree, _Info}, Int+1, RevOidSoFar, MibView);
- Else ->
- Else
- end;
-%% no solution
-next_node(D, {tree, Tree, _Info}, [], RevOidSoFar, MibView) ->
- ?vtrace("next_node(tree,[]) -> entry when"
- "~n size(Tree): ~p"
- "~n RevOidSoFar: ~p"
- "~n MibView: ~p",
- [size(Tree), RevOidSoFar, MibView]),
- find_next(D, {tree, Tree, _Info}, 0, RevOidSoFar, MibView);
-next_node(_D, {tree, Tree, _Info}, _RestOfOid, _RevOidSoFar, _MibView) ->
- ?vtrace("next_node(tree) -> entry when"
- "~n size(Tree): ~p", [size(Tree)]),
- false;
-
-next_node(D, {node, subagent}, Oid, RevOidSoFar, MibView) ->
- ?vtrace("next_node(node,subagent) -> entry when"
- "~n Oid: ~p"
- "~n RevOidSoFar: ~p"
- "~n MibView: ~p",
- [Oid, RevOidSoFar, MibView]),
- OidSoFar = lists:reverse(RevOidSoFar),
- case snmpa_acm:is_definitely_not_in_mib_view(OidSoFar, MibView) of
- true ->
- false;
- _ ->
- #mib_data{subagents = SAs} = D,
- case lists:keysearch(OidSoFar, 2, SAs) of
- {value, {SubAgentPid, OidSoFar}} ->
- {subagent, SubAgentPid, OidSoFar};
- _ ->
- ?vinfo("next_node -> could not find subagent with"
- "~n OidSoFar: ~p"
- "~n SAs: ~p", [OidSoFar, SAs]),
- false
- end
- end;
-
-next_node(D, {node, {variable, _MibName}}, [], RevOidSoFar, MibView) ->
- ?vtrace("next_node(node,variable,[]) -> entry when"
- "~n RevOidSoFar: ~p"
- "~n MibView: ~p",
- [RevOidSoFar, MibView]),
- OidSoFar = lists:reverse([0 | RevOidSoFar]),
- case snmpa_acm:validate_mib_view(OidSoFar, MibView) of
- true ->
- #mib_data{node_db = Db} = D,
- case snmpa_general_db:read(Db, lists:reverse(RevOidSoFar)) of
- false ->
- ?vinfo("next_node -> could not find variable with"
- "~n RevOidSoFar: ~p", [RevOidSoFar]),
- false;
- {value, #node_info{me = ME}} ->
- {variable, ME, OidSoFar}
- end;
- _ ->
- false
- end;
-
-next_node(_D, {node, {variable, _MibName}}, _Oid, _RevOidSoFar, _MibView) ->
- ?vtrace("next_node(node,variable) -> entry", []),
- false.
-
-%%-----------------------------------------------------------------
-%% This function is used to find the first leaf from where we
-%% are.
-%% Returns: {subagent, SubAgentPid, SAOid} |
-%% false |
-%% {variable, MibEntry, VarOid} |
-%% {table, TableOid, TableRestOid, MibEntry}
-%% PRE: This function must always be called with a {internal, Tree}
-%% node.
-%%-----------------------------------------------------------------
-find_next(D, {tree, Tree, internal}, Idx, RevOidSoFar, MibView)
- when Idx < size(Tree) ->
- case find_next(D, element(Idx+1, Tree), 0, [Idx| RevOidSoFar], MibView) of
- false ->
- find_next(D, {tree, Tree, internal}, Idx+1, RevOidSoFar, MibView);
- Other ->
- Other
- end;
-find_next(_D, {tree, _Tree, internal}, _Idx, _RevOidSoFar, _MibView) ->
- false;
-find_next(_D, undefined_node, _Idx, _RevOidSoFar, _MibView) ->
- false;
-find_next(D, {tree, Tree, {table, _MibName}}, Idx, RevOidSoFar, MibView) ->
- find_next(D, {tree, Tree, internal}, Idx, RevOidSoFar, MibView);
-find_next(D, {tree, _Tree, {table_entry, _MibName}}, _Index,
- RevOidSoFar, MibView) ->
- OidSoFar = lists:reverse(RevOidSoFar),
- case snmpa_acm:is_definitely_not_in_mib_view(OidSoFar, MibView) of
- true ->
- false;
- _ ->
- #mib_data{node_db = Db} = D,
- case snmpa_general_db:read(Db, OidSoFar) of
- false ->
- ?vinfo("find_next -> could not find table_entry ME with"
- "~n OidSoFar: ~p", [OidSoFar]),
- false;
- {value, #node_info{me = ME}} ->
- {table, OidSoFar, [], ME}
- end
- end;
-find_next(D, {node, {variable, _MibName}}, _Idx, RevOidSoFar, MibView) ->
- OidSoFar = lists:reverse([0 | RevOidSoFar]),
- case snmpa_acm:validate_mib_view(OidSoFar, MibView) of
- true ->
- #mib_data{node_db = Db} = D,
- case snmpa_general_db:read(Db, lists:reverse(RevOidSoFar)) of
- false ->
- ?vinfo("find_next -> could not find variable with"
- "~n RevOidSoFar: ~p", [RevOidSoFar]),
- false;
- {value, #node_info{me = ME}} ->
- {variable, ME, OidSoFar}
- end;
- _ ->
- false
- end;
-find_next(D, {node, subagent}, _Idx, RevOidSoFar, MibView) ->
- OidSoFar = lists:reverse(RevOidSoFar),
- case snmpa_acm:is_definitely_not_in_mib_view(OidSoFar, MibView) of
- true ->
- false;
- _ ->
- #mib_data{subagents = SAs} = D,
- case lists:keysearch(OidSoFar, 2, SAs) of
- {value, {SubAgentPid, OidSoFar}} ->
- {subagent, SubAgentPid, OidSoFar};
- false ->
- ?vinfo("find_node -> could not find subagent with"
- "~n OidSoFar: ~p"
- "~n SAs: ~p", [OidSoFar, SAs]),
- false
- end
- end.
-
-%%%======================================================================
-%%% 3. Tree building functions
-%%% Used when loading mibs.
-%%%======================================================================
-
-build_tree(Mes, MibName) ->
- ?d("build_tree -> "
- "~n Mes: ~p", [Mes]),
- {ListTree, []} = build_subtree([], Mes, MibName),
- {tree, convert_tree(ListTree), internal}.
-
-%%----------------------------------------------------------------------
-%% Purpose: Builds the tree where all oids have prefix equal to LevelPrefix.
-%% Returns: {Tree, RestMes}
-%% RestMes are Mes that should not be in this subtree.
-%% The Tree is a temporary and simplified data structure that is easy to
-%% convert to the final tuple tree used by the MIB process.
-%% A Node is represented as in the final tree.
-%% The tree is not represented as a N-tuple, but as an Index-list.
-%% Example: Temporary: [{1, Node1}, {3, Node3}]
-%% Final: {Node1, undefined_node, Node3}
-%% Pre: Mes are sorted on oid.
-%%----------------------------------------------------------------------
-build_subtree(LevelPrefix, [Me | Mes], MibName) ->
- ?vtrace("build subtree -> ~n"
- " oid: ~p~n"
- " LevelPrefix: ~p~n"
- " MibName: ~p", [Me#me.oid, LevelPrefix, MibName]),
- EType = Me#me.entrytype,
- ?vtrace("build subtree -> EType = ~p",[EType]),
- case in_subtree(LevelPrefix, Me) of
- above ->
- ?vtrace("build subtree -> above",[]),
- {[], [Me|Mes]};
- {node, Index} ->
- ?vtrace("build subtree -> node at ~p",[Index]),
- {Tree, RestMes} = build_subtree(LevelPrefix, Mes, MibName),
- {[{Index, {node, {EType, MibName}}} | Tree], RestMes};
- {subtree, Index, NewLevelPrefix} ->
- ?vtrace("build subtree -> subtree at"
- "~n ~w with ~w",
- [Index, NewLevelPrefix]),
- {BelowTree, RestMes} =
- build_subtree(NewLevelPrefix, Mes, MibName),
- {CurTree, RestMes2} =
- build_subtree(LevelPrefix, RestMes, MibName),
- {[{Index, {tree, BelowTree, {EType,MibName}}}| CurTree], RestMes2};
- {internal_subtree, Index, NewLevelPrefix} ->
- ?vtrace("build subtree -> internal_subtree at"
- "~n ~w with ~w",
- [Index,NewLevelPrefix]),
- {BelowTree, RestMes} =
- build_subtree(NewLevelPrefix, [Me | Mes], MibName),
- {CurTree, RestMes2} =
- build_subtree(LevelPrefix, RestMes, MibName),
- {[{Index, {tree, BelowTree, internal}} | CurTree], RestMes2}
- end;
-
-build_subtree(_LevelPrefix, [], _MibName) ->
- ?vtrace("build subtree -> done", []),
- {[], []}.
-
-%%--------------------------------------------------
-%% Purpose: Determine how/if/where Me should be inserted in subtree
-%% with LevelPrefix. This function does not build any tree, only
-%% determinses what should be done (by build subtree).
-%% Returns:
-%% above - Indicating that this ME should _not_ be in this subtree.
-%% {node, Index} - yes, construct a node with index Index on this level
-%% {internal_subtree, Index, NewLevelPrefix} - yes, there should be an
-%% internal subtree at this index.
-%% {subtree, Index, NewLevelPrefix} - yes, construct a subtree with
-%% NewLevelPrefix and insert this on current level in position Index.
-%%--------------------------------------------------
-in_subtree(LevelPrefix, Me) ->
- case lists:prefix(LevelPrefix, Me#me.oid) of
- true when length(Me#me.oid) > length(LevelPrefix) ->
- classify_how_in_subtree(LevelPrefix, Me);
- _ ->
- above
- end.
-
-%%--------------------------------------------------
-%% See comment about in_subtree/2. This function takes care of all cases
-%% where the ME really should be in _this_ subtree (not above).
-%%--------------------------------------------------
-classify_how_in_subtree(LevelPrefix, Me)
- when (length(Me#me.oid) =:= (length(LevelPrefix) + 1)) ->
- Oid = Me#me.oid,
- case node_or_subtree(Me#me.entrytype) of
- subtree ->
- {subtree, lists:last(Oid), Oid};
- node ->
- {node, lists:last(Oid)}
- end;
-
-classify_how_in_subtree(LevelPrefix, Me)
- when (length(Me#me.oid) > (length(LevelPrefix) + 1)) ->
- L1 = length(LevelPrefix) + 1,
- Oid = Me#me.oid,
- {internal_subtree, lists:nth(L1, Oid), lists:sublist(Oid, 1, L1)}.
-
-%%--------------------------------------------------
-%% Determines how to treat different kinds om MEs in the tree building process.
-%% Pre: all internal nodes have been removed.
-%%--------------------------------------------------
-node_or_subtree(table) -> subtree;
-node_or_subtree(table_entry) -> subtree;
-node_or_subtree(variable) -> node;
-node_or_subtree(table_column) -> node.
-
-%%--------------------------------------------------
-%% Purpose: (Recursively) Converts a temporary tree (see above) to a final tree.
-%% If input is a ListTree, output is a TupleTree.
-%% If input is a Node, output is the same Node.
-%% Pre: All Indexes are >= 0.
-%%--------------------------------------------------
-convert_tree({Index, {tree, Tree, Info}}) when Index >= 0 ->
- L = lists:map(fun convert_tree/1, Tree),
- {Index, {tree, dict_list_to_tuple(L), Info}};
-convert_tree({Index, {node, Info}}) when Index >= 0 ->
- {Index, {node, Info}};
-convert_tree(Tree) when is_list(Tree) ->
- L = lists:map(fun convert_tree/1, Tree),
- dict_list_to_tuple(L).
-
-%%----------------------------------------------------------------------
-%% Purpose: Converts a single level (that is non-recursively) from
-%% the temporary indexlist to the N-tuple.
-%% Input: A list of {Index, Data}.
-%% Output: A tuple where element Index is Data.
-%%----------------------------------------------------------------------
-dict_list_to_tuple(L) ->
- L2 = lists:keysort(1, L),
- list_to_tuple(integrate_indexes(0, L2)).
-
-%%----------------------------------------------------------------------
-%% Purpose: Helper function for dict_list_to_tuple/1.
-%% Converts an indexlist to a N-list.
-%% Input: A list of {Index, Data}.
-%% Output: A (usually longer, never shorter) list where element Index is Data.
-%% Example: [{1,hej}, {3, sven}] will give output
-%% [undefined_node, hej, undefined_node, sven].
-%% Initially CurIndex should be 0.
-%%----------------------------------------------------------------------
-integrate_indexes(CurIndex, [{CurIndex, Data} | T]) ->
- [Data | integrate_indexes(CurIndex + 1, T)];
-integrate_indexes(_Index, []) ->
- [];
-integrate_indexes(CurIndex, L) ->
- [undefined_node | integrate_indexes(CurIndex + 1, L)].
-
-%%%======================================================================
-%%% 4. Tree merging
-%%% Used by: load mib, insert subagent.
-%%%======================================================================
-
-%%----------------------------------------------------------------------
-%% Arg: Two root nodes (that is to be merged).
-%% Returns: A new root node where the nodes have been merger to one.
-%%----------------------------------------------------------------------
-merge_nodes(Same, Same) ->
- Same;
-merge_nodes(Node, undefined_node) ->
- Node;
-merge_nodes(undefined_node, Node) ->
- Node;
-merge_nodes({tree, Tree1, internal}, {tree, Tree2, internal}) ->
- {tree, merge_levels(tuple_to_list(Tree1),tuple_to_list(Tree2)), internal};
-merge_nodes(Node1, Node2) ->
- throw({error_merge_nodes, Node1, Node2}).
-
-%%----------------------------------------------------------------------
-%% Arg: Two levels to be merged.
-%% Here, a level is represented as a list of nodes. A list is easier
-%% to extend than a tuple.
-%% Returns: The resulting, merged level tuple.
-%%----------------------------------------------------------------------
-merge_levels(Level1, Level2) when length(Level1) =:= length(Level2) ->
- MergeNodes = fun(N1, N2) -> merge_nodes(N1, N2) end,
- list_to_tuple(snmp_misc:multi_map(MergeNodes, [Level1, Level2]));
-merge_levels(Level1, Level2) when length(Level1) > length(Level2) ->
- merge_levels(Level1, Level2 ++
- undefined_nodes_list(length(Level1) - length(Level2)));
-merge_levels(Level1, Level2) when length(Level1) < length(Level2) ->
- merge_levels(Level2, Level1).
-
-undefined_nodes_list(N) -> lists:duplicate(N, undefined_node).
-
-
-%%%======================================================================
-%%% 5. Tree deletion routines
-%%% (for unload mib)
-%%%======================================================================
-
-%%----------------------------------------------------------------------
-%% Purpose: Actually kicks of the tree reconstruction.
-%% Returns: {list of removed MEs, NewTree}
-%%----------------------------------------------------------------------
-delete_mib_from_tree(MibName, {tree, Tree, internal}) ->
- case delete_tree(Tree, MibName) of
- [] ->
- {tree, {undefined_node}, internal}; % reduce
- LevelList ->
- {tree, list_to_tuple(LevelList), internal}
- end.
-
-%%----------------------------------------------------------------------
-%% Purpose: Deletes all nodes associated to MibName from this level and
-%% all levels below.
-%% If the new level does not contain information (that is, no
-%% other mibs use it) anymore the empty list is returned.
-%% Returns: {MEs, The new level represented as a list}
-%%----------------------------------------------------------------------
-delete_tree(Tree, MibName) when is_tuple(Tree) ->
- NewLevel = delete_nodes(tuple_to_list(Tree), MibName, []),
- case lists:filter(fun drop_undefined_nodes/1,NewLevel) of
- [] -> [];
- _A_perhaps_shorted_list ->
- NewLevel % some other mib needs this level
- end.
-
-%%----------------------------------------------------------------------
-%% Purpose: Nodes belonging to MibName are removed from the tree.
-%% Recursively deletes sub trees to this node.
-%% Returns: {MEs, NewNodesList}
-%%----------------------------------------------------------------------
-delete_nodes([], _MibName, AccNodes) ->
- lists:reverse(AccNodes);
-
-delete_nodes([{node, {variable, MibName}}|T], MibName, AccNodes) ->
- delete_nodes(T, MibName, [undefined_node | AccNodes]);
-
-delete_nodes([{node, {table_column, MibName}}|T], MibName, AccNodes) ->
- delete_nodes(T, MibName, [undefined_node | AccNodes]);
-
-delete_nodes([{tree, _Tree, {table, MibName}}|T], MibName, AccNodes) ->
- delete_nodes(T, MibName, [undefined_node | AccNodes]);
-
-delete_nodes([{tree, _Tree, {table_entry, MibName}}|T], MibName, AccNodes) ->
- delete_nodes(T, MibName, [undefined_node | AccNodes]);
-
-delete_nodes([{tree, Tree, Info}|T], MibName, AccNodes) ->
- case delete_tree(Tree, MibName) of
- [] -> % tree completely deleted
- delete_nodes(T, MibName, [undefined_node | AccNodes]);
- LevelList ->
- delete_nodes(T, MibName,
- [{tree, list_to_tuple(LevelList), Info} | AccNodes])
- end;
-
-delete_nodes([NodeToKeep|T], MibName, AccNodes) ->
- delete_nodes(T, MibName, [NodeToKeep | AccNodes]).
-
-drop_undefined_nodes(undefined_node) -> false;
-drop_undefined_nodes(_) -> true.
-
-
-%%%======================================================================
-%%% 6. Functions for subagent handling
-%%%======================================================================
-
-%%----------------------------------------------------------------------
-%% Returns: A new Root|{error, reason}
-%%----------------------------------------------------------------------
-insert_subagent(Oid, OldRoot) ->
- ListTree = build_tree_for_subagent(Oid),
- case catch convert_tree(ListTree) of
- {'EXIT', _Reason} ->
- {error, 'cannot construct tree from oid'};
- Level when is_tuple(Level) ->
- T = {tree, Level, internal},
- case catch merge_nodes(T, OldRoot) of
- {error_merge_nodes, _Node1, _Node2} ->
- {error, oid_conflict};
- NewRoot when is_tuple(NewRoot) andalso
- (element(1, NewRoot) =:= tree) ->
- NewRoot
- end
- end.
-
-build_tree_for_subagent([Index]) ->
- [{Index, {node, subagent}}];
-
-build_tree_for_subagent([Index | T]) ->
- [{Index, {tree, build_tree_for_subagent(T), internal}}].
+-type mib_view() :: [mib_view_elem()].
+-type mib_view_elem() :: {SubTree :: snmp:oid(),
+ Mask :: [non_neg_integer()],
+ Inclusion :: mib_view_inclusion()}.
+-type mib_view_mask() :: [non_neg_integer()].
+-type mib_view_inclusion() :: 1 | 2. % 1 = included, 2 = excluded
-%%----------------------------------------------------------------------
-%% Returns: A new tree where the subagent at Oid (2nd arg) has been deleted.
-%%----------------------------------------------------------------------
-delete_subagent({tree, Tree, Info}, [Index]) ->
- {node, subagent} = element(Index+1, Tree),
- {tree, setelement(Index+1, Tree, undefined_node), Info};
-delete_subagent({tree, Tree, Info}, [Index | TI]) ->
- {tree, setelement(Index+1, Tree,
- delete_subagent(element(Index+1, Tree), TI)), Info}.
+-type filename() :: file:filename().
-%%%======================================================================
-%%% 7. Misc functions
-%%%======================================================================
-%%----------------------------------------------------------------------
-%% Installs the mibs found in the database when starting the agent.
-%% Basically calls the instrumentation functions for all non-internal
-%% mib-entries
-%%----------------------------------------------------------------------
-install_mibs(MibDb, NodeDb) ->
- MibNames = loaded(MibDb),
- ?vtrace("install_mibs -> found following mibs in database: ~n"
- "~p", [MibNames]),
- install_mibs2(NodeDb, MibNames).
+-callback new(MibStorage :: snmpa:mib_storage()) -> State :: term().
-install_mibs2(_, []) ->
- ok;
-install_mibs2(NodeDb, [MibName|MibNames]) ->
- Pattern = #node_info{oid = '_', mib_name = MibName, me = '_'},
- Nodes = snmpa_general_db:match_object(NodeDb, Pattern),
- MEs = [ME || #node_info{me = ME} <- Nodes],
- ?vtrace("install_mibs2 -> installing ~p MEs for mib ~p",
- [length(MEs),MibName]),
- NewF = fun(ME) -> call_instrumentation(ME, new) end,
- lists:foreach(NewF, MEs),
- install_mibs2(NodeDb, MibNames).
-
-
-%%----------------------------------------------------------------------
-%% Does all side effect stuff during load_mib.
-%%----------------------------------------------------------------------
-install_mib(Db, Symbolic, Mib, MibName, FileName, NonInternalMes) ->
- ?vdebug("install_mib -> entry with"
- "~n Symbolic: ~p"
- "~n MibName: ~p"
- "~n FileName: ~p", [Symbolic, MibName, FileName]),
- Rec = #mib_info{name = MibName, symbolic = Symbolic, file_name = FileName},
- snmpa_general_db:write(Db, Rec),
- install_mib2(Symbolic, MibName, Mib),
- NewF = fun(ME) -> call_instrumentation(ME, new) end,
- lists:foreach(NewF, NonInternalMes).
+-callback close(State :: term()) -> ok.
-install_mib2(true, MibName, Mib) ->
- #mib{table_infos = TabInfos,
- variable_infos = VarInfos,
- mes = MEs,
- asn1_types = ASN1Types,
- traps = Traps} = Mib,
- snmpa_symbolic_store:add_table_infos(MibName, TabInfos),
- snmpa_symbolic_store:add_variable_infos(MibName, VarInfos),
- snmpa_symbolic_store:add_aliasnames(MibName, MEs),
- snmpa_symbolic_store:add_types(MibName, ASN1Types),
- SetF = fun(Trap) ->
- snmpa_symbolic_store:set_notification(Trap, MibName)
- end,
- lists:foreach(SetF, Traps);
-install_mib2(_, _, _) ->
- ok.
+-callback sync(State :: term()) -> ok.
-install_mes(_Db, _MibName, []) ->
- ok;
-install_mes(Db, MibName, [ME|MEs]) ->
- Node = #node_info{oid = ME#me.oid, mib_name = MibName, me = ME},
- snmpa_general_db:write(Db, Node),
- install_mes(Db, MibName, MEs).
+-callback load_mib(State :: term(), FileName :: string(),
+ MeOverride :: boolean(),
+ TeOverride :: boolean()) ->
+ {ok, NewState :: term()} | {error, Reason :: already_loaded | term()}.
+-callback unload_mib(State :: term(), FileName :: string(),
+ MeOverride :: boolean(),
+ TeOverride :: boolean()) ->
+ {ok, NewState :: term()} | {error, Reason :: not_loaded | term()}.
-%%----------------------------------------------------------------------
-%% Does all side effect stuff during unload_mib.
-%%----------------------------------------------------------------------
-uninstall_mib(Db, Symbolic, MibName, MEs) ->
- ?vtrace("uninstall_mib -> entry with"
- "~n Db: ~p"
- "~n Symbolic: ~p"
- "~n MibName: ~p", [Db, Symbolic, MibName]),
- Res = snmpa_general_db:delete(Db, MibName),
- ?vtrace("uninstall_mib -> (mib) db delete result: ~p", [Res]),
- uninstall_mib2(Symbolic, MibName),
- DelF = fun(ME) -> call_instrumentation(ME, delete) end,
- lists:foreach(DelF, MEs).
+-callback lookup(State :: term(), Oid :: snmp:oid()) ->
+ {false, Reason :: term()} |
+ {variable, MibEntry :: snmpa:me()} |
+ {table_column, MibEntry :: snmpa:me(), TableEntryOid :: snmp:oid()} |
+ {subagent, SubAgentPid :: pid(), SAOid :: snmp:oid()}.
-uninstall_mib2(true, MibName) ->
- snmpa_symbolic_store:delete_table_infos(MibName),
- snmpa_symbolic_store:delete_variable_infos(MibName),
- snmpa_symbolic_store:delete_aliasnames(MibName),
- snmpa_symbolic_store:delete_types(MibName),
- snmpa_symbolic_store:delete_notifications(MibName);
-uninstall_mib2(_, _) ->
- ok.
+-callback next(State :: term(), Oid :: snmp:oid(), MibView :: mib_view()) ->
+ endOfView | false |
+ {subagent, SubAgentPid :: pid(), SAOid :: snmp:oid()} |
+ {variable, MibEntry :: snmpa:me(), VarOid :: snmp:oid()} |
+ {table, TableOid :: snmp:oid(), TableRestOid :: snmp:oid(), MibEntry :: snmpa:me()}.
-uninstall_mes(Db, MibName) ->
- Pattern = #node_info{oid = '_', mib_name = MibName, me = '_'},
- snmpa_general_db:match_delete(Db, Pattern).
+-callback register_subagent(State :: term(),
+ Oid :: snmp:oid(),
+ Pid :: pid()) ->
+ {ok, NewState :: term()} | {error, Reason :: term()}.
+-callback unregister_subagent(State :: term(),
+ PidOrOid :: pid() | snmp:oid()) ->
+ {ok, NewState :: term()} | % When second arg was a pid()
+ {ok, NewState :: term(), Pid :: pid()} | % When second arg was a oid()
+ {error, Reason :: term()}.
-%%----------------------------------------------------------------------
-%% Create a list of the names of all the loaded mibs
-%%----------------------------------------------------------------------
-loaded(Db) ->
- [N || #mib_info{name = N} <- snmpa_general_db:tab2list(Db)].
-
+-callback dump(State :: term(), Destination :: io | filename()) ->
+ ok | {error, Reason :: term()}.
-%%----------------------------------------------------------------------
-%% Calls MFA-instrumentation with 'new' or 'delete' operation.
-%%----------------------------------------------------------------------
-call_instrumentation(#me{entrytype = variable, mfa={M,F,A}}, Operation) ->
- ?vtrace("call instrumentation with"
- "~n entrytype: variable"
- "~n MFA: {~p,~p,~p}"
- "~n Operation: ~p",
- [M,F,A,Operation]),
- catch apply(M, F, [Operation | A]);
-call_instrumentation(#me{entrytype = table_entry, mfa={M,F,A}}, Operation) ->
- ?vtrace("call instrumentation with"
- "~n entrytype: table_entry"
- "~n MFA: {~p,~p,~p}"
- "~n Operation: ~p",
- [M,F,A,Operation]),
- catch apply(M, F, [Operation | A]);
-call_instrumentation(_ShitME, _Operation) ->
- done.
+-callback which_mib(State :: term(), Oid :: snmp:oid()) ->
+ {ok, Mib :: string()} | {error, Reason :: term()}.
+-callback which_mibs(State :: term()) ->
+ [{MibName :: atom(), Filename :: string()}].
-maybe_drop_me(#me{entrytype = internal}) -> false;
-maybe_drop_me(#me{entrytype = group}) -> false;
-maybe_drop_me(#me{imported = true}) -> false;
-maybe_drop_me(_) -> true.
+-callback whereis_mib(State :: term(), MibName :: atom()) ->
+ {ok, Filename :: string()} | {error, Reason :: term()}.
+-callback info(State :: term()) -> list().
-%%----------------------------------------------------------------------
-%% Code change functions
-%%----------------------------------------------------------------------
+-callback backup(State :: term(), BackupDir :: string()) ->
+ ok | {error, Reason :: term()}.
-code_change(down, State) ->
- ?d("code_change(down) -> entry",[]),
- State;
+-callback code_change(Direction :: up | down,
+ Vsn :: term(),
+ Extra :: term(),
+ State :: term()) ->
+ NewState :: term().
-code_change(up, State) ->
- ?d("code_change(up)",[]),
- State;
-code_change(_Vsn, State) ->
- State.
diff --git a/lib/snmp/src/agent/snmpa_mib_data_ttln.erl b/lib/snmp/src/agent/snmpa_mib_data_ttln.erl
new file mode 100644
index 0000000000..d367e8f13f
--- /dev/null
+++ b/lib/snmp/src/agent/snmpa_mib_data_ttln.erl
@@ -0,0 +1,1402 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2013-2013. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(snmpa_mib_data_ttln).
+
+%%%-----------------------------------------------------------------
+%%%
+%%% THIS FILE IS JUST A PLACE HOLDER - IGNORE
+%%%
+%%%-----------------------------------------------------------------
+
+
+%%%-----------------------------------------------------------------
+%%%
+%%% TTLN - TupleTreeListNodes
+%%%
+%%% This module implements the MIB internal data structures.
+%%% An MIB Data Structure consists of three items; an ets-table,
+%%% a tree and a list of registered subagents.
+%%% The subagent information is consequently duplicated. It resides
+%%% both in the tree and in the list.
+%%% The ets-table contains all data associated with each variable,
+%%% table, tableentry and tablecolumn in the MIB.
+%%% The tree contains information of the Oids in the MIB.
+%%%
+%%% When a mib is loaded, the tree is built from the plain list
+%%% in the binary file.
+%%%
+%%%-----------------------------------------------------------------
+
+-include("snmp_types.hrl").
+-include("snmp_debug.hrl").
+
+-define(VMODULE,"MDATA_TTLN").
+-include("snmp_verbosity.hrl").
+
+-behaviour(snmpa_mib_data).
+
+-define(MIB_DATA, snmpa_mib_data).
+-define(MIB_NODE, snmpa_mib_node).
+-define(MIB_TREE, snmpa_mib_tree).
+-define(DUMMY_TREE_GENERATION, 1).
+-define(DEFAULT_TREE, {tree,{undefined_node},internal}).
+
+
+%%%-----------------------------------------------------------------
+%%% Table of contents
+%%% =================
+%%% 1. Interface
+%%% 2. Implementation of tree access
+%%% 3. Tree building functions
+%%% 4. Tree merging
+%%% 5. Tree deletion routines
+%%% 6. Functions for subagent handling
+%%% 7. Misc functions
+%%%-----------------------------------------------------------------
+
+
+%%----------------------------------------------------------------------
+%% data_db is an database containing loaded mibs as:
+%% {MibName = atom(), Symbolic = ?, FullFileName = string()}
+%% it is either ets or mnesia
+%% tree_db is a database containing _one_ record with the tree!
+%% (the reason for this is part to get replication and part out of convenience)
+%% ref_tree is the root node, without any subagent.
+%% tree is the root node (same as ref_tree but with the subagents added).
+%% subagents is a list of {SAPid, Oid}
+%%----------------------------------------------------------------------
+-record(mib_data, {mib_db, % table of #mib_info
+ node_db, % table of #node_info
+ tree_db, % table of #tree
+ tree, % The actual tree
+ subagents = []}).
+
+-record(mib_info, {name, symbolic, file_name}).
+-record(node_info, {oid, mib_name, me}).
+
+
+%% API
+-export([new/0, new/1, sync/1, close/1,
+ load_mib/4, unload_mib/4, which_mibs/1, whereis_mib/2,
+ info/1, info/2,
+ dump/1, dump/2,
+ backup/2,
+ lookup/2, next/3, which_mib/2,
+ register_subagent/3, unregister_subagent/2]).
+
+%% Internal exports
+-export([code_change/2]).
+
+
+%%-----------------------------------------------------------------
+%% A tree is represented as a N-tuple, where each element is a
+%% node. A node is:
+%% 1) {tree, Tree, Info} where Info can be {table, Id}, {table_entry, Id}
+%% or perhaps 'internal'
+%% 2) undefined_node (memory optimization (instead of {node, undefined}))
+%% 3) {node, Info} where Info can be {subagent, Pid}, {variable, Id},
+%% {table_column, Id}
+%% Id is {MibName, MibEntry}
+%% The over all root is represented as {tree, Tree, internal}.
+%%
+%% tree() = {tree, nodes(), tree_info()}
+%% nodes() = [tree() | node() | undefined_node]
+%% node() = {node, node_info()}
+%% tree_info() = {table, Id} | {table_entry, Id} | internal
+%% node_info() = {subagent, Pid} | {variable, Id} | {table_colum, Id}
+%%-----------------------------------------------------------------
+
+-type tree_generation() :: non_neg_integer().
+-type tree() :: #tree{}.
+-type tree_nodes() :: [tree_node()].
+-type tree_node() :: tree() |
+ tree_node_elem() |
+ tree_node_empty().
+-type tree_node_elem() :: {node, tree_node_info()}.
+-type tree_node_info() :: {subagent, Pid :: pid()} |
+ {variable, Id :: non_neg_integer()} |
+ {table_column, Id :: non_neg_integer()}.
+-type tree_node_empty() :: {undefined_node, N :: pos_integer()}.
+-type tree_info() :: {table, Id :: non_neg_integer()} |
+ {table_entry, Id :: non_neg_integer()} |
+ internal.
+
+
+%% This record is what is stored in the database. The 'tree' part
+%% is described above...
+-record(mtree,
+ {
+ generation = ?DUMMY_TREE_GENERATION :: tree_generation(),
+ root = ?DEFAULT_TREE :: tree()
+ }).
+
+-record(tree,
+ {
+ %% The number of nodes is *not* actually the length of the
+ %% nodes list. Since the undefined-node(s) can be collapsed
+ %% into {undefined_node, N} we need to keep track of the
+ %% actual size some other way (so that we dont have the
+ %% traverse the nodes every time we want to check an index).
+ num_nodes :: non_neg_integer(),
+ nodes :: tree_nodes(),
+ tree_info :: tree_info()
+ }).
+
+
+
+
+%%%======================================================================
+%%% 1. Interface
+%%%======================================================================
+
+%%-----------------------------------------------------------------
+%% Func: new/0, new/1
+%% Returns: A representation of mib data.
+%%-----------------------------------------------------------------
+new() ->
+ new(ets).
+
+%% Where -> A list of nodes where the tables will be created
+new(Storage) ->
+ %% First we must check if there is already something to read
+ %% If a database already exists, then the tree structure has to be read
+ ?vtrace("open (mib) database",[]),
+ MibDb = snmpa_general_db:open(Storage, ?MIB_DATA,
+ mib_info,
+ record_info(fields, mib_info), set),
+ ?vtrace("open (mib) node database",[]),
+ NodeDb = snmpa_general_db:open(Storage, ?MIB_NODE,
+ node_info,
+ record_info(fields, node_info), set),
+ ?vtrace("open (mib) tree database",[]),
+ TreeDb = snmpa_general_db:open(Storage, ?MIB_TREE,
+ tree,
+ record_info(fields, mtree), set),
+ MTree =
+ case snmpa_general_db:read(TreeDb, ?DUMMY_TREE_GENERATION) of
+ false ->
+ T = #mtree{},
+ snmpa_general_db:write(TreeDb, T),
+ T;
+ {value, T} ->
+ T
+ end,
+ install_mibs(MibDb, NodeDb),
+ #mib_data{mib_db = MibDb,
+ node_db = NodeDb,
+ tree_db = TreeDb,
+ mtree = MTree}.
+
+
+%%----------------------------------------------------------------------
+%% Returns: new mib data | {error, Reason}
+%%----------------------------------------------------------------------
+load_mib(MibData,FileName,MeOverride,TeOverride)
+ when is_record(MibData,mib_data) andalso is_list(FileName) ->
+ ?vlog("load mib file: ~p",[FileName]),
+ ActualFileName = filename:rootname(FileName, ".bin") ++ ".bin",
+ MibName = list_to_atom(filename:basename(FileName, ".bin")),
+ (catch do_load_mib(MibData, ActualFileName, MibName,
+ MeOverride, TeOverride)).
+
+do_load_mib(MibData, ActualFileName, MibName, MeOverride, TeOverride) ->
+ ?vtrace("do_load_mib -> entry with"
+ "~n ActualFileName: ~s"
+ "~n MibName: ~p",[ActualFileName, MibName]),
+ #mib_data{mib_db = MibDb,
+ node_db = NodeDb,
+ %% tree_db = TreeDb,
+ tree = Tree} = MibData,
+ verify_not_loaded(MibDb, MibName),
+ ?vtrace("do_load_mib -> already loaded mibs:"
+ "~n ~p",[loaded(MibDb)]),
+ Mib = do_read_mib(ActualFileName),
+ ?vtrace("do_load_mib -> read mib ~s",[Mib#mib.name]),
+ NonInternalMes =
+ lists:filter(fun(ME) -> maybe_drop_me(ME) end, Mib#mib.mes),
+ OldRoot = Tree#tree.root,
+ T = build_tree(NonInternalMes, MibName),
+ ?d("load_mib -> "
+ "~n OldRoot: ~p"
+ "~n T: ~p", [OldRoot, T]),
+ case (catch merge_nodes(T, OldRoot)) of
+ {error_merge_nodes, Node1, Node2} ->
+ ?vlog("error merging nodes:"
+ "~n~p~nand~n~p", [Node1,Node2]),
+ {error, oid_conflict};
+ NewRoot when is_tuple(NewRoot) andalso (element(1,NewRoot) =:= tree) ->
+ ?d("load_mib -> "
+ "~n NewRoot: ~p", [NewRoot]),
+ Symbolic = not lists:member(no_symbolic_info, Mib#mib.misc),
+ case (catch check_notif_and_mes(TeOverride, MeOverride, Symbolic,
+ Mib#mib.traps, NonInternalMes)) of
+ true ->
+ install_mes(NodeDb, MibName, NonInternalMes),
+ install_mib(MibDb, Symbolic, Mib,
+ MibName, ActualFileName, NonInternalMes),
+ ?vtrace("installed mib ~s", [Mib#mib.name]),
+ Tree2 = Tree#tree{root = NewRoot},
+ %% snmpa_general_db:write(TreeDb, Tree2), %% Store later?
+ {ok, MibData#mib_data{tree = Tree2}};
+ Else ->
+ Else
+ end
+ end.
+
+
+verify_not_loaded(Db, Name) ->
+ case snmpa_general_db:read(Db, Name) of
+ {value, #mib_info{name = Name}} ->
+ throw({error, 'already loaded'});
+ false ->
+ ok
+ end.
+
+do_read_mib(ActualFileName) ->
+ case snmp_misc:read_mib(ActualFileName) of
+ {error, Reason} ->
+ ?vlog("Failed reading mib file ~p with reason: ~p",
+ [ActualFileName,Reason]),
+ throw({error, Reason});
+ {ok, Mib} ->
+ Mib
+ end.
+
+%% The Tree DB is handled in a special way since it can be very large.
+sync(#mib_data{mib_db = M,
+ node_db = N,
+ tree_db = T, tree = Tree, subagents = []}) ->
+ snmpa_general_db:sync(M),
+ snmpa_general_db:sync(N),
+ snmpa_general_db:write(T, Tree),
+ snmpa_general_db:sync(T);
+sync(#mib_data{mib_db = M,
+ node_db = N,
+ tree_db = T, tree = Tree, subagents = SAs}) ->
+
+ snmpa_general_db:sync(M),
+ snmpa_general_db:sync(N),
+
+ %% Ouch. Since the subagent info is dynamic we do not
+ %% want to store the tree containing subagent info. So, we
+ %% have to create a tmp tree without those and store it.
+
+ case delete_subagents(Tree, SAs) of
+ {ok, TreeWithoutSAs} ->
+ snmpa_general_db:write(T, TreeWithoutSAs),
+ snmpa_general_db:sync(T);
+ Error ->
+ Error
+ end.
+
+delete_subagents(Tree, []) ->
+ {ok, Tree};
+delete_subagents(Tree0, [{_, Oid}|SAs]) ->
+ case (catch delete_subagent(Tree0, Oid)) of
+ {tree, _Tree, _Info} = Tree1 ->
+ delete_subagents(Tree1, SAs);
+ _Error ->
+ {error, {'invalid oid', Oid}}
+ end.
+
+%%----------------------------------------------------------------------
+%% (OTP-3601)
+%%----------------------------------------------------------------------
+check_notif_and_mes(TeOverride,MeOverride,Symbolic,Traps,MEs) ->
+ ?vtrace("check notifications and mib entries",[]),
+ check_notifications(TeOverride,Symbolic,Traps),
+ check_mes(MeOverride,MEs).
+
+check_notifications(true, _Symbolic, _Traps) ->
+ ?vtrace("trapentry override = true => skip check",[]),
+ true;
+check_notifications(_, Symbolic, Traps) ->
+ check_notifications(Symbolic, Traps).
+
+check_notifications(true, Traps) ->
+ check_notifications(Traps);
+check_notifications(_, _) -> true.
+
+check_notifications([]) -> true;
+check_notifications([#trap{trapname = Key} = Trap | Traps]) ->
+ ?vtrace("check notification [trap] with Key: ~p",[Key]),
+ case snmpa_symbolic_store:get_notification(Key) of
+ {value, Trap} -> check_notifications(Traps);
+ {value, _} -> throw({error, {'trap already defined', Key}});
+ undefined -> check_notifications(Traps)
+ end;
+check_notifications([#notification{trapname = Key} = Notif | Traps]) ->
+ ?vtrace("check notification [notification] with Key: ~p",[Key]),
+ case snmpa_symbolic_store:get_notification(Key) of
+ {value, Notif} ->
+ check_notifications(Traps);
+ {value, _} ->
+ throw({error, {'notification already defined', Key}});
+ undefined ->
+ check_notifications(Traps)
+ end;
+check_notifications([Crap | Traps]) ->
+ ?vlog("skipped check of: ~n~p",[Crap]),
+ check_notifications(Traps).
+
+check_mes(true,_) ->
+ ?vtrace("mibentry override = true => skip check",[]),
+ true;
+check_mes(_,MEs) ->
+ check_mes(MEs).
+
+check_mes([]) -> true;
+check_mes([#me{aliasname = Name, oid = Oid1} | MEs]) ->
+ ?vtrace("check mib entries with aliasname: ~p",[Name]),
+ case snmpa_symbolic_store:aliasname_to_oid(Name) of
+ {value, Oid1} ->
+ check_mes(MEs);
+ {value, Oid2} ->
+ ?vinfo("~n expecting '~p'~n but found '~p'",[Oid1, Oid2]),
+ throw({error, {'mibentry already defined', Name}});
+ false ->
+ check_mes(MEs)
+ end;
+check_mes([Crap | MEs]) ->
+ ?vlog("skipped check of: ~n~p",[Crap]),
+ check_mes(MEs).
+
+
+
+%%----------------------------------------------------------------------
+%% Returns: new mib data | {error, Reason}
+%%----------------------------------------------------------------------
+unload_mib(MibData, FileName, _, _) when is_list(FileName) ->
+ MibName = list_to_atom(filename:basename(FileName, ".bin")),
+ (catch do_unload_mib(MibData, MibName)).
+
+do_unload_mib(MibData, MibName) ->
+ ?vtrace("do_unload_mib -> entry with"
+ "~n MibName: ~p", [MibName]),
+ #mib_data{mib_db = MibDb,
+ node_db = NodeDb,
+ %% tree_db = TreeDb,
+ tree = Tree} = MibData,
+ #mib_info{symbolic = Symbolic} = verify_loaded(MibDb, MibName),
+ NewRoot = delete_mib_from_tree(MibName, Tree#tree.root),
+ MEs = uninstall_mes(NodeDb, MibName),
+ uninstall_mib(MibDb, Symbolic, MibName, MEs),
+ NewMibData = MibData#mib_data{tree = Tree#tree{root = NewRoot}},
+ {ok, NewMibData}.
+
+verify_loaded(Db, Name) ->
+ case snmpa_general_db:read(Db, Name) of
+ {value, MibInfo} ->
+ MibInfo;
+ false ->
+ throw({error, 'not loaded'})
+ end.
+
+
+close(#mib_data{mib_db = MibDb, node_db = NodeDb, tree_db = TreeDb}) ->
+ snmpa_general_db:close(MibDb),
+ snmpa_general_db:close(NodeDb),
+ snmpa_general_db:close(TreeDb),
+ ok.
+
+register_subagent(#mib_data{tree = T} = MibData, Oid, Pid) ->
+ case insert_subagent(Oid, T#tree.root) of
+ {error, Reason} ->
+ {error, Reason};
+ NewRootTree ->
+ SAs = [{Pid, Oid} | MibData#mib_data.subagents],
+ T2 = T#tree{root = NewRootTree},
+ MibData#mib_data{tree = T2, subagents = SAs}
+ end.
+
+
+%%----------------------------------------------------------------------
+%% Purpose: Get a list of all loaded mibs
+%% Returns: [{Name, File}]
+%%----------------------------------------------------------------------
+
+which_mibs(#mib_data{mib_db = Db}) ->
+ Mibs = snmpa_general_db:tab2list(Db),
+ [{Name, File} || #mib_info{name = Name, file_name = File} <- Mibs].
+
+
+%%----------------------------------------------------------------------
+%% Purpose: Get a list of all loaded mibs
+%% Returns: [{Name, File}]
+%%----------------------------------------------------------------------
+
+whereis_mib(#mib_data{mib_db = Db}, Name) ->
+ case snmpa_general_db:read(Db, Name) of
+ {value, #mib_info{file_name = File}} ->
+ {ok, File};
+ false ->
+ {error, not_found}
+ end.
+
+
+%%----------------------------------------------------------------------
+%% Purpose: Deletes SA with Pid from all subtrees it handles.
+%% Returns: NewMibData.
+%%----------------------------------------------------------------------
+unregister_subagent(MibData, Pid) when is_pid(Pid) ->
+ SAs = MibData#mib_data.subagents,
+ case lists:keysearch(Pid, 1, SAs) of
+ false -> MibData;
+ {value, {Pid, Oid}} ->
+ % we should never get an error since Oid is found in MibData.
+ {ok, NewMibData, _DeletedSA} = unregister_subagent(MibData, Oid),
+ % continue if the same Pid handles other mib subtrees.
+ unregister_subagent(NewMibData, Pid)
+ end;
+
+%%----------------------------------------------------------------------
+%% Purpose: Deletes one unique subagent.
+%% Returns: {error, Reason} | {ok, NewMibData, DeletedSubagentPid}
+%%----------------------------------------------------------------------
+unregister_subagent(#mib_data{tree = T} = MibData, Oid) when is_list(Oid) ->
+ case catch delete_subagent(T#tree.root, Oid) of
+ {tree, Tree, Info} ->
+ OldSAs = MibData#mib_data.subagents,
+ {value, {Pid, _Oid}} = lists:keysearch(Oid, 2, OldSAs),
+ SAs = lists:keydelete(Oid, 2, OldSAs),
+ T2 = T#tree{root = {tree, Tree, Info}},
+ {ok,
+ MibData#mib_data{tree = T2, subagents = SAs},
+ Pid};
+ _ ->
+ {error, {'invalid oid', Oid}}
+ end.
+
+%%----------------------------------------------------------------------
+%% Purpose: To inpect memory usage, loaded mibs, registered subagents
+%%----------------------------------------------------------------------
+info(MibData) ->
+ ?vtrace("retrieve info",[]),
+ #mib_data{mib_db = MibDb, node_db = NodeDb, tree_db = TreeDb,
+ tree = Tree, subagents = SAs} = MibData,
+ LoadedMibs = old_format(snmpa_general_db:tab2list(MibDb)),
+ TreeSize = snmp_misc:mem_size(Tree),
+ {memory, ProcSize} = erlang:process_info(self(),memory),
+ MibDbSize = snmpa_general_db:info(MibDb, memory),
+ NodeDbSize = snmpa_general_db:info(NodeDb, memory),
+ TreeDbSize = snmpa_general_db:info(TreeDb, memory),
+ [{loaded_mibs, LoadedMibs}, {subagents, SAs}, {tree_size_bytes, TreeSize},
+ {process_memory, ProcSize},
+ {db_memory, [{mib,MibDbSize},{node,NodeDbSize},{tree,TreeDbSize}]}].
+
+info(#mib_data{mib_db = MibDb}, loaded_mibs) ->
+ Mibs = snmpa_general_db:tab2list(MibDb),
+ [filename:rootname(FN, ".bin") || #mib_info{file_name = FN} <- Mibs];
+info(#mib_data{tree = Tree}, tree_size_bytes) ->
+ snmp_misc:mem_size(Tree);
+info(_, process_memory) ->
+ {memory, ProcSize} = erlang:process_info(self(),memory),
+ ProcSize;
+info(#mib_data{mib_db = MibDb, node_db = NodeDb, tree_db = TreeDb},
+ db_memory) ->
+ MibDbSize = snmpa_general_db:info(MibDb, memory),
+ NodeDbSize = snmpa_general_db:info(NodeDb, memory),
+ TreeDbSize = snmpa_general_db:info(TreeDb, memory),
+ [{mib,MibDbSize},{node,NodeDbSize},{tree,TreeDbSize}];
+info(#mib_data{subagents = SAs}, subagents) ->
+ SAs.
+
+old_format(LoadedMibs) ->
+ ?vtrace("convert mib info to old format",[]),
+ [{N,S,F} || #mib_info{name=N,symbolic=S,file_name=F} <- LoadedMibs].
+
+
+%%----------------------------------------------------------------------
+%% A total dump for debugging.
+%%----------------------------------------------------------------------
+dump(#mib_data{mib_db = MibDb, node_db = NodeDb, tree = Tree}) ->
+ (catch io:format("MIB-tables:~n~p~n~n",
+ [snmpa_general_db:tab2list(MibDb)])),
+ (catch io:format("MIB-entries:~n~p~n~n",
+ [snmpa_general_db:tab2list(NodeDb)])),
+ (catch io:format("Tree:~n~p~n", [Tree])), % good luck reading it!
+ ok.
+
+dump(#mib_data{mib_db = MibDb, node_db = NodeDb, tree = Tree}, File) ->
+ case file:open(File,[write]) of
+ {ok, Fd} ->
+ io:format(Fd,"~s~n",
+ [snmp:date_and_time_to_string(snmp:date_and_time())]),
+ (catch io:format(Fd,"MIB-tables:~n~p~n~n",
+ [snmpa_general_db:tab2list(MibDb)])),
+ (catch io:format(Fd, "MIB-entries:~n~p~n~n",
+ [snmpa_general_db:tab2list(NodeDb)])),
+ io:format(Fd,"Tree:~n~p~n", [Tree]), % good luck reading it!
+ file:close(Fd),
+ ok;
+ {error,Reason} ->
+ ?vinfo("~n Failed opening file '~s' for reason ~p",
+ [File,Reason]),
+ {error,Reason}
+ end.
+
+
+backup(#mib_data{mib_db = M, node_db = N, tree_db = T}, BackupDir) ->
+ MRes = snmpa_general_db:backup(M, BackupDir),
+ NRes = snmpa_general_db:backup(N, BackupDir),
+ TRes = snmpa_general_db:backup(T, BackupDir),
+ handle_backup_res([{mib_db, MRes}, {node_db, NRes}, {tree_db, TRes}]).
+
+handle_backup_res(Res) ->
+ handle_backup_res(Res, []).
+
+handle_backup_res([], []) ->
+ ok;
+handle_backup_res([], Err) ->
+ {error, lists:reverse(Err)};
+handle_backup_res([{_, ok}|Res], Err) ->
+ handle_backup_res(Res, Err);
+handle_backup_res([{Tag, {error, Reason}}|Res], Err) ->
+ handle_backup_res(Res, [{Tag, Reason}|Err]);
+handle_backup_res([{Tag, Error}|Res], Err) ->
+ handle_backup_res(Res, [{Tag, Error}|Err]).
+
+
+%%%======================================================================
+%%% 2. Implementation of tree access
+%%% lookup and next.
+%%%======================================================================
+
+
+which_mib(#mib_data{tree = T} = D, Oid) ->
+ ?vtrace("which_mib -> entry with"
+ "~n Oid: ~p",[Oid]),
+ case (catch find_node(D, T#tree.root, Oid, [])) of
+ {variable, _ME, Mib} ->
+ ?vtrace("which_mib -> variable:"
+ "~n Mib: ~p", [Mib]),
+ {ok, Mib};
+ {table, _EntryME, _, Mib} ->
+ ?vtrace("which_mib -> table:"
+ "~n Mib: ~p", [Mib]),
+ {ok, Mib};
+ {subagent, SubAgentPid, _SANextOid} ->
+ ?vtrace("which_mib -> subagent:"
+ "~n SubAgentPid: ~p", [SubAgentPid]),
+ {error, {subagent, SubAgentPid}};
+ {false, ErrorCode} ->
+ ?vtrace("which_mib -> false:"
+ "~n ErrorCode: ~p",[ErrorCode]),
+ {error, ErrorCode};
+ false ->
+ ?vtrace("which_mib -> false",[]),
+ {error, noSuchObject};
+ {'EXIT', R} ->
+ ?vtrace("which_mib -> exit:"
+ "~n R: ~p",[R]),
+ {error, noSuchObject}
+ end.
+
+
+%%-----------------------------------------------------------------
+%% Func: lookup/2
+%% Purpose: Finds the mib entry corresponding to the Oid. If it is a
+%% variable, the Oid must be <Oid for var>.0 and if it is
+%% a table, Oid must be <table>.<entry>.<col>.<any>
+%% Returns: {variable, MibEntry} |
+%% {table_column, MibEntry, TableEntryOid} |
+%% {subagent, SubAgentPid, SAOid} |
+%% {false, Reason}
+%%-----------------------------------------------------------------
+lookup(#mib_data{tree = T} = D, Oid) ->
+ ?vtrace("lookup -> entry with"
+ "~n Oid: ~p",[Oid]),
+ case (catch find_node(D, T#tree.root, Oid, [])) of
+ {variable, ME, _Mib} when is_record(ME, me) ->
+ ?vtrace("lookup -> variable:"
+ "~n ME: ~p",[ME]),
+ {variable, ME};
+ {table, EntryME, {ColME, TableEntryOid}, _Mib} ->
+ ?vtrace("lookup -> table:"
+ "~n EntryME: ~p"
+ "~n ColME: ~p"
+ "~n RevTableEntryOid: ~p",
+ [EntryME, ColME, TableEntryOid]),
+ MFA = EntryME#me.mfa,
+ RetME = ColME#me{mfa = MFA},
+ {table_column, RetME, TableEntryOid};
+ {subagent, SubAgentPid, SANextOid} ->
+ ?vtrace("lookup -> subagent:"
+ "~n SubAgentPid: ~p"
+ "~n SANextOid: ~p", [SubAgentPid, SANextOid]),
+ {subagent, SubAgentPid, SANextOid};
+ {false, ErrorCode} ->
+ ?vtrace("lookup -> false:"
+ "~n ErrorCode: ~p",[ErrorCode]),
+ {false, ErrorCode};
+ false ->
+ ?vtrace("lookup -> false",[]),
+ {false, noSuchObject};
+ {'EXIT', R} ->
+ ?vtrace("lookup -> exit:"
+ "~n R: ~p",[R]),
+ {false, noSuchObject}
+ end.
+
+
+find_node(D, {tree, Tree, {table, _}}, RestOfOid, RevOid) ->
+ ?vtrace("find_node(tree,table) -> entry with"
+ "~n RestOfOid: ~p"
+ "~n RevOid: ~p",[RestOfOid, RevOid]),
+ find_node(D, {tree, Tree, internal}, RestOfOid, RevOid);
+find_node(D, {tree, Tree, {table_entry, _}}, RestOfOid, RevOid) ->
+ ?vtrace("find_node(tree,table_entry) -> entry with"
+ "~n RestOfOid: ~p"
+ "~n RevOid: ~p",[RestOfOid, RevOid]),
+ #mib_data{node_db = Db} = D,
+ Oid = lists:reverse(RevOid),
+ case snmpa_general_db:read(Db, Oid) of
+ {value, #node_info{me = ME, mib_name = Mib}} ->
+ case find_node(D, {tree, Tree, internal}, RestOfOid, RevOid) of
+ {false, ErrorCode} -> {false, ErrorCode};
+ Val -> {table, ME, Val, Mib}
+ end;
+ false ->
+ ?vinfo("find_node -> could not find table_entry ME with"
+ "~n RevOid: ~p"
+ "~n when"
+ "~n RestOfOid: ~p",
+ [RevOid, RestOfOid]),
+ false
+ end;
+find_node(D, {tree, Tree, _Internal}, [Int | RestOfOid], RevOid) ->
+ ?vtrace("find_node(tree) -> entry with"
+ "~n Int: ~p"
+ "~n RestOfOid: ~p"
+ "~n RevOid: ~p",[Int, RestOfOid, RevOid]),
+ find_node(D, element(Int+1, Tree), RestOfOid, [Int | RevOid]);
+find_node(D, {node, {table_column, _}}, RestOfOid, [ColInt | RevOid]) ->
+ ?vtrace("find_node(tree,table_column) -> entry with"
+ "~n RestOfOid: ~p"
+ "~n ColInt: ~p"
+ "~n RevOid: ~p",[RestOfOid, ColInt, RevOid]),
+ #mib_data{node_db = Db} = D,
+ Oid = lists:reverse([ColInt | RevOid]),
+ case snmpa_general_db:read(Db, Oid) of
+ {value, #node_info{me = ME}} ->
+ {ME, lists:reverse(RevOid)};
+ false ->
+ X = snmpa_general_db:read(Db, lists:reverse([ColInt | RevOid])),
+ ?vinfo("find_node -> could not find table_column ME with"
+ "~n RevOid: ~p"
+ "~n trying [~p|~p]"
+ "~n X: ~p",
+ [RevOid, [ColInt | RevOid], X]),
+ false
+ end;
+find_node(D, {node, {variable, _MibName}}, [0], RevOid) ->
+ ?vtrace("find_node(tree,variable,[0]) -> entry with"
+ "~n RevOid: ~p",[RevOid]),
+ #mib_data{node_db = Db} = D,
+ Oid = lists:reverse(RevOid),
+ %% {value, #node_info{me = ME}} = snmpa_general_db:read(Db, Oid),
+ case snmpa_general_db:read(Db, Oid) of
+ {value, #node_info{me = ME, mib_name = Mib}} ->
+ {variable, ME, Mib};
+ false ->
+ ?vinfo("find_node -> could not find variable ME with"
+ "~n RevOid: ~p", [RevOid]),
+ false
+ end;
+find_node(_D, {node, {variable, _MibName}}, [], _RevOid) ->
+ ?vtrace("find_node(tree,variable,[]) -> entry",[]),
+ {false, noSuchObject};
+find_node(_D, {node, {variable, _MibName}}, _, _RevOid) ->
+ ?vtrace("find_node(tree,variable) -> entry",[]),
+ {false, noSuchInstance};
+find_node(D, {node, subagent}, _RestOfOid, SARevOid) ->
+ ?vtrace("find_node(tree,subagent) -> entry with"
+ "~n SARevOid: ~p",[SARevOid]),
+ #mib_data{subagents = SAs} = D,
+ SAOid = lists:reverse(SARevOid),
+ case lists:keysearch(SAOid, 2, SAs) of
+ {value, {SubAgentPid, SAOid}} ->
+ {subagent, SubAgentPid, SAOid};
+ false ->
+ ?vinfo("find_node -> could not find subagent with"
+ "~n SAOid: ~p"
+ "~n SAs: ~p", [SAOid, SAs]),
+ false
+ end;
+find_node(_D, Node, _RestOfOid, _RevOid) ->
+ ?vtrace("find_node -> failed:~n~p",[Node]),
+ {false, noSuchObject}.
+
+
+%%-----------------------------------------------------------------
+%% Func: next/3
+%% Purpose: Finds the lexicographically next oid.
+%% Returns: endOfMibView |
+%% {subagent, SubAgentPid, SAOid} |
+%% {variable, MibEntry, VarOid} |
+%% {table, TableOid, TableRestOid, MibEntry}
+%% If a variable is returnes, it is in the MibView.
+%% If a table or subagent is returned, it *may* be in the MibView.
+%%-----------------------------------------------------------------
+next(#mib_data{tree = T} = D, Oid, MibView) ->
+ case catch next_node(D, T#tree.root, Oid, [], MibView) of
+ false -> endOfMibView;
+ Else -> Else
+ end.
+
+%%-----------------------------------------------------------------
+%% This function is used as long as we have any Oid left. Take
+%% one integer at a time from the Oid, and traverse the tree
+%% accordingly. When the Oid is empty, call find_next.
+%% Returns: {subagent, SubAgentPid, SAOid} |
+%% false |
+%% {variable, MibEntry, VarOid} |
+%% {table, TableOid, TableRestOid, MibEntry}
+%%-----------------------------------------------------------------
+next_node(_D, undefined_node, _Oid, _RevOidSoFar, _MibView) ->
+ ?vtrace("next_node(undefined_node) -> entry", []),
+ false;
+
+next_node(_D, {tree, Tree, {table_entry, _Id}}, [Int | _Oid],
+ _RevOidSoFar, _MibView)
+ when Int+1 > size(Tree) ->
+ ?vtrace("next_node(tree,table_entry) -> entry when not found whith"
+ "~n Int: ~p"
+ "~n size(Tree): ~p", [Int, size(Tree)]),
+ false;
+next_node(D, {tree, Tree, {table_entry, _MibName}},
+ Oid, RevOidSoFar, MibView) ->
+ ?vtrace("next_node(tree,table_entry) -> entry when"
+ "~n size(Tree): ~p"
+ "~n Oid: ~p"
+ "~n RevOidSoFar: ~p"
+ "~n MibView: ~p", [size(Tree), Oid, RevOidSoFar, MibView]),
+ OidSoFar = lists:reverse(RevOidSoFar),
+ case snmpa_acm:is_definitely_not_in_mib_view(OidSoFar, MibView) of
+ true ->
+ ?vdebug("next_node(tree,table_entry) -> not in mib view",[]),
+ false;
+ _ ->
+ #mib_data{node_db = Db} = D,
+ case snmpa_general_db:read(Db, OidSoFar) of
+ false ->
+ ?vinfo("next_node -> could not find table_entry with"
+ "~n OidSoFar: ~p", [OidSoFar]),
+ false;
+ {value, #node_info{me = ME}} ->
+ ?vtrace("next_node(tree,table_entry) -> found: ~n ~p",
+ [ME]),
+ {table, OidSoFar, Oid, ME}
+ end
+ end;
+
+next_node(D, {tree, Tree, _Info}, [Int | RestOfOid], RevOidSoFar, MibView)
+ when (Int < size(Tree)) andalso (Int >= 0) ->
+ ?vtrace("next_node(tree) -> entry when"
+ "~n size(Tree): ~p"
+ "~n Int: ~p"
+ "~n RestOfOid: ~p"
+ "~n RevOidSoFar: ~p"
+ "~n MibView: ~p",
+ [size(Tree), Int, RestOfOid, RevOidSoFar, MibView]),
+ case next_node(D, element(Int+1,Tree),
+ RestOfOid, [Int|RevOidSoFar], MibView) of
+ false ->
+ find_next(D, {tree, Tree, _Info}, Int+1, RevOidSoFar, MibView);
+ Else ->
+ Else
+ end;
+%% no solution
+next_node(D, {tree, Tree, _Info}, [], RevOidSoFar, MibView) ->
+ ?vtrace("next_node(tree,[]) -> entry when"
+ "~n size(Tree): ~p"
+ "~n RevOidSoFar: ~p"
+ "~n MibView: ~p",
+ [size(Tree), RevOidSoFar, MibView]),
+ find_next(D, {tree, Tree, _Info}, 0, RevOidSoFar, MibView);
+next_node(_D, {tree, Tree, _Info}, _RestOfOid, _RevOidSoFar, _MibView) ->
+ ?vtrace("next_node(tree) -> entry when"
+ "~n size(Tree): ~p", [size(Tree)]),
+ false;
+
+next_node(D, {node, subagent}, Oid, RevOidSoFar, MibView) ->
+ ?vtrace("next_node(node,subagent) -> entry when"
+ "~n Oid: ~p"
+ "~n RevOidSoFar: ~p"
+ "~n MibView: ~p",
+ [Oid, RevOidSoFar, MibView]),
+ OidSoFar = lists:reverse(RevOidSoFar),
+ case snmpa_acm:is_definitely_not_in_mib_view(OidSoFar, MibView) of
+ true ->
+ false;
+ _ ->
+ #mib_data{subagents = SAs} = D,
+ case lists:keysearch(OidSoFar, 2, SAs) of
+ {value, {SubAgentPid, OidSoFar}} ->
+ {subagent, SubAgentPid, OidSoFar};
+ _ ->
+ ?vinfo("next_node -> could not find subagent with"
+ "~n OidSoFar: ~p"
+ "~n SAs: ~p", [OidSoFar, SAs]),
+ false
+ end
+ end;
+
+next_node(D, {node, {variable, _MibName}}, [], RevOidSoFar, MibView) ->
+ ?vtrace("next_node(node,variable,[]) -> entry when"
+ "~n RevOidSoFar: ~p"
+ "~n MibView: ~p",
+ [RevOidSoFar, MibView]),
+ OidSoFar = lists:reverse([0 | RevOidSoFar]),
+ case snmpa_acm:validate_mib_view(OidSoFar, MibView) of
+ true ->
+ #mib_data{node_db = Db} = D,
+ case snmpa_general_db:read(Db, lists:reverse(RevOidSoFar)) of
+ false ->
+ ?vinfo("next_node -> could not find variable with"
+ "~n RevOidSoFar: ~p", [RevOidSoFar]),
+ false;
+ {value, #node_info{me = ME}} ->
+ {variable, ME, OidSoFar}
+ end;
+ _ ->
+ false
+ end;
+
+next_node(_D, {node, {variable, _MibName}}, _Oid, _RevOidSoFar, _MibView) ->
+ ?vtrace("next_node(node,variable) -> entry", []),
+ false.
+
+%%-----------------------------------------------------------------
+%% This function is used to find the first leaf from where we
+%% are.
+%% Returns: {subagent, SubAgentPid, SAOid} |
+%% false |
+%% {variable, MibEntry, VarOid} |
+%% {table, TableOid, TableRestOid, MibEntry}
+%% PRE: This function must always be called with a {internal, Tree}
+%% node.
+%%-----------------------------------------------------------------
+find_next(D, {tree, Tree, internal}, Idx, RevOidSoFar, MibView)
+ when Idx < size(Tree) ->
+ case find_next(D, element(Idx+1, Tree), 0, [Idx| RevOidSoFar], MibView) of
+ false ->
+ find_next(D, {tree, Tree, internal}, Idx+1, RevOidSoFar, MibView);
+ Other ->
+ Other
+ end;
+find_next(_D, {tree, _Tree, internal}, _Idx, _RevOidSoFar, _MibView) ->
+ false;
+find_next(_D, undefined_node, _Idx, _RevOidSoFar, _MibView) ->
+ false;
+find_next(D, {tree, Tree, {table, _MibName}}, Idx, RevOidSoFar, MibView) ->
+ find_next(D, {tree, Tree, internal}, Idx, RevOidSoFar, MibView);
+find_next(D, {tree, _Tree, {table_entry, _MibName}}, _Index,
+ RevOidSoFar, MibView) ->
+ OidSoFar = lists:reverse(RevOidSoFar),
+ case snmpa_acm:is_definitely_not_in_mib_view(OidSoFar, MibView) of
+ true ->
+ false;
+ _ ->
+ #mib_data{node_db = Db} = D,
+ case snmpa_general_db:read(Db, OidSoFar) of
+ false ->
+ ?vinfo("find_next -> could not find table_entry ME with"
+ "~n OidSoFar: ~p", [OidSoFar]),
+ false;
+ {value, #node_info{me = ME}} ->
+ {table, OidSoFar, [], ME}
+ end
+ end;
+find_next(D, {node, {variable, _MibName}}, _Idx, RevOidSoFar, MibView) ->
+ OidSoFar = lists:reverse([0 | RevOidSoFar]),
+ case snmpa_acm:validate_mib_view(OidSoFar, MibView) of
+ true ->
+ #mib_data{node_db = Db} = D,
+ case snmpa_general_db:read(Db, lists:reverse(RevOidSoFar)) of
+ false ->
+ ?vinfo("find_next -> could not find variable with"
+ "~n RevOidSoFar: ~p", [RevOidSoFar]),
+ false;
+ {value, #node_info{me = ME}} ->
+ {variable, ME, OidSoFar}
+ end;
+ _ ->
+ false
+ end;
+find_next(D, {node, subagent}, _Idx, RevOidSoFar, MibView) ->
+ OidSoFar = lists:reverse(RevOidSoFar),
+ case snmpa_acm:is_definitely_not_in_mib_view(OidSoFar, MibView) of
+ true ->
+ false;
+ _ ->
+ #mib_data{subagents = SAs} = D,
+ case lists:keysearch(OidSoFar, 2, SAs) of
+ {value, {SubAgentPid, OidSoFar}} ->
+ {subagent, SubAgentPid, OidSoFar};
+ false ->
+ ?vinfo("find_node -> could not find subagent with"
+ "~n OidSoFar: ~p"
+ "~n SAs: ~p", [OidSoFar, SAs]),
+ false
+ end
+ end.
+
+%%%======================================================================
+%%% 3. Tree building functions
+%%% Used when loading mibs.
+%%%======================================================================
+
+build_tree(Mes, MibName) ->
+ ?d("build_tree -> "
+ "~n Mes: ~p", [Mes]),
+ {ListTree, []} = build_subtree([], Mes, MibName),
+ {tree, convert_tree(ListTree), internal}.
+
+%%----------------------------------------------------------------------
+%% Purpose: Builds the tree where all oids have prefix equal to LevelPrefix.
+%% Returns: {Tree, RestMes}
+%% RestMes are Mes that should not be in this subtree.
+%% The Tree is a temporary and simplified data structure that is easy to
+%% convert to the final tuple tree used by the MIB process.
+%% A Node is represented as in the final tree.
+%% The tree is not represented as a N-tuple, but as an Index-list.
+%% Example: Temporary: [{1, Node1}, {3, Node3}]
+%% Final: {Node1, undefined_node, Node3}
+%% Pre: Mes are sorted on oid.
+%%----------------------------------------------------------------------
+build_subtree(LevelPrefix, [Me | Mes], MibName) ->
+ ?vtrace("build subtree -> ~n"
+ " oid: ~p~n"
+ " LevelPrefix: ~p~n"
+ " MibName: ~p", [Me#me.oid, LevelPrefix, MibName]),
+ EType = Me#me.entrytype,
+ ?vtrace("build subtree -> EType = ~p",[EType]),
+ case in_subtree(LevelPrefix, Me) of
+ above ->
+ ?vtrace("build subtree -> above",[]),
+ {[], [Me|Mes]};
+ {node, Index} ->
+ ?vtrace("build subtree -> node at ~p",[Index]),
+ {Tree, RestMes} = build_subtree(LevelPrefix, Mes, MibName),
+ {[{Index, {node, {EType, MibName}}} | Tree], RestMes};
+ {subtree, Index, NewLevelPrefix} ->
+ ?vtrace("build subtree -> subtree at"
+ "~n ~w with ~w",
+ [Index, NewLevelPrefix]),
+ {BelowTree, RestMes} =
+ build_subtree(NewLevelPrefix, Mes, MibName),
+ {CurTree, RestMes2} =
+ build_subtree(LevelPrefix, RestMes, MibName),
+ {[{Index, {tree, BelowTree, {EType,MibName}}}| CurTree], RestMes2};
+ {internal_subtree, Index, NewLevelPrefix} ->
+ ?vtrace("build subtree -> internal_subtree at"
+ "~n ~w with ~w",
+ [Index,NewLevelPrefix]),
+ {BelowTree, RestMes} =
+ build_subtree(NewLevelPrefix, [Me | Mes], MibName),
+ {CurTree, RestMes2} =
+ build_subtree(LevelPrefix, RestMes, MibName),
+ {[{Index, {tree, BelowTree, internal}} | CurTree], RestMes2}
+ end;
+
+build_subtree(_LevelPrefix, [], _MibName) ->
+ ?vtrace("build subtree -> done", []),
+ {[], []}.
+
+%%--------------------------------------------------
+%% Purpose: Determine how/if/where Me should be inserted in subtree
+%% with LevelPrefix. This function does not build any tree, only
+%% determinses what should be done (by build subtree).
+%% Returns:
+%% above - Indicating that this ME should _not_ be in this subtree.
+%% {node, Index} - yes, construct a node with index Index on this level
+%% {internal_subtree, Index, NewLevelPrefix} - yes, there should be an
+%% internal subtree at this index.
+%% {subtree, Index, NewLevelPrefix} - yes, construct a subtree with
+%% NewLevelPrefix and insert this on current level in position Index.
+%%--------------------------------------------------
+in_subtree(LevelPrefix, Me) ->
+ case lists:prefix(LevelPrefix, Me#me.oid) of
+ true when length(Me#me.oid) > length(LevelPrefix) ->
+ classify_how_in_subtree(LevelPrefix, Me);
+ _ ->
+ above
+ end.
+
+%%--------------------------------------------------
+%% See comment about in_subtree/2. This function takes care of all cases
+%% where the ME really should be in _this_ subtree (not above).
+%%--------------------------------------------------
+classify_how_in_subtree(LevelPrefix, Me)
+ when (length(Me#me.oid) =:= (length(LevelPrefix) + 1)) ->
+ Oid = Me#me.oid,
+ case node_or_subtree(Me#me.entrytype) of
+ subtree ->
+ {subtree, lists:last(Oid), Oid};
+ node ->
+ {node, lists:last(Oid)}
+ end;
+
+classify_how_in_subtree(LevelPrefix, Me)
+ when (length(Me#me.oid) > (length(LevelPrefix) + 1)) ->
+ L1 = length(LevelPrefix) + 1,
+ Oid = Me#me.oid,
+ {internal_subtree, lists:nth(L1, Oid), lists:sublist(Oid, 1, L1)}.
+
+%%--------------------------------------------------
+%% Determines how to treat different kinds om MEs in the tree building process.
+%% Pre: all internal nodes have been removed.
+%%--------------------------------------------------
+node_or_subtree(table) -> subtree;
+node_or_subtree(table_entry) -> subtree;
+node_or_subtree(variable) -> node;
+node_or_subtree(table_column) -> node.
+
+%%--------------------------------------------------
+%% Purpose: (Recursively) Converts a temporary tree (see above) to a final tree.
+%% If input is a ListTree, output is a TupleTree.
+%% If input is a Node, output is the same Node.
+%% Pre: All Indexes are >= 0.
+%%--------------------------------------------------
+convert_tree({Index, {tree, Tree, Info}}) when Index >= 0 ->
+ L = lists:map(fun convert_tree/1, Tree),
+ {Index, {tree, dict_list_to_tuple(L), Info}};
+convert_tree({Index, {node, Info}}) when Index >= 0 ->
+ {Index, {node, Info}};
+convert_tree(Tree) when is_list(Tree) ->
+ L = lists:map(fun convert_tree/1, Tree),
+ dict_list_to_tuple(L).
+
+%%----------------------------------------------------------------------
+%% Purpose: Converts a single level (that is non-recursively) from
+%% the temporary indexlist to the N-tuple.
+%% Input: A list of {Index, Data}.
+%% Output: A tuple where element Index is Data.
+%%----------------------------------------------------------------------
+dict_list_to_tuple(L) ->
+ L2 = lists:keysort(1, L),
+ list_to_tuple(integrate_indexes(0, L2)).
+
+%%----------------------------------------------------------------------
+%% Purpose: Helper function for dict_list_to_tuple/1.
+%% Converts an indexlist to a N-list.
+%% Input: A list of {Index, Data}.
+%% Output: A (usually longer, never shorter) list where element Index is Data.
+%% Example: [{1,hej}, {3, sven}] will give output
+%% [undefined_node, hej, undefined_node, sven].
+%% Initially CurIndex should be 0.
+%%----------------------------------------------------------------------
+integrate_indexes(CurIndex, [{CurIndex, Data} | T]) ->
+ [Data | integrate_indexes(CurIndex + 1, T)];
+integrate_indexes(_Index, []) ->
+ [];
+integrate_indexes(CurIndex, L) ->
+ [undefined_node | integrate_indexes(CurIndex + 1, L)].
+
+%%%======================================================================
+%%% 4. Tree merging
+%%% Used by: load mib, insert subagent.
+%%%======================================================================
+
+%%----------------------------------------------------------------------
+%% Arg: Two root nodes (that is to be merged).
+%% Returns: A new root node where the nodes have been merger to one.
+%%----------------------------------------------------------------------
+merge_nodes(Same, Same) ->
+ Same;
+merge_nodes(Node, undefined_node) ->
+ Node;
+merge_nodes(undefined_node, Node) ->
+ Node;
+merge_nodes({tree, Tree1, internal}, {tree, Tree2, internal}) ->
+ {tree, merge_levels(tuple_to_list(Tree1),tuple_to_list(Tree2)), internal};
+merge_nodes(Node1, Node2) ->
+ throw({error_merge_nodes, Node1, Node2}).
+
+%%----------------------------------------------------------------------
+%% Arg: Two levels to be merged.
+%% Here, a level is represented as a list of nodes. A list is easier
+%% to extend than a tuple.
+%% Returns: The resulting, merged level tuple.
+%%----------------------------------------------------------------------
+merge_levels(Level1, Level2) when length(Level1) =:= length(Level2) ->
+ MergeNodes = fun(N1, N2) -> merge_nodes(N1, N2) end,
+ list_to_tuple(snmp_misc:multi_map(MergeNodes, [Level1, Level2]));
+merge_levels(Level1, Level2) when length(Level1) > length(Level2) ->
+ merge_levels(Level1, Level2 ++
+ undefined_nodes_list(length(Level1) - length(Level2)));
+merge_levels(Level1, Level2) when length(Level1) < length(Level2) ->
+ merge_levels(Level2, Level1).
+
+undefined_nodes_list(N) -> lists:duplicate(N, undefined_node).
+
+
+%%%======================================================================
+%%% 5. Tree deletion routines
+%%% (for unload mib)
+%%%======================================================================
+
+%%----------------------------------------------------------------------
+%% Purpose: Actually kicks of the tree reconstruction.
+%% Returns: {list of removed MEs, NewTree}
+%%----------------------------------------------------------------------
+delete_mib_from_tree(MibName, {tree, Tree, internal}) ->
+ case delete_tree(Tree, MibName) of
+ [] ->
+ {tree, {undefined_node}, internal}; % reduce
+ LevelList ->
+ {tree, list_to_tuple(LevelList), internal}
+ end.
+
+%%----------------------------------------------------------------------
+%% Purpose: Deletes all nodes associated to MibName from this level and
+%% all levels below.
+%% If the new level does not contain information (that is, no
+%% other mibs use it) anymore the empty list is returned.
+%% Returns: {MEs, The new level represented as a list}
+%%----------------------------------------------------------------------
+delete_tree(Tree, MibName) when is_tuple(Tree) ->
+ NewLevel = delete_nodes(tuple_to_list(Tree), MibName, []),
+ case lists:filter(fun drop_undefined_nodes/1,NewLevel) of
+ [] -> [];
+ _A_perhaps_shorted_list ->
+ NewLevel % some other mib needs this level
+ end.
+
+%%----------------------------------------------------------------------
+%% Purpose: Nodes belonging to MibName are removed from the tree.
+%% Recursively deletes sub trees to this node.
+%% Returns: {MEs, NewNodesList}
+%%----------------------------------------------------------------------
+delete_nodes([], _MibName, AccNodes) ->
+ lists:reverse(AccNodes);
+
+delete_nodes([{node, {variable, MibName}}|T], MibName, AccNodes) ->
+ delete_nodes(T, MibName, [undefined_node | AccNodes]);
+
+delete_nodes([{node, {table_column, MibName}}|T], MibName, AccNodes) ->
+ delete_nodes(T, MibName, [undefined_node | AccNodes]);
+
+delete_nodes([{tree, _Tree, {table, MibName}}|T], MibName, AccNodes) ->
+ delete_nodes(T, MibName, [undefined_node | AccNodes]);
+
+delete_nodes([{tree, _Tree, {table_entry, MibName}}|T], MibName, AccNodes) ->
+ delete_nodes(T, MibName, [undefined_node | AccNodes]);
+
+delete_nodes([{tree, Tree, Info}|T], MibName, AccNodes) ->
+ case delete_tree(Tree, MibName) of
+ [] -> % tree completely deleted
+ delete_nodes(T, MibName, [undefined_node | AccNodes]);
+ LevelList ->
+ delete_nodes(T, MibName,
+ [{tree, list_to_tuple(LevelList), Info} | AccNodes])
+ end;
+
+delete_nodes([NodeToKeep|T], MibName, AccNodes) ->
+ delete_nodes(T, MibName, [NodeToKeep | AccNodes]).
+
+drop_undefined_nodes(undefined_node) -> false;
+drop_undefined_nodes(_) -> true.
+
+
+%%%======================================================================
+%%% 6. Functions for subagent handling
+%%%======================================================================
+
+%%----------------------------------------------------------------------
+%% Returns: A new Root|{error, reason}
+%%----------------------------------------------------------------------
+insert_subagent(Oid, OldRoot) ->
+ ListTree = build_tree_for_subagent(Oid),
+ case catch convert_tree(ListTree) of
+ {'EXIT', _Reason} ->
+ {error, 'cannot construct tree from oid'};
+ Level when is_tuple(Level) ->
+ T = {tree, Level, internal},
+ case catch merge_nodes(T, OldRoot) of
+ {error_merge_nodes, _Node1, _Node2} ->
+ {error, oid_conflict};
+ NewRoot when is_tuple(NewRoot) andalso
+ (element(1, NewRoot) =:= tree) ->
+ NewRoot
+ end
+ end.
+
+build_tree_for_subagent([Index]) ->
+ [{Index, {node, subagent}}];
+
+build_tree_for_subagent([Index | T]) ->
+ [{Index, {tree, build_tree_for_subagent(T), internal}}].
+
+%%----------------------------------------------------------------------
+%% Returns: A new tree where the subagent at Oid (2nd arg) has been deleted.
+%%----------------------------------------------------------------------
+delete_subagent({tree, Tree, Info}, [Index]) ->
+ {node, subagent} = element(Index+1, Tree),
+ {tree, setelement(Index+1, Tree, undefined_node), Info};
+delete_subagent({tree, Tree, Info}, [Index | TI]) ->
+ {tree, setelement(Index+1, Tree,
+ delete_subagent(element(Index+1, Tree), TI)), Info}.
+
+%%%======================================================================
+%%% 7. Misc functions
+%%%======================================================================
+
+%%----------------------------------------------------------------------
+%% Installs the mibs found in the database when starting the agent.
+%% Basically calls the instrumentation functions for all non-internal
+%% mib-entries
+%%----------------------------------------------------------------------
+install_mibs(MibDb, NodeDb) ->
+ MibNames = loaded(MibDb),
+ ?vtrace("install_mibs -> found following mibs in database: ~n"
+ "~p", [MibNames]),
+ install_mibs2(NodeDb, MibNames).
+
+install_mibs2(_, []) ->
+ ok;
+install_mibs2(NodeDb, [MibName|MibNames]) ->
+ Pattern = #node_info{oid = '_', mib_name = MibName, me = '_'},
+ Nodes = snmpa_general_db:match_object(NodeDb, Pattern),
+ MEs = [ME || #node_info{me = ME} <- Nodes],
+ ?vtrace("install_mibs2 -> installing ~p MEs for mib ~p",
+ [length(MEs),MibName]),
+ NewF = fun(ME) -> call_instrumentation(ME, new) end,
+ lists:foreach(NewF, MEs),
+ install_mibs2(NodeDb, MibNames).
+
+
+%%----------------------------------------------------------------------
+%% Does all side effect stuff during load_mib.
+%%----------------------------------------------------------------------
+install_mib(Db, Symbolic, Mib, MibName, FileName, NonInternalMes) ->
+ ?vdebug("install_mib -> entry with"
+ "~n Symbolic: ~p"
+ "~n MibName: ~p"
+ "~n FileName: ~p", [Symbolic, MibName, FileName]),
+ Rec = #mib_info{name = MibName, symbolic = Symbolic, file_name = FileName},
+ snmpa_general_db:write(Db, Rec),
+ install_mib2(Symbolic, MibName, Mib),
+ NewF = fun(ME) -> call_instrumentation(ME, new) end,
+ lists:foreach(NewF, NonInternalMes).
+
+install_mib2(true, MibName, Mib) ->
+ #mib{table_infos = TabInfos,
+ variable_infos = VarInfos,
+ mes = MEs,
+ asn1_types = ASN1Types,
+ traps = Traps} = Mib,
+ snmpa_symbolic_store:add_table_infos(MibName, TabInfos),
+ snmpa_symbolic_store:add_variable_infos(MibName, VarInfos),
+ snmpa_symbolic_store:add_aliasnames(MibName, MEs),
+ snmpa_symbolic_store:add_types(MibName, ASN1Types),
+ SetF = fun(Trap) ->
+ snmpa_symbolic_store:set_notification(Trap, MibName)
+ end,
+ lists:foreach(SetF, Traps);
+install_mib2(_, _, _) ->
+ ok.
+
+install_mes(_Db, _MibName, []) ->
+ ok;
+install_mes(Db, MibName, [ME|MEs]) ->
+ Node = #node_info{oid = ME#me.oid, mib_name = MibName, me = ME},
+ snmpa_general_db:write(Db, Node),
+ install_mes(Db, MibName, MEs).
+
+
+%%----------------------------------------------------------------------
+%% Does all side effect stuff during unload_mib.
+%%----------------------------------------------------------------------
+uninstall_mib(Db, Symbolic, MibName, MEs) ->
+ ?vtrace("uninstall_mib -> entry with"
+ "~n Db: ~p"
+ "~n Symbolic: ~p"
+ "~n MibName: ~p", [Db, Symbolic, MibName]),
+ Res = snmpa_general_db:delete(Db, MibName),
+ ?vtrace("uninstall_mib -> (mib) db delete result: ~p", [Res]),
+ uninstall_mib2(Symbolic, MibName),
+ DelF = fun(ME) -> call_instrumentation(ME, delete) end,
+ lists:foreach(DelF, MEs).
+
+uninstall_mib2(true, MibName) ->
+ snmpa_symbolic_store:delete_table_infos(MibName),
+ snmpa_symbolic_store:delete_variable_infos(MibName),
+ snmpa_symbolic_store:delete_aliasnames(MibName),
+ snmpa_symbolic_store:delete_types(MibName),
+ snmpa_symbolic_store:delete_notifications(MibName);
+uninstall_mib2(_, _) ->
+ ok.
+
+uninstall_mes(Db, MibName) ->
+ Pattern = #node_info{oid = '_', mib_name = MibName, me = '_'},
+ snmpa_general_db:match_delete(Db, Pattern).
+
+
+%%----------------------------------------------------------------------
+%% Create a list of the names of all the loaded mibs
+%%----------------------------------------------------------------------
+loaded(Db) ->
+ [N || #mib_info{name = N} <- snmpa_general_db:tab2list(Db)].
+
+
+%%----------------------------------------------------------------------
+%% Calls MFA-instrumentation with 'new' or 'delete' operation.
+%%----------------------------------------------------------------------
+call_instrumentation(#me{entrytype = variable, mfa={M,F,A}}, Operation) ->
+ ?vtrace("call instrumentation with"
+ "~n entrytype: variable"
+ "~n MFA: {~p,~p,~p}"
+ "~n Operation: ~p",
+ [M,F,A,Operation]),
+ catch apply(M, F, [Operation | A]);
+call_instrumentation(#me{entrytype = table_entry, mfa={M,F,A}}, Operation) ->
+ ?vtrace("call instrumentation with"
+ "~n entrytype: table_entry"
+ "~n MFA: {~p,~p,~p}"
+ "~n Operation: ~p",
+ [M,F,A,Operation]),
+ catch apply(M, F, [Operation | A]);
+call_instrumentation(_ShitME, _Operation) ->
+ done.
+
+
+maybe_drop_me(#me{entrytype = internal}) -> false;
+maybe_drop_me(#me{entrytype = group}) -> false;
+maybe_drop_me(#me{imported = true}) -> false;
+maybe_drop_me(_) -> true.
+
+
+%%----------------------------------------------------------------------
+%% Code change functions
+%%----------------------------------------------------------------------
+
+code_change(down, State) ->
+ ?d("code_change(down) -> entry",[]),
+ State;
+
+code_change(up, State) ->
+ ?d("code_change(up)",[]),
+ State;
+
+code_change(_Vsn, State) ->
+ State.
+
diff --git a/lib/snmp/src/agent/snmpa_mib_data_tttn.erl b/lib/snmp/src/agent/snmpa_mib_data_tttn.erl
new file mode 100644
index 0000000000..90ddf4869f
--- /dev/null
+++ b/lib/snmp/src/agent/snmpa_mib_data_tttn.erl
@@ -0,0 +1,1443 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(snmpa_mib_data_tttn).
+
+
+%%%-----------------------------------------------------------------
+%%%
+%%% TTTN - TupleTreeTupleNodes
+%%%
+%%% This module implements the MIB (internal) data structures.
+%%% The TTTN MIB Data structure consists of three items:
+%%%
+%%% 1) A mib-storage (as specified when new is called) for
+%%% the data associated with each variable, table,
+%%% table-entry and table-column in the MIB.
+%%% 2) A tree contains information of the Oids in the MIB.
+%%% 3) A list of registered subagents.
+%%%
+%%% The subagent information is consequently duplicated. It resides
+%%% both in the tree and in the list.
+%%%
+%%% When a mib is loaded, the tree is built from the plain list
+%%% in the binary file.
+%%%
+%%%-----------------------------------------------------------------
+
+-include_lib("snmp/include/snmp_types.hrl").
+-include_lib("snmp/src/misc/snmp_debug.hrl").
+
+-define(VMODULE,"MDATA_TTTN").
+-include_lib("snmp/src/misc/snmp_verbosity.hrl").
+
+-behaviour(snmpa_mib_data).
+
+-define(MIB_DATA, snmpa_mib_data).
+-define(MIB_NODE, snmpa_mib_node).
+-define(MIB_TREE, snmpa_mib_tree).
+-define(DUMMY_TREE_GENERATION, 1).
+-define(DEFAULT_TREE, {tree,{undefined_node},internal}).
+
+
+%%%-----------------------------------------------------------------
+%%% Table of contents
+%%% =================
+%%% 1. Interface
+%%% 2. Implementation of tree access
+%%% 3. Tree building functions
+%%% 4. Tree merging
+%%% 5. Tree deletion routines
+%%% 6. Functions for subagent handling
+%%% 7. Misc functions
+%%%-----------------------------------------------------------------
+
+-record(mib_data,
+ {
+ %% Mib storage module
+ module :: snmpa:mib_storage_module(),
+
+ %% A database of loaded mibs
+ %% #mib_info{}
+ mib_db,
+
+ %% A database with information about each node in the tree
+ %% #node_info{}
+ node_db,
+
+ %% A database containing _one_ record with the tree
+ %% without the subagent(s).
+ %% (the reason for this is part to get replication
+ %% and part out of convenience)
+ %% #tree{}
+ tree_db,
+
+ %% The root node (same as the tree part of the tree_db
+ %% but with the subagents added).
+ tree,
+
+ %% A list of {SAPid, Oid}
+ subagents = []
+ }).
+
+-record(mib_info, {name, symbolic, file_name}).
+-record(node_info, {oid, mib_name, me}).
+
+
+%% (behaviour) API
+-export([new/1,
+ close/1,
+ sync/1,
+ load_mib/4,
+ unload_mib/4,
+ lookup/2,
+ next/3,
+ register_subagent/3,
+ unregister_subagent/2,
+ dump/2,
+ which_mib/2, which_mibs/1,
+ whereis_mib/2,
+ info/1, info/2,
+ backup/2,
+ code_change/4]).
+
+
+%%-----------------------------------------------------------------
+%% A tree is represented as a N-tuple, where each element is a
+%% node. A node is:
+%% 1) {tree, Tree, Info} where Info can be {table, Id}, {table_entry, Id}
+%% or perhaps 'internal'
+%% 2) undefined_node (memory optimization (instead of {node, undefined}))
+%% 3) {node, Info} where Info can be {subagent, Pid}, {variable, Id},
+%% {table_column, Id}
+%% Id is {MibName, MibEntry}
+%% The over all root is represented as {tree, Tree, internal}.
+%%
+%% tree() = {tree, nodes(), tree_info()}
+%% nodes() = {tree() | node() | undefined_node, ...}
+%% node() = {node, node_info()}
+%% tree_info() = {table, Id} | {table_entry, Id} | internal
+%% node_info() = {subagent, Pid} | {variable, Id} | {table_colum, Id}
+%%-----------------------------------------------------------------
+
+%% This record is what is stored in the database. The 'tree' part
+%% is described above...
+-record(tree, {generation = ?DUMMY_TREE_GENERATION, root = ?DEFAULT_TREE}).
+
+
+%%%======================================================================
+%%% 1. Interface
+%%%======================================================================
+
+%%-----------------------------------------------------------------
+%% Func: new/1
+%% Returns: A representation of mib data.
+%%-----------------------------------------------------------------
+
+%% Where -> A list of nodes where the tables will be created
+new(MibStorage) ->
+ Mod = snmp_misc:get_option(module, MibStorage),
+ Opts = snmp_misc:get_option(options, MibStorage, []),
+
+ %% First we must check if there is already something to read
+ %% If a database already exists, then the tree structure has to be read
+ ?vdebug("open (mib) database",[]),
+ MibDb =
+ case Mod:open(?MIB_DATA, mib_info, record_info(fields, mib_info),
+ set, Opts) of
+ {ok, T1} ->
+ T1;
+ {error, Reason1} ->
+ throw({error, {open, mib_data, Reason1}})
+ end,
+
+ ?vdebug("open (mib) node database",[]),
+ NodeDb =
+ case Mod:open(?MIB_NODE, node_info, record_info(fields, node_info),
+ set, Opts) of
+ {ok, T2} ->
+ T2;
+ {error, Reason2} ->
+ throw({error, {open, mib_node, Reason2}})
+ end,
+
+ ?vdebug("open (mib) tree database",[]),
+ TreeDb =
+ case Mod:open(?MIB_TREE, tree, record_info(fields, tree),
+ set, Opts) of
+ {ok, T3} ->
+ T3;
+ {error, Reason3} ->
+ throw({error, {open, mib_tree, Reason3}})
+ end,
+
+ ?vdebug("write the default (mib) tree",[]),
+ Tree =
+ case Mod:read(TreeDb, ?DUMMY_TREE_GENERATION) of
+ false ->
+ T = #tree{},
+ Mod:write(TreeDb, T),
+ T;
+ {value, T} ->
+ T
+ end,
+ ?vdebug("install (existing) mibs",[]),
+ install_mibs(Mod, MibDb, NodeDb),
+ ?vdebug("done",[]),
+ #mib_data{module = Mod,
+ mib_db = MibDb,
+ node_db = NodeDb,
+ tree_db = TreeDb,
+ tree = Tree}.
+
+
+%%----------------------------------------------------------------------
+%% Returns: new mib data | {error, Reason}
+%%----------------------------------------------------------------------
+load_mib(MibData, FileName, MeOverride, TeOverride)
+ when is_record(MibData,mib_data) andalso is_list(FileName) ->
+ ?vlog("load mib file: ~p",[FileName]),
+ ActualFileName = filename:rootname(FileName, ".bin") ++ ".bin",
+ MibName = list_to_atom(filename:basename(FileName, ".bin")),
+ (catch do_load_mib(MibData, ActualFileName, MibName,
+ MeOverride, TeOverride)).
+
+do_load_mib(MibData, ActualFileName, MibName, MeOverride, TeOverride) ->
+ ?vtrace("do_load_mib -> entry with"
+ "~n ActualFileName: ~s"
+ "~n MibName: ~p",[ActualFileName, MibName]),
+ #mib_data{module = Mod,
+ mib_db = MibDb,
+ node_db = NodeDb,
+ %% tree_db = TreeDb,
+ tree = Tree} = MibData,
+ verify_not_loaded(Mod, MibDb, MibName),
+ ?vtrace("do_load_mib -> already loaded mibs:"
+ "~n ~p", [loaded(Mod, MibDb)]),
+ Mib = do_read_mib(ActualFileName),
+ ?vtrace("do_load_mib -> read mib ~s",[Mib#mib.name]),
+ NonInternalMes =
+ lists:filter(fun(ME) -> maybe_drop_me(ME) end, Mib#mib.mes),
+ OldRoot = Tree#tree.root,
+ T = build_tree(NonInternalMes, MibName),
+ ?d("load_mib -> "
+ "~n OldRoot: ~p"
+ "~n T: ~p", [OldRoot, T]),
+ case (catch merge_nodes(T, OldRoot)) of
+ {error_merge_nodes, Node1, Node2} ->
+ ?vlog("error merging nodes:"
+ "~n~p~nand~n~p", [Node1,Node2]),
+ {error, oid_conflict};
+ NewRoot when is_tuple(NewRoot) andalso (element(1,NewRoot) =:= tree) ->
+ ?d("load_mib -> "
+ "~n NewRoot: ~p", [NewRoot]),
+ Symbolic = not lists:member(no_symbolic_info, Mib#mib.misc),
+ case (catch check_notif_and_mes(TeOverride, MeOverride, Symbolic,
+ Mib#mib.traps, NonInternalMes)) of
+ true ->
+ install_mes(Mod, NodeDb, MibName, NonInternalMes),
+ install_mib(Mod,
+ MibDb, Symbolic, Mib,
+ MibName, ActualFileName, NonInternalMes),
+ ?vtrace("installed mib ~s", [Mib#mib.name]),
+ Tree2 = Tree#tree{root = NewRoot},
+ {ok, MibData#mib_data{tree = Tree2}};
+ Else ->
+ Else
+ end
+ end.
+
+
+verify_not_loaded(Mod, Tab, Name) ->
+ case Mod:read(Tab, Name) of
+ {value, #mib_info{name = Name}} ->
+ throw({error, already_loaded});
+ false ->
+ ok
+ end.
+
+do_read_mib(ActualFileName) ->
+ case snmp_misc:read_mib(ActualFileName) of
+ {error, Reason} ->
+ ?vlog("Failed reading mib file ~p with reason: ~p",
+ [ActualFileName, Reason]),
+ throw({error, Reason});
+ {ok, Mib} ->
+ Mib
+ end.
+
+%% The Tree DB is handled in a special way since it can be very large.
+sync(#mib_data{module = Mod,
+ mib_db = M,
+ node_db = N,
+ tree_db = T, tree = Tree, subagents = []}) ->
+ Mod:sync(M),
+ Mod:sync(N),
+ Mod:write(T, Tree),
+ Mod:sync(T);
+sync(#mib_data{module = Mod,
+ mib_db = M,
+ node_db = N,
+ tree_db = T, tree = Tree, subagents = SAs}) ->
+
+ Mod:sync(M),
+ Mod:sync(N),
+
+ %% Ouch. Since the subagent info is dynamic we do not
+ %% want to store the tree containing subagent info. So, we
+ %% have to create a tmp tree without those and store it.
+
+ case delete_subagents(Tree, SAs) of
+ {ok, TreeWithoutSAs} ->
+ Mod:write(T, TreeWithoutSAs),
+ Mod:sync(T);
+ Error ->
+ Error
+ end.
+
+delete_subagents(Tree, []) ->
+ {ok, Tree};
+delete_subagents(Tree0, [{_, Oid}|SAs]) ->
+ case (catch delete_subagent(Tree0, Oid)) of
+ {tree, _Tree, _Info} = Tree1 ->
+ delete_subagents(Tree1, SAs);
+ _Error ->
+ {error, {'invalid oid', Oid}}
+ end.
+
+%%----------------------------------------------------------------------
+%% (OTP-3601)
+%%----------------------------------------------------------------------
+check_notif_and_mes(TeOverride,MeOverride,Symbolic,Traps,MEs) ->
+ ?vtrace("check notifications and mib entries",[]),
+ check_notifications(TeOverride,Symbolic,Traps),
+ check_mes(MeOverride,MEs).
+
+check_notifications(true, _Symbolic, _Traps) ->
+ ?vtrace("trapentry override = true => skip check",[]),
+ true;
+check_notifications(_, Symbolic, Traps) ->
+ check_notifications(Symbolic, Traps).
+
+check_notifications(true, Traps) ->
+ check_notifications(Traps);
+check_notifications(_, _) -> true.
+
+check_notifications([]) -> true;
+check_notifications([#trap{trapname = Key} = Trap | Traps]) ->
+ ?vtrace("check notification [trap] with Key: ~p",[Key]),
+ case snmpa_symbolic_store:get_notification(Key) of
+ {value, Trap} -> check_notifications(Traps);
+ {value, _} -> throw({error, {'trap already defined', Key}});
+ undefined -> check_notifications(Traps)
+ end;
+check_notifications([#notification{trapname = Key} = Notif | Traps]) ->
+ ?vtrace("check notification [notification] with Key: ~p",[Key]),
+ case snmpa_symbolic_store:get_notification(Key) of
+ {value, Notif} ->
+ check_notifications(Traps);
+ {value, _} ->
+ throw({error, {'notification already defined', Key}});
+ undefined ->
+ check_notifications(Traps)
+ end;
+check_notifications([Crap | Traps]) ->
+ ?vlog("skipped check of: ~n~p",[Crap]),
+ check_notifications(Traps).
+
+check_mes(true,_) ->
+ ?vtrace("mibentry override = true => skip check",[]),
+ true;
+check_mes(_,MEs) ->
+ check_mes(MEs).
+
+check_mes([]) -> true;
+check_mes([#me{aliasname = Name, oid = Oid1} | MEs]) ->
+ ?vtrace("check mib entries with aliasname: ~p",[Name]),
+ case snmpa_symbolic_store:aliasname_to_oid(Name) of
+ {value, Oid1} ->
+ check_mes(MEs);
+ {value, Oid2} ->
+ ?vinfo("~n expecting '~p'~n but found '~p'",[Oid1, Oid2]),
+ throw({error, {'mibentry already defined', Name}});
+ false ->
+ check_mes(MEs)
+ end;
+check_mes([Crap | MEs]) ->
+ ?vlog("skipped check of: ~n~p",[Crap]),
+ check_mes(MEs).
+
+
+
+%%----------------------------------------------------------------------
+%% Returns: new mib data | {error, Reason}
+%%----------------------------------------------------------------------
+unload_mib(MibData, FileName, _, _) when is_list(FileName) ->
+ MibName = list_to_atom(filename:basename(FileName, ".bin")),
+ (catch do_unload_mib(MibData, MibName)).
+
+do_unload_mib(MibData, MibName) ->
+ ?vtrace("do_unload_mib -> entry with"
+ "~n MibName: ~p", [MibName]),
+ #mib_data{module = Mod,
+ mib_db = MibDb,
+ node_db = NodeDb,
+ %% tree_db = TreeDb,
+ tree = Tree} = MibData,
+ #mib_info{symbolic = Symbolic} = verify_loaded(Mod, MibDb, MibName),
+ NewRoot = delete_mib_from_tree(MibName, Tree#tree.root),
+ MEs = uninstall_mes(Mod, NodeDb, MibName),
+ uninstall_mib(Mod, MibDb, Symbolic, MibName, MEs),
+ NewMibData = MibData#mib_data{tree = Tree#tree{root = NewRoot}},
+ {ok, NewMibData}.
+
+verify_loaded(Mod, Tab, Name) ->
+ case Mod:read(Tab, Name) of
+ {value, MibInfo} ->
+ MibInfo;
+ false ->
+ throw({error, not_loaded})
+ end.
+
+
+close(#mib_data{module = Mod,
+ mib_db = MibDb,
+ node_db = NodeDb,
+ tree_db = TreeDb}) ->
+ Mod:close(MibDb),
+ Mod:close(NodeDb),
+ Mod:close(TreeDb),
+ ok.
+
+register_subagent(#mib_data{tree = T} = MibData, Oid, Pid) ->
+ case insert_subagent(Oid, T#tree.root) of
+ {error, Reason} ->
+ {error, Reason};
+ NewRootTree ->
+ SAs = [{Pid, Oid} | MibData#mib_data.subagents],
+ T2 = T#tree{root = NewRootTree},
+ {ok, MibData#mib_data{tree = T2, subagents = SAs}}
+ end.
+
+
+%%----------------------------------------------------------------------
+%% Purpose: Get a list of all loaded mibs
+%% Returns: [{Name, File}]
+%%----------------------------------------------------------------------
+
+which_mibs(#mib_data{module = Mod, mib_db = Db}) ->
+ Mibs = Mod:tab2list(Db),
+ [{Name, File} || #mib_info{name = Name, file_name = File} <- Mibs].
+
+
+%%----------------------------------------------------------------------
+%% Purpose: Get a list of all loaded mibs
+%% Returns: [{Name, File}]
+%%----------------------------------------------------------------------
+
+whereis_mib(#mib_data{module = Mod, mib_db = Db}, Name) ->
+ case Mod:read(Db, Name) of
+ {value, #mib_info{file_name = File}} ->
+ {ok, File};
+ false ->
+ {error, not_found}
+ end.
+
+
+%%----------------------------------------------------------------------
+%% Purpose: Deletes SA with Pid from all subtrees it handles.
+%% Returns: NewMibData.
+%%----------------------------------------------------------------------
+unregister_subagent(#mib_data{subagents = SAs} = MibData, Pid)
+ when is_pid(Pid) ->
+ SAs = MibData#mib_data.subagents,
+ case lists:keysearch(Pid, 1, SAs) of
+ false ->
+ {ok, MibData};
+ {value, {Pid, Oid}} ->
+ % we should never get an error since Oid is found in MibData.
+ {ok, NewMibData, _DeletedSA} = unregister_subagent(MibData, Oid),
+ % continue if the same Pid handles other mib subtrees.
+ unregister_subagent(NewMibData, Pid)
+ end;
+
+%%----------------------------------------------------------------------
+%% Purpose: Deletes one unique subagent.
+%% Returns: {error, Reason} | {ok, NewMibData, DeletedSubagentPid}
+%%----------------------------------------------------------------------
+unregister_subagent(#mib_data{tree = T} = MibData, Oid) when is_list(Oid) ->
+ case (catch delete_subagent(T#tree.root, Oid)) of
+ {tree, Tree, Info} ->
+ OldSAs = MibData#mib_data.subagents,
+ {value, {Pid, _Oid}} = lists:keysearch(Oid, 2, OldSAs),
+ SAs = lists:keydelete(Oid, 2, OldSAs),
+ T2 = T#tree{root = {tree, Tree, Info}},
+ {ok,
+ MibData#mib_data{tree = T2, subagents = SAs},
+ Pid};
+ _ ->
+ {error, {invalid_oid, Oid}}
+ end.
+
+%%----------------------------------------------------------------------
+%% Purpose: To inpect memory usage, loaded mibs, registered subagents
+%%----------------------------------------------------------------------
+info(MibData) ->
+ ?vtrace("retrieve info",[]),
+ #mib_data{module = Mod,
+ mib_db = MibDb,
+ node_db = NodeDb,
+ tree_db = TreeDb,
+ tree = Tree,
+ subagents = SAs} = MibData,
+ LoadedMibs = old_format(Mod:tab2list(MibDb)),
+ TreeSize = snmp_misc:mem_size(Tree),
+ {memory, ProcSize} = erlang:process_info(self(), memory),
+ MibDbSize = Mod:info(MibDb, memory),
+ NodeDbSize = Mod:info(NodeDb, memory),
+ TreeDbSize = Mod:info(TreeDb, memory),
+ [{loaded_mibs, LoadedMibs}, {subagents, SAs}, {tree_size_bytes, TreeSize},
+ {process_memory, ProcSize},
+ {db_memory, [{mib,MibDbSize},{node,NodeDbSize},{tree,TreeDbSize}]}].
+
+info(#mib_data{module = Mod, mib_db = MibDb}, loaded_mibs) ->
+ Mibs = Mod:tab2list(MibDb),
+ [filename:rootname(FN, ".bin") || #mib_info{file_name = FN} <- Mibs];
+info(#mib_data{tree = Tree}, tree_size_bytes) ->
+ snmp_misc:mem_size(Tree);
+info(_, process_memory) ->
+ {memory, ProcSize} = erlang:process_info(self(),memory),
+ ProcSize;
+info(#mib_data{module = Mod,
+ mib_db = MibDb,
+ node_db = NodeDb,
+ tree_db = TreeDb},
+ db_memory) ->
+ MibDbSize = Mod:info(MibDb, memory),
+ NodeDbSize = Mod:info(NodeDb, memory),
+ TreeDbSize = Mod:info(TreeDb, memory),
+ [{mib, MibDbSize}, {node, NodeDbSize}, {tree, TreeDbSize}];
+info(#mib_data{subagents = SAs}, subagents) ->
+ SAs.
+
+old_format(LoadedMibs) ->
+ ?vtrace("convert mib info to old format",[]),
+ [{N,S,F} || #mib_info{name=N,symbolic=S,file_name=F} <- LoadedMibs].
+
+
+%%----------------------------------------------------------------------
+%% A total dump for debugging.
+%%----------------------------------------------------------------------
+
+dump(#mib_data{module = Mod,
+ mib_db = MibDb,
+ node_db = NodeDb,
+ tree = Tree}, io) ->
+ (catch io:format("MIB-tables:~n~p~n~n",
+ [Mod:tab2list(MibDb)])),
+ (catch io:format("MIB-entries:~n~p~n~n",
+ [Mod:tab2list(NodeDb)])),
+ (catch io:format("Tree:~n~p~n", [Tree])), % good luck reading it!
+ ok;
+
+dump(#mib_data{module = Mod,
+ mib_db = MibDb,
+ node_db = NodeDb,
+ tree = Tree}, File) ->
+ case file:open(File, [write]) of
+ {ok, Fd} ->
+ io:format(Fd,"~s~n",
+ [snmp:date_and_time_to_string(snmp:date_and_time())]),
+ (catch io:format(Fd,"MIB-tables:~n~p~n~n",
+ [Mod:tab2list(MibDb)])),
+ (catch io:format(Fd, "MIB-entries:~n~p~n~n",
+ [Mod:tab2list(NodeDb)])),
+ io:format(Fd,"Tree:~n~p~n", [Tree]), % good luck reading it!
+ file:close(Fd),
+ ok;
+ {error, Reason} ->
+ ?vinfo("~n Failed opening file '~s' for reason ~p",
+ [File, Reason]),
+ {error, Reason}
+ end.
+
+
+backup(#mib_data{module = Mod,
+ mib_db = M,
+ node_db = N,
+ tree_db = T}, BackupDir) ->
+ MRes = Mod:backup(M, BackupDir),
+ NRes = Mod:backup(N, BackupDir),
+ TRes = Mod:backup(T, BackupDir),
+ handle_backup_res([{mib_db, MRes}, {node_db, NRes}, {tree_db, TRes}]).
+
+handle_backup_res(Res) ->
+ handle_backup_res(Res, []).
+
+handle_backup_res([], []) ->
+ ok;
+handle_backup_res([], Err) ->
+ {error, lists:reverse(Err)};
+handle_backup_res([{_, ok}|Res], Err) ->
+ handle_backup_res(Res, Err);
+handle_backup_res([{Tag, {error, Reason}}|Res], Err) ->
+ handle_backup_res(Res, [{Tag, Reason}|Err]);
+handle_backup_res([{Tag, Error}|Res], Err) ->
+ handle_backup_res(Res, [{Tag, Error}|Err]).
+
+
+%%%======================================================================
+%%% 2. Implementation of tree access
+%%% lookup and next.
+%%%======================================================================
+
+
+which_mib(#mib_data{tree = T} = D, Oid) ->
+ ?vtrace("which_mib -> entry with"
+ "~n Oid: ~p",[Oid]),
+ case (catch find_node(D, T#tree.root, Oid, [])) of
+ {variable, _ME, Mib} ->
+ ?vtrace("which_mib -> variable:"
+ "~n Mib: ~p", [Mib]),
+ {ok, Mib};
+ {table, _EntryME, _, Mib} ->
+ ?vtrace("which_mib -> table:"
+ "~n Mib: ~p", [Mib]),
+ {ok, Mib};
+ {subagent, SubAgentPid, _SANextOid} ->
+ ?vtrace("which_mib -> subagent:"
+ "~n SubAgentPid: ~p", [SubAgentPid]),
+ {error, {subagent, SubAgentPid}};
+ {false, ErrorCode} ->
+ ?vtrace("which_mib -> false:"
+ "~n ErrorCode: ~p",[ErrorCode]),
+ {error, ErrorCode};
+ false ->
+ ?vtrace("which_mib -> false",[]),
+ {error, noSuchObject};
+ {'EXIT', R} ->
+ ?vtrace("which_mib -> exit:"
+ "~n R: ~p",[R]),
+ {error, noSuchObject}
+ end.
+
+
+%%-----------------------------------------------------------------
+%% Func: lookup/2
+%% Purpose: Finds the mib entry corresponding to the Oid. If it is a
+%% variable, the Oid must be <Oid for var>.0 and if it is
+%% a table, Oid must be <table>.<entry>.<col>.<any>
+%% Returns: {variable, MibEntry} |
+%% {table_column, MibEntry, TableEntryOid} |
+%% {subagent, SubAgentPid, SAOid} |
+%% {false, Reason}
+%%-----------------------------------------------------------------
+lookup(#mib_data{tree = T} = D, Oid) ->
+ ?vtrace("lookup -> entry with"
+ "~n Oid: ~p",[Oid]),
+ case (catch find_node(D, T#tree.root, Oid, [])) of
+ {variable, ME, _Mib} when is_record(ME, me) ->
+ ?vtrace("lookup -> variable:"
+ "~n ME: ~p",[ME]),
+ {variable, ME};
+ {table, EntryME, {ColME, TableEntryOid}, _Mib} ->
+ ?vtrace("lookup -> table:"
+ "~n EntryME: ~p"
+ "~n ColME: ~p"
+ "~n RevTableEntryOid: ~p",
+ [EntryME, ColME, TableEntryOid]),
+ MFA = EntryME#me.mfa,
+ RetME = ColME#me{mfa = MFA},
+ {table_column, RetME, TableEntryOid};
+ {subagent, SubAgentPid, SANextOid} ->
+ ?vtrace("lookup -> subagent:"
+ "~n SubAgentPid: ~p"
+ "~n SANextOid: ~p", [SubAgentPid, SANextOid]),
+ {subagent, SubAgentPid, SANextOid};
+ {false, ErrorCode} ->
+ ?vtrace("lookup -> false:"
+ "~n ErrorCode: ~p",[ErrorCode]),
+ {false, ErrorCode};
+ false ->
+ ?vtrace("lookup -> false",[]),
+ {false, noSuchObject};
+ {'EXIT', R} ->
+ ?vtrace("lookup -> exit:"
+ "~n R: ~p",[R]),
+ {false, noSuchObject}
+ end.
+
+
+find_node(D, {tree, Tree, {table, _}}, RestOfOid, RevOid) ->
+ ?vtrace("find_node(tree,table) -> entry with"
+ "~n RestOfOid: ~p"
+ "~n RevOid: ~p",[RestOfOid, RevOid]),
+ find_node(D, {tree, Tree, internal}, RestOfOid, RevOid);
+find_node(D, {tree, Tree, {table_entry, _}}, RestOfOid, RevOid) ->
+ ?vtrace("find_node(tree,table_entry) -> entry with"
+ "~n RestOfOid: ~p"
+ "~n RevOid: ~p",[RestOfOid, RevOid]),
+ #mib_data{module = Mod, node_db = Db} = D,
+ Oid = lists:reverse(RevOid),
+ case Mod:read(Db, Oid) of
+ {value, #node_info{me = ME, mib_name = Mib}} ->
+ case find_node(D, {tree, Tree, internal}, RestOfOid, RevOid) of
+ {false, ErrorCode} -> {false, ErrorCode};
+ Val -> {table, ME, Val, Mib}
+ end;
+ false ->
+ ?vinfo("find_node -> could not find table_entry ME with"
+ "~n RevOid: ~p"
+ "~n when"
+ "~n RestOfOid: ~p",
+ [RevOid, RestOfOid]),
+ false
+ end;
+find_node(D, {tree, Tree, _Internal}, [Int | RestOfOid], RevOid) ->
+ ?vtrace("find_node(tree) -> entry with"
+ "~n Int: ~p"
+ "~n RestOfOid: ~p"
+ "~n RevOid: ~p",[Int, RestOfOid, RevOid]),
+ find_node(D, element(Int+1, Tree), RestOfOid, [Int | RevOid]);
+find_node(D, {node, {table_column, _}}, RestOfOid, [ColInt | RevOid]) ->
+ ?vtrace("find_node(tree,table_column) -> entry with"
+ "~n RestOfOid: ~p"
+ "~n ColInt: ~p"
+ "~n RevOid: ~p",[RestOfOid, ColInt, RevOid]),
+ #mib_data{module = Mod, node_db = Db} = D,
+ Oid = lists:reverse([ColInt | RevOid]),
+ case Mod:read(Db, Oid) of
+ {value, #node_info{me = ME}} ->
+ {ME, lists:reverse(RevOid)};
+ false ->
+ X = Mod:read(Db, lists:reverse([ColInt | RevOid])),
+ ?vinfo("find_node -> could not find table_column ME with"
+ "~n RevOid: ~p"
+ "~n trying [~p|~p]"
+ "~n X: ~p",
+ [RevOid, [ColInt | RevOid], X]),
+ false
+ end;
+find_node(D, {node, {variable, _MibName}}, [0], RevOid) ->
+ ?vtrace("find_node(tree,variable,[0]) -> entry with"
+ "~n RevOid: ~p",[RevOid]),
+ #mib_data{module = Mod, node_db = Db} = D,
+ Oid = lists:reverse(RevOid),
+ case Mod:read(Db, Oid) of
+ {value, #node_info{me = ME, mib_name = Mib}} ->
+ {variable, ME, Mib};
+ false ->
+ ?vinfo("find_node -> could not find variable ME with"
+ "~n RevOid: ~p", [RevOid]),
+ false
+ end;
+find_node(_D, {node, {variable, _MibName}}, [], _RevOid) ->
+ ?vtrace("find_node(tree,variable,[]) -> entry",[]),
+ {false, noSuchObject};
+find_node(_D, {node, {variable, _MibName}}, _, _RevOid) ->
+ ?vtrace("find_node(tree,variable) -> entry",[]),
+ {false, noSuchInstance};
+find_node(D, {node, subagent}, _RestOfOid, SARevOid) ->
+ ?vtrace("find_node(tree,subagent) -> entry with"
+ "~n SARevOid: ~p",[SARevOid]),
+ #mib_data{subagents = SAs} = D,
+ SAOid = lists:reverse(SARevOid),
+ case lists:keysearch(SAOid, 2, SAs) of
+ {value, {SubAgentPid, SAOid}} ->
+ {subagent, SubAgentPid, SAOid};
+ false ->
+ ?vinfo("find_node -> could not find subagent with"
+ "~n SAOid: ~p"
+ "~n SAs: ~p", [SAOid, SAs]),
+ false
+ end;
+find_node(_D, Node, _RestOfOid, _RevOid) ->
+ ?vtrace("find_node -> failed:~n~p",[Node]),
+ {false, noSuchObject}.
+
+
+%%-----------------------------------------------------------------
+%% Func: next/3
+%% Purpose: Finds the lexicographically next oid.
+%% Returns: endOfMibView |
+%% {subagent, SubAgentPid, SAOid} |
+%% {variable, MibEntry, VarOid} |
+%% {table, TableOid, TableRestOid, MibEntry}
+%% If a variable is returnes, it is in the MibView.
+%% If a table or subagent is returned, it *may* be in the MibView.
+%%-----------------------------------------------------------------
+next(#mib_data{tree = T} = D, Oid, MibView) ->
+ case catch next_node(D, T#tree.root, Oid, [], MibView) of
+ false -> endOfMibView;
+ Else -> Else
+ end.
+
+%%-----------------------------------------------------------------
+%% This function is used as long as we have any Oid left. Take
+%% one integer at a time from the Oid, and traverse the tree
+%% accordingly. When the Oid is empty, call find_next.
+%% Returns: {subagent, SubAgentPid, SAOid} |
+%% false |
+%% {variable, MibEntry, VarOid} |
+%% {table, TableOid, TableRestOid, MibEntry}
+%%-----------------------------------------------------------------
+next_node(_D, undefined_node, _Oid, _RevOidSoFar, _MibView) ->
+ ?vtrace("next_node(undefined_node) -> entry", []),
+ false;
+
+next_node(_D, {tree, Tree, {table_entry, _Id}}, [Int | _Oid],
+ _RevOidSoFar, _MibView)
+ when Int+1 > size(Tree) ->
+ ?vtrace("next_node(tree,table_entry) -> entry when not found whith"
+ "~n Int: ~p"
+ "~n size(Tree): ~p", [Int, size(Tree)]),
+ false;
+next_node(D, {tree, Tree, {table_entry, _MibName}},
+ Oid, RevOidSoFar, MibView) ->
+ ?vtrace("next_node(tree,table_entry) -> entry when"
+ "~n size(Tree): ~p"
+ "~n Oid: ~p"
+ "~n RevOidSoFar: ~p"
+ "~n MibView: ~p", [size(Tree), Oid, RevOidSoFar, MibView]),
+ OidSoFar = lists:reverse(RevOidSoFar),
+ case snmpa_acm:is_definitely_not_in_mib_view(OidSoFar, MibView) of
+ true ->
+ ?vdebug("next_node(tree,table_entry) -> not in mib view",[]),
+ false;
+ _ ->
+ #mib_data{module = Mod, node_db = Db} = D,
+ case Mod:read(Db, OidSoFar) of
+ false ->
+ ?vinfo("next_node -> could not find table_entry with"
+ "~n OidSoFar: ~p", [OidSoFar]),
+ false;
+ {value, #node_info{me = ME}} ->
+ ?vtrace("next_node(tree,table_entry) -> found: ~n ~p",
+ [ME]),
+ {table, OidSoFar, Oid, ME}
+ end
+ end;
+
+next_node(D, {tree, Tree, _Info}, [Int | RestOfOid], RevOidSoFar, MibView)
+ when (Int < size(Tree)) andalso (Int >= 0) ->
+ ?vtrace("next_node(tree) -> entry when"
+ "~n size(Tree): ~p"
+ "~n Int: ~p"
+ "~n RestOfOid: ~p"
+ "~n RevOidSoFar: ~p"
+ "~n MibView: ~p",
+ [size(Tree), Int, RestOfOid, RevOidSoFar, MibView]),
+ case next_node(D, element(Int+1,Tree),
+ RestOfOid, [Int|RevOidSoFar], MibView) of
+ false ->
+ find_next(D, {tree, Tree, _Info}, Int+1, RevOidSoFar, MibView);
+ Else ->
+ Else
+ end;
+%% no solution
+next_node(D, {tree, Tree, _Info}, [], RevOidSoFar, MibView) ->
+ ?vtrace("next_node(tree,[]) -> entry when"
+ "~n size(Tree): ~p"
+ "~n RevOidSoFar: ~p"
+ "~n MibView: ~p",
+ [size(Tree), RevOidSoFar, MibView]),
+ find_next(D, {tree, Tree, _Info}, 0, RevOidSoFar, MibView);
+next_node(_D, {tree, Tree, _Info}, _RestOfOid, _RevOidSoFar, _MibView) ->
+ ?vtrace("next_node(tree) -> entry when"
+ "~n size(Tree): ~p", [size(Tree)]),
+ false;
+
+next_node(D, {node, subagent}, Oid, RevOidSoFar, MibView) ->
+ ?vtrace("next_node(node,subagent) -> entry when"
+ "~n Oid: ~p"
+ "~n RevOidSoFar: ~p"
+ "~n MibView: ~p",
+ [Oid, RevOidSoFar, MibView]),
+ OidSoFar = lists:reverse(RevOidSoFar),
+ case snmpa_acm:is_definitely_not_in_mib_view(OidSoFar, MibView) of
+ true ->
+ false;
+ _ ->
+ #mib_data{subagents = SAs} = D,
+ case lists:keysearch(OidSoFar, 2, SAs) of
+ {value, {SubAgentPid, OidSoFar}} ->
+ {subagent, SubAgentPid, OidSoFar};
+ _ ->
+ ?vinfo("next_node -> could not find subagent with"
+ "~n OidSoFar: ~p"
+ "~n SAs: ~p", [OidSoFar, SAs]),
+ false
+ end
+ end;
+
+next_node(D, {node, {variable, _MibName}}, [], RevOidSoFar, MibView) ->
+ ?vtrace("next_node(node,variable,[]) -> entry when"
+ "~n RevOidSoFar: ~p"
+ "~n MibView: ~p",
+ [RevOidSoFar, MibView]),
+ OidSoFar = lists:reverse([0 | RevOidSoFar]),
+ case snmpa_acm:validate_mib_view(OidSoFar, MibView) of
+ true ->
+ #mib_data{module = Mod, node_db = Db} = D,
+ case Mod:read(Db, lists:reverse(RevOidSoFar)) of
+ false ->
+ ?vinfo("next_node -> could not find variable with"
+ "~n RevOidSoFar: ~p", [RevOidSoFar]),
+ false;
+ {value, #node_info{me = ME}} ->
+ {variable, ME, OidSoFar}
+ end;
+ _ ->
+ false
+ end;
+
+next_node(_D, {node, {variable, _MibName}}, _Oid, _RevOidSoFar, _MibView) ->
+ ?vtrace("next_node(node,variable) -> entry", []),
+ false.
+
+
+%%-----------------------------------------------------------------
+%% This function is used to find the first leaf from where we
+%% are.
+%% Returns: {subagent, SubAgentPid, SAOid} |
+%% false |
+%% {variable, MibEntry, VarOid} |
+%% {table, TableOid, TableRestOid, MibEntry}
+%% PRE: This function must always be called with a {internal, Tree}
+%% node.
+%%-----------------------------------------------------------------
+find_next(D, {tree, Tree, internal}, Idx, RevOidSoFar, MibView)
+ when Idx < size(Tree) ->
+ case find_next(D, element(Idx+1, Tree), 0, [Idx| RevOidSoFar], MibView) of
+ false ->
+ find_next(D, {tree, Tree, internal}, Idx+1, RevOidSoFar, MibView);
+ Other ->
+ Other
+ end;
+find_next(_D, {tree, _Tree, internal}, _Idx, _RevOidSoFar, _MibView) ->
+ false;
+find_next(_D, undefined_node, _Idx, _RevOidSoFar, _MibView) ->
+ false;
+find_next(D, {tree, Tree, {table, _MibName}}, Idx, RevOidSoFar, MibView) ->
+ find_next(D, {tree, Tree, internal}, Idx, RevOidSoFar, MibView);
+find_next(D, {tree, _Tree, {table_entry, _MibName}}, _Index,
+ RevOidSoFar, MibView) ->
+ OidSoFar = lists:reverse(RevOidSoFar),
+ case snmpa_acm:is_definitely_not_in_mib_view(OidSoFar, MibView) of
+ true ->
+ false;
+ _ ->
+ #mib_data{module = Mod, node_db = Db} = D,
+ case Mod:read(Db, OidSoFar) of
+ false ->
+ ?vinfo("find_next -> could not find table_entry ME with"
+ "~n OidSoFar: ~p", [OidSoFar]),
+ false;
+ {value, #node_info{me = ME}} ->
+ {table, OidSoFar, [], ME}
+ end
+ end;
+find_next(D, {node, {variable, _MibName}}, _Idx, RevOidSoFar, MibView) ->
+ OidSoFar = lists:reverse([0 | RevOidSoFar]),
+ case snmpa_acm:validate_mib_view(OidSoFar, MibView) of
+ true ->
+ #mib_data{module = Mod, node_db = Db} = D,
+ case Mod:read(Db, lists:reverse(RevOidSoFar)) of
+ false ->
+ ?vinfo("find_next -> could not find variable with"
+ "~n RevOidSoFar: ~p", [RevOidSoFar]),
+ false;
+ {value, #node_info{me = ME}} ->
+ {variable, ME, OidSoFar}
+ end;
+ _ ->
+ false
+ end;
+find_next(D, {node, subagent}, _Idx, RevOidSoFar, MibView) ->
+ OidSoFar = lists:reverse(RevOidSoFar),
+ case snmpa_acm:is_definitely_not_in_mib_view(OidSoFar, MibView) of
+ true ->
+ false;
+ _ ->
+ #mib_data{subagents = SAs} = D,
+ case lists:keysearch(OidSoFar, 2, SAs) of
+ {value, {SubAgentPid, OidSoFar}} ->
+ {subagent, SubAgentPid, OidSoFar};
+ false ->
+ ?vinfo("find_node -> could not find subagent with"
+ "~n OidSoFar: ~p"
+ "~n SAs: ~p", [OidSoFar, SAs]),
+ false
+ end
+ end.
+
+%%%======================================================================
+%%% 3. Tree building functions
+%%% Used when loading mibs.
+%%%======================================================================
+
+build_tree(Mes, MibName) ->
+ ?d("build_tree -> "
+ "~n Mes: ~p", [Mes]),
+ {ListTree, []} = build_subtree([], Mes, MibName),
+ {tree, convert_tree(ListTree), internal}.
+
+%%----------------------------------------------------------------------
+%% Purpose: Builds the tree where all oids have prefix equal to LevelPrefix.
+%% Returns: {Tree, RestMes}
+%% RestMes are Mes that should not be in this subtree.
+%% The Tree is a temporary and simplified data structure that is easy to
+%% convert to the final tuple tree used by the MIB process.
+%% A Node is represented as in the final tree.
+%% The tree is not represented as a N-tuple, but as an Index-list.
+%% Example: Temporary: [{1, Node1}, {3, Node3}]
+%% Final: {Node1, undefined_node, Node3}
+%% Pre: Mes are sorted on oid.
+%%----------------------------------------------------------------------
+build_subtree(LevelPrefix, [Me | Mes], MibName) ->
+ ?vtrace("build subtree -> ~n"
+ " oid: ~p~n"
+ " LevelPrefix: ~p~n"
+ " MibName: ~p", [Me#me.oid, LevelPrefix, MibName]),
+ EType = Me#me.entrytype,
+ ?vtrace("build subtree -> EType = ~p",[EType]),
+ case in_subtree(LevelPrefix, Me) of
+ above ->
+ ?vtrace("build subtree -> above",[]),
+ {[], [Me|Mes]};
+ {node, Index} ->
+ ?vtrace("build subtree -> node at ~p",[Index]),
+ {Tree, RestMes} = build_subtree(LevelPrefix, Mes, MibName),
+ {[{Index, {node, {EType, MibName}}} | Tree], RestMes};
+ {subtree, Index, NewLevelPrefix} ->
+ ?vtrace("build subtree -> subtree at"
+ "~n ~w with ~w",
+ [Index, NewLevelPrefix]),
+ {BelowTree, RestMes} =
+ build_subtree(NewLevelPrefix, Mes, MibName),
+ {CurTree, RestMes2} =
+ build_subtree(LevelPrefix, RestMes, MibName),
+ {[{Index, {tree, BelowTree, {EType,MibName}}}| CurTree], RestMes2};
+ {internal_subtree, Index, NewLevelPrefix} ->
+ ?vtrace("build subtree -> internal_subtree at"
+ "~n ~w with ~w",
+ [Index,NewLevelPrefix]),
+ {BelowTree, RestMes} =
+ build_subtree(NewLevelPrefix, [Me | Mes], MibName),
+ {CurTree, RestMes2} =
+ build_subtree(LevelPrefix, RestMes, MibName),
+ {[{Index, {tree, BelowTree, internal}} | CurTree], RestMes2}
+ end;
+
+build_subtree(_LevelPrefix, [], _MibName) ->
+ ?vtrace("build subtree -> done", []),
+ {[], []}.
+
+%%--------------------------------------------------
+%% Purpose: Determine how/if/where Me should be inserted in subtree
+%% with LevelPrefix. This function does not build any tree, only
+%% determinses what should be done (by build subtree).
+%% Returns:
+%% above - Indicating that this ME should _not_ be in this subtree.
+%% {node, Index} - yes, construct a node with index Index on this level
+%% {internal_subtree, Index, NewLevelPrefix} - yes, there should be an
+%% internal subtree at this index.
+%% {subtree, Index, NewLevelPrefix} - yes, construct a subtree with
+%% NewLevelPrefix and insert this on current level in position Index.
+%%--------------------------------------------------
+in_subtree(LevelPrefix, Me) ->
+ case lists:prefix(LevelPrefix, Me#me.oid) of
+ true when length(Me#me.oid) > length(LevelPrefix) ->
+ classify_how_in_subtree(LevelPrefix, Me);
+ _ ->
+ above
+ end.
+
+%%--------------------------------------------------
+%% See comment about in_subtree/2. This function takes care of all cases
+%% where the ME really should be in _this_ subtree (not above).
+%%--------------------------------------------------
+classify_how_in_subtree(LevelPrefix, Me)
+ when (length(Me#me.oid) =:= (length(LevelPrefix) + 1)) ->
+ Oid = Me#me.oid,
+ case node_or_subtree(Me#me.entrytype) of
+ subtree ->
+ {subtree, lists:last(Oid), Oid};
+ node ->
+ {node, lists:last(Oid)}
+ end;
+
+classify_how_in_subtree(LevelPrefix, Me)
+ when (length(Me#me.oid) > (length(LevelPrefix) + 1)) ->
+ L1 = length(LevelPrefix) + 1,
+ Oid = Me#me.oid,
+ {internal_subtree, lists:nth(L1, Oid), lists:sublist(Oid, 1, L1)}.
+
+%%--------------------------------------------------
+%% Determines how to treat different kinds om MEs in the tree building process.
+%% Pre: all internal nodes have been removed.
+%%--------------------------------------------------
+node_or_subtree(table) -> subtree;
+node_or_subtree(table_entry) -> subtree;
+node_or_subtree(variable) -> node;
+node_or_subtree(table_column) -> node.
+
+%%--------------------------------------------------
+%% Purpose: (Recursively) Converts a temporary tree (see above) to a final tree.
+%% If input is a ListTree, output is a TupleTree.
+%% If input is a Node, output is the same Node.
+%% Pre: All Indexes are >= 0.
+%%--------------------------------------------------
+convert_tree({Index, {tree, Tree, Info}}) when Index >= 0 ->
+ L = lists:map(fun convert_tree/1, Tree),
+ {Index, {tree, dict_list_to_tuple(L), Info}};
+convert_tree({Index, {node, Info}}) when Index >= 0 ->
+ {Index, {node, Info}};
+convert_tree(Tree) when is_list(Tree) ->
+ L = lists:map(fun convert_tree/1, Tree),
+ dict_list_to_tuple(L).
+
+%%----------------------------------------------------------------------
+%% Purpose: Converts a single level (that is non-recursively) from
+%% the temporary indexlist to the N-tuple.
+%% Input: A list of {Index, Data}.
+%% Output: A tuple where element Index is Data.
+%%----------------------------------------------------------------------
+dict_list_to_tuple(L) ->
+ L2 = lists:keysort(1, L),
+ list_to_tuple(integrate_indexes(0, L2)).
+
+%%----------------------------------------------------------------------
+%% Purpose: Helper function for dict_list_to_tuple/1.
+%% Converts an indexlist to a N-list.
+%% Input: A list of {Index, Data}.
+%% Output: A (usually longer, never shorter) list where element Index is Data.
+%% Example: [{1,hej}, {3, sven}] will give output
+%% [undefined_node, hej, undefined_node, sven].
+%% Initially CurIndex should be 0.
+%%----------------------------------------------------------------------
+integrate_indexes(CurIndex, [{CurIndex, Data} | T]) ->
+ [Data | integrate_indexes(CurIndex + 1, T)];
+integrate_indexes(_Index, []) ->
+ [];
+integrate_indexes(CurIndex, L) ->
+ [undefined_node | integrate_indexes(CurIndex + 1, L)].
+
+%%%======================================================================
+%%% 4. Tree merging
+%%% Used by: load mib, insert subagent.
+%%%======================================================================
+
+%%----------------------------------------------------------------------
+%% Arg: Two root nodes (that is to be merged).
+%% Returns: A new root node where the nodes have been merger to one.
+%%----------------------------------------------------------------------
+merge_nodes(Same, Same) ->
+ Same;
+merge_nodes(Node, undefined_node) ->
+ Node;
+merge_nodes(undefined_node, Node) ->
+ Node;
+merge_nodes({tree, Tree1, internal}, {tree, Tree2, internal}) ->
+ {tree, merge_levels(tuple_to_list(Tree1),tuple_to_list(Tree2)), internal};
+merge_nodes(Node1, Node2) ->
+ throw({error_merge_nodes, Node1, Node2}).
+
+%%----------------------------------------------------------------------
+%% Arg: Two levels to be merged.
+%% Here, a level is represented as a list of nodes. A list is easier
+%% to extend than a tuple.
+%% Returns: The resulting, merged level tuple.
+%%----------------------------------------------------------------------
+merge_levels(Level1, Level2) when length(Level1) =:= length(Level2) ->
+ MergeNodes = fun(N1, N2) -> merge_nodes(N1, N2) end,
+ list_to_tuple(snmp_misc:multi_map(MergeNodes, [Level1, Level2]));
+merge_levels(Level1, Level2) when length(Level1) > length(Level2) ->
+ merge_levels(Level1, Level2 ++
+ undefined_nodes_list(length(Level1) - length(Level2)));
+merge_levels(Level1, Level2) when length(Level1) < length(Level2) ->
+ merge_levels(Level2, Level1).
+
+undefined_nodes_list(N) -> lists:duplicate(N, undefined_node).
+
+
+%%%======================================================================
+%%% 5. Tree deletion routines
+%%% (for unload mib)
+%%%======================================================================
+
+%%----------------------------------------------------------------------
+%% Purpose: Actually kicks of the tree reconstruction.
+%% Returns: {list of removed MEs, NewTree}
+%%----------------------------------------------------------------------
+delete_mib_from_tree(MibName, {tree, Tree, internal}) ->
+ case delete_tree(Tree, MibName) of
+ [] ->
+ {tree, {undefined_node}, internal}; % reduce
+ LevelList ->
+ {tree, list_to_tuple(LevelList), internal}
+ end.
+
+%%----------------------------------------------------------------------
+%% Purpose: Deletes all nodes associated to MibName from this level and
+%% all levels below.
+%% If the new level does not contain information (that is, no
+%% other mibs use it) anymore the empty list is returned.
+%% Returns: {MEs, The new level represented as a list}
+%%----------------------------------------------------------------------
+delete_tree(Tree, MibName) when is_tuple(Tree) ->
+ NewLevel = delete_nodes(tuple_to_list(Tree), MibName, []),
+ case lists:filter(fun drop_undefined_nodes/1,NewLevel) of
+ [] -> [];
+ _A_perhaps_shorted_list ->
+ NewLevel % some other mib needs this level
+ end.
+
+%%----------------------------------------------------------------------
+%% Purpose: Nodes belonging to MibName are removed from the tree.
+%% Recursively deletes sub trees to this node.
+%% Returns: {MEs, NewNodesList}
+%%----------------------------------------------------------------------
+delete_nodes([], _MibName, AccNodes) ->
+ lists:reverse(AccNodes);
+
+delete_nodes([{node, {variable, MibName}}|T], MibName, AccNodes) ->
+ delete_nodes(T, MibName, [undefined_node | AccNodes]);
+
+delete_nodes([{node, {table_column, MibName}}|T], MibName, AccNodes) ->
+ delete_nodes(T, MibName, [undefined_node | AccNodes]);
+
+delete_nodes([{tree, _Tree, {table, MibName}}|T], MibName, AccNodes) ->
+ delete_nodes(T, MibName, [undefined_node | AccNodes]);
+
+delete_nodes([{tree, _Tree, {table_entry, MibName}}|T], MibName, AccNodes) ->
+ delete_nodes(T, MibName, [undefined_node | AccNodes]);
+
+delete_nodes([{tree, Tree, Info}|T], MibName, AccNodes) ->
+ case delete_tree(Tree, MibName) of
+ [] -> % tree completely deleted
+ delete_nodes(T, MibName, [undefined_node | AccNodes]);
+ LevelList ->
+ delete_nodes(T, MibName,
+ [{tree, list_to_tuple(LevelList), Info} | AccNodes])
+ end;
+
+delete_nodes([NodeToKeep|T], MibName, AccNodes) ->
+ delete_nodes(T, MibName, [NodeToKeep | AccNodes]).
+
+drop_undefined_nodes(undefined_node) -> false;
+drop_undefined_nodes(_) -> true.
+
+
+%%%======================================================================
+%%% 6. Functions for subagent handling
+%%%======================================================================
+
+%%----------------------------------------------------------------------
+%% Returns: A new Root|{error, reason}
+%%----------------------------------------------------------------------
+insert_subagent(Oid, OldRoot) ->
+ ListTree = build_tree_for_subagent(Oid),
+ case catch convert_tree(ListTree) of
+ {'EXIT', _Reason} ->
+ {error, 'cannot construct tree from oid'};
+ Level when is_tuple(Level) ->
+ T = {tree, Level, internal},
+ case catch merge_nodes(T, OldRoot) of
+ {error_merge_nodes, _Node1, _Node2} ->
+ {error, oid_conflict};
+ NewRoot when is_tuple(NewRoot) andalso
+ (element(1, NewRoot) =:= tree) ->
+ NewRoot
+ end
+ end.
+
+build_tree_for_subagent([Index]) ->
+ [{Index, {node, subagent}}];
+
+build_tree_for_subagent([Index | T]) ->
+ [{Index, {tree, build_tree_for_subagent(T), internal}}].
+
+
+%%----------------------------------------------------------------------
+%% Returns: A new tree where the subagent at Oid (2nd arg) has been deleted.
+%%----------------------------------------------------------------------
+
+delete_subagent({tree, Tree, Info}, [Index]) ->
+ {node, subagent} = element(Index+1, Tree),
+ {tree, setelement(Index+1, Tree, undefined_node), Info};
+delete_subagent({tree, Tree, Info}, [Index | TI]) ->
+ {tree, setelement(Index+1, Tree,
+ delete_subagent(element(Index+1, Tree), TI)), Info}.
+
+
+%%%======================================================================
+%%% 7. Misc functions
+%%%======================================================================
+
+%%----------------------------------------------------------------------
+%% Installs the mibs found in the database when starting the agent.
+%% Basically calls the instrumentation functions for all non-internal
+%% mib-entries
+%%----------------------------------------------------------------------
+install_mibs(Mod, MibDb, NodeDb) ->
+ MibNames = loaded(Mod, MibDb),
+ ?vtrace("install_mibs -> found following mibs in database: ~n"
+ "~p", [MibNames]),
+ install_mibs2(Mod, NodeDb, MibNames).
+
+install_mibs2(_, _, []) ->
+ ok;
+install_mibs2(Mod, NodeDb, [MibName|MibNames]) ->
+ Pattern = #node_info{oid = '_', mib_name = MibName, me = '_'},
+ Nodes = Mod:match_object(NodeDb, Pattern),
+ MEs = [ME || #node_info{me = ME} <- Nodes],
+ ?vtrace("install_mibs2 -> installing ~p MEs for mib ~p",
+ [length(MEs), MibName]),
+ NewF = fun(ME) -> call_instrumentation(ME, new) end,
+ lists:foreach(NewF, MEs),
+ install_mibs2(Mod, NodeDb, MibNames).
+
+
+%%----------------------------------------------------------------------
+%% Does all side effect stuff during load_mib.
+%%----------------------------------------------------------------------
+install_mib(Mod, Db, Symbolic, Mib, MibName, FileName, NonInternalMes) ->
+ ?vdebug("install_mib -> entry with"
+ "~n Symbolic: ~p"
+ "~n MibName: ~p"
+ "~n FileName: ~p", [Symbolic, MibName, FileName]),
+ Rec = #mib_info{name = MibName, symbolic = Symbolic, file_name = FileName},
+ Mod:write(Db, Rec),
+ install_mib2(Symbolic, MibName, Mib),
+ NewF = fun(ME) -> call_instrumentation(ME, new) end,
+ lists:foreach(NewF, NonInternalMes).
+
+install_mib2(true, MibName, Mib) ->
+ #mib{table_infos = TabInfos,
+ variable_infos = VarInfos,
+ mes = MEs,
+ asn1_types = ASN1Types,
+ traps = Traps} = Mib,
+ snmpa_symbolic_store:add_table_infos(MibName, TabInfos),
+ snmpa_symbolic_store:add_variable_infos(MibName, VarInfos),
+ snmpa_symbolic_store:add_aliasnames(MibName, MEs),
+ snmpa_symbolic_store:add_types(MibName, ASN1Types),
+ SetF = fun(Trap) ->
+ snmpa_symbolic_store:set_notification(Trap, MibName)
+ end,
+ lists:foreach(SetF, Traps);
+install_mib2(_, _, _) ->
+ ok.
+
+install_mes(Mod, Db, MibName, MEs) ->
+ Write = fun(#me{oid = Oid} = ME) ->
+ Node = #node_info{oid = Oid,
+ mib_name = MibName,
+ me = ME},
+ Mod:write(Db, Node)
+ end,
+ install_mes(Write, MEs).
+
+install_mes(_Write, []) ->
+ ok;
+install_mes(Write, [ME|MEs]) ->
+ Write(ME),
+ install_mes(Write, MEs).
+
+
+%%----------------------------------------------------------------------
+%% Does all side effect stuff during unload_mib.
+%%----------------------------------------------------------------------
+uninstall_mib(Mod, Db, Symbolic, MibName, MEs) ->
+ ?vtrace("uninstall_mib -> entry with"
+ "~n Db: ~p"
+ "~n Symbolic: ~p"
+ "~n MibName: ~p", [Db, Symbolic, MibName]),
+ Res = Mod:delete(Db, MibName),
+ ?vtrace("uninstall_mib -> (mib) db delete result: ~p", [Res]),
+ uninstall_mib2(Symbolic, MibName),
+ DelF = fun(ME) -> call_instrumentation(ME, delete) end,
+ lists:foreach(DelF, MEs).
+
+uninstall_mib2(true, MibName) ->
+ snmpa_symbolic_store:delete_table_infos(MibName),
+ snmpa_symbolic_store:delete_variable_infos(MibName),
+ snmpa_symbolic_store:delete_aliasnames(MibName),
+ snmpa_symbolic_store:delete_types(MibName),
+ snmpa_symbolic_store:delete_notifications(MibName);
+uninstall_mib2(_, _) ->
+ ok.
+
+uninstall_mes(Mod, Db, MibName) ->
+ Pattern = #node_info{oid = '_', mib_name = MibName, me = '_'},
+ Mod:match_delete(Db, Pattern).
+
+
+%%----------------------------------------------------------------------
+%% Create a list of the names of all the loaded mibs
+%%----------------------------------------------------------------------
+loaded(Mod, Db) ->
+ [N || #mib_info{name = N} <- Mod:tab2list(Db)].
+
+
+%%----------------------------------------------------------------------
+%% Calls MFA-instrumentation with 'new' or 'delete' operation.
+%%----------------------------------------------------------------------
+call_instrumentation(#me{entrytype = variable, mfa={M,F,A}}, Operation) ->
+ ?vtrace("call instrumentation with"
+ "~n entrytype: variable"
+ "~n MFA: {~p,~p,~p}"
+ "~n Operation: ~p",
+ [M,F,A,Operation]),
+ catch apply(M, F, [Operation | A]);
+call_instrumentation(#me{entrytype = table_entry, mfa={M,F,A}}, Operation) ->
+ ?vtrace("call instrumentation with"
+ "~n entrytype: table_entry"
+ "~n MFA: {~p,~p,~p}"
+ "~n Operation: ~p",
+ [M,F,A,Operation]),
+ catch apply(M, F, [Operation | A]);
+call_instrumentation(_ShitME, _Operation) ->
+ done.
+
+
+maybe_drop_me(#me{entrytype = internal}) -> false;
+maybe_drop_me(#me{entrytype = group}) -> false;
+maybe_drop_me(#me{imported = true}) -> false;
+maybe_drop_me(_) -> true.
+
+
+%%----------------------------------------------------------------------
+%% Code change functions
+%%----------------------------------------------------------------------
+
+code_change(down, _Vsn, _Extra, State) ->
+ ?d("code_change(down) -> entry when"
+ "~n Vsn: ~p"
+ "~n Extra: ~p", [_Vsn, _Extra]),
+ State;
+
+code_change(up, _Vsn, _Extra, State) ->
+ ?d("code_change(up) -> entry when"
+ "~n Vsn: ~p"
+ "~n Extra: ~p", [_Vsn, _Extra]),
+ State.
+
+
diff --git a/lib/snmp/src/agent/snmpa_mib_storage.erl b/lib/snmp/src/agent/snmpa_mib_storage.erl
new file mode 100644
index 0000000000..5c3f76d89b
--- /dev/null
+++ b/lib/snmp/src/agent/snmpa_mib_storage.erl
@@ -0,0 +1,181 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2013-2013. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(snmpa_mib_storage).
+
+-export_type([
+ mib_storage_fields/0,
+ mib_storage_table_type/0,
+ mib_storage_table_id/0
+ ]).
+
+
+%%% ----------------------------------------------------------------
+%%% This behaviour module defines the API for the mib-storage.
+%%% This is how the agent stores its internal mib-data
+%%% (symbolic-store and mib-server).
+%%%-----------------------------------------------------------------
+
+-type mib_storage_fields() :: [atom()].
+-type mib_storage_table_type() :: set | bag.
+-type mib_storage_table_id() :: term().
+
+
+%% ---------------------------------------------------------------
+%% open
+%%
+%% Open or create a mib-storage table.
+%% If any extra info needs to be communicated to the implementor
+%% (of the behaviour), this is done using the *Options* argument.
+%% ---------------------------------------------------------------
+
+%% Options is callback module dependant
+
+-callback open(Name :: atom(),
+ RecName :: atom(),
+ Fields :: mib_storage_fields(),
+ Type :: mib_storage_table_type(),
+ Options :: list()) ->
+ {ok, TabId :: mib_storage_table_id()} | {error, Reason :: term()}.
+
+
+%% ---------------------------------------------------------------
+%% close
+%%
+%% Close the mib-storage table. What this does is up to the
+%% implementor (when using mnesia it may be a no-op but for ets
+%% it may actually delete the table).
+%% ---------------------------------------------------------------
+
+-callback close(TabId :: mib_storage_table_id()) ->
+ term().
+
+
+%% ---------------------------------------------------------------
+%% read/2
+%%
+%% Retrieve a record from the mib-storage table.
+%% ---------------------------------------------------------------
+
+-callback read(TabId :: mib_storage_table_id(),
+ Key :: term()) ->
+ false | {value, Record :: tuple()}.
+
+
+%% ---------------------------------------------------------------
+%% write/2
+%%
+%% Write a record to the mib-storage table.
+%% ---------------------------------------------------------------
+
+-callback write(TabId :: mib_storage_table_id(),
+ Record :: tuple()) ->
+ ok | {error, Reason :: term()}.
+
+
+%% ---------------------------------------------------------------
+%% delete/1
+%%
+%% Delete the mib-storage table.
+%% ---------------------------------------------------------------
+
+-callback delete(TabId :: mib_storage_table_id()) ->
+ snmp:void().
+
+
+%% ---------------------------------------------------------------
+%% delete/2
+%%
+%% Delete a record from the mib-storage table.
+%% ---------------------------------------------------------------
+
+-callback delete(TabId :: mib_storage_table_id(),
+ Key :: term()) ->
+ ok | {error, Reason :: term()}.
+
+
+%% ---------------------------------------------------------------
+%% match_object
+%%
+%% Search the mib-storage table for records which matches
+%% the pattern.
+%% ---------------------------------------------------------------
+
+-callback match_object(TabId :: mib_storage_table_id(),
+ Pattern :: ets:match_pattern()) ->
+ {ok, Recs :: [tuple()]} | {error, Reason :: term()}.
+
+
+%% ---------------------------------------------------------------
+%% match_delete
+%%
+%% Search the mib-storage table for records which matches the
+%% pattern and deletes them from the database and return the
+%5 deleted records.
+%% ---------------------------------------------------------------
+
+-callback match_delete(TabId :: mib_storage_table_id(),
+ Pattern :: ets:match_pattern()) ->
+ {ok, Recs :: [tuple()]} | {error, Reason :: term()}.
+
+
+%% ---------------------------------------------------------------
+%% tab2list
+%%
+%% Return all records in the table in the form of a list.
+%% ---------------------------------------------------------------
+
+-callback tab2list(TabId :: mib_storage_table_id()) ->
+ [tuple()].
+
+
+%% ---------------------------------------------------------------
+%% info/1,2
+%%
+%% Retrieve implementation dependent mib-storage table
+%% information.
+%% ---------------------------------------------------------------
+
+-callback info(TabId :: mib_storage_table_id()) ->
+ Info :: term().
+
+-callback info(TabId :: mib_storage_table_id(), Item :: atom()) ->
+ Info :: term().
+
+
+%% ---------------------------------------------------------------
+%% sync
+%%
+%% Dump mib-storage table to disc (if it has a disk component).
+%% ---------------------------------------------------------------
+
+-callback sync(TabId :: mib_storage_table_id()) ->
+ snmp:void().
+
+
+%% ---------------------------------------------------------------
+%% backup
+%%
+%% Make a backup copy of the mib-storage table.
+%% ---------------------------------------------------------------
+
+-callback backup(TabId :: mib_storage_table_id(),
+ Dir :: file:filename()) ->
+ ok | {error, Reason :: term()}.
+
diff --git a/lib/snmp/src/agent/snmpa_mib_storage_dets.erl b/lib/snmp/src/agent/snmpa_mib_storage_dets.erl
new file mode 100644
index 0000000000..e84e18e7ea
--- /dev/null
+++ b/lib/snmp/src/agent/snmpa_mib_storage_dets.erl
@@ -0,0 +1,309 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2013-2013. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(snmpa_mib_storage_dets).
+
+-behaviour(snmpa_mib_storage).
+
+
+%%%-----------------------------------------------------------------
+%%% This module implements the snmpa_mib_storage behaviour.
+%%% It uses dets for storage.
+%%%-----------------------------------------------------------------
+
+-export([
+ open/5,
+ close/1,
+ read/2,
+ write/2,
+ delete/1,
+ delete/2,
+ match_object/2,
+ match_delete/2,
+ tab2list/1,
+ info/1, info/2,
+ sync/1,
+ backup/2
+ ]).
+
+
+-define(VMODULE, "MS-DETS").
+-include("snmp_verbosity.hrl").
+
+-record(tab, {id, rec_name}).
+
+
+%% ---------------------------------------------------------------
+%% open
+%%
+%% Open or create a mib-storage (dets) table.
+%%
+%% Opts - A list of implementation dependent options
+%% dets_open_options() = [dets_open_option()]
+%% dets_open_option() = {dir, filename()} |
+%% {action, keep | clear} |
+%% {auto_save, default | pos_integer()} |
+%% {repair, force | boolean()}
+%%
+%% ---------------------------------------------------------------
+
+open(Name, RecName, _Fields, Type, Opts) ->
+ Dir = snmp_misc:get_option(dir, Opts),
+ Action = snmp_misc:get_option(action, Opts, keep),
+ AutoSave = snmp_misc:get_option(auto_save, Opts, default),
+ Repair = snmp_misc:get_option(repair, Opts, false),
+ File = dets_filename(Name, Dir),
+ OpenOpts = [{file, File},
+ {type, Type},
+ {keypos, 2},
+ {repair, Repair}] ++
+ case AutoSave of
+ default ->
+ [];
+ _ ->
+ [{auto_save, AutoSave}]
+ end,
+ case dets:open_file(Name, OpenOpts) of
+ {ok, ID} when (Action =:= keep) ->
+ {ok, #tab{id = ID, rec_name = RecName}};
+ {ok, ID} when (Action =:= clear) ->
+ dets:match_delete(ID, '_'),
+ {ok, #tab{id = ID, rec_name = RecName}};
+ {error, Reason} ->
+ {error, {dets_open, Reason}}
+ end.
+
+dets_filename(Name, Dir) ->
+ Dir1 = dets_filename1(Dir),
+ Dir2 = string:strip(Dir1, right, $/),
+ io_lib:format("~s/~p.dat", [Dir2, Name]).
+
+dets_filename1([]) -> ".";
+dets_filename1(Dir) -> Dir.
+
+
+%% ---------------------------------------------------------------
+%% close
+%%
+%% Close the table.
+%% ---------------------------------------------------------------
+
+close(#tab{id = ID}) ->
+ ?vtrace("close database ~p", [ID]),
+ dets:close(ID).
+
+
+%% ---------------------------------------------------------------
+%% read
+%%
+%% Retrieve a record from the database table.
+%% ---------------------------------------------------------------
+
+read(#tab{id = ID}, Key) ->
+ ?vtrace("read from table ~p: ~p", [ID, Key]),
+ case dets:lookup(ID, Key) of
+ [Rec|_] -> {value, Rec};
+ _ -> false
+ end.
+
+
+%% ---------------------------------------------------------------
+%% write
+%%
+%% Write a record to the database table.
+%% ---------------------------------------------------------------
+
+write(#tab{id = ID, rec_name = RecName}, Rec)
+ when (is_tuple(Rec) andalso (element(1, Rec) =:= RecName)) ->
+ ?vtrace("write to table ~p", [ID]),
+ dets:insert(ID, Rec).
+
+
+%% ---------------------------------------------------------------
+%% delete
+%%
+%% Delete the database table.
+%% ---------------------------------------------------------------
+
+delete(#tab{id = ID}) ->
+ ?vtrace("delete database ~p", [ID]),
+ File = dets:info(ID, filename),
+ case dets:close(ID) of
+ ok ->
+ file:delete(File);
+ Error ->
+ Error
+ end.
+
+
+%% ---------------------------------------------------------------
+%% delete
+%%
+%% Delete a record from the database table.
+%% ---------------------------------------------------------------
+
+delete(#tab{id = ID}, Key) ->
+ ?vtrace("delete from table ~p: ~p", [ID, Key]),
+ dets:delete(ID, Key).
+
+
+%% ---------------------------------------------------------------
+%% match_object
+%%
+%% Search the database table for records witch matches the pattern.
+%% ---------------------------------------------------------------
+
+match_object(#tab{id = ID}, Pattern) ->
+ ?vtrace("match_object in ~p of ~p", [ID, Pattern]),
+ dets:match_object(ID, Pattern).
+
+
+%% ---------------------------------------------------------------
+%% match_delete
+%%
+%% Search the database table for records witch matches the
+%% pattern and deletes them from the database table.
+%% ---------------------------------------------------------------
+
+match_delete(#tab{id = ID}, Pattern) ->
+ ?vtrace("match_delete in ~p with pattern ~p", [ID, Pattern]),
+ Recs = dets:match_object(ID, Pattern),
+ dets:match_delete(ID, Pattern),
+ Recs.
+
+
+%% ---------------------------------------------------------------
+%% tab2list
+%%
+%% Return all records in the table in the form of a list.
+%% ---------------------------------------------------------------
+
+tab2list(#tab{id = ID} = Tab) ->
+ ?vtrace("tab2list -> list of ~p", [ID]),
+ match_object(Tab, '_').
+
+
+%% ---------------------------------------------------------------
+%% info
+%%
+%% Retrieve implementation dependent mib-storage table
+%% information.
+%% ---------------------------------------------------------------
+
+info(#tab{id = ID}) ->
+ ?vtrace("info -> info of ~p", [ID]),
+ dets:info(ID).
+
+
+info(TabId, all = _Item) ->
+ info(TabId);
+info(#tab{id = ID}, memory = _Item) ->
+ ?vtrace("info on ~p (~w)", [ID, _Item]),
+ dets:info(ID, file_size);
+info(#tab{id = ID}, Item) ->
+ ?vtrace("info on ~p (~w)", [ID, Item]),
+ dets:info(ID, Item).
+
+
+%% ---------------------------------------------------------------
+%% sync
+%%
+%% Dump mib-storage table to disc (if it has a disk component)
+%% ---------------------------------------------------------------
+
+sync(#tab{id = ID}) ->
+ ?vtrace("sync -> sync ~p", [ID]),
+ dets:sync(ID).
+
+
+%% ---------------------------------------------------------------
+%% backup
+%%
+%% Make a backup copy of the mib-storage table.
+%% ---------------------------------------------------------------
+
+backup(#tab{id = ID}, BackupDir) ->
+ ?vtrace("backup -> backup of ~p to ~p", [ID, BackupDir]),
+ case dets:info(ID, filename) of
+ undefined ->
+ {error, no_file};
+ Filename ->
+ case filename:dirname(Filename) of
+ BackupDir ->
+ {error, db_dir};
+ _ ->
+ Type = dets:info(ID, type),
+ KP = dets:info(ID, keypos),
+ dets_backup(ID,
+ filename:basename(Filename),
+ BackupDir, Type, KP)
+ end
+ end.
+
+
+dets_backup(ID, Filename, BackupDir, Type, KP) ->
+ ?vtrace("dets_backup -> entry with"
+ "~n ID: ~p"
+ "~n Filename: ~p"
+ "~n BackupDir: ~p"
+ "~n Type: ~p"
+ "~n KP: ~p", [ID, Filename, BackupDir, Type, KP]),
+ BackupFile = filename:join(BackupDir, Filename),
+ ?vtrace("dets_backup -> "
+ "~n BackupFile: ~p", [BackupFile]),
+ Backup = list_to_atom(atom_to_list(ID) ++ "_backup"),
+ Opts = [{file, BackupFile}, {type, Type}, {keypos, KP}],
+ case dets:open_file(Backup, Opts) of
+ {ok, B} ->
+ ?vtrace("dets_backup -> create fun", []),
+ F = fun(Arg) ->
+ dets_backup(Arg, start, ID, B)
+ end,
+ dets:safe_fixtable(ID, true),
+ Res = dets:init_table(Backup, F, [{format, bchunk}]),
+ dets:safe_fixtable(ID, false),
+ ?vtrace("dets_backup -> Res: ~p", [Res]),
+ Res;
+ Error ->
+ ?vinfo("dets_backup -> open_file failed: "
+ "~n ~p", [Error]),
+ Error
+ end.
+
+dets_backup(close, _Cont, _ID, B) ->
+ dets:close(B),
+ ok;
+dets_backup(read, Cont1, ID, B) ->
+ case dets:bchunk(ID, Cont1) of
+ {Cont2, Data} ->
+ F = fun(Arg) ->
+ dets_backup(Arg, Cont2, ID, B)
+ end,
+ {Data, F};
+ '$end_of_table' ->
+ dets:close(B),
+ end_of_input;
+ Error ->
+ Error
+ end.
+
+
+%%----------------------------------------------------------------------
+
+%% user_err(F, A) ->
+%% snmpa_error:user_err(F, A).
diff --git a/lib/snmp/src/agent/snmpa_mib_storage_ets.erl b/lib/snmp/src/agent/snmpa_mib_storage_ets.erl
new file mode 100644
index 0000000000..04faf46864
--- /dev/null
+++ b/lib/snmp/src/agent/snmpa_mib_storage_ets.erl
@@ -0,0 +1,341 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2013-2013. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(snmpa_mib_storage_ets).
+
+-behaviour(snmpa_mib_storage).
+
+%%%-----------------------------------------------------------------
+%%% This module implements the snmpa_mib_storage behaviour.
+%%% It uses ets for storage.
+%%%-----------------------------------------------------------------
+
+-export([
+ open/5,
+ close/1,
+ read/2,
+ write/2,
+ delete/1,
+ delete/2,
+ match_object/2,
+ match_delete/2,
+ tab2list/1,
+ info/1, info/2,
+ sync/1,
+ backup/2
+ ]).
+
+
+-define(VMODULE,"MS-ETS").
+-include("snmp_verbosity.hrl").
+
+-record(tab, {id, rec_name, file, checksum = false}).
+
+
+%% ---------------------------------------------------------------
+%% open
+%%
+%% Open or create an ets table.
+%% Possibly also read data from a (specified) file (mirror) and
+%% populate the table from that (the dir option).
+%%
+%% Opts - A list of implementation dependent options
+%% ets_open_options() = [ets_open_option()]
+%% ets_open_option() = {dir, filename()} |
+%% {action, keep | clear} |
+%% {checksum, boolean()}
+%%
+%% The RecName and Fields arguments are not used in this
+%% implementation.
+%%
+%% ---------------------------------------------------------------
+
+%% This function creates the ets table
+open(Name, RecName, _Fields, Type, Opts) ->
+ ?vtrace("open table ~p", [Name]),
+ case lists:keysearch(dir, 1, Opts) of
+ {value, {dir, Dir}} ->
+ Action = snmp_misc:get_option(action, Opts, keep),
+ Checksum = snmp_misc:get_option(checksum, Opts, false),
+ ?vtrace("open ~p database ~p - check if file exist", [Type, Name]),
+ File = filename:join(Dir, atom_to_list(Name) ++ ".db"),
+ case file:read_file_info(File) of
+ {ok, _} ->
+ ?vdebug("open ~p database ~p - file exist - try reading",
+ [Type, Name]),
+ case ets:file2tab(File, [{verify, Checksum}]) of
+ {ok, ID} ->
+ ?vtrace("open ~p database ~p - "
+ "data read from file", [Type, Name]),
+ {ok, #tab{id = ID,
+ rec_name = RecName,
+ file = File,
+ checksum = Checksum}};
+ {error, Reason} when (Action =:= keep) ->
+ ?vinfo("open ~p database ~p - "
+ "failed reading from file (keep): "
+ "~n ~p",
+ [Type, Name, Reason]),
+ {error, {file2tab, Reason}};
+ {error, Reason} ->
+ ?vlog("open ~p database ~p - "
+ "failed reading from file (clear): "
+ "~n ~p", [Type, Name, Reason]),
+ user_err("Warning: could not read file - "
+ "create new (empty): "
+ "~n File: ~p"
+ "~n Reason: ~p", [File, Reason]),
+ ID = ets:new(Name, [Type, protected, {keypos, 2}]),
+ write_ets_file(ID, File, Checksum),
+ {ok, #tab{id = ID,
+ rec_name = RecName,
+ file = File,
+ checksum = Checksum}}
+ end;
+ {error, enoent} ->
+ %% No such file - create it
+ ?vdebug("open ~p database ~p - "
+ "file does *not* exist - create",
+ [Type, Name]),
+ ID = ets:new(Name, [Type, protected, {keypos, 2}]),
+ write_ets_file(ID, File, Checksum),
+ {ok, #tab{id = ID,
+ rec_name = RecName,
+ file = File,
+ checksum = Checksum}};
+ {error, Reason} when (Action =:= keep) ->
+ ?vinfo("open ~p database ~p - "
+ "failed reading file info (keep): "
+ "~n ~p",
+ [Type, Name, Reason]),
+ {error, {read_file_info, Reason}};
+ {error, Reason} ->
+ ?vlog("open ~p database ~p - "
+ "failed reading file info (clear): "
+ "~n ~p",
+ [Type, Name, Reason]),
+ user_err("Warning: could not read file info - "
+ "create new file: "
+ "~n File: ~p"
+ "~n Reason: ~p", [File, Reason]),
+ ID = ets:new(Name, [Type, protected, {keypos, 2}]),
+ write_ets_file(ID, File, Checksum),
+ {ok, #tab{id = ID,
+ rec_name = RecName,
+ file = File,
+ checksum = Checksum}}
+ end;
+ false ->
+ ?vdebug("open ~p database ~p - ok", [Type, Name]),
+ ID = ets:new(Name, [Type, protected, {keypos, 2}]),
+ {ok, #tab{id = ID, rec_name = RecName}}
+ end.
+
+
+%% ---------------------------------------------------------------
+%% close
+%%
+%% Close the mib-storage table.
+%% We will delete the table and if there is a file component,
+%% will also be written to file.
+%% ---------------------------------------------------------------
+close(#tab{id = ID, file = undefined}) ->
+ ?vtrace("close (delete) table ~p", [ID]),
+ ets:delete(ID);
+close(#tab{id = ID, file = File, checksum = Checksum}) ->
+ ?vtrace("close (delete) table ~p", [ID]),
+ write_ets_file(ID, File, Checksum),
+ ets:delete(ID).
+
+
+%% ---------------------------------------------------------------
+%% read
+%%
+%% Retrieve a record from the mib-storage table.
+%% ---------------------------------------------------------------
+
+read(#tab{id = ID}, Key) ->
+ ?vtrace("read from table ~p: ~p", [ID, Key]),
+ case ets:lookup(ID, Key) of
+ [Rec|_] -> {value, Rec};
+ _ -> false
+ end.
+
+
+%% ---------------------------------------------------------------
+%% write
+%%
+%% Write a record to the mib-storage table.
+%% ---------------------------------------------------------------
+
+%% This is a very crude guard test is used instead of: is_record(Rec, RecName)
+write(#tab{id = ID, rec_name = RecName}, Rec)
+ when (is_tuple(Rec) andalso (element(1, Rec) =:= RecName)) ->
+ ?vtrace("write to table ~p", [ID]),
+ ets:insert(ID, Rec).
+
+
+%% ---------------------------------------------------------------
+%% delete
+%%
+%% Delete the mib-storage table.
+%% ---------------------------------------------------------------
+delete(#tab{id = ID, file = undefined}) ->
+ ?vtrace("delete table ~p", [ID]),
+ ets:delete(ID);
+delete(#tab{id = ID, file = File}) ->
+ ?vtrace("delete table ~p", [ID]),
+ file:delete(File),
+ ets:delete(ID).
+
+
+%% ---------------------------------------------------------------
+%% delete
+%%
+%% Delete a record from the mib-storage table.
+%% ---------------------------------------------------------------
+delete(#tab{id = ID}, Key) ->
+ ?vtrace("delete from table ~p: ~p", [ID, Key]),
+ ets:delete(ID, Key).
+
+
+%% ---------------------------------------------------------------
+%% match_object
+%%
+%% Search the mib-storage table for records witch matches
+%% the pattern.
+%% ---------------------------------------------------------------
+
+match_object(#tab{id = ID}, Pattern) ->
+ ?vtrace("match_object in ~p of ~p", [ID, Pattern]),
+ ets:match_object(ID, Pattern).
+
+
+%% ---------------------------------------------------------------
+%% match_delete
+%%
+%% Search the mib-storage table for records witch matches
+%% the pattern and deletes them from the table.
+%% ---------------------------------------------------------------
+
+match_delete(#tab{id = ID}, Pattern) ->
+ ?vtrace("match_delete in ~p with pattern ~p", [ID, Pattern]),
+ Recs = ets:match_object(ID, Pattern),
+ ets:match_delete(ID, Pattern),
+ Recs.
+
+
+%% ---------------------------------------------------------------
+%% tab2list
+%%
+%% Return all records in the mib-storage table in the form
+%% of a list.
+%% ---------------------------------------------------------------
+
+tab2list(#tab{id = ID}) ->
+ ?vtrace("tab2list -> list of ~p", [ID]),
+ ets:tab2list(ID).
+
+
+
+%% ---------------------------------------------------------------
+%% info/1,2
+%%
+%% Retrieve implementation dependent mib-storage table
+%% information.
+%% ---------------------------------------------------------------
+info(#tab{id = ID}) ->
+ ?vtrace("info on ~p", [ID]),
+ case ets:info(ID) of
+ undefined ->
+ [];
+ L ->
+ L
+ end.
+
+
+info(TabId, all = _Item) ->
+ info(TabId);
+info(#tab{id = ID}, Item) ->
+ ?vtrace("info on ~p", [ID]),
+ ets:info(ID, Item).
+
+
+%% ---------------------------------------------------------------
+%% sync
+%%
+%% Dump mib-storage table to disc (if there is a file compionent)
+%% ---------------------------------------------------------------
+
+sync(#tab{file = undefined}) ->
+ ok;
+sync(#tab{id = ID, file = File, checksum = Checksum}) ->
+ ?vtrace("sync ~p", [ID]),
+ write_ets_file(ID, File, Checksum).
+
+
+%% ---------------------------------------------------------------
+%% backup
+%%
+%% Make a backup copy of the mib-storage table. Only valid id
+%% there is a file component.
+%% ---------------------------------------------------------------
+
+backup(#tab{file = undefined}, _BackupDir) ->
+ ok;
+backup(#tab{id = ID, file = File, checksum = Checksum}, BackupDir) ->
+ ?vtrace("backup ~p to ~p", [ID, BackupDir]),
+ Filename = filename:basename(File),
+ case filename:join(BackupDir, Filename) of
+ File ->
+ %% Oups: backup-dir and db-dir the same
+ {error, db_dir};
+ BackupFile ->
+ write_ets_file(ID, BackupFile, Checksum)
+ end.
+
+
+%%----------------------------------------------------------------------
+
+write_ets_file(ID, File, Checksum) when (Checksum =:= true) ->
+ do_write_ets_file(ID, File, [{extended_info, [md5sum]}]);
+write_ets_file(ID, File, Checksum) when (Checksum =:= false) ->
+ do_write_ets_file(ID, File, []).
+
+do_write_ets_file(ID, File, Options) ->
+ TmpFile = File ++ ".tmp",
+ case ets:tab2file(ID, TmpFile, Options) of
+ ok ->
+ case file:rename(TmpFile, File) of
+ ok ->
+ ok;
+ Else ->
+ user_err("Warning: could not move file ~p"
+ " (~p)", [File, Else])
+ end;
+ {error, Reason} ->
+ user_err("Warning: could not save file ~p (~p)",
+ [File, Reason])
+ end.
+
+
+%%----------------------------------------------------------------------
+
+user_err(F, A) ->
+ snmpa_error:user_err(F, A).
diff --git a/lib/snmp/src/agent/snmpa_mib_storage_mnesia.erl b/lib/snmp/src/agent/snmpa_mib_storage_mnesia.erl
new file mode 100644
index 0000000000..192b5aa26e
--- /dev/null
+++ b/lib/snmp/src/agent/snmpa_mib_storage_mnesia.erl
@@ -0,0 +1,302 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2013-2013. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(snmpa_mib_storage_mnesia).
+
+
+-behaviour(snmpa_mib_storage).
+
+%%%-----------------------------------------------------------------
+%%% This module implements the snmpa_mib_storage behaviour.
+%%% It uses mnesia for storage.
+%%%-----------------------------------------------------------------
+
+-export([
+ open/5,
+ close/1,
+ read/2,
+ write/2,
+ delete/1,
+ delete/2,
+ match_object/2,
+ match_delete/2,
+ tab2list/1,
+ info/1, info/2,
+ sync/1,
+ backup/2
+ ]).
+
+
+-define(VMODULE,"MS-MNESIA").
+-include("snmp_verbosity.hrl").
+
+-record(tab, {id}).
+
+
+%% ---------------------------------------------------------------
+%% open
+%%
+%% Open or create a mnesia table.
+%%
+%% Opts - A list of implementation dependent options
+%% mnesia_open_options() = [mnesia_open_option()]
+%% mnesia_open_option() = {action, keep | clear} |
+%% {nodes, [node()]}
+%%
+%% ---------------------------------------------------------------
+
+open(Name, RecName, Fields, Type, Opts) ->
+ ?vtrace("open ~p table ~p for record ~p",
+ [Type, Name, RecName]),
+ Action = get_action(Opts),
+ Nodes = get_nodes(Opts),
+ case table_exists(Name) of
+ true when (Action =:= keep) ->
+ ?vtrace("open table ~p - exist (keep)", [Name]),
+ {ok, #tab{id = Name}};
+ true when (Action =:= clear) ->
+ ?vtrace("open table ~p - exist (clear)", [Name]),
+ F = fun() -> mnesia:clear_table(Name) end,
+ case mnesia:transaction(F) of
+ {aborted, Reason} ->
+ {error, {clear, Reason}};
+ {atomic, _} ->
+ {ok, #tab{id = Name}}
+ end;
+ false ->
+ ?vtrace("open table ~p - does not exist", [Name]),
+ Args = [{record_name, RecName},
+ {attributes, Fields},
+ {type, Type},
+ {disc_copies, Nodes}],
+ case mnesia:create_table(Name, Args) of
+ {atomic, ok} ->
+ ?vtrace("open table ~p - ok", [Name]),
+ {ok, #tab{id = Name}};
+ {aborted, Reason} ->
+ ?vinfo("open table ~p - aborted"
+ "~n Reason: ~p", [Name, Reason]),
+ {error, {create, Reason}}
+ end
+ end.
+
+table_exists(Name) ->
+ case (catch mnesia:table_info(Name, type)) of
+ {'EXIT', _Reason} ->
+ false;
+ _ ->
+ true
+ end.
+
+
+%% ---------------------------------------------------------------
+%% close
+%%
+%% Close the mib-storage table.
+%% This does nothing in the mnesia case.
+%% ---------------------------------------------------------------
+
+close(_) ->
+ ?vtrace("close mib-storage - ignore",[]),
+ ok.
+
+
+%% ---------------------------------------------------------------
+%% read
+%%
+%% Retrieve a record from the mib-storage table.
+%% ---------------------------------------------------------------
+
+read(#tab{id = ID}, Key) ->
+ ?vtrace("read (dirty) from database ~p: ~p", [ID, Key]),
+ case (catch mnesia:dirty_read(ID, Key)) of
+ [Rec|_] -> {value,Rec};
+ _ -> false
+ end.
+
+
+%% ---------------------------------------------------------------
+%% write
+%%
+%% Write a record to the mib-storage table.
+%% ---------------------------------------------------------------
+
+write(#tab{id = ID}, Rec) ->
+ ?vtrace("write to database ~p", [ID]),
+ F = fun() -> mnesia:write(ID, Rec, write) end,
+ case mnesia:transaction(F) of
+ {aborted, _Reason} = ABORTED ->
+ {error, ABORTED};
+ {atomic,_} ->
+ ok
+ end.
+
+
+%% ---------------------------------------------------------------
+%% delete
+%%
+%% Delete the mib-storage table.
+%% ---------------------------------------------------------------
+
+delete(#tab{id = ID}) ->
+ ?vtrace("delete database: ~p", [ID]),
+ mnesia:delete_table(ID).
+
+
+%% ---------------------------------------------------------------
+%% delete
+%%
+%% Delete a record from the mib-storage table.
+%% ---------------------------------------------------------------
+
+delete(#tab{id = ID}, Key) ->
+ ?vtrace("delete from database ~p: ~p", [ID, Key]),
+ F = fun() -> mnesia:delete(ID, Key, write) end,
+ case mnesia:transaction(F) of
+ {aborted, _Reason} = ABORTED ->
+ {error, ABORTED};
+ {atomic, _} ->
+ ok
+ end.
+
+
+%% ---------------------------------------------------------------
+%% match_object
+%%
+%% Search the mib-storage table for records witch matches
+%% the pattern.
+%% ---------------------------------------------------------------
+
+match_object(#tab{id = ID}, Pattern) ->
+ ?vtrace("match_object in ~p of ~p", [ID, Pattern]),
+ F = fun() -> mnesia:match_object(ID, Pattern, read) end,
+ case mnesia:transaction(F) of
+ {aborted, _Reason} = ABORTED ->
+ {error, ABORTED};
+ {atomic, Rs} ->
+ Rs
+ end.
+
+
+%% ---------------------------------------------------------------
+%% match_delete
+%%
+%% Search the mib-storage table for records witch matches
+%% the pattern and deletes them from the table.
+%% ---------------------------------------------------------------
+
+match_delete(#tab{id = ID}, Pattern) ->
+ ?vtrace("match_delete in ~p with pattern ~p", [ID, Pattern]),
+ F = fun() ->
+ Recs = mnesia:match_object(ID, Pattern, read),
+ lists:foreach(fun(Rec) ->
+ mnesia:delete_object(ID, Rec, write)
+ end, Recs),
+ Recs
+ end,
+ case mnesia:transaction(F) of
+ {aborted, _Reason} = ABORTED ->
+ {error, ABORTED};
+ {atomic, Rs} ->
+ Rs
+ end.
+
+
+%% ---------------------------------------------------------------
+%% tab2list
+%%
+%% Return all records in the mib-storage table in the form of
+%% a list.
+%% ---------------------------------------------------------------
+
+tab2list(#tab{id = ID} = Tab) ->
+ ?vtrace("tab2list -> list of ~p", [ID]),
+ match_object(Tab, mnesia:table_info(ID, wild_pattern)).
+
+
+%% ---------------------------------------------------------------
+%% info
+%%
+%% Retrieve implementation dependent mib-storage table
+%% information.
+%% ---------------------------------------------------------------
+
+info(#tab{id = ID}) ->
+ case (catch mnesia:table_info(ID, all)) of
+ Info when is_list(Info) ->
+ Info;
+ {'EXIT', {aborted, Reason}} ->
+ {error, Reason}
+ end.
+
+
+info(#tab{id = ID}, Item) ->
+ mnesia:table_info(ID, Item).
+
+
+%% ---------------------------------------------------------------
+%% sync
+%%
+%% Ignore
+%% ---------------------------------------------------------------
+
+sync(_) ->
+ ok.
+
+
+%% ---------------------------------------------------------------
+%% backup
+%%
+%% Ignore. Mnesia handles its own backups.
+%% ---------------------------------------------------------------
+
+backup(_, _) ->
+ ok.
+
+
+%%----------------------------------------------------------------------
+
+get_action(Opts) ->
+ snmp_misc:get_option(action, Opts, keep).
+
+get_nodes(Opts) ->
+ case snmp_misc:get_option(nodes, Opts, erlang:nodes()) of
+ [] ->
+ [node()];
+ Nodes when is_list(Nodes) ->
+ Nodes;
+ all ->
+ erlang:nodes();
+ visible ->
+ erlang:nodes(visible);
+ connected ->
+ erlang:nodes(connected);
+ db_nodes ->
+ try mnesia:system_info(db_nodes) of
+ DbNodes when is_list(DbNodes) ->
+ DbNodes;
+ _ ->
+ erlang:nodes()
+ catch
+ _:_ ->
+ erlang:nodes()
+ end
+ end.
+
+%% user_err(F, A) ->
+%% snmpa_error:user_err(F, A).
diff --git a/lib/snmp/src/agent/snmpa_supervisor.erl b/lib/snmp/src/agent/snmpa_supervisor.erl
index 886fd074bc..aebcdbaa84 100644
--- a/lib/snmp/src/agent/snmpa_supervisor.erl
+++ b/lib/snmp/src/agent/snmpa_supervisor.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2012. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -224,26 +224,101 @@ init([AgentType, Opts]) ->
ets:insert(snmp_agent_table, {error_report_mod, ErrorReportMod}),
%% -- mib storage --
+ %% MibStorage has only one mandatory part: module
+ %% Everything else is module dependent and therefor
+ %% put in a special option: options
MibStorage =
- case get_opt(mib_storage, Opts, ets) of
+ case get_opt(mib_storage, Opts, [{module, snmpa_mib_storage_ets}]) of
+
+ %% --- ETS wrappers ---
+
+ ets ->
+ [{module, snmpa_mib_storage_ets}];
+ {ets, default} ->
+ [{module, snmpa_mib_storage_ets},
+ {options, [{dir, filename:join([DbDir])},
+ {action, keep}]}];
+ {ets, Dir} when is_list(Dir) ->
+ [{module, snmpa_mib_storage_ets},
+ {options, [{dir, filename:join([Dir])},
+ {action, keep}]}];
+ {ets, default, Action} when ((Action =:= keep) orelse
+ (Action =:= clear)) ->
+ [{module, snmpa_mib_storage_ets},
+ {options, [{dir, filename:join([DbDir])},
+ {action, Action}]}];
+ {ets, Dir, Action} when is_list(Dir) andalso
+ ((Action =:= keep) orelse
+ (Action =:= clear)) ->
+ [{module, snmpa_mib_storage_ets},
+ {options, [{dir, filename:join([Dir])},
+ {action, Action}]}];
+
+ %% --- DETS wrappers ---
+
dets ->
- {dets, DbDir};
+ [{module, snmpa_mib_storage_dets},
+ {options, [{dir, filename:join([DbDir])},
+ {action, keep}]}];
{dets, default} ->
- {dets, DbDir};
- {dets, default, Act} ->
- {dets, DbDir, Act};
- {ets, default} ->
- {ets, DbDir};
+ [{module, snmpa_mib_storage_dets},
+ {options, [{dir, filename:join([DbDir])},
+ {action, keep}]}];
+ {dets, default, Action} when ((Action =:= keep) orelse
+ (Action =:= clear)) ->
+ [{module, snmpa_mib_storage_dets},
+ {options, [{dir, filename:join([DbDir])},
+ {action, Action}]}];
+ {dets, Dir, Action} when is_list(Dir) andalso
+ ((Action =:= keep) orelse
+ (Action =:= clear)) ->
+ [{module, snmpa_mib_storage_dets},
+ {options, [{dir, filename:join([Dir])},
+ {action, Action}]}];
+
+ %% --- Mnesia wrappers ---
+
mnesia ->
- {mnesia, erlang:nodes()};
- {mnesia, visible} ->
- {mnesia, erlang:nodes(visible)};
- {mnesia, connected} ->
- {mnesia, erlang:nodes(connected)};
- Other ->
+ [{module, snmpa_mib_storage_mnesia},
+ {options, [{nodes, erlang:nodes()},
+ {action, keep}]}];
+ {mnesia, Nodes0} ->
+ Nodes =
+ if
+ Nodes0 =:= visible ->
+ erlang:nodes(visible);
+ Nodes0 =:= connected ->
+ erlang:nodes(connected);
+ Nodes0 =:= [] ->
+ [node()];
+ true ->
+ Nodes0
+ end,
+ [{module, snmpa_mib_storage_mnesia},
+ {options, [{nodes, Nodes},
+ {action, keep}]}];
+ {mnesia, Nodes0, Action} when ((Action =:= keep) orelse
+ (Action =:= clear)) ->
+ Nodes =
+ if
+ Nodes0 =:= visible ->
+ erlang:nodes(visible);
+ Nodes0 =:= connected ->
+ erlang:nodes(connected);
+ Nodes0 =:= [] ->
+ [node()];
+ true ->
+ Nodes0
+ end,
+ [{module, snmpa_mib_storage_mnesia},
+ {options, [{nodes, Nodes},
+ {action, Action}]}];
+
+ Other when is_list(Other) ->
Other
end,
- ?vdebug("[agent table] store mib storage: ~w",[MibStorage]),
+
+ ?vdebug("[agent table] store mib storage: ~w", [MibStorage]),
ets:insert(snmp_agent_table, {mib_storage, MibStorage}),
%% -- Agent mib storage --
@@ -388,7 +463,7 @@ init([AgentType, Opts]) ->
AgentSpec =
worker_spec(snmpa_agent,
- [Prio,snmp_master_agent,none,Ref,AgentOpts],
+ [Prio, snmp_master_agent, none, Ref, AgentOpts],
Restart, 15000),
AgentSupSpec =
sup_spec(snmpa_agent_sup, [AgentSpec],
diff --git a/lib/snmp/src/agent/snmpa_symbolic_store.erl b/lib/snmp/src/agent/snmpa_symbolic_store.erl
index 6c58ffde41..00178f4bcd 100644
--- a/lib/snmp/src/agent/snmpa_symbolic_store.erl
+++ b/lib/snmp/src/agent/snmpa_symbolic_store.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -78,7 +78,7 @@
gen_server:start_link({local, ?SERVER}, ?MODULE, [Prio, Opts], [])).
-endif.
--record(state, {db, backup}).
+-record(state, {module, db, backup}).
-record(symbol, {key, mib_name, info}).
@@ -112,6 +112,9 @@ backup(BackupDir) ->
get_db() ->
call(get_db).
+which_module() ->
+ call(which_module).
+
%%----------------------------------------------------------------------
%% Returns: {value, Oid} | false
@@ -202,49 +205,63 @@ verbosity(Verbosity) ->
%%----------------------------------------------------------------------
%% DB access (read) functions: Returns: {value, Oid} | false
%%----------------------------------------------------------------------
+
aliasname_to_oid(Db, Aliasname) ->
- case snmpa_general_db:read(Db, {alias, Aliasname}) of
+ Mod = which_module(),
+ aliasname_to_oid(Mod, Db, Aliasname).
+
+aliasname_to_oid(Mod, Db, Aliasname) ->
+ case Mod:read(Db, {alias, Aliasname}) of
{value,#symbol{info = {Oid, _Enums}}} -> {value, Oid};
false -> false
end.
-oid_to_aliasname(Db,Oid) ->
- case snmpa_general_db:read(Db, {oid, Oid}) of
+oid_to_aliasname(Db, Oid) ->
+ Mod = which_module(),
+ oid_to_aliasname(Mod, Db, Oid).
+
+oid_to_aliasname(Mod, Db, Oid) ->
+ case Mod:read(Db, {oid, Oid}) of
{value,#symbol{info = Aliasname}} -> {value, Aliasname};
_ -> false
end.
-which_notifications(Db) ->
+which_notifications(Mod, Db) ->
Pattern = #symbol{key = {trap, '_'}, _ = '_'},
- Symbols = snmpa_general_db:match_object(Db, Pattern),
+ Symbols = Mod:match_object(Db, Pattern),
[{Name, Mib, Rec} || #symbol{key = {trap, Name},
mib_name = Mib,
info = Rec} <- Symbols].
-which_aliasnames(Db) ->
+which_aliasnames(Mod, Db) ->
Pattern = #symbol{key = {alias, '_'}, _ = '_'},
- Symbols = snmpa_general_db:match_object(Db, Pattern),
+ Symbols = Mod:match_object(Db, Pattern),
[Alias || #symbol{key = {alias, Alias}} <- Symbols].
-which_tables(Db) ->
+which_tables(Mod, Db) ->
Pattern = #symbol{key = {table_info, '_'}, _ = '_'},
- Symbols = snmpa_general_db:match_object(Db, Pattern),
+ Symbols = Mod:match_object(Db, Pattern),
[Name || #symbol{key = {table_info, Name}} <- Symbols].
-which_variables(Db) ->
+which_variables(Mod, Db) ->
Pattern = #symbol{key = {variable_info, '_'}, _ = '_'},
- Symbols = snmpa_general_db:match_object(Db, Pattern),
+ Symbols = Mod:match_object(Db, Pattern),
[Name || #symbol{key = {variable_info, Name}} <- Symbols].
-int_to_enum(Db,TypeOrObjName,Int) ->
- case snmpa_general_db:read(Db, {alias, TypeOrObjName}) of
+
+int_to_enum(Db, TypeOrObjName, Int) ->
+ Mod = which_module(),
+ int_to_enum(Mod, Db, TypeOrObjName, Int).
+
+int_to_enum(Mod, Db, TypeOrObjName, Int) ->
+ case Mod:read(Db, {alias, TypeOrObjName}) of
{value,#symbol{info = {_Oid, Enums}}} ->
case lists:keysearch(Int, 2, Enums) of
{value, {Enum, _Int}} -> {value, Enum};
false -> false
end;
false -> % Not an Aliasname ->
- case snmpa_general_db:read(Db, {type, TypeOrObjName}) of
+ case Mod:read(Db, {type, TypeOrObjName}) of
{value,#symbol{info = Enums}} ->
case lists:keysearch(Int, 2, Enums) of
{value, {Enum, _Int}} -> {value, Enum};
@@ -256,14 +273,18 @@ int_to_enum(Db,TypeOrObjName,Int) ->
end.
enum_to_int(Db, TypeOrObjName, Enum) ->
- case snmpa_general_db:read(Db, {alias, TypeOrObjName}) of
+ Mod = which_module(),
+ enum_to_int(Mod, Db, TypeOrObjName, Enum).
+
+enum_to_int(Mod, Db, TypeOrObjName, Enum) ->
+ case Mod:read(Db, {alias, TypeOrObjName}) of
{value,#symbol{info = {_Oid, Enums}}} ->
case lists:keysearch(Enum, 1, Enums) of
{value, {_Enum, Int}} -> {value, Int};
false -> false
end;
false -> % Not an Aliasname
- case snmpa_general_db:read(Db, {type, TypeOrObjName}) of
+ case Mod:read(Db, {type, TypeOrObjName}) of
{value,#symbol{info = Enums}} ->
case lists:keysearch(Enum, 1, Enums) of
{value, {_Enum, Int}} -> {value, Int};
@@ -278,8 +299,9 @@ enum_to_int(Db, TypeOrObjName, Enum) ->
%%----------------------------------------------------------------------
%% DB access (read) functions: Returns: false|{value, Info}
%%----------------------------------------------------------------------
-table_info(Db,TableName) ->
- case snmpa_general_db:read(Db, {table_info, TableName}) of
+
+table_info(Mod, Db, TableName) ->
+ case Mod:read(Db, {table_info, TableName}) of
{value,#symbol{info = Info}} -> {value, Info};
false -> false
end.
@@ -288,8 +310,8 @@ table_info(Db,TableName) ->
%%----------------------------------------------------------------------
%% DB access (read) functions: Returns: false|{value, Info}
%%----------------------------------------------------------------------
-variable_info(Db,VariableName) ->
- case snmpa_general_db:read(Db, {variable_info, VariableName}) of
+variable_info(Mod, Db, VariableName) ->
+ case Mod:read(Db, {variable_info, VariableName}) of
{value,#symbol{info = Info}} -> {value, Info};
false -> false
end.
@@ -299,7 +321,7 @@ variable_info(Db,VariableName) ->
%% Implementation
%%----------------------------------------------------------------------
-init([Prio,Opts]) ->
+init([Prio, Opts]) ->
?d("init -> entry with"
"~n Prio: ~p"
"~n Opts: ~p", [Prio,Opts]),
@@ -317,102 +339,125 @@ do_init(Prio, Opts) ->
put(sname,ss),
put(verbosity,get_verbosity(Opts)),
?vlog("starting",[]),
- Storage = get_mib_storage(Opts),
+ MibStorage = get_mib_storage(Opts),
+ Mod = snmp_misc:get_option(module, MibStorage),
+ MsOpts = snmp_misc:get_option(options, MibStorage, []),
+
%% type = bag solves the problem with import and multiple
%% object/type definitions.
- Db = snmpa_general_db:open(Storage, snmpa_symbolic_store,
- symbol, record_info(fields,symbol), bag),
- S = #state{db = Db},
- ?vdebug("started",[]),
- {ok, S}.
+ case Mod:open(?MODULE, symbol, record_info(fields, symbol), bag, MsOpts) of
+ {ok, Db} ->
+ S = #state{module = Mod, db = Db},
+ ?vdebug("started",[]),
+ {ok, S};
+ {error, _} = ERROR ->
+ ERROR
+ end.
handle_call(get_db, _From, #state{db = DB} = S) ->
?vlog("get db",[]),
{reply, DB, S};
-handle_call({table_info, TableName}, _From, #state{db = DB} = S) ->
+handle_call(which_module, _From, #state{module = Mod} = S) ->
+ ?vlog("which module",[]),
+ {reply, Mod, S};
+
+handle_call({table_info, TableName}, _From,
+ #state{module = Mod, db = DB} = S) ->
?vlog("table info: ~p",[TableName]),
- Res = table_info(DB, TableName),
+ Res = table_info(Mod, DB, TableName),
?vdebug("table info result: ~p",[Res]),
{reply, Res, S};
-handle_call({variable_info, VariableName}, _From, #state{db = DB} = S) ->
+handle_call({variable_info, VariableName}, _From,
+ #state{module = Mod, db = DB} = S) ->
?vlog("variable info: ~p",[VariableName]),
- Res = variable_info(DB, VariableName),
+ Res = variable_info(Mod, DB, VariableName),
?vdebug("variable info result: ~p",[Res]),
{reply, Res, S};
-handle_call({aliasname_to_oid, Aliasname}, _From, #state{db = DB} = S) ->
+handle_call({aliasname_to_oid, Aliasname}, _From,
+ #state{module = Mod, db = DB} = S) ->
?vlog("aliasname to oid: ~p",[Aliasname]),
- Res = aliasname_to_oid(DB,Aliasname),
+ Res = aliasname_to_oid(Mod, DB, Aliasname),
?vdebug("aliasname to oid result: ~p",[Res]),
{reply, Res, S};
-handle_call({oid_to_aliasname, Oid}, _From, #state{db = DB} = S) ->
+handle_call({oid_to_aliasname, Oid}, _From,
+ #state{module = Mod, db = DB} = S) ->
?vlog("oid to aliasname: ~p",[Oid]),
- Res = oid_to_aliasname(DB, Oid),
+ Res = oid_to_aliasname(Mod, DB, Oid),
?vdebug("oid to aliasname result: ~p",[Res]),
{reply, Res, S};
-handle_call(which_aliasnames, _From, #state{db = DB} = S) ->
+handle_call(which_aliasnames, _From,
+ #state{module = Mod, db = DB} = S) ->
?vlog("which aliasnames",[]),
- Res = which_aliasnames(DB),
+ Res = which_aliasnames(Mod, DB),
?vdebug("which aliasnames: ~p",[Res]),
{reply, Res, S};
-handle_call(which_tables, _From, #state{db = DB} = S) ->
+handle_call(which_tables, _From,
+ #state{module = Mod, db = DB} = S) ->
?vlog("which tables",[]),
- Res = which_tables(DB),
+ Res = which_tables(Mod, DB),
?vdebug("which tables: ~p",[Res]),
{reply, Res, S};
-handle_call(which_variables, _From, #state{db = DB} = S) ->
+handle_call(which_variables, _From,
+ #state{module = Mod, db = DB} = S) ->
?vlog("which variables",[]),
- Res = which_variables(DB),
+ Res = which_variables(Mod, DB),
?vdebug("which variables: ~p",[Res]),
{reply, Res, S};
-handle_call({enum_to_int, TypeOrObjName, Enum}, _From, #state{db = DB} = S) ->
+handle_call({enum_to_int, TypeOrObjName, Enum}, _From,
+ #state{module = Mod, db = DB} = S) ->
?vlog("enum to int: ~p, ~p",[TypeOrObjName,Enum]),
- Res = enum_to_int(DB, TypeOrObjName, Enum),
+ Res = enum_to_int(Mod, DB, TypeOrObjName, Enum),
?vdebug("enum to int result: ~p",[Res]),
{reply, Res, S};
-handle_call({int_to_enum, TypeOrObjName, Int}, _From, #state{db = DB} = S) ->
+handle_call({int_to_enum, TypeOrObjName, Int}, _From,
+ #state{module = Mod, db = DB} = S) ->
?vlog("int to enum: ~p, ~p",[TypeOrObjName,Int]),
- Res = int_to_enum(DB, TypeOrObjName, Int),
+ Res = int_to_enum(Mod, DB, TypeOrObjName, Int),
?vdebug("int to enum result: ~p",[Res]),
{reply, Res, S};
-handle_call({set_notification, MibName, Trap}, _From, #state{db = DB} = S) ->
+handle_call({set_notification, MibName, Trap}, _From,
+ #state{module = Mod, db = DB} = S) ->
?vlog("set notification:"
"~n ~p~n ~p", [MibName,Trap]),
- set_notif(DB, MibName, Trap),
+ set_notif(Mod, DB, MibName, Trap),
{reply, true, S};
-handle_call({delete_notifications, MibName}, _From, #state{db = DB} = S) ->
+handle_call({delete_notifications, MibName}, _From,
+ #state{module = Mod, db = DB} = S) ->
?vlog("delete notification: ~p",[MibName]),
- delete_notif(DB, MibName),
+ delete_notif(Mod, DB, MibName),
{reply, true, S};
-handle_call(which_notifications, _From, #state{db = DB} = S) ->
+handle_call(which_notifications, _From,
+ #state{module = Mod, db = DB} = S) ->
?vlog("which notifications", []),
- Reply = which_notifications(DB),
+ Reply = which_notifications(Mod, DB),
{reply, Reply, S};
-handle_call({get_notification, Key}, _From, #state{db = DB} = S) ->
+handle_call({get_notification, Key}, _From,
+ #state{module = Mod, db = DB} = S) ->
?vlog("get notification: ~p",[Key]),
- Res = get_notif(DB, Key),
+ Res = get_notif(Mod, DB, Key),
?vdebug("get notification result: ~p",[Res]),
{reply, Res, S};
-handle_call(info, _From, #state{db = DB} = S) ->
+handle_call(info, _From, #state{module = Mod, db = DB} = S) ->
?vlog("info",[]),
- Info = get_info(DB),
+ Info = get_info(Mod, DB),
{reply, Info, S};
-handle_call({backup, BackupDir}, From, #state{db = DB} = S) ->
+handle_call({backup, BackupDir}, From, #state{module = Mod, db = DB} = S) ->
?vlog("info to ~p",[BackupDir]),
Pid = self(),
V = get(verbosity),
@@ -424,7 +469,7 @@ handle_call({backup, BackupDir}, From, #state{db = DB} = S) ->
put(sname, albs),
put(verbosity, V),
Dir = filename:join([BackupDir]),
- Reply = snmpa_general_db:backup(DB, Dir),
+ Reply = Mod:backup(DB, Dir),
Pid ! {backup_done, Reply},
unlink(Pid)
end),
@@ -446,7 +491,7 @@ handle_call(Req, _From, S) ->
{reply, Reply, S}.
-handle_cast({add_types, MibName, Types}, #state{db = DB} = S) ->
+handle_cast({add_types, MibName, Types}, #state{module = Mod, db = DB} = S) ->
?vlog("add types for ~p:",[MibName]),
F = fun(#asn1_type{assocList = Alist, aliasname = Name}) ->
case snmp_misc:assq(enums, Alist) of
@@ -455,20 +500,21 @@ handle_cast({add_types, MibName, Types}, #state{db = DB} = S) ->
Rec = #symbol{key = {type, Name},
mib_name = MibName,
info = Es},
- snmpa_general_db:write(DB, Rec);
+ Mod:write(DB, Rec);
false -> done
end
end,
lists:foreach(F, Types),
{noreply, S};
-handle_cast({delete_types, MibName}, #state{db = DB} = S) ->
+handle_cast({delete_types, MibName}, #state{module = Mod, db = DB} = S) ->
?vlog("delete types: ~p",[MibName]),
Pattern = #symbol{key = {type, '_'}, mib_name = MibName, info = '_'},
- snmpa_general_db:match_delete(DB, Pattern),
+ Mod:match_delete(DB, Pattern),
{noreply, S};
-handle_cast({add_aliasnames, MibName, MEs}, #state{db = DB} = S) ->
+handle_cast({add_aliasnames, MibName, MEs},
+ #state{module = Mod, db = DB} = S) ->
?vlog("add aliasnames for ~p:",[MibName]),
F = fun(#me{aliasname = AN, oid = Oid, asn1_type = AT}) ->
Enums =
@@ -480,20 +526,21 @@ handle_cast({add_aliasnames, MibName, MEs}, #state{db = DB} = S) ->
end;
_ -> []
end,
- write_alias(AN, DB, Enums, MibName, Oid)
+ write_alias(Mod, AN, DB, Enums, MibName, Oid)
end,
lists:foreach(F, MEs),
{noreply, S};
-handle_cast({delete_aliasname, MibName}, #state{db = DB} = S) ->
+handle_cast({delete_aliasname, MibName}, #state{module = Mod, db = DB} = S) ->
?vlog("delete aliasname: ~p",[MibName]),
Pattern1 = #symbol{key = {alias, '_'}, mib_name = MibName, info = '_'},
- snmpa_general_db:match_delete(DB, Pattern1),
+ Mod:match_delete(DB, Pattern1),
Pattern2 = #symbol{key = {oid, '_'}, mib_name = MibName, info = '_'},
- snmpa_general_db:match_delete(DB, Pattern2),
+ Mod:match_delete(DB, Pattern2),
{noreply, S};
-handle_cast({add_table_infos, MibName, TableInfos}, #state{db = DB} = S) ->
+handle_cast({add_table_infos, MibName, TableInfos},
+ #state{module = Mod, db = DB} = S) ->
?vlog("add table infos for ~p:",[MibName]),
F = fun({Name, TableInfo}) ->
?vlog("add table info~n ~p -> ~p",
@@ -501,19 +548,20 @@ handle_cast({add_table_infos, MibName, TableInfos}, #state{db = DB} = S) ->
Rec = #symbol{key = {table_info, Name},
mib_name = MibName,
info = TableInfo},
- snmpa_general_db:write(DB, Rec)
+ Mod:write(DB, Rec)
end,
lists:foreach(F, TableInfos),
{noreply, S};
-handle_cast({delete_table_infos, MibName}, #state{db = DB} = S) ->
+handle_cast({delete_table_infos, MibName},
+ #state{module = Mod, db = DB} = S) ->
?vlog("delete table infos: ~p",[MibName]),
Pattern = #symbol{key = {table_info, '_'}, mib_name = MibName, info = '_'},
- snmpa_general_db:match_delete(DB, Pattern),
+ Mod:match_delete(DB, Pattern),
{noreply, S};
handle_cast({add_variable_infos, MibName, VariableInfos},
- #state{db = DB} = S) ->
+ #state{module = Mod, db = DB} = S) ->
?vlog("add variable infos for ~p:",[MibName]),
F = fun({Name, VariableInfo}) ->
?vlog("add variable info~n ~p -> ~p",
@@ -521,17 +569,18 @@ handle_cast({add_variable_infos, MibName, VariableInfos},
Rec = #symbol{key = {variable_info, Name},
mib_name = MibName,
info = VariableInfo},
- snmpa_general_db:write(DB, Rec)
+ Mod:write(DB, Rec)
end,
lists:foreach(F, VariableInfos),
{noreply, S};
-handle_cast({delete_variable_infos, MibName}, #state{db = DB} = S) ->
+handle_cast({delete_variable_infos, MibName},
+ #state{module = Mod, db = DB} = S) ->
?vlog("delete variable infos: ~p",[MibName]),
Pattern = #symbol{key = {variable_info,'_'},
mib_name = MibName,
info = '_'},
- snmpa_general_db:match_delete(DB, Pattern),
+ Mod:match_delete(DB, Pattern),
{noreply, S};
handle_cast({verbosity,Verbosity}, State) ->
@@ -565,9 +614,9 @@ handle_info(Info, S) ->
{noreply, S}.
-terminate(Reason, S) ->
- ?vlog("terminate: ~p",[Reason]),
- snmpa_general_db:close(S#state.db).
+terminate(Reason, #state{module = Mod, db = DB}) ->
+ ?vlog("terminate: ~p", [Reason]),
+ Mod:close(DB).
%%----------------------------------------------------------
@@ -575,18 +624,18 @@ terminate(Reason, S) ->
%%----------------------------------------------------------
% downgrade
-code_change({down, _Vsn}, #state{db = DB, backup = B}, downgrade_to_pre_4_7) ->
- ?d("code_change(down) -> entry", []),
- stop_backup_server(B),
- S = {state, DB},
- {ok, S};
-
-% upgrade
-code_change(_Vsn, S, upgrade_from_pre_4_7) ->
- ?d("code_change(up) -> entry", []),
- {state, DB} = S,
- S1 = #state{db = DB},
- {ok, S1};
+%% code_change({down, _Vsn}, #state{db = DB, backup = B}, downgrade_to_pre_4_7) ->
+%% ?d("code_change(down) -> entry", []),
+%% stop_backup_server(B),
+%% S = {state, DB},
+%% {ok, S};
+
+%% % upgrade
+%% code_change(_Vsn, S, upgrade_from_pre_4_7) ->
+%% ?d("code_change(up) -> entry", []),
+%% {state, DB} = S,
+%% S1 = #state{db = DB},
+%% {ok, S1};
code_change(_Vsn, S, _Extra) ->
?d("code_change -> entry [do nothing]", []),
@@ -609,13 +658,13 @@ stop_backup_server({Pid, _}) when is_pid(Pid) ->
%%-----------------------------------------------------------------
%% Returns: {value, Value} | undefined
%%-----------------------------------------------------------------
-get_notif(Db, Key) ->
- case snmpa_general_db:read(Db, {trap, Key}) of
+get_notif(Mod, Db, Key) ->
+ case Mod:read(Db, {trap, Key}) of
{value,#symbol{info = Value}} -> {value, Value};
false -> undefined
end.
-set_notif(Db, MibName, Trap) when is_record(Trap, trap) ->
+set_notif(Mod, Db, MibName, Trap) when is_record(Trap, trap) ->
#trap{trapname = Name} = Trap,
Rec = #symbol{key = {trap, Name}, mib_name = MibName, info = Trap},
%% convert old v1 trap to oid
@@ -625,40 +674,41 @@ set_notif(Db, MibName, Trap) when is_record(Trap, trap) ->
Oid0 ->
Oid0 ++ [0, Trap#trap.specificcode]
end,
- write_alias(Name, Db, MibName, Oid),
- snmpa_general_db:write(Db, Rec);
-set_notif(Db, MibName, Trap) ->
+ write_alias(Mod, Name, Db, MibName, Oid),
+ Mod:write(Db, Rec);
+set_notif(Mod, Db, MibName, Trap) ->
#notification{trapname = Name, oid = Oid} = Trap,
Rec = #symbol{key = {trap, Name}, mib_name = MibName, info = Trap},
- write_alias(Name, Db, MibName, Oid),
- snmpa_general_db:write(Db, Rec).
+ write_alias(Mod, Name, Db, MibName, Oid),
+ Mod:write(Db, Rec).
-delete_notif(Db, MibName) ->
+delete_notif(Mod, Db, MibName) ->
Pattern = #symbol{key = {trap, '_'}, mib_name = MibName, info = '_'},
- snmpa_general_db:match_delete(Db, Pattern).
+ Mod:match_delete(Db, Pattern).
-write_alias(AN, DB, MibName, Oid) ->
- write_alias(AN, DB, [], MibName, Oid).
+write_alias(Mod, AN, DB, MibName, Oid) ->
+ write_alias(Mod, AN, DB, [], MibName, Oid).
-write_alias(AN, DB, Enums, MibName, Oid) ->
+write_alias(Mod, AN, DB, Enums, MibName, Oid) ->
?vlog("add alias~n ~p -> {~p,~p}",[AN, Oid, Enums]),
Rec1 = #symbol{key = {alias, AN},
mib_name = MibName,
info = {Oid,Enums}},
- snmpa_general_db:write(DB, Rec1),
+ Mod:write(DB, Rec1),
?vlog("add oid~n ~p -> ~p",[Oid, AN]),
Rec2 = #symbol{key = {oid, Oid},
mib_name = MibName,
info = AN},
- snmpa_general_db:write(DB, Rec2).
+ Mod:write(DB, Rec2).
+
%% -------------------------------------
-get_info(DB) ->
+get_info(Mod, DB) ->
ProcSize = proc_mem(self()),
- DbSz = tab_size(DB),
- [{process_memory, ProcSize}, {db_memory, DbSz}].
+ DbMemory = Mod:info(DB, memory),
+ [{process_memory, ProcSize}, {db_memory, DbMemory}].
proc_mem(P) when is_pid(P) ->
case (catch erlang:process_info(P, memory)) of
@@ -667,26 +717,15 @@ proc_mem(P) when is_pid(P) ->
_ ->
undefined
end.
-%% proc_mem(_) ->
-%% undefined.
-
-tab_size(DB) ->
- case (catch snmpa_general_db:info(DB, memory)) of
- Sz when is_integer(Sz) ->
- Sz;
- _ ->
- undefined
- end.
-
%% -------------------------------------
get_verbosity(L) ->
- snmp_misc:get_option(verbosity,L,?default_verbosity).
+ snmp_misc:get_option(verbosity, L, ?default_verbosity).
get_mib_storage(L) ->
- snmp_misc:get_option(mib_storage,L,ets).
+ snmp_misc:get_option(mib_storage, L).
%% -------------------------------------
diff --git a/lib/snmp/src/app/snmp.app.src b/lib/snmp/src/app/snmp.app.src
index b11c1ef934..904d17954b 100644
--- a/lib/snmp/src/app/snmp.app.src
+++ b/lib/snmp/src/app/snmp.app.src
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2012. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -48,11 +48,15 @@
snmpa_error_io,
snmpa_error_logger,
snmpa_error_report,
- snmpa_general_db,
snmpa_local_db,
snmpa_mib,
snmpa_mib_data,
+ snmpa_mib_data_tttn,
snmpa_mib_lib,
+ snmpa_mib_storage,
+ snmpa_mib_storage_ets,
+ snmpa_mib_storage_dets,
+ snmpa_mib_storage_mnesia,
snmpa_misc_sup,
snmpa_mpd,
snmpa_net_if,
diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src
index 4c5f14da90..7ffa4a725d 100644
--- a/lib/snmp/src/app/snmp.appup.src
+++ b/lib/snmp/src/app/snmp.appup.src
@@ -22,19 +22,15 @@
%% ----- U p g r a d e -------------------------------------------------------
[
- {"4.23",
- [
- ]
- }
+ {"4.23.1", [{restart_application, snmp}]},
+ {"4.23", [{restart_application, snmp}]}
],
%% ------D o w n g r a d e ---------------------------------------------------
[
- {"4.23",
- [
- ]
- }
+ {"4.23.1", [{restart_application, snmp}]},
+ {"4.23", [{restart_application, snmp}]}
]
}.
diff --git a/lib/snmp/src/app/snmp.erl b/lib/snmp/src/app/snmp.erl
index cd3e3a0055..1bb562654a 100644
--- a/lib/snmp/src/app/snmp.erl
+++ b/lib/snmp/src/app/snmp.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2012. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -90,6 +90,13 @@
]).
+-export_type([
+ oid/0,
+
+ void/0
+ ]).
+
+
%% This is for XREF
-deprecated([{c, 1, eventually},
{c, 2, eventually},
@@ -143,6 +150,15 @@
-define(APPLICATION, snmp).
+
+%%-----------------------------------------------------------------
+%% Types
+%%-----------------------------------------------------------------
+
+-type oid() :: [non_neg_integer()].
+-type void() :: term().
+
+
%%-----------------------------------------------------------------
%% Application
%%-----------------------------------------------------------------
diff --git a/lib/snmp/src/app/snmp_app.erl b/lib/snmp/src/app/snmp_app.erl
index deb42cc373..0cfbb22a5a 100644
--- a/lib/snmp/src/app/snmp_app.erl
+++ b/lib/snmp/src/app/snmp_app.erl
@@ -62,17 +62,17 @@ entities([], []) ->
?d("entities -> converted config: ~n~p", [Conf]),
[{agent, Conf}]
end;
-entities([], E) ->
+entities([], Acc) ->
?d("entities -> done", []),
- lists:reverse(E);
-entities([ET|ETs], E) ->
+ lists:reverse(Acc);
+entities([Ent|Ents], Acc) ->
?d("entities -> entry with"
- "~n ET: ~p", [ET]),
- case application:get_env(snmp, ET) of
+ "~n Ent: ~p", [Ent]),
+ case application:get_env(snmp, Ent) of
{ok, Conf} ->
- entities(ETs, [{ET, Conf}|E]);
+ entities(Ents, [{Ent, Conf}|Acc]);
_ ->
- entities(ETs, E)
+ entities(Ents, Acc)
end.
start_entities(_Type, []) ->
diff --git a/lib/snmp/src/manager/snmpm_config.erl b/lib/snmp/src/manager/snmpm_config.erl
index 5bbf9e5542..9d687f1d31 100644
--- a/lib/snmp/src/manager/snmpm_config.erl
+++ b/lib/snmp/src/manager/snmpm_config.erl
@@ -2028,7 +2028,7 @@ verify_usm_user_auth(usmNoAuthProtocol, AuthKey) ->
end;
verify_usm_user_auth(usmHMACMD5AuthProtocol, AuthKey)
when is_list(AuthKey) andalso (length(AuthKey) =:= 16) ->
- case is_crypto_supported(md5_mac_96) of
+ case is_crypto_supported(md5) of
true ->
case snmp_conf:all_integer(AuthKey) of
true ->
@@ -2037,7 +2037,7 @@ verify_usm_user_auth(usmHMACMD5AuthProtocol, AuthKey)
error({invalid_auth_key, usmHMACMD5AuthProtocol})
end;
false ->
- error({unsupported_crypto, md5_mac_96})
+ error({unsupported_crypto, md5})
end;
verify_usm_user_auth(usmHMACMD5AuthProtocol, AuthKey) when is_list(AuthKey) ->
Len = length(AuthKey),
@@ -2046,7 +2046,7 @@ verify_usm_user_auth(usmHMACMD5AuthProtocol, _AuthKey) ->
error({invalid_auth_key, usmHMACMD5AuthProtocol});
verify_usm_user_auth(usmHMACSHAAuthProtocol, AuthKey)
when is_list(AuthKey) andalso (length(AuthKey) =:= 20) ->
- case is_crypto_supported(sha_mac_96) of
+ case is_crypto_supported(sha) of
true ->
case snmp_conf:all_integer(AuthKey) of
true ->
@@ -2055,7 +2055,7 @@ verify_usm_user_auth(usmHMACSHAAuthProtocol, AuthKey)
error({invalid_auth_key, usmHMACSHAAuthProtocol})
end;
false ->
- error({unsupported_crypto, sha_mac_96})
+ error({unsupported_crypto, sha})
end;
verify_usm_user_auth(usmHMACSHAAuthProtocol, AuthKey) when is_list(AuthKey) ->
Len = length(AuthKey),
@@ -2074,7 +2074,7 @@ verify_usm_user_priv(usmNoPrivProtocol, PrivKey) ->
end;
verify_usm_user_priv(usmDESPrivProtocol, PrivKey)
when (length(PrivKey) =:= 16) ->
- case is_crypto_supported(des_cbc_decrypt) of
+ case is_crypto_supported(des_cbc) of
true ->
case snmp_conf:all_integer(PrivKey) of
true ->
@@ -2083,7 +2083,7 @@ verify_usm_user_priv(usmDESPrivProtocol, PrivKey)
error({invalid_priv_key, usmDESPrivProtocol})
end;
false ->
- error({unsupported_crypto, des_cbc_decrypt})
+ error({unsupported_crypto, des_cbc})
end;
verify_usm_user_priv(usmDESPrivProtocol, PrivKey) when is_list(PrivKey) ->
Len = length(PrivKey),
@@ -2092,7 +2092,7 @@ verify_usm_user_priv(usmDESPrivProtocol, _PrivKey) ->
error({invalid_priv_key, usmDESPrivProtocol});
verify_usm_user_priv(usmAesCfb128Protocol, PrivKey)
when (length(PrivKey) =:= 16) ->
- case is_crypto_supported(aes_cfb_128_decrypt) of
+ case is_crypto_supported(aes_cfb128) of
true ->
case snmp_conf:all_integer(PrivKey) of
true ->
@@ -2101,7 +2101,7 @@ verify_usm_user_priv(usmAesCfb128Protocol, PrivKey)
error({invalid_priv_key, usmAesCfb128Protocol})
end;
false ->
- error({unsupported_crypto, aes_cfb_128_decrypt})
+ error({unsupported_crypto, aes_cfb128})
end;
verify_usm_user_priv(usmAesCfb128Protocol, PrivKey) when is_list(PrivKey) ->
Len = length(PrivKey),
@@ -2111,13 +2111,10 @@ verify_usm_user_priv(usmAesCfb128Protocol, _PrivKey) ->
verify_usm_user_priv(PrivP, _PrivKey) ->
error({invalid_priv_protocol, PrivP}).
+
+-compile({inline, [{is_crypto_supported,1}]}).
is_crypto_supported(Func) ->
- %% The 'catch' handles the case when 'crypto' is
- %% not present in the system (or not started).
- case (catch lists:member(Func, crypto:info())) of
- true -> true;
- _ -> false
- end.
+ snmp_misc:is_crypto_supported(Func).
read_manager_config_file(Dir) ->
@@ -2879,11 +2876,11 @@ do_update_usm_user_info(Key,
#usm_user{auth = usmHMACMD5AuthProtocol} = User,
auth_key, Val)
when length(Val) =:= 16 ->
- case is_crypto_supported(md5_mac_96) of
+ case is_crypto_supported(md5) of
true ->
do_update_usm_user_info(Key, User#usm_user{auth_key = Val});
false ->
- {error, {unsupported_crypto, md5_mac_96}}
+ {error, {unsupported_crypto, md5}}
end;
do_update_usm_user_info(_Key,
#usm_user{auth = usmHMACMD5AuthProtocol},
@@ -2898,11 +2895,11 @@ do_update_usm_user_info(Key,
#usm_user{auth = usmHMACSHAAuthProtocol} = User,
auth_key, Val)
when length(Val) =:= 20 ->
- case is_crypto_supported(sha_mac_96) of
+ case is_crypto_supported(sha) of
true ->
do_update_usm_user_info(Key, User#usm_user{auth_key = Val});
false ->
- {error, {unsupported_crypto, sha_mac_96}}
+ {error, {unsupported_crypto, sha}}
end;
do_update_usm_user_info(_Key,
#usm_user{auth = usmHMACSHAAuthProtocol},
@@ -2933,21 +2930,21 @@ do_update_usm_user_info(Key,
#usm_user{priv = usmDESPrivProtocol} = User,
priv_key, Val)
when length(Val) =:= 16 ->
- case is_crypto_supported(des_cbc_decrypt) of
+ case is_crypto_supported(des_cbc) of
true ->
do_update_usm_user_info(Key, User#usm_user{priv_key = Val});
false ->
- {error, {unsupported_crypto, des_cbc_decrypt}}
+ {error, {unsupported_crypto, des_cbc}}
end;
do_update_usm_user_info(Key,
#usm_user{priv = usmAesCfb128Protocoll} = User,
priv_key, Val)
when length(Val) =:= 16 ->
- case is_crypto_supported(aes_cfb_128_decrypt) of
+ case is_crypto_supported(aes_cfb128) of
true ->
do_update_usm_user_info(Key, User#usm_user{priv_key = Val});
false ->
- {error, {unsupported_crypto, aes_cfb_128_decrypt}}
+ {error, {unsupported_crypto, aes_cfb128}}
end;
do_update_usm_user_info(_Key,
#usm_user{auth = usmHMACSHAAuthProtocol},
diff --git a/lib/snmp/src/misc/snmp_config.erl b/lib/snmp/src/misc/snmp_config.erl
index 0bed097b62..22fe25941c 100644
--- a/lib/snmp/src/misc/snmp_config.erl
+++ b/lib/snmp/src/misc/snmp_config.erl
@@ -238,7 +238,7 @@ config_agent_sys() ->
MibStorage =
case MibStorageType of
ets ->
- ets;
+ [{module, snmpa_mib_storage_ets}];
dets ->
DetsDir = ask("6b. Mib storage directory (absolute path)?",
DbDir, fun verify_dir/1),
@@ -248,13 +248,14 @@ config_agent_sys() ->
"default", fun verify_mib_storage_action/1),
case DetsAction of
default ->
- {dets, DetsDir};
+ [{module, snmpa_mib_storage_dets},
+ {options, [{dir, DetsDir}]}];
_ ->
- {dets, DetsDir, DetsAction}
+ [{module, snmpa_mib_storage_dets},
+ {options, [{dir, DetsDir},
+ {action, DetsAction}]}]
end;
mnesia ->
-% Nodes = ask("Mib storage nodes?", "none",
-% fun verify_mib_storage_nodes/1),
Nodes = [],
MnesiaAction = ask("6b. Mib storage [mnesia] database start "
"action "
@@ -262,11 +263,18 @@ config_agent_sys() ->
"default", fun verify_mib_storage_action/1),
case MnesiaAction of
default ->
- {mnesia, Nodes};
+ [{module, snmpa_mib_storage_mnesia},
+ {options, [{nodes, Nodes}]}];
_ ->
- {mnesia, Nodes, MnesiaAction}
+ [{module, snmpa_mib_storage_mnesia},
+ {options, [{nodes, Nodes},
+ {action, MnesiaAction}]}]
end
end,
+
+ %% Here we should ask about mib-server data module,
+ %% but as we only have one at the moment...
+
TargetCacheVerb = ask("7. Target cache verbosity "
"(silence/info/log/debug/trace)?", "silence",
fun verify_verbosity/1),
diff --git a/lib/snmp/src/misc/snmp_misc.erl b/lib/snmp/src/misc/snmp_misc.erl
index a061dcd97c..293b22991b 100644
--- a/lib/snmp/src/misc/snmp_misc.erl
+++ b/lib/snmp/src/misc/snmp_misc.erl
@@ -43,6 +43,7 @@
ip/1, ip/2,
is_auth/1,
is_BitString/1,
+ is_crypto_supported/1,
is_oid/1,
is_priv/1,
is_reportable/1,
@@ -117,13 +118,27 @@ now(sec) ->
(element(3,Now) div 1000000).
+is_crypto_supported(Alg) ->
+ %% The 'try catch' handles the case when 'crypto' is
+ %% not present in the system (or not started).
+ try
+ begin
+ Supported = crypto:supports(),
+ Hashs = proplists:get_value(hashs, Supported),
+ Ciphers = proplists:get_value(ciphers, Supported),
+ lists:member(Alg, Hashs ++ Ciphers)
+ end
+ catch
+ _:_ ->
+ false
+ end.
+
is_string([]) -> true;
is_string([Tkn | Str])
when is_integer(Tkn) andalso (Tkn >= 0) andalso (Tkn =< 255) ->
is_string(Str);
is_string(_) -> false.
-
is_oid([E1, E2| Rest])
when (length(Rest) =< 126) andalso (E1 *40 + E2 =< 255) ->
is_oid2(Rest);
diff --git a/lib/snmp/src/misc/snmp_usm.erl b/lib/snmp/src/misc/snmp_usm.erl
index 53c291ca0e..67e3476816 100644
--- a/lib/snmp/src/misc/snmp_usm.erl
+++ b/lib/snmp/src/misc/snmp_usm.erl
@@ -142,32 +142,33 @@ auth_out(?usmHMACSHAAuthProtocol, AuthKey, Message, UsmSecParams) ->
sha_auth_out(AuthKey, Message, UsmSecParams).
md5_auth_out(AuthKey, Message, UsmSecParams) ->
+ %% ?vtrace("md5_auth_out -> entry with"
+ %% "~n AuthKey: ~w"
+ %% "~n Message: ~w"
+ %% "~n UsmSecParams: ~w", [AuthKey, Message, UsmSecParams]),
%% 6.3.1.1
Message2 = set_msg_auth_params(Message, UsmSecParams, ?twelwe_zeros),
- Packet = snmp_pdus:enc_message_only(Message2),
+ Packet = snmp_pdus:enc_message_only(Message2),
%% 6.3.1.2-4 is done by the crypto function
%% 6.3.1.4
MAC = binary_to_list(crypto:hmac(md5, AuthKey, Packet, 12)),
- ?vtrace("md5_auth_out -> entry with"
- "~n Packet: ~w"
- "~n AuthKey: ~w"
- "~n MAC: ~w"
- , [Packet, AuthKey, MAC]),
+ %% ?vtrace("md5_auth_out -> crypto (md5) encoded"
+ %% "~n MAC: ~w", [MAC]),
%% 6.3.1.5
set_msg_auth_params(Message, UsmSecParams, MAC).
md5_auth_in(AuthKey, AuthParams, Packet) when length(AuthParams) == 12 ->
+ %% ?vtrace("md5_auth_in -> entry with"
+ %% "~n AuthKey: ~w"
+ %% "~n AuthParams: ~w"
+ %% "~n Packet: ~w", [AuthKey, AuthParams, Packet]),
%% 6.3.2.3
Packet2 = patch_packet(binary_to_list(Packet)),
%% 6.3.2.5
MAC = binary_to_list(crypto:hmac(md5, AuthKey, Packet2, 12)),
%% 6.3.2.6
- ?vtrace("md5_auth_in -> entry with"
- "~n Packet2: ~w"
- "~n AuthKey: ~w"
- "~n AuthParams: ~w"
- "~n MAC: ~w"
- , [Packet2, AuthKey, AuthParams, MAC]),
+ %% ?vtrace("md5_auth_in -> crypto (md5) encoded"
+ %% "~n MAC: ~w", [MAC]),
MAC == AuthParams;
md5_auth_in(_AuthKey, _AuthParams, _Packet) ->
%% 6.3.2.1
diff --git a/lib/snmp/test/snmp_agent_mibs_test.erl b/lib/snmp/test/snmp_agent_mibs_test.erl
index 3e48130fac..248fe7d83e 100644
--- a/lib/snmp/test/snmp_agent_mibs_test.erl
+++ b/lib/snmp/test/snmp_agent_mibs_test.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2013. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -19,13 +19,17 @@
%%
%%----------------------------------------------------------------------
-%% Purpose:
+%% Purpose: Test suite of the agent mib-server.
+%% Some of these tests should really be in a mib-storage suite.
%%----------------------------------------------------------------------
+
-module(snmp_agent_mibs_test).
+
%%----------------------------------------------------------------------
%% Include files
%%----------------------------------------------------------------------
+
-include_lib("test_server/include/test_server.hrl").
-include("snmp_test_lib.hrl").
-include_lib("snmp/include/snmp_types.hrl").
@@ -39,13 +43,25 @@
%% External exports
%%----------------------------------------------------------------------
-export([
- all/0,groups/0,init_per_group/2,end_per_group/2,
- init_per_testcase/2, end_per_testcase/2,
- init_per_suite/1, end_per_suite/1,
+ all/0,
+ groups/0,
+
+ init_per_suite/1,
+ end_per_suite/1,
+
+ init_per_group/2,
+ end_per_group/2,
+
+ init_per_testcase/2,
+ end_per_testcase/2,
start_and_stop/1,
- size_check_ets/1,
+ size_check_ets1/1,
+ size_check_ets2/1,
+ size_check_ets2_bad_file1/1,
+ size_check_ets3/1,
+ size_check_ets3_bad_file1/1,
size_check_dets/1,
size_check_mnesia/1,
load_unload/1,
@@ -55,6 +71,7 @@
]).
+
%%----------------------------------------------------------------------
%% Internal exports
%%----------------------------------------------------------------------
@@ -71,18 +88,51 @@
%% External functions
%%======================================================================
-init_per_testcase(size_check_dets, Config) when is_list(Config) ->
- Dir = ?config(priv_dir, Config),
- DetsDir = join(Dir, "dets_dir/"),
- ?line ok = file:make_dir(DetsDir),
- [{dets_dir, DetsDir}|Config];
-init_per_testcase(size_check_mnesia, Config) when is_list(Config) ->
- Dir = ?config(priv_dir, Config),
- MnesiaDir = join(Dir, "mnesia_dir/"),
- ?line ok = file:make_dir(MnesiaDir),
- mnesia_start([{dir, MnesiaDir}]),
- [{mnesia_dir, MnesiaDir}|Config];
-init_per_testcase(cache_test, Config) when is_list(Config) ->
+init_per_suite(Config0) when is_list(Config0) ->
+
+ ?DBG("init_per_suite -> entry with"
+ "~n Config0: ~p", [Config0]),
+
+ Config1 = snmp_test_lib:init_suite_top_dir(?MODULE, Config0),
+
+ ?DBG("init_per_suite -> done when"
+ "~n Config1: ~p", [Config1]),
+
+ Config1.
+
+end_per_suite(Config) when is_list(Config) ->
+
+ ?DBG("end_per_suite -> entry with"
+ "~n Config: ~p", [Config]),
+
+ Config.
+
+
+init_per_testcase(Case, Config0) when is_list(Config0) ->
+ Config1 = snmp_test_lib:fix_data_dir(Config0),
+ CaseTopDir = snmp_test_lib:init_testcase_top_dir(Case, Config1),
+ DbDir = join(CaseTopDir, "db_dir/"),
+ ?line ok = file:make_dir(DbDir),
+ init_per_testcase2(Case, [{db_dir, DbDir},
+ {case_top_dir, CaseTopDir} | Config1]).
+
+init_per_testcase2(size_check_ets2_bad_file1, Config) when is_list(Config) ->
+ DbDir = ?config(db_dir, Config),
+ %% Create a ad file
+ ok = file:write_file(join(DbDir, "snmpa_symbolic_store.db"),
+ "calvin and hoppes play chess"),
+ Config;
+init_per_testcase2(size_check_ets3_bad_file1, Config) when is_list(Config) ->
+ DbDir = ?config(db_dir, Config),
+ %% Create a ad file
+ ok = file:write_file(join(DbDir, "snmpa_symbolic_store.db"),
+ "calvin and hoppes play chess"),
+ Config;
+init_per_testcase2(size_check_mnesia, Config) when is_list(Config) ->
+ DbDir = ?config(db_dir, Config),
+ mnesia_start([{dir, DbDir}]),
+ Config;
+init_per_testcase2(cache_test, Config) when is_list(Config) ->
Min = timer:minutes(5),
Timeout =
case lists:keysearch(tc_timeout, 1, Config) of
@@ -95,18 +145,26 @@ init_per_testcase(cache_test, Config) when is_list(Config) ->
end,
Dog = test_server:timetrap(Timeout),
[{watchdog, Dog} | Config];
-init_per_testcase(_Case, Config) when is_list(Config) ->
+init_per_testcase2(_Case, Config) when is_list(Config) ->
Config.
-end_per_testcase(size_check_dets, Config) when is_list(Config) ->
- Dir = ?config(dets_dir, Config),
- ?line ok = ?DEL_DIR(Dir),
- lists:keydelete(dets_dir, 1, Config);
+%% end_per_testcase(EtsCase, Config)
+%% when (is_list(Config) andalso
+%% ((EtsCase =:= size_check_ets2) orelse
+%% (EtsCase =:= size_check_ets3))) ->
+%% Dir = ?config(ets_dir, Config),
+%% ?line ok = ?DEL_DIR(Dir),
+%% lists:keydelete(ets_dir, 1, Config);
+%% end_per_testcase(size_check_dets, Config) when is_list(Config) ->
+%% Dir = ?config(dets_dir, Config),
+%% ?line ok = ?DEL_DIR(Dir),
+%% lists:keydelete(dets_dir, 1, Config);
end_per_testcase(size_check_mnesia, Config) when is_list(Config) ->
mnesia_stop(),
- Dir = ?config(mnesia_dir, Config),
- ?line ok = ?DEL_DIR(Dir),
- lists:keydelete(mnesia_dir, 1, Config);
+ %% Dir = ?config(db_dir, Config),
+ %% ?line ok = ?DEL_DIR(Dir),
+ %% lists:keydelete(mnesia_dir, 1, Config);
+ Config;
end_per_testcase(cache_test, Config) when is_list(Config) ->
Dog = ?config(watchdog, Config),
test_server:timetrap_cancel(Dog),
@@ -120,33 +178,40 @@ end_per_testcase(_Case, Config) when is_list(Config) ->
%%======================================================================
all() ->
-cases().
+ cases().
groups() ->
[{size_check, [],
- [size_check_ets, size_check_dets, size_check_mnesia]}].
+ [
+ size_check_ets1, % Plain ets
+ size_check_ets2, % ets with a file
+ size_check_ets2_bad_file1, % ets with a bad file
+ size_check_ets3, % ets with a checksummed file
+ size_check_ets3_bad_file1, % ets with bad file (checksummed)
+ size_check_dets, % Plain dets
+ size_check_mnesia % Plain mnesia
+ ]
+ }].
+
-init_per_group(_GroupName, Config) ->
- Config.
+init_per_group(GroupName, Config) ->
+ snmp_test_lib:init_group_top_dir(GroupName, Config).
end_per_group(_GroupName, Config) ->
- Config.
+ %% Do we really need to do this?
+ %% lists:keydelete(snmp_group_top_dir, 1, Config).
+ Config.
cases() ->
-[start_and_stop, load_unload, {group, size_check},
- me_lookup, which_mib, cache_test].
-
-init_per_suite(Config) when is_list(Config) ->
- %% Data dir points wrong
- DataDir0 = ?config(data_dir, Config),
- DataDir1 = filename:split(filename:absname(DataDir0)),
- [_|DataDir2] = lists:reverse(DataDir1),
- DataDir = filename:join(lists:reverse(DataDir2) ++ [?snmp_test_data]),
- [{snmp_data_dir, DataDir ++ "/"}|Config].
-
-end_per_suite(Config) when is_list(Config) ->
- lists:keydelete(snmp_data_dir, 1, Config).
+ [
+ start_and_stop,
+ load_unload,
+ {group, size_check},
+ me_lookup,
+ which_mib,
+ cache_test
+ ].
%%======================================================================
@@ -175,8 +240,7 @@ load_unload(suite) -> [];
load_unload(Config) when is_list(Config) ->
Prio = normal,
Verbosity = log,
- %% MibStorage = ets,
- MibDir = ?config(snmp_data_dir, Config),
+ MibDir = ?config(data_dir, Config),
?DBG("load_unload -> start symbolic store", []),
?line sym_start(Prio, Verbosity),
@@ -221,30 +285,74 @@ load_unload(Config) when is_list(Config) ->
%% ---------------------------------------------------------------------
-size_check_ets(suite) ->
+size_check_ets1(suite) ->
+ [];
+size_check_ets1(Config) when is_list(Config) ->
+ MibStorage = [{module, snmpa_mib_storage_ets}],
+ do_size_check([{mib_storage, MibStorage}|Config]).
+
+size_check_ets2(suite) ->
+ [];
+size_check_ets2(Config) when is_list(Config) ->
+ Dir = ?config(db_dir, Config),
+ MibStorage = [{module, snmpa_mib_storage_ets},
+ {options, [{dir, Dir}]}],
+ do_size_check([{mib_storage, MibStorage}|Config]).
+
+size_check_ets2_bad_file1(suite) ->
+ [];
+size_check_ets2_bad_file1(Config) when is_list(Config) ->
+ Dir = ?config(db_dir, Config),
+ %% Ensure that the bad file does not cause any problems (action = clear)
+ MibStorage = [{module, snmpa_mib_storage_ets},
+ {options, [{dir, Dir},
+ {action, clear}]}],
+ do_size_check([{mib_storage, MibStorage}|Config]).
+
+size_check_ets3(suite) ->
[];
-size_check_ets(Config) when is_list(Config) ->
- do_size_check([{mib_storage, ets}|Config]).
+size_check_ets3(Config) when is_list(Config) ->
+ Dir = ?config(db_dir, Config),
+ MibStorage = [{module, snmpa_mib_storage_ets},
+ {options, [{dir, Dir},
+ {checksum, true}]}],
+ do_size_check([{mib_storage, MibStorage}|Config]).
+
+size_check_ets3_bad_file1(suite) ->
+ [];
+size_check_ets3_bad_file1(Config) when is_list(Config) ->
+ Dir = ?config(db_dir, Config),
+ %% Ensure that the bad file does not cause any problems (action = clear)
+ MibStorage = [{module, snmpa_mib_storage_ets},
+ {options, [{dir, Dir},
+ {action, clear},
+ {checksum, true}]}],
+ do_size_check([{mib_storage, MibStorage}|Config]).
size_check_dets(suite) ->
[];
size_check_dets(Config) when is_list(Config) ->
- Dir = ?config(dets_dir, Config),
- do_size_check([{mib_storage, {dets, Dir}}|Config]).
+ Dir = ?config(db_dir, Config),
+ MibStorage = [{module, snmpa_mib_storage_dets},
+ {options, [{dir, Dir}]}],
+ do_size_check([{mib_storage, MibStorage}|Config]).
size_check_mnesia(suite) ->
[];
size_check_mnesia(Config) when is_list(Config) ->
- do_size_check([{mib_storage, {mnesia, [node()]}}|Config]).
+ MibStorage = [{module, snmpa_mib_storage_mnesia},
+ {options, [{nodes, [node()]}]}],
+ do_size_check([{mib_storage, MibStorage}|Config]).
do_size_check(Config) ->
- ?DBG("do_size_check -> start", []),
+ ?DBG("do_size_check -> start with"
+ "~n Config: ~p", [Config]),
Prio = normal,
Verbosity = trace,
MibStorage = ?config(mib_storage, Config),
?DBG("do_size_check -> MibStorage: ~p", [MibStorage]),
- MibDir = ?config(snmp_data_dir, Config),
+ MibDir = ?config(data_dir, Config),
StdMibDir = filename:join(code:priv_dir(snmp), "mibs") ++ "/",
?DBG("do_size_check -> start symbolic store", []),
@@ -294,8 +402,7 @@ me_lookup(suite) -> [];
me_lookup(Config) when is_list(Config) ->
Prio = normal,
Verbosity = trace,
- %% MibStorage = ets,
- MibDir = ?config(snmp_data_dir, Config),
+ MibDir = ?config(data_dir, Config),
StdMibDir = filename:join(code:priv_dir(snmp), "mibs") ++ "/",
Mibs = ["Test2", "TestTrap", "TestTrapv2"],
StdMibs = ["OTP-SNMPEA-MIB",
@@ -348,8 +455,7 @@ which_mib(suite) -> [];
which_mib(Config) when is_list(Config) ->
Prio = normal,
Verbosity = trace,
- %% MibStorage = ets,
- MibDir = ?config(snmp_data_dir, Config),
+ MibDir = ?config(data_dir, Config),
StdMibDir = filename:join(code:priv_dir(snmp), "mibs") ++ "/",
Mibs = ["Test2", "TestTrap", "TestTrapv2"],
StdMibs = ["OTP-SNMPEA-MIB",
@@ -406,28 +512,28 @@ cache_test(Config) when is_list(Config) ->
?DBG("cache_test -> start", []),
Prio = normal,
Verbosity = trace,
- MibStorage = ets,
- MibDir = ?config(snmp_data_dir, Config),
+ MibStorage = [{module, snmpa_mib_storage_ets}],
+ MibDir = ?config(data_dir, Config),
StdMibDir = filename:join(code:priv_dir(snmp), "mibs") ++ "/",
- Mibs = ["Test2", "TestTrap", "TestTrapv2"],
- StdMibs = ["OTP-SNMPEA-MIB",
- "SNMP-COMMUNITY-MIB",
- "SNMP-FRAMEWORK-MIB",
- "SNMP-MPD-MIB",
- "SNMP-NOTIFICATION-MIB",
- "SNMP-TARGET-MIB",
- %% "SNMP-USER-BASED-SM-MIB",
- "SNMP-VIEW-BASED-ACM-MIB",
- "SNMPv2-MIB",
- "SNMPv2-TC",
- "SNMPv2-TM"],
+ Mibs = ["Test2", "TestTrap", "TestTrapv2"],
+ StdMibs = ["OTP-SNMPEA-MIB",
+ "SNMP-COMMUNITY-MIB",
+ "SNMP-FRAMEWORK-MIB",
+ "SNMP-MPD-MIB",
+ "SNMP-NOTIFICATION-MIB",
+ "SNMP-TARGET-MIB",
+ %% "SNMP-USER-BASED-SM-MIB",
+ "SNMP-VIEW-BASED-ACM-MIB",
+ "SNMPv2-MIB",
+ "SNMPv2-TC",
+ "SNMPv2-TM"],
?DBG("cache_test -> start symbolic store", []),
?line sym_start(Prio, MibStorage, Verbosity),
?DBG("cache_test -> start mib server", []),
- GcLimit = 2,
- Age = timer:seconds(10),
+ GcLimit = 2,
+ Age = timer:seconds(10),
CacheOpts = [{autogc, false}, {age, Age}, {gclimit, GcLimit}],
?line MibsPid = mibs_start(Prio, MibStorage, [], Verbosity, CacheOpts),
@@ -537,7 +643,7 @@ mnesia_stop() ->
%% - Symbolic Store mini interface
sym_start(Prio, Verbosity) ->
- sym_start(Prio, ets, Verbosity).
+ sym_start(Prio, mib_storage(), Verbosity).
sym_start(Prio, MibStorage, Verbosity) ->
Opts = [{mib_storage, MibStorage}, {verbosity,Verbosity}],
@@ -554,7 +660,7 @@ sym_info() ->
%% -- MIB server mini interface
mibs_start(Prio, Verbosity) when is_atom(Prio) andalso is_atom(Verbosity) ->
- mibs_start(Prio, ets, [], Verbosity).
+ mibs_start(Prio, mib_storage(), [], Verbosity).
mibs_start(Prio, MibStorage, Verbosity)
when is_atom(Prio) andalso is_atom(Verbosity) ->
@@ -671,6 +777,11 @@ which_mib(M1, M2) ->
{error, {invalid_mib, M1, M2}}.
+%% Default mib-storage
+mib_storage() ->
+ [{module, snmpa_mib_storage_ets}].
+
+
%% --
display_memory_usage(MibsPid) ->
diff --git a/lib/snmp/test/snmp_agent_test.erl b/lib/snmp/test/snmp_agent_test.erl
index 09e1eb25a9..6fe97ccd25 100644
--- a/lib/snmp/test/snmp_agent_test.erl
+++ b/lib/snmp/test/snmp_agent_test.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2013. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -24,7 +24,402 @@
%% * Test fault-tolerance (kill master etc)
%%
--compile(export_all).
+-export([
+ all/0,
+ groups/0,
+ init_per_suite/1, end_per_suite/1,
+ init_per_group/2, end_per_group/2,
+ init_per_testcase/2, end_per_testcase/2,
+
+ %% all_tcs - misc
+ app_info/1,
+ info_test/1,
+
+ %% all_tcs - test_v1
+ simple/1,
+ db_notify_client/1,
+ v1_processing/1,
+ big/1,
+ big2/1,
+ loop_mib/1,
+ api/1,
+ subagent/1,
+ mnesia/1,
+ sa_register/1,
+ v1_trap/1,
+ sa_error/1,
+ next_across_sa/1,
+ undo/1,
+ sparse_table/1,
+ cnt_64/1,
+ opaque/1,
+ change_target_addr_config/1,
+
+ %% all_tcs - test_v1 - multiple_reqs
+ mul_get/1,
+ mul_get_err/1,
+ mul_next/1,
+ mul_next_err/1,
+ mul_set/1,
+ mul_set_err/1,
+
+ %% all_tcs - test_v1 - reported_bugs
+ otp_1128/1,
+ otp_1129/1,
+ otp_1131/1,
+ otp_1162/1,
+ otp_1222/1,
+ otp_1298/1,
+ otp_1331/1,
+ otp_1338/1,
+ otp_1342/1,
+ otp_1366/1,
+ otp_2776/1,
+ otp_2979/1,
+ otp_3187/1,
+ otp_3725/1,
+
+ %% all_tcs - test_v1 - standard_mibs
+ snmp_standard_mib/1,
+ snmp_community_mib/1,
+ snmp_framework_mib/1,
+ snmp_target_mib/1,
+ snmp_notification_mib/1,
+ snmp_view_based_acm_mib/1,
+
+ %% all_tcs - test_v2
+ simple_2/1,
+ v2_processing/1,
+ big_2/1,
+ big2_2/1,
+ loop_mib_2/1,
+ api_2/1,
+ subagent_2/1,
+ mnesia_2/1,
+ sa_register_2/1,
+ v2_trap/1,
+ sa_error_2/1,
+ next_across_sa_2/1,
+ undo_2/1,
+ v2_types/1,
+ implied/1,
+ sparse_table_2/1,
+ cnt_64_2/1,
+ opaque_2/1,
+ v2_caps/1,
+
+ %% all_tcs - test_v2 - multiple_reqs_2
+ mul_get_2/1,
+ mul_get_err_2/1,
+ mul_next_2/1,
+ mul_next_err_2/1,
+ mul_set_2/1,
+ mul_set_err_2/1,
+
+ %% all_tcs - test_v2 - v2_inform
+ v2_inform_i/1,
+
+ %% all_tcs - test_v2 - reported_bugs_2
+ otp_1128_2/1,
+ otp_1129_2/1,
+ otp_1131_2/1,
+ otp_1162_2/1,
+ otp_1222_2/1,
+ otp_1298_2/1,
+ otp_1331_2/1,
+ otp_1338_2/1,
+ otp_1342_2/1,
+ otp_1366_2/1,
+ otp_2776_2/1,
+ otp_2979_2/1,
+ otp_3187_2/1,
+
+ %% all_tcs - test_v2 - standard_mibs_2
+ snmpv2_mib_2/1,
+ snmp_community_mib_2/1,
+ snmp_framework_mib_2/1,
+ snmp_target_mib_2/1,
+ snmp_notification_mib_2/1,
+ snmp_view_based_acm_mib_2/1,
+
+ %% all_tcs - test_v1_v2
+ simple_bi/1,
+
+ %% all_tcs - test_v3
+ simple_3/1,
+ v3_processing/1,
+ big_3/1,
+ big2_3/1,
+ api_3/1,
+ subagent_3/1,
+ mnesia_3/1,
+ loop_mib_3/1,
+ sa_register_3/1,
+ v3_trap/1,
+ sa_error_3/1,
+ next_across_sa_3/1,
+ undo_3/1,
+ v2_types_3/1,
+ implied_3/1,
+ sparse_table_3/1,
+ cnt_64_3/1,
+ opaque_3/1,
+ v2_caps_3/1,
+
+ %% all_tcs - test_v3 - multiple_reqs_3
+ mul_get_3/1,
+ mul_get_err_3/1,
+ mul_next_3/1,
+ mul_next_err_3/1,
+ mul_set_3/1,
+ mul_set_err_3/1,
+
+ %% all_tcs - test_v3 - v3_inform
+ v3_inform_i/1,
+
+ %% all_tcs - test_v3 - reported_bugs_3
+ otp_1128_3/1,
+ otp_1129_3/1,
+ otp_1131_3/1,
+ otp_1162_3/1,
+ otp_1222_3/1,
+ otp_1298_3/1,
+ otp_1331_3/1,
+ otp_1338_3/1,
+ otp_1342_3/1,
+ otp_1366_3/1,
+ otp_2776_3/1,
+ otp_2979_3/1,
+ otp_3187_3/1,
+ otp_3542/1,
+
+ %% all_tcs - test_v3 - standard_mibs_3
+ snmpv2_mib_3/1,
+ snmp_framework_mib_3/1,
+ snmp_mpd_mib_3/1,
+ snmp_target_mib_3/1,
+ snmp_notification_mib_3/1,
+ snmp_view_based_acm_mib_3/1,
+ snmp_user_based_sm_mib_3/1,
+
+ %% all_tcs - test_v3 - v3_security
+ v3_crypto_basic/1,
+ v3_md5_auth/1,
+ v3_sha_auth/1,
+ v3_des_priv/1,
+
+ %% all_tcs - test_multi_threaded
+ multi_threaded/1,
+ mt_trap/1,
+
+ %% all_tcs - mib_storage - mib_storage_ets
+ mse_simple/1,
+ mse_v1_processing/1,
+ mse_big/1,
+ mse_big2/1,
+ mse_loop_mib/1,
+ mse_api/1,
+ mse_sa_register/1,
+ mse_v1_trap/1,
+ mse_sa_error/1,
+ mse_next_across_sa/1,
+ mse_undo/1,
+ mse_standard_mib/1,
+ mse_community_mib/1,
+ mse_framework_mib/1,
+ mse_target_mib/1,
+ mse_notification_mib/1,
+ mse_view_based_acm_mib/1,
+ mse_sparse_table/1,
+ mse_me_of/1,
+ mse_mib_of/1,
+
+ %% all_tcs - mib_storage - mib_storage_dets
+ msd_simple/1,
+ msd_v1_processing/1,
+ msd_big/1,
+ msd_big2/1,
+ msd_loop_mib/1,
+ msd_api/1,
+ msd_sa_register/1,
+ msd_v1_trap/1,
+ msd_sa_error/1,
+ msd_next_across_sa/1,
+ msd_undo/1,
+ msd_standard_mib/1,
+ msd_community_mib/1,
+ msd_framework_mib/1,
+ msd_target_mib/1,
+ msd_notification_mib/1,
+ msd_view_based_acm_mib/1,
+ msd_sparse_table/1,
+ msd_me_of/1,
+ msd_mib_of/1,
+
+ %% all_tcs - mib_storage - mib_storage_mnesia
+ msm_simple/1,
+ msm_v1_processing/1,
+ msm_big/1,
+ msm_big2/1,
+ msm_loop_mib/1,
+ msm_api/1,
+ msm_sa_register/1,
+ msm_v1_trap/1,
+ msm_sa_error/1,
+ msm_next_across_sa/1,
+ msm_undo/1,
+ msm_standard_mib/1,
+ msm_community_mib/1,
+ msm_framework_mib/1,
+ msm_target_mib/1,
+ msm_notification_mib/1,
+ msm_view_based_acm_mib/1,
+ msm_sparse_table/1,
+ msm_me_of/1,
+ msm_mib_of/1,
+
+ %% all_tcs - mib_storage - mse_size_check
+ mse_size_check/1,
+
+ %% all_tcs - mib_storage - msd_size_check
+ msd_size_check/1,
+
+ %% all_tcs - mib_storage - msm_size_check
+ msm_size_check/1,
+
+ %% all_tcs - mib_storage - varm_mib_storage_dets
+ msd_varm_mib_start/1,
+
+ %% all_tcs - mib_storage - varm_mib_storage_mnesia
+ msm_varm_mib_start/1,
+
+ %% all_tcs - tickets1 - otp4394
+ otp_4394/1,
+
+ %% all_tcs - tickets1 - otp7157
+ otp_7157/1,
+
+ %% tickets2
+ otp8395/1,
+ otp9884/1
+
+ ]).
+
+%% Internal exports
+-export([dummy_manager_init/2,
+ v3_sync/1,
+ v3_inform_sync/1,
+ v2_caps_i/1,
+ v1_proc/0,
+ v2_proc/0,
+ big_test/0,
+ big_test_2/0,
+ simple_standard_test/0,
+ db_notify_client_test/0,
+ notify/2,
+ multi_threaded_test/0,
+ mt_trap_test/1,
+ types_v2_test/0,
+ implied_test/1,
+ sparse_table_test/0,
+ cnt_64_test/1,
+ opaque_test/0,
+ api_test/1,
+ unreg_test/0,
+ load_test/0,
+ load_test_sa/0,
+ api_test2/0,
+ api_test3/0,
+ do_mul_get/0,
+ do_mul_get_err/0,
+ do_mul_next/0,
+ do_mul_next_err/0,
+ do_mul_set/0,
+ do_mul_set_err/0,
+ sa_mib/0,
+ ma_trap1/1,
+ ma_trap2/1,
+ ma_v2_2_v1_trap/1,
+ ma_v2_2_v1_trap2/1,
+ sa_trap1/1,
+ sa_trap2/1,
+ sa_trap3/1,
+ ma_v2_trap1/1,
+ ma_v2_trap2/1,
+ ma_v2_inform1/1,
+ ma_v2_inform2/1,
+ ma_v2_inform3/1,
+ delivery_targets/3,
+ delivery_info/4,
+ ma_v1_2_v2_trap/1,
+ ma_v1_2_v2_trap2/1,
+ sa_v1_2_v2_trap1/1,
+ sa_v1_2_v2_trap2/1,
+ sa_v1_2_v2_trap3/1,
+ sa_errs_bad_value/0,
+ sa_errs_gen_err/0,
+ sa_too_big/0,
+ next_across_sa_test/0,
+ undo_test/0,
+ bad_return/0,
+ standard_mib_a/0,
+ std_mib_read/0,
+ std_mib_write/0,
+ std_mib_init/0,
+ std_mib_finish/0,
+ standard_mib_test_finish/0,
+ std_mib_asn_err/0,
+ snmpv2_mib_test_finish/0,
+ std_mib_a/0,
+ std_mib_b/1,
+ std_mib_c/1,
+ snmpv2_mib_a/0,
+ snmp_community_mib_test/0,
+ snmp_framework_mib_test/0,
+ snmp_mpd_mib_a/0,
+ snmp_mpd_mib_b/0,
+ snmp_mpd_mib_c/1,
+ snmp_target_mib_test/0,
+ snmp_notification_mib_test/0,
+ do_set/1,
+ add_row/1,
+ del_row/1,
+ use_no_rights/0,
+ use_rights/0,
+ usm_add_user1/0,
+ usm_use_user/0,
+ usm_key_change1/2,
+ usm_key_change2/4,
+ usm_key_change3/4,
+ usm_read/0,
+ usm_del_user/0,
+ usm_bad/0,
+ loop_mib_1/0,
+ loop_mib_2/0,
+ otp_1129_i/1,
+ otp_1162_test/0,
+ otp_1131_test/0,
+ otp_1222_test/0,
+ otp_1298_test/0,
+ otp_1331_test/0,
+ otp_1338_test/0,
+ otp_1342_test/0,
+ otp_1366_test/0,
+ otp_1128_test/0,
+ otp_2776_test/0,
+ otp_2979_test/0,
+ otp_3542_test/0,
+ otp_3725_test/1,
+ otp_4394_test/0,
+ otp_7157_test/1,
+ otp9884_backup/4,
+ agent_log_validation/0,
+ mnesia_init/1,
+ mnesia_start/0,
+ mnesia_stop/0,
+ start_stdalone_agent/1,
+ do_info/1
+ ]).
-define(application, snmp).
@@ -86,6 +481,26 @@
end).
+-define(expect1(What),
+ snmp_agent_test_lib:expect(?MODULE, ?LINE,
+ What)).
+-define(expect2(What, ExpVBs),
+ snmp_agent_test_lib:expect(?MODULE, ?LINE,
+ What, ExpVBs)).
+-define(expect3(Err, Idx, ExpVBs),
+ snmp_agent_test_lib:expect(?MODULE, ?LINE,
+ Err, Idx, ExpVBs)).
+-define(expect4(Err, Idx, ExpVBs, To),
+ snmp_agent_test_lib:expect(?MODULE, ?LINE,
+ Err, Idx, ExpVBs, To)).
+-define(expect5(Type, Ent, Gen, Spec, ExpVBs),
+ snmp_agent_test_lib:expect(?MODULE, ?LINE,
+ Type, Ent, Gen, Spec, ExpVBs)).
+-define(expect6(Type, Ent, Gen, Spec, ExpVBs, To),
+ snmp_agent_test_lib:expect(?MODULE, ?LINE,
+ Type, Ent, Gen, Spec, ExpVBs, To)).
+
+
all() ->
%% Reqs = [mnesia, distribution, {local_slave_nodes, 2}, {time, 360}],
Conf1 = [{group, all_tcs}],
@@ -94,19 +509,8 @@ all() ->
groups() ->
[
- {all_tcs, [], cases()},
- {mib_storage, [],
- [
- {group, mib_storage_ets},
- {group, mib_storage_dets},
- {group, mib_storage_mnesia},
- {group, mib_storage_size_check_ets},
- {group, mib_storage_size_check_dets},
- {group, mib_storage_size_check_mnesia},
- {group, mib_storage_varm_dets},
- {group, mib_storage_varm_mnesia}
- ]
- },
+ {all_tcs, [], cases()},
+ {mib_storage, [], mib_storage_cases()},
{mib_storage_ets, [], mib_storage_ets_cases()},
{mib_storage_dets, [], mib_storage_dets_cases()},
{mib_storage_mnesia, [], mib_storage_mnesia_cases()},
@@ -123,109 +527,20 @@ groups() ->
{test_multi_threaded, [], mt_cases()},
{multiple_reqs, [], mul_cases()},
{multiple_reqs_2, [], mul_cases_2()},
- {v2_inform, [],
- [
- v2_inform_i
- ]
- },
- {v3_security, [],
- [
- v3_crypto_basic,
- v3_md5_auth,
- v3_sha_auth,
- v3_des_priv
- ]
- },
- {standard_mibs, [],
- [
- snmp_standard_mib,
- snmp_community_mib,
- snmp_framework_mib,
- snmp_target_mib,
- snmp_notification_mib,
- snmp_view_based_acm_mib
- ]
- },
- {standard_mibs_2, [],
- [
- snmpv2_mib_2,
- snmp_community_mib_2,
- snmp_framework_mib_2,
- snmp_target_mib_2,
- snmp_notification_mib_2,
- snmp_view_based_acm_mib_2
- ]
- },
- {standard_mibs_3, [],
- [
- snmpv2_mib_3,
- snmp_framework_mib_3,
- snmp_mpd_mib_3,
- snmp_target_mib_3,
- snmp_notification_mib_3,
- snmp_view_based_acm_mib_3,
- snmp_user_based_sm_mib_3
- ]
- },
- {reported_bugs, [],
- [
- otp_1128,
- otp_1129,
- otp_1131,
- otp_1162,
- otp_1222,
- otp_1298,
- otp_1331,
- otp_1338,
- otp_1342,
- otp_2776,
- otp_2979,
- otp_3187,
- otp_3725
- ]
- },
- {reported_bugs_2, [],
- [
- otp_1128_2,
- otp_1129_2,
- otp_1131_2,
- otp_1162_2,
- otp_1222_2,
- otp_1298_2,
- otp_1331_2,
- otp_1338_2,
- otp_1342_2,
- otp_2776_2,
- otp_2979_2,
- otp_3187_2
- ]
- },
- {reported_bugs_3, [],
- [
- otp_1128_3,
- otp_1129_3,
- otp_1131_3,
- otp_1162_3,
- otp_1222_3,
- otp_1298_3,
- otp_1331_3,
- otp_1338_3,
- otp_1342_3,
- otp_2776_3,
- otp_2979_3,
- otp_3187_3,
- otp_3542
- ]
- },
- {tickets1, [],
- [
- {group, otp_4394},
- {group, otp_7157}
- ]
- },
- {tickets2, [], [otp8395, otp9884]},
- {otp_4394, [], [otp_4394_test]},
- {otp_7157, [], [otp_7157_test]}
+ {multiple_reqs_3, [], mul_cases_3()},
+ {v2_inform, [], v2_inform_cases()},
+ {v3_inform, [], v3_inform_cases()},
+ {v3_security, [], v3_security_cases()},
+ {standard_mibs, [], standard_mibs_cases()},
+ {standard_mibs_2, [], standard_mibs2_cases()},
+ {standard_mibs_3, [], standard_mibs3_cases()},
+ {reported_bugs, [], reported_bugs_cases()},
+ {reported_bugs_2, [], reported_bugs2_cases()},
+ {reported_bugs_3, [], reported_bugs3_cases()},
+ {tickets1, [], tickets1_cases()},
+ {tickets2, [], tickets2_cases()},
+ {otp4394, [], [otp_4394]},
+ {otp7157, [], [otp_7157]}
].
@@ -258,15 +573,19 @@ end_per_suite(Config) when is_list(Config) ->
init_per_group(all_tcs = GroupName, Config) ->
init_all(snmp_test_lib:init_group_top_dir(GroupName, Config));
-init_per_group(otp_7157 = GroupName, Config) ->
- init_otp_7157(snmp_test_lib:init_group_top_dir(GroupName, Config));
-init_per_group(otp_4394 = GroupName, Config) ->
- init_otp_4394(snmp_test_lib:init_group_top_dir(GroupName, Config));
+init_per_group(otp7157 = GroupName, Config) ->
+ otp_7157_init(snmp_test_lib:init_group_top_dir(GroupName, Config));
+init_per_group(otp4394 = GroupName, Config) ->
+ otp_4394_init(snmp_test_lib:init_group_top_dir(GroupName, Config));
init_per_group(v2_inform = GroupName, Config) ->
init_v2_inform(snmp_test_lib:init_group_top_dir(GroupName, Config));
+init_per_group(v3_inform = GroupName, Config) ->
+ init_v3_inform(snmp_test_lib:init_group_top_dir(GroupName, Config));
+init_per_group(multiple_reqs = GroupName, Config) ->
+ init_mul(snmp_test_lib:init_group_top_dir(GroupName, Config));
init_per_group(multiple_reqs_2 = GroupName, Config) ->
init_mul(snmp_test_lib:init_group_top_dir(GroupName, Config));
-init_per_group(multiple_reqs = GroupName, Config) ->
+init_per_group(multiple_reqs_3 = GroupName, Config) ->
init_mul(snmp_test_lib:init_group_top_dir(GroupName, Config));
init_per_group(test_multi_threaded = GroupName, Config) ->
init_mt(snmp_test_lib:init_group_top_dir(GroupName, Config));
@@ -284,8 +603,10 @@ init_per_group(mib_storage_varm_mnesia = GroupName, Config) ->
init_varm_mib_storage_mnesia(snmp_test_lib:init_group_top_dir(GroupName,
Config));
init_per_group(mib_storage_varm_dets = GroupName, Config) ->
- init_varm_mib_storage_dets(snmp_test_lib:init_group_top_dir(GroupName,
- Config));
+ ?DBG("init_per_group(mib_storage_varm_dets) -> entry with"
+ "~n Config: ~p", [Config]),
+ init_varm_mib_storage_dets(
+ snmp_test_lib:init_group_top_dir(GroupName, Config));
init_per_group(mib_storage_size_check_mnesia = GroupName, Config) ->
init_size_check_msm(snmp_test_lib:init_group_top_dir(GroupName, Config));
init_per_group(mib_storage_size_check_dets = GroupName, Config) ->
@@ -304,16 +625,20 @@ init_per_group(GroupName, Config) ->
end_per_group(all_tcs, Config) ->
finish_all(Config);
-end_per_group(otp_7157, Config) ->
- finish_otp_7157(Config);
-end_per_group(otp_4394, Config) ->
- finish_otp_4394(Config);
+end_per_group(otp7157, Config) ->
+ otp_7157_finish(Config);
+end_per_group(otp4394, Config) ->
+ otp_4394_finish(Config);
end_per_group(v2_inform, Config) ->
- finish_v2_inform(Config);
-end_per_group(multiple_reqs_2, Config) ->
- finish_mul(Config);
+ finish_v2_inform(Config);
+end_per_group(v3_inform, Config) ->
+ finish_v3_inform(Config);
end_per_group(multiple_reqs, Config) ->
finish_mul(Config);
+end_per_group(multiple_reqs_2, Config) ->
+ finish_mul(Config);
+end_per_group(multiple_reqs_3, Config) ->
+ finish_mul(Config);
end_per_group(test_multi_threaded, Config) ->
finish_mt(Config);
end_per_group(test_v3, Config) ->
@@ -353,9 +678,6 @@ init_per_testcase(Case, Config) when is_list(Config) ->
?DBG("init_per_testcase -> entry with"
"~n Config: ~p", [Config]),
- p("Agent Info: "
- "~n ~p", [snmpa:info()]),
-
init_per_testcase1(Case, Config).
init_per_testcase1(otp8395 = Case, Config) when is_list(Config) ->
@@ -368,7 +690,7 @@ init_per_testcase1(otp9884 = Case, Config) when is_list(Config) ->
"~n Case: ~p"
"~n Config: ~p", [Case, Config]),
otp9884({init, init_per_testcase2(Case, Config)});
-init_per_testcase1(otp_7157_test = _Case, Config) when is_list(Config) ->
+init_per_testcase1(otp_7157 = _Case, Config) when is_list(Config) ->
?DBG("init_per_testcase1 -> entry with"
"~n Case: ~p"
"~n Config: ~p", [_Case, Config]),
@@ -400,9 +722,6 @@ end_per_testcase(Case, Config) when is_list(Config) ->
?DBG("end_per_testcase -> entry with"
"~n Config: ~p", [Config]),
- p("Agent Info: "
- "~n ~p", [snmpa:info()]),
-
display_log(Config),
end_per_testcase1(Case, Config).
@@ -454,20 +773,20 @@ init_per_testcase2(Case, Config) ->
{sub_agent_top_dir, SubAgentTopDir},
{manager_top_dir, ManagerTopDir} | Config].
-end_per_testcase2(_Case, Config) ->
- Config.
+%% end_per_testcase2(_Case, Config) ->
+%% Config.
cases() ->
[
- {group, misc},
- {group, test_v1},
- {group, test_v2},
- {group, test_v1_v2},
- {group, test_v3},
- {group, test_multi_threaded},
- {group, mib_storage},
- {group, tickets1}
+ {group, misc},
+ {group, test_v1},
+ {group, test_v2},
+ {group, test_v1_v2},
+ {group, test_v3},
+ {group, test_multi_threaded},
+ {group, mib_storage},
+ {group, tickets1}
].
@@ -553,7 +872,7 @@ delete_tables() ->
mnesia:delete_table(kompissTable2),
mnesia:delete_table(snmp_variables).
-%% Creation is done in runtime!
+%% Tables are created in runtime!
delete_mib_storage_mnesia_tables() ->
mnesia:delete_table(snmpa_mib_data),
mnesia:delete_table(snmpa_mib_tree),
@@ -576,40 +895,89 @@ delete_mib_storage_mnesia_tables() ->
%% versions as well, <base>_N.
%%-----------------------------------------------------------------
-
-
-
-
-
-
-
-
+mib_storage_cases() ->
+ [
+ {group, mib_storage_ets},
+ {group, mib_storage_dets},
+ {group, mib_storage_mnesia},
+ {group, mib_storage_size_check_ets},
+ {group, mib_storage_size_check_dets},
+ {group, mib_storage_size_check_mnesia},
+ {group, mib_storage_varm_dets},
+ {group, mib_storage_varm_mnesia}
+ ].
+
mib_storage_ets_cases() ->
-[mse_simple, mse_v1_processing, mse_big, mse_big2,
- mse_loop_mib, mse_api, mse_sa_register, mse_v1_trap,
- mse_sa_error, mse_next_across_sa, mse_undo,
- mse_standard_mib, mse_community_mib, mse_framework_mib,
- mse_target_mib, mse_notification_mib,
- mse_view_based_acm_mib, mse_sparse_table, mse_me_of,
- mse_mib_of].
+ [
+ mse_simple,
+ mse_v1_processing,
+ mse_big,
+ mse_big2,
+ mse_loop_mib,
+ mse_api,
+ mse_sa_register,
+ mse_v1_trap,
+ mse_sa_error,
+ mse_next_across_sa,
+ mse_undo,
+ mse_standard_mib,
+ mse_community_mib,
+ mse_framework_mib,
+ mse_target_mib,
+ mse_notification_mib,
+ mse_view_based_acm_mib,
+ mse_sparse_table,
+ mse_me_of,
+ mse_mib_of
+ ].
mib_storage_dets_cases() ->
-[msd_simple, msd_v1_processing, msd_big, msd_big2,
- msd_loop_mib, msd_api, msd_sa_register, msd_v1_trap,
- msd_sa_error, msd_next_across_sa, msd_undo,
- msd_standard_mib, msd_community_mib, msd_framework_mib,
- msd_target_mib, msd_notification_mib,
- msd_view_based_acm_mib, msd_sparse_table, msd_me_of,
- msd_mib_of].
+ [
+ msd_simple,
+ msd_v1_processing,
+ msd_big,
+ msd_big2,
+ msd_loop_mib,
+ msd_api,
+ msd_sa_register,
+ msd_v1_trap,
+ msd_sa_error,
+ msd_next_across_sa,
+ msd_undo,
+ msd_standard_mib,
+ msd_community_mib,
+ msd_framework_mib,
+ msd_target_mib,
+ msd_notification_mib,
+ msd_view_based_acm_mib,
+ msd_sparse_table,
+ msd_me_of,
+ msd_mib_of
+ ].
mib_storage_mnesia_cases() ->
-[msm_simple, msm_v1_processing, msm_big, msm_big2,
- msm_loop_mib, msm_api, msm_sa_register, msm_v1_trap,
- msm_sa_error, msm_next_across_sa, msm_undo,
- msm_standard_mib, msm_community_mib, msm_framework_mib,
- msm_target_mib, msm_notification_mib,
- msm_view_based_acm_mib, msm_sparse_table, msm_me_of,
- msm_mib_of].
+ [
+ msm_simple,
+ msm_v1_processing,
+ msm_big,
+ msm_big2,
+ msm_loop_mib,
+ msm_api,
+ msm_sa_register,
+ msm_v1_trap,
+ msm_sa_error,
+ msm_next_across_sa,
+ msm_undo,
+ msm_standard_mib,
+ msm_community_mib,
+ msm_framework_mib,
+ msm_target_mib,
+ msm_notification_mib,
+ msm_view_based_acm_mib,
+ msm_sparse_table,
+ msm_me_of,
+ msm_mib_of
+ ].
mse_size_check_cases() ->
[mse_size_check].
@@ -628,22 +996,27 @@ varm_mib_storage_mnesia_cases() ->
init_mib_storage_ets(Config) when is_list(Config) ->
?LOG("init_mib_storage_ets -> entry", []),
- MibStorage = {snmp_mib_storage,ets},
+ MibStorage = {mib_storage, [{module, snmpa_mib_storage_ets}]},
init_ms(Config, [MibStorage]).
init_mib_storage_dets(Config) when is_list(Config) ->
- ?LOG("init_mib_storage_ets -> entry", []),
+ ?LOG("init_mib_storage_dets -> entry", []),
?line AgentDbDir = ?GCONF(agent_db_dir, Config),
- MibStorage = {snmp_mib_storage, {dets, AgentDbDir}},
+ MibStorage = {mib_storage, [{module, snmpa_mib_storage_dets},
+ {options, [{dir, AgentDbDir}]}]},
init_ms(Config, [MibStorage]).
init_mib_storage_mnesia(Config) when is_list(Config) ->
- ?LOG("init_mib_storage_ets -> entry", []),
- MibStorage = {snmp_mib_storage, {mnesia,[]}},
+ ?LOG("init_mib_storage_mnesia -> entry", []),
+ ?line AgentNode = ?GCONF(snmp_master, Config),
+ MibStorage = {mib_storage, [{module, snmpa_mib_storage_mnesia},
+ {options, [{nodes, [AgentNode]}]}]},
init_ms(Config, [MibStorage]).
init_ms(Config, Opts) when is_list(Config) ->
- ?LOG("init_mib_storage_ets -> entry", []),
+ ?LOG("init_ms -> entry with"
+ "~n Config: ~p"
+ "~n Opts: ~p", [Config, Opts]),
?line SaNode = ?GCONF(snmp_sa, Config),
?line create_tables(SaNode),
?line AgentConfDir = ?GCONF(agent_conf_dir, Config),
@@ -651,23 +1024,26 @@ init_ms(Config, Opts) when is_list(Config) ->
?line Ip = ?GCONF(ip, Config),
?line config([v1], MgrDir, AgentConfDir,
tuple_to_list(Ip), tuple_to_list(Ip)),
- MasterAgentVerbosity = {snmp_master_agent_verbosity, trace},
- MibsVerbosity = {snmp_mibserver_verbosity, trace},
- SymStoreVerbosity = {snmp_symbolic_store_verbosity, trace},
+ MasterAgentVerbosity = {agent_verbosity, trace},
+ MibsVerbosity = {mib_server, [{verbosity, trace}]},
+ SymStoreVerbosity = {symbolic_store, [{verbosity, trace}]},
Opts1 = [MasterAgentVerbosity, MibsVerbosity, SymStoreVerbosity | Opts],
[{vsn, v1} | start_v1_agent(Config, Opts1)].
init_size_check_mse(Config) when is_list(Config) ->
- MibStorage = {snmp_mib_storage, ets},
+ MibStorage = {mib_storage, [{module, snmpa_mib_storage_ets}]},
init_size_check_ms(Config, [MibStorage]).
init_size_check_msd(Config) when is_list(Config) ->
AgentDbDir = ?GCONF(agent_db_dir, Config),
- MibStorage = {snmp_mib_storage, {dets, AgentDbDir}},
+ MibStorage = {mib_storage, [{module, snmpa_mib_storage_dets},
+ {options, [{dir, AgentDbDir}]}]},
init_size_check_ms(Config, [MibStorage]).
init_size_check_msm(Config) when is_list(Config) ->
- MibStorage = {snmp_mib_storage, {mnesia,[]}},
+ ?line AgentNode = ?GCONF(snmp_master, Config),
+ MibStorage = {mib_storage, [{module, snmpa_mib_storage_mnesia},
+ {options, [{nodes, [AgentNode]}]}]},
init_size_check_ms(Config, [MibStorage]).
init_size_check_ms(Config, Opts) when is_list(Config) ->
@@ -702,12 +1078,16 @@ init_varm_mib_storage_dets(Config) when is_list(Config) ->
?line Ip = ?GCONF(ip, Config),
?line config([v1], MgrDir, AgentConfDir,
tuple_to_list(Ip), tuple_to_list(Ip)),
- MibStorage = {snmp_mib_storage, {dets, AgentDbDir}},
- MasterAgentVerbosity = {snmp_master_agent_verbosity, trace},
- MibsVerbosity = {snmp_mibserver_verbosity, trace},
- SymStoreVerbosity = {snmp_symbolic_store_verbosity, trace},
- Opts = [MibStorage,MasterAgentVerbosity,MibsVerbosity,SymStoreVerbosity],
- [{vsn, v1}, {agent_opts,Opts} | Config].
+ MibStorage = {mib_storage, [{module, snmpa_mib_storage_dets},
+ {options, [{dir, AgentDbDir}]}]},
+ MasterAgentVerbosity = {agent_verbosity, trace},
+ MibsVerbosity = {mib_server, [{verbosity, trace}]},
+ SymStoreVerbosity = {symbolic_store, [{verbosity, trace}]},
+ Opts = [MibStorage,
+ MasterAgentVerbosity,
+ MibsVerbosity,
+ SymStoreVerbosity],
+ [{vsn, v1}, {agent_opts, Opts} | Config].
init_varm_mib_storage_mnesia(Config) when is_list(Config) ->
?LOG("init_varm_mib_storage_mnesia -> entry", []),
@@ -718,12 +1098,17 @@ init_varm_mib_storage_mnesia(Config) when is_list(Config) ->
?line Ip = ?GCONF(ip, Config),
?line config([v1], MgrDir, AgentConfDir,
tuple_to_list(Ip), tuple_to_list(Ip)),
- MibStorage = {snmp_mib_storage,{mnesia,[]}},
- MasterAgentVerbosity = {snmp_master_agent_verbosity, trace},
- MibsVerbosity = {snmp_mibserver_verbosity, trace},
- SymStoreVerbosity = {snmp_symbolic_store_verbosity, trace},
- Opts = [MibStorage,MasterAgentVerbosity,MibsVerbosity,SymStoreVerbosity],
- [{vsn, v1}, {agent_opts,Opts} | Config].
+ ?line AgentNode = ?GCONF(snmp_master, Config),
+ MibStorage = {mib_storage, [{module, snmpa_mib_storage_mnesia},
+ {options, [{nodes, [AgentNode]}]}]},
+ MasterAgentVerbosity = {agent_verbosity, trace},
+ MibsVerbosity = {mib_server, [{verbosity, trace}]},
+ SymStoreVerbosity = {symbolic_store, [{verbosity, trace}]},
+ Opts = [MibStorage,
+ MasterAgentVerbosity,
+ MibsVerbosity,
+ SymStoreVerbosity],
+ [{vsn, v1}, {agent_opts, Opts} | Config].
finish_mib_storage_ets(Config) when is_list(Config) ->
?LOG("finish_mib_storage_ets -> entry", []),
@@ -956,10 +1341,10 @@ varm_mib_start(Config) when is_list(Config) ->
%% Perform the test(s)
?DBG("varm_mib_start -> perform the tests", []),
- try_test(snmp_community_mib),
- try_test(snmp_framework_mib),
- try_test(snmp_target_mib),
- try_test(snmp_notification_mib),
+ try_test(snmp_community_mib_test),
+ try_test(snmp_framework_mib_test),
+ try_test(snmp_target_mib_test),
+ try_test(snmp_notification_mib_test),
%% Stop the agent (without deleting the stored files)
?DBG("varm_mib_start -> stop the agent", []),
@@ -1119,7 +1504,10 @@ finish_misc(Config) ->
finish_v1(Config).
misc_cases() ->
-[app_info, info_test].
+ [
+ app_info,
+ info_test
+ ].
app_info(suite) -> [];
app_info(Config) when is_list(Config) ->
@@ -1270,10 +1658,10 @@ v3_cases() ->
subagent_3,
mnesia_3,
loop_mib_3,
- multiple_reqs_3,
+ {group, multiple_reqs_3},
sa_register_3,
v3_trap,
- v3_inform,
+ {group, v3_inform},
sa_error_3,
next_across_sa_3,
undo_3,
@@ -1626,7 +2014,7 @@ change_target_addr_config(Config) when is_list(Config) ->
dummy_manager_start(MA) ->
?DBG("dummy_manager_start -> entry",[]),
- Pid = spawn(get(mgr_node), ?MODULE,dummy_manager_init,[self(),MA]),
+ Pid = spawn(get(mgr_node), ?MODULE, dummy_manager_init, [self(), MA]),
?DBG("dummy_manager_start -> Pid: ~p",[Pid]),
await_dummy_manager_started(Pid).
@@ -1818,23 +2206,41 @@ mnesia_2(X) -> ?P(mnesia_2), mnesia(X).
mnesia_3(X) -> ?P(mnesia_3), mnesia(X).
-
mul_cases() ->
-[mul_get, mul_get_err, mul_next, mul_next_err,
- mul_set_err].
-
+ [
+ mul_get,
+ mul_get_err,
+ mul_next,
+ mul_next_err,
+ mul_set,
+ mul_set_err
+ ].
+
-multiple_reqs_3(_X) ->
- {req, [], {conf, init_mul, mul_cases_3(), finish_mul}}.
+%% multiple_reqs_3(_X) ->
+%% {req, [], {conf, init_mul, mul_cases_3(), finish_mul}}.
mul_cases_2() ->
-[mul_get_2, mul_get_err_2, mul_next_2, mul_next_err_2,
- mul_set_err_2].
-
+ [
+ mul_get_2,
+ mul_get_err_2,
+ mul_next_2,
+ mul_next_err_2,
+ mul_set_2,
+ mul_set_err_2
+ ].
+
mul_cases_3() ->
- [mul_get_3, mul_get_err_3, mul_next_3, mul_next_err_3, mul_set_err_3].
+ [
+ mul_get_3,
+ mul_get_err_3,
+ mul_next_3,
+ mul_next_err_3,
+ mul_set_3,
+ mul_set_err_3
+ ].
init_mul(Config) when is_list(Config) ->
@@ -2056,27 +2462,32 @@ v3_trap(Config) when is_list(Config) ->
trap2(Config).
-v3_inform(_X) ->
- %% v2_inform(X).
- {req, [], {conf, init_v3_inform, [v3_inform_i], finish_v3_inform}}.
+v3_inform_cases() ->
+ [
+ v3_inform_i
+ ].
+
+init_v3_inform(X) ->
+ init_v2_inform(X).
+
+finish_v3_inform(X) ->
+ finish_v2_inform(X).
+
init_v2_inform(Config) when is_list(Config) ->
_Dir = ?config(agent_conf_dir, Config),
%% snmp_internal_mib:configure(Dir),
Config.
-init_v3_inform(X) ->
- init_v2_inform(X).
-
finish_v2_inform(Config) when is_list(Config) ->
_Dir = ?config(agent_conf_dir, Config),
%% snmp_internal_mib:configure(Dir),
Config.
-finish_v3_inform(X) ->
- finish_v2_inform(X).
-
-
+v2_inform_cases() ->
+ [
+ v2_inform_i
+ ].
v2_inform_i(suite) -> [];
v2_inform_i(Config) when is_list(Config) ->
@@ -2176,7 +2587,7 @@ next_across_sa(Config) when is_list(Config) ->
try_test(load_test_sa),
?P1("Testing next across subagent (endOfMibView from SA)..."),
- try_test(next_across_sa),
+ try_test(next_across_sa_test),
?P1("Unloading mib (Klas1)"),
snmpa:unload_mibs(SA, [MibDir ++ "Klas1"]),
@@ -2186,7 +2597,7 @@ next_across_sa(Config) when is_list(Config) ->
?P1("Starting another subagent (2) "),
?line {ok, SA2} = start_subagent(SaNode, ?klas1, "Klas1"),
?P1("Testing next across subagent (wrong prefix from SA)..."),
- try_test(next_across_sa),
+ try_test(next_across_sa_test),
?P1("stop subagent (1)..."),
stop_subagent(SA),
@@ -2315,6 +2726,15 @@ v3_processing(Config) when is_list(Config) ->
%% report, which makes it in sync. The notification-generating
%% application times out, and send again. This time it'll work.
+v3_security_cases() ->
+ [
+ v3_crypto_basic,
+ v3_md5_auth,
+ v3_sha_auth,
+ v3_des_priv
+ ].
+
+
v3_crypto_basic(suite) -> [];
v3_crypto_basic(_Config) ->
?P(v3_crypto_basic),
@@ -2453,9 +2873,9 @@ v3_des_priv(Config) when is_list(Config) ->
v3_sync(Funcs) ->
?DBG("v3_sync -> entry with Funcs: ~p",[Funcs]),
g([[sysDescr, 0]]),
- expect(432, report, [{?usmStatsNotInTimeWindows_instance, any}]),
+ ?expect2(report, [{?usmStatsNotInTimeWindows_instance, any}]),
g([[sysDescr, 0]]),
- expect(433, [{[sysDescr,0], any}]),
+ ?expect1([{[sysDescr,0], any}]),
lists:foreach(fun({Func, Args}) -> apply(?MODULE, Func, Args) end, Funcs).
v3_inform_sync(MA) ->
@@ -2466,9 +2886,9 @@ v3_inform_sync(MA) ->
?DBG("v3_sync -> wait some time: ",[]),
?SLEEP(20000), % more than 1500*10 in target_addr.conf
?DBG("v3_sync -> await response",[]),
- ?line expect(1, {inform, true},
- [{[sysUpTime, 0], any},
- {[snmpTrapOID, 0], ?system ++ [0,1]}]).
+ ?line ?expect2({inform, true},
+ [{[sysUpTime, 0], any},
+ {[snmpTrapOID, 0], ?system ++ [0,1]}]).
v2_caps(suite) -> [];
@@ -2484,11 +2904,11 @@ v2_caps_3(X) -> ?P(v2_caps_3), v2_caps(X).
v2_caps_i(Node) ->
?line Idx = rpc:call(Node, snmp, add_agent_caps, [[1,2,3,4,5], "test cap"]),
g([[sysORID, Idx], [sysORDescr, Idx]]),
- ?line expect(1, [{[sysORID, Idx], [1,2,3,4,5]},
- {[sysORDescr, Idx], "test cap"}]),
+ ?line ?expect1([{[sysORID, Idx], [1,2,3,4,5]},
+ {[sysORDescr, Idx], "test cap"}]),
?line rpc:call(Node, snmp, del_agent_caps, [Idx]),
g([[sysORID, Idx]]),
- ?line expect(2, [{[sysORID, Idx], noSuchInstance}]).
+ ?line ?expect1([{[sysORID, Idx], noSuchInstance}]).
%% Req. Test2
@@ -2504,86 +2924,86 @@ v1_proc() ->
v1_get_p() ->
%% 4.1.2:1
g([[test2]]),
- ?line expect(10, noSuchName, 1, [{[test2], 'NULL'}]),
+ ?line ?expect3(noSuchName, 1, [{[test2], 'NULL'}]),
g([[tDescr]]),
- ?line expect(11, noSuchName, 1, [{[tDescr], 'NULL'}]),
+ ?line ?expect3(noSuchName, 1, [{[tDescr], 'NULL'}]),
g([[tDescr2,0]]),
- ?line expect(12, noSuchName, 1, [{[tDescr2,0], 'NULL'}]),
+ ?line ?expect3(noSuchName, 1, [{[tDescr2,0], 'NULL'}]),
g([[tDescr3,0]]),
- ?line expect(131, noSuchName, 1, [{[tDescr3,0], 'NULL'}]),
+ ?line ?expect3(noSuchName, 1, [{[tDescr3,0], 'NULL'}]),
g([[tDescr4,0]]),
- ?line expect(132, noSuchName, 1, [{[tDescr4,0], 'NULL'}]),
+ ?line ?expect3(noSuchName, 1, [{[tDescr4,0], 'NULL'}]),
g([[sysDescr, 0], [tDescr,0]]), % Outside mibview
- ?line expect(14, noSuchName, 2, [{[sysDescr, 0], 'NULL'},
- {[tDescr,0], 'NULL'}]),
+ ?line ?expect3(noSuchName, 2, [{[sysDescr, 0], 'NULL'},
+ {[tDescr,0], 'NULL'}]),
g([[sysDescr,3]]),
- ?line expect(15, noSuchName, 1, [{[sysDescr, 3], 'NULL'}]),
+ ?line ?expect3(noSuchName, 1, [{[sysDescr, 3], 'NULL'}]),
%% 4.1.2:2
g([[tTable]]),
- ?line expect(20, noSuchName, 1, [{[tTable], 'NULL'}]),
+ ?line ?expect3(noSuchName, 1, [{[tTable], 'NULL'}]),
g([[tEntry]]),
- ?line expect(21, noSuchName, 1, [{[tEntry], 'NULL'}]),
+ ?line ?expect3(noSuchName, 1, [{[tEntry], 'NULL'}]),
%% 4.1.2:3
g([[tTooBig, 0]]),
- ?line expect(30, tooBig, 0, [{[tTooBig, 0], 'NULL'}]),
+ ?line ?expect3(tooBig, 0, [{[tTooBig, 0], 'NULL'}]),
%% 4.1.2:4
g([[tGenErr1, 0]]),
- ?line expect(40, genErr, 1, [{[tGenErr1, 0], 'NULL'}]),
+ ?line ?expect3(genErr, 1, [{[tGenErr1, 0], 'NULL'}]),
g([[tGenErr2, 0]]),
- ?line expect(41, genErr, 1, [{[tGenErr2, 0], 'NULL'}]),
+ ?line ?expect3(genErr, 1, [{[tGenErr2, 0], 'NULL'}]),
g([[sysDescr, 0], [tGenErr3, 0]]),
- ?line expect(42, genErr, 2, [{[sysDescr, 0], 'NULL'},
- {[tGenErr3, 0], 'NULL'}]).
+ ?line ?expect3(genErr, 2, [{[sysDescr, 0], 'NULL'},
+ {[tGenErr3, 0], 'NULL'}]).
v1_get_next_p() ->
%% 4.1.3:1
gn([[1,3,7,1]]),
- ?line expect(10, noSuchName, 1, [{[1,3,7,1], 'NULL'}]),
+ ?line ?expect3(noSuchName, 1, [{[1,3,7,1], 'NULL'}]),
gn([[tDescr2]]),
- ?line expect(11, tooBig, 0, any),
+ ?line ?expect3(tooBig, 0, any),
%% 4.1.3:2
gn([[tTooBig]]),
io:format("We currently don't handle tooBig correct!!!\n"),
-% ?line expect(20, tooBig, 0, [{[tTooBig], 'NULL'}]),
- ?line expect(20, tooBig, 0, any),
+% ?line ?expect3(tooBig, 0, [{[tTooBig], 'NULL'}]),
+ ?line ?expect3(tooBig, 0, any),
%% 4.1.3:3
gn([[tGenErr1]]),
% ?line expect(40, genErr, 1, [{[tGenErr1], 'NULL'}]),
- ?line expect(40, genErr, 1, any),
+ ?line ?expect3(genErr, 1, any),
gn([[tGenErr2]]),
-% ?line expect(41, genErr, 1, [{[tGenErr2], 'NULL'}]),
- ?line expect(41, genErr, 1, any),
+% ?line ?expect3(genErr, 1, [{[tGenErr2], 'NULL'}]),
+ ?line ?expect3(genErr, 1, any),
gn([[sysDescr], [tGenErr3]]),
-% ?line expect(42, genErr, 2, [{[sysDescr], 'NULL'},
+% ?line ?expect3(genErr, 2, [{[sysDescr], 'NULL'},
% {[tGenErr3], 'NULL'}]).
- ?line expect(42, genErr, 2, any).
+ ?line ?expect3(genErr, 2, any).
v1_set_p() ->
%% 4.1.5:1
s([{[1,3,7,0], i, 4}]),
- ?line expect(10, noSuchName, 1, [{[1,3,7,0], 4}]),
+ ?line ?expect3(noSuchName, 1, [{[1,3,7,0], 4}]),
s([{[tDescr,0], s, "outside mibview"}]),
- ?line expect(11, noSuchName, 1, [{[tDescr,0], "outside mibview"}]),
+ ?line ?expect3(noSuchName, 1, [{[tDescr,0], "outside mibview"}]),
s([{[tDescr3,0], s, "read-only"}]),
- ?line expect(12, noSuchName, 1, [{[tDescr3,0], "read-only"}]),
+ ?line ?expect3(noSuchName, 1, [{[tDescr3,0], "read-only"}]),
s([{[tDescr3], s, "noSuchObject"}]),
- ?line expect(13, noSuchName, 1, [{[tDescr3], "noSuchObject"}]),
+ ?line ?expect3(noSuchName, 1, [{[tDescr3], "noSuchObject"}]),
s([{[tDescr3,1], s, "noSuchInstance"}]),
- ?line expect(14, noSuchName, 1, [{[tDescr3,1], "noSuchInstance"}]),
+ ?line ?expect3(noSuchName, 1, [{[tDescr3,1], "noSuchInstance"}]),
s([{[tDescr2,0], s, "inconsistentName"}]),
- ?line expect(15, noSuchName, 1, [{[tDescr2,0], "inconsistentName"}]),
+ ?line ?expect3(noSuchName, 1, [{[tDescr2,0], "inconsistentName"}]),
%% 4.1.5:2
s([{[tDescr2, 0], i, 4}]),
- ?line expect(20, badValue, 1, [{[tDescr2, 0], 4}]),
+ ?line ?expect3(badValue, 1, [{[tDescr2, 0], 4}]),
s([{[tDescr2, 0], s, "badValue"}]),
- ?line expect(21, badValue, 1, [{[tDescr2, 0], "badValue"}]),
+ ?line ?expect3(badValue, 1, [{[tDescr2, 0], "badValue"}]),
%% 4.1.5:3
%% The standard is quite incorrect here. The resp pdu was too big. In
@@ -2593,14 +3013,14 @@ v1_set_p() ->
%% of the std-like original value.
s([{[tTooBig, 0], s, ?tooBigStr}]),
%% according to std:
-% ?line expect(30, tooBig, 0, [{[tTooBig, 0], ?tooBigStr}]),
- ?line expect(30, tooBig, 0, [{[tTooBig, 0], 'NULL'}]),
+% ?line ?expect3(tooBig, 0, [{[tTooBig, 0], ?tooBigStr}]),
+ ?line ?expect3(tooBig, 0, [{[tTooBig, 0], 'NULL'}]),
%% 4.1.5:4
s([{[tDescr2, 0], s, "is_set_ok_fail"}]),
- ?line expect(40, genErr, 1, [{[tDescr2, 0], "is_set_ok_fail"}]),
+ ?line ?expect3(genErr, 1, [{[tDescr2, 0], "is_set_ok_fail"}]),
s([{[tDescr2, 0], s, "commit_fail"}]),
- ?line expect(41, genErr, 1, [{[tDescr2, 0], "commit_fail"}]).
+ ?line ?expect3(genErr, 1, [{[tDescr2, 0], "commit_fail"}]).
%% Req. Test2
v2_proc() ->
@@ -2616,183 +3036,183 @@ v2_get_p() ->
%% 4.2.1:2
?DBG("v2_get_p -> entry",[]),
g([[test2]]),
- ?line expect(10, [{[test2], noSuchObject}]),
+ ?line ?expect1([{[test2], noSuchObject}]),
g([[tDescr]]),
- ?line expect(11, [{[tDescr], noSuchObject}]),
+ ?line ?expect1([{[tDescr], noSuchObject}]),
g([[tDescr4,0]]),
- ?line expect(12, [{[tDescr4,0], noSuchObject}]),
+ ?line ?expect1([{[tDescr4,0], noSuchObject}]),
g([[sysDescr, 0], [tDescr,0]]), % Outside mibview
- ?line expect(13, [{[sysDescr,0], "Erlang SNMP agent"},
- {[tDescr,0], noSuchObject}]),
+ ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"},
+ {[tDescr,0], noSuchObject}]),
g([[tTable]]),
- ?line expect(14, [{[tTable], noSuchObject}]),
+ ?line ?expect1([{[tTable], noSuchObject}]),
g([[tEntry]]),
- ?line expect(15, [{[tEntry], noSuchObject}]),
+ ?line ?expect1([{[tEntry], noSuchObject}]),
%% 4.2.1:3
g([[tDescr2,0]]), %% instrum ret noSuchName!!!
- ?line expect(20, [{[tDescr2,0], noSuchInstance}]),
+ ?line ?expect1([{[tDescr2,0], noSuchInstance}]),
g([[tDescr3,0]]),
- ?line expect(21, [{[tDescr3,0], noSuchInstance}]),
+ ?line ?expect1([{[tDescr3,0], noSuchInstance}]),
g([[sysDescr,3]]),
- ?line expect(22, [{[sysDescr, 3], noSuchInstance}]),
+ ?line ?expect1([{[sysDescr, 3], noSuchInstance}]),
g([[tIndex,1]]),
- ?line expect(23, [{[tIndex, 1], noSuchInstance}]),
+ ?line ?expect1([{[tIndex, 1], noSuchInstance}]),
%% 4.2.1 - any other error: genErr
g([[tGenErr1, 0]]),
- ?line expect(30, genErr, 1, [{[tGenErr1, 0], 'NULL'}]),
+ ?line ?expect3(genErr, 1, [{[tGenErr1, 0], 'NULL'}]),
g([[tGenErr2, 0]]),
- ?line expect(31, genErr, 1, [{[tGenErr2, 0], 'NULL'}]),
+ ?line ?expect3(genErr, 1, [{[tGenErr2, 0], 'NULL'}]),
g([[sysDescr, 0], [tGenErr3, 0]]),
- ?line expect(32, genErr, 2, [{[sysDescr, 0], 'NULL'},
- {[tGenErr3, 0], 'NULL'}]),
+ ?line ?expect3(genErr, 2, [{[sysDescr, 0], 'NULL'},
+ {[tGenErr3, 0], 'NULL'}]),
%% 4.2.1 - tooBig
g([[tTooBig, 0]]),
- ?line expect(40, tooBig, 0, []).
+ ?line ?expect3(tooBig, 0, []).
v2_get_next_p() ->
%% 4.2.2:2
?DBG("v2_get_next_p -> entry",[]),
gn([[1,3,7,1]]),
- ?line expect(10, [{[1,3,7,1], endOfMibView}]),
+ ?line ?expect1([{[1,3,7,1], endOfMibView}]),
gn([[sysDescr], [1,3,7,1]]),
- ?line expect(11, [{[sysDescr, 0], "Erlang SNMP agent"},
- {[1,3,7,1], endOfMibView}]),
+ ?line ?expect1([{[sysDescr, 0], "Erlang SNMP agent"},
+ {[1,3,7,1], endOfMibView}]),
gn([[tCnt2, 1]]),
- ?line expect(12, [{[tCnt2,2], 100}]),
+ ?line ?expect1([{[tCnt2,2], 100}]),
gn([[tCnt2, 2]]),
- ?line expect(12, [{[tCnt2,2], endOfMibView}]),
+ ?line ?expect1([{[tCnt2,2], endOfMibView}]),
%% 4.2.2 - any other error: genErr
gn([[tGenErr1]]),
- ?line expect(20, genErr, 1, [{[tGenErr1], 'NULL'}]),
+ ?line ?expect3(genErr, 1, [{[tGenErr1], 'NULL'}]),
gn([[tGenErr2]]),
- ?line expect(21, genErr, 1, [{[tGenErr2], 'NULL'}]),
+ ?line ?expect3(genErr, 1, [{[tGenErr2], 'NULL'}]),
gn([[sysDescr], [tGenErr3]]),
- ?line expect(22, genErr, 2, [{[sysDescr], 'NULL'},
- {[tGenErr3], 'NULL'}]),
+ ?line ?expect3(genErr, 2, [{[sysDescr], 'NULL'},
+ {[tGenErr3], 'NULL'}]),
%% 4.2.2 - tooBig
gn([[tTooBig]]),
- ?line expect(20, tooBig, 0, []).
+ ?line ?expect3(tooBig, 0, []).
v2_get_bulk_p() ->
%% 4.2.3
?DBG("v2_get_bulk_p -> entry",[]),
gb(1, 1, []),
- ?line expect(10, []),
+ ?line ?expect1([]),
gb(-1, 1, []),
- ?line expect(11, []),
+ ?line ?expect1([]),
gb(-1, -1, []),
- ?line expect(12, []),
+ ?line ?expect1([]),
gb(-1, -1, []),
- ?line expect(13, []),
+ ?line ?expect1([]),
gb(2, 0, [[sysDescr], [1,3,7,1]]),
- ?line expect(14, [{[sysDescr, 0], "Erlang SNMP agent"},
- {[1,3,7,1], endOfMibView}]),
+ ?line ?expect1([{[sysDescr, 0], "Erlang SNMP agent"},
+ {[1,3,7,1], endOfMibView}]),
gb(1, 2, [[sysDescr], [1,3,7,1]]),
- ?line expect(15, [{[sysDescr, 0], "Erlang SNMP agent"},
- {[1,3,7,1], endOfMibView}]),
+ ?line ?expect1([{[sysDescr, 0], "Erlang SNMP agent"},
+ {[1,3,7,1], endOfMibView}]),
gb(0, 2, [[sysDescr], [1,3,7,1]]),
- ?line expect(16, [{[sysDescr, 0], "Erlang SNMP agent"},
- {[1,3,7,1], endOfMibView},
- {[sysObjectID, 0], [1,2,3]},
- {[1,3,7,1], endOfMibView}]),
+ ?line ?expect1([{[sysDescr, 0], "Erlang SNMP agent"},
+ {[1,3,7,1], endOfMibView},
+ {[sysObjectID, 0], [1,2,3]},
+ {[1,3,7,1], endOfMibView}]),
gb(2, 2, [[sysDescr], [1,3,7,1], [sysDescr], [1,3,7,1]]),
- ?line expect(17, [{[sysDescr, 0], "Erlang SNMP agent"},
- {[1,3,7,1], endOfMibView},
- {[sysDescr, 0], "Erlang SNMP agent"},
- {[1,3,7,1], endOfMibView},
- {[sysObjectID, 0], [1,2,3]},
- {[1,3,7,1], endOfMibView}]),
+ ?line ?expect1([{[sysDescr, 0], "Erlang SNMP agent"},
+ {[1,3,7,1], endOfMibView},
+ {[sysDescr, 0], "Erlang SNMP agent"},
+ {[1,3,7,1], endOfMibView},
+ {[sysObjectID, 0], [1,2,3]},
+ {[1,3,7,1], endOfMibView}]),
gb(1, 2, [[sysDescr], [sysDescr], [tTooBig]]),
- ?line expect(18, [{[sysDescr, 0], "Erlang SNMP agent"},
- {[sysDescr, 0], "Erlang SNMP agent"}]),
+ ?line ?expect1([{[sysDescr, 0], "Erlang SNMP agent"},
+ {[sysDescr, 0], "Erlang SNMP agent"}]),
gb(1,12, [[tDescr2], [sysDescr]]), % next one after tDescr2 is tTooBig.
- ?line expect(19, []),
+ ?line ?expect1([]),
gb(2,2, [[sysDescr], [sysObjectID], [tGenErr1], [sysDescr]]),
- ?line expect(20, genErr, 3, [{[sysDescr], 'NULL'},
- {[sysObjectID], 'NULL'},
- {[tGenErr1], 'NULL'},
- {[sysDescr], 'NULL'}]),
+ ?line ?expect3(genErr, 3, [{[sysDescr], 'NULL'},
+ {[sysObjectID], 'NULL'},
+ {[tGenErr1], 'NULL'},
+ {[sysDescr], 'NULL'}]),
gb(0, 2, [[tCnt2, 1]]),
- ?line expect(21, [{[tCnt2,2], 100},
- {[tCnt2,2], endOfMibView}]).
+ ?line ?expect1([{[tCnt2,2], 100},
+ {[tCnt2,2], endOfMibView}]).
v2_set_p() ->
%% 4.2.5:1
?DBG("v2_set_p -> entry",[]),
s([{[1,3,7,0], i, 4}]),
- ?line expect(10, noAccess, 1, [{[1,3,7,0], 4}]),
+ ?line ?expect3(noAccess, 1, [{[1,3,7,0], 4}]),
s([{[tDescr,0], s, "outside mibview"}]),
- ?line expect(11, noAccess, 1, [{[tDescr,0], "outside mibview"}]),
+ ?line ?expect3(noAccess, 1, [{[tDescr,0], "outside mibview"}]),
%% 4.2.5:2
s([{[1,3,6,1,0], s, "noSuchObject"}]),
- ?line expect(20, notWritable, 1, [{[1,3,6,1,0], "noSuchObject"}]),
+ ?line ?expect3(notWritable, 1, [{[1,3,6,1,0], "noSuchObject"}]),
%% 4.2.5:3
s([{[tDescr2, 0], i, 4}]),
- ?line expect(30, wrongType, 1, [{[tDescr2, 0], 4}]),
+ ?line ?expect3(wrongType, 1, [{[tDescr2, 0], 4}]),
s([{[tDescr2, 0], s, "badValue"}]),
- ?line expect(31, badValue, 1, [{[tDescr2, 0], "badValue"}]),
+ ?line ?expect3(badValue, 1, [{[tDescr2, 0], "badValue"}]),
%% 4.2.5:4
s([{[tStr, 0], s, ""}]),
- ?line expect(40, wrongLength, 1, [{[tStr, 0], ""}]),
+ ?line ?expect3(wrongLength, 1, [{[tStr, 0], ""}]),
s([{[tStr, 0], s, "12345"}]),
- ?line expect(40, wrongLength, 1, [{[tStr, 0], "12345"}]),
+ ?line ?expect3(wrongLength, 1, [{[tStr, 0], "12345"}]),
%% 4.2.5:5 - N/A
%% 4.2.5:6
s([{[tInt1, 0], i, 0}]),
- ?line expect(60, wrongValue, 1, [{[tInt1, 0], 0}]),
+ ?line ?expect3(wrongValue, 1, [{[tInt1, 0], 0}]),
s([{[tInt1, 0], i, 5}]),
- ?line expect(61, wrongValue, 1, [{[tInt1, 0], 5}]),
+ ?line ?expect3(wrongValue, 1, [{[tInt1, 0], 5}]),
s([{[tInt2, 0], i, 0}]),
- ?line expect(62, wrongValue, 1, [{[tInt2, 0], 0}]),
+ ?line ?expect3(wrongValue, 1, [{[tInt2, 0], 0}]),
s([{[tInt2, 0], i, 5}]),
- ?line expect(63, wrongValue, 1, [{[tInt2, 0], 5}]),
+ ?line ?expect3(wrongValue, 1, [{[tInt2, 0], 5}]),
s([{[tInt3, 0], i, 5}]),
- ?line expect(64, wrongValue, 1, [{[tInt3, 0], 5}]),
+ ?line ?expect3(wrongValue, 1, [{[tInt3, 0], 5}]),
%% 4.2.5:7
s([{[tDescrX, 1, 1], s, "noCreation"}]),
- ?line expect(70, noCreation, 1, [{[tDescrX, 1, 1], "noCreation"}]),
+ ?line ?expect3(noCreation, 1, [{[tDescrX, 1, 1], "noCreation"}]),
%% 4.2.5:8
s([{[tDescrX, 1, 2], s, "inconsistentName"}]),
- ?line expect(80, inconsistentName, 1,
- [{[tDescrX, 1, 2], "inconsistentName"}]),
+ ?line ?expect3(inconsistentName, 1,
+ [{[tDescrX, 1, 2], "inconsistentName"}]),
%% 4.2.5:9
s([{[tCnt, 1, 2], i, 5}]),
- ?line expect(90, notWritable, 1, [{[tCnt, 1, 2], 5}]),
+ ?line ?expect3(notWritable, 1, [{[tCnt, 1, 2], 5}]),
s([{[tDescr3,0], s, "read-only"}]),
- ?line expect(90, notWritable, 1, [{[tDescr3,0], "read-only"}]),
+ ?line ?expect3(notWritable, 1, [{[tDescr3,0], "read-only"}]),
%% 4.2.5:10
s([{[tDescr2,0], s, "inconsistentValue"}]),
- ?line expect(100, inconsistentValue, 1,
- [{[tDescr2,0], "inconsistentValue"}]),
+ ?line ?expect3(inconsistentValue, 1,
+ [{[tDescr2,0], "inconsistentValue"}]),
%% 4.2.5:11
s([{[tDescr2,0], s, "resourceUnavailable"}]),
- ?line expect(110, resourceUnavailable, 1,
- [{[tDescr2,0],"resourceUnavailable"}]),
+ ?line ?expect3(resourceUnavailable, 1,
+ [{[tDescr2,0],"resourceUnavailable"}]),
%% 4.2.5:12
s([{[tDescr2, 0], s, "is_set_ok_fail"}]),
- ?line expect(120, genErr, 1, [{[tDescr2, 0], "is_set_ok_fail"}]).
+ ?line ?expect3(genErr, 1, [{[tDescr2, 0], "is_set_ok_fail"}]).
%% commitFailed and undoFailed is tested by the 'undo' case.
@@ -2807,101 +3227,101 @@ table_test() ->
Key1c4 = [intCommunityAccess,get(mip),is("public")],
EndKey = [intCommunityEntry,[9],get(mip),is("public")],
gn([[intCommunityEntry]]),
- ?line expect(7, [{Key1c3, 2}]),
+ ?line ?expect1([{Key1c3, 2}]),
gn([[intCommunityTable]]),
- ?line expect(71, [{Key1c3, 2}]),
+ ?line ?expect1([{Key1c3, 2}]),
gn([[community]]),
- ?line expect(72, [{Key1c3, 2}]),
+ ?line ?expect1([{Key1c3, 2}]),
gn([[otpSnmpeaMIB]]),
- ?line expect(73, [{Key1c3, 2}]),
+ ?line ?expect1([{Key1c3, 2}]),
gn([[ericsson]]),
- ?line expect(74, [{Key1c3, 2}]),
+ ?line ?expect1([{Key1c3, 2}]),
gn([Key1c3]),
- ?line expect(8, [{Key2c3, 2}]),
+ ?line ?expect1([{Key2c3, 2}]),
gn([Key2c3]),
- ?line expect(9, [{Key1c4, 2}]),
+ ?line ?expect1([{Key1c4, 2}]),
gn([EndKey]),
AgentIp = [intAgentIpAddress,0],
- ?line expect(10, [{AgentIp, any}]),
+ ?line ?expect1([{AgentIp, any}]),
g([Key1c3]),
- ?line expect(11, [{Key1c3, 2}]),
+ ?line ?expect1([{Key1c3, 2}]),
g([EndKey]),
- ?line ?v1_2(expect(12, noSuchName, 1, any),
- expect(12, [{EndKey, noSuchObject}])),
+ ?line ?v1_2(?expect3(noSuchName, 1, any),
+ ?expect1([{EndKey, noSuchObject}])),
io:format("Testing row creation/deletion on communityTable...~n"),
NewKeyc3 = [intCommunityViewIndex,get(mip),is("test")],
NewKeyc4 = [intCommunityAccess,get(mip),is("test")],
NewKeyc5 = [intCommunityStatus,get(mip),is("test")],
s([{NewKeyc5, ?createAndGo}]),
- ?line expect(14, ?v1_2(badValue, inconsistentValue), 1,any),
+ ?line ?expect3(?v1_2(badValue, inconsistentValue), 1, any),
s([{NewKeyc5, ?createAndGo}, {NewKeyc3, 2}, {NewKeyc4, 2}]),
- ?line expect(15, [{NewKeyc5, ?createAndGo},{NewKeyc3, 2}, {NewKeyc4, 2}]),
+ ?line ?expect1([{NewKeyc5, ?createAndGo},{NewKeyc3, 2}, {NewKeyc4, 2}]),
g([NewKeyc4]),
- ?line expect(16, [{NewKeyc4, 2}]),
+ ?line ?expect1([{NewKeyc4, 2}]),
s([{NewKeyc5, ?destroy}]),
- ?line expect(17, [{NewKeyc5, ?destroy}]),
+ ?line ?expect1([{NewKeyc5, ?destroy}]),
s([{NewKeyc4, 2}]),
- ?line expect(18, ?v1_2(noSuchName, inconsistentName), 1,[{NewKeyc4, 2}]),
+ ?line ?expect3(?v1_2(noSuchName, inconsistentName), 1, [{NewKeyc4, 2}]),
s([{NewKeyc5, ?createAndWait}]),
- ?line expect(19, [{NewKeyc5, ?createAndWait}]),
+ ?line ?expect1([{NewKeyc5, ?createAndWait}]),
g([NewKeyc5]),
- ?line expect(20, [{NewKeyc5, ?notReady}]),
+ ?line ?expect1([{NewKeyc5, ?notReady}]),
s([{NewKeyc4, 2}]),
- ?line expect(21, [{NewKeyc4, 2}]),
+ ?line ?expect1([{NewKeyc4, 2}]),
g([NewKeyc5]),
- ?line expect(22, [{NewKeyc5, ?notReady}]),
+ ?line ?expect1([{NewKeyc5, ?notReady}]),
s([{NewKeyc3, 2}]),
- ?line expect(23, [{NewKeyc3, 2}]),
+ ?line ?expect1([{NewKeyc3, 2}]),
g([NewKeyc5]),
- ?line expect(24, [{NewKeyc5, ?notInService}]),
+ ?line ?expect1([{NewKeyc5, ?notInService}]),
s([{NewKeyc5, ?active}]),
- ?line expect(25, [{NewKeyc5, ?active}]),
+ ?line ?expect1([{NewKeyc5, ?active}]),
s([{NewKeyc5, ?destroy}]),
- ?line expect(26, [{NewKeyc5, ?destroy}]),
+ ?line ?expect1([{NewKeyc5, ?destroy}]),
s([{NewKeyc3, 3}]),
- ?line expect(27, ?v1_2(noSuchName, inconsistentName), 1,[{NewKeyc3, 3}]),
- otp_1128().
+ ?line ?expect3(?v1_2(noSuchName, inconsistentName), 1, [{NewKeyc3, 3}]),
+ otp_1128_test().
%% Req. system group
simple_standard_test() ->
?DBG("simple_standard_test -> entry",[]),
gn([[1,1]]),
- ?line expect(1, [{[sysDescr,0], "Erlang SNMP agent"}]),
+ ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"}]),
gn([[1,3]]),
- ?line expect(11, [{[sysDescr,0], "Erlang SNMP agent"}]),
+ ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"}]),
gn([[1,3,6]]),
- ?line expect(12, [{[sysDescr,0], "Erlang SNMP agent"}]),
+ ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"}]),
gn([[1,3,6,1]]),
- ?line expect(13, [{[sysDescr,0], "Erlang SNMP agent"}]),
+ ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"}]),
gn([[1,3,6,1,2]]),
- ?line expect(14, [{[sysDescr,0], "Erlang SNMP agent"}]),
+ ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"}]),
gn([[1,3,6,1,2,1]]),
- ?line expect(15, [{[sysDescr,0], "Erlang SNMP agent"}]),
+ ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"}]),
gn([[1,3,6,1,2,1,1]]),
- ?line expect(16, [{[sysDescr,0], "Erlang SNMP agent"}]),
+ ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"}]),
gn([[sysDescr]]),
- ?line expect(17, [{[sysDescr,0], "Erlang SNMP agent"}]),
+ ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"}]),
g([[sysDescr,0]]),
- ?line expect(2, [{[sysDescr,0], "Erlang SNMP agent"}]),
+ ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"}]),
g([[sysDescr]]),
- ?line ?v1_2(expect(3, noSuchName, 1, any),
- expect(3, [{[sysDescr], noSuchObject}])),
+ ?line ?v1_2(?expect3(noSuchName, 1, any),
+ ?expect1([{[sysDescr], noSuchObject}])),
g([[1,6,7,0]]),
- ?line ?v1_2(expect(41, noSuchName, 1, any),
- expect(3, [{[1,6,7,0], noSuchObject}])),
+ ?line ?v1_2(?expect3(noSuchName, 1, any),
+ ?expect1([{[1,6,7,0], noSuchObject}])),
gn([[1,13]]),
- ?line ?v1_2(expect(4, noSuchName,1, any),
- expect(4, [{[1,13], endOfMibView}])),
+ ?line ?v1_2(?expect3(noSuchName,1, any),
+ ?expect1([{[1,13], endOfMibView}])),
s([{[sysLocation, 0], "new_value"}]),
- ?line expect(5, [{[sysLocation, 0], "new_value"}]),
+ ?line ?expect1([{[sysLocation, 0], "new_value"}]),
g([[sysLocation, 0]]),
- ?line expect(6, [{[sysLocation, 0], "new_value"}]),
+ ?line ?expect1([{[sysLocation, 0], "new_value"}]),
io:format("Testing noSuchName and badValue...~n"),
s([{[sysServices,0], 3}]),
- ?line expect(61, ?v1_2(noSuchName, notWritable), 1, any),
+ ?line ?expect3(?v1_2(noSuchName, notWritable), 1, any),
s([{[sysLocation, 0], i, 3}]),
- ?line expect(62, ?v1_2(badValue, wrongType), 1, any),
+ ?line ?expect3(?v1_2(badValue, wrongType), 1, any),
?DBG("simple_standard_test -> done",[]),
ok.
@@ -2918,7 +3338,7 @@ db_notify_client(Config) when is_list(Config) ->
snmpa_local_db:verbosity(trace),
Self = self(),
?DBG("db_notify_client -> register self (~p) notify client", [Self]),
- snmpa_local_db:register_notify_client(self(),?MODULE),
+ snmpa_local_db:register_notify_client(Self, ?MODULE),
%% This call (to the manager) will issue to set operations, so
%% we expect to receive to notify(insert) calls.
@@ -2943,7 +3363,7 @@ db_notify_client(Config) when is_list(Config) ->
end,
?DBG("db_notify_client -> unregister self (~p) notify client", [Self]),
- snmpa_local_db:unregister_notify_client(self()),
+ snmpa_local_db:unregister_notify_client(Self),
?DBG("db_notify_client -> minimize verbosity", []),
snmpa_local_db:verbosity(silence),
@@ -2955,12 +3375,13 @@ db_notify_client(Config) when is_list(Config) ->
db_notify_client_test() ->
?DBG("set first new sysLocation",[]),
s([{[sysLocation, 0], "new_value"}]),
- ?line expect(5, [{[sysLocation, 0], "new_value"}]),
+ ?line ?expect1([{[sysLocation, 0], "new_value"}]),
?DBG("set second new sysLocation",[]),
s([{[sysLocation, 0], "new_value"}]),
- ?line expect(5, [{[sysLocation, 0], "new_value"}]).
+ ?line ?expect1([{[sysLocation, 0], "new_value"}]).
+%% Callback function
notify(Pid, What) ->
?DBG("notify(~p,~p) -> called",[Pid,What]),
Pid ! {db_notify_test_reply, What}.
@@ -2976,24 +3397,23 @@ big_test() ->
?DBG("big_test -> testing simple next/get/set @ subagent...",[]),
gn([[klas1]]),
- ?line expect(1, [{[fname,0], ""}]),
+ ?line ?expect1([{[fname,0], ""}]),
g([[fname,0]]),
- ?line expect(2, [{[fname,0], ""}]),
+ ?line ?expect1([{[fname,0], ""}]),
s([{[fname,0], s, "test set"}]),
- ?line expect(3, [{[fname,0], "test set"}]),
+ ?line ?expect1([{[fname,0], "test set"}]),
g([[fname,0]]),
- ?line expect(4, [{[fname,0], "test set"}]),
+ ?line ?expect1([{[fname,0], "test set"}]),
?DBG("big_test -> "
"testing next from last instance in master to subagent...",[]),
gn([[?v1_2(sysServices, sysORLastChange),0]]),
- ?line expect(5, [{[fname,0], "test set"}]),
- gn([[1,1],
- [?v1_2(sysServices, sysORLastChange),0]]),
- ?line expect(51, [{[sysDescr,0], "Erlang SNMP agent"},
- {[fname,0], "test set"}]),
+ ?line ?expect1([{[fname,0], "test set"}]),
+ gn([[1,1], [?v1_2(sysServices, sysORLastChange),0]]),
+ ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"},
+ {[fname,0], "test set"}]),
s([{[fname,0], s, ""}]),
- ?line expect(52, [{[fname,0], ""}]),
+ ?line ?expect1([{[fname,0], ""}]),
table_test(),
@@ -3001,43 +3421,43 @@ big_test() ->
_FTab = [friendsEntry],
s([{[friendsEntry, [2, 3]], s, "kompis3"},
{[friendsEntry, [3, 3]], i, ?createAndGo}]),
- ?line expect(6, [{[friendsEntry, [2, 3]], "kompis3"},
- {[friendsEntry, [3, 3]], ?createAndGo}]),
+ ?line ?expect1([{[friendsEntry, [2, 3]], "kompis3"},
+ {[friendsEntry, [3, 3]], ?createAndGo}]),
g([[friendsEntry, [2, 3]],
[friendsEntry, [3, 3]]]),
- ?line expect(7, [{[friendsEntry, [2, 3]], "kompis3"},
- {[friendsEntry, [3, 3]], ?active}]),
+ ?line ?expect1([{[friendsEntry, [2, 3]], "kompis3"},
+ {[friendsEntry, [3, 3]], ?active}]),
s([{[friendsEntry, [3, 3]], i, ?destroy}]),
- ?line expect(8, [{[friendsEntry, [3, 3]], ?destroy}]),
+ ?line ?expect1([{[friendsEntry, [3, 3]], ?destroy}]),
- otp_1131(),
+ otp_1131_test(),
?DBG("big_test -> adding two rows in subagent table with special INDEX",
[]),
s([{[kompissEntry, [1, 3]], s, "kompis3"},
{[kompissEntry, [2, 3]], i, ?createAndGo}]),
- ?line expect(9, [{[kompissEntry, [1, 3]], "kompis3"},
- {[kompissEntry, [2, 3]], ?createAndGo}]),
+ ?line ?expect1([{[kompissEntry, [1, 3]], "kompis3"},
+ {[kompissEntry, [2, 3]], ?createAndGo}]),
g([[kompissEntry, [1, 3]],
[kompissEntry, [2, 3]]]),
- ?line expect(10, [{[kompissEntry, [1, 3]], "kompis3"},
- {[kompissEntry, [2, 3]], ?active}]),
+ ?line ?expect1([{[kompissEntry, [1, 3]], "kompis3"},
+ {[kompissEntry, [2, 3]], ?active}]),
gn([[kompissEntry, [1]],
[kompissEntry, [2]]]),
- ?line expect(11, [{[kompissEntry, [1, 3]], "kompis3"},
- {[kompissEntry, [2, 3]], ?active}]),
+ ?line ?expect1([{[kompissEntry, [1, 3]], "kompis3"},
+ {[kompissEntry, [2, 3]], ?active}]),
s([{[kompissEntry, [1, 2]], s, "kompis3"},
{[kompissEntry, [2, 2]], i, ?createAndGo}]),
- ?line expect(12, [{[kompissEntry, [1, 2]], "kompis3"},
- {[kompissEntry, [2, 2]], ?createAndGo}]),
+ ?line ?expect1([{[kompissEntry, [1, 2]], "kompis3"},
+ {[kompissEntry, [2, 2]], ?createAndGo}]),
gn([[kompissEntry, [1, 1]],
[kompissEntry, [2, 1]]]),
- ?line expect(13, [{[kompissEntry, [1, 2]], "kompis3"},
- {[kompissEntry, [2, 2]], ?active}]),
+ ?line ?expect1([{[kompissEntry, [1, 2]], "kompis3"},
+ {[kompissEntry, [2, 2]], ?active}]),
s([{[kompissEntry, [2, 3]], i, ?destroy}]),
- ?line expect(14, [{[kompissEntry, [2, 3]], ?destroy}]),
+ ?line ?expect1([{[kompissEntry, [2, 3]], ?destroy}]),
s([{[kompissEntry, [2, 2]], i, ?destroy}]),
- ?line expect(15, [{[kompissEntry, [2, 2]], ?destroy}]),
+ ?line ?expect1([{[kompissEntry, [2, 2]], ?destroy}]),
?DBG("big_test -> done",[]),
ok.
@@ -3048,23 +3468,22 @@ big_test_2() ->
?P1("Testing simple next/get/set @ subagent (2)..."),
gn([[klas2]]),
- ?line expect(1, [{[fname2,0], ""}]),
+ ?line ?expect1([{[fname2,0], ""}]),
g([[fname2,0]]),
- ?line expect(2, [{[fname2,0], ""}]),
+ ?line ?expect1([{[fname2,0], ""}]),
s([{[fname2,0], s, "test set"}]),
- ?line expect(3, [{[fname2,0], "test set"}]),
+ ?line ?expect1([{[fname2,0], "test set"}]),
g([[fname2,0]]),
- ?line expect(4, [{[fname2,0], "test set"}]),
+ ?line ?expect1([{[fname2,0], "test set"}]),
- otp_1298(),
+ otp_1298_test(),
?P1("Testing next from last object in master to subagent (2)..."),
gn([[?v1_2(sysServices, sysORLastChange),0]]),
- ?line expect(5, [{[fname2,0], "test set"}]),
- gn([[1,1],
- [?v1_2(sysServices, sysORLastChange),0]]),
- ?line expect(51, [{[sysDescr,0], "Erlang SNMP agent"},
- {[fname2,0], "test set"}]),
+ ?line ?expect1([{[fname2,0], "test set"}]),
+ gn([[1,1], [?v1_2(sysServices, sysORLastChange),0]]),
+ ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"},
+ {[fname2,0], "test set"}]),
table_test(),
@@ -3072,40 +3491,40 @@ big_test_2() ->
_FTab = [friendsEntry2],
s([{[friendsEntry2, [2, 3]], s, "kompis3"},
{[friendsEntry2, [3, 3]], i, ?createAndGo}]),
- ?line expect(6, [{[friendsEntry2, [2, 3]], "kompis3"},
- {[friendsEntry2, [3, 3]], ?createAndGo}]),
+ ?line ?expect1([{[friendsEntry2, [2, 3]], "kompis3"},
+ {[friendsEntry2, [3, 3]], ?createAndGo}]),
g([[friendsEntry2, [2, 3]],
[friendsEntry2, [3, 3]]]),
- ?line expect(7, [{[friendsEntry2, [2, 3]], "kompis3"},
- {[friendsEntry2, [3, 3]], ?active}]),
+ ?line ?expect1([{[friendsEntry2, [2, 3]], "kompis3"},
+ {[friendsEntry2, [3, 3]], ?active}]),
s([{[friendsEntry2, [3, 3]], i, ?destroy}]),
- ?line expect(8, [{[friendsEntry2, [3, 3]], ?destroy}]),
+ ?line ?expect1([{[friendsEntry2, [3, 3]], ?destroy}]),
?P1("Adding two rows in subagent table with special INDEX (2)"),
s([{[kompissEntry2, [1, 3]], s, "kompis3"},
{[kompissEntry2, [2, 3]], i, ?createAndGo}]),
- ?line expect(9, [{[kompissEntry2, [1, 3]], "kompis3"},
- {[kompissEntry2, [2, 3]], ?createAndGo}]),
+ ?line ?expect1([{[kompissEntry2, [1, 3]], "kompis3"},
+ {[kompissEntry2, [2, 3]], ?createAndGo}]),
g([[kompissEntry2, [1, 3]],
[kompissEntry2, [2, 3]]]),
- ?line expect(10, [{[kompissEntry2, [1, 3]], "kompis3"},
- {[kompissEntry2, [2, 3]], ?active}]),
+ ?line ?expect1([{[kompissEntry2, [1, 3]], "kompis3"},
+ {[kompissEntry2, [2, 3]], ?active}]),
gn([[kompissEntry2, [1]],
[kompissEntry2, [2]]]),
- ?line expect(11, [{[kompissEntry2, [1, 3]], "kompis3"},
- {[kompissEntry2, [2, 3]], ?active}]),
+ ?line ?expect1([{[kompissEntry2, [1, 3]], "kompis3"},
+ {[kompissEntry2, [2, 3]], ?active}]),
s([{[kompissEntry2, [1, 2]], s, "kompis3"},
{[kompissEntry2, [2, 2]], i, ?createAndGo}]),
- ?line expect(12, [{[kompissEntry2, [1, 2]], "kompis3"},
- {[kompissEntry2, [2, 2]], ?createAndGo}]),
+ ?line ?expect1([{[kompissEntry2, [1, 2]], "kompis3"},
+ {[kompissEntry2, [2, 2]], ?createAndGo}]),
gn([[kompissEntry2, [1, 1]],
[kompissEntry2, [2, 1]]]),
- ?line expect(13, [{[kompissEntry2, [1, 2]], "kompis3"},
- {[kompissEntry2, [2, 2]], ?active}]),
+ ?line ?expect1([{[kompissEntry2, [1, 2]], "kompis3"},
+ {[kompissEntry2, [2, 2]], ?active}]),
s([{[kompissEntry2, [2, 3]], i, ?destroy}]),
- ?line expect(14, [{[kompissEntry2, [2, 3]], ?destroy}]),
+ ?line ?expect1([{[kompissEntry2, [2, 3]], ?destroy}]),
s([{[kompissEntry2, [2, 2]], i, ?destroy}]),
- ?line expect(15, [{[kompissEntry2, [2, 2]], ?destroy}]),
+ ?line ?expect1([{[kompissEntry2, [2, 2]], ?destroy}]),
ok.
%% Req. Test1
@@ -3114,26 +3533,26 @@ multi_threaded_test() ->
g([[multiStr,0]]),
Pid = get_multi_pid(),
g([[sysUpTime,0]]),
- ?line expect(1, [{[sysUpTime,0], any}]),
+ ?line ?expect1([{[sysUpTime,0], any}]),
s([{[sysLocation, 0], s, "pelle"}]),
- ?line expect(2, [{[sysLocation, 0], "pelle"}]),
+ ?line ?expect1([{[sysLocation, 0], "pelle"}]),
Pid ! continue,
- ?line expect(3, [{[multiStr,0], "ok"}]),
+ ?line ?expect1([{[multiStr,0], "ok"}]),
s([{[multiStr, 0], s, "block"}]),
Pid2 = get_multi_pid(),
g([[sysUpTime,0]]),
- ?line expect(4, [{[sysUpTime,0], any}]),
+ ?line ?expect1([{[sysUpTime,0], any}]),
g([[multiStr,0]]),
Pid3 = get_multi_pid(),
g([[sysUpTime,0]]),
- ?line expect(5, [{[sysUpTime,0], any}]),
+ ?line ?expect1([{[sysUpTime,0], any}]),
s([{[sysLocation, 0], s, "kalle"}]),
Pid3 ! continue,
- ?line expect(6, [{[multiStr,0], "ok"}]),
+ ?line ?expect1([{[multiStr,0], "ok"}]),
Pid2 ! continue,
- ?line expect(7, [{[multiStr,0], "block"}]),
- ?line expect(8, [{[sysLocation,0], "kalle"}]).
+ ?line ?expect1([{[multiStr,0], "block"}]),
+ ?line ?expect1([{[sysLocation,0], "kalle"}]).
%% Req. Test1, TestTrapv2
mt_trap_test(MA) ->
@@ -3141,9 +3560,8 @@ mt_trap_test(MA) ->
?DBG("mt_trap_test(01) -> issue testTrapv22 (standard trap)", []),
snmpa:send_trap(MA, testTrapv22, "standard trap"),
?DBG("mt_trap_test(02) -> await v2trap", []),
- ?line expect(mt_trap_test_1, v2trap,
- [{[sysUpTime, 0], any},
- {[snmpTrapOID, 0], ?system ++ [0,1]}]),
+ ?line ?expect2(v2trap, [{[sysUpTime, 0], any},
+ {[snmpTrapOID, 0], ?system ++ [0,1]}]),
?DBG("mt_trap_test(03) -> issue mtTrap (standard trap)", []),
snmpa:send_trap(MA, mtTrap, "standard trap"),
@@ -3152,21 +3570,21 @@ mt_trap_test(MA) ->
g([[sysUpTime,0]]),
?DBG("mt_trap_test(06) -> await sysUpTime", []),
- ?line expect(mt_trap_test_2, [{[sysUpTime,0], any}]),
+ ?line ?expect1([{[sysUpTime,0], any}]),
?DBG("mt_trap_test(07) -> issue testTrapv22 (standard trap)", []),
snmpa:send_trap(MA, testTrapv22, "standard trap"),
?DBG("mt_trap_test(08) -> await v2trap", []),
- ?line expect(mt_trap_test_3, v2trap,
- [{[sysUpTime, 0], any},
- {[snmpTrapOID, 0], ?system ++ [0,1]}]),
+ ?line ?expect2(v2trap,
+ [{[sysUpTime, 0], any},
+ {[snmpTrapOID, 0], ?system ++ [0,1]}]),
?DBG("mt_trap_test(09) -> send continue to multi-pid", []),
Pid ! continue,
?DBG("mt_trap_test(10) -> await v2trap", []),
- ?line expect(mt_trap_test_4, v2trap, [{[sysUpTime, 0], any},
- {[snmpTrapOID, 0], ?testTrap ++ [2]},
- {[multiStr,0], "ok"}]),
+ ?line ?expect2(v2trap, [{[sysUpTime, 0], any},
+ {[snmpTrapOID, 0], ?testTrap ++ [2]},
+ {[multiStr,0], "ok"}]),
?DBG("mt_trap_test(11) -> done", []),
ok.
@@ -3187,26 +3605,26 @@ types_v2_test() ->
?P1("Testing v2 types..."),
s([{[bits1,0], 2#10}]),
- ?line expect(1, [{[bits1,0], ?str(2#10)}]),
+ ?line ?expect1([{[bits1,0], ?str(2#10)}]),
g([[bits1,0]]),
- ?line expect(2, [{[bits1,0], ?str(2#101)}]),
+ ?line ?expect1([{[bits1,0], ?str(2#101)}]),
s([{[bits2,0], 2#11000000110}]),
- ?line expect(3, [{[bits2,0], ?str(2#11000000110)}]),
+ ?line ?expect1([{[bits2,0], ?str(2#11000000110)}]),
g([[bits2,0]]),
- ?line expect(4, [{[bits2,0], ?str(2#11000000110)}]),
+ ?line ?expect1([{[bits2,0], ?str(2#11000000110)}]),
g([[bits3,0]]),
- ?line expect(50, genErr, 1, any),
+ ?line ?expect3(genErr, 1, any),
g([[bits4,0]]),
- ?line expect(51, genErr, 1, any),
+ ?line ?expect3(genErr, 1, any),
s([{[bits1,0], s, [2#10]}]),
- ?line expect(6, ?v1_2(badValue, wrongValue), 1, any),
+ ?line ?expect3(?v1_2(badValue, wrongValue), 1, any),
s([{[bits2,0], 2#11001001101010011}]),
- ?line expect(7, ?v1_2(badValue, wrongValue), 1, any).
+ ?line ?expect3(?v1_2(badValue, wrongValue), 1, any).
%% Req. Test1
@@ -3214,64 +3632,63 @@ implied_test(MA) ->
?LOG("implied_test -> start",[]),
?P1("Testing IMPLIED..."),
- snmpa:verbosity(MA,trace),
- snmpa:verbosity(MA,trace),
+ snmpa:verbosity(MA, trace),
%% Create two rows, check that they are get-nexted in correct order.
Idx1 = "apa",
Idx2 = "qq",
?DBG("implied_test -> (send) create row 1 '~s' in table 1",[Idx1]),
s([{[testStatus, Idx1], i, ?createAndGo}, {[testDescr, Idx1],s,"row 1"}]),
- ?line expect(1, [{[testStatus, Idx1], ?createAndGo},
- {[testDescr, Idx1], "row 1"}]),
+ ?line ?expect1([{[testStatus, Idx1], ?createAndGo},
+ {[testDescr, Idx1], "row 1"}]),
?DBG("implied_test -> (send) create row 2 '~s' in table 1",[Idx2]),
s([{[testStatus, Idx2], i, ?createAndGo}, {[testDescr, Idx2],s,"row 2"}]),
- ?line expect(2, [{[testStatus, Idx2], ?createAndGo},
- {[testDescr, Idx2], "row 2"}]),
+ ?line ?expect1([{[testStatus, Idx2], ?createAndGo},
+ {[testDescr, Idx2], "row 2"}]),
?DBG("implied_test -> get-next(testDescr)",[]),
gn([[testDescr]]),
- ?line expect(3, [{[testDescr,Idx1], "row 1"}]),
+ ?line ?expect1([{[testDescr,Idx1], "row 1"}]),
?DBG("implied_test -> get-next(testDescr) of row 1",[]),
gn([[testDescr,Idx1]]),
- ?line expect(4, [{[testDescr,Idx2], "row 2"}]),
+ ?line ?expect1([{[testDescr,Idx2], "row 2"}]),
% Delete the rows
?DBG("implied_test -> (send) delete row 1 '~s' from table 1",[Idx1]),
s([{[testStatus, Idx1], i, ?destroy}]),
- ?line expect(5, [{[testStatus, Idx1], ?destroy}]),
+ ?line ?expect1([{[testStatus, Idx1], ?destroy}]),
?DBG("implied_test -> (send) delete row 2 '~s' from table 1",[Idx2]),
s([{[testStatus, Idx2], i, ?destroy}]),
- ?line expect(6, [{[testStatus, Idx2], ?destroy}]),
+ ?line ?expect1([{[testStatus, Idx2], ?destroy}]),
%% Try the same in other table
Idx3 = [1, "apa"],
Idx4 = [1, "qq"],
?DBG("implied_test -> (send) create row 1 '~s' in table 2",[Idx3]),
s([{[testStatus2, Idx3], i, ?createAndGo}, {[testDescr2,Idx3],s,"row 1"}]),
- ?line expect(1, [{[testStatus2, Idx3], ?createAndGo},
- {[testDescr2, Idx3], "row 1"}]),
+ ?line ?expect1([{[testStatus2, Idx3], ?createAndGo},
+ {[testDescr2, Idx3], "row 1"}]),
?DBG("implied_test -> (send) create row 2 '~s' in table 2",[Idx4]),
s([{[testStatus2, Idx4], i, ?createAndGo}, {[testDescr2,Idx4],s,"row 2"}]),
- ?line expect(2, [{[testStatus2, Idx4], ?createAndGo},
- {[testDescr2, Idx4], "row 2"}]),
+ ?line ?expect1([{[testStatus2, Idx4], ?createAndGo},
+ {[testDescr2, Idx4], "row 2"}]),
?DBG("implied_test -> get-next(testDescr2)",[]),
gn([[testDescr2]]),
- ?line expect(3, [{[testDescr2,Idx3], "row 1"}]),
+ ?line ?expect1([{[testDescr2,Idx3], "row 1"}]),
?DBG("implied_test -> get-next(testDescr2) of row 1",[]),
gn([[testDescr2,Idx3]]),
- ?line expect(4, [{[testDescr2,Idx4], "row 2"}]),
+ ?line ?expect1([{[testDescr2,Idx4], "row 2"}]),
% Delete the rows
?DBG("implied_test -> (send) delete row 1 '~s' from table 2",[Idx3]),
s([{[testStatus2, Idx3], i, ?destroy}]),
- ?line expect(5, [{[testStatus2, Idx3], ?destroy}]),
+ ?line ?expect1([{[testStatus2, Idx3], ?destroy}]),
?DBG("implied_test -> (send) delete row 2 '~s' from table 2",[Idx4]),
s([{[testStatus2, Idx4], i, ?destroy}]),
- ?line expect(6, [{[testStatus2, Idx4], ?destroy}]),
+ ?line ?expect1([{[testStatus2, Idx4], ?destroy}]),
- snmpa:verbosity(MA,log),
+ snmpa:verbosity(MA, log),
- ?LOG("implied_test -> done",[]).
+ ?LOG("implied_test -> done", []).
@@ -3284,25 +3701,25 @@ sparse_table_test() ->
Idx2 = 2,
s([{[sparseStatus, Idx1], i, ?createAndGo},
{[sparseDescr, Idx1], s, "row 1"}]),
- ?line expect(1, [{[sparseStatus, Idx1], ?createAndGo},
- {[sparseDescr, Idx1], "row 1"}]),
+ ?line ?expect1([{[sparseStatus, Idx1], ?createAndGo},
+ {[sparseDescr, Idx1], "row 1"}]),
s([{[sparseStatus, Idx2], i, ?createAndGo},
{[sparseDescr, Idx2], s, "row 2"}]),
- ?line expect(2, [{[sparseStatus, Idx2], ?createAndGo},
- {[sparseDescr, Idx2], "row 2"}]),
+ ?line ?expect1([{[sparseStatus, Idx2], ?createAndGo},
+ {[sparseDescr, Idx2], "row 2"}]),
?v1_2(gn([[sparseIndex], [sparseDescr,Idx1], [sparseDescr,Idx2],
[sparseStatus,Idx1], [sparseStatus,Idx2]]),
gb(0,5,[[sparseIndex]])),
- ?line expect(3, [{[sparseDescr,Idx1], "row 1"},
- {[sparseDescr,Idx2], "row 2"},
- {[sparseStatus,Idx1], ?active},
- {[sparseStatus,Idx2], ?active},
- {[sparseStr,0], "slut"}]),
- % Delete the rows
+ ?line ?expect1([{[sparseDescr,Idx1], "row 1"},
+ {[sparseDescr,Idx2], "row 2"},
+ {[sparseStatus,Idx1], ?active},
+ {[sparseStatus,Idx2], ?active},
+ {[sparseStr,0], "slut"}]),
+ %% Delete the rows
s([{[sparseStatus, Idx1], i, ?destroy}]),
- ?line expect(4, [{[sparseStatus, Idx1], ?destroy}]),
+ ?line ?expect1([{[sparseStatus, Idx1], ?destroy}]),
s([{[sparseStatus, Idx2], i, ?destroy}]),
- ?line expect(5, [{[sparseStatus, Idx2], ?destroy}]).
+ ?line ?expect1([{[sparseStatus, Idx2], ?destroy}]).
%% Req. Test1
@@ -3316,13 +3733,13 @@ cnt_64_test(MA) ->
?DBG("get cnt64",[]),
g([[cnt64,0]]),
?DBG("await response",[]),
- ?line ?v1_2(expect(1, noSuchName, 1, any),
- expect(1, [{[cnt64,0],18446744073709551615}])),
+ ?line ?v1_2(?expect3(noSuchName, 1, any),
+ ?expect1([{[cnt64,0],18446744073709551615}])),
?DBG("get-next cnt64",[]),
gn([[cnt64]]),
?DBG("await response",[]),
- ?line ?v1_2(expect(2, [{[cnt64Str,0], "after cnt64"}]),
- expect(2, [{[cnt64,0],18446744073709551615}])),
+ ?line ?v1_2(?expect1([{[cnt64Str,0], "after cnt64"}]),
+ ?expect1([{[cnt64,0],18446744073709551615}])),
?DBG("send cntTrap",[]),
snmpa:send_trap(MA,cntTrap,"standard trap",[
{sysContact, "pelle"},
@@ -3330,13 +3747,13 @@ cnt_64_test(MA) ->
{sysLocation, "here"}
]),
?DBG("await response",[]),
- ?line ?v1_2(expect(3, trap, [test], 6, 1, [{[sysContact,0], "pelle"},
- {[sysLocation,0], "here"}]),
- expect(3, v2trap, [{[sysUpTime, 0], any},
- {[snmpTrapOID, 0], ?testTrap ++ [1]},
- {[sysContact,0], "pelle"},
- {[cnt64,0], 10},
- {[sysLocation,0], "here"}])),
+ ?line ?v1_2(?expect5(trap, [test], 6, 1, [{[sysContact,0], "pelle"},
+ {[sysLocation,0], "here"}]),
+ ?expect2(v2trap, [{[sysUpTime, 0], any},
+ {[snmpTrapOID, 0], ?testTrap ++ [1]},
+ {[sysContact,0], "pelle"},
+ {[cnt64,0], 10},
+ {[sysLocation,0], "here"}])),
%% Create two rows, check that they are get-nexted in correct order.
Idx1 = 1,
@@ -3344,27 +3761,27 @@ cnt_64_test(MA) ->
?DBG("create row (cntStatus): ~p",[Idx1]),
s([{[cntStatus, Idx1], i, ?createAndGo}]),
?DBG("await response",[]),
- ?line expect(1, [{[cntStatus, Idx1], ?createAndGo}]),
+ ?line ?expect1([{[cntStatus, Idx1], ?createAndGo}]),
?DBG("create row (cntStatus): ~p",[Idx2]),
s([{[cntStatus, Idx2], i, ?createAndGo}]),
?DBG("await response",[]),
- ?line expect(2, [{[cntStatus, Idx2], ?createAndGo}]),
+ ?line ?expect1([{[cntStatus, Idx2], ?createAndGo}]),
?DBG("get-next (cntIndex)",[]),
gn([[cntIndex]]),
?DBG("await response",[]),
- ?line ?v1_2(expect(3, [{[cntStatus,Idx1], ?active}]),
- expect(3, [{[cntCnt,Idx1], 0}])),
+ ?line ?v1_2(?expect1([{[cntStatus,Idx1], ?active}]),
+ ?expect1([{[cntCnt,Idx1], 0}])),
% Delete the rows
?DBG("delete row (cntStatus): ~p",[Idx1]),
s([{[cntStatus, Idx1], i, ?destroy}]),
?DBG("await response",[]),
- ?line expect(4, [{[cntStatus, Idx1], ?destroy}]),
+ ?line ?expect1([{[cntStatus, Idx1], ?destroy}]),
?DBG("delete row (cntStatus): ~p",[Idx2]),
s([{[cntStatus, Idx2], i, ?destroy}]),
?DBG("await response",[]),
- ?line expect(5, [{[cntStatus, Idx2], ?destroy}]),
- catch snmpa:verbosity(MA,log),
+ ?line ?expect1([{[cntStatus, Idx2], ?destroy}]),
+ catch snmpa:verbosity(MA, log),
?DBG("done",[]),
ok.
@@ -3372,7 +3789,7 @@ cnt_64_test(MA) ->
opaque_test() ->
?P1("Testing Opaque datatype..."),
g([[opaqueObj,0]]),
- ?line expect(1, [{[opaqueObj,0], "opaque-data"}]).
+ ?line ?expect1([{[opaqueObj,0], "opaque-data"}]).
%% Req. OLD-SNMPEA-MIB
api_test(MaNode) ->
@@ -3413,70 +3830,69 @@ api_test(MaNode) ->
%% Req. Klas3
api_test2() ->
g([[fname3,0]]),
- ?line expect(1, [{[fname3,0], "ok"}]),
+ ?line ?expect1([{[fname3,0], "ok"}]),
g([[fname4,0]]),
- ?line expect(2, [{[fname4,0], 1}]).
+ ?line ?expect1([{[fname4,0], 1}]).
api_test3() ->
g([[fname3,0]]),
- ?line expect(1, [{[fname3,0], "ok"}]).
+ ?line ?expect1([{[fname3,0], "ok"}]).
unreg_test() ->
gn([[?v1_2(sysServices, sysORLastChange),0]]),
- ?line expect(1, [{[snmpInPkts, 0], any}]).
+ ?line ?expect1([{[snmpInPkts, 0], any}]).
load_test() ->
gn([[?v1_2(sysServices, sysORLastChange),0]]),
- ?line expect(1, [{[fname,0], ""}]).
+ ?line ?expect1([{[fname,0], ""}]).
%% Req. Klas1
load_test_sa() ->
gn([[?v1_2(sysServices,sysORLastChange), 0]]),
- ?line expect(1, [{[fname,0], any}]).
+ ?line ?expect1([{[fname,0], any}]).
%% Req. system group, Klas1, OLD-SNMPEA-MIB
do_mul_get() ->
Key1c3 = [intCommunityEntry,[3],get(mip),is("public")],
Key1c4 = [intCommunityEntry,[4],get(mip),is("public")],
s([{[fname,0], s, "test set"}]),
- ?line expect(3, [{[fname,0], "test set"}]),
- g([[sysDescr,0], Key1c4, [fname,0],Key1c3,
- [sysName,0]]),
- ?line expect(1, [{[sysDescr,0], "Erlang SNMP agent"},
- {Key1c4, 2},
- {[fname,0], "test set"},
- {Key1c3, 2},
- {[sysName,0], "test"}]),
+ ?line ?expect1([{[fname,0], "test set"}]),
+ g([[sysDescr,0], Key1c4, [fname,0],Key1c3,[sysName,0]]),
+ ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"},
+ {Key1c4, 2},
+ {[fname,0], "test set"},
+ {Key1c3, 2},
+ {[sysName,0], "test"}]),
g([[1,3,7,1], Key1c4, [sysDescr,0], [1,3,7,2], Key1c3, [sysDescr,0]]),
- ?line ?v1_2(expect(2, noSuchName, [1,4], any),
- expect(2, [{[1,3,7,1], noSuchObject},
- {Key1c4, 2},
- {[sysDescr,0], "Erlang SNMP agent"},
- {[1,3,7,2], noSuchObject},
- {Key1c3, 2},
- {[sysDescr,0], "Erlang SNMP agent"}])).
+ ?line ?v1_2(?expect3(noSuchName, [1,4], any),
+ ?expect1([{[1,3,7,1], noSuchObject},
+ {Key1c4, 2},
+ {[sysDescr,0], "Erlang SNMP agent"},
+ {[1,3,7,2], noSuchObject},
+ {Key1c3, 2},
+ {[sysDescr,0], "Erlang SNMP agent"}])).
%% Req. v1, system group, Klas1, OLD-SNMPEA-MIB, *ej* Klas3.
do_mul_get_err() ->
Key1c3 = [intCommunityEntry,[3],get(mip),is("public")],
Key1c4 = [intCommunityEntry,[4],get(mip),is("public")],
s([{[fname,0], s, "test set"}]),
- ?line expect(3, [{[fname,0], "test set"}]),
+ ?line ?expect1([{[fname,0], "test set"}]),
g([[sysDescr,0],Key1c4,[fname,0], Key1c3, [sysName,2]]),
- ?line ?v1_2(expect(1, noSuchName, 5, any),
- expect(1, [{[sysDescr,0], "Erlang SNMP agent"},
- {Key1c4, 2},
- {[fname,0], "test set"},
- {Key1c3, 2},
- {[sysName,2], noSuchInstance}])),
+ ?line ?v1_2(?expect3(noSuchName, 5, any),
+ ?expect1([{[sysDescr,0], "Erlang SNMP agent"},
+ {Key1c4, 2},
+ {[fname,0], "test set"},
+ {Key1c3, 2},
+ {[sysName,2], noSuchInstance}])),
g([[sysDescr,0],Key1c4,[fname3,0], Key1c3, [sysName,1]]),
- ?line ?v1_2(expect(1, noSuchName, [3,5], any),
- expect(1, [{[sysDescr,0], "Erlang SNMP agent"},
- {Key1c4, 2},
- {[fname3,0], noSuchObject},
- {Key1c3, 2},
- {[sysName,1], noSuchInstance}])).
+ ?line ?v1_2(?expect3(noSuchName, [3,5], any),
+ ?expect1([{[sysDescr,0], "Erlang SNMP agent"},
+ {Key1c4, 2},
+ {[fname3,0], noSuchObject},
+ {Key1c3, 2},
+ {[sysName,1], noSuchInstance}])).
%% Req. system group, Klas1, OLD-SNMPEA-MIB
@@ -3486,11 +3902,11 @@ do_mul_next() ->
Key1c3 = [intCommunityEntry,[3],get(mip),is("public")],
Key1c4 = [intCommunityEntry,[4],get(mip),is("public")],
s([{[fname,0], s, "test set"}]),
- ?line expect(3, [{[fname,0], "test set"}]),
+ ?line ?expect1([{[fname,0], "test set"}]),
gn([[sysDescr], Key1c4s, [fname],Key1c3s,[sysName]]),
- ?line expect(1, [{[sysDescr,0], "Erlang SNMP agent"},
- {Key1c4, 2}, {[fname,0], "test set"},
- {Key1c3, 2}, {[sysName,0], "test"}]).
+ ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"},
+ {Key1c4, 2}, {[fname,0], "test set"},
+ {Key1c3, 2}, {[sysName,0], "test"}]).
%% Req. system group, Klas1, OLD-SNMPEA-MIB
do_mul_next_err() ->
@@ -3499,17 +3915,17 @@ do_mul_next_err() ->
Key1c3 = [intCommunityEntry,[3],get(mip),is("public")],
Key1c4 = [intCommunityEntry,[4],get(mip),is("public")],
s([{[fname,0], s, "test set"}]),
- ?line expect(3, [{[fname,0], "test set"}]),
+ ?line ?expect1([{[fname,0], "test set"}]),
gn([[sysDescr], Key1c4s, [1,3,6,999], [fname],[1,3,90], Key1c3s,[sysName]]),
- ?line ?v1_2(expect(1, noSuchName, [3,5], any),
- expect(1, [{[sysDescr,0], "Erlang SNMP agent"},
- {Key1c4, 2},
- {[1,3,6,999], endOfMibView},
- {[fname,0], "test set"},
- {[1,3,90], endOfMibView},
- {Key1c3, 2},
- {[sysName,0], "test"}])).
-
+ ?line ?v1_2(?expect3(noSuchName, [3,5], any),
+ ?expect1([{[sysDescr,0], "Erlang SNMP agent"},
+ {Key1c4, 2},
+ {[1,3,6,999], endOfMibView},
+ {[fname,0], "test set"},
+ {[1,3,90], endOfMibView},
+ {Key1c3, 2},
+ {[sysName,0], "test"}])).
+
%% Req. system group, Klas1, OLD-SNMPEA-MIB
do_mul_set() ->
@@ -3523,24 +3939,24 @@ do_mul_set() ->
{NewKeyc5, ?createAndGo},
{NewKeyc4, 2},
{[friendsEntry, [3, 3]], ?createAndGo}]),
- ?line expect(1, [{[friendsEntry, [2, 3]], "kompis3"},
- {NewKeyc3, 2},
- {[sysLocation,0], "new_value"},
- {NewKeyc5, ?createAndGo},
- {NewKeyc4, 2},
- {[friendsEntry, [3, 3]], ?createAndGo}]),
+ ?line ?expect1([{[friendsEntry, [2, 3]], "kompis3"},
+ {NewKeyc3, 2},
+ {[sysLocation,0], "new_value"},
+ {NewKeyc5, ?createAndGo},
+ {NewKeyc4, 2},
+ {[friendsEntry, [3, 3]], ?createAndGo}]),
g([[friendsEntry, [2, 3]],
- [sysLocation,0],
- [friendsEntry, [3, 3]]]),
- ?line expect(2, [{[friendsEntry, [2, 3]], "kompis3"},
- {[sysLocation,0], "new_value"},
- {[friendsEntry, [3, 3]], ?active}]),
+ [sysLocation,0],
+ [friendsEntry, [3, 3]]]),
+ ?line ?expect1([{[friendsEntry, [2, 3]], "kompis3"},
+ {[sysLocation,0], "new_value"},
+ {[friendsEntry, [3, 3]], ?active}]),
g([NewKeyc4]),
- ?line expect(3, [{NewKeyc4, 2}]),
+ ?line ?expect1([{NewKeyc4, 2}]),
s([{[friendsEntry, [3, 3]], ?destroy},
{NewKeyc5, ?destroy}]),
- ?line expect(4, [{[friendsEntry, [3, 3]], ?destroy},
- {NewKeyc5, ?destroy}]).
+ ?line ?expect1([{[friendsEntry, [3, 3]], ?destroy},
+ {NewKeyc5, ?destroy}]).
%% Req. system group, Klas1, OLD-SNMPEA-MIB
do_mul_set_err() ->
@@ -3554,53 +3970,48 @@ do_mul_set_err() ->
{NewKeyc5, ?createAndGo},
{NewKeyc4, 2},
{[friendsEntry, [3, 3]], ?createAndGo}]),
- ?line expect(1, ?v1_2(noSuchName, notWritable), 3, any),
+ ?line ?expect3(?v1_2(noSuchName, notWritable), 3, any),
g([[friendsEntry, [2, 3]]]),
- ?line ?v1_2(expect(2, noSuchName, 1, any),
- expect(2, [{[friendsEntry, [2,3]], noSuchInstance}])),
+ ?line ?v1_2(?expect3(noSuchName, 1, any),
+ ?expect1([{[friendsEntry, [2,3]], noSuchInstance}])),
g([NewKeyc4]),
- ?line ?v1_2(expect(3, noSuchName, 1, any),
- expect(3, [{NewKeyc4, noSuchInstance}])).
+ ?line ?v1_2(?expect3(noSuchName, 1, any),
+ ?expect1([{NewKeyc4, noSuchInstance}])).
%% Req. SA-MIB
sa_mib() ->
g([[sa, [2,0]]]),
- ?line expect(sa_mib_1, [{[sa, [2,0]], 3}]),
+ ?line ?expect1([{[sa, [2,0]], 3}]),
s([{[sa, [1,0]], s, "sa_test"}]),
- ?line expect(sa_mib_2, [{[sa, [1,0]], "sa_test"}]),
+ ?line ?expect1([{[sa, [1,0]], "sa_test"}]),
ok.
ma_trap1(MA) ->
ok = snmpa:send_trap(MA, testTrap2, "standard trap"),
- ?line expect(ma_trap1_1,
- trap, [system], 6, 1, [{[system, [4,0]],
- "{mbj,eklas}@erlang.ericsson.se"}]),
+ ?line ?expect5(trap, [system], 6, 1, [{[system, [4,0]],
+ "{mbj,eklas}@erlang.ericsson.se"}]),
ok = snmpa:send_trap(MA, testTrap1, "standard trap"),
- ?line expect(ma_trap1_2,
- trap, [1,2,3] , 1, 0, [{[system, [4,0]],
- "{mbj,eklas}@erlang.ericsson.se"}]),
+ ?line ?expect5(trap, [1,2,3] , 1, 0, [{[system, [4,0]],
+ "{mbj,eklas}@erlang.ericsson.se"}]),
ok.
ma_trap2(MA) ->
snmpa:send_trap(MA,testTrap2,"standard trap",[{sysContact,"pelle"}]),
- ?line expect(ma_trap2_3,
- trap, [system], 6, 1, [{[system, [4,0]], "pelle"}]),
+ ?line ?expect5(trap, [system], 6, 1, [{[system, [4,0]], "pelle"}]),
ok.
ma_v2_2_v1_trap(MA) ->
snmpa:send_trap(MA,testTrapv22,"standard trap",[{sysContact,"pelle"}]),
- ?line expect(ma_v2_2_v1_trap_3,
- trap, [system], 6, 1, [{[system, [4,0]], "pelle"}]),
+ ?line ?expect5(trap, [system], 6, 1, [{[system, [4,0]], "pelle"}]),
ok.
ma_v2_2_v1_trap2(MA) ->
snmpa:send_trap(MA,linkUp,"standard trap",[{ifIndex, [1], 1},
{ifAdminStatus, [1], 1},
{ifOperStatus, [1], 2}]),
- ?line expect(ma_v2_2_v1_trap2_3,
- trap, [1,2,3], 3, 0, [{[ifIndex, 1], 1},
- {[ifAdminStatus, 1], 1},
- {[ifOperStatus, 1], 2}]),
+ ?line ?expect5(trap, [1,2,3], 3, 0, [{[ifIndex, 1], 1},
+ {[ifAdminStatus, 1], 1},
+ {[ifOperStatus, 1], 2}]),
ok.
sa_trap1(SA) ->
@@ -3618,47 +4029,44 @@ sa_trap1(SA) ->
%% io:format("sa_trap1 -> SA trap send: "
%% "~n TSRes: ~p"
%% "~n", [TSRes]),
- ?line expect(sa_trap1_4,
- trap, [ericsson], 6, 1, [{[system, [4,0]],
- "{mbj,eklas}@erlang.ericsson.se"},
- {[sa, [1,0]], "sa_test"}]),
+ ?line ?expect5(trap, [ericsson], 6, 1, [{[system, [4,0]],
+ "{mbj,eklas}@erlang.ericsson.se"},
+ {[sa, [1,0]], "sa_test"}]),
snmpa:verbosity(SA, {subagents, silence}),
ok.
sa_trap2(SA) ->
snmpa:send_trap(SA, saTrap, "standard trap",[{sysContact,"pelle"}]),
- ?line expect(sa_trap2_5,
- trap, [ericsson], 6, 1, [{[system, [4,0]], "pelle"},
- {[sa, [1,0]], "sa_test"}]),
+ ?line ?expect5(trap, [ericsson], 6, 1, [{[system, [4,0]], "pelle"},
+ {[sa, [1,0]], "sa_test"}]),
ok.
sa_trap3(SA) ->
snmpa:send_trap(SA, saTrap2, "standard trap",
[{intViewSubtree, [4], [1,2,3,4]}]),
- ?line expect(sa_trap3_6,
- trap, [ericsson], 6, 2, [{[system, [4,0]],
- "{mbj,eklas}@erlang.ericsson.se"},
- {[sa, [1,0]], "sa_test"},
- {[intViewSubtree,4],[1,2,3,4]}]),
+ ?line ?expect5(trap, [ericsson], 6, 2, [{[system, [4,0]],
+ "{mbj,eklas}@erlang.ericsson.se"},
+ {[sa, [1,0]], "sa_test"},
+ {[intViewSubtree,4],[1,2,3,4]}]),
ok.
ma_v2_trap1(MA) ->
?DBG("ma_v2_traps -> entry with MA = ~p => "
"send standard trap: testTrapv22",[MA]),
snmpa:send_trap(MA, testTrapv22, "standard trap"),
- ?line expect(1, v2trap, [{[sysUpTime, 0], any},
- {[snmpTrapOID, 0], ?system ++ [0,1]}]),
+ ?line ?expect2(v2trap, [{[sysUpTime, 0], any},
+ {[snmpTrapOID, 0], ?system ++ [0,1]}]),
?DBG("ma_v2_traps -> send standard trap: testTrapv21",[]),
snmpa:send_trap(MA, testTrapv21, "standard trap"),
- ?line expect(2, v2trap, [{[sysUpTime, 0], any},
- {[snmpTrapOID, 0], ?snmp ++ [1]}]),
+ ?line ?expect2(v2trap, [{[sysUpTime, 0], any},
+ {[snmpTrapOID, 0], ?snmp ++ [1]}]),
ok.
ma_v2_trap2(MA) ->
snmpa:send_trap(MA,testTrapv22,"standard trap",[{sysContact,"pelle"}]),
- ?line expect(3, v2trap, [{[sysUpTime, 0], any},
- {[snmpTrapOID, 0], ?system ++ [0,1]},
- {[system, [4,0]], "pelle"}]).
+ ?line ?expect2(v2trap, [{[sysUpTime, 0], any},
+ {[snmpTrapOID, 0], ?system ++ [0,1]},
+ {[system, [4,0]], "pelle"}]).
%% Note: This test case takes a while... actually a couple of minutes.
ma_v2_inform1(MA) ->
@@ -3667,11 +4075,10 @@ ma_v2_inform1(MA) ->
"~n send notification: testTrapv22", [MA]),
CmdExpectInform =
- fun(No, Response) ->
- expect(No,
- {inform, Response},
- [{[sysUpTime, 0], any},
- {[snmpTrapOID, 0], ?system ++ [0,1]}])
+ fun(_No, Response) ->
+ ?expect2({inform, Response},
+ [{[sysUpTime, 0], any},
+ {[snmpTrapOID, 0], ?system ++ [0,1]}])
end,
CmdExp =
@@ -3817,11 +4224,10 @@ ma_v2_inform2(MA) ->
"~n send notification: testTrapv22", [MA]),
CmdExpectInform =
- fun(No, Response) ->
- expect(No,
- {inform, Response},
- [{[sysUpTime, 0], any},
- {[snmpTrapOID, 0], ?system ++ [0,1]}])
+ fun(_No, Response) ->
+ ?expect2({inform, Response},
+ [{[sysUpTime, 0], any},
+ {[snmpTrapOID, 0], ?system ++ [0,1]}])
end,
CmdExp =
@@ -3909,17 +4315,17 @@ ma_v2_inform3(MA) ->
CmdExpectInform =
fun(No, Response) ->
- expect(No,
- {inform, Response},
- [{[sysUpTime, 0], any},
- {[snmpTrapOID, 0], ?system ++ [0,1]}])
+ ?DBG("CmdExpectInform -> ~p: ~n~p", [No, Response]),
+ ?expect2({inform, Response},
+ [{[sysUpTime, 0], any},
+ {[snmpTrapOID, 0], ?system ++ [0,1]}])
end,
CmdExp =
fun(ok) ->
ok;
({ok, Val}) ->
- ?DBG("ma_v2_inform3 -> [cmd2] Val: ~p", [Val]),
+ ?DBG("CmdExp -> Val: ~p", [Val]),
ok;
({error, Id, Extra}) ->
{error, {unexpected, Id, Extra}};
@@ -3983,15 +4389,16 @@ ma_v2_inform3(MA) ->
Commands =
[
- {15, "Send notification [tag31]", Cmd15},
- {16, "Expect notification message [tag31]", Cmd16},
- {17, "Expect targets message [tag31]", Cmd17},
- {18, "Expect notification (no) response message [tag31]", Cmd18}
+ {15, "Send notification [" ++ atom_to_list(Tag15) ++ "]", Cmd15},
+ {16, "Expect notification message [" ++ atom_to_list(Tag15) ++ "]", Cmd16},
+ {17, "Expect targets message [" ++ atom_to_list(Tag15) ++ "]", Cmd17},
+ {18, "Expect notification (no) response message [" ++ atom_to_list(Tag15) ++ "]", Cmd18}
],
command_handler(Commands).
-
+
+%% snmpa_notification_delivery_info_receiver callback function
delivery_targets(Tag, Addresses, Extra) ->
io:format("~w:delivery_targets -> entry with"
"~n Tag: ~p"
@@ -4008,6 +4415,7 @@ delivery_targets(Tag, Addresses, Extra) ->
end,
ok.
+%% snmpa_notification_delivery_info_receiver callback function
delivery_info(Tag, Address, DeliveryResult, Extra) ->
io:format("~w:delivery_info -> entry with"
"~n Tag: ~p"
@@ -4045,40 +4453,40 @@ command_handler([{No, Desc, Cmd}|Rest]) ->
ma_v1_2_v2_trap(MA) ->
snmpa:send_trap(MA,linkDown,"standard trap",[{ifIndex, [1], 1}]),
- ?line expect(2, v2trap, [{[sysUpTime, 0], any},
- {[snmpTrapOID, 0], ?snmpTraps ++ [3]},
- {[ifIndex, 1], 1},
- {[snmpTrapEnterprise, 0], [1,2,3]}]).
+ ?line ?expect2(v2trap, [{[sysUpTime, 0], any},
+ {[snmpTrapOID, 0], ?snmpTraps ++ [3]},
+ {[ifIndex, 1], 1},
+ {[snmpTrapEnterprise, 0], [1,2,3]}]).
ma_v1_2_v2_trap2(MA) ->
snmpa:send_trap(MA,testTrap2,"standard trap",[{sysContact,"pelle"}]),
- ?line expect(3, v2trap, [{[sysUpTime, 0], any},
- {[snmpTrapOID, 0], ?system ++ [0,1]},
- {[system, [4,0]], "pelle"},
- {[snmpTrapEnterprise, 0], ?system}]).
+ ?line ?expect2(v2trap, [{[sysUpTime, 0], any},
+ {[snmpTrapOID, 0], ?system ++ [0,1]},
+ {[system, [4,0]], "pelle"},
+ {[snmpTrapEnterprise, 0], ?system}]).
sa_v1_2_v2_trap1(SA) ->
snmpa:verbosity(SA, {subagents, trace}),
snmpa:send_trap(SA, saTrap, "standard trap"),
- ?line expect(trap1_4, v2trap, [{[sysUpTime, 0], any},
- {[snmpTrapOID, 0], ?ericsson ++ [0, 1]},
- {[system, [4,0]],
- "{mbj,eklas}@erlang.ericsson.se"},
- {[sa, [1,0]], "sa_test"},
- {[snmpTrapEnterprise, 0], ?ericsson}]),
+ ?line ?expect2(v2trap, [{[sysUpTime, 0], any},
+ {[snmpTrapOID, 0], ?ericsson ++ [0, 1]},
+ {[system, [4,0]],
+ "{mbj,eklas}@erlang.ericsson.se"},
+ {[sa, [1,0]], "sa_test"},
+ {[snmpTrapEnterprise, 0], ?ericsson}]),
snmpa:verbosity(SA, {subagents, silence}),
ok.
sa_v1_2_v2_trap2(SA) ->
snmpa:verbosity(SA, {subagents, trace}),
snmpa:send_trap(SA, saTrap, "standard trap",[{sysContact,"pelle"}]),
- ?line expect(trap2_4, v2trap, [{[sysUpTime, 0], any},
- {[snmpTrapOID, 0], ?ericsson ++ [0, 1]},
- {[system, [4,0]], "pelle"},
- {[sa, [1,0]], "sa_test"},
- {[snmpTrapEnterprise, 0], ?ericsson}]),
+ ?line ?expect2(v2trap, [{[sysUpTime, 0], any},
+ {[snmpTrapOID, 0], ?ericsson ++ [0, 1]},
+ {[system, [4,0]], "pelle"},
+ {[sa, [1,0]], "sa_test"},
+ {[snmpTrapEnterprise, 0], ?ericsson}]),
snmpa:verbosity(SA, {subagents, silence}),
ok.
@@ -4087,13 +4495,13 @@ sa_v1_2_v2_trap3(SA) ->
snmpa:verbosity(SA, {subagents, trace}),
snmpa:send_trap(SA, saTrap2, "standard trap",
[{intViewSubtree, [4], [1,2,3,4]}]),
- ?line expect(trap3_4, v2trap, [{[sysUpTime, 0], any},
- {[snmpTrapOID, 0], ?ericsson ++ [0, 2]},
- {[system, [4,0]],
- "{mbj,eklas}@erlang.ericsson.se"},
- {[sa, [1,0]], "sa_test"},
- {[intViewSubtree,4],[1,2,3,4]},
- {[snmpTrapEnterprise, 0], ?ericsson}]),
+ ?line ?expect2(v2trap, [{[sysUpTime, 0], any},
+ {[snmpTrapOID, 0], ?ericsson ++ [0, 2]},
+ {[system, [4,0]],
+ "{mbj,eklas}@erlang.ericsson.se"},
+ {[sa, [1,0]], "sa_test"},
+ {[intViewSubtree,4],[1,2,3,4]},
+ {[snmpTrapEnterprise, 0], ?ericsson}]),
snmpa:verbosity(SA, {subagents, silence}),
ok.
@@ -4107,15 +4515,15 @@ sa_errs_bad_value() ->
{[sa, [2,0]], 5}, % badValue (i is_set_ok)
{NewKeyc5, ?createAndGo},
{NewKeyc4, 2}]),
- ?line expect(1, badValue, 2, any),
+ ?line ?expect3(badValue, 2, any),
s([{NewKeyc3, 2},
{[sa, [2,0]], 6}, % wrongValue (i is_set_ok)
{NewKeyc5, ?createAndGo},
{NewKeyc4, 2}]),
- ?line expect(1, ?v1_2(badValue, wrongValue), 2, any),
+ ?line ?expect3(?v1_2(badValue, wrongValue), 2, any),
g([NewKeyc4]),
- ?line ?v1_2(expect(2, noSuchName, 1, any),
- expect(2, [{NewKeyc4, noSuchInstance}])).
+ ?line ?v1_2(?expect3(noSuchName, 1, any),
+ ?expect1([{NewKeyc4, noSuchInstance}])).
%% Req. SA-MIB, OLD-SNMPEA-MIB
sa_errs_gen_err() ->
@@ -4124,23 +4532,23 @@ sa_errs_gen_err() ->
NewKeyc5 = [intCommunityEntry,[5],get(mip),is("test")],
s([{NewKeyc3, 2},{NewKeyc4, 2},
{NewKeyc5, ?createAndGo}, {[sa, [3,0]], 5}]),
- ?line expect(1, genErr, 4, any),
+ ?line ?expect3(genErr, 4, any),
% The row might have been added; we don't know.
% (as a matter of fact we do - it is added, because the agent
% first sets its own vars, and then th SAs. Lets destroy it.
s([{NewKeyc5, ?destroy}]),
- ?line expect(2, [{NewKeyc5, ?destroy}]).
+ ?line ?expect1([{NewKeyc5, ?destroy}]).
%% Req. SA-MIB, OLD-SNMPEA-MIB
sa_too_big() ->
g([[sa, [4,0]]]),
- ?line expect(1, tooBig).
+ ?line ?expect1(tooBig).
%% Req. Klas1, system group, snmp group (v1/v2)
-next_across_sa() ->
+next_across_sa_test() ->
gn([[sysDescr],[klas1,5]]),
- ?line expect(1, [{[sysDescr,0], "Erlang SNMP agent"},
- {[snmpInPkts, 0], any}]).
+ ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"},
+ {[snmpInPkts, 0], any}]).
%% snmp_test_mgr:s([{[fStatus3, 1], 4}, {[fname3,0], "ok"}]). -> noError
%% snmp_test_mgr:s([{[fStatus3, 1], 4}, {[fname3,0], "hoj"}]). -> {badValue, 2}
@@ -4151,40 +4559,40 @@ next_across_sa() ->
%% Req. Klas3, Klas4
undo_test() ->
s([{[fStatus3, 1], 4}, {[fname3,0], "ok"}]),
- ?line expect(1, [{[fStatus3, 1], 4}, {[fname3,0], "ok"}]),
+ ?line ?expect1([{[fStatus3, 1], 4}, {[fname3,0], "ok"}]),
s([{[fStatus3, 1], 4}, {[fname3,0], "hoj"}]),
- ?line expect(2, ?v1_2(badValue, inconsistentValue), 2, any),
+ ?line ?expect3(?v1_2(badValue, inconsistentValue), 2, any),
s([{[fStatus3, 3], 4}, {[fname3,0], "hoj"}]),
- ?line expect(3, ?v1_2(genErr, undoFailed), 1, any),
+ ?line ?expect3(?v1_2(genErr, undoFailed), 1, any),
s([{[fStatus3, 4], 4}, {[fname3,0], "ok"}]),
- ?line expect(4, ?v1_2(genErr, commitFailed), 1, any),
+ ?line ?expect3(?v1_2(genErr, commitFailed), 1, any),
% unfortunatly we don't know if we'll get undoFailed or commitFailed.
% it depends on which order the agent traverses the varbind list.
% s([{[fStatus3, 4], 4}, {[fname3,0], "ufail"}]),
% ?line expect(5, ?v1_2(genErr, undoFailed), 1, any),
s([{[fStatus3, 1], 4}, {[fname3,0], "xfail"}]),
- ?line expect(6, genErr, 2, any).
+ ?line ?expect3(genErr, 2, any).
%% Req. Klas3, Klas4
bad_return() ->
g([[fStatus4,4],
[fName4,4]]),
- ?line expect(4, genErr, 2, any),
+ ?line ?expect3(genErr, 2, any),
g([[fStatus4,5],
[fName4,5]]),
- ?line expect(5, genErr, 1, any),
+ ?line ?expect3(genErr, 1, any),
g([[fStatus4,6],
[fName4,6]]),
- ?line expect(6, genErr, 2, any),
+ ?line ?expect3(genErr, 2, any),
gn([[fStatus4,7],
[fName4,7]]),
- ?line expect(7, genErr, 2, any),
+ ?line ?expect3(genErr, 2, any),
gn([[fStatus4,8],
[fName4,8]]),
- ?line expect(8, genErr, 1, any),
+ ?line ?expect3(genErr, 1, any),
gn([[fStatus4,9],
[fName4,9]]),
- ?line expect(9, genErr, 2, any).
+ ?line ?expect3(genErr, 2, any).
%%%-----------------------------------------------------------------
@@ -4195,7 +4603,16 @@ bad_return() ->
%%% already tested by the normal tests.
%%%-----------------------------------------------------------------
-
+standard_mibs_cases() ->
+ [
+ snmp_standard_mib,
+ snmp_community_mib,
+ snmp_framework_mib,
+ snmp_target_mib,
+ snmp_notification_mib,
+ snmp_view_based_acm_mib
+ ].
+
%%-----------------------------------------------------------------
%% For this test, the agent is configured for v1.
@@ -4247,27 +4664,27 @@ std_mib_init() ->
%% disable authentication failure traps. (otherwise w'd get many of
%% them - this is also a test to see that it works).
s([{[snmpEnableAuthenTraps,0], 2}]),
- ?line expect(std_mib_init_1, [{[snmpEnableAuthenTraps, 0], 2}]).
+ ?line ?expect1([{[snmpEnableAuthenTraps, 0], 2}]).
%% Req. SNMP-STANDARD-MIB | SNMPv2-MIB
std_mib_finish() ->
%% enable again
s([{[snmpEnableAuthenTraps,0], 1}]),
- ?line expect(std_mib_finish_1, [{[snmpEnableAuthenTraps, 0], 1}]).
+ ?line ?expect1([{[snmpEnableAuthenTraps, 0], 1}]).
%% Req. SNMP-STANDARD-MIB
standard_mib_test_finish() ->
%% force a authenticationFailure (should result in a trap)
std_mib_write(),
%% check that we got a trap
- ?line expect(standard_mib_test_finish_2, trap, [1,2,3], 4, 0, []).
+ ?line ?expect5(trap, [1,2,3], 4, 0, []).
%% Req. SNMP-STANDARD-MIB | SNMPv2-MIB
std_mib_read() ->
?DBG("std_mib_read -> entry", []),
g([[sysUpTime,0]]), % try a bad <something>; msg dropped, no reply
?DBG("std_mib_read -> await timeout (i.e. no reply)", []),
- ?line expect(std_mib_read_1, timeout). % make sure we don't get a trap!
+ ?line ?expect1(timeout). % make sure we don't get a trap!
%% Req. SNMP-STANDARD-MIB | SNMPv2-MIB
@@ -4279,6 +4696,18 @@ std_mib_write() ->
std_mib_asn_err() ->
snmp_test_mgr:send_bytes([48,99,67,12,0,0,0,0,0,0,5]).
+
+standard_mibs2_cases() ->
+ [
+ snmpv2_mib_2,
+ snmp_community_mib_2,
+ snmp_framework_mib_2,
+ snmp_target_mib_2,
+ snmp_notification_mib_2,
+ snmp_view_based_acm_mib_2
+ ].
+
+
%%-----------------------------------------------------------------
%% For this test, the agent is configured for v2 and v3.
%% o Test the counters and control objects in SNMPv2-MIB
@@ -4327,6 +4756,19 @@ snmpv2_mib_2(Config) when is_list(Config) ->
?LOG("snmpv2_mib_2 -> done",[]).
+
+standard_mibs3_cases() ->
+ [
+ snmpv2_mib_3,
+ snmp_framework_mib_3,
+ snmp_mpd_mib_3,
+ snmp_target_mib_3,
+ snmp_notification_mib_3,
+ snmp_view_based_acm_mib_3,
+ snmp_user_based_sm_mib_3
+ ].
+
+
%% Req. SNMPv2-MIB
snmpv2_mib_3(suite) -> [];
snmpv2_mib_3(Config) when is_list(Config) ->
@@ -4358,13 +4800,13 @@ snmpv2_mib_test_finish() ->
%% check that we got a trap
?DBG("ma_v2_inform -> await trap",[]),
- ?line expect(2, v2trap, [{[sysUpTime,0], any},
- {[snmpTrapOID,0], ?authenticationFailure}]),
+ ?line ?expect2(v2trap, [{[sysUpTime,0], any},
+ {[snmpTrapOID,0], ?authenticationFailure}]),
%% and the the inform
?DBG("ma_v2_inform -> await inform",[]),
- ?line expect(2, {inform,true}, [{[sysUpTime,0], any},
- {[snmpTrapOID,0],?authenticationFailure}]).
+ ?line ?expect2({inform,true}, [{[sysUpTime,0], any},
+ {[snmpTrapOID,0],?authenticationFailure}]).
%% Req. SNMP-STANDARD-MIB | SNMPv2-MIB
std_mib_a() ->
@@ -4402,12 +4844,12 @@ std_mib_c({InBadCommunityNames, InBadCommunityUses, InASNErrs}) ->
snmpv2_mib_a() ->
?line [SetSerial] = get_req(2, [[snmpSetSerialNo,0]]),
s([{[snmpSetSerialNo,0], SetSerial}, {[sysLocation, 0], "val2"}]),
- ?line expect(snmpv2_mib_a_3, [{[snmpSetSerialNo,0], SetSerial},
- {[sysLocation, 0], "val2"}]),
+ ?line ?expect1([{[snmpSetSerialNo,0], SetSerial},
+ {[sysLocation, 0], "val2"}]),
s([{[sysLocation, 0], "val3"}, {[snmpSetSerialNo,0], SetSerial}]),
- ?line expect(snmpv2_mib_a_4, inconsistentValue, 2,
- [{[sysLocation, 0], "val3"},
- {[snmpSetSerialNo,0], SetSerial}]),
+ ?line ?expect3(inconsistentValue, 2,
+ [{[sysLocation, 0], "val3"},
+ {[snmpSetSerialNo,0], SetSerial}]),
?line ["val2"] = get_req(5, [[sysLocation,0]]).
@@ -4421,13 +4863,13 @@ snmp_community_mib(Config) when is_list(Config) ->
?P(snmp_community_mib),
init_case(Config),
?line load_master_std("SNMP-COMMUNITY-MIB"),
- try_test(snmp_community_mib),
+ try_test(snmp_community_mib_test),
?line unload_master("SNMP-COMMUNITY-MIB").
snmp_community_mib_2(X) -> ?P(snmp_community_mib_2), snmp_community_mib(X).
%% Req. SNMP-COMMUNITY-MIB
-snmp_community_mib() ->
+snmp_community_mib_test() ->
?INF("NOT YET IMPLEMENTED", []),
nyi.
@@ -4439,7 +4881,7 @@ snmp_framework_mib(Config) when is_list(Config) ->
?P(snmp_framework_mib),
init_case(Config),
?line load_master_std("SNMP-FRAMEWORK-MIB"),
- try_test(snmp_framework_mib),
+ try_test(snmp_framework_mib_test),
?line unload_master("SNMP-FRAMEWORK-MIB").
snmp_framework_mib_2(X) -> ?P(snmp_framework_mib_2), snmp_framework_mib(X).
@@ -4448,11 +4890,11 @@ snmp_framework_mib_3(suite) -> [];
snmp_framework_mib_3(Config) when is_list(Config) ->
?P(snmp_framework_mib_3),
init_case(Config),
- try_test(snmp_framework_mib).
+ try_test(snmp_framework_mib_test).
%% Req. SNMP-FRAMEWORK-MIB
-snmp_framework_mib() ->
+snmp_framework_mib_test() ->
?line ["agentEngine"] = get_req(1, [[snmpEngineID,0]]),
?line [EngineTime] = get_req(2, [[snmpEngineTime,0]]),
?SLEEP(5000),
@@ -4538,7 +4980,7 @@ snmp_mpd_mib_a() ->
-define(snmpUnknownPDUHandlers_instance, [1,3,6,1,6,3,11,2,1,3,0]).
snmp_mpd_mib_b() ->
g([[sysUpTime,0]]),
- ?line expect(1, report, [{?snmpUnknownPDUHandlers_instance, any}]).
+ ?line ?expect2(report, [{?snmpUnknownPDUHandlers_instance, any}]).
snmp_mpd_mib_c(UnknownPDUHs) ->
@@ -4551,14 +4993,14 @@ snmp_target_mib(Config) when is_list(Config) ->
?P(snmp_target_mib),
init_case(Config),
?line load_master_std("SNMP-TARGET-MIB"),
- try_test(snmp_target_mib),
+ try_test(snmp_target_mib_test),
?line unload_master("SNMP-TARGET-MIB").
snmp_target_mib_2(X) -> ?P(snmp_target_mib_2), snmp_target_mib(X).
snmp_target_mib_3(X) -> ?P(snmp_target_mib_3), snmp_target_mib(X).
-snmp_target_mib() ->
+snmp_target_mib_test() ->
?INF("NOT YET IMPLEMENTED", []),
nyi.
@@ -4567,7 +5009,7 @@ snmp_notification_mib(Config) when is_list(Config) ->
?P(snmp_notification_mib),
init_case(Config),
?line load_master_std("SNMP-NOTIFICATION-MIB"),
- try_test(snmp_notification_mib),
+ try_test(snmp_notification_mib_test),
?line unload_master("SNMP-NOTIFICATION-MIB").
snmp_notification_mib_2(X) -> ?P(snmp_notification_mib_2),
@@ -4576,7 +5018,7 @@ snmp_notification_mib_2(X) -> ?P(snmp_notification_mib_2),
snmp_notification_mib_3(X) -> ?P(snmp_notification_mib_3),
snmp_notification_mib(X).
-snmp_notification_mib() ->
+snmp_notification_mib_test() ->
?INF("NOT YET IMPLEMENTED", []),
nyi.
@@ -4728,50 +5170,51 @@ snmp_view_based_acm_mib() ->
do_set(Row) ->
s(Row),
- expect(do_set_1, Row).
+ ?expect1(Row).
add_row(RowStatus) ->
s([{RowStatus, ?createAndGo}]),
- expect(add_row_1, [{RowStatus, ?createAndGo}]).
+ ?expect1([{RowStatus, ?createAndGo}]).
del_row(RowStatus) ->
s([{RowStatus, ?destroy}]),
- expect(del_row_1, [{RowStatus, ?destroy}]).
+ ?expect1([{RowStatus, ?destroy}]).
use_no_rights() ->
g([[xDescr,0]]),
- ?v1_2_3(expect(use_no_rights_11, noSuchName, 1, any),
- expect(use_no_rights_12, [{[xDescr,0], noSuchObject}]),
- expect(use_no_rights_13, authorizationError, 1, any)),
+ ?v1_2_3(?expect3(noSuchName, 1, any),
+ ?expect1([{[xDescr,0], noSuchObject}]),
+ ?expect3(authorizationError, 1, any)),
g([[xDescr2,0]]),
- ?v1_2_3(expect(use_no_rights_21, noSuchName, 1, any),
- expect(use_no_rights_22, [{[xDescr2,0], noSuchObject}]),
- expect(use_no_rights_23, authorizationError, 1, any)),
+ ?v1_2_3(?expect3(noSuchName, 1, any),
+ ?expect1([{[xDescr2,0], noSuchObject}]),
+ ?expect3(authorizationError, 1, any)),
gn([[xDescr]]),
- ?v1_2_3(expect(use_no_rights_31, noSuchName, 1, any),
- expect(use_no_rights_32, [{[xDescr], endOfMibView}]),
- expect(use_no_rights_33, authorizationError, 1, any)),
+ ?v1_2_3(?expect3(noSuchName, 1, any),
+ ?expect1([{[xDescr], endOfMibView}]),
+ ?expect3(authorizationError, 1, any)),
s([{[xDescr,0], "tryit"}]),
- ?v1_2_3(expect(use_no_rights_41, noSuchName, 1, any),
- expect(use_no_rights_42, noAccess, 1, any),
- expect(use_no_rights_43, authorizationError, 1, any)).
+ ?v1_2_3(?expect3(noSuchName, 1, any),
+ ?expect3(noAccess, 1, any),
+ ?expect3(authorizationError, 1, any)).
use_rights() ->
g([[xDescr,0]]),
- expect(use_rights_1, [{[xDescr,0], any}]),
+ ?expect1([{[xDescr,0], any}]),
g([[xDescr2,0]]),
- expect(use_rights_2, [{[xDescr2,0], any}]),
+ ?expect1([{[xDescr2,0], any}]),
s([{[xDescr,0], "tryit"}]),
- expect(use_rights_3, noError, 0, any),
+ ?expect3(noError, 0, any),
g([[xDescr,0]]),
- expect(use_rights_4, [{[xDescr,0], "tryit"}]).
+ ?expect1([{[xDescr,0], "tryit"}]).
mk_ln(X) ->
[length(X) | X].
+
%%-----------------------------------------------------------------
%% o add/delete users and try them
%% o test all secLevels
@@ -4851,15 +5294,15 @@ snmp_user_based_sm_mib_3(Config) when is_list(Config) ->
%% Try some read requests
?line try_test(v3_sync, [[{usm_read, []}]],
- [{sec_level, authPriv}, {user, "privDES"}]),
+ [{sec_level, authPriv}, {user, "privDES"}]),
%% Delete the new user
?line try_test(v3_sync, [[{usm_del_user, []}]],
- [{sec_level, authPriv}, {user, "privDES"}]),
+ [{sec_level, authPriv}, {user, "privDES"}]),
%% Try some bad requests
?line try_test(v3_sync, [[{usm_bad, []}]],
- [{sec_level, authPriv}, {user, "privDES"}]),
+ [{sec_level, authPriv}, {user, "privDES"}]),
?line unload_master("SNMP-USER-BASED-SM-MIB").
@@ -4871,7 +5314,7 @@ usm_add_user1() ->
Vbs1 = [{[usmUserCloneFrom, NewRowIndex], RowPointer},
{[usmUserStatus, NewRowIndex], ?createAndGo}],
?line s(Vbs1),
- ?line expect(1, Vbs1),
+ ?line ?expect1(Vbs1),
ok.
usm_use_user() ->
@@ -4890,7 +5333,7 @@ usm_key_change1(ShaKey, DesKey) ->
Vbs1 = [{[usmUserAuthKeyChange, NewRowIndex], ShaKeyChange},
{[usmUserPrivKeyChange, NewRowIndex], DesKeyChange}],
s(Vbs1),
- ?line expect(1, Vbs1).
+ ?line ?expect1(Vbs1).
%% Change own private keys
usm_key_change2(OldShaKey, OldDesKey, ShaKey, DesKey) ->
@@ -4904,7 +5347,7 @@ usm_key_change2(OldShaKey, OldDesKey, ShaKey, DesKey) ->
Vbs1 = [{[usmUserOwnAuthKeyChange, NewRowIndex], ShaKeyChange},
{[usmUserOwnPrivKeyChange, NewRowIndex], DesKeyChange}],
s(Vbs1),
- ?line expect(1, Vbs1).
+ ?line ?expect1(Vbs1).
%% Change other's public keys
usm_key_change3(OldShaKey, OldDesKey, ShaKey, DesKey) ->
@@ -4917,16 +5360,16 @@ usm_key_change3(OldShaKey, OldDesKey, ShaKey, DesKey) ->
DesKey),
Vbs1 = [{[usmUserOwnAuthKeyChange, NewRowIndex], ShaKeyChange}],
s(Vbs1),
- ?line expect(1, noAccess, 1, any),
+ ?line ?expect3(noAccess, 1, any),
Vbs2 = [{[usmUserOwnPrivKeyChange, NewRowIndex], DesKeyChange}],
s(Vbs2),
- ?line expect(2, noAccess, 1, any),
+ ?line ?expect3(noAccess, 1, any),
Vbs3 = [{[usmUserAuthKeyChange, NewRowIndex], ShaKeyChange},
{[usmUserPrivKeyChange, NewRowIndex], DesKeyChange}],
s(Vbs3),
- ?line expect(1, Vbs3).
+ ?line ?expect1(Vbs3).
usm_read() ->
NewRowIndex = [11,"agentEngine", 7, "newUser"],
@@ -4936,13 +5379,12 @@ usm_read() ->
[usmUserOwnAuthKeyChange, NewRowIndex],
[usmUserPrivKeyChange, NewRowIndex],
[usmUserOwnPrivKeyChange, NewRowIndex]]),
- ?line expect(1,
- [{[usmUserSecurityName, NewRowIndex], "newUser"},
- {[usmUserCloneFrom, NewRowIndex], [0,0]},
- {[usmUserAuthKeyChange, NewRowIndex], ""},
- {[usmUserOwnAuthKeyChange, NewRowIndex], ""},
- {[usmUserPrivKeyChange, NewRowIndex], ""},
- {[usmUserOwnPrivKeyChange, NewRowIndex], ""}]),
+ ?line ?expect1([{[usmUserSecurityName, NewRowIndex], "newUser"},
+ {[usmUserCloneFrom, NewRowIndex], [0,0]},
+ {[usmUserAuthKeyChange, NewRowIndex], ""},
+ {[usmUserOwnAuthKeyChange, NewRowIndex], ""},
+ {[usmUserPrivKeyChange, NewRowIndex], ""},
+ {[usmUserOwnPrivKeyChange, NewRowIndex], ""}]),
ok.
@@ -4951,7 +5393,7 @@ usm_del_user() ->
NewRowIndex = [11,"agentEngine", 7, "newUser"],
Vbs1 = [{[usmUserStatus, NewRowIndex], ?destroy}],
?line s(Vbs1),
- ?line expect(1, Vbs1),
+ ?line ?expect1(Vbs1),
ok.
-define(usmUserCloneFrom, [1,3,6,1,6,3,15,1,2,2,1,4]).
@@ -4972,32 +5414,31 @@ usm_bad() ->
Vbs1 = [{[usmUserCloneFrom, NewRowIndex], RowPointer1},
{[usmUserStatus, NewRowIndex], ?createAndGo}],
?line s(Vbs1),
- ?line expect(1, inconsistentName, 1, any),
+ ?line ?expect3(inconsistentName, 1, any),
RowPointer2 = ?usmUserCloneFrom ++ [11|"agentEngine"] ++ [7|"privDES"],
Vbs2 = [{[usmUserCloneFrom, NewRowIndex], RowPointer2},
{[usmUserStatus, NewRowIndex], ?createAndGo}],
?line s(Vbs2),
- ?line expect(2, wrongValue, 1, any),
+ ?line ?expect3(wrongValue, 1, any),
RowPointer3 = ?usmUserSecurityName ++ [11|"agentEngine"] ++ [7|"privDES"],
Vbs3 = [{[usmUserCloneFrom, NewRowIndex], RowPointer3},
{[usmUserStatus, NewRowIndex], ?createAndGo}],
?line s(Vbs3),
- ?line expect(3, Vbs3),
+ ?line ?expect1(Vbs3),
?line s([{[usmUserAuthProtocol, NewRowIndex], ?usmNoAuthProtocol}]),
- ?line expect(4, inconsistentValue, 1, any),
+ ?line ?expect3(inconsistentValue, 1, any),
?line s([{[usmUserAuthProtocol, NewRowIndex], ?usmHMACMD5AuthProtocol}]),
- ?line expect(5, inconsistentValue, 1, any),
+ ?line ?expect3(inconsistentValue, 1, any),
?line s([{[usmUserAuthProtocol, NewRowIndex], ?usmDESPrivProtocol}]),
- ?line expect(6, wrongValue, 1, any),
+ ?line ?expect3(wrongValue, 1, any),
?line s([{[usmUserPrivProtocol, NewRowIndex], ?usmHMACSHAAuthProtocol}]),
- ?line expect(7, wrongValue, 1, any),
+ ?line ?expect3(wrongValue, 1, any),
Vbs4 = [{[usmUserStatus, NewRowIndex], ?destroy}],
?line s(Vbs4),
- ?line expect(1, Vbs4),
-
+ ?line ?expect1(Vbs4),
ok.
@@ -5239,7 +5680,60 @@ loop_it_2(Oid, N) ->
%%% Testing of reported bugs and other tickets.
%%%-----------------------------------------------------------------
+reported_bugs_cases() ->
+ [
+ otp_1128,
+ otp_1129,
+ otp_1131,
+ otp_1162,
+ otp_1222,
+ otp_1298,
+ otp_1331,
+ otp_1338,
+ otp_1342,
+ otp_1366,
+ otp_2776,
+ otp_2979,
+ otp_3187,
+ otp_3725
+ ].
+
+reported_bugs2_cases() ->
+ [
+ otp_1128_2,
+ otp_1129_2,
+ otp_1131_2,
+ otp_1162_2,
+ otp_1222_2,
+ otp_1298_2,
+ otp_1331_2,
+ otp_1338_2,
+ otp_1342_2,
+ otp_1366_2,
+ otp_2776_2,
+ otp_2979_2,
+ otp_3187_2
+ ].
+reported_bugs3_cases() ->
+ [
+ otp_1128_3,
+ otp_1129_3,
+ otp_1131_3,
+ otp_1162_3,
+ otp_1222_3,
+ otp_1298_3,
+ otp_1331_3,
+ otp_1338_3,
+ otp_1342_3,
+ otp_1366_3,
+ otp_2776_3,
+ otp_2979_3,
+ otp_3187_3,
+ otp_3542
+ ].
+
+
%%-----------------------------------------------------------------
%% Ticket: OTP-1128
%% Slogan: Bug in handling of createAndWait set-requests.
@@ -5251,14 +5745,14 @@ otp_1128(Config) when is_list(Config) ->
?line load_master("OLD-SNMPEA-MIB"),
?line init_old(),
- try_test(otp_1128),
+ try_test(otp_1128_test),
?line unload_master("OLD-SNMPEA-MIB").
otp_1128_2(X) -> ?P(otp_1128_2), otp_1128(X).
otp_1128_3(X) -> ?P(otp_1128_3), otp_1128(X).
-otp_1128() ->
+otp_1128_test() ->
io:format("Testing bug reported in ticket OTP-1128...~n"),
NewKeyc3 = [intCommunityViewIndex,get(mip),is("test")],
@@ -5266,15 +5760,16 @@ otp_1128() ->
NewKeyc5 = [intCommunityStatus,get(mip),is("test")],
s([{NewKeyc5, ?createAndWait}, {NewKeyc4, 2}]),
- ?line expect(28, [{NewKeyc5, ?createAndWait}, {NewKeyc4, 2}]),
+ ?line ?expect1([{NewKeyc5, ?createAndWait}, {NewKeyc4, 2}]),
g([NewKeyc5]),
- ?line expect(29, [{NewKeyc5, ?notReady}]),
+ ?line ?expect1([{NewKeyc5, ?notReady}]),
s([{NewKeyc5, ?active}, {NewKeyc3, 2}]),
- ?line expect(30, [{NewKeyc5, ?active}, {NewKeyc3, 2}]),
+ ?line ?expect1([{NewKeyc5, ?active}, {NewKeyc3, 2}]),
g([NewKeyc5]),
- ?line expect(31, [{NewKeyc5, ?active}]),
+ ?line ?expect1([{NewKeyc5, ?active}]),
s([{NewKeyc5, ?destroy}]),
- ?line expect(32, [{NewKeyc5, ?destroy}]).
+ ?line ?expect1([{NewKeyc5, ?destroy}]).
+
%%-----------------------------------------------------------------
%% Ticket: OTP-1129, OTP-1169
@@ -5297,6 +5792,7 @@ otp_1129_i(MaNode) ->
false = rpc:call(MaNode, snmp, int_to_enum, [iso, 1]),
false = rpc:call(MaNode, snmp, int_to_enum, [isox, 1]).
+
%%-----------------------------------------------------------------
%% Ticket: OTP-1131
%% Slogan: Agent crashes / erlang node halts if RowIndex in a
@@ -5309,7 +5805,7 @@ otp_1131(Config) when is_list(Config) ->
init_case(Config),
?line load_master("Klas1"),
- try_test(otp_1131),
+ try_test(otp_1131_test),
?line unload_master("Klas1").
otp_1131_2(X) -> ?P(otp_1131_2), otp_1131(X).
@@ -5352,11 +5848,11 @@ otp_1131_3(X) ->
?P(otp_1131_3),
otp_1131(X).
-otp_1131() ->
+otp_1131_test() ->
io:format("Testing bug reported in ticket OTP-1131...~n"),
s([{[friendsEntry, [2, 3, 1]], s, "kompis3"},
{[friendsEntry, [3, 3, 1]], i, ?createAndGo}]),
- ?line expect(1, ?v1_2(noSuchName, noCreation), 2, any).
+ ?line ?expect3(?v1_2(noSuchName, noCreation), 2, any).
%%-----------------------------------------------------------------
@@ -5368,16 +5864,16 @@ otp_1162(Config) when is_list(Config) ->
?P(otp_1162),
{SaNode, _MgrNode, _MibDir} = init_case(Config),
?line {ok, SA} = start_subagent(SaNode, ?sa, "SA-MIB"),
- try_test(otp_1162),
+ try_test(otp_1162_test),
stop_subagent(SA).
otp_1162_2(X) -> ?P(otp_1162_2), otp_1162(X).
otp_1162_3(X) -> ?P(otp_1162_3), otp_1162(X).
-otp_1162() ->
+otp_1162_test() ->
s([{[sa, [2,0]], 6}]), % wrongValue (i is_set_ok)
- ?line expect(1, ?v1_2(badValue, wrongValue), 1, any).
+ ?line ?expect3(?v1_2(badValue, wrongValue), 1, any).
%%-----------------------------------------------------------------
@@ -5390,7 +5886,7 @@ otp_1222(Config) when is_list(Config) ->
init_case(Config),
?line load_master("Klas3"),
?line load_master("Klas4"),
- try_test(otp_1222),
+ try_test(otp_1222_test),
?line unload_master("Klas3"),
?line unload_master("Klas4").
@@ -5398,12 +5894,13 @@ otp_1222_2(X) -> ?P(otp_1222_2), otp_1222(X).
otp_1222_3(X) -> ?P(otp_1222_3), otp_1222(X).
-otp_1222() ->
+otp_1222_test() ->
io:format("Testing bug reported in ticket OTP-1222...~n"),
s([{[fStatus4,1], 4}, {[fName4,1], 1}]),
- ?line expect(1, genErr, 0, any),
+ ?line ?expect3(genErr, 0, any),
s([{[fStatus4,2], 4}, {[fName4,2], 1}]),
- ?line expect(2, genErr, 0, any).
+ ?line ?expect3(genErr, 0, any).
+
%%-----------------------------------------------------------------
%% Ticket: OTP-1298
@@ -5415,17 +5912,17 @@ otp_1298(Config) when is_list(Config) ->
init_case(Config),
?line load_master("Klas2"),
- try_test(otp_1298),
+ try_test(otp_1298_test),
?line unload_master("Klas2").
otp_1298_2(X) -> ?P(otp_1298_2), otp_1298(X).
otp_1298_3(X) -> ?P(otp_1298_3), otp_1298(X).
-otp_1298() ->
+otp_1298_test() ->
io:format("Testing bug reported in ticket OTP-1298...~n"),
s([{[fint,0], -1}]),
- ?line expect(1298, [{[fint,0], -1}]).
+ ?line ?expect1([{[fint,0], -1}]).
%%-----------------------------------------------------------------
@@ -5438,17 +5935,17 @@ otp_1331(Config) when is_list(Config) ->
init_case(Config),
?line load_master("OLD-SNMPEA-MIB"),
?line init_old(),
- try_test(otp_1331),
+ try_test(otp_1331_test),
?line unload_master("OLD-SNMPEA-MIB").
otp_1331_2(X) -> ?P(otp_1331_2), otp_1331(X).
otp_1331_3(X) -> ?P(otp_1331_3), otp_1331(X).
-otp_1331() ->
+otp_1331_test() ->
NewKeyc5 = [intCommunityStatus,[127,32,0,0],is("test")],
s([{NewKeyc5, ?destroy}]),
- ?line expect(1, [{NewKeyc5, ?destroy}]).
+ ?line ?expect1([{NewKeyc5, ?destroy}]).
%%-----------------------------------------------------------------
@@ -5461,18 +5958,19 @@ otp_1338(Config) when is_list(Config) ->
init_case(Config),
?line load_master("Klas2"),
- try_test(otp_1338),
+ try_test(otp_1338_test),
?line unload_master("Klas2").
otp_1338_2(X) -> ?P(otp_1338_2), otp_1338(X).
otp_1338_3(X) -> ?P(otp_1338_3), otp_1338(X).
-otp_1338() ->
+otp_1338_test() ->
s([{[kStatus2, 7], i, ?createAndGo}]),
- ?line expect(1, [{[kStatus2, 7], ?createAndGo}]),
+ ?line ?expect1([{[kStatus2, 7], ?createAndGo}]),
g([[kName2, 7]]),
- ?line expect(2, [{[kName2, 7], "JJJ"}]).
+ ?line ?expect1([{[kName2, 7], "JJJ"}]).
+
%%-----------------------------------------------------------------
%% Ticket: OTP-1342
@@ -5484,18 +5982,18 @@ otp_1342(Config) when is_list(Config) ->
?P(otp_1342),
init_case(Config),
?line load_master("Klas4"),
- try_test(otp_1342),
+ try_test(otp_1342_test),
?line unload_master("Klas4").
otp_1342_2(X) -> ?P(otp_1342_2), otp_1342(X).
otp_1342_3(X) -> ?P(otp_1342_3), otp_1342(X).
-otp_1342() ->
+otp_1342_test() ->
s([{[fIndex5, 1], i, 1},
{[fName5, 1], i, 3},
{[fStatus5, 1], i, ?createAndGo}]),
- ?line expect(1, ?v1_2(noSuchName, noCreation), 3, any).
+ ?line ?expect3(?v1_2(noSuchName, noCreation), 3, any).
%%-----------------------------------------------------------------
@@ -5510,17 +6008,18 @@ otp_1366(Config) when is_list(Config) ->
init_case(Config),
?line load_master("OLD-SNMPEA-MIB"),
?line init_old(),
- try_test(otp_1366),
+ try_test(otp_1366_test),
?line unload_master("OLD-SNMPEA-MIB").
otp_1366_2(X) -> ?P(otp_1366_2), otp_1366(X).
otp_1366_3(X) -> ?P(otp_1366_3), otp_1366(X).
-otp_1366() ->
+otp_1366_test() ->
?INF("NOT YET IMPLEMENTED", []),
'NYI'.
+
%%-----------------------------------------------------------------
%% Ticket: OTP-2776
%% Slogan: snmp:validate_date_and_time() fails when time is 00:00
@@ -5529,13 +6028,13 @@ otp_2776(suite) -> [];
otp_2776(Config) when is_list(Config) ->
?P(otp_2776),
init_case(Config),
- try_test(otp_2776).
+ try_test(otp_2776_test).
otp_2776_2(X) -> ?P(otp_2776_2), otp_2776(X).
otp_2776_3(X) -> ?P(otp_2776_3), otp_2776(X).
-otp_2776() ->
+otp_2776_test() ->
io:format("Testing bug reported in ticket OTP-2776...~n"),
Dt01_valid = [19,98,9,1,1,0,23,0,43,0,0],
@@ -5598,17 +6097,18 @@ otp_2979(Config) when is_list(Config) ->
init_case(Config),
?line load_master("Test1"),
?line init_old(),
- try_test(otp_2979),
+ try_test(otp_2979_test),
?line unload_master("Test1").
otp_2979_2(X) -> ?P(otp_2979_2), otp_2979(X).
otp_2979_3(X) -> ?P(otp_2979_3), otp_2979(X).
-otp_2979() ->
+otp_2979_test() ->
gn([[sparseDescr], [sparseStatus]]),
- ?line expect(1, [{[sparseStr,0], "slut"},
- {[sparseStr,0], "slut"}]).
+ ?line ?expect1([{[sparseStr,0], "slut"},
+ {[sparseStr,0], "slut"}]).
+
%%-----------------------------------------------------------------
%% Ticket: OTP-3187
@@ -5620,14 +6120,14 @@ otp_3187(Config) when is_list(Config) ->
?P(otp_3187),
init_case(Config),
?line load_master_std("SNMP-VIEW-BASED-ACM-MIB"),
- otp_3187(),
+ otp_3187_test(),
?line unload_master("SNMP-VIEW-BASED-ACM-MIB").
otp_3187_2(X) -> ?P(otp_3187_2), otp_3187(X).
otp_3187_3(X) -> ?P(otp_3187_3), otp_3187(X).
-otp_3187() ->
+otp_3187_test() ->
?line Elements =
snmp_view_based_acm_mib:vacmAccessTable(get_next,[],[4,5,6]),
lists:foreach(fun(E) ->
@@ -5645,9 +6145,9 @@ otp_3542(suite) -> [];
otp_3542(Config) when is_list(Config) ->
?P(otp_3542),
init_case(Config),
- try_test(otp_3542).
+ try_test(otp_3542_test).
-otp_3542() ->
+otp_3542_test() ->
io:format("SNMP v3 discovery...~n"),
?line Res = snmp_test_mgr:d(),
io:format("SNMP v3 discovery result: ~p~n",[Res]).
@@ -5716,10 +6216,15 @@ otp_3725_test(MaNode) ->
%% Slogan: Target mib tag list check invalid
%%-----------------------------------------------------------------
+tickets1_cases() ->
+ [
+ {group, otp4394},
+ {group, otp7157}
+ ].
+
-
-init_otp_4394(Config) when is_list(Config) ->
- ?DBG("init_otp_4394 -> entry with"
+otp_4394_init(Config) when is_list(Config) ->
+ ?DBG("otp_4394_init -> entry with"
"~n Config: ~p", [Config]),
?line AgentConfDir = ?config(agent_conf_dir, Config),
?line MgrDir = ?config(mgr_dir, Config),
@@ -5772,35 +6277,35 @@ otp_4394_config(AgentConfDir, MgrDir, Ip0) ->
-finish_otp_4394(Config) when is_list(Config) ->
+otp_4394_finish(Config) when is_list(Config) ->
?DBG("finish_otp_4394 -> entry", []),
C1 = stop_agent(Config),
delete_files(C1),
erase(mgr_node),
lists:keydelete(vsn, 1, C1).
-otp_4394_test(suite) -> [];
-otp_4394_test(Config) ->
- ?P(otp_4394_test),
- ?DBG("otp_4394_test -> entry", []),
+otp_4394(suite) -> [];
+otp_4394(Config) ->
+ ?P(otp_4394),
+ ?DBG("otp_4394 -> entry", []),
init_case(Config),
- try_test(otp_4394_test1),
- ?DBG("otp_4394_test -> done", []),
+ try_test(otp_4394_test),
+ ?DBG("otp_4394 -> done", []),
ok.
-otp_4394_test1() ->
- ?DBG("otp_4394_test1 -> entry", []),
+otp_4394_test() ->
+ ?DBG("otp_4394_test -> entry", []),
gn([[1,1]]),
Res =
case snmp_test_mgr:expect(1, [{[sysDescr,0], "Erlang SNMP agent"}]) of
%% {error, 1, {"?",[]}, {"~w",[timeout]}}
{error, 1, _, {_, [timeout]}} ->
- ?DBG("otp_4394_test1 -> expected result: timeout", []),
+ ?DBG("otp_4394_test -> expected result: timeout", []),
ok;
Else ->
Else
end,
- ?DBG("otp_4394_test1 -> done with: ~p", [Res]),
+ ?DBG("otp_4394_test -> done with: ~p", [Res]),
Res.
@@ -5811,7 +6316,7 @@ otp_4394_test1() ->
-init_otp_7157(Config) when is_list(Config) ->
+otp_7157_init(Config) when is_list(Config) ->
%% <CONDITIONAL-SKIP>
Skippable = [win32],
Condition = fun() -> ?OS_BASED_SKIP(Skippable) end,
@@ -5831,30 +6336,30 @@ init_otp_7157(Config) when is_list(Config) ->
[{vsn, v2} | start_v2_agent(Config, Opts)].
-finish_otp_7157(Config) when is_list(Config) ->
+otp_7157_finish(Config) when is_list(Config) ->
?DBG("finish_otp_7157 -> entry", []),
C1 = stop_agent(Config),
delete_files(C1),
erase(mgr_node),
lists:keydelete(vsn, 1, C1).
-otp_7157_test(suite) -> [];
-otp_7157_test(Config) ->
- ?P(otp_7157_test),
- ?DBG("otp_7157_test -> entry", []),
+otp_7157(suite) -> [];
+otp_7157(Config) ->
+ ?P(otp_7157),
+ ?DBG("otp_7157 -> entry", []),
init_case(Config),
MA = whereis(snmp_master_agent),
?line load_master("Test1"),
- try_test(otp_7157_test1, [MA]),
+ try_test(otp_7157_test, [MA]),
?line unload_master("Test1"),
- ?DBG("otp_7157_test -> done", []),
+ ?DBG("otp_7157 -> done", []),
ok.
%% ts:run(snmp, snmp_agent_test, [batch]).
-otp_7157_test1(MA) ->
- ?LOG("start otp_7157_test1 test (~p)",[MA]),
+otp_7157_test(MA) ->
+ ?LOG("start otp_7157_test test (~p)",[MA]),
snmpa:verbosity(MA, trace),
- ?LOG("start otp_7157_test1 test",[]),
+ ?LOG("start otp_7157_test test",[]),
?P1("Testing that varbinds in traps/notifications are not reordered"),
?DBG("send cntTrap",[]),
@@ -5862,11 +6367,11 @@ otp_7157_test1(MA) ->
?DBG("await response",[]),
%% We don't really care about the values, just the vb order.
- ?line ok = expect(1, v2trap, [{[sysUpTime, 0], any},
- {[snmpTrapOID, 0], any},
- {[sysContact, 0], any},
- {[cnt64, 0], any},
- {[sysLocation, 0], any}]),
+ ?line ok = ?expect2(v2trap, [{[sysUpTime, 0], any},
+ {[snmpTrapOID, 0], any},
+ {[sysContact, 0], any},
+ {[cnt64, 0], any},
+ {[sysLocation, 0], any}]),
?DBG("done", []),
ok.
@@ -5878,6 +6383,13 @@ otp_7157_test1(MA) ->
%% These cases are started in the new way
%%-----------------------------------------------------------------
+tickets2_cases() ->
+ [
+ otp8395,
+ otp9884
+ ].
+
+
otp8395({init, Config}) when is_list(Config) ->
?DBG("otp8395(init) -> entry with"
"~n Config: ~p", [Config]),
@@ -6336,13 +6848,13 @@ process_options(Defaults, _Opts) ->
%% {value, {Key, Value}} when is_list->
-snmp_app_env_init(Node, Entity, Conf) ->
- rpc:call(Node, snmp_app_env_init, [Entity, Conf]).
+%% snmp_app_env_init(Node, Entity, Conf) ->
+%% rpc:call(Node, snmp_app_env_init, [Entity, Conf]).
-snmp_app_env_init(Entity, Conf) ->
- application:unload(snmp),
- application:load(snmp),
- application:set_env(snmp, Entity, Conf).
+%% snmp_app_env_init(Entity, Conf) ->
+%% application:unload(snmp),
+%% application:load(snmp),
+%% application:set_env(snmp, Entity, Conf).
start_stdalone_agent(Node, Config) ->
rpc:call(Node, ?MODULE, start_stdalone_agent, [Config]).
@@ -6403,10 +6915,10 @@ info_test(Config) when is_list(Config) ->
?line load_master("OLD-SNMPEA-MIB"),
?line init_old(),
- try_test(info_test1, [node()]),
+ try_test(do_info, [node()]),
?line unload_master("OLD-SNMPEA-MIB").
-info_test1(MaNode) ->
+do_info(MaNode) ->
?line Info = rpc:call(MaNode, snmpa, info, []),
?DBG("info_test1 -> Info: ~n~p", [Info]),
Keys = [vsns,
@@ -6482,7 +6994,7 @@ verify_old_info([Key|Keys], Info) ->
?FAIL({missing_old_info, Key})
end.
-%% string used in index
+%% Index String - string used in index
is(S) -> [length(S) | S].
try_test(Func) ->
@@ -6500,16 +7012,11 @@ try_test(Func, A, Opts) ->
%% Test manager wrapperfunctions:
g(Oids) -> snmp_test_mgr:g(Oids).
-gn() -> snmp_test_mgr:gn().
+%%gn() -> snmp_test_mgr:gn().
gn(OidsOrN) -> snmp_test_mgr:gn(OidsOrN).
gb(NR, MR, Oids) -> snmp_test_mgr:gb(NR, MR, Oids).
s(VAV) -> snmp_test_mgr:s(VAV).
-expect(A, B) -> snmp_agent_test_lib:expect(A, B).
-expect(A, B, C) -> snmp_agent_test_lib:expect(A, B, C).
-expect(A, B, C, D) -> snmp_agent_test_lib:expect(A, B, C, D).
-expect(A, B, C, D, E, F) -> snmp_agent_test_lib:expect(A, B, C, D, E, F).
-
get_req(Id, Vars) ->
snmp_agent_test_lib:get_req(Id, Vars).
@@ -6545,8 +7052,8 @@ rewrite_usm_mgr(Dir, ShaKey, DesKey) ->
reset_usm_mgr(Dir) ->
snmp_agent_test_lib:reset_usm_mgr(Dir).
-update_community(Vsns, DIr) ->
- snmp_agent_test_lib:update_community(Vsns, DIr).
+%% update_community(Vsns, Dir) ->
+%% snmp_agent_test_lib:update_community(Vsns, Dir).
update_vacm(Vsn, Dir) ->
snmp_agent_test_lib:update_vacm(Vsn, Dir).
@@ -6579,8 +7086,8 @@ reset_target_params_conf(Dir) ->
write_notify_conf(Dir) ->
snmp_agent_test_lib:write_notify_conf(Dir).
-write_view_conf(Dir) ->
- snmp_agent_test_lib:write_view_conf(Dir).
+%% write_view_conf(Dir) ->
+%% snmp_agent_test_lib:write_view_conf(Dir).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -6742,8 +7249,8 @@ lists_key1search(Key, List) when is_atom(Key) ->
end.
-regs() ->
- lists:sort(registered()).
+%% regs() ->
+%% lists:sort(registered()).
%% ------
diff --git a/lib/snmp/test/snmp_agent_test_lib.erl b/lib/snmp/test/snmp_agent_test_lib.erl
index 757aebfa9b..11c05fc1db 100644
--- a/lib/snmp/test/snmp_agent_test_lib.erl
+++ b/lib/snmp/test/snmp_agent_test_lib.erl
@@ -28,7 +28,7 @@
start_mt_agent/1, start_mt_agent/2,
stop_agent/1,
- start_sup/0, stop_sup/2,
+ %% start_sup/0, stop_sup/2,
start_subagent/3, stop_subagent/1,
start_sub_sup/1, start_sub_sup/2,
@@ -58,7 +58,7 @@
init_all/1, finish_all/1,
init_case/1,
try_test/2, try_test/3, try_test/4,
- expect/2, expect/3, expect/4, expect/6,
+ expect/3, expect/4, expect/5, expect/7,
regs/0,
rpc/3
@@ -418,10 +418,10 @@ start_bilingual_agent(Config, Opts)
start_agent(Config, [v1,v2], Opts).
start_mt_agent(Config) when is_list(Config) ->
- start_agent(Config, [v2], [{snmp_multi_threaded, true}]).
+ start_agent(Config, [v2], [{multi_threaded, true}]).
start_mt_agent(Config, Opts) when is_list(Config) andalso is_list(Opts) ->
- start_agent(Config, [v2], [{snmp_multi_threaded, true}|Opts]).
+ start_agent(Config, [v2], [{multi_threaded, true}|Opts]).
start_agent(Config, Vsns) ->
start_agent(Config, Vsns, []).
@@ -437,79 +437,231 @@ start_agent(Config, Vsns, Opts) ->
?line AgentDbDir = ?config(agent_db_dir, Config),
?line SaNode = ?config(snmp_sa, Config),
- app_env_init(vsn_init(Vsns) ++
- [{audit_trail_log, read_write_log},
- {audit_trail_log_dir, AgentLogDir},
- {audit_trail_log_size, {10240, 10}},
- {force_config_reload, false},
- {snmp_agent_type, master},
- {snmp_config_dir, AgentConfDir},
- {snmp_db_dir, AgentDbDir},
- {snmp_local_db_auto_repair, true},
- {snmp_local_db_verbosity, log},
- {snmp_master_agent_verbosity, trace},
- {snmp_supervisor_verbosity, trace},
- {snmp_mibserver_verbosity, log},
- {snmp_symbolic_store_verbosity, log},
- {snmp_note_store_verbosity, log},
- {snmp_net_if_verbosity, trace}],
- Opts),
-
+ Env = app_agent_env_init(
+ [{versions, Vsns},
+ {agent_type, master},
+ {agent_verbosity, trace},
+ {db_dir, AgentDbDir},
+ {audit_trail_log, [{type, read_write},
+ {dir, AgentLogDir},
+ {size, {10240, 10}}]},
+ {config, [{dir, AgentConfDir},
+ {force_load, false},
+ {verbosity, trace}]},
+ {local_db, [{repair, true},
+ {verbosity, log}]},
+ {mib_server, [{verbosity, log}]},
+ {symbolic_store, [{verbosity, log}]},
+ {note_store, [{verbosity, log}]},
+ {net_if, [{verbosity, trace}]}],
+ Opts),
+
process_flag(trap_exit,true),
{ok, AppSup} = snmp_app_sup:start_link(),
unlink(AppSup),
- ?DBG("start_agent -> snmp app supervisor: ~p",[AppSup]),
+ ?DBG("start_agent -> snmp app supervisor: ~p", [AppSup]),
- ?DBG("start_agent -> start master agent (old style)",[]),
- ?line Sup = start_sup(),
+ ?DBG("start_agent -> start master agent",[]),
+ ?line Sup = start_sup(Env),
- ?DBG("start_agent -> unlink from supervisor",[]),
+ ?DBG("start_agent -> unlink from supervisor", []),
?line unlink(Sup),
?line SaDir = ?config(sa_dir, Config),
- ?DBG("start_agent -> (rpc) start sub on ~p",[SaNode]),
+ ?DBG("start_agent -> (rpc) start sub on ~p", [SaNode]),
?line {ok, Sub} = start_sub_sup(SaNode, SaDir),
?DBG("start_agent -> done",[]),
?line [{snmp_sup, {Sup, self()}}, {snmp_sub, Sub} | Config].
-vsn_init(Vsn) ->
- vsn_init([v1,v2,v3], Vsn, []).
+app_agent_env_init(Env0, Opts) ->
+ ?DBG("app_agent_env_init -> unload snmp",[]),
+ ?line application:unload(snmp),
+
+ ?DBG("app_agent_env_init -> load snmp",[]),
+ ?line application:load(snmp),
-vsn_init([], _Vsn, Acc) ->
- Acc;
-vsn_init([V|Vsns], Vsn, Acc) ->
- case lists:member(V, Vsn) of
- true ->
- vsn_init(Vsns, Vsn, [{V, true}|Acc]);
- false ->
- vsn_init(Vsns, Vsn, [{V, false}|Acc])
+ ?DBG("app_agent_env_init -> "
+ "merge or maybe replace (snmp agent) app env",[]),
+ Env = add_or_maybe_merge_agent_env(Opts, Env0),
+ ?DBG("app_agent_env_init -> merged env: "
+ "~n ~p", [Env]),
+
+ %% We put it into the app environment just as
+ %% a precaution, since when starting normally,
+ %% this is where the environment is extracted from.
+ app_agent_set_env(Env),
+ Env.
+
+app_agent_set_env(Value) ->
+ application_controller:set_env(snmp, agent, Value).
+
+add_or_maybe_merge_agent_env([], Env) ->
+ ?DBG("merging agent env -> merged", []),
+ lists:keysort(1, Env);
+add_or_maybe_merge_agent_env([{Key, Value1}|Opts], Env) ->
+ ?DBG("merging agent env -> add, replace or merge ~p", [Key]),
+ case lists:keysearch(Key, 1, Env) of
+ {value, {Key, Value1}} ->
+ %% Identical, move on
+ ?DBG("merging agent env -> "
+ "no need to merge ~p - identical - keep: "
+ "~n ~p", [Key, Value1]),
+ add_or_maybe_merge_agent_env(Opts, Env);
+ {value, {Key, Value2}} ->
+ %% Another value, merge or replace
+ NewValue = merge_or_replace_agent_env(Key, Value1, Value2),
+ Env2 = lists:keyreplace(Key, 1, Env, {Key, NewValue}),
+ add_or_maybe_merge_agent_env(Opts, Env2);
+ false ->
+ ?DBG("merging agent env -> no old ~p to merge with - add: "
+ "~n ~p", [Key, Value1]),
+ add_or_maybe_merge_agent_env(Opts, [{Key, Value1}|Env])
end.
-app_env_init(Env0, Opts) ->
- ?DBG("app_env_init -> unload snmp",[]),
- ?line application:unload(snmp),
- ?DBG("app_env_init -> load snmp",[]),
- ?line application:load(snmp),
- ?DBG("app_env_init -> initiate (snmp) application env",[]),
- F1 = fun({Key, Val} = New, Acc0) ->
- ?DBG("app_env_init -> "
- "updating setting ~p to ~p", [Key, Val]),
- case lists:keyreplace(Key, 1, Acc0, New) of
- Acc0 ->
- [New|Acc0];
- Acc ->
- Acc
- end
- end,
- Env = lists:foldr(F1, Env0, Opts),
- ?DBG("app_env_init -> Env: ~p",[Env]),
- F2 = fun({Key,Val}) ->
- ?DBG("app_env_init -> setting ~p to ~p",[Key, Val]),
- application_controller:set_env(snmp, Key, Val)
- end,
- lists:foreach(F2, Env).
+merge_or_replace_agent_env(versions, NewVersions, _OldVersions) ->
+ ?DBG("merging agent env -> versions replaced: ~p -> ~p",
+ [NewVersions, _OldVersions]),
+ NewVersions;
+merge_or_replace_agent_env(agent_type, NewType, _OldType) ->
+ ?DBG("merging agent env -> agent type replaced: ~p -> ~p",
+ [NewType, _OldType]),
+ NewType;
+merge_or_replace_agent_env(agent_verbosity, NewVerbosity, _OldVerbosity) ->
+ ?DBG("merging agent env -> agent verbosity replaced: ~p -> ~p",
+ [NewVerbosity, _OldVerbosity]),
+ NewVerbosity;
+merge_or_replace_agent_env(db_dir, NewDbDir, _OldDbDir) ->
+ ?DBG("merging agent env -> db-dir replaced: ~p -> ~p",
+ [NewDbDir, _OldDbDir]),
+ NewDbDir;
+merge_or_replace_agent_env(audit_trail_log, NewATL, OldATL) ->
+ merge_or_replace_agent_env_atl(NewATL, OldATL);
+merge_or_replace_agent_env(config, NewConfig, OldConfig) ->
+ merge_or_replace_agent_env_config(NewConfig, OldConfig);
+merge_or_replace_agent_env(local_db, NewLdb, OldLdb) ->
+ merge_or_replace_agent_env_ldb(NewLdb, OldLdb);
+merge_or_replace_agent_env(mib_storage, NewMst, OldMst) ->
+ merge_or_replace_agent_env_mib_storage(NewMst, OldMst);
+merge_or_replace_agent_env(mib_server, NewMibs, OldMibs) ->
+ merge_or_replace_agent_env_mib_server(NewMibs, OldMibs);
+merge_or_replace_agent_env(symbolic_store, NewSymStore, OldSymStore) ->
+ merge_or_replace_agent_env_symbolic_store(NewSymStore, OldSymStore);
+merge_or_replace_agent_env(note_store, NewNoteStore, OldNoteStore) ->
+ merge_or_replace_agent_env_note_store(NewNoteStore, OldNoteStore);
+merge_or_replace_agent_env(net_if, NewNetIf, OldNetIf) ->
+ merge_or_replace_agent_env_net_if(NewNetIf, OldNetIf);
+merge_or_replace_agent_env(Key, NewValue, OldValue) ->
+ ?FAIL({not_implemented_merge_or_replace,
+ Key, NewValue, OldValue}).
+
+merge_or_replace_agent_env_atl(New, Old) ->
+ ATL = merge_agent_options(New, Old),
+ ?DBG("merging agent env -> audit-trail-log merged: "
+ "~n ~p | ~p -> ~p", [New, Old, ATL]),
+ ATL.
+
+merge_or_replace_agent_env_config(New, Old) ->
+ Config = merge_agent_options(New, Old),
+ case lists:keymember(dir, 1, Config) of
+ true ->
+ ?DBG("merging agent env -> config merged: "
+ "~n ~p | ~p -> ~p", [New, Old, Config]),
+ Config;
+ false ->
+ ?FAIL({missing_mandatory_option, {config, dir}})
+ end.
+
+merge_or_replace_agent_env_ldb(New, Old) ->
+ LDB = merge_agent_options(New, Old),
+ ?DBG("merging agent env -> local-db merged: "
+ "~n ~p | ~p -> ~p", [New, Old, LDB]),
+ LDB.
+
+merge_or_replace_agent_env_mib_storage(NewMibStorage, OldMibStorage) ->
+ %% Shall we merge or replace?
+ %% module is mandatory. We will only merge if NewModule is
+ %% equal to OldModule.
+ NewModule =
+ case lists:keysearch(module, 1, NewMibStorage) of
+ {value, {module, M}} ->
+ M;
+ false ->
+ ?FAIL({missing_mandatory_option, {mib_storage, module}})
+ end,
+ case lists:keysearch(module, 1, OldMibStorage) of
+ {value, {module, NewModule}} ->
+ %% Same module => merge
+ %% Non-ex new options => remove
+ %% Ex new options and non-ex old options => replace
+ %% Otherwise merge
+ case lists:keysearch(options, 1, NewMibStorage) of
+ false ->
+ ?DBG("merging agent env -> "
+ "no mib-storage ~p merge needed - "
+ "no new options (= remove old options)", [NewModule]),
+ NewMibStorage;
+ {value, {options, NewOptions}} ->
+ case lists:keysearch(options, 1, OldMibStorage) of
+ false ->
+ ?DBG("merging agent env -> "
+ "no mib-storage ~p merge needed - "
+ "no old options", [NewModule]),
+ NewMibStorage;
+ {value, {options, OldOptions}} ->
+ MergedOptions =
+ merge_agent_options(NewOptions, OldOptions),
+ ?DBG("merging agent env -> mib-storage ~p merged: "
+ "~n Options: ~p | ~p -> ~p",
+ [NewModule,
+ NewOptions, OldOptions, MergedOptions]),
+ [{module, NewModule},
+ {options, MergedOptions}]
+ end
+ end;
+ _ ->
+ %% Diff module => replace
+ ?DBG("merging agent env -> "
+ "no mib-storage ~p merge needed - "
+ "new module", [NewModule]),
+ NewMibStorage
+ end.
+
+merge_or_replace_agent_env_mib_server(New, Old) ->
+ MibServer = merge_agent_options(New, Old),
+ ?DBG("merging agent env -> mib-server merged: "
+ "~n ~p | ~p -> ~p", [New, Old, MibServer]),
+ MibServer.
+
+merge_or_replace_agent_env_symbolic_store(New, Old) ->
+ SymbolicStore = merge_agent_options(New, Old),
+ ?DBG("merging agent env -> symbolic-store merged: "
+ "~n ~p | ~p -> ~p", [New, Old, SymbolicStore]),
+ SymbolicStore.
+
+merge_or_replace_agent_env_note_store(New, Old) ->
+ NoteStore = merge_agent_options(New, Old),
+ ?DBG("merging agent env -> note-store merged: "
+ "~n ~p | ~p -> ~p", [New, Old, NoteStore]),
+ NoteStore.
+
+merge_or_replace_agent_env_net_if(New, Old) ->
+ NetIf = merge_agent_options(New, Old),
+ ?DBG("merging agent env -> net-if merged: "
+ "~n ~p | ~p -> ~p", [New, Old, NetIf]),
+ NetIf.
+
+merge_agent_options([], Options) ->
+ lists:keysort(1, Options);
+merge_agent_options([{Key, _Value} = Opt|Opts], Options) ->
+ case lists:keysearch(Key, 1, Options) of
+ {value, _} ->
+ NewOptions = lists:keyreplace(Key, 1, Options, Opt),
+ merge_agent_options(Opts, NewOptions);
+ false ->
+ merge_agent_options(Opts, [Opt|Options])
+ end.
stop_agent(Config) when is_list(Config) ->
@@ -544,8 +696,8 @@ stop_agent(Config) when is_list(Config) ->
lists:keydelete(snmp_sub, 1, C1).
-start_sup() ->
- case (catch snmpa_app:start(normal)) of
+start_sup(Env) ->
+ case (catch snmp_app_sup:start_agent(normal, Env)) of
{ok, S} ->
?DBG("start_agent -> started, Sup: ~p",[S]),
S;
@@ -553,7 +705,7 @@ start_sup() ->
Else ->
?DBG("start_agent -> unknown result: ~n~p",[Else]),
%% Get info about the apps we depend on
- ?FAIL({start_failed,Else, ?IS_MNESIA_RUNNING()})
+ ?FAIL({start_failed, Else, ?IS_MNESIA_RUNNING()})
end.
stop_sup(Pid, _) when (node(Pid) =:= node()) ->
@@ -594,7 +746,7 @@ start_sub_sup(Node, Dir) ->
start_sub_sup(Dir) ->
?DBG("start_sub -> entry",[]),
- Opts = [{db_dir, Dir},
+ Opts = [{db_dir, Dir},
{supervisor, [{verbosity, trace}]}],
{ok, P} = snmpa_supervisor:start_sub_sup(Opts),
unlink(P),
@@ -690,31 +842,33 @@ agent_info(Sup) ->
%% ---
+%% The first two arguments are simple to be able to find where in the
+%% (test) code this call is made.
-expect(Id, A) ->
- Fun = fun() -> do_expect(A) end,
- expect2(Id, Fun).
+expect(Mod, Line, What) ->
+ Fun = fun() -> do_expect(What) end,
+ expect2(Mod, Line, Fun).
-expect(Id, A, B) ->
- Fun = fun() -> do_expect(A, B) end,
- expect2(Id, Fun).
+expect(Mod, Line, What, ExpVBs) ->
+ Fun = fun() -> do_expect(What, ExpVBs) end,
+ expect2(Mod, Line, Fun).
-expect(Id, A, B, C) ->
- Fun = fun() -> do_expect(A, B, C) end,
- expect2(Id, Fun).
+expect(Mod, Line, Error, Index, ExpVBS) ->
+ Fun = fun() -> do_expect(Error, Index, ExpVBS) end,
+ expect2(Mod, Line, Fun).
-expect(Id, A, B, C, D, E) ->
- Fun = fun() -> do_expect(A, B, C, D, E) end,
- expect2(Id, Fun).
+expect(Mod, Line, Type, Enterp, Generic, Specific, ExpVBs) ->
+ Fun = fun() -> do_expect(Type, Enterp, Generic, Specific, ExpVBs) end,
+ expect2(Mod, Line, Fun).
-expect2(Id, F) ->
- io:format("EXPECT for ~w~n", [Id]),
+expect2(Mod, Line, F) ->
+ io:format("EXPECT for ~w:~w~n", [Mod, Line]),
case F() of
{error, Reason} ->
- io:format("EXPECT failed for ~w: ~n~p~n", [Id, Reason]),
- throw({error, {expect, Id, Reason}});
+ io:format("EXPECT failed at ~w:~w => ~n~p~n", [Mod, Line, Reason]),
+ throw({error, {expect, Mod, Line, Reason}});
Else ->
- io:format("EXPECT result for ~w: ~n~p~n", [Id, Else]),
+ io:format("EXPECT result for ~w:~w => ~n~p~n", [Mod, Line, Else]),
Else
end.
@@ -766,7 +920,8 @@ do_expect({timeout, To}) ->
end;
do_expect({Err, To})
- when is_atom(Err) andalso (is_integer(To) orelse (To =:= infinity)) ->
+ when (is_atom(Err) andalso
+ ((is_integer(To) andalso To > 0) orelse (To =:= infinity))) ->
io:format("EXPECT error ~w within ~w~n", [Err, To]),
do_expect({{error, Err}, To});
diff --git a/lib/snmp/test/snmp_test_lib.erl b/lib/snmp/test/snmp_test_lib.erl
index f0abae73e8..505332b586 100644
--- a/lib/snmp/test/snmp_test_lib.erl
+++ b/lib/snmp/test/snmp_test_lib.erl
@@ -435,7 +435,7 @@ crypto_start() ->
end.
crypto_support() ->
- crypto_support([md5_mac_96, sha_mac_96], []).
+ crypto_support([md5, sha], []).
crypto_support([], []) ->
yes;
@@ -450,12 +450,7 @@ crypto_support([Func|Funcs], Acc) ->
end.
is_crypto_supported(Func) ->
- %% The 'catch' handles the case when 'crypto' is
- %% not present in the system (or not started).
- case (catch lists:member(Func, crypto:info())) of
- true -> true;
- _ -> false
- end.
+ snmp_misc:is_crypto_supported(Func).
%% ----------------------------------------------------------------
diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk
index fb7aa52402..0e48e7ea56 100644
--- a/lib/snmp/vsn.mk
+++ b/lib/snmp/vsn.mk
@@ -18,6 +18,6 @@
# %CopyrightEnd%
APPLICATION = snmp
-SNMP_VSN = 4.23.1
+SNMP_VSN = 4.24
PRE_VSN =
APP_VSN = "$(APPLICATION)-$(SNMP_VSN)$(PRE_VSN)"
diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile
index 3b8145089e..cf9f7d5001 100644
--- a/lib/ssl/src/Makefile
+++ b/lib/ssl/src/Makefile
@@ -42,31 +42,37 @@ BEHAVIOUR_MODULES= \
MODULES= \
ssl \
+ tls \
+ dtls \
ssl_alert \
ssl_app \
ssl_dist_sup\
ssl_sup \
inet_tls_dist \
ssl_certificate\
- ssl_certificate_db\
+ ssl_pkix_db\
ssl_cipher \
ssl_srp_primes \
- ssl_connection \
+ tls_connection \
+ dtls_connection \
ssl_connection_sup \
- ssl_handshake \
+ tls_handshake \
+ dtls_handshake\
ssl_manager \
ssl_session \
ssl_session_cache \
ssl_socket \
- ssl_record \
+ tls_record \
+ dtls_record \
ssl_ssl2 \
ssl_ssl3 \
ssl_tls1 \
ssl_tls_dist_proxy
INTERNAL_HRL_FILES = \
- ssl_alert.hrl ssl_cipher.hrl ssl_handshake.hrl ssl_internal.hrl \
- ssl_record.hrl ssl_srp.hrl
+ ssl_alert.hrl ssl_cipher.hrl ssl_handshake.hrl tls_handshake.hrl \
+ dtls_handshake.hrl ssl_internal.hrl \
+ ssl_record.hrl tls_record.hrl dtls_record.hrl ssl_srp.hrl
ERL_FILES= \
$(MODULES:%=%.erl) \
@@ -134,13 +140,14 @@ release_docs_spec:
# Dependencies
# ----------------------------------------------------
$(EBIN)/inet_tls_dist.$(EMULATOR): ../../kernel/include/net_address.hrl ../../kernel/include/dist.hrl ../../kernel/include/dist_util.hrl
-$(EBIN)/ssl.$(EMULATOR): ssl_internal.hrl ssl_record.hrl ssl_cipher.hrl ssl_handshake.hrl ../../public_key/include/public_key.hrl
+$(EBIN)/tls.$(EMULATOR): ssl_internal.hrl ssl_record.hrl ssl_cipher.hrl ssl_handshake.hrl ../../public_key/include/public_key.hrl
$(EBIN)/ssl_alert.$(EMULATOR): ssl_alert.hrl ssl_record.hrl
$(EBIN)/ssl_certificate.$(EMULATOR): ssl_internal.hrl ssl_alert.hrl ssl_handshake.hrl ../../public_key/include/public_key.hrl
$(EBIN)/ssl_certificate_db.$(EMULATOR): ssl_internal.hrl ../../public_key/include/public_key.hrl ../../kernel/include/file.hrl
$(EBIN)/ssl_cipher.$(EMULATOR): ssl_internal.hrl ssl_record.hrl ssl_cipher.hrl ssl_handshake.hrl ssl_alert.hrl ../../public_key/include/public_key.hrl
-$(EBIN)/ssl_connection.$(EMULATOR): ssl_internal.hrl ssl_record.hrl ssl_cipher.hrl ssl_handshake.hrl ssl_alert.hrl ../../public_key/include/public_key.hrl
-$(EBIN)/ssl_handshake.$(EMULATOR): ssl_internal.hrl ssl_record.hrl ssl_cipher.hrl ssl_handshake.hrl ssl_alert.hrl ../../public_key/include/public_key.hrl
+$(EBIN)/tls_connection.$(EMULATOR): ssl_internal.hrl tls_record.hrl ssl_cipher.hrl tls_handshake.hrl ssl_alert.hrl ../../public_key/include/public_key.hrl
+$(EBIN)/dtls_connection.$(EMULATOR): ssl_internal.hrl dtls_record.hrl ssl_cipher.hrl dtls_handshake.hrl ssl_alert.hrl ../../public_key/include/public_key.hrl
+$(EBIN)/tls_handshake.$(EMULATOR): ssl_internal.hrl tls_record.hrl ssl_cipher.hrl tls_handshake.hrl ssl_alert.hrl ../../public_key/include/public_key.hrl
$(EBIN)/ssl_manager.$(EMULATOR): ssl_internal.hrl ssl_handshake.hrl ../../kernel/include/file.hrl
$(EBIN)/ssl_record.$(EMULATOR): ssl_internal.hrl ssl_record.hrl ssl_cipher.hrl ssl_handshake.hrl ssl_alert.hrl
$(EBIN)/ssl_session.$(EMULATOR): ssl_internal.hrl ssl_handshake.hrl
diff --git a/lib/ssl/src/ssl_debug.hrl b/lib/ssl/src/dtls.erl
index e88cef441f..013286c9bd 100644
--- a/lib/ssl/src/ssl_debug.hrl
+++ b/lib/ssl/src/dtls.erl
@@ -1,39 +1,25 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 1999-2013. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%
%%
+%%% Purpose : API for DTLS.
--ifndef(ssl_debug).
--define(ssl_debug, true).
-
--ifdef(SSL_DEBUG).
--define(DBG_HEX(V), ssl_debug:hex_data(??V, V, ?MODULE, ?LINE)).
--define(DBG_TERM(T), ssl_debug:term_data(??T, T, ?MODULE, ?LINE)).
--else.
--define(DBG_HEX(V), ok).
--define(DBG_TERM(T), ok).
--endif.
-
--endif. % -ifdef(ssl_debug).
-
-
-
-
+-module(dtls).
diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl
new file mode 100644
index 0000000000..ac2ee0d09f
--- /dev/null
+++ b/lib/ssl/src/dtls_connection.erl
@@ -0,0 +1,19 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2013-2013. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(dtls_connection).
diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl
new file mode 100644
index 0000000000..b25daa59d9
--- /dev/null
+++ b/lib/ssl/src/dtls_handshake.erl
@@ -0,0 +1,18 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2013-2013. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+-module(dtls_handshake).
diff --git a/lib/ssl/src/dtls_handshake.hrl b/lib/ssl/src/dtls_handshake.hrl
new file mode 100644
index 0000000000..db7b8596ae
--- /dev/null
+++ b/lib/ssl/src/dtls_handshake.hrl
@@ -0,0 +1,50 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2013-2013. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%%----------------------------------------------------------------------
+%% Purpose: Record and constant defenitions for the DTLS-handshake protocol
+%% that differs from TLS see RFC 6347
+%%----------------------------------------------------------------------
+-ifndef(dtls_handshake).
+-define(dtls_handshake, true).
+
+-include("ssl_handshake.hrl"). %% Common TLS and DTLS records and Constantes
+
+-record(client_hello, {
+ client_version,
+ random,
+ session_id, % opaque SessionID<0..32>
+ cookie, % opaque<2..2^16-1>
+ cipher_suites, % cipher_suites<2..2^16-1>
+ compression_methods, % compression_methods<1..2^8-1>,
+ %% Extensions
+ renegotiation_info,
+ hash_signs, % supported combinations of hashes/signature algos
+ next_protocol_negotiation = undefined % [binary()]
+ }).
+
+-record(hello_verify_request {
+ protocol_version,
+ cookie
+ }).
+
+-define(HELLO_VERIFY_REQUEST, 3).
+
+-endif. % -ifdef(dtls_handshake).
diff --git a/lib/ssl/src/dtls_record.erl b/lib/ssl/src/dtls_record.erl
new file mode 100644
index 0000000000..2469a7d26c
--- /dev/null
+++ b/lib/ssl/src/dtls_record.erl
@@ -0,0 +1,18 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2013-2013. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+-module(dtls_record).
diff --git a/lib/ssl/src/dtls_record.hrl b/lib/ssl/src/dtls_record.hrl
new file mode 100644
index 0000000000..e935d84bdf
--- /dev/null
+++ b/lib/ssl/src/dtls_record.hrl
@@ -0,0 +1,44 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2013-2013. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%%----------------------------------------------------------------------
+%% Purpose: Record and constant defenitions for the DTLS-record protocol
+%% see RFC 6347
+%%----------------------------------------------------------------------
+
+-ifndef(dtls_record).
+-define(dtls_record, true).
+
+-include("ssl_record.hrl"). %% Common TLS and DTLS records and Constantes
+
+%% Used to handle tls_plain_text, tls_compressed and tls_cipher_text
+
+-record(ssl_tls, {
+ type,
+ version,
+ record_seq, % used in plain_text
+ epoch, % used in plain_text
+ message_seq,
+ fragment_offset,
+ fragment_length,
+ fragment
+ }).
+
+-endif. % -ifdef(dtls_record).
diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src
index 5c34de905e..582a60635f 100644
--- a/lib/ssl/src/ssl.app.src
+++ b/lib/ssl/src/ssl.app.src
@@ -1,7 +1,20 @@
{application, ssl,
[{description, "Erlang/OTP SSL application"},
{vsn, "%VSN%"},
- {modules, [ssl,
+ {modules, [
+ %% TLS/SSL
+ tls,
+ tls_connection,
+ tls_handshake,
+ tls_record,
+ %% DTLS
+ dtls_record,
+ dtls_handshake,
+ dtls_connection,
+ dtls,
+ %% Backwards compatibility
+ ssl,
+ %% Both TLS/SSL and DTLS
ssl_app,
ssl_sup,
inet_tls_dist,
@@ -14,14 +27,14 @@
ssl_session_cache_api,
ssl_session_cache,
ssl_socket,
- ssl_record,
+ %%ssl_record,
ssl_manager,
- ssl_handshake,
+ %%ssl_handshake,
ssl_connection_sup,
- ssl_connection,
+ %%ssl_connection,
ssl_cipher,
ssl_srp_primes,
- ssl_certificate_db,
+ ssl_pkix_db,
ssl_certificate,
ssl_alert
]},
@@ -31,5 +44,3 @@
{mod, {ssl_app, []}}]}.
-
-
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index fb64a6652f..75c17b14db 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -19,7 +19,7 @@
%%
-%%% Purpose : Main API module for SSL.
+%%% Purpose : Backwards compatibility
-module(ssl).
@@ -46,13 +46,6 @@
tls_atom_version/0, %% From ssl_internal.hrl
prf_random/0, sslsocket/0]).
--record(config, {ssl, %% SSL parameters
- inet_user, %% User set inet options
- emulated, %% #socket_option{} emulated
- inet_ssl, %% inet options for internal ssl socket
- cb %% Callback info
- }).
-
-type sslsocket() :: #sslsocket{}.
-type connect_option() :: socket_connect_option() | ssl_option() | transport_option().
-type socket_connect_option() :: gen_tcp:connect_option().
@@ -92,241 +85,65 @@
%% is temporary. see application(3)
%%--------------------------------------------------------------------
start() ->
- application:start(crypto),
- application:start(public_key),
- application:start(ssl).
-
+ tls:start().
start(Type) ->
- application:start(crypto, Type),
- application:start(public_key, Type),
- application:start(ssl, Type).
+ tls:start(Type).
-%%--------------------------------------------------------------------
--spec stop() -> ok.
-%%
-%% Description: Stops the ssl application.
-%%--------------------------------------------------------------------
stop() ->
- application:stop(ssl).
+ tls:stop().
-%%--------------------------------------------------------------------
--spec connect(host() | port(), [connect_option()]) -> {ok, #sslsocket{}} |
- {error, reason()}.
--spec connect(host() | port(), [connect_option()] | inet:port_number(),
- timeout() | list()) ->
- {ok, #sslsocket{}} | {error, reason()}.
--spec connect(host() | port(), inet:port_number(), list(), timeout()) ->
- {ok, #sslsocket{}} | {error, reason()}.
+connect(Socket, SslOptions) ->
+ tls:connect(Socket, SslOptions).
-%%
-%% Description: Connect to an ssl server.
-%%--------------------------------------------------------------------
-connect(Socket, SslOptions) when is_port(Socket) ->
- connect(Socket, SslOptions, infinity).
-
-connect(Socket, SslOptions0, Timeout) when is_port(Socket) ->
- {Transport,_,_,_} = proplists:get_value(cb_info, SslOptions0,
- {gen_tcp, tcp, tcp_closed, tcp_error}),
- EmulatedOptions = emulated_options(),
- {ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions),
- try handle_options(SslOptions0 ++ SocketValues, client) of
- {ok, #config{cb = CbInfo, ssl = SslOptions, emulated = EmOpts}} ->
-
- ok = ssl_socket:setopts(Transport, Socket, internal_inet_values()),
- case ssl_socket:peername(Transport, Socket) of
- {ok, {Address, Port}} ->
- ssl_connection:connect(Address, Port, Socket,
- {SslOptions, EmOpts},
- self(), CbInfo, Timeout);
- {error, Error} ->
- {error, Error}
- end
- catch
- _:{error, Reason} ->
- {error, Reason}
- end;
-
-connect(Host, Port, Options) ->
- connect(Host, Port, Options, infinity).
+connect(Socket, SslOptions0, TimeoutOrOpts) ->
+ tls:connect(Socket, SslOptions0, TimeoutOrOpts).
connect(Host, Port, Options, Timeout) ->
- try handle_options(Options, client) of
- {ok, Config} ->
- do_connect(Host,Port,Config,Timeout)
- catch
- throw:Error ->
- Error
- end.
+ tls:connect(Host, Port, Options, Timeout).
-%%--------------------------------------------------------------------
--spec listen(inet:port_number(), [listen_option()]) ->{ok, #sslsocket{}} | {error, reason()}.
-
-%%
-%% Description: Creates an ssl listen socket.
-%%--------------------------------------------------------------------
-listen(_Port, []) ->
- {error, nooptions};
-listen(Port, Options0) ->
- try
- {ok, Config} = handle_options(Options0, server),
- #config{cb = {Transport, _, _, _}, inet_user = Options} = Config,
- case Transport:listen(Port, Options) of
- {ok, ListenSocket} ->
- {ok, #sslsocket{pid = {ListenSocket, Config}}};
- Err = {error, _} ->
- Err
- end
- catch
- Error = {error, _} ->
- Error
- end.
-%%--------------------------------------------------------------------
--spec transport_accept(#sslsocket{}) -> {ok, #sslsocket{}} |
- {error, reason()}.
--spec transport_accept(#sslsocket{}, timeout()) -> {ok, #sslsocket{}} |
- {error, reason()}.
-%%
-%% Description: Performs transport accept on an ssl listen socket
-%%--------------------------------------------------------------------
-transport_accept(ListenSocket) ->
- transport_accept(ListenSocket, infinity).
+listen(Port, Options) ->
+ tls:listen(Port, Options).
-transport_accept(#sslsocket{pid = {ListenSocket, #config{cb = CbInfo, ssl = SslOpts}}}, Timeout) ->
-
- %% The setopt could have been invoked on the listen socket
- %% and options should be inherited.
- EmOptions = emulated_options(),
- {Transport,_,_, _} = CbInfo,
- {ok, SocketValues} = ssl_socket:getopts(Transport, ListenSocket, EmOptions),
- ok = ssl_socket:setopts(Transport, ListenSocket, internal_inet_values()),
- case Transport:accept(ListenSocket, Timeout) of
- {ok, Socket} ->
- ok = ssl_socket:setopts(Transport, ListenSocket, SocketValues),
- {ok, Port} = ssl_socket:port(Transport, Socket),
- ConnArgs = [server, "localhost", Port, Socket,
- {SslOpts, socket_options(SocketValues)}, self(), CbInfo],
- case ssl_connection_sup:start_child(ConnArgs) of
- {ok, Pid} ->
- ssl_connection:socket_control(Socket, Pid, Transport);
- {error, Reason} ->
- {error, Reason}
- end;
- {error, Reason} ->
- {error, Reason}
- end.
+transport_accept(ListenSocket) ->
+ tls:transport_accept(ListenSocket).
-%%--------------------------------------------------------------------
--spec ssl_accept(#sslsocket{}) -> ok | {error, reason()}.
--spec ssl_accept(#sslsocket{} | port(), timeout()| [ssl_option()
- | transport_option()]) ->
- ok | {ok, #sslsocket{}} | {error, reason()}.
--spec ssl_accept(port(), [ssl_option()| transport_option()], timeout()) ->
- {ok, #sslsocket{}} | {error, reason()}.
-%%
-%% Description: Performs accept on an ssl listen socket. e.i. performs
-%% ssl handshake.
-%%--------------------------------------------------------------------
+transport_accept(ListenSocket, Timeout) ->
+ tls:transport_accept(ListenSocket, Timeout).
+
ssl_accept(ListenSocket) ->
- ssl_accept(ListenSocket, infinity).
+ tls:ssl_accept(ListenSocket, infinity).
ssl_accept(#sslsocket{} = Socket, Timeout) ->
- ssl_connection:handshake(Socket, Timeout);
+ tls:ssl_accept(Socket, Timeout);
ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) ->
- ssl_accept(ListenSocket, SslOptions, infinity).
+ tls:ssl_accept(ListenSocket, SslOptions, infinity).
ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) ->
- {Transport,_,_,_} =
- proplists:get_value(cb_info, SslOptions, {gen_tcp, tcp, tcp_closed, tcp_error}),
- EmulatedOptions = emulated_options(),
- {ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions),
- try handle_options(SslOptions ++ SocketValues, server) of
- {ok, #config{cb = CbInfo, ssl = SslOpts, emulated = EmOpts}} ->
- ok = ssl_socket:setopts(Transport, Socket, internal_inet_values()),
- {ok, Port} = ssl_socket:port(Transport, Socket),
- ssl_connection:ssl_accept(Port, Socket,
- {SslOpts, EmOpts},
- self(), CbInfo, Timeout)
- catch
- Error = {error, _Reason} -> Error
- end.
+ tls:ssl_accept(Socket, SslOptions, Timeout).
-%%--------------------------------------------------------------------
--spec close(#sslsocket{}) -> term().
-%%
-%% Description: Close an ssl connection
-%%--------------------------------------------------------------------
-close(#sslsocket{pid = Pid}) when is_pid(Pid) ->
- ssl_connection:close(Pid);
-close(#sslsocket{pid = {ListenSocket, #config{cb={Transport,_, _, _}}}}) ->
- Transport:close(ListenSocket).
+close(Socket) ->
+ tls:close(Socket).
-%%--------------------------------------------------------------------
--spec send(#sslsocket{}, iodata()) -> ok | {error, reason()}.
-%%
-%% Description: Sends data over the ssl connection
-%%--------------------------------------------------------------------
-send(#sslsocket{pid = Pid}, Data) when is_pid(Pid) ->
- ssl_connection:send(Pid, Data);
-send(#sslsocket{pid = {ListenSocket, #config{cb={Transport, _, _, _}}}}, Data) ->
- Transport:send(ListenSocket, Data). %% {error,enotconn}
+send(Socket, Data) ->
+ tls:send(Socket, Data).
-%%--------------------------------------------------------------------
--spec recv(#sslsocket{}, integer()) -> {ok, binary()| list()} | {error, reason()}.
--spec recv(#sslsocket{}, integer(), timeout()) -> {ok, binary()| list()} | {error, reason()}.
-%%
-%% Description: Receives data when active = false
-%%--------------------------------------------------------------------
recv(Socket, Length) ->
- recv(Socket, Length, infinity).
-recv(#sslsocket{pid = Pid}, Length, Timeout) when is_pid(Pid) ->
- ssl_connection:recv(Pid, Length, Timeout);
-recv(#sslsocket{pid = {Listen,
- #config{cb={Transport, _, _, _}}}}, _,_) when is_port(Listen)->
- Transport:recv(Listen, 0). %% {error,enotconn}
-
-%%--------------------------------------------------------------------
--spec controlling_process(#sslsocket{}, pid()) -> ok | {error, reason()}.
-%%
-%% Description: Changes process that receives the messages when active = true
-%% or once.
-%%--------------------------------------------------------------------
-controlling_process(#sslsocket{pid = Pid}, NewOwner) when is_pid(Pid), is_pid(NewOwner) ->
- ssl_connection:new_user(Pid, NewOwner);
-controlling_process(#sslsocket{pid = {Listen,
- #config{cb={Transport, _, _, _}}}},
- NewOwner) when is_port(Listen),
- is_pid(NewOwner) ->
- Transport:controlling_process(Listen, NewOwner).
+ tls:recv(Socket, Length, infinity).
+recv(Socket, Length, Timeout) ->
+ tls:recv(Socket, Length, Timeout).
-%%--------------------------------------------------------------------
--spec connection_info(#sslsocket{}) -> {ok, {tls_atom_version(), erl_cipher_suite()}} |
- {error, reason()}.
-%%
-%% Description: Returns ssl protocol and cipher used for the connection
-%%--------------------------------------------------------------------
-connection_info(#sslsocket{pid = Pid}) when is_pid(Pid) ->
- ssl_connection:info(Pid);
-connection_info(#sslsocket{pid = {Listen, _}}) when is_port(Listen) ->
- {error, enotconn}.
+controlling_process(Socket, NewOwner) ->
+ tls:controlling_process(Socket, NewOwner).
+
+connection_info(Socket) ->
+ tls:connection_info(Socket).
-%%--------------------------------------------------------------------
--spec peername(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}.
-%%
-%% Description: same as inet:peername/1.
-%%--------------------------------------------------------------------
-peername(#sslsocket{pid = Pid, fd = {Transport, Socket}}) when is_pid(Pid)->
- ssl_socket:peername(Transport, Socket);
-peername(#sslsocket{pid = {ListenSocket, #config{cb = {Transport,_,_,_}}}}) ->
- ssl_socket:peername(Transport, ListenSocket). %% Will return {error, enotconn}
+peername(Socket) ->
+ tls:peername(Socket).
-%%--------------------------------------------------------------------
--spec peercert(#sslsocket{}) ->{ok, DerCert::binary()} | {error, reason()}.
-%%
-%% Description: Returns the peercert.
-%%--------------------------------------------------------------------
peercert(#sslsocket{pid = Pid}) when is_pid(Pid) ->
- case ssl_connection:peer_certificate(Pid) of
+ case tls_connection:peer_certificate(Pid) of
{ok, undefined} ->
{error, no_peercert};
Result ->
@@ -335,701 +152,71 @@ peercert(#sslsocket{pid = Pid}) when is_pid(Pid) ->
peercert(#sslsocket{pid = {Listen, _}}) when is_port(Listen) ->
{error, enotconn}.
-%%--------------------------------------------------------------------
--spec suite_definition(cipher_suite()) -> erl_cipher_suite().
-%%
-%% Description: Return erlang cipher suite definition.
-%%--------------------------------------------------------------------
suite_definition(S) ->
{KeyExchange, Cipher, Hash, _} = ssl_cipher:suite_definition(S),
{KeyExchange, Cipher, Hash}.
-%%--------------------------------------------------------------------
--spec negotiated_next_protocol(#sslsocket{}) -> {ok, binary()} | {error, reason()}.
-%%
-%% Description: Returns the next protocol that has been negotiated. If no
-%% protocol has been negotiated will return {error, next_protocol_not_negotiated}
-%%--------------------------------------------------------------------
negotiated_next_protocol(#sslsocket{pid = Pid}) ->
- ssl_connection:negotiated_next_protocol(Pid).
+ tls_connection:negotiated_next_protocol(Pid).
+%%%--------------------------------------------------------------------
-spec cipher_suites() -> [erl_cipher_suite()].
-spec cipher_suites(erlang | openssl | all ) -> [erl_cipher_suite()] | [string()].
%% Description: Returns all supported cipher suites.
%%--------------------------------------------------------------------
+
cipher_suites() ->
cipher_suites(erlang).
cipher_suites(erlang) ->
- Version = ssl_record:highest_protocol_version([]),
- [suite_definition(S) || S <- cipher_suites(Version, [])];
+ Version = tls_record:highest_protocol_version([]),
+ [suite_definition(S) || S <- ssl_cipher:suites(Version)];
cipher_suites(openssl) ->
- Version = ssl_record:highest_protocol_version([]),
- [ssl_cipher:openssl_suite_name(S) || S <- cipher_suites(Version, [])];
+ Version = tls_record:highest_protocol_version([]),
+ [ssl_cipher:openssl_suite_name(S) || S <- ssl_cipher:suites(Version)];
cipher_suites(all) ->
- Version = ssl_record:highest_protocol_version([]),
+ Version = tls_record:highest_protocol_version([]),
Supported = ssl_cipher:suites(Version)
++ ssl_cipher:anonymous_suites()
++ ssl_cipher:psk_suites(Version)
++ ssl_cipher:srp_suites(),
[suite_definition(S) || S <- Supported].
-%%--------------------------------------------------------------------
--spec getopts(#sslsocket{}, [gen_tcp:option_name()]) ->
- {ok, [gen_tcp:option()]} | {error, reason()}.
-%%
-%% Description: Gets options
-%%--------------------------------------------------------------------
-getopts(#sslsocket{pid = Pid}, OptionTags) when is_pid(Pid), is_list(OptionTags) ->
- ssl_connection:get_opts(Pid, OptionTags);
-getopts(#sslsocket{pid = {ListenSocket, #config{cb = {Transport,_,_,_}}}},
- OptionTags) when is_list(OptionTags) ->
- try ssl_socket:getopts(Transport, ListenSocket, OptionTags) of
- {ok, _} = Result ->
- Result;
- {error, InetError} ->
- {error, {options, {socket_options, OptionTags, InetError}}}
- catch
- _:_ ->
- {error, {options, {socket_options, OptionTags}}}
- end;
-getopts(#sslsocket{}, OptionTags) ->
- {error, {options, {socket_options, OptionTags}}}.
-
-%%--------------------------------------------------------------------
--spec setopts(#sslsocket{}, [gen_tcp:option()]) -> ok | {error, reason()}.
-%%
-%% Description: Sets options
-%%--------------------------------------------------------------------
-setopts(#sslsocket{pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) ->
- try proplists:expand([{binary, [{mode, binary}]},
- {list, [{mode, list}]}], Options0) of
- Options ->
- ssl_connection:set_opts(Pid, Options)
- catch
- _:_ ->
- {error, {options, {not_a_proplist, Options0}}}
- end;
-setopts(#sslsocket{pid = {ListenSocket, #config{cb = {Transport,_,_,_}}}}, Options) when is_list(Options) ->
- try ssl_socket:setopts(Transport, ListenSocket, Options) of
- ok ->
- ok;
- {error, InetError} ->
- {error, {options, {socket_options, Options, InetError}}}
- catch
- _:Error ->
- {error, {options, {socket_options, Options, Error}}}
- end;
-setopts(#sslsocket{}, Options) ->
- {error, {options,{not_a_proplist, Options}}}.
+getopts(Socket, OptionTags) ->
+ tls:getopts(Socket, OptionTags).
-%%---------------------------------------------------------------
--spec shutdown(#sslsocket{}, read | write | read_write) -> ok | {error, reason()}.
-%%
-%% Description: Same as gen_tcp:shutdown/2
-%%--------------------------------------------------------------------
-shutdown(#sslsocket{pid = {Listen, #config{cb={Transport,_, _, _}}}},
- How) when is_port(Listen) ->
- Transport:shutdown(Listen, How);
-shutdown(#sslsocket{pid = Pid}, How) ->
- ssl_connection:shutdown(Pid, How).
+setopts(Socket, Options) ->
+ tls:setopts(Socket, Options).
-%%--------------------------------------------------------------------
--spec sockname(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}.
-%%
-%% Description: Same as inet:sockname/1
-%%--------------------------------------------------------------------
-sockname(#sslsocket{pid = {Listen, #config{cb={Transport,_, _, _}}}}) when is_port(Listen) ->
- ssl_socket:sockname(Transport, Listen);
+shutdown(Socket, How) ->
+ tls:shutdown(Socket, How).
-sockname(#sslsocket{pid = Pid, fd = {Transport, Socket}}) when is_pid(Pid) ->
- ssl_socket:sockname(Transport, Socket).
+sockname(Socket) ->
+ tls:sockname(Socket).
-%%---------------------------------------------------------------
--spec session_info(#sslsocket{}) -> {ok, list()} | {error, reason()}.
-%%
-%% Description: Returns list of session info currently [{session_id, session_id(),
-%% {cipher_suite, cipher_suite()}]
-%%--------------------------------------------------------------------
session_info(#sslsocket{pid = Pid}) when is_pid(Pid) ->
- ssl_connection:session_info(Pid);
+ tls_connection:session_info(Pid);
session_info(#sslsocket{pid = {Listen,_}}) when is_port(Listen) ->
{error, enotconn}.
-%%---------------------------------------------------------------
--spec versions() -> [{ssl_app, string()} | {supported, [tls_atom_version()]} |
- {available, [tls_atom_version()]}].
-%%
-%% Description: Returns a list of relevant versions.
-%%--------------------------------------------------------------------
versions() ->
- Vsns = ssl_record:supported_protocol_versions(),
- SupportedVsns = [ssl_record:protocol_version(Vsn) || Vsn <- Vsns],
- AvailableVsns = ?ALL_SUPPORTED_VERSIONS,
- [{ssl_app, ?VSN}, {supported, SupportedVsns}, {available, AvailableVsns}].
+ tls:versions().
+renegotiate(Socket) ->
+ tls:renegotiate(Socket).
-%%---------------------------------------------------------------
--spec renegotiate(#sslsocket{}) -> ok | {error, reason()}.
-%%
-%% Description: Initiates a renegotiation.
-%%--------------------------------------------------------------------
-renegotiate(#sslsocket{pid = Pid}) when is_pid(Pid) ->
- ssl_connection:renegotiation(Pid);
-renegotiate(#sslsocket{pid = {Listen,_}}) when is_port(Listen) ->
- {error, enotconn}.
+prf(Socket, Secret, Label, Seed, WantedLength) ->
+ tls:prf(Socket, Secret, Label, Seed, WantedLength).
-%%--------------------------------------------------------------------
--spec prf(#sslsocket{}, binary() | 'master_secret', binary(),
- binary() | prf_random(), non_neg_integer()) ->
- {ok, binary()} | {error, reason()}.
-%%
-%% Description: use a ssl sessions TLS PRF to generate key material
-%%--------------------------------------------------------------------
-prf(#sslsocket{pid = Pid},
- Secret, Label, Seed, WantedLength) when is_pid(Pid) ->
- ssl_connection:prf(Pid, Secret, Label, Seed, WantedLength);
-prf(#sslsocket{pid = {Listen,_}}, _,_,_,_) when is_port(Listen) ->
- {error, enotconn}.
-
-%%--------------------------------------------------------------------
--spec clear_pem_cache() -> ok.
-%%
-%% Description: Clear the PEM cache
-%%--------------------------------------------------------------------
clear_pem_cache() ->
- ssl_manager:clear_pem_cache().
+ tls:clear_pem_cache().
-%%---------------------------------------------------------------
--spec format_error({error, term()}) -> list().
-%%
-%% Description: Creates error string.
-%%--------------------------------------------------------------------
-format_error({error, Reason}) ->
- format_error(Reason);
format_error(Reason) when is_list(Reason) ->
- Reason;
-format_error(closed) ->
- "TLS connection is closed";
-format_error({tls_alert, Description}) ->
- "TLS Alert: " ++ Description;
-format_error({options,{FileType, File, Reason}}) when FileType == cacertfile;
- FileType == certfile;
- FileType == keyfile;
- FileType == dhfile ->
- Error = file_error_format(Reason),
- file_desc(FileType) ++ File ++ ": " ++ Error;
-format_error({options, {socket_options, Option, Error}}) ->
- lists:flatten(io_lib:format("Invalid transport socket option ~p: ~s", [Option, format_error(Error)]));
-format_error({options, {socket_options, Option}}) ->
- lists:flatten(io_lib:format("Invalid socket option: ~p", [Option]));
-format_error({options, Options}) ->
- lists:flatten(io_lib:format("Invalid TLS option: ~p", [Options]));
-
-format_error(Error) ->
- case inet:format_error(Error) of
- "unknown POSIX" ++ _ ->
- unexpected_format(Error);
- Other ->
- Other
- end.
+ tls:format_error(Reason).
-%%--------------------------------------------------------------------
--spec random_bytes(integer()) -> binary().
-
-%%
-%% Description: Generates cryptographically secure random sequence if possible
-%% fallbacks on pseudo random function
-%%--------------------------------------------------------------------
random_bytes(N) ->
- try crypto:strong_rand_bytes(N) of
- RandBytes ->
- RandBytes
- catch
- error:low_entropy ->
- crypto:rand_bytes(N)
- end.
-
-%%%--------------------------------------------------------------
-%%% Internal functions
-%%%--------------------------------------------------------------------
-do_connect(Address, Port,
- #config{cb=CbInfo, inet_user=UserOpts, ssl=SslOpts,
- emulated=EmOpts,inet_ssl=SocketOpts},
- Timeout) ->
- {Transport, _, _, _} = CbInfo,
- try Transport:connect(Address, Port, SocketOpts, Timeout) of
- {ok, Socket} ->
- ssl_connection:connect(Address, Port, Socket, {SslOpts,EmOpts},
- self(), CbInfo, Timeout);
- {error, Reason} ->
- {error, Reason}
- catch
- exit:{function_clause, _} ->
- {error, {options, {cb_info, CbInfo}}};
- exit:badarg ->
- {error, {options, {socket_options, UserOpts}}};
- exit:{badarg, _} ->
- {error, {options, {socket_options, UserOpts}}}
- end.
-
-handle_options(Opts0, _Role) ->
- Opts = proplists:expand([{binary, [{mode, binary}]},
- {list, [{mode, list}]}], Opts0),
- ReuseSessionFun = fun(_, _, _, _) -> true end,
-
- DefaultVerifyNoneFun =
- {fun(_,{bad_cert, _}, UserState) ->
- {valid, UserState};
- (_,{extension, _}, UserState) ->
- {unknown, UserState};
- (_, valid, UserState) ->
- {valid, UserState};
- (_, valid_peer, UserState) ->
- {valid, UserState}
- end, []},
-
- VerifyNoneFun = handle_option(verify_fun, Opts, DefaultVerifyNoneFun),
-
- UserFailIfNoPeerCert = handle_option(fail_if_no_peer_cert, Opts, false),
- UserVerifyFun = handle_option(verify_fun, Opts, undefined),
- CaCerts = handle_option(cacerts, Opts, undefined),
-
- {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun} =
- %% Handle 0, 1, 2 for backwards compatibility
- case proplists:get_value(verify, Opts, verify_none) of
- 0 ->
- {verify_none, false,
- ca_cert_default(verify_none, VerifyNoneFun, CaCerts), VerifyNoneFun};
- 1 ->
- {verify_peer, false,
- ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun};
- 2 ->
- {verify_peer, true,
- ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun};
- verify_none ->
- {verify_none, false,
- ca_cert_default(verify_none, VerifyNoneFun, CaCerts), VerifyNoneFun};
- verify_peer ->
- {verify_peer, UserFailIfNoPeerCert,
- ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun};
- Value ->
- throw({error, {options, {verify, Value}}})
- end,
-
- CertFile = handle_option(certfile, Opts, <<>>),
-
- Versions = case handle_option(versions, Opts, []) of
- [] ->
- ssl_record:supported_protocol_versions();
- Vsns ->
- [ssl_record:protocol_version(Vsn) || Vsn <- Vsns]
- end,
-
- SSLOptions = #ssl_options{
- versions = Versions,
- verify = validate_option(verify, Verify),
- verify_fun = VerifyFun,
- fail_if_no_peer_cert = FailIfNoPeerCert,
- verify_client_once = handle_option(verify_client_once, Opts, false),
- depth = handle_option(depth, Opts, 1),
- cert = handle_option(cert, Opts, undefined),
- certfile = CertFile,
- key = handle_option(key, Opts, undefined),
- keyfile = handle_option(keyfile, Opts, CertFile),
- password = handle_option(password, Opts, ""),
- cacerts = CaCerts,
- cacertfile = handle_option(cacertfile, Opts, CaCertDefault),
- dh = handle_option(dh, Opts, undefined),
- dhfile = handle_option(dhfile, Opts, undefined),
- user_lookup_fun = handle_option(user_lookup_fun, Opts, undefined),
- psk_identity = handle_option(psk_identity, Opts, undefined),
- srp_identity = handle_option(srp_identity, Opts, undefined),
- ciphers = handle_option(ciphers, Opts, []),
- %% Server side option
- reuse_session = handle_option(reuse_session, Opts, ReuseSessionFun),
- reuse_sessions = handle_option(reuse_sessions, Opts, true),
- secure_renegotiate = handle_option(secure_renegotiate, Opts, false),
- renegotiate_at = handle_option(renegotiate_at, Opts, ?DEFAULT_RENEGOTIATE_AT),
- hibernate_after = handle_option(hibernate_after, Opts, undefined),
- erl_dist = handle_option(erl_dist, Opts, false),
- next_protocols_advertised =
- handle_option(next_protocols_advertised, Opts, undefined),
- next_protocol_selector =
- make_next_protocol_selector(
- handle_option(client_preferred_next_protocols, Opts, undefined))
- },
-
- CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}),
- SslOptions = [versions, verify, verify_fun,
- fail_if_no_peer_cert, verify_client_once,
- depth, cert, certfile, key, keyfile,
- password, cacerts, cacertfile, dh, dhfile,
- user_lookup_fun, psk_identity, srp_identity, ciphers,
- reuse_session, reuse_sessions, ssl_imp,
- cb_info, renegotiate_at, secure_renegotiate, hibernate_after,
- erl_dist, next_protocols_advertised,
- client_preferred_next_protocols],
-
- SockOpts = lists:foldl(fun(Key, PropList) ->
- proplists:delete(Key, PropList)
- end, Opts, SslOptions),
-
- {SSLsock, Emulated} = emulated_options(SockOpts),
- {ok, #config{ssl=SSLOptions, emulated=Emulated, inet_ssl=SSLsock,
- inet_user=SockOpts, cb=CbInfo}}.
-
-handle_option(OptionName, Opts, Default) ->
- validate_option(OptionName,
- proplists:get_value(OptionName, Opts, Default)).
-
-
-validate_option(versions, Versions) ->
- validate_versions(Versions, Versions);
-validate_option(verify, Value)
- when Value == verify_none; Value == verify_peer ->
- Value;
-validate_option(verify_fun, undefined) ->
- undefined;
-%% Backwards compatibility
-validate_option(verify_fun, Fun) when is_function(Fun) ->
- {fun(_,{bad_cert, _} = Reason, OldFun) ->
- case OldFun([Reason]) of
- true ->
- {valid, OldFun};
- false ->
- {fail, Reason}
- end;
- (_,{extension, _}, UserState) ->
- {unknown, UserState};
- (_, valid, UserState) ->
- {valid, UserState};
- (_, valid_peer, UserState) ->
- {valid, UserState}
- end, Fun};
-validate_option(verify_fun, {Fun, _} = Value) when is_function(Fun) ->
- Value;
-validate_option(fail_if_no_peer_cert, Value)
- when Value == true; Value == false ->
- Value;
-validate_option(verify_client_once, Value)
- when Value == true; Value == false ->
- Value;
-validate_option(depth, Value) when is_integer(Value),
- Value >= 0, Value =< 255->
- Value;
-validate_option(cert, Value) when Value == undefined;
- is_binary(Value) ->
- Value;
-validate_option(certfile, undefined = Value) ->
- Value;
-validate_option(certfile, Value) when is_binary(Value) ->
- Value;
-validate_option(certfile, Value) when is_list(Value) ->
- list_to_binary(Value);
-
-validate_option(key, undefined) ->
- undefined;
-validate_option(key, {KeyType, Value}) when is_binary(Value),
- KeyType == rsa; %% Backwards compatibility
- KeyType == dsa; %% Backwards compatibility
- KeyType == 'RSAPrivateKey';
- KeyType == 'DSAPrivateKey';
- KeyType == 'ECPrivateKey';
- KeyType == 'PrivateKeyInfo' ->
- {KeyType, Value};
-
-validate_option(keyfile, undefined) ->
- <<>>;
-validate_option(keyfile, Value) when is_binary(Value) ->
- Value;
-validate_option(keyfile, Value) when is_list(Value), Value =/= "" ->
- list_to_binary(Value);
-validate_option(password, Value) when is_list(Value) ->
- Value;
-
-validate_option(cacerts, Value) when Value == undefined;
- is_list(Value) ->
- Value;
-%% certfile must be present in some cases otherwhise it can be set
-%% to the empty string.
-validate_option(cacertfile, undefined) ->
- <<>>;
-validate_option(cacertfile, Value) when is_binary(Value) ->
- Value;
-validate_option(cacertfile, Value) when is_list(Value), Value =/= ""->
- list_to_binary(Value);
-validate_option(dh, Value) when Value == undefined;
- is_binary(Value) ->
- Value;
-validate_option(dhfile, undefined = Value) ->
- Value;
-validate_option(dhfile, Value) when is_binary(Value) ->
- Value;
-validate_option(dhfile, Value) when is_list(Value), Value =/= "" ->
- list_to_binary(Value);
-validate_option(psk_identity, undefined) ->
- undefined;
-validate_option(psk_identity, Identity)
- when is_list(Identity), Identity =/= "", length(Identity) =< 65535 ->
- list_to_binary(Identity);
-validate_option(user_lookup_fun, undefined) ->
- undefined;
-validate_option(user_lookup_fun, {Fun, _} = Value) when is_function(Fun, 3) ->
- Value;
-validate_option(srp_identity, undefined) ->
- undefined;
-validate_option(srp_identity, {Username, Password})
- when is_list(Username), is_list(Password), Username =/= "", length(Username) =< 255 ->
- {list_to_binary(Username), list_to_binary(Password)};
-validate_option(ciphers, Value) when is_list(Value) ->
- Version = ssl_record:highest_protocol_version([]),
- try cipher_suites(Version, Value)
- catch
- exit:_ ->
- throw({error, {options, {ciphers, Value}}});
- error:_->
- throw({error, {options, {ciphers, Value}}})
- end;
-validate_option(reuse_session, Value) when is_function(Value) ->
- Value;
-validate_option(reuse_sessions, Value) when Value == true;
- Value == false ->
- Value;
-
-validate_option(secure_renegotiate, Value) when Value == true;
- Value == false ->
- Value;
-validate_option(renegotiate_at, Value) when is_integer(Value) ->
- erlang:min(Value, ?DEFAULT_RENEGOTIATE_AT);
-
-validate_option(hibernate_after, undefined) ->
- undefined;
-validate_option(hibernate_after, Value) when is_integer(Value), Value >= 0 ->
- Value;
-validate_option(erl_dist,Value) when Value == true;
- Value == false ->
- Value;
-validate_option(client_preferred_next_protocols = Opt, {Precedence, PreferredProtocols} = Value)
- when is_list(PreferredProtocols) ->
- case ssl_record:highest_protocol_version([]) of
- {3,0} ->
- throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}});
- _ ->
- validate_binary_list(client_preferred_next_protocols, PreferredProtocols),
- validate_npn_ordering(Precedence),
- {Precedence, PreferredProtocols, ?NO_PROTOCOL}
- end;
-validate_option(client_preferred_next_protocols = Opt, {Precedence, PreferredProtocols, Default} = Value)
- when is_list(PreferredProtocols), is_binary(Default),
- byte_size(Default) > 0, byte_size(Default) < 256 ->
- case ssl_record:highest_protocol_version([]) of
- {3,0} ->
- throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}});
- _ ->
- validate_binary_list(client_preferred_next_protocols, PreferredProtocols),
- validate_npn_ordering(Precedence),
- Value
- end;
-
-validate_option(client_preferred_next_protocols, undefined) ->
- undefined;
-validate_option(next_protocols_advertised = Opt, Value) when is_list(Value) ->
- case ssl_record:highest_protocol_version([]) of
- {3,0} ->
- throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}});
- _ ->
- validate_binary_list(next_protocols_advertised, Value),
- Value
- end;
-
-validate_option(next_protocols_advertised, undefined) ->
- undefined;
-validate_option(Opt, Value) ->
- throw({error, {options, {Opt, Value}}}).
-
-validate_npn_ordering(client) ->
- ok;
-validate_npn_ordering(server) ->
- ok;
-validate_npn_ordering(Value) ->
- throw({error, {options, {client_preferred_next_protocols, {invalid_precedence, Value}}}}).
-
-validate_binary_list(Opt, List) ->
- lists:foreach(
- fun(Bin) when is_binary(Bin),
- byte_size(Bin) > 0,
- byte_size(Bin) < 256 ->
- ok;
- (Bin) ->
- throw({error, {options, {Opt, {invalid_protocol, Bin}}}})
- end, List).
-
-validate_versions([], Versions) ->
- Versions;
-validate_versions([Version | Rest], Versions) when Version == 'tlsv1.2';
- Version == 'tlsv1.1';
- Version == tlsv1;
- Version == sslv3 ->
- validate_versions(Rest, Versions);
-validate_versions([Ver| _], Versions) ->
- throw({error, {options, {Ver, {versions, Versions}}}}).
-
-validate_inet_option(mode, Value)
- when Value =/= list, Value =/= binary ->
- throw({error, {options, {mode,Value}}});
-validate_inet_option(packet, Value)
- when not (is_atom(Value) orelse is_integer(Value)) ->
- throw({error, {options, {packet,Value}}});
-validate_inet_option(packet_size, Value)
- when not is_integer(Value) ->
- throw({error, {options, {packet_size,Value}}});
-validate_inet_option(header, Value)
- when not is_integer(Value) ->
- throw({error, {options, {header,Value}}});
-validate_inet_option(active, Value)
- when Value =/= true, Value =/= false, Value =/= once ->
- throw({error, {options, {active,Value}}});
-validate_inet_option(_, _) ->
- ok.
-
-%% The option cacerts overrides cacertsfile
-ca_cert_default(_,_, [_|_]) ->
- undefined;
-ca_cert_default(verify_none, _, _) ->
- undefined;
-ca_cert_default(verify_peer, {Fun,_}, _) when is_function(Fun) ->
- undefined;
-%% Server that wants to verify_peer and has no verify_fun must have
-%% some trusted certs.
-ca_cert_default(verify_peer, undefined, _) ->
- "".
-
-emulated_options() ->
- [mode, packet, active, header, packet_size].
-
-internal_inet_values() ->
- [{packet_size,0},{packet, 0},{header, 0},{active, false},{mode,binary}].
-
-socket_options(InetValues) ->
- #socket_options{
- mode = proplists:get_value(mode, InetValues, lists),
- header = proplists:get_value(header, InetValues, 0),
- active = proplists:get_value(active, InetValues, active),
- packet = proplists:get_value(packet, InetValues, 0),
- packet_size = proplists:get_value(packet_size, InetValues)
- }.
-
-emulated_options(Opts) ->
- emulated_options(Opts, internal_inet_values(), #socket_options{}).
-
-emulated_options([{mode,Opt}|Opts], Inet, Emulated) ->
- validate_inet_option(mode,Opt),
- emulated_options(Opts, Inet, Emulated#socket_options{mode=Opt});
-emulated_options([{header,Opt}|Opts], Inet, Emulated) ->
- validate_inet_option(header,Opt),
- emulated_options(Opts, Inet, Emulated#socket_options{header=Opt});
-emulated_options([{active,Opt}|Opts], Inet, Emulated) ->
- validate_inet_option(active,Opt),
- emulated_options(Opts, Inet, Emulated#socket_options{active=Opt});
-emulated_options([{packet,Opt}|Opts], Inet, Emulated) ->
- validate_inet_option(packet,Opt),
- emulated_options(Opts, Inet, Emulated#socket_options{packet=Opt});
-emulated_options([{packet_size,Opt}|Opts], Inet, Emulated) ->
- validate_inet_option(packet_size,Opt),
- emulated_options(Opts, Inet, Emulated#socket_options{packet_size=Opt});
-emulated_options([Opt|Opts], Inet, Emulated) ->
- emulated_options(Opts, [Opt|Inet], Emulated);
-emulated_options([], Inet,Emulated) ->
- {Inet, Emulated}.
-
-cipher_suites(Version, []) ->
- ssl_cipher:filter_suites(ssl_cipher:suites(Version));
-cipher_suites(Version, [{_,_,_,_}| _] = Ciphers0) -> %% Backwards compatibility
- Ciphers = [{KeyExchange, Cipher, Hash} || {KeyExchange, Cipher, Hash, _} <- Ciphers0],
- ssl_cipher:filter_suites(cipher_suites(Version, Ciphers));
-cipher_suites(Version, [{_,_,_}| _] = Ciphers0) ->
- Ciphers = [ssl_cipher:suite(C) || C <- Ciphers0],
- ssl_cipher:filter_suites(cipher_suites(Version, Ciphers));
-cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) ->
- Supported0 = ssl_cipher:suites(Version)
- ++ ssl_cipher:anonymous_suites()
- ++ ssl_cipher:psk_suites(Version)
- ++ ssl_cipher:srp_suites(),
- Supported1 = ssl_cipher:filter_suites(Supported0),
- case [Cipher || Cipher <- Ciphers0, lists:member(Cipher, Supported1)] of
- [] ->
- Supported1;
- Ciphers ->
- Ciphers
- end;
-cipher_suites(Version, [Head | _] = Ciphers0) when is_list(Head) ->
- %% Format: ["RC4-SHA","RC4-MD5"]
- Ciphers = [ssl_cipher:openssl_suite(C) || C <- Ciphers0],
- cipher_suites(Version, Ciphers);
-cipher_suites(Version, Ciphers0) ->
- %% Format: "RC4-SHA:RC4-MD5"
- Ciphers = [ssl_cipher:openssl_suite(C) || C <- string:tokens(Ciphers0, ":")],
- cipher_suites(Version, Ciphers).
-
-unexpected_format(Error) ->
- lists:flatten(io_lib:format("Unexpected error: ~p", [Error])).
-
-file_error_format({error, Error})->
- case file:format_error(Error) of
- "unknown POSIX error" ->
- "decoding error";
- Str ->
- Str
- end;
-file_error_format(_) ->
- "decoding error".
-
-file_desc(cacertfile) ->
- "Invalid CA certificate file ";
-file_desc(certfile) ->
- "Invalid certificate file ";
-file_desc(keyfile) ->
- "Invalid key file ";
-file_desc(dhfile) ->
- "Invalid DH params file ".
-
-detect(_Pred, []) ->
- undefined;
-detect(Pred, [H|T]) ->
- case Pred(H) of
- true ->
- H;
- _ ->
- detect(Pred, T)
- end.
-
-make_next_protocol_selector(undefined) ->
- undefined;
-make_next_protocol_selector({client, AllProtocols, DefaultProtocol}) ->
- fun(AdvertisedProtocols) ->
- case detect(fun(PreferredProtocol) ->
- lists:member(PreferredProtocol, AdvertisedProtocols)
- end, AllProtocols) of
- undefined ->
- DefaultProtocol;
- PreferredProtocol ->
- PreferredProtocol
- end
- end;
+ tls:random_bytes(N).
-make_next_protocol_selector({server, AllProtocols, DefaultProtocol}) ->
- fun(AdvertisedProtocols) ->
- case detect(fun(PreferredProtocol) ->
- lists:member(PreferredProtocol, AllProtocols)
- end,
- AdvertisedProtocols) of
- undefined ->
- DefaultProtocol;
- PreferredProtocol ->
- PreferredProtocol
- end
- end.
diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl
index 9e1c3a09bf..b186a1015a 100644
--- a/lib/ssl/src/ssl_certificate.erl
+++ b/lib/ssl/src/ssl_certificate.erl
@@ -240,7 +240,7 @@ find_issuer(OtpCert, CertDbHandle) ->
Acc
end,
- try ssl_certificate_db:foldl(IsIssuerFun, issuer_not_found, CertDbHandle) of
+ try ssl_pkix_db:foldl(IsIssuerFun, issuer_not_found, CertDbHandle) of
issuer_not_found ->
{error, issuer_not_found}
catch
diff --git a/lib/ssl/src/ssl_connection_sup.erl b/lib/ssl/src/ssl_connection_sup.erl
index 78cfda5e63..fb1c6e11a6 100644
--- a/lib/ssl/src/ssl_connection_sup.erl
+++ b/lib/ssl/src/ssl_connection_sup.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2013. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -56,10 +56,10 @@ init(_O) ->
MaxT = 3600,
Name = undefined, % As simple_one_for_one is used.
- StartFunc = {ssl_connection, start_link, []},
+ StartFunc = {tls_connection, start_link, []},
Restart = temporary, % E.g. should not be restarted
Shutdown = 4000,
- Modules = [ssl_connection],
+ Modules = [tls_connection],
Type = worker,
ChildSpec = {Name, StartFunc, Restart, Shutdown, Type, Modules},
diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl
index b2387a0ee7..eb1a1dbf62 100644
--- a/lib/ssl/src/ssl_handshake.hrl
+++ b/lib/ssl/src/ssl_handshake.hrl
@@ -20,7 +20,7 @@
%%
%%----------------------------------------------------------------------
%% Purpose: Record and constant defenitions for the SSL-handshake protocol
-%% see RFC 4346
+%% see RFC 5246. Also includes supported hello extensions.
%%----------------------------------------------------------------------
-ifndef(ssl_handshake).
@@ -91,21 +91,10 @@
% -define(NULL, 0). %% Already defined by ssl_internal.hrl
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%% Hello messages - RFC 4346 section 7.4.2
+%%% Hello messages - RFC 5246 section 7.4.1
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
--record(client_hello, {
- client_version,
- random,
- session_id, % opaque SessionID<0..32>
- cipher_suites, % cipher_suites<2..2^16-1>
- compression_methods, % compression_methods<1..2^8-1>,
- renegotiation_info,
- srp, % srp username to send
- hash_signs, % supported combinations of hashes/signature algos
- ec_point_formats, % supported ec point formats
- elliptic_curves, % supported elliptic curver
- next_protocol_negotiation = undefined % [binary()]
- }).
+
+%% client_hello defined in tls_handshake.hrl and dtls_handshake.hrl
-record(server_hello, {
server_version,
@@ -121,7 +110,7 @@
}).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%% Server authentication and key exchange messages - RFC 4346 section 7.4.3
+%%% Server authentication and key exchange messages - RFC 5246 section 7.4.3
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% opaque ASN.1Cert<2^24-1>;
@@ -193,7 +182,7 @@
-record(server_hello_done, {}).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%% Certificate request - RFC 4346 section 7.4.4
+%%% Certificate request - RFC 5246 section 7.4.4
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% enum {
diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl
index caea528a08..1b06e351cf 100644
--- a/lib/ssl/src/ssl_manager.erl
+++ b/lib/ssl/src/ssl_manager.erl
@@ -104,7 +104,8 @@ connection_init(Trustedcerts, Role) ->
%%--------------------------------------------------------------------
cache_pem_file(File, DbHandle) ->
MD5 = crypto:hash(md5, File),
- case ssl_certificate_db:lookup_cached_pem(DbHandle, MD5) of
+ MD5 = crypto:md5(File),
+ case ssl_pkix_db:lookup_cached_pem(DbHandle, MD5) of
[{Content,_}] ->
{ok, Content};
[Content] ->
@@ -132,7 +133,7 @@ clear_pem_cache() ->
%% serialnumber(), issuer()}.
%% --------------------------------------------------------------------
lookup_trusted_cert(DbHandle, Ref, SerialNumber, Issuer) ->
- ssl_certificate_db:lookup_trusted_cert(DbHandle, Ref, SerialNumber, Issuer).
+ ssl_pkix_db:lookup_trusted_cert(DbHandle, Ref, SerialNumber, Issuer).
%%--------------------------------------------------------------------
-spec new_session_id(integer()) -> session_id().
@@ -194,7 +195,7 @@ init([Name, Opts]) ->
CacheCb = proplists:get_value(session_cb, Opts, ssl_session_cache),
SessionLifeTime =
proplists:get_value(session_lifetime, Opts, ?'24H_in_sec'),
- CertDb = ssl_certificate_db:create(),
+ CertDb = ssl_pkix_db:create(),
SessionCache = CacheCb:init(proplists:get_value(session_cb_init_args, Opts, [])),
Timer = erlang:send_after(SessionLifeTime * 1000 + 5000,
self(), validate_sessions),
@@ -227,7 +228,7 @@ handle_call({{connection_init, Trustedcerts, _Role}, Pid}, _From,
session_cache = Cache} = State) ->
Result =
try
- {ok, Ref} = ssl_certificate_db:add_trusted_certs(Pid, Trustedcerts, Db),
+ {ok, Ref} = ssl_pkix_db:add_trusted_certs(Pid, Trustedcerts, Db),
{ok, Ref, CertDb, FileRefDb, PemChace, Cache}
catch
_:Reason ->
@@ -244,7 +245,7 @@ handle_call({{new_session_id,Port}, _},
handle_call({{cache_pem, File}, _Pid}, _,
#state{certificate_db = Db} = State) ->
- try ssl_certificate_db:cache_pem_file(File, Db) of
+ try ssl_pkix_db:cache_pem_file(File, Db) of
Result ->
{reply, Result, State}
catch
@@ -252,7 +253,7 @@ handle_call({{cache_pem, File}, _Pid}, _,
{reply, {error, Reason}, State}
end;
handle_call({unconditionally_clear_pem_cache, _},_, #state{certificate_db = [_,_,PemChace]} = State) ->
- ssl_certificate_db:clear(PemChace),
+ ssl_pkix_db:clear(PemChace),
{reply, ok, State}.
%%--------------------------------------------------------------------
@@ -315,11 +316,11 @@ handle_info({delayed_clean_session, Key}, #state{session_cache = Cache,
{noreply, State};
handle_info(clear_pem_cache, #state{certificate_db = [_,_,PemChace]} = State) ->
- case ssl_certificate_db:db_size(PemChace) of
+ case ssl_pkix_db:db_size(PemChace) of
N when N < ?NOT_TO_BIG ->
ok;
_ ->
- ssl_certificate_db:clear(PemChace)
+ ssl_pkix_db:clear(PemChace)
end,
erlang:send_after(?CLEAR_PEM_CACHE, self(), clear_pem_cache),
{noreply, State};
@@ -328,7 +329,7 @@ handle_info(clear_pem_cache, #state{certificate_db = [_,_,PemChace]} = State) ->
handle_info({clean_cert_db, Ref, File},
#state{certificate_db = [CertDb,RefDb, PemCache]} = State) ->
- case ssl_certificate_db:lookup(Ref, RefDb) of
+ case ssl_pkix_db:lookup(Ref, RefDb) of
undefined -> %% Alredy cleaned
ok;
_ ->
@@ -357,7 +358,7 @@ terminate(_Reason, #state{certificate_db = Db,
session_cache_cb = CacheCb,
session_validation_timer = Timer}) ->
erlang:cancel_timer(Timer),
- ssl_certificate_db:remove(Db),
+ ssl_pkix_db:remove(Db),
CacheCb:terminate(SessionCache),
ok.
@@ -466,17 +467,17 @@ new_id(Port, Tries, Cache, CacheCb) ->
end.
clean_cert_db(Ref, CertDb, RefDb, PemCache, File) ->
- case ssl_certificate_db:ref_count(Ref, RefDb, 0) of
+ case ssl_pkix_db:ref_count(Ref, RefDb, 0) of
0 ->
MD5 = crypto:hash(md5, File),
- case ssl_certificate_db:lookup_cached_pem(PemCache, MD5) of
+ case ssl_pkix_db:lookup_cached_pem(PemCache, MD5) of
[{Content, Ref}] ->
- ssl_certificate_db:insert(MD5, Content, PemCache);
+ ssl_pkix_db:insert(MD5, Content, PemCache);
_ ->
ok
end,
- ssl_certificate_db:remove(Ref, RefDb),
- ssl_certificate_db:remove_trusted_certs(Ref, CertDb);
+ ssl_pkix_db:remove(Ref, RefDb),
+ ssl_pkix_db:remove_trusted_certs(Ref, CertDb);
_ ->
ok
end.
diff --git a/lib/ssl/src/ssl_certificate_db.erl b/lib/ssl/src/ssl_pkix_db.erl
index cdff73336e..9de50c8f26 100644
--- a/lib/ssl/src/ssl_certificate_db.erl
+++ b/lib/ssl/src/ssl_pkix_db.erl
@@ -21,7 +21,7 @@
%% Purpose: Storage for trusted certificates
%%----------------------------------------------------------------------
--module(ssl_certificate_db).
+-module(ssl_pkix_db).
-include("ssl_internal.hrl").
-include_lib("public_key/include/public_key.hrl").
diff --git a/lib/ssl/src/ssl_record.hrl b/lib/ssl/src/ssl_record.hrl
index f73da92a52..2fd17f9c35 100644
--- a/lib/ssl/src/ssl_record.hrl
+++ b/lib/ssl/src/ssl_record.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2013. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -143,34 +143,6 @@
-define(LOWEST_MAJOR_SUPPORTED_VERSION, 3).
--record(ssl_tls, { %% From inet driver
- port,
- type,
- version,
- fragment
- }).
-
-%% -record(tls_plain_text, {
-%% type,
-%% version, % #protocol_version{}
-%% length, % unit 16
-%% fragment % opaque
-%% }).
-
-%% -record(tls_compressed, {
-%% type,
-%% version,
-%% length, % unit 16
-%% fragment % opaque
-%% }).
-
-%% -record(tls_cipher_text, {
-%% type,
-%% version,
-%% length,
-%% cipher,
-%% fragment
-%% }).
-record(generic_stream_cipher, {
content, % opaque content[TLSCompressed.length];
diff --git a/lib/ssl/src/tls.erl b/lib/ssl/src/tls.erl
new file mode 100644
index 0000000000..fcecf8196f
--- /dev/null
+++ b/lib/ssl/src/tls.erl
@@ -0,0 +1,1037 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2013. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+
+%%% Purpose : Main API module for SSL.
+
+-module(tls).
+
+-export([start/0, start/1, stop/0, transport_accept/1,
+ transport_accept/2, ssl_accept/1, ssl_accept/2, ssl_accept/3,
+ cipher_suites/0, cipher_suites/1, suite_definition/1,
+ close/1, shutdown/2,
+ connect/3, connect/2, connect/4, connection_info/1,
+ controlling_process/2, listen/2, peername/1, peercert/1,
+ recv/2, recv/3, send/2, getopts/2, setopts/2, sockname/1,
+ versions/0, session_info/1, format_error/1,
+ renegotiate/1, prf/5, clear_pem_cache/0, random_bytes/1, negotiated_next_protocol/1]).
+
+-include("ssl_internal.hrl").
+-include("ssl_record.hrl").
+-include("ssl_cipher.hrl").
+-include("ssl_handshake.hrl").
+-include("ssl_srp.hrl").
+
+-include_lib("public_key/include/public_key.hrl").
+
+%% Visible in API
+-export_type([connect_option/0, listen_option/0, ssl_option/0, transport_option/0,
+ erl_cipher_suite/0, %% From ssl_cipher.hrl
+ tls_atom_version/0, %% From ssl_internal.hrl
+ prf_random/0, sslsocket/0]).
+
+-record(config, {ssl, %% SSL parameters
+ inet_user, %% User set inet options
+ emulated, %% #socket_option{} emulated
+ inet_ssl, %% inet options for internal ssl socket
+ cb %% Callback info
+ }).
+
+-type sslsocket() :: #sslsocket{}.
+-type connect_option() :: socket_connect_option() | ssl_option() | transport_option().
+-type socket_connect_option() :: gen_tcp:connect_option().
+-type listen_option() :: socket_listen_option() | ssl_option() | transport_option().
+-type socket_listen_option() :: gen_tcp:listen_option().
+
+-type ssl_option() :: {verify, verify_type()} |
+ {verify_fun, {fun(), InitialUserState::term()}} |
+ {fail_if_no_peer_cert, boolean()} | {depth, integer()} |
+ {cert, Der::binary()} | {certfile, path()} | {key, Der::binary()} |
+ {keyfile, path()} | {password, string()} | {cacerts, [Der::binary()]} |
+ {cacertfile, path()} | {dh, Der::binary()} | {dhfile, path()} |
+ {user_lookup_fun, {fun(), InitialUserState::term()}} |
+ {psk_identity, string()} |
+ {srp_identity, {string(), string()}} |
+ {ciphers, ciphers()} | {ssl_imp, ssl_imp()} | {reuse_sessions, boolean()} |
+ {reuse_session, fun()} | {hibernate_after, integer()|undefined} |
+ {next_protocols_advertised, list(binary())} |
+ {client_preferred_next_protocols, binary(), client | server, list(binary())}.
+
+-type verify_type() :: verify_none | verify_peer.
+-type path() :: string().
+-type ciphers() :: [erl_cipher_suite()] |
+ string(). % (according to old API)
+-type ssl_imp() :: new | old.
+
+-type transport_option() :: {cb_info, {CallbackModule::atom(), DataTag::atom(),
+ ClosedTag::atom(), ErrTag::atom()}}.
+-type prf_random() :: client_random | server_random.
+
+%%--------------------------------------------------------------------
+-spec start() -> ok | {error, reason()}.
+-spec start(permanent | transient | temporary) -> ok | {error, reason()}.
+%%
+%% Description: Utility function that starts the ssl,
+%% crypto and public_key applications. Default type
+%% is temporary. see application(3)
+%%--------------------------------------------------------------------
+start() ->
+ application:start(crypto),
+ application:start(public_key),
+ application:start(ssl).
+
+start(Type) ->
+ application:start(crypto, Type),
+ application:start(public_key, Type),
+ application:start(ssl, Type).
+
+%%--------------------------------------------------------------------
+-spec stop() -> ok.
+%%
+%% Description: Stops the ssl application.
+%%--------------------------------------------------------------------
+stop() ->
+ application:stop(ssl).
+
+%%--------------------------------------------------------------------
+-spec connect(host() | port(), [connect_option()]) -> {ok, #sslsocket{}} |
+ {error, reason()}.
+-spec connect(host() | port(), [connect_option()] | inet:port_number(),
+ timeout() | list()) ->
+ {ok, #sslsocket{}} | {error, reason()}.
+-spec connect(host() | port(), inet:port_number(), list(), timeout()) ->
+ {ok, #sslsocket{}} | {error, reason()}.
+
+%%
+%% Description: Connect to an ssl server.
+%%--------------------------------------------------------------------
+connect(Socket, SslOptions) when is_port(Socket) ->
+ connect(Socket, SslOptions, infinity).
+
+connect(Socket, SslOptions0, Timeout) when is_port(Socket) ->
+ {Transport,_,_,_} = proplists:get_value(cb_info, SslOptions0,
+ {gen_tcp, tcp, tcp_closed, tcp_error}),
+ EmulatedOptions = emulated_options(),
+ {ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions),
+ try handle_options(SslOptions0 ++ SocketValues, client) of
+ {ok, #config{cb = CbInfo, ssl = SslOptions, emulated = EmOpts}} ->
+
+ ok = ssl_socket:setopts(Transport, Socket, internal_inet_values()),
+ case ssl_socket:peername(Transport, Socket) of
+ {ok, {Address, Port}} ->
+ tls_connection:connect(Address, Port, Socket,
+ {SslOptions, EmOpts},
+ self(), CbInfo, Timeout);
+ {error, Error} ->
+ {error, Error}
+ end
+ catch
+ _:{error, Reason} ->
+ {error, Reason}
+ end;
+
+connect(Host, Port, Options) ->
+ connect(Host, Port, Options, infinity).
+
+connect(Host, Port, Options, Timeout) ->
+ try handle_options(Options, client) of
+ {ok, Config} ->
+ do_connect(Host,Port,Config,Timeout)
+ catch
+ throw:Error ->
+ Error
+ end.
+
+%%--------------------------------------------------------------------
+-spec listen(inet:port_number(), [listen_option()]) ->{ok, #sslsocket{}} | {error, reason()}.
+
+%%
+%% Description: Creates an ssl listen socket.
+%%--------------------------------------------------------------------
+listen(_Port, []) ->
+ {error, nooptions};
+listen(Port, Options0) ->
+ try
+ {ok, Config} = handle_options(Options0, server),
+ #config{cb = {Transport, _, _, _}, inet_user = Options} = Config,
+ case Transport:listen(Port, Options) of
+ {ok, ListenSocket} ->
+ {ok, #sslsocket{pid = {ListenSocket, Config}}};
+ Err = {error, _} ->
+ Err
+ end
+ catch
+ Error = {error, _} ->
+ Error
+ end.
+%%--------------------------------------------------------------------
+-spec transport_accept(#sslsocket{}) -> {ok, #sslsocket{}} |
+ {error, reason()}.
+-spec transport_accept(#sslsocket{}, timeout()) -> {ok, #sslsocket{}} |
+ {error, reason()}.
+%%
+%% Description: Performs transport accept on an ssl listen socket
+%%--------------------------------------------------------------------
+transport_accept(ListenSocket) ->
+ transport_accept(ListenSocket, infinity).
+
+transport_accept(#sslsocket{pid = {ListenSocket, #config{cb = CbInfo, ssl = SslOpts}}}, Timeout) ->
+
+ %% The setopt could have been invoked on the listen socket
+ %% and options should be inherited.
+ EmOptions = emulated_options(),
+ {Transport,_,_, _} = CbInfo,
+ {ok, SocketValues} = ssl_socket:getopts(Transport, ListenSocket, EmOptions),
+ ok = ssl_socket:setopts(Transport, ListenSocket, internal_inet_values()),
+ case Transport:accept(ListenSocket, Timeout) of
+ {ok, Socket} ->
+ ok = ssl_socket:setopts(Transport, ListenSocket, SocketValues),
+ {ok, Port} = ssl_socket:port(Transport, Socket),
+ ConnArgs = [server, "localhost", Port, Socket,
+ {SslOpts, socket_options(SocketValues)}, self(), CbInfo],
+ case ssl_connection_sup:start_child(ConnArgs) of
+ {ok, Pid} ->
+ tls_connection:socket_control(Socket, Pid, Transport);
+ {error, Reason} ->
+ {error, Reason}
+ end;
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+%%--------------------------------------------------------------------
+-spec ssl_accept(#sslsocket{}) -> ok | {error, reason()}.
+-spec ssl_accept(#sslsocket{} | port(), timeout()| [ssl_option()
+ | transport_option()]) ->
+ ok | {ok, #sslsocket{}} | {error, reason()}.
+-spec ssl_accept(port(), [ssl_option()| transport_option()], timeout()) ->
+ {ok, #sslsocket{}} | {error, reason()}.
+%%
+%% Description: Performs accept on an ssl listen socket. e.i. performs
+%% ssl handshake.
+%%--------------------------------------------------------------------
+ssl_accept(ListenSocket) ->
+ ssl_accept(ListenSocket, infinity).
+
+ssl_accept(#sslsocket{} = Socket, Timeout) ->
+ tls_connection:handshake(Socket, Timeout);
+
+ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) ->
+ ssl_accept(ListenSocket, SslOptions, infinity).
+
+ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) ->
+ {Transport,_,_,_} =
+ proplists:get_value(cb_info, SslOptions, {gen_tcp, tcp, tcp_closed, tcp_error}),
+ EmulatedOptions = emulated_options(),
+ {ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions),
+ try handle_options(SslOptions ++ SocketValues, server) of
+ {ok, #config{cb = CbInfo, ssl = SslOpts, emulated = EmOpts}} ->
+ ok = ssl_socket:setopts(Transport, Socket, internal_inet_values()),
+ {ok, Port} = ssl_socket:port(Transport, Socket),
+ tls_connection:ssl_accept(Port, Socket,
+ {SslOpts, EmOpts},
+ self(), CbInfo, Timeout)
+ catch
+ Error = {error, _Reason} -> Error
+ end.
+
+%%--------------------------------------------------------------------
+-spec close(#sslsocket{}) -> term().
+%%
+%% Description: Close an ssl connection
+%%--------------------------------------------------------------------
+close(#sslsocket{pid = Pid}) when is_pid(Pid) ->
+ tls_connection:close(Pid);
+close(#sslsocket{pid = {ListenSocket, #config{cb={Transport,_, _, _}}}}) ->
+ Transport:close(ListenSocket).
+
+%%--------------------------------------------------------------------
+-spec send(#sslsocket{}, iodata()) -> ok | {error, reason()}.
+%%
+%% Description: Sends data over the ssl connection
+%%--------------------------------------------------------------------
+send(#sslsocket{pid = Pid}, Data) when is_pid(Pid) ->
+ tls_connection:send(Pid, Data);
+send(#sslsocket{pid = {ListenSocket, #config{cb={Transport, _, _, _}}}}, Data) ->
+ Transport:send(ListenSocket, Data). %% {error,enotconn}
+
+%%--------------------------------------------------------------------
+-spec recv(#sslsocket{}, integer()) -> {ok, binary()| list()} | {error, reason()}.
+-spec recv(#sslsocket{}, integer(), timeout()) -> {ok, binary()| list()} | {error, reason()}.
+%%
+%% Description: Receives data when active = false
+%%--------------------------------------------------------------------
+recv(Socket, Length) ->
+ recv(Socket, Length, infinity).
+recv(#sslsocket{pid = Pid}, Length, Timeout) when is_pid(Pid) ->
+ tls_connection:recv(Pid, Length, Timeout);
+recv(#sslsocket{pid = {Listen,
+ #config{cb={Transport, _, _, _}}}}, _,_) when is_port(Listen)->
+ Transport:recv(Listen, 0). %% {error,enotconn}
+
+%%--------------------------------------------------------------------
+-spec controlling_process(#sslsocket{}, pid()) -> ok | {error, reason()}.
+%%
+%% Description: Changes process that receives the messages when active = true
+%% or once.
+%%--------------------------------------------------------------------
+controlling_process(#sslsocket{pid = Pid}, NewOwner) when is_pid(Pid), is_pid(NewOwner) ->
+ tls_connection:new_user(Pid, NewOwner);
+controlling_process(#sslsocket{pid = {Listen,
+ #config{cb={Transport, _, _, _}}}},
+ NewOwner) when is_port(Listen),
+ is_pid(NewOwner) ->
+ Transport:controlling_process(Listen, NewOwner).
+
+%%--------------------------------------------------------------------
+-spec connection_info(#sslsocket{}) -> {ok, {tls_atom_version(), erl_cipher_suite()}} |
+ {error, reason()}.
+%%
+%% Description: Returns ssl protocol and cipher used for the connection
+%%--------------------------------------------------------------------
+connection_info(#sslsocket{pid = Pid}) when is_pid(Pid) ->
+ tls_connection:info(Pid);
+connection_info(#sslsocket{pid = {Listen, _}}) when is_port(Listen) ->
+ {error, enotconn}.
+
+%%--------------------------------------------------------------------
+-spec peername(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}.
+%%
+%% Description: same as inet:peername/1.
+%%--------------------------------------------------------------------
+peername(#sslsocket{pid = Pid, fd = {Transport, Socket}}) when is_pid(Pid)->
+ ssl_socket:peername(Transport, Socket);
+peername(#sslsocket{pid = {ListenSocket, #config{cb = {Transport,_,_,_}}}}) ->
+ ssl_socket:peername(Transport, ListenSocket). %% Will return {error, enotconn}
+
+%%--------------------------------------------------------------------
+-spec peercert(#sslsocket{}) ->{ok, DerCert::binary()} | {error, reason()}.
+%%
+%% Description: Returns the peercert.
+%%--------------------------------------------------------------------
+peercert(#sslsocket{pid = Pid}) when is_pid(Pid) ->
+ case tls_connection:peer_certificate(Pid) of
+ {ok, undefined} ->
+ {error, no_peercert};
+ Result ->
+ Result
+ end;
+peercert(#sslsocket{pid = {Listen, _}}) when is_port(Listen) ->
+ {error, enotconn}.
+
+%%--------------------------------------------------------------------
+-spec suite_definition(cipher_suite()) -> erl_cipher_suite().
+%%
+%% Description: Return erlang cipher suite definition.
+%%--------------------------------------------------------------------
+suite_definition(S) ->
+ {KeyExchange, Cipher, Hash, _} = ssl_cipher:suite_definition(S),
+ {KeyExchange, Cipher, Hash}.
+
+%%--------------------------------------------------------------------
+-spec negotiated_next_protocol(#sslsocket{}) -> {ok, binary()} | {error, reason()}.
+%%
+%% Description: Returns the next protocol that has been negotiated. If no
+%% protocol has been negotiated will return {error, next_protocol_not_negotiated}
+%%--------------------------------------------------------------------
+negotiated_next_protocol(#sslsocket{pid = Pid}) ->
+ tls_connection:negotiated_next_protocol(Pid).
+
+-spec cipher_suites() -> [erl_cipher_suite()].
+-spec cipher_suites(erlang | openssl | all) -> [erl_cipher_suite()] | [string()].
+
+%% Description: Returns all supported cipher suites.
+%%--------------------------------------------------------------------
+cipher_suites() ->
+ cipher_suites(erlang).
+
+cipher_suites(erlang) ->
+ Version = tls_record:highest_protocol_version([]),
+ [suite_definition(S) || S <- ssl_cipher:suites(Version)];
+
+cipher_suites(openssl) ->
+ Version = tls_record:highest_protocol_version([]),
+ [ssl_cipher:openssl_suite_name(S) || S <- ssl_cipher:suites(Version)];
+cipher_suites(all) ->
+ Version = tls_record:highest_protocol_version([]),
+ Supported = ssl_cipher:suites(Version)
+ ++ ssl_cipher:anonymous_suites()
+ ++ ssl_cipher:psk_suites(Version)
+ ++ ssl_cipher:srp_suites(),
+ [suite_definition(S) || S <- Supported].
+
+%%--------------------------------------------------------------------
+-spec getopts(#sslsocket{}, [gen_tcp:option_name()]) ->
+ {ok, [gen_tcp:option()]} | {error, reason()}.
+%%
+%% Description: Gets options
+%%--------------------------------------------------------------------
+getopts(#sslsocket{pid = Pid}, OptionTags) when is_pid(Pid), is_list(OptionTags) ->
+ tls_connection:get_opts(Pid, OptionTags);
+getopts(#sslsocket{pid = {ListenSocket, #config{cb = {Transport,_,_,_}}}},
+ OptionTags) when is_list(OptionTags) ->
+ try ssl_socket:getopts(Transport, ListenSocket, OptionTags) of
+ {ok, _} = Result ->
+ Result;
+ {error, InetError} ->
+ {error, {options, {socket_options, OptionTags, InetError}}}
+ catch
+ _:_ ->
+ {error, {options, {socket_options, OptionTags}}}
+ end;
+getopts(#sslsocket{}, OptionTags) ->
+ {error, {options, {socket_options, OptionTags}}}.
+
+%%--------------------------------------------------------------------
+-spec setopts(#sslsocket{}, [gen_tcp:option()]) -> ok | {error, reason()}.
+%%
+%% Description: Sets options
+%%--------------------------------------------------------------------
+setopts(#sslsocket{pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) ->
+ try proplists:expand([{binary, [{mode, binary}]},
+ {list, [{mode, list}]}], Options0) of
+ Options ->
+ tls_connection:set_opts(Pid, Options)
+ catch
+ _:_ ->
+ {error, {options, {not_a_proplist, Options0}}}
+ end;
+
+setopts(#sslsocket{pid = {ListenSocket, #config{cb = {Transport,_,_,_}}}}, Options) when is_list(Options) ->
+ try ssl_socket:setopts(Transport, ListenSocket, Options) of
+ ok ->
+ ok;
+ {error, InetError} ->
+ {error, {options, {socket_options, Options, InetError}}}
+ catch
+ _:Error ->
+ {error, {options, {socket_options, Options, Error}}}
+ end;
+setopts(#sslsocket{}, Options) ->
+ {error, {options,{not_a_proplist, Options}}}.
+
+%%---------------------------------------------------------------
+-spec shutdown(#sslsocket{}, read | write | read_write) -> ok | {error, reason()}.
+%%
+%% Description: Same as gen_tcp:shutdown/2
+%%--------------------------------------------------------------------
+shutdown(#sslsocket{pid = {Listen, #config{cb={Transport,_, _, _}}}},
+ How) when is_port(Listen) ->
+ Transport:shutdown(Listen, How);
+shutdown(#sslsocket{pid = Pid}, How) ->
+ tls_connection:shutdown(Pid, How).
+
+%%--------------------------------------------------------------------
+-spec sockname(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}.
+%%
+%% Description: Same as inet:sockname/1
+%%--------------------------------------------------------------------
+sockname(#sslsocket{pid = {Listen, #config{cb={Transport,_, _, _}}}}) when is_port(Listen) ->
+ ssl_socket:sockname(Transport, Listen);
+
+sockname(#sslsocket{pid = Pid, fd = {Transport, Socket}}) when is_pid(Pid) ->
+ ssl_socket:sockname(Transport, Socket).
+
+%%---------------------------------------------------------------
+-spec session_info(#sslsocket{}) -> {ok, list()} | {error, reason()}.
+%%
+%% Description: Returns list of session info currently [{session_id, session_id(),
+%% {cipher_suite, cipher_suite()}]
+%%--------------------------------------------------------------------
+session_info(#sslsocket{pid = Pid}) when is_pid(Pid) ->
+ tls_connection:session_info(Pid);
+session_info(#sslsocket{pid = {Listen,_}}) when is_port(Listen) ->
+ {error, enotconn}.
+
+%%---------------------------------------------------------------
+-spec versions() -> [{ssl_app, string()} | {supported, [tls_atom_version()]} |
+ {available, [tls_atom_version()]}].
+%%
+%% Description: Returns a list of relevant versions.
+%%--------------------------------------------------------------------
+versions() ->
+ Vsns = tls_record:supported_protocol_versions(),
+ SupportedVsns = [tls_record:protocol_version(Vsn) || Vsn <- Vsns],
+ AvailableVsns = ?ALL_SUPPORTED_VERSIONS,
+ [{ssl_app, ?VSN}, {supported, SupportedVsns}, {available, AvailableVsns}].
+
+
+%%---------------------------------------------------------------
+-spec renegotiate(#sslsocket{}) -> ok | {error, reason()}.
+%%
+%% Description: Initiates a renegotiation.
+%%--------------------------------------------------------------------
+renegotiate(#sslsocket{pid = Pid}) when is_pid(Pid) ->
+ tls_connection:renegotiation(Pid);
+renegotiate(#sslsocket{pid = {Listen,_}}) when is_port(Listen) ->
+ {error, enotconn}.
+
+%%--------------------------------------------------------------------
+-spec prf(#sslsocket{}, binary() | 'master_secret', binary(),
+ binary() | prf_random(), non_neg_integer()) ->
+ {ok, binary()} | {error, reason()}.
+%%
+%% Description: use a ssl sessions TLS PRF to generate key material
+%%--------------------------------------------------------------------
+prf(#sslsocket{pid = Pid},
+ Secret, Label, Seed, WantedLength) when is_pid(Pid) ->
+ tls_connection:prf(Pid, Secret, Label, Seed, WantedLength);
+prf(#sslsocket{pid = {Listen,_}}, _,_,_,_) when is_port(Listen) ->
+ {error, enotconn}.
+
+%%--------------------------------------------------------------------
+-spec clear_pem_cache() -> ok.
+%%
+%% Description: Clear the PEM cache
+%%--------------------------------------------------------------------
+clear_pem_cache() ->
+ ssl_manager:clear_pem_cache().
+
+%%---------------------------------------------------------------
+-spec format_error({error, term()}) -> list().
+%%
+%% Description: Creates error string.
+%%--------------------------------------------------------------------
+format_error({error, Reason}) ->
+ format_error(Reason);
+format_error(Reason) when is_list(Reason) ->
+ Reason;
+format_error(closed) ->
+ "TLS connection is closed";
+format_error({tls_alert, Description}) ->
+ "TLS Alert: " ++ Description;
+format_error({options,{FileType, File, Reason}}) when FileType == cacertfile;
+ FileType == certfile;
+ FileType == keyfile;
+ FileType == dhfile ->
+ Error = file_error_format(Reason),
+ file_desc(FileType) ++ File ++ ": " ++ Error;
+format_error({options, {socket_options, Option, Error}}) ->
+ lists:flatten(io_lib:format("Invalid transport socket option ~p: ~s", [Option, format_error(Error)]));
+format_error({options, {socket_options, Option}}) ->
+ lists:flatten(io_lib:format("Invalid socket option: ~p", [Option]));
+format_error({options, Options}) ->
+ lists:flatten(io_lib:format("Invalid TLS option: ~p", [Options]));
+
+format_error(Error) ->
+ case inet:format_error(Error) of
+ "unknown POSIX" ++ _ ->
+ unexpected_format(Error);
+ Other ->
+ Other
+ end.
+
+%%--------------------------------------------------------------------
+-spec random_bytes(integer()) -> binary().
+
+%%
+%% Description: Generates cryptographically secure random sequence if possible
+%% fallbacks on pseudo random function
+%%--------------------------------------------------------------------
+random_bytes(N) ->
+ try crypto:strong_rand_bytes(N) of
+ RandBytes ->
+ RandBytes
+ catch
+ error:low_entropy ->
+ crypto:rand_bytes(N)
+ end.
+
+%%%--------------------------------------------------------------
+%%% Internal functions
+%%%--------------------------------------------------------------------
+do_connect(Address, Port,
+ #config{cb=CbInfo, inet_user=UserOpts, ssl=SslOpts,
+ emulated=EmOpts,inet_ssl=SocketOpts},
+ Timeout) ->
+ {Transport, _, _, _} = CbInfo,
+ try Transport:connect(Address, Port, SocketOpts, Timeout) of
+ {ok, Socket} ->
+ tls_connection:connect(Address, Port, Socket, {SslOpts,EmOpts},
+ self(), CbInfo, Timeout);
+ {error, Reason} ->
+ {error, Reason}
+ catch
+ exit:{function_clause, _} ->
+ {error, {options, {cb_info, CbInfo}}};
+ exit:badarg ->
+ {error, {options, {socket_options, UserOpts}}};
+ exit:{badarg, _} ->
+ {error, {options, {socket_options, UserOpts}}}
+ end.
+
+handle_options(Opts0, _Role) ->
+ Opts = proplists:expand([{binary, [{mode, binary}]},
+ {list, [{mode, list}]}], Opts0),
+ ReuseSessionFun = fun(_, _, _, _) -> true end,
+
+ DefaultVerifyNoneFun =
+ {fun(_,{bad_cert, _}, UserState) ->
+ {valid, UserState};
+ (_,{extension, _}, UserState) ->
+ {unknown, UserState};
+ (_, valid, UserState) ->
+ {valid, UserState};
+ (_, valid_peer, UserState) ->
+ {valid, UserState}
+ end, []},
+
+ VerifyNoneFun = handle_option(verify_fun, Opts, DefaultVerifyNoneFun),
+
+ UserFailIfNoPeerCert = handle_option(fail_if_no_peer_cert, Opts, false),
+ UserVerifyFun = handle_option(verify_fun, Opts, undefined),
+ CaCerts = handle_option(cacerts, Opts, undefined),
+
+ {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun} =
+ %% Handle 0, 1, 2 for backwards compatibility
+ case proplists:get_value(verify, Opts, verify_none) of
+ 0 ->
+ {verify_none, false,
+ ca_cert_default(verify_none, VerifyNoneFun, CaCerts), VerifyNoneFun};
+ 1 ->
+ {verify_peer, false,
+ ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun};
+ 2 ->
+ {verify_peer, true,
+ ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun};
+ verify_none ->
+ {verify_none, false,
+ ca_cert_default(verify_none, VerifyNoneFun, CaCerts), VerifyNoneFun};
+ verify_peer ->
+ {verify_peer, UserFailIfNoPeerCert,
+ ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun};
+ Value ->
+ throw({error, {options, {verify, Value}}})
+ end,
+
+ CertFile = handle_option(certfile, Opts, <<>>),
+
+ Versions = case handle_option(versions, Opts, []) of
+ [] ->
+ tls_record:supported_protocol_versions();
+ Vsns ->
+ [tls_record:protocol_version(Vsn) || Vsn <- Vsns]
+ end,
+
+ SSLOptions = #ssl_options{
+ versions = Versions,
+ verify = validate_option(verify, Verify),
+ verify_fun = VerifyFun,
+ fail_if_no_peer_cert = FailIfNoPeerCert,
+ verify_client_once = handle_option(verify_client_once, Opts, false),
+ depth = handle_option(depth, Opts, 1),
+ cert = handle_option(cert, Opts, undefined),
+ certfile = CertFile,
+ key = handle_option(key, Opts, undefined),
+ keyfile = handle_option(keyfile, Opts, CertFile),
+ password = handle_option(password, Opts, ""),
+ cacerts = CaCerts,
+ cacertfile = handle_option(cacertfile, Opts, CaCertDefault),
+ dh = handle_option(dh, Opts, undefined),
+ dhfile = handle_option(dhfile, Opts, undefined),
+ user_lookup_fun = handle_option(user_lookup_fun, Opts, undefined),
+ psk_identity = handle_option(psk_identity, Opts, undefined),
+ srp_identity = handle_option(srp_identity, Opts, undefined),
+ ciphers = handle_option(ciphers, Opts, []),
+ %% Server side option
+ reuse_session = handle_option(reuse_session, Opts, ReuseSessionFun),
+ reuse_sessions = handle_option(reuse_sessions, Opts, true),
+ secure_renegotiate = handle_option(secure_renegotiate, Opts, false),
+ renegotiate_at = handle_option(renegotiate_at, Opts, ?DEFAULT_RENEGOTIATE_AT),
+ hibernate_after = handle_option(hibernate_after, Opts, undefined),
+ erl_dist = handle_option(erl_dist, Opts, false),
+ next_protocols_advertised =
+ handle_option(next_protocols_advertised, Opts, undefined),
+ next_protocol_selector =
+ make_next_protocol_selector(
+ handle_option(client_preferred_next_protocols, Opts, undefined))
+ },
+
+ CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}),
+ SslOptions = [versions, verify, verify_fun,
+ fail_if_no_peer_cert, verify_client_once,
+ depth, cert, certfile, key, keyfile,
+ password, cacerts, cacertfile, dh, dhfile,
+ user_lookup_fun, psk_identity, srp_identity, ciphers,
+ reuse_session, reuse_sessions, ssl_imp,
+ cb_info, renegotiate_at, secure_renegotiate, hibernate_after,
+ erl_dist, next_protocols_advertised,
+ client_preferred_next_protocols],
+
+ SockOpts = lists:foldl(fun(Key, PropList) ->
+ proplists:delete(Key, PropList)
+ end, Opts, SslOptions),
+
+ {SSLsock, Emulated} = emulated_options(SockOpts),
+ {ok, #config{ssl=SSLOptions, emulated=Emulated, inet_ssl=SSLsock,
+ inet_user=SockOpts, cb=CbInfo}}.
+
+handle_option(OptionName, Opts, Default) ->
+ validate_option(OptionName,
+ proplists:get_value(OptionName, Opts, Default)).
+
+
+validate_option(versions, Versions) ->
+ validate_versions(Versions, Versions);
+validate_option(verify, Value)
+ when Value == verify_none; Value == verify_peer ->
+ Value;
+validate_option(verify_fun, undefined) ->
+ undefined;
+%% Backwards compatibility
+validate_option(verify_fun, Fun) when is_function(Fun) ->
+ {fun(_,{bad_cert, _} = Reason, OldFun) ->
+ case OldFun([Reason]) of
+ true ->
+ {valid, OldFun};
+ false ->
+ {fail, Reason}
+ end;
+ (_,{extension, _}, UserState) ->
+ {unknown, UserState};
+ (_, valid, UserState) ->
+ {valid, UserState};
+ (_, valid_peer, UserState) ->
+ {valid, UserState}
+ end, Fun};
+validate_option(verify_fun, {Fun, _} = Value) when is_function(Fun) ->
+ Value;
+validate_option(fail_if_no_peer_cert, Value)
+ when Value == true; Value == false ->
+ Value;
+validate_option(verify_client_once, Value)
+ when Value == true; Value == false ->
+ Value;
+validate_option(depth, Value) when is_integer(Value),
+ Value >= 0, Value =< 255->
+ Value;
+validate_option(cert, Value) when Value == undefined;
+ is_binary(Value) ->
+ Value;
+validate_option(certfile, undefined = Value) ->
+ Value;
+validate_option(certfile, Value) when is_binary(Value) ->
+ Value;
+validate_option(certfile, Value) when is_list(Value) ->
+ list_to_binary(Value);
+
+validate_option(key, undefined) ->
+ undefined;
+validate_option(key, {KeyType, Value}) when is_binary(Value),
+ KeyType == rsa; %% Backwards compatibility
+ KeyType == dsa; %% Backwards compatibility
+ KeyType == 'RSAPrivateKey';
+ KeyType == 'DSAPrivateKey';
+ KeyType == 'PrivateKeyInfo' ->
+ {KeyType, Value};
+
+validate_option(keyfile, undefined) ->
+ <<>>;
+validate_option(keyfile, Value) when is_binary(Value) ->
+ Value;
+validate_option(keyfile, Value) when is_list(Value), Value =/= "" ->
+ list_to_binary(Value);
+validate_option(password, Value) when is_list(Value) ->
+ Value;
+
+validate_option(cacerts, Value) when Value == undefined;
+ is_list(Value) ->
+ Value;
+%% certfile must be present in some cases otherwhise it can be set
+%% to the empty string.
+validate_option(cacertfile, undefined) ->
+ <<>>;
+validate_option(cacertfile, Value) when is_binary(Value) ->
+ Value;
+validate_option(cacertfile, Value) when is_list(Value), Value =/= ""->
+ list_to_binary(Value);
+validate_option(dh, Value) when Value == undefined;
+ is_binary(Value) ->
+ Value;
+validate_option(dhfile, undefined = Value) ->
+ Value;
+validate_option(dhfile, Value) when is_binary(Value) ->
+ Value;
+validate_option(dhfile, Value) when is_list(Value), Value =/= "" ->
+ list_to_binary(Value);
+validate_option(psk_identity, undefined) ->
+ undefined;
+validate_option(psk_identity, Identity)
+ when is_list(Identity), Identity =/= "", length(Identity) =< 65535 ->
+ list_to_binary(Identity);
+validate_option(user_lookup_fun, undefined) ->
+ undefined;
+validate_option(user_lookup_fun, {Fun, _} = Value) when is_function(Fun, 3) ->
+ Value;
+validate_option(srp_identity, undefined) ->
+ undefined;
+validate_option(srp_identity, {Username, Password})
+ when is_list(Username), is_list(Password), Username =/= "", length(Username) =< 255 ->
+ {list_to_binary(Username), list_to_binary(Password)};
+
+validate_option(ciphers, Value) when is_list(Value) ->
+ Version = tls_record:highest_protocol_version([]),
+ try cipher_suites(Version, Value)
+ catch
+ exit:_ ->
+ throw({error, {options, {ciphers, Value}}});
+ error:_->
+ throw({error, {options, {ciphers, Value}}})
+ end;
+validate_option(reuse_session, Value) when is_function(Value) ->
+ Value;
+validate_option(reuse_sessions, Value) when Value == true;
+ Value == false ->
+ Value;
+
+validate_option(secure_renegotiate, Value) when Value == true;
+ Value == false ->
+ Value;
+validate_option(renegotiate_at, Value) when is_integer(Value) ->
+ erlang:min(Value, ?DEFAULT_RENEGOTIATE_AT);
+
+validate_option(hibernate_after, undefined) ->
+ undefined;
+validate_option(hibernate_after, Value) when is_integer(Value), Value >= 0 ->
+ Value;
+validate_option(erl_dist,Value) when Value == true;
+ Value == false ->
+ Value;
+validate_option(client_preferred_next_protocols = Opt, {Precedence, PreferredProtocols} = Value)
+ when is_list(PreferredProtocols) ->
+ case tls_record:highest_protocol_version([]) of
+ {3,0} ->
+ throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}});
+ _ ->
+ validate_binary_list(client_preferred_next_protocols, PreferredProtocols),
+ validate_npn_ordering(Precedence),
+ {Precedence, PreferredProtocols, ?NO_PROTOCOL}
+ end;
+validate_option(client_preferred_next_protocols = Opt, {Precedence, PreferredProtocols, Default} = Value)
+ when is_list(PreferredProtocols), is_binary(Default),
+ byte_size(Default) > 0, byte_size(Default) < 256 ->
+ case tls_record:highest_protocol_version([]) of
+ {3,0} ->
+ throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}});
+ _ ->
+ validate_binary_list(client_preferred_next_protocols, PreferredProtocols),
+ validate_npn_ordering(Precedence),
+ Value
+ end;
+
+validate_option(client_preferred_next_protocols, undefined) ->
+ undefined;
+validate_option(next_protocols_advertised = Opt, Value) when is_list(Value) ->
+ case tls_record:highest_protocol_version([]) of
+ {3,0} ->
+ throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}});
+ _ ->
+ validate_binary_list(next_protocols_advertised, Value),
+ Value
+ end;
+
+validate_option(next_protocols_advertised, undefined) ->
+ undefined;
+validate_option(Opt, Value) ->
+ throw({error, {options, {Opt, Value}}}).
+
+validate_npn_ordering(client) ->
+ ok;
+validate_npn_ordering(server) ->
+ ok;
+validate_npn_ordering(Value) ->
+ throw({error, {options, {client_preferred_next_protocols, {invalid_precedence, Value}}}}).
+
+validate_binary_list(Opt, List) ->
+ lists:foreach(
+ fun(Bin) when is_binary(Bin),
+ byte_size(Bin) > 0,
+ byte_size(Bin) < 256 ->
+ ok;
+ (Bin) ->
+ throw({error, {options, {Opt, {invalid_protocol, Bin}}}})
+ end, List).
+
+validate_versions([], Versions) ->
+ Versions;
+validate_versions([Version | Rest], Versions) when Version == 'tlsv1.2';
+ Version == 'tlsv1.1';
+ Version == tlsv1;
+ Version == sslv3 ->
+ validate_versions(Rest, Versions);
+validate_versions([Ver| _], Versions) ->
+ throw({error, {options, {Ver, {versions, Versions}}}}).
+
+validate_inet_option(mode, Value)
+ when Value =/= list, Value =/= binary ->
+ throw({error, {options, {mode,Value}}});
+validate_inet_option(packet, Value)
+ when not (is_atom(Value) orelse is_integer(Value)) ->
+ throw({error, {options, {packet,Value}}});
+validate_inet_option(packet_size, Value)
+ when not is_integer(Value) ->
+ throw({error, {options, {packet_size,Value}}});
+validate_inet_option(header, Value)
+ when not is_integer(Value) ->
+ throw({error, {options, {header,Value}}});
+validate_inet_option(active, Value)
+ when Value =/= true, Value =/= false, Value =/= once ->
+ throw({error, {options, {active,Value}}});
+validate_inet_option(_, _) ->
+ ok.
+
+%% The option cacerts overrides cacertsfile
+ca_cert_default(_,_, [_|_]) ->
+ undefined;
+ca_cert_default(verify_none, _, _) ->
+ undefined;
+ca_cert_default(verify_peer, {Fun,_}, _) when is_function(Fun) ->
+ undefined;
+%% Server that wants to verify_peer and has no verify_fun must have
+%% some trusted certs.
+ca_cert_default(verify_peer, undefined, _) ->
+ "".
+
+emulated_options() ->
+ [mode, packet, active, header, packet_size].
+
+internal_inet_values() ->
+ [{packet_size,0},{packet, 0},{header, 0},{active, false},{mode,binary}].
+
+socket_options(InetValues) ->
+ #socket_options{
+ mode = proplists:get_value(mode, InetValues, lists),
+ header = proplists:get_value(header, InetValues, 0),
+ active = proplists:get_value(active, InetValues, active),
+ packet = proplists:get_value(packet, InetValues, 0),
+ packet_size = proplists:get_value(packet_size, InetValues)
+ }.
+
+emulated_options(Opts) ->
+ emulated_options(Opts, internal_inet_values(), #socket_options{}).
+
+emulated_options([{mode,Opt}|Opts], Inet, Emulated) ->
+ validate_inet_option(mode,Opt),
+ emulated_options(Opts, Inet, Emulated#socket_options{mode=Opt});
+emulated_options([{header,Opt}|Opts], Inet, Emulated) ->
+ validate_inet_option(header,Opt),
+ emulated_options(Opts, Inet, Emulated#socket_options{header=Opt});
+emulated_options([{active,Opt}|Opts], Inet, Emulated) ->
+ validate_inet_option(active,Opt),
+ emulated_options(Opts, Inet, Emulated#socket_options{active=Opt});
+emulated_options([{packet,Opt}|Opts], Inet, Emulated) ->
+ validate_inet_option(packet,Opt),
+ emulated_options(Opts, Inet, Emulated#socket_options{packet=Opt});
+emulated_options([{packet_size,Opt}|Opts], Inet, Emulated) ->
+ validate_inet_option(packet_size,Opt),
+ emulated_options(Opts, Inet, Emulated#socket_options{packet_size=Opt});
+emulated_options([Opt|Opts], Inet, Emulated) ->
+ emulated_options(Opts, [Opt|Inet], Emulated);
+emulated_options([], Inet,Emulated) ->
+ {Inet, Emulated}.
+
+cipher_suites(Version, []) ->
+ ssl_cipher:suites(Version);
+cipher_suites(Version, [{_,_,_,_}| _] = Ciphers0) -> %% Backwards compatibility
+ Ciphers = [{KeyExchange, Cipher, Hash} || {KeyExchange, Cipher, Hash, _} <- Ciphers0],
+ cipher_suites(Version, Ciphers);
+cipher_suites(Version, [{_,_,_}| _] = Ciphers0) ->
+ Ciphers = [ssl_cipher:suite(C) || C <- Ciphers0],
+ cipher_suites(Version, Ciphers);
+
+cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) ->
+ Supported0 = ssl_cipher:suites(Version)
+ ++ ssl_cipher:anonymous_suites()
+ ++ ssl_cipher:psk_suites(Version)
+ ++ ssl_cipher:srp_suites(),
+ Supported = ssl_cipher:filter_suites(Supported0),
+ case [Cipher || Cipher <- Ciphers0, lists:member(Cipher, Supported)] of
+ [] ->
+ Supported;
+ Ciphers ->
+ Ciphers
+ end;
+cipher_suites(Version, [Head | _] = Ciphers0) when is_list(Head) ->
+ %% Format: ["RC4-SHA","RC4-MD5"]
+ Ciphers = [ssl_cipher:openssl_suite(C) || C <- Ciphers0],
+ cipher_suites(Version, Ciphers);
+cipher_suites(Version, Ciphers0) ->
+ %% Format: "RC4-SHA:RC4-MD5"
+ Ciphers = [ssl_cipher:openssl_suite(C) || C <- string:tokens(Ciphers0, ":")],
+ cipher_suites(Version, Ciphers).
+
+unexpected_format(Error) ->
+ lists:flatten(io_lib:format("Unexpected error: ~p", [Error])).
+
+file_error_format({error, Error})->
+ case file:format_error(Error) of
+ "unknown POSIX error" ->
+ "decoding error";
+ Str ->
+ Str
+ end;
+file_error_format(_) ->
+ "decoding error".
+
+file_desc(cacertfile) ->
+ "Invalid CA certificate file ";
+file_desc(certfile) ->
+ "Invalid certificate file ";
+file_desc(keyfile) ->
+ "Invalid key file ";
+file_desc(dhfile) ->
+ "Invalid DH params file ".
+
+detect(_Pred, []) ->
+ undefined;
+detect(Pred, [H|T]) ->
+ case Pred(H) of
+ true ->
+ H;
+ _ ->
+ detect(Pred, T)
+ end.
+
+make_next_protocol_selector(undefined) ->
+ undefined;
+make_next_protocol_selector({client, AllProtocols, DefaultProtocol}) ->
+ fun(AdvertisedProtocols) ->
+ case detect(fun(PreferredProtocol) ->
+ lists:member(PreferredProtocol, AdvertisedProtocols)
+ end, AllProtocols) of
+ undefined ->
+ DefaultProtocol;
+ PreferredProtocol ->
+ PreferredProtocol
+ end
+ end;
+
+make_next_protocol_selector({server, AllProtocols, DefaultProtocol}) ->
+ fun(AdvertisedProtocols) ->
+ case detect(fun(PreferredProtocol) ->
+ lists:member(PreferredProtocol, AllProtocols)
+ end,
+ AdvertisedProtocols) of
+ undefined ->
+ DefaultProtocol;
+ PreferredProtocol ->
+ PreferredProtocol
+ end
+ end.
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/tls_connection.erl
index de9260fd8c..6a0461e805 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/tls_connection.erl
@@ -25,13 +25,13 @@
%% sent according to the SSL-record protocol.
%%----------------------------------------------------------------------
--module(ssl_connection).
+-module(tls_connection).
-behaviour(gen_fsm).
--include("ssl_handshake.hrl").
+-include("tls_handshake.hrl").
-include("ssl_alert.hrl").
--include("ssl_record.hrl").
+-include("tls_record.hrl").
-include("ssl_cipher.hrl").
-include("ssl_internal.hrl").
-include("ssl_srp.hrl").
@@ -70,7 +70,7 @@
tls_handshake_history, % tls_handshake_history()
tls_cipher_texts, % list() received but not deciphered yet
cert_db, %
- session, % #session{} from ssl_handshake.hrl
+ session, % #session{} from tls_handshake.hrl
session_cache, %
session_cache_cb, %
negotiated_version, % tls_version()
@@ -302,7 +302,7 @@ start_link(Role, Host, Port, Socket, Options, User, CbInfo) ->
init([Role, Host, Port, Socket, {SSLOpts0, _} = Options, User, CbInfo]) ->
State0 = initial_state(Role, Host, Port, Socket, Options, User, CbInfo),
- Handshake = ssl_handshake:init_handshake_history(),
+ Handshake = tls_handshake:init_handshake_history(),
TimeStamp = calendar:datetime_to_gregorian_seconds({date(), time()}),
try ssl_init(SSLOpts0, Role) of
{ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, OwnCert, Key, DHParams} ->
@@ -342,11 +342,11 @@ hello(start, #state{host = Host, port = Port, role = client,
transport_cb = Transport, socket = Socket,
connection_states = ConnectionStates0,
renegotiation = {Renegotiation, _}} = State0) ->
- Hello = ssl_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts,
+ Hello = tls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts,
Cache, CacheCb, Renegotiation, Cert),
Version = Hello#client_hello.client_version,
- Handshake0 = ssl_handshake:init_handshake_history(),
+ Handshake0 = tls_handshake:init_handshake_history(),
{BinMsg, ConnectionStates, Handshake} =
encode_handshake(Hello, Version, ConnectionStates0, Handshake0),
Transport:send(Socket, BinMsg),
@@ -374,7 +374,7 @@ hello(#server_hello{cipher_suite = CipherSuite,
negotiated_version = ReqVersion,
renegotiation = {Renegotiation, _},
ssl_options = SslOptions} = State0) ->
- case ssl_handshake:hello(Hello, SslOptions, ConnectionStates0, Renegotiation) of
+ case tls_handshake:hello(Hello, SslOptions, ConnectionStates0, Renegotiation) of
#alert{} = Alert ->
handle_own_alert(Alert, ReqVersion, hello, State0);
{Version, NewId, ConnectionStates, NextProtocol} ->
@@ -414,7 +414,7 @@ hello(Hello = #client_hello{client_version = ClientVersion},
session_cache = Cache,
session_cache_cb = CacheCb,
ssl_options = SslOpts}) ->
- case ssl_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb,
+ case tls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb,
ConnectionStates0, Cert}, Renegotiation) of
{Version, {Type, Session}, ConnectionStates, ProtocolsToAdvertise,
EcPointFormats, EllipticCurves} ->
@@ -448,11 +448,11 @@ abbreviated(#finished{verify_data = Data} = Finished,
session = #session{master_secret = MasterSecret},
connection_states = ConnectionStates0} =
State) ->
- case ssl_handshake:verify_connection(Version, Finished, client,
+ case tls_handshake:verify_connection(Version, Finished, client,
get_current_connection_state_prf(ConnectionStates0, write),
MasterSecret, Handshake) of
verified ->
- ConnectionStates = ssl_record:set_client_verify_data(current_both, Data, ConnectionStates0),
+ ConnectionStates = tls_record:set_client_verify_data(current_both, Data, ConnectionStates0),
next_state_connection(abbreviated,
ack_connection(State#state{connection_states = ConnectionStates}));
#alert{} = Alert ->
@@ -464,11 +464,11 @@ abbreviated(#finished{verify_data = Data} = Finished,
session = #session{master_secret = MasterSecret},
negotiated_version = Version,
connection_states = ConnectionStates0} = State) ->
- case ssl_handshake:verify_connection(Version, Finished, server,
+ case tls_handshake:verify_connection(Version, Finished, server,
get_pending_connection_state_prf(ConnectionStates0, write),
MasterSecret, Handshake0) of
verified ->
- ConnectionStates1 = ssl_record:set_server_verify_data(current_read, Data, ConnectionStates0),
+ ConnectionStates1 = tls_record:set_server_verify_data(current_read, Data, ConnectionStates0),
{ConnectionStates, Handshake} =
finalize_handshake(State#state{connection_states = ConnectionStates1}, abbreviated),
next_state_connection(abbreviated,
@@ -523,7 +523,7 @@ certify(#certificate{} = Cert,
cert_db = CertDbHandle,
cert_db_ref = CertDbRef,
ssl_options = Opts} = State) ->
- case ssl_handshake:certify(Cert, CertDbHandle, CertDbRef, Opts#ssl_options.depth,
+ case tls_handshake:certify(Cert, CertDbHandle, CertDbRef, Opts#ssl_options.depth,
Opts#ssl_options.verify,
Opts#ssl_options.verify_fun, Role) of
{PeerCert, PublicKeyInfo} ->
@@ -603,7 +603,7 @@ certify(#server_hello_done{},
negotiated_version = Version,
premaster_secret = undefined,
role = client} = State0) ->
- case ssl_handshake:master_secret(Version, Session,
+ case tls_handshake:master_secret(Version, Session,
ConnectionStates0, client) of
{MasterSecret, ConnectionStates} ->
State = State0#state{connection_states = ConnectionStates},
@@ -619,7 +619,7 @@ certify(#server_hello_done{},
negotiated_version = Version,
premaster_secret = PremasterSecret,
role = client} = State0) ->
- case ssl_handshake:master_secret(Version, PremasterSecret,
+ case tls_handshake:master_secret(Version, PremasterSecret,
ConnectionStates0, client) of
{MasterSecret, ConnectionStates} ->
Session = Session0#session{master_secret = MasterSecret},
@@ -640,7 +640,7 @@ certify(#client_key_exchange{} = Msg,
certify(#client_key_exchange{exchange_keys = Keys},
State = #state{key_algorithm = KeyAlg, negotiated_version = Version}) ->
try
- certify_client_key_exchange(ssl_handshake:decode_client_key(Keys, KeyAlg, Version), State)
+ certify_client_key_exchange(tls_handshake:decode_client_key(Keys, KeyAlg, Version), State)
catch
#alert{} = Alert ->
handle_own_alert(Alert, Version, certify, State)
@@ -658,8 +658,8 @@ certify_client_key_exchange(#encrypted_premaster_secret{premaster_secret= EncPMS
connection_states = ConnectionStates0,
session = Session0,
private_key = Key} = State0) ->
- PremasterSecret = ssl_handshake:decrypt_premaster_secret(EncPMS, Key),
- case ssl_handshake:master_secret(Version, PremasterSecret,
+ PremasterSecret = tls_handshake:decrypt_premaster_secret(EncPMS, Key),
+ case tls_handshake:master_secret(Version, PremasterSecret,
ConnectionStates0, server) of
{MasterSecret, ConnectionStates} ->
Session = Session0#session{master_secret = MasterSecret},
@@ -726,7 +726,7 @@ certify_client_key_exchange(#client_rsa_psk_identity{
#encrypted_premaster_secret{premaster_secret= EncPMS}},
#state{negotiated_version = Version,
private_key = Key} = State0) ->
- PremasterSecret = ssl_handshake:decrypt_premaster_secret(EncPMS, Key),
+ PremasterSecret = tls_handshake:decrypt_premaster_secret(EncPMS, Key),
case server_rsa_psk_master_secret(PskIdentity, PremasterSecret, State0) of
#state{} = State1 ->
{Record, State} = next_record(State1),
@@ -769,7 +769,7 @@ cipher(#certificate_verify{signature = Signature, hashsign_algorithm = CertHashS
{_, _} -> CertHashSign;
_ -> ConnectionHashSign
end,
- case ssl_handshake:certificate_verify(Signature, PublicKeyInfo,
+ case tls_handshake:certificate_verify(Signature, PublicKeyInfo,
Version, HashSign, MasterSecret, Handshake) of
valid ->
{Record, State} = next_record(State0),
@@ -792,7 +792,7 @@ cipher(#finished{verify_data = Data} = Finished,
= Session0,
connection_states = ConnectionStates0,
tls_handshake_history = Handshake0} = State) ->
- case ssl_handshake:verify_connection(Version, Finished,
+ case tls_handshake:verify_connection(Version, Finished,
opposite_role(Role),
get_current_connection_state_prf(ConnectionStates0, read),
MasterSecret, Handshake0) of
@@ -830,7 +830,7 @@ connection(#hello_request{}, #state{host = Host, port = Port,
connection_states = ConnectionStates0,
renegotiation = {Renegotiation, _},
tls_handshake_history = Handshake0} = State0) ->
- Hello = ssl_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts,
+ Hello = tls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts,
Cache, CacheCb, Renegotiation, Cert),
{BinMsg, ConnectionStates, Handshake} =
@@ -1025,7 +1025,7 @@ handle_sync_event({prf, Secret, Label, Seed, WantedLength}, _, StateName,
#state{connection_states = ConnectionStates,
negotiated_version = Version} = State) ->
ConnectionState =
- ssl_record:current_connection_state(ConnectionStates, read),
+ tls_record:current_connection_state(ConnectionStates, read),
SecParams = ConnectionState#connection_state.security_parameters,
#security_parameters{master_secret = MasterSecret,
client_random = ClientRandom,
@@ -1040,7 +1040,7 @@ handle_sync_event({prf, Secret, Label, Seed, WantedLength}, _, StateName,
(client_random, Acc) -> [ClientRandom|Acc];
(server_random, Acc) -> [ServerRandom|Acc]
end, [], Seed)),
- ssl_handshake:prf(Version, SecretToUse, Label, SeedToUse, WantedLength)
+ tls_handshake:prf(Version, SecretToUse, Label, SeedToUse, WantedLength)
catch
exit:_ -> {error, badarg};
error:Reason -> {error, Reason}
@@ -1051,7 +1051,7 @@ handle_sync_event(info, _, StateName,
#state{negotiated_version = Version,
session = #session{cipher_suite = Suite}} = State) ->
- AtomVersion = ssl_record:protocol_version(Version),
+ AtomVersion = tls_record:protocol_version(Version),
{reply, {ok, {AtomVersion, ssl:suite_definition(Suite)}},
StateName, State, get_timeout(State)};
@@ -1397,7 +1397,7 @@ certify_client(#state{client_certificate_requested = true, role = client,
session = #session{own_certificate = OwnCert},
socket = Socket,
tls_handshake_history = Handshake0} = State) ->
- Certificate = ssl_handshake:certificate(OwnCert, CertDbHandle, CertDbRef, client),
+ Certificate = tls_handshake:certificate(OwnCert, CertDbHandle, CertDbRef, client),
{BinCert, ConnectionStates, Handshake} =
encode_handshake(Certificate, Version, ConnectionStates0, Handshake0),
Transport:send(Socket, BinCert),
@@ -1418,7 +1418,7 @@ verify_client_cert(#state{client_certificate_requested = true, role = client,
tls_handshake_history = Handshake0} = State) ->
%%TODO: for TLS 1.2 we can choose a different/stronger HashSign combination for this.
- case ssl_handshake:client_certificate_verify(OwnCert, MasterSecret,
+ case tls_handshake:client_certificate_verify(OwnCert, MasterSecret,
Version, HashSign, PrivateKey, Handshake0) of
#certificate_verify{} = Verified ->
{BinVerified, ConnectionStates, Handshake} =
@@ -1444,7 +1444,7 @@ do_server_hello(Type, NextProtocolsToSend,
= State0) when is_atom(Type) ->
ServerHello =
- ssl_handshake:server_hello(SessId, Version,
+ tls_handshake:server_hello(SessId, Version,
ConnectionStates0, Renegotiation,
NextProtocolsToSend, EcPointFormats, EllipticCurves),
State = server_hello(ServerHello,
@@ -1480,7 +1480,7 @@ resumed_server_hello(#state{session = Session,
connection_states = ConnectionStates0,
negotiated_version = Version} = State0) ->
- case ssl_handshake:master_secret(Version, Session,
+ case tls_handshake:master_secret(Version, Session,
ConnectionStates0, server) of
{_, ConnectionStates1} ->
State1 = State0#state{connection_states = ConnectionStates1,
@@ -1509,7 +1509,7 @@ handle_resumed_session(SessId, #state{connection_states = ConnectionStates0,
session_cache = Cache,
session_cache_cb = CacheCb} = State0) ->
Session = CacheCb:lookup(Cache, {{Host, Port}, SessId}),
- case ssl_handshake:master_secret(Version, Session,
+ case tls_handshake:master_secret(Version, Session,
ConnectionStates0, client) of
{_, ConnectionStates} ->
{Record, State} =
@@ -1569,7 +1569,7 @@ server_hello_done(#state{transport_cb = Transport,
connection_states = ConnectionStates0,
tls_handshake_history = Handshake0} = State) ->
- HelloDone = ssl_handshake:server_hello_done(),
+ HelloDone = tls_handshake:server_hello_done(),
{BinHelloDone, ConnectionStates, Handshake} =
encode_handshake(HelloDone, Version, ConnectionStates0, Handshake0),
@@ -1589,7 +1589,7 @@ certify_server(#state{transport_cb = Transport,
cert_db = CertDbHandle,
cert_db_ref = CertDbRef,
session = #session{own_certificate = OwnCert}} = State) ->
- case ssl_handshake:certificate(OwnCert, CertDbHandle, CertDbRef, server) of
+ case tls_handshake:certificate(OwnCert, CertDbHandle, CertDbRef, server) of
CertMsg = #certificate{} ->
{BinCertMsg, ConnectionStates, Handshake} =
encode_handshake(CertMsg, Version, ConnectionStates0, Handshake0),
@@ -1618,11 +1618,11 @@ key_exchange(#state{role = server, key_algorithm = Algo,
Algo == dh_anon ->
DHKeys = public_key:generate_key(Params),
ConnectionState =
- ssl_record:pending_connection_state(ConnectionStates0, read),
+ tls_record:pending_connection_state(ConnectionStates0, read),
SecParams = ConnectionState#connection_state.security_parameters,
#security_parameters{client_random = ClientRandom,
server_random = ServerRandom} = SecParams,
- Msg = ssl_handshake:key_exchange(server, Version, {dh, DHKeys, Params,
+ Msg = tls_handshake:key_exchange(server, Version, {dh, DHKeys, Params,
HashSignAlgo, ClientRandom,
ServerRandom,
PrivateKey}),
@@ -1650,11 +1650,11 @@ key_exchange(#state{role = server, key_algorithm = Algo,
ECDHKeys = public_key:generate_key(select_curve(State)),
ConnectionState =
- ssl_record:pending_connection_state(ConnectionStates0, read),
+ tls_record:pending_connection_state(ConnectionStates0, read),
SecParams = ConnectionState#connection_state.security_parameters,
#security_parameters{client_random = ClientRandom,
server_random = ServerRandom} = SecParams,
- Msg = ssl_handshake:key_exchange(server, Version, {ecdh, ECDHKeys,
+ Msg = tls_handshake:key_exchange(server, Version, {ecdh, ECDHKeys,
HashSignAlgo, ClientRandom,
ServerRandom,
PrivateKey}),
@@ -1679,14 +1679,14 @@ key_exchange(#state{role = server, key_algorithm = psk,
transport_cb = Transport
} = State) ->
ConnectionState =
- ssl_record:pending_connection_state(ConnectionStates0, read),
+ tls_record:pending_connection_state(ConnectionStates0, read),
SecParams = ConnectionState#connection_state.security_parameters,
#security_parameters{client_random = ClientRandom,
server_random = ServerRandom} = SecParams,
- Msg = ssl_handshake:key_exchange(server, Version, {psk, PskIdentityHint,
- HashSignAlgo, ClientRandom,
- ServerRandom,
- PrivateKey}),
+ Msg = tls_handshake:key_exchange(server, Version, {psk, PskIdentityHint,
+ HashSignAlgo, ClientRandom,
+ ServerRandom,
+ PrivateKey}),
{BinMsg, ConnectionStates, Handshake} =
encode_handshake(Msg, Version, ConnectionStates0, Handshake0),
Transport:send(Socket, BinMsg),
@@ -1706,11 +1706,11 @@ key_exchange(#state{role = server, key_algorithm = dhe_psk,
} = State) ->
DHKeys = public_key:generate_key(Params),
ConnectionState =
- ssl_record:pending_connection_state(ConnectionStates0, read),
+ tls_record:pending_connection_state(ConnectionStates0, read),
SecParams = ConnectionState#connection_state.security_parameters,
#security_parameters{client_random = ClientRandom,
server_random = ServerRandom} = SecParams,
- Msg = ssl_handshake:key_exchange(server, Version, {dhe_psk, PskIdentityHint, DHKeys, Params,
+ Msg = tls_handshake:key_exchange(server, Version, {dhe_psk, PskIdentityHint, DHKeys, Params,
HashSignAlgo, ClientRandom,
ServerRandom,
PrivateKey}),
@@ -1735,11 +1735,11 @@ key_exchange(#state{role = server, key_algorithm = rsa_psk,
transport_cb = Transport
} = State) ->
ConnectionState =
- ssl_record:pending_connection_state(ConnectionStates0, read),
+ tls_record:pending_connection_state(ConnectionStates0, read),
SecParams = ConnectionState#connection_state.security_parameters,
#security_parameters{client_random = ClientRandom,
server_random = ServerRandom} = SecParams,
- Msg = ssl_handshake:key_exchange(server, Version, {psk, PskIdentityHint,
+ Msg = tls_handshake:key_exchange(server, Version, {psk, PskIdentityHint,
HashSignAlgo, ClientRandom,
ServerRandom,
PrivateKey}),
@@ -1771,11 +1771,11 @@ key_exchange(#state{role = server, key_algorithm = Algo,
Keys0
end,
ConnectionState =
- ssl_record:pending_connection_state(ConnectionStates0, read),
+ tls_record:pending_connection_state(ConnectionStates0, read),
SecParams = ConnectionState#connection_state.security_parameters,
#security_parameters{client_random = ClientRandom,
server_random = ServerRandom} = SecParams,
- Msg = ssl_handshake:key_exchange(server, Version, {srp, Keys, SrpParams,
+ Msg = tls_handshake:key_exchange(server, Version, {srp, Keys, SrpParams,
HashSignAlgo, ClientRandom,
ServerRandom,
PrivateKey}),
@@ -1811,7 +1811,7 @@ key_exchange(#state{role = client,
when Algorithm == dhe_dss;
Algorithm == dhe_rsa;
Algorithm == dh_anon ->
- Msg = ssl_handshake:key_exchange(client, Version, {dh, DhPubKey}),
+ Msg = tls_handshake:key_exchange(client, Version, {dh, DhPubKey}),
{BinMsg, ConnectionStates, Handshake} =
encode_handshake(Msg, Version, ConnectionStates0, Handshake0),
Transport:send(Socket, BinMsg),
@@ -1828,7 +1828,7 @@ key_exchange(#state{role = client,
when Algorithm == ecdhe_ecdsa; Algorithm == ecdhe_rsa;
Algorithm == ecdh_ecdsa; Algorithm == ecdh_rsa;
Algorithm == ecdh_anon ->
- Msg = ssl_handshake:key_exchange(client, Version, {ecdh, Keys}),
+ Msg = tls_handshake:key_exchange(client, Version, {ecdh, Keys}),
{BinMsg, ConnectionStates, Handshake} =
encode_handshake(Msg, Version, ConnectionStates0, Handshake0),
Transport:send(Socket, BinMsg),
@@ -1842,7 +1842,7 @@ key_exchange(#state{role = client,
negotiated_version = Version,
socket = Socket, transport_cb = Transport,
tls_handshake_history = Handshake0} = State) ->
- Msg = ssl_handshake:key_exchange(client, Version, {psk, SslOpts#ssl_options.psk_identity}),
+ Msg = tls_handshake:key_exchange(client, Version, {psk, SslOpts#ssl_options.psk_identity}),
{BinMsg, ConnectionStates, Handshake} =
encode_handshake(Msg, Version, ConnectionStates0, Handshake0),
Transport:send(Socket, BinMsg),
@@ -1857,7 +1857,7 @@ key_exchange(#state{role = client,
diffie_hellman_keys = {DhPubKey, _},
socket = Socket, transport_cb = Transport,
tls_handshake_history = Handshake0} = State) ->
- Msg = ssl_handshake:key_exchange(client, Version, {dhe_psk, SslOpts#ssl_options.psk_identity, DhPubKey}),
+ Msg = tls_handshake:key_exchange(client, Version, {dhe_psk, SslOpts#ssl_options.psk_identity, DhPubKey}),
{BinMsg, ConnectionStates, Handshake} =
encode_handshake(Msg, Version, ConnectionStates0, Handshake0),
Transport:send(Socket, BinMsg),
@@ -1890,7 +1890,7 @@ key_exchange(#state{role = client,
when Algorithm == srp_dss;
Algorithm == srp_rsa;
Algorithm == srp_anon ->
- Msg = ssl_handshake:key_exchange(client, Version, {srp, ClientPubKey}),
+ Msg = tls_handshake:key_exchange(client, Version, {srp, ClientPubKey}),
{BinMsg, ConnectionStates, Handshake} =
encode_handshake(Msg, Version, ConnectionStates0, Handshake0),
Transport:send(Socket, BinMsg),
@@ -1907,7 +1907,7 @@ rsa_key_exchange(Version, PremasterSecret, PublicKeyInfo = {Algorithm, _, _})
Algorithm == ?sha384WithRSAEncryption;
Algorithm == ?sha512WithRSAEncryption
->
- ssl_handshake:key_exchange(client, Version,
+ tls_handshake:key_exchange(client, Version,
{premaster_secret, PremasterSecret,
PublicKeyInfo});
rsa_key_exchange(_, _, _) ->
@@ -1923,7 +1923,7 @@ rsa_psk_key_exchange(Version, PskIdentity, PremasterSecret, PublicKeyInfo = {Alg
Algorithm == ?sha384WithRSAEncryption;
Algorithm == ?sha512WithRSAEncryption
->
- ssl_handshake:key_exchange(client, Version,
+ tls_handshake:key_exchange(client, Version,
{psk_premaster_secret, PskIdentity, PremasterSecret,
PublicKeyInfo});
rsa_psk_key_exchange(_, _, _, _) ->
@@ -1937,7 +1937,7 @@ request_client_cert(#state{ssl_options = #ssl_options{verify = verify_peer},
negotiated_version = Version,
socket = Socket,
transport_cb = Transport} = State) ->
- Msg = ssl_handshake:certificate_request(ConnectionStates0, CertDbHandle, CertDbRef),
+ Msg = tls_handshake:certificate_request(ConnectionStates0, CertDbHandle, CertDbRef),
{BinMsg, ConnectionStates, Handshake} =
encode_handshake(Msg, Version, ConnectionStates0, Handshake0),
Transport:send(Socket, BinMsg),
@@ -1952,7 +1952,7 @@ finalize_handshake(State, StateName) ->
ConnectionStates0 = cipher_protocol(State),
ConnectionStates =
- ssl_record:activate_pending_connection_state(ConnectionStates0,
+ tls_record:activate_pending_connection_state(ConnectionStates0,
write),
State1 = State#state{connection_states = ConnectionStates},
@@ -1970,7 +1970,7 @@ next_protocol(#state{transport_cb = Transport, socket = Socket,
next_protocol = NextProtocol,
connection_states = ConnectionStates0,
tls_handshake_history = Handshake0} = State) ->
- NextProtocolMessage = ssl_handshake:next_protocol(NextProtocol),
+ NextProtocolMessage = tls_handshake:next_protocol(NextProtocol),
{BinMsg, ConnectionStates, Handshake} = encode_handshake(NextProtocolMessage, Version, ConnectionStates0, Handshake0),
Transport:send(Socket, BinMsg),
State#state{connection_states = ConnectionStates,
@@ -1992,7 +1992,7 @@ finished(#state{role = Role, socket = Socket, negotiated_version = Version,
connection_states = ConnectionStates0,
tls_handshake_history = Handshake0}, StateName) ->
MasterSecret = Session#session.master_secret,
- Finished = ssl_handshake:finished(Version, Role,
+ Finished = tls_handshake:finished(Version, Role,
get_current_connection_state_prf(ConnectionStates0, write),
MasterSecret, Handshake0),
ConnectionStates1 = save_verify_data(Role, Finished, ConnectionStates0, StateName),
@@ -2002,18 +2002,18 @@ finished(#state{role = Role, socket = Socket, negotiated_version = Version,
{ConnectionStates, Handshake}.
save_verify_data(client, #finished{verify_data = Data}, ConnectionStates, certify) ->
- ssl_record:set_client_verify_data(current_write, Data, ConnectionStates);
+ tls_record:set_client_verify_data(current_write, Data, ConnectionStates);
save_verify_data(server, #finished{verify_data = Data}, ConnectionStates, cipher) ->
- ssl_record:set_server_verify_data(current_both, Data, ConnectionStates);
+ tls_record:set_server_verify_data(current_both, Data, ConnectionStates);
save_verify_data(client, #finished{verify_data = Data}, ConnectionStates, abbreviated) ->
- ssl_record:set_client_verify_data(current_both, Data, ConnectionStates);
+ tls_record:set_client_verify_data(current_both, Data, ConnectionStates);
save_verify_data(server, #finished{verify_data = Data}, ConnectionStates, abbreviated) ->
- ssl_record:set_server_verify_data(current_write, Data, ConnectionStates).
+ tls_record:set_server_verify_data(current_write, Data, ConnectionStates).
handle_server_key(#server_key_exchange{exchange_keys = Keys},
#state{key_algorithm = KeyAlg,
negotiated_version = Version} = State) ->
- Params = ssl_handshake:decode_server_key(Keys, KeyAlg, Version),
+ Params = tls_handshake:decode_server_key(Keys, KeyAlg, Version),
HashSign = connection_hashsign(Params#server_key_params.hashsign, State),
case HashSign of
{_, SignAlgo} when SignAlgo == anon; SignAlgo == ecdh_anon ->
@@ -2030,15 +2030,15 @@ verify_server_key(#server_key_params{params = Params,
public_key_info = PubKeyInfo,
connection_states = ConnectionStates} = State) ->
ConnectionState =
- ssl_record:pending_connection_state(ConnectionStates, read),
+ tls_record:pending_connection_state(ConnectionStates, read),
SecParams = ConnectionState#connection_state.security_parameters,
#security_parameters{client_random = ClientRandom,
server_random = ServerRandom} = SecParams,
- Hash = ssl_handshake:server_key_exchange_hash(HashAlgo,
+ Hash = tls_handshake:server_key_exchange_hash(HashAlgo,
<<ClientRandom/binary,
ServerRandom/binary,
EncParams/binary>>),
- case ssl_handshake:verify_signature(Version, Hash, HashSign, Signature, PubKeyInfo) of
+ case tls_handshake:verify_signature(Version, Hash, HashSign, Signature, PubKeyInfo) of
true ->
server_master_secret(Params, State);
false ->
@@ -2074,7 +2074,7 @@ master_from_premaster_secret(PremasterSecret,
#state{session = Session,
negotiated_version = Version, role = Role,
connection_states = ConnectionStates0} = State) ->
- case ssl_handshake:master_secret(Version, PremasterSecret,
+ case tls_handshake:master_secret(Version, PremasterSecret,
ConnectionStates0, Role) of
{MasterSecret, ConnectionStates} ->
State#state{
@@ -2227,12 +2227,12 @@ client_srp_master_secret(Generator, Prime, Salt, ServerPub, ClientKeys,
end.
cipher_role(client, Data, Session, #state{connection_states = ConnectionStates0} = State) ->
- ConnectionStates = ssl_record:set_server_verify_data(current_both, Data, ConnectionStates0),
+ ConnectionStates = tls_record:set_server_verify_data(current_both, Data, ConnectionStates0),
next_state_connection(cipher, ack_connection(State#state{session = Session,
connection_states = ConnectionStates}));
cipher_role(server, Data, Session, #state{connection_states = ConnectionStates0} = State) ->
- ConnectionStates1 = ssl_record:set_client_verify_data(current_read, Data, ConnectionStates0),
+ ConnectionStates1 = tls_record:set_client_verify_data(current_read, Data, ConnectionStates0),
{ConnectionStates, Handshake} =
finalize_handshake(State#state{connection_states = ConnectionStates1,
session = Session}, cipher),
@@ -2242,16 +2242,16 @@ cipher_role(server, Data, Session, #state{connection_states = ConnectionStates0
tls_handshake_history =
Handshake})).
encode_alert(#alert{} = Alert, Version, ConnectionStates) ->
- ssl_record:encode_alert_record(Alert, Version, ConnectionStates).
+ tls_record:encode_alert_record(Alert, Version, ConnectionStates).
encode_change_cipher(#change_cipher_spec{}, Version, ConnectionStates) ->
- ssl_record:encode_change_cipher_spec(Version, ConnectionStates).
+ tls_record:encode_change_cipher_spec(Version, ConnectionStates).
encode_handshake(HandshakeRec, Version, ConnectionStates0, Handshake0) ->
- Frag = ssl_handshake:encode_handshake(HandshakeRec, Version),
- Handshake1 = ssl_handshake:update_handshake_history(Handshake0, Frag),
+ Frag = tls_handshake:encode_handshake(HandshakeRec, Version),
+ Handshake1 = tls_handshake:update_handshake_history(Handshake0, Frag),
{E, ConnectionStates1} =
- ssl_record:encode_handshake(Frag, Version, ConnectionStates0),
+ tls_record:encode_handshake(Frag, Version, ConnectionStates0),
{E, ConnectionStates1, Handshake1}.
encode_packet(Data, #socket_options{packet=Packet}) ->
@@ -2346,7 +2346,7 @@ write_application_data(Data0, From, #state{socket = Socket,
renegotiate(State#state{send_queue = queue:in_r({From, Data}, SendQueue),
renegotiation = {true, internal}});
false ->
- {Msgs, ConnectionStates} = ssl_record:encode_data(Data, Version, ConnectionStates0),
+ {Msgs, ConnectionStates} = tls_record:encode_data(Data, Version, ConnectionStates0),
Result = Transport:send(Socket, Msgs),
{reply, Result,
connection, State#state{connection_states = ConnectionStates}, get_timeout(State)}
@@ -2514,7 +2514,7 @@ next_state(Current, Next, #ssl_tls{type = ?HANDSHAKE, fragment = Data},
fun({#hello_request{} = Packet, _}, {next_state, connection = SName, State}) ->
%% This message should not be included in handshake
%% message hashes. Starts new handshake (renegotiation)
- Hs0 = ssl_handshake:init_handshake_history(),
+ Hs0 = tls_handshake:init_handshake_history(),
?MODULE:SName(Packet, State#state{tls_handshake_history=Hs0,
renegotiation = {true, peer}});
({#hello_request{} = Packet, _}, {next_state, SName, State}) ->
@@ -2523,17 +2523,17 @@ next_state(Current, Next, #ssl_tls{type = ?HANDSHAKE, fragment = Data},
?MODULE:SName(Packet, State);
({#client_hello{} = Packet, Raw}, {next_state, connection = SName, State}) ->
Version = Packet#client_hello.client_version,
- Hs0 = ssl_handshake:init_handshake_history(),
- Hs1 = ssl_handshake:update_handshake_history(Hs0, Raw),
+ Hs0 = tls_handshake:init_handshake_history(),
+ Hs1 = tls_handshake:update_handshake_history(Hs0, Raw),
?MODULE:SName(Packet, State#state{tls_handshake_history=Hs1,
renegotiation = {true, peer}});
({Packet, Raw}, {next_state, SName, State = #state{tls_handshake_history=Hs0}}) ->
- Hs1 = ssl_handshake:update_handshake_history(Hs0, Raw),
+ Hs1 = tls_handshake:update_handshake_history(Hs0, Raw),
?MODULE:SName(Packet, State#state{tls_handshake_history=Hs1});
(_, StopState) -> StopState
end,
try
- {Packets, Buf} = ssl_handshake:get_tls_handshake(Version,Data,Buf0),
+ {Packets, Buf} = tls_handshake:get_tls_handshake(Version,Data,Buf0),
State = State0#state{tls_packets = Packets, tls_handshake_buffer = Buf},
handle_tls_handshake(Handle, Next, State)
catch throw:#alert{} = Alert ->
@@ -2551,7 +2551,7 @@ next_state(Current, Next, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = <<1>>}
_ChangeCipher,
#state{connection_states = ConnectionStates0} = State0) ->
ConnectionStates1 =
- ssl_record:activate_pending_connection_state(ConnectionStates0, read),
+ tls_record:activate_pending_connection_state(ConnectionStates0, read),
{Record, State} = next_record(State0#state{connection_states = ConnectionStates1}),
next_state(Current, Next, Record, State);
next_state(Current, Next, #ssl_tls{type = _Unknown}, State0) ->
@@ -2561,7 +2561,7 @@ next_state(Current, Next, #ssl_tls{type = _Unknown}, State0) ->
next_tls_record(Data, #state{tls_record_buffer = Buf0,
tls_cipher_texts = CT0} = State0) ->
- case ssl_record:get_tls_records(Data, Buf0) of
+ case tls_record:get_tls_records(Data, Buf0) of
{Records, Buf1} ->
CT1 = CT0 ++ Records,
next_record(State0#state{tls_record_buffer = Buf1,
@@ -2576,7 +2576,7 @@ next_record(#state{tls_packets = [], tls_cipher_texts = [], socket = Socket,
{no_record, State};
next_record(#state{tls_packets = [], tls_cipher_texts = [CT | Rest],
connection_states = ConnStates0} = State) ->
- case ssl_record:decode_cipher_text(CT, ConnStates0) of
+ case tls_record:decode_cipher_text(CT, ConnStates0) of
{Plain, ConnStates} ->
{Plain, State#state{tls_cipher_texts = Rest, connection_states = ConnStates}};
#alert{} = Alert ->
@@ -2603,7 +2603,7 @@ next_state_connection(StateName, #state{send_queue = Queue0,
case queue:out(Queue0) of
{{value, {From, Data}}, Queue} ->
{Msgs, ConnectionStates} =
- ssl_record:encode_data(Data, Version, ConnectionStates0),
+ tls_record:encode_data(Data, Version, ConnectionStates0),
Result = Transport:send(Socket, Msgs),
gen_fsm:reply(From, Result),
next_state_connection(StateName,
@@ -2622,13 +2622,13 @@ next_state_is_connection(_, State =
#socket_options{active = false}}) when RecvFrom =/= undefined ->
passive_receive(State#state{premaster_secret = undefined,
public_key_info = undefined,
- tls_handshake_history = ssl_handshake:init_handshake_history()}, connection);
+ tls_handshake_history = tls_handshake:init_handshake_history()}, connection);
next_state_is_connection(StateName, State0) ->
{Record, State} = next_record_if_active(State0),
next_state(StateName, connection, Record, State#state{premaster_secret = undefined,
public_key_info = undefined,
- tls_handshake_history = ssl_handshake:init_handshake_history()}).
+ tls_handshake_history = tls_handshake:init_handshake_history()}).
register_session(client, Host, Port, #session{is_resumable = new} = Session0) ->
Session = Session0#session{is_resumable = true},
@@ -2648,7 +2648,7 @@ invalidate_session(server, _, Port, Session) ->
initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User,
{CbModule, DataTag, CloseTag, ErrorTag}) ->
- ConnectionStates = ssl_record:init_connection_states(Role),
+ ConnectionStates = tls_record:init_connection_states(Role),
SessionCacheCb = case application:get_env(ssl, session_cb) of
{ok, Cb} when is_atom(Cb) ->
@@ -2905,18 +2905,18 @@ ack_connection(State) ->
renegotiate(#state{role = client} = State) ->
%% Handle same way as if server requested
%% the renegotiation
- Hs0 = ssl_handshake:init_handshake_history(),
+ Hs0 = tls_handshake:init_handshake_history(),
connection(#hello_request{}, State#state{tls_handshake_history = Hs0});
renegotiate(#state{role = server,
socket = Socket,
transport_cb = Transport,
negotiated_version = Version,
connection_states = ConnectionStates0} = State0) ->
- HelloRequest = ssl_handshake:hello_request(),
- Frag = ssl_handshake:encode_handshake(HelloRequest, Version),
- Hs0 = ssl_handshake:init_handshake_history(),
+ HelloRequest = tls_handshake:hello_request(),
+ Frag = tls_handshake:encode_handshake(HelloRequest, Version),
+ Hs0 = tls_handshake:init_handshake_history(),
{BinMsg, ConnectionStates} =
- ssl_record:encode_handshake(Frag, Version, ConnectionStates0),
+ tls_record:encode_handshake(Frag, Version, ConnectionStates0),
Transport:send(Socket, BinMsg),
{Record, State} = next_record(State0#state{connection_states =
ConnectionStates,
@@ -2976,14 +2976,14 @@ handle_trusted_certs_db(#state{cert_db_ref = Ref,
ssl_options = #ssl_options{cacertfile = undefined}}) ->
%% Certs provided as DER directly can not be shared
%% with other connections and it is safe to delete them when the connection ends.
- ssl_certificate_db:remove_trusted_certs(Ref, CertDb);
+ ssl_pkix_db:remove_trusted_certs(Ref, CertDb);
handle_trusted_certs_db(#state{file_ref_db = undefined}) ->
%% Something went wrong early (typically cacertfile does not exist) so there is nothing to handle
ok;
handle_trusted_certs_db(#state{cert_db_ref = Ref,
file_ref_db = RefDb,
ssl_options = #ssl_options{cacertfile = File}}) ->
- case ssl_certificate_db:ref_count(Ref, RefDb, -1) of
+ case ssl_pkix_db:ref_count(Ref, RefDb, -1) of
0 ->
ssl_manager:clean_cert_db(Ref, File);
_ ->
@@ -2991,10 +2991,10 @@ handle_trusted_certs_db(#state{cert_db_ref = Ref,
end.
get_current_connection_state_prf(CStates, Direction) ->
- CS = ssl_record:current_connection_state(CStates, Direction),
+ CS = tls_record:current_connection_state(CStates, Direction),
CS#connection_state.security_parameters#security_parameters.prf_algorithm.
get_pending_connection_state_prf(CStates, Direction) ->
- CS = ssl_record:pending_connection_state(CStates, Direction),
+ CS = tls_record:pending_connection_state(CStates, Direction),
CS#connection_state.security_parameters#security_parameters.prf_algorithm.
connection_hashsign(HashSign = {_, _}, _State) ->
diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/tls_handshake.erl
index 24ea86311f..fea75736f7 100644
--- a/lib/ssl/src/ssl_handshake.erl
+++ b/lib/ssl/src/tls_handshake.erl
@@ -21,10 +21,10 @@
%% Purpose: Help funtions for handling the SSL-handshake protocol
%%----------------------------------------------------------------------
--module(ssl_handshake).
+-module(tls_handshake).
--include("ssl_handshake.hrl").
--include("ssl_record.hrl").
+-include("tls_handshake.hrl").
+-include("tls_record.hrl").
-include("ssl_cipher.hrl").
-include("ssl_alert.hrl").
-include("ssl_internal.hrl").
@@ -64,8 +64,8 @@ client_hello(Host, Port, ConnectionStates,
ciphers = UserSuites
} = SslOpts,
Cache, CacheCb, Renegotiation, OwnCert) ->
- Version = ssl_record:highest_protocol_version(Versions),
- Pending = ssl_record:pending_connection_state(ConnectionStates, read),
+ Version = tls_record:highest_protocol_version(Versions),
+ Pending = tls_record:pending_connection_state(ConnectionStates, read),
SecParams = Pending#connection_state.security_parameters,
Ciphers = available_suites(UserSuites, Version),
SRP = srp_user(SslOpts),
@@ -76,7 +76,7 @@ client_hello(Host, Port, ConnectionStates,
#client_hello{session_id = Id,
client_version = Version,
cipher_suites = cipher_suites(Ciphers, Renegotiation),
- compression_methods = ssl_record:compressions(),
+ compression_methods = tls_record:compressions(),
random = SecParams#security_parameters.client_random,
renegotiation_info =
@@ -109,7 +109,7 @@ encode_protocols_advertised_on_server(Protocols) ->
%%--------------------------------------------------------------------
server_hello(SessionId, Version, ConnectionStates, Renegotiation,
ProtocolsAdvertisedOnServer, EcPointFormats, EllipticCurves) ->
- Pending = ssl_record:pending_connection_state(ConnectionStates, read),
+ Pending = tls_record:pending_connection_state(ConnectionStates, read),
SecParams = Pending#connection_state.security_parameters,
#server_hello{server_version = Version,
cipher_suite = SecParams#security_parameters.cipher_suite,
@@ -153,7 +153,7 @@ hello(#server_hello{cipher_suite = CipherSuite, server_version = Version,
versions = SupportedVersions},
ConnectionStates0, Renegotiation) ->
%%TODO: select hash and signature algorigthm
- case ssl_record:is_acceptable_version(Version, SupportedVersions) of
+ case tls_record:is_acceptable_version(Version, SupportedVersions) of
true ->
case handle_renegotiation_info(client, Info, ConnectionStates0,
Renegotiation, SecureRenegotation, []) of
@@ -179,7 +179,7 @@ hello(#client_hello{client_version = ClientVersion} = Hello,
{Port, Session0, Cache, CacheCb, ConnectionStates0, Cert}, Renegotiation) ->
%% TODO: select hash and signature algorithm
Version = select_version(ClientVersion, Versions),
- case ssl_record:is_acceptable_version(Version, Versions) of
+ case tls_record:is_acceptable_version(Version, Versions) of
true ->
%% TODO: need to take supported Curves into Account when selecting the CipherSuite....
%% if whe have an ECDSA cert with an unsupported curve, we need to drop ECDSA ciphers
@@ -357,7 +357,7 @@ verify_signature(_Version, Hash, {HashAlgo, ecdsa}, Signature, {?'id-ecPublicKey
certificate_request(ConnectionStates, CertDbHandle, CertDbRef) ->
#connection_state{security_parameters =
#security_parameters{cipher_suite = CipherSuite}} =
- ssl_record:pending_connection_state(ConnectionStates, read),
+ tls_record:pending_connection_state(ConnectionStates, read),
Types = certificate_types(CipherSuite),
HashSigns = default_hash_signs(),
Authorities = certificate_authorities(CertDbHandle, CertDbRef),
@@ -499,7 +499,7 @@ enc_server_key_exchange(Version, Params, {HashAlgo, SignAlgo},
master_secret(Version, #session{master_secret = Mastersecret},
ConnectionStates, Role) ->
ConnectionState =
- ssl_record:pending_connection_state(ConnectionStates, read),
+ tls_record:pending_connection_state(ConnectionStates, read),
SecParams = ConnectionState#connection_state.security_parameters,
try master_secret(Version, Mastersecret, SecParams,
ConnectionStates, Role)
@@ -513,7 +513,7 @@ master_secret(Version, #session{master_secret = Mastersecret},
master_secret(Version, PremasterSecret, ConnectionStates, Role) ->
ConnectionState =
- ssl_record:pending_connection_state(ConnectionStates, read),
+ tls_record:pending_connection_state(ConnectionStates, read),
SecParams = ConnectionState#connection_state.security_parameters,
#security_parameters{prf_algorithm = PrfAlgo,
client_random = ClientRandom,
@@ -760,7 +760,7 @@ srp_user(_) ->
renegotiation_info(client, _, false) ->
#renegotiation_info{renegotiated_connection = undefined};
renegotiation_info(server, ConnectionStates, false) ->
- CS = ssl_record:current_connection_state(ConnectionStates, read),
+ CS = tls_record:current_connection_state(ConnectionStates, read),
case CS#connection_state.secure_renegotiation of
true ->
#renegotiation_info{renegotiated_connection = ?byte(0)};
@@ -768,7 +768,7 @@ renegotiation_info(server, ConnectionStates, false) ->
#renegotiation_info{renegotiated_connection = undefined}
end;
renegotiation_info(client, ConnectionStates, true) ->
- CS = ssl_record:current_connection_state(ConnectionStates, read),
+ CS = tls_record:current_connection_state(ConnectionStates, read),
case CS#connection_state.secure_renegotiation of
true ->
Data = CS#connection_state.client_verify_data,
@@ -778,7 +778,7 @@ renegotiation_info(client, ConnectionStates, true) ->
end;
renegotiation_info(server, ConnectionStates, true) ->
- CS = ssl_record:current_connection_state(ConnectionStates, read),
+ CS = tls_record:current_connection_state(ConnectionStates, read),
case CS#connection_state.secure_renegotiation of
true ->
CData = CS#connection_state.client_verify_data,
@@ -873,22 +873,22 @@ handle_ecc_curves_extension(Version, _) ->
handle_renegotiation_info(_, #renegotiation_info{renegotiated_connection = ?byte(0)},
ConnectionStates, false, _, _) ->
- {ok, ssl_record:set_renegotiation_flag(true, ConnectionStates)};
+ {ok, tls_record:set_renegotiation_flag(true, ConnectionStates)};
handle_renegotiation_info(server, undefined, ConnectionStates, _, _, CipherSuites) ->
case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of
true ->
- {ok, ssl_record:set_renegotiation_flag(true, ConnectionStates)};
+ {ok, tls_record:set_renegotiation_flag(true, ConnectionStates)};
false ->
- {ok, ssl_record:set_renegotiation_flag(false, ConnectionStates)}
+ {ok, tls_record:set_renegotiation_flag(false, ConnectionStates)}
end;
handle_renegotiation_info(_, undefined, ConnectionStates, false, _, _) ->
- {ok, ssl_record:set_renegotiation_flag(false, ConnectionStates)};
+ {ok, tls_record:set_renegotiation_flag(false, ConnectionStates)};
handle_renegotiation_info(client, #renegotiation_info{renegotiated_connection = ClientServerVerify},
ConnectionStates, true, _, _) ->
- CS = ssl_record:current_connection_state(ConnectionStates, read),
+ CS = tls_record:current_connection_state(ConnectionStates, read),
CData = CS#connection_state.client_verify_data,
SData = CS#connection_state.server_verify_data,
case <<CData/binary, SData/binary>> == ClientServerVerify of
@@ -904,7 +904,7 @@ handle_renegotiation_info(server, #renegotiation_info{renegotiated_connection =
true ->
?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE);
false ->
- CS = ssl_record:current_connection_state(ConnectionStates, read),
+ CS = tls_record:current_connection_state(ConnectionStates, read),
Data = CS#connection_state.client_verify_data,
case Data == ClientVerify of
true ->
@@ -926,7 +926,7 @@ handle_renegotiation_info(server, undefined, ConnectionStates, true, SecureReneg
end.
handle_renegotiation_info(ConnectionStates, SecureRenegotation) ->
- CS = ssl_record:current_connection_state(ConnectionStates, read),
+ CS = tls_record:current_connection_state(ConnectionStates, read),
case {SecureRenegotation, CS#connection_state.secure_renegotiation} of
{_, true} ->
?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE);
@@ -943,9 +943,9 @@ handle_renegotiation_info(ConnectionStates, SecureRenegotation) ->
hello_pending_connection_states(Role, Version, CipherSuite, Random, Compression,
ConnectionStates) ->
ReadState =
- ssl_record:pending_connection_state(ConnectionStates, read),
+ tls_record:pending_connection_state(ConnectionStates, read),
WriteState =
- ssl_record:pending_connection_state(ConnectionStates, write),
+ tls_record:pending_connection_state(ConnectionStates, write),
NewReadSecParams =
hello_security_parameters(Role, Version, ReadState, CipherSuite,
@@ -955,7 +955,7 @@ hello_pending_connection_states(Role, Version, CipherSuite, Random, Compression,
hello_security_parameters(Role, Version, WriteState, CipherSuite,
Random, Compression),
- ssl_record:update_security_params(NewReadSecParams,
+ tls_record:update_security_params(NewReadSecParams,
NewWriteSecParams,
ConnectionStates).
@@ -978,8 +978,8 @@ hello_security_parameters(server, Version, ConnectionState, CipherSuite, Random,
}.
select_version(ClientVersion, Versions) ->
- ServerVersion = ssl_record:highest_protocol_version(Versions),
- ssl_record:lowest_protocol_version(ClientVersion, ServerVersion).
+ ServerVersion = tls_record:highest_protocol_version(Versions),
+ tls_record:lowest_protocol_version(ClientVersion, ServerVersion).
select_cipher_suite([], _) ->
no_suite;
@@ -1011,15 +1011,15 @@ master_secret(Version, MasterSecret, #security_parameters{
setup_keys(Version, PrfAlgo, MasterSecret, ServerRandom,
ClientRandom, HashSize, KML, EKML, IVS),
- ConnStates1 = ssl_record:set_master_secret(MasterSecret, ConnectionStates),
+ ConnStates1 = tls_record:set_master_secret(MasterSecret, ConnectionStates),
ConnStates2 =
- ssl_record:set_mac_secret(ClientWriteMacSecret, ServerWriteMacSecret,
+ tls_record:set_mac_secret(ClientWriteMacSecret, ServerWriteMacSecret,
Role, ConnStates1),
ClientCipherState = #cipher_state{iv = ClientIV, key = ClientWriteKey},
ServerCipherState = #cipher_state{iv = ServerIV, key = ServerWriteKey},
{MasterSecret,
- ssl_record:set_pending_cipher_state(ConnStates2, ClientCipherState,
+ tls_record:set_pending_cipher_state(ConnStates2, ClientCipherState,
ServerCipherState, Role)}.
@@ -1685,7 +1685,7 @@ certificate_authorities_from_db(CertDbHandle, CertDbRef) ->
(_, Acc) ->
Acc
end,
- ssl_certificate_db:foldl(ConnectionCerts, [], CertDbHandle).
+ ssl_pkix_db:foldl(ConnectionCerts, [], CertDbHandle).
digitally_signed({3, Minor}, Hash, HashAlgo, Key) when Minor >= 3 ->
diff --git a/lib/ssl/src/tls_handshake.hrl b/lib/ssl/src/tls_handshake.hrl
new file mode 100644
index 0000000000..abf1b5abb6
--- /dev/null
+++ b/lib/ssl/src/tls_handshake.hrl
@@ -0,0 +1,45 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2013-2013. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%%----------------------------------------------------------------------
+%% Purpose: Record and constant defenitions for the TLS-handshake protocol
+%% see RFC 5246.
+%%----------------------------------------------------------------------
+-ifndef(tls_handshake).
+-define(tls_handshake, true).
+
+-include("ssl_handshake.hrl"). %% Common TLS and DTLS records and Constantes
+
+-record(client_hello, {
+ client_version,
+ random,
+ session_id, % opaque SessionID<0..32>
+ cipher_suites, % cipher_suites<2..2^16-1>
+ compression_methods, % compression_methods<1..2^8-1>,
+ %% Extensions
+ renegotiation_info,
+ hash_signs, % supported combinations of hashes/signature algos
+ next_protocol_negotiation = undefined, % [binary()]
+ srp,
+ ec_point_formats,
+ elliptic_curves
+ }).
+
+-endif. % -ifdef(tls_handshake).
diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/tls_record.erl
index 2a3356d60f..1409a04763 100644
--- a/lib/ssl/src/ssl_record.erl
+++ b/lib/ssl/src/tls_record.erl
@@ -23,12 +23,12 @@
%%
%%----------------------------------------------------------------------
--module(ssl_record).
+-module(tls_record).
--include("ssl_record.hrl").
+-include("tls_record.hrl").
-include("ssl_internal.hrl").
-include("ssl_alert.hrl").
--include("ssl_handshake.hrl").
+-include("tls_handshake.hrl").
-include("ssl_cipher.hrl").
%% Connection state handling
diff --git a/lib/ssl/src/tls_record.hrl b/lib/ssl/src/tls_record.hrl
new file mode 100644
index 0000000000..c9350fa137
--- /dev/null
+++ b/lib/ssl/src/tls_record.hrl
@@ -0,0 +1,39 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2013-2013. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%%----------------------------------------------------------------------
+%% Purpose: Record and constant defenitions for the TLS-record protocol
+%% see RFC 5246
+%%----------------------------------------------------------------------
+
+-ifndef(tls_record).
+-define(tls_record, true).
+
+-include("ssl_record.hrl"). %% Common TLS and DTLS records and Constantes
+
+%% Used to handle tls_plain_text, tls_compressed and tls_cipher_text
+
+-record(ssl_tls, {
+ type,
+ version,
+ fragment
+ }).
+
+-endif. % -ifdef(tls_record).
diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile
index 847907cde8..39aa22ffb4 100644
--- a/lib/ssl/test/Makefile
+++ b/lib/ssl/test/Makefile
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1999-2012. All Rights Reserved.
+# Copyright Ericsson AB 1999-2013. All Rights Reserved.
#
# The contents of this file are subject to the Erlang Public License,
# Version 1.1, (the "License"); you may not use this file except in
@@ -58,8 +58,10 @@ HRL_FILES =
HRL_FILES_SRC = \
ssl_internal.hrl\
ssl_alert.hrl \
+ tls_handshake.hrl \
ssl_handshake.hrl \
ssl_cipher.hrl \
+ tls_record.hrl \
ssl_record.hrl
HRL_FILES_INC =
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index c4a6cf1407..fed590f0ef 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -30,8 +30,8 @@
-include("ssl_internal.hrl").
-include("ssl_alert.hrl").
-include("ssl_internal.hrl").
--include("ssl_record.hrl").
--include("ssl_handshake.hrl").
+-include("tls_record.hrl").
+-include("tls_handshake.hrl").
-define('24H_in_sec', 86400).
-define(TIMEOUT, 60000).
@@ -266,7 +266,7 @@ init_per_testcase(empty_protocol_versions, Config) ->
%% ssl_test_lib:make_mix_cert(Config0);
init_per_testcase(_TestCase, Config0) ->
- ct:log("TLS/SSL version ~p~n ", [ssl_record:supported_protocol_versions()]),
+ ct:log("TLS/SSL version ~p~n ", [tls_record:supported_protocol_versions()]),
Config = lists:keydelete(watchdog, 1, Config0),
Dog = ct:timetrap(?TIMEOUT),
[{watchdog, Dog} | Config].
@@ -333,7 +333,7 @@ connection_info(Config) when is_list(Config) ->
[self(), Client, Server]),
Version =
- ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ tls_record:protocol_version(tls_record:highest_protocol_version([])),
ServerMsg = ClientMsg = {ok, {Version, {rsa,rc4_128,sha}}},
@@ -1547,7 +1547,7 @@ ciphers_rsa_signed_certs() ->
ciphers_rsa_signed_certs(Config) when is_list(Config) ->
Version =
- ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ tls_record:protocol_version(tls_record:highest_protocol_version([])),
Ciphers = ssl_test_lib:rsa_suites(crypto),
ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]),
@@ -1558,7 +1558,7 @@ ciphers_rsa_signed_certs_openssl_names() ->
ciphers_rsa_signed_certs_openssl_names(Config) when is_list(Config) ->
Version =
- ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ tls_record:protocol_version(tls_record:highest_protocol_version([])),
Ciphers = ssl_test_lib:openssl_rsa_suites(crypto),
ct:log("tls1 openssl cipher suites ~p~n", [Ciphers]),
run_suites(Ciphers, Version, Config, rsa).
@@ -1569,7 +1569,7 @@ ciphers_dsa_signed_certs() ->
ciphers_dsa_signed_certs(Config) when is_list(Config) ->
Version =
- ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ tls_record:protocol_version(tls_record:highest_protocol_version([])),
Ciphers = ssl_test_lib:dsa_suites(),
ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]),
@@ -1580,7 +1580,7 @@ ciphers_dsa_signed_certs_openssl_names() ->
ciphers_dsa_signed_certs_openssl_names(Config) when is_list(Config) ->
Version =
- ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ tls_record:protocol_version(tls_record:highest_protocol_version([])),
Ciphers = ssl_test_lib:openssl_dsa_suites(),
ct:log("tls1 openssl cipher suites ~p~n", [Ciphers]),
@@ -1589,56 +1589,56 @@ ciphers_dsa_signed_certs_openssl_names(Config) when is_list(Config) ->
anonymous_cipher_suites()->
[{doc,"Test the anonymous ciphersuites"}].
anonymous_cipher_suites(Config) when is_list(Config) ->
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
Ciphers = ssl_test_lib:anonymous_suites(),
run_suites(Ciphers, Version, Config, anonymous).
%%-------------------------------------------------------------------
psk_cipher_suites() ->
[{doc, "Test the PSK ciphersuites WITHOUT server supplied identity hint"}].
psk_cipher_suites(Config) when is_list(Config) ->
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
Ciphers = ssl_test_lib:psk_suites(),
run_suites(Ciphers, Version, Config, psk).
%%-------------------------------------------------------------------
psk_with_hint_cipher_suites()->
[{doc, "Test the PSK ciphersuites WITH server supplied identity hint"}].
psk_with_hint_cipher_suites(Config) when is_list(Config) ->
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
Ciphers = ssl_test_lib:psk_suites(),
run_suites(Ciphers, Version, Config, psk_with_hint).
%%-------------------------------------------------------------------
psk_anon_cipher_suites() ->
[{doc, "Test the anonymous PSK ciphersuites WITHOUT server supplied identity hint"}].
psk_anon_cipher_suites(Config) when is_list(Config) ->
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
Ciphers = ssl_test_lib:psk_anon_suites(),
run_suites(Ciphers, Version, Config, psk_anon).
%%-------------------------------------------------------------------
psk_anon_with_hint_cipher_suites()->
[{doc, "Test the anonymous PSK ciphersuites WITH server supplied identity hint"}].
psk_anon_with_hint_cipher_suites(Config) when is_list(Config) ->
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
Ciphers = ssl_test_lib:psk_anon_suites(),
run_suites(Ciphers, Version, Config, psk_anon_with_hint).
%%-------------------------------------------------------------------
srp_cipher_suites()->
[{doc, "Test the SRP ciphersuites"}].
srp_cipher_suites(Config) when is_list(Config) ->
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
Ciphers = ssl_test_lib:srp_suites(),
run_suites(Ciphers, Version, Config, srp).
%%-------------------------------------------------------------------
srp_anon_cipher_suites()->
[{doc, "Test the anonymous SRP ciphersuites"}].
srp_anon_cipher_suites(Config) when is_list(Config) ->
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
Ciphers = ssl_test_lib:srp_anon_suites(),
run_suites(Ciphers, Version, Config, srp_anon).
%%-------------------------------------------------------------------
srp_dsa_cipher_suites()->
[{doc, "Test the SRP DSA ciphersuites"}].
srp_dsa_cipher_suites(Config) when is_list(Config) ->
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
Ciphers = ssl_test_lib:srp_dss_suites(),
run_suites(Ciphers, Version, Config, srp_dsa).
%%--------------------------------------------------------------------
@@ -1671,7 +1671,7 @@ ciphers_ecdsa_signed_certs() ->
ciphers_ecdsa_signed_certs(Config) when is_list(Config) ->
Version =
- ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ tls_record:protocol_version(tls_record:highest_protocol_version([])),
Ciphers = ssl_test_lib:ecdsa_suites(),
ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]),
@@ -1682,7 +1682,7 @@ ciphers_ecdsa_signed_certs_openssl_names() ->
ciphers_ecdsa_signed_certs_openssl_names(Config) when is_list(Config) ->
Version =
- ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ tls_record:protocol_version(tls_record:highest_protocol_version([])),
Ciphers = ssl_test_lib:openssl_ecdsa_suites(),
ct:log("tls1 openssl cipher suites ~p~n", [Ciphers]),
run_suites(Ciphers, Version, Config, ecdsa).
@@ -1692,7 +1692,7 @@ ciphers_ecdh_rsa_signed_certs() ->
ciphers_ecdh_rsa_signed_certs(Config) when is_list(Config) ->
Version =
- ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ tls_record:protocol_version(tls_record:highest_protocol_version([])),
Ciphers = ssl_test_lib:ecdh_rsa_suites(),
ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]),
@@ -1703,7 +1703,7 @@ ciphers_ecdh_rsa_signed_certs_openssl_names() ->
ciphers_ecdh_rsa_signed_certs_openssl_names(Config) when is_list(Config) ->
Version =
- ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ tls_record:protocol_version(tls_record:highest_protocol_version([])),
Ciphers = ssl_test_lib:openssl_ecdh_rsa_suites(),
ct:log("tls1 openssl cipher suites ~p~n", [Ciphers]),
run_suites(Ciphers, Version, Config, ecdh_rsa).
@@ -2084,7 +2084,7 @@ client_no_wrap_sequence_number(Config) when is_list(Config) ->
{options, ServerOpts}]),
Port = ssl_test_lib:inet_port(Server),
- Version = ssl_record:highest_protocol_version(ssl_record:supported_protocol_versions()),
+ Version = tls_record:highest_protocol_version(tls_record:supported_protocol_versions()),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl
index 2703d2d79c..4e095dc184 100644
--- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl
+++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl
@@ -29,8 +29,8 @@
-include("ssl_internal.hrl").
-include("ssl_alert.hrl").
-include("ssl_internal.hrl").
--include("ssl_record.hrl").
--include("ssl_handshake.hrl").
+-include("tls_record.hrl").
+-include("tls_handshake.hrl").
-define(LONG_TIMEOUT, 600000).
diff --git a/lib/ssl/test/ssl_cipher_SUITE.erl b/lib/ssl/test/ssl_cipher_SUITE.erl
index 9869812e6e..45e91786d4 100644
--- a/lib/ssl/test/ssl_cipher_SUITE.erl
+++ b/lib/ssl/test/ssl_cipher_SUITE.erl
@@ -25,7 +25,7 @@
-include_lib("common_test/include/ct.hrl").
-include("ssl_internal.hrl").
--include("ssl_record.hrl").
+-include("tls_record.hrl").
-include("ssl_cipher.hrl").
-include("ssl_alert.hrl").
diff --git a/lib/ssl/test/ssl_handshake_SUITE.erl b/lib/ssl/test/ssl_handshake_SUITE.erl
index aff0e0fbbc..a40f07fd07 100644
--- a/lib/ssl/test/ssl_handshake_SUITE.erl
+++ b/lib/ssl/test/ssl_handshake_SUITE.erl
@@ -25,7 +25,7 @@
-include_lib("common_test/include/ct.hrl").
-include("ssl_internal.hrl").
--include("ssl_handshake.hrl").
+-include("tls_handshake.hrl").
%%--------------------------------------------------------------------
%% Common Test interface functions -----------------------------------
@@ -55,20 +55,20 @@ decode_hello_handshake(_Config) ->
16#70, 16#64, 16#79, 16#2f, 16#32>>,
Version = {3, 0},
- {Records, _Buffer} = ssl_handshake:get_tls_handshake(Version, HelloPacket, <<>>),
+ {Records, _Buffer} = tls_handshake:get_tls_handshake(Version, HelloPacket, <<>>),
{Hello, _Data} = hd(Records),
#renegotiation_info{renegotiated_connection = <<0>>} = Hello#server_hello.renegotiation_info.
decode_single_hello_extension_correctly(_Config) ->
Renegotiation = <<?UINT16(?RENEGOTIATION_EXT), ?UINT16(1), 0>>,
- Extensions = ssl_handshake:dec_hello_extensions(Renegotiation, []),
+ Extensions = tls_handshake:dec_hello_extensions(Renegotiation, []),
[{renegotiation_info,#renegotiation_info{renegotiated_connection = <<0>>}}] = Extensions.
decode_unknown_hello_extension_correctly(_Config) ->
FourByteUnknown = <<16#CA,16#FE, ?UINT16(4), 3, 0, 1, 2>>,
Renegotiation = <<?UINT16(?RENEGOTIATION_EXT), ?UINT16(1), 0>>,
- Extensions = ssl_handshake:dec_hello_extensions(<<FourByteUnknown/binary, Renegotiation/binary>>, []),
+ Extensions = tls_handshake:dec_hello_extensions(<<FourByteUnknown/binary, Renegotiation/binary>>, []),
[{renegotiation_info,#renegotiation_info{renegotiated_connection = <<0>>}}] = Extensions.
diff --git a/lib/ssl/test/ssl_npn_hello_SUITE.erl b/lib/ssl/test/ssl_npn_hello_SUITE.erl
index 43fa72ea28..ef5a02abef 100644
--- a/lib/ssl/test/ssl_npn_hello_SUITE.erl
+++ b/lib/ssl/test/ssl_npn_hello_SUITE.erl
@@ -23,10 +23,10 @@
%% Note: This directive should only be used in test suites.
-compile(export_all).
--include("ssl_handshake.hrl").
--include("ssl_record.hrl").
-include("ssl_cipher.hrl").
-include("ssl_internal.hrl").
+-include("tls_handshake.hrl").
+-include("tls_record.hrl").
-include_lib("common_test/include/ct.hrl").
%%--------------------------------------------------------------------
@@ -49,54 +49,52 @@ all() ->
encode_and_decode_client_hello_test(_Config) ->
HandShakeData = create_client_handshake(undefined),
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
{[{DecodedHandshakeMessage, _Raw}], _} =
- ssl_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>),
+ tls_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>),
NextProtocolNegotiation = DecodedHandshakeMessage#client_hello.next_protocol_negotiation,
NextProtocolNegotiation = undefined.
%%--------------------------------------------------------------------
encode_and_decode_npn_client_hello_test(_Config) ->
HandShakeData = create_client_handshake(#next_protocol_negotiation{extension_data = <<>>}),
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
{[{DecodedHandshakeMessage, _Raw}], _} =
- ssl_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>),
+ tls_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>),
NextProtocolNegotiation = DecodedHandshakeMessage#client_hello.next_protocol_negotiation,
NextProtocolNegotiation = #next_protocol_negotiation{extension_data = <<>>}.
%%--------------------------------------------------------------------
encode_and_decode_server_hello_test(_Config) ->
HandShakeData = create_server_handshake(undefined),
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
{[{DecodedHandshakeMessage, _Raw}], _} =
- ssl_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>),
+ tls_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>),
NextProtocolNegotiation = DecodedHandshakeMessage#server_hello.next_protocol_negotiation,
NextProtocolNegotiation = undefined.
%%--------------------------------------------------------------------
encode_and_decode_npn_server_hello_test(_Config) ->
HandShakeData = create_server_handshake(#next_protocol_negotiation{extension_data = <<6, "spdy/2">>}),
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
{[{DecodedHandshakeMessage, _Raw}], _} =
- ssl_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>),
+ tls_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>),
NextProtocolNegotiation = DecodedHandshakeMessage#server_hello.next_protocol_negotiation,
ct:log("~p ~n", [NextProtocolNegotiation]),
NextProtocolNegotiation = #next_protocol_negotiation{extension_data = <<6, "spdy/2">>}.
%%--------------------------------------------------------------------
create_server_hello_with_no_advertised_protocols_test(_Config) ->
- Hello = ssl_handshake:server_hello(<<>>, {3, 0}, create_connection_states(), false,
- undefined, undefined, undefined),
+ Hello = tls_handshake:server_hello(<<>>, {3, 0}, create_connection_states(), false, undefined, undefined, undefined),
undefined = Hello#server_hello.next_protocol_negotiation.
%%--------------------------------------------------------------------
create_server_hello_with_advertised_protocols_test(_Config) ->
- Hello = ssl_handshake:server_hello(<<>>, {3, 0}, create_connection_states(),
- false, [<<"spdy/1">>, <<"http/1.0">>, <<"http/1.1">>],
- undefined, undefined),
+ Hello = tls_handshake:server_hello(<<>>, {3, 0}, create_connection_states(),
+ false, [<<"spdy/1">>, <<"http/1.0">>, <<"http/1.1">>], undefined, undefined),
#next_protocol_negotiation{extension_data = <<6, "spdy/1", 8, "http/1.0", 8, "http/1.1">>} =
Hello#server_hello.next_protocol_negotiation.
%%--------------------------------------------------------------------
%% Internal functions ------------------------------------------------
%%--------------------------------------------------------------------
create_client_handshake(Npn) ->
- ssl_handshake:encode_handshake(#client_hello{
+ tls_handshake:encode_handshake(#client_hello{
client_version = {1, 2},
random = <<1:256>>,
session_id = <<>>,
@@ -107,7 +105,7 @@ create_client_handshake(Npn) ->
}, vsn).
create_server_handshake(Npn) ->
- ssl_handshake:encode_handshake(#server_hello{
+ tls_handshake:encode_handshake(#server_hello{
server_version = {1, 2},
random = <<1:256>>,
session_id = <<>>,
diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl
index 7f91865a86..0564b37f1c 100644
--- a/lib/ssl/test/ssl_to_openssl_SUITE.erl
+++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl
@@ -269,7 +269,7 @@ erlang_client_openssl_server(Config) when is_list(Config) ->
Port = ssl_test_lib:inet_port(node()),
CertFile = proplists:get_value(certfile, ServerOpts),
KeyFile = proplists:get_value(keyfile, ServerOpts),
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++
" -cert " ++ CertFile ++ " -key " ++ KeyFile,
@@ -310,7 +310,7 @@ erlang_server_openssl_client(Config) when is_list(Config) ->
{mfa, {?MODULE, erlang_ssl_receive, [Data]}},
{options, ServerOpts}]),
Port = ssl_test_lib:inet_port(Server),
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ version_flag(Version) ++
" -host localhost",
@@ -344,7 +344,7 @@ erlang_client_openssl_server_dsa_cert(Config) when is_list(Config) ->
CaCertFile = proplists:get_value(cacertfile, ServerOpts),
CertFile = proplists:get_value(certfile, ServerOpts),
KeyFile = proplists:get_value(keyfile, ServerOpts),
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++
" -cert " ++ CertFile ++ " -CAfile " ++ CaCertFile
@@ -392,7 +392,7 @@ erlang_server_openssl_client_dsa_cert(Config) when is_list(Config) ->
{mfa, {?MODULE, erlang_ssl_receive, [Data]}},
{options, ServerOpts}]),
Port = ssl_test_lib:inet_port(Server),
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ version_flag(Version) ++
" -host localhost " ++ " -cert " ++ CertFile ++ " -CAfile " ++ CaCertFile
++ " -key " ++ KeyFile ++ " -msg",
@@ -428,7 +428,7 @@ erlang_server_openssl_client_reuse_session(Config) when is_list(Config) ->
{reconnect_times, 5},
{options, ServerOpts}]),
Port = ssl_test_lib:inet_port(Server),
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ version_flag(Version) ++
" -host localhost -reconnect",
@@ -463,7 +463,7 @@ erlang_client_openssl_server_renegotiate(Config) when is_list(Config) ->
Port = ssl_test_lib:inet_port(node()),
CertFile = proplists:get_value(certfile, ServerOpts),
KeyFile = proplists:get_value(keyfile, ServerOpts),
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++
" -cert " ++ CertFile ++ " -key " ++ KeyFile ++ " -msg",
@@ -513,7 +513,7 @@ erlang_client_openssl_server_nowrap_seqnum(Config) when is_list(Config) ->
Port = ssl_test_lib:inet_port(node()),
CertFile = proplists:get_value(certfile, ServerOpts),
KeyFile = proplists:get_value(keyfile, ServerOpts),
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++
" -cert " ++ CertFile ++ " -key " ++ KeyFile ++ " -msg",
@@ -559,7 +559,7 @@ erlang_server_openssl_client_nowrap_seqnum(Config) when is_list(Config) ->
trigger_renegotiate, [[Data, N+2]]}},
{options, [{renegotiate_at, N}, {reuse_sessions, false} | ServerOpts]}]),
Port = ssl_test_lib:inet_port(Server),
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ version_flag(Version) ++
" -host localhost -msg",
@@ -594,7 +594,7 @@ erlang_client_openssl_server_no_server_ca_cert(Config) when is_list(Config) ->
Port = ssl_test_lib:inet_port(node()),
CertFile = proplists:get_value(certfile, ServerOpts),
KeyFile = proplists:get_value(keyfile, ServerOpts),
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++
" -cert " ++ CertFile ++ " -key " ++ KeyFile ++ " -msg",
@@ -636,7 +636,7 @@ erlang_client_openssl_server_client_cert(Config) when is_list(Config) ->
CertFile = proplists:get_value(certfile, ServerOpts),
CaCertFile = proplists:get_value(cacertfile, ServerOpts),
KeyFile = proplists:get_value(keyfile, ServerOpts),
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++
" -cert " ++ CertFile ++ " -CAfile " ++ CaCertFile
++ " -key " ++ KeyFile ++ " -Verify 2",
@@ -687,7 +687,7 @@ erlang_server_openssl_client_client_cert(Config) when is_list(Config) ->
CaCertFile = proplists:get_value(cacertfile, ClientOpts),
CertFile = proplists:get_value(certfile, ClientOpts),
KeyFile = proplists:get_value(keyfile, ClientOpts),
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
Cmd = "openssl s_client -cert " ++ CertFile ++ " -CAfile " ++ CaCertFile
++ " -key " ++ KeyFile ++ " -port " ++ integer_to_list(Port) ++ version_flag(Version) ++
" -host localhost",
@@ -712,7 +712,7 @@ erlang_server_erlang_client_client_cert(Config) when is_list(Config) ->
process_flag(trap_exit, true),
ServerOpts = ?config(server_verification_opts, Config),
ClientOpts = ?config(client_verification_opts, Config),
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Data = "From erlang to erlang",
@@ -748,7 +748,7 @@ ciphers_rsa_signed_certs() ->
[{doc,"Test cipher suites that uses rsa certs"}].
ciphers_rsa_signed_certs(Config) when is_list(Config) ->
Version =
- ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ tls_record:protocol_version(tls_record:highest_protocol_version([])),
Ciphers = ssl_test_lib:rsa_suites(openssl),
run_suites(Ciphers, Version, Config, rsa).
@@ -758,7 +758,7 @@ ciphers_dsa_signed_certs() ->
[{doc,"Test cipher suites that uses dsa certs"}].
ciphers_dsa_signed_certs(Config) when is_list(Config) ->
Version =
- ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ tls_record:protocol_version(tls_record:highest_protocol_version([])),
Ciphers = ssl_test_lib:dsa_suites(),
run_suites(Ciphers, Version, Config, dsa).
@@ -776,7 +776,7 @@ erlang_client_bad_openssl_server(Config) when is_list(Config) ->
Port = ssl_test_lib:inet_port(node()),
CertFile = proplists:get_value(certfile, ServerOpts),
KeyFile = proplists:get_value(keyfile, ServerOpts),
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++
" -cert " ++ CertFile ++ " -key " ++ KeyFile ++ "",
@@ -1095,7 +1095,7 @@ start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, Opens
Port = ssl_test_lib:inet_port(node()),
CertFile = proplists:get_value(certfile, ServerOpts),
KeyFile = proplists:get_value(keyfile, ServerOpts),
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
Cmd = "openssl s_server " ++ OpensslServerOpts ++ " -accept " ++
integer_to_list(Port) ++ version_flag(Version) ++
@@ -1135,7 +1135,7 @@ start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callbac
Port = ssl_test_lib:inet_port(node()),
CertFile = proplists:get_value(certfile, ServerOpts),
KeyFile = proplists:get_value(keyfile, ServerOpts),
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
Cmd = "openssl s_server -msg -nextprotoneg http/1.1,spdy/2 -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++
" -cert " ++ CertFile ++ " -key " ++ KeyFile,
@@ -1174,7 +1174,7 @@ start_erlang_server_and_openssl_client_for_npn_negotiation(Config, Data, Callbac
{mfa, {?MODULE, erlang_ssl_receive_and_assert_npn, [<<"spdy/2">>, Data]}},
{options, ServerOpts}]),
Port = ssl_test_lib:inet_port(Server),
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
Cmd = "openssl s_client -nextprotoneg http/1.0,spdy/2 -msg -port " ++ integer_to_list(Port) ++ version_flag(Version) ++
" -host localhost",
@@ -1203,7 +1203,7 @@ start_erlang_server_and_openssl_client_with_opts(Config, ErlangServerOpts, OpenS
{mfa, {?MODULE, erlang_ssl_receive, [Data]}},
{options, ServerOpts}]),
Port = ssl_test_lib:inet_port(Server),
- Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
Cmd = "openssl s_client " ++ OpenSSLClientOpts ++ " -msg -port " ++ integer_to_list(Port) ++ version_flag(Version) ++
" -host localhost",
diff --git a/lib/stdlib/doc/src/c.xml b/lib/stdlib/doc/src/c.xml
index ddae388a1b..9cd4581a89 100644
--- a/lib/stdlib/doc/src/c.xml
+++ b/lib/stdlib/doc/src/c.xml
@@ -140,9 +140,9 @@ compile:file(<anno>File</anno>, <anno>Options</anno> ++ [report_errors, report_w
</func>
<func>
<name name="ls" arity="1"/>
- <fsummary>List files in a directory</fsummary>
+ <fsummary>List files in a directory or a single file</fsummary>
<desc>
- <p>Lists files in directory <c><anno>Dir</anno></c>.</p>
+ <p>Lists files in directory <c><anno>Dir</anno></c> or, if Dir is a file, only list it.</p>
</desc>
</func>
<func>
diff --git a/lib/stdlib/doc/src/erl_eval.xml b/lib/stdlib/doc/src/erl_eval.xml
index d0622594d9..24940f8396 100644
--- a/lib/stdlib/doc/src/erl_eval.xml
+++ b/lib/stdlib/doc/src/erl_eval.xml
@@ -288,10 +288,7 @@ Func(FuncSpec, Arguments) </code>
<section>
<title>Bugs</title>
- <p>The evaluator is not complete. <c>receive</c> cannot be
- handled properly.
- </p>
- <p>Any undocumented functions in <c>erl_eval</c> should not be used.</p>
+ <p>Undocumented functions in <c>erl_eval</c> should not be used.</p>
</section>
</erlref>
diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl
index 2e9ebece0e..121f9febed 100644
--- a/lib/stdlib/src/beam_lib.erl
+++ b/lib/stdlib/src/beam_lib.erl
@@ -300,7 +300,7 @@ clear_crypto_key_fun() ->
call_crypto_server(clear_crypto_key_fun).
-spec make_crypto_key(mode(), string()) ->
- {binary(), binary(), binary(), binary()}.
+ {mode(), [binary()], binary(), integer()}.
make_crypto_key(des3_cbc=Type, String) ->
<<K1:8/binary,K2:8/binary>> = First = erlang:md5(String),
diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl
index 91d317489c..6e96e3d564 100644
--- a/lib/stdlib/src/c.erl
+++ b/lib/stdlib/src/c.erl
@@ -713,8 +713,10 @@ ls(Dir) ->
case file:list_dir(Dir) of
{ok, Entries} ->
ls_print(sort(Entries));
- {error,_E} ->
- format("Invalid directory\n")
+ {error, enotdir} ->
+ ls_print([Dir]);
+ {error, Error} ->
+ format("~s\n", [file:format_error(Error)])
end.
ls_print([]) -> ok;
diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl
index 0b57af1b6d..73b8da335a 100644
--- a/lib/stdlib/src/erl_eval.erl
+++ b/lib/stdlib/src/erl_eval.erl
@@ -245,10 +245,10 @@ expr({'case',_,E,Cs}, Bs0, Lf, Ef, RBs) ->
expr({'try',_,B,Cases,Catches,AB}, Bs, Lf, Ef, RBs) ->
try_clauses(B, Cases, Catches, AB, Bs, Lf, Ef, RBs);
expr({'receive',_,Cs}, Bs, Lf, Ef, RBs) ->
- receive_clauses(Cs, Bs, Lf, Ef, [], RBs);
+ receive_clauses(Cs, Bs, Lf, Ef, RBs);
expr({'receive',_, Cs, E, TB}, Bs0, Lf, Ef, RBs) ->
{value,T,Bs} = expr(E, Bs0, Lf, Ef, none),
- receive_clauses(T, Cs, {TB,Bs}, Bs0, Lf, Ef, [], RBs);
+ receive_clauses(T, Cs, {TB,Bs}, Bs0, Lf, Ef, RBs);
expr({'fun',_Line,{function,Mod0,Name0,Arity0}}, Bs0, Lf, Ef, RBs) ->
{[Mod,Name,Arity],Bs} = expr_list([Mod0,Name0,Arity0], Bs0, Lf, Ef),
F = erlang:make_fun(Mod, Name, Arity),
@@ -807,66 +807,24 @@ case_clauses(Val, Cs, Bs, Lf, Ef, RBs) ->
end.
%%
-%% receive_clauses(Clauses, Bindings, LocalFuncHnd,ExtFuncHnd, Messages, RBs)
+%% receive_clauses(Clauses, Bindings, LocalFuncHnd,ExtFuncHnd, RBs)
%%
-receive_clauses(Cs, Bs, Lf, Ef, Ms, RBs) ->
- receive
- Val ->
- case match_clause(Cs, [Val], Bs, Lf, Ef) of
- {B, Bs1} ->
- merge_queue(Ms),
- exprs(B, Bs1, Lf, Ef, RBs);
- nomatch ->
- receive_clauses(Cs, Bs, Lf, Ef, [Val|Ms], RBs)
- end
- end.
+receive_clauses(Cs, Bs, Lf, Ef, RBs) ->
+ receive_clauses(infinity, Cs, unused, Bs, Lf, Ef, RBs).
%%
%% receive_clauses(TimeOut, Clauses, TimeoutBody, Bindings,
%% ExternalFuncHandler, LocalFuncHandler, RBs)
%%
-receive_clauses(T, Cs, TB, Bs, Lf, Ef, Ms, RBs) ->
- {_,_} = statistics(runtime),
- receive
- Val ->
- case match_clause(Cs, [Val], Bs, Lf, Ef) of
- {B, Bs1} ->
- merge_queue(Ms),
- exprs(B, Bs1, Lf, Ef, RBs);
- nomatch ->
- {_,T1} = statistics(runtime),
- if
- T =:= infinity ->
- receive_clauses(T, Cs, TB,Bs,Lf,Ef,[Val|Ms],RBs);
- T-T1 =< 0 ->
- receive_clauses(0, Cs, TB,Bs,Lf,Ef,[Val|Ms],RBs);
- true ->
- receive_clauses(T-T1, Cs,TB,Bs,Lf,Ef,[Val|Ms],RBs)
- end
- end
- after T ->
- merge_queue(Ms),
+receive_clauses(T, Cs, TB, Bs, Lf, Ef, RBs) ->
+ F = fun (M) -> match_clause(Cs, [M], Bs, Lf, Ef) end,
+ case prim_eval:'receive'(F, T) of
+ {B, Bs1} ->
+ exprs(B, Bs1, Lf, Ef, RBs);
+ timeout ->
{B, Bs1} = TB,
exprs(B, Bs1, Lf, Ef, RBs)
end.
-merge_queue([]) ->
- true;
-merge_queue(Ms) ->
- send_all(recv_all(Ms), self()).
-
-recv_all(Xs) ->
- receive
- X -> recv_all([X|Xs])
- after 0 ->
- reverse(Xs)
- end.
-
-send_all([X|Xs], Self) ->
- Self ! X,
- send_all(Xs, Self);
-send_all([], _) -> true.
-
-
%% match_clause -> {Body, Bindings} or nomatch
-spec(match_clause(Clauses, ValueList, Bindings, LocalFunctionHandler) ->
diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl
index c0596e5ba6..657cb5d34c 100644
--- a/lib/stdlib/src/erl_pp.erl
+++ b/lib/stdlib/src/erl_pp.erl
@@ -214,7 +214,9 @@ lattribute({attribute,_Line,type,Type}, Opts, _State) ->
lattribute({attribute,_Line,opaque,Type}, Opts, _State) ->
[typeattr(opaque, Type, Opts),leaf(".\n")];
lattribute({attribute,_Line,spec,Arg}, _Opts, _State) ->
- [specattr(Arg),leaf(".\n")];
+ [specattr(spec, Arg),leaf(".\n")];
+lattribute({attribute,_Line,callback,Arg}, _Opts, _State) ->
+ [specattr(callback, Arg),leaf(".\n")];
lattribute({attribute,_Line,Name,Arg}, Opts, State) ->
[lattribute(Name, Arg, Opts, State),leaf(".\n")].
@@ -311,14 +313,14 @@ union_elem(T) ->
tuple_type(Ts, F) ->
{seq,${,$},[$,],ltypes(Ts, F)}.
-specattr({FuncSpec,TypeSpecs}) ->
+specattr(SpecKind, {FuncSpec,TypeSpecs}) ->
Func = case FuncSpec of
{F,_A} ->
format("~w", [F]);
{M,F,_A} ->
format("~w:~w", [M, F])
end,
- {first,leaf("-spec "),
+ {first,leaf(lists:concat(["-", SpecKind, " "])),
{list,[{first,leaf(Func),spec_clauses(TypeSpecs)}]}}.
spec_clauses(TypeSpecs) ->
diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl
index 42a42b7fd7..cebc9c91bd 100644
--- a/lib/stdlib/src/otp_internal.erl
+++ b/lib/stdlib/src/otp_internal.erl
@@ -250,10 +250,12 @@ obsolete_1(snmp, N, A) ->
false ->
no;
true ->
- {deprecated,"Deprecated; use snmpa:"++atom_to_list(N)++"/"++
+ {deprecated, "Deprecated (will be removed in R17B); use snmpa:"++atom_to_list(N)++"/"++
integer_to_list(A)++" instead"}
end;
+obsolete_1(snmpa, old_info_format, 1) ->
+ {deprecated, "Deprecated; (will be removed in R17B); use \"new\" format instead"};
obsolete_1(snmpm, agent_info, 3) ->
{removed, {snmpm, agent_info, 2}, "R16B"};
obsolete_1(snmpm, update_agent_info, 5) ->
diff --git a/lib/stdlib/test/c_SUITE.erl b/lib/stdlib/test/c_SUITE.erl
index 25281365be..8c55b616b9 100644
--- a/lib/stdlib/test/c_SUITE.erl
+++ b/lib/stdlib/test/c_SUITE.erl
@@ -20,7 +20,7 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2]).
-export([c_1/1, c_2/1, c_3/1, c_4/1, nc_1/1, nc_2/1, nc_3/1, nc_4/1,
- memory/1]).
+ ls/1, memory/1]).
-include_lib("test_server/include/test_server.hrl").
@@ -29,7 +29,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- [c_1, c_2, c_3, c_4, nc_1, nc_2, nc_3, nc_4, memory].
+ [c_1, c_2, c_3, c_4, nc_1, nc_2, nc_3, nc_4, ls, memory].
groups() ->
[].
@@ -147,6 +147,13 @@ nc_4(Config) when is_list(Config) ->
?line Result = nc(R,[{outdir,W}]),
?line {ok, m} = Result.
+ls(Config) when is_list(Config) ->
+ Directory = ?config(data_dir, Config),
+ ok = c:ls(Directory),
+ File = filename:join(Directory, "m.erl"),
+ ok = c:ls(File),
+ ok = c:ls("no_such_file").
+
memory(doc) ->
["Checks that c:memory/[0,1] returns consistent results."];
memory(suite) ->
diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl
index ff3470349e..2b7cec87df 100644
--- a/lib/stdlib/test/erl_pp_SUITE.erl
+++ b/lib/stdlib/test/erl_pp_SUITE.erl
@@ -43,7 +43,7 @@
receive_after/1, bits/1, head_tail/1,
cond1/1, block/1, case1/1, ops/1, messages/1,
old_mnemosyne_syntax/1,
- import_export/1, misc_attrs/1,
+ import_export/1, misc_attrs/1, dialyzer_attrs/1,
hook/1,
neg_indent/1,
@@ -77,7 +77,7 @@ groups() ->
[func, call, recs, try_catch, if_then, receive_after,
bits, head_tail, cond1, block, case1, ops,
messages, old_mnemosyne_syntax]},
- {attributes, [], [misc_attrs, import_export]},
+ {attributes, [], [misc_attrs, import_export, dialyzer_attrs]},
{tickets, [],
[otp_6321, otp_6911, otp_6914, otp_8150, otp_8238,
otp_8473, otp_8522, otp_8567, otp_8664, otp_9147,
@@ -597,6 +597,15 @@ misc_attrs(Config) when is_list(Config) ->
ok.
+dialyzer_attrs(suite) ->
+ [];
+dialyzer_attrs(Config) when is_list(Config) ->
+ ok = pp_forms(<<"-type foo() :: #bar{}. ">>),
+ ok = pp_forms(<<"-opaque foo() :: {bar, fun((X, [42,...]) -> X)}. ">>),
+ ok = pp_forms(<<"-spec foo(bar(), qux()) -> [T | baz(T)]. ">>),
+ ok = pp_forms(<<"-callback foo(<<_:32,_:_*4>>, T) -> T. ">>),
+ ok.
+
hook(suite) ->
[];
hook(Config) when is_list(Config) ->
diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl
index bd69019892..2b29566942 100644
--- a/lib/stdlib/test/ets_SUITE.erl
+++ b/lib/stdlib/test/ets_SUITE.erl
@@ -5626,17 +5626,25 @@ etsmem() ->
MemInfo ->
CS = lists:foldl(
fun ({instance, _, L}, Acc) ->
- {value,{_,SBMBCS}} = lists:keysearch(sbmbcs, 1, L),
- {value,{_,MBCS}} = lists:keysearch(mbcs, 1, L),
- {value,{_,SBCS}} = lists:keysearch(sbcs, 1, L),
- [SBMBCS,MBCS,SBCS | Acc]
+ {value,{mbcs,MBCS}} = lists:keysearch(mbcs, 1, L),
+ {value,{sbcs,SBCS}} = lists:keysearch(sbcs, 1, L),
+ NewAcc = [MBCS, SBCS | Acc],
+ case lists:keysearch(mbcs_pool, 1, L) of
+ {value,{mbcs_pool, MBCS_POOL}} ->
+ [MBCS_POOL|NewAcc];
+ _ -> NewAcc
+ end
end,
[],
MemInfo),
lists:foldl(
fun(L, {Bl0,BlSz0}) ->
- {value,{_,Bl,_,_}} = lists:keysearch(blocks, 1, L),
- {value,{_,BlSz,_,_}} = lists:keysearch(blocks_size, 1, L),
+ {value,BlTup} = lists:keysearch(blocks, 1, L),
+ blocks = element(1, BlTup),
+ Bl = element(2, BlTup),
+ {value,BlSzTup} = lists:keysearch(blocks_size, 1, L),
+ blocks_size = element(1, BlSzTup),
+ BlSz = element(2, BlSzTup),
{Bl0+Bl,BlSz0+BlSz}
end, {0,0}, CS)
end},
diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl
index 8b0be51be3..c350f758ce 100644
--- a/lib/test_server/src/test_server.erl
+++ b/lib/test_server/src/test_server.erl
@@ -716,6 +716,16 @@ end_conf_timeout(_, _) ->
call_end_conf(Mod,Func,TCPid,TCExitReason,Loc,Conf,TVal) ->
Starter = self(),
Data = {Mod,Func,TCPid,TCExitReason,Loc},
+ case erlang:function_exported(Mod,end_per_testcase,2) of
+ false ->
+ spawn_link(fun() ->
+ Starter ! {self(),{call_end_conf,Data,ok}}
+ end);
+ true ->
+ do_call_end_conf(Starter,Mod,Func,Data,Conf,TVal)
+ end.
+
+do_call_end_conf(Starter,Mod,Func,Data,Conf,TVal) ->
EndConfProc =
fun() ->
process_flag(trap_exit,true), % to catch timetraps
@@ -753,7 +763,8 @@ call_end_conf(Mod,Func,TCPid,TCExitReason,Loc,Conf,TVal) ->
end,
spawn_link(EndConfProc).
-spawn_fw_call(Mod,{init_per_testcase,Func},CurrConf,Pid,{timetrap_timeout,TVal}=Why,
+spawn_fw_call(Mod,{init_per_testcase,Func},CurrConf,Pid,
+ {timetrap_timeout,TVal}=Why,
Loc,SendTo) ->
FwCall =
fun() ->
diff --git a/lib/test_server/src/ts_install_cth.erl b/lib/test_server/src/ts_install_cth.erl
index 9b6e10e7e2..a75cae3c9d 100644
--- a/lib/test_server/src/ts_install_cth.erl
+++ b/lib/test_server/src/ts_install_cth.erl
@@ -103,7 +103,9 @@ pre_init_per_suite(_Suite,Config,State) ->
end,
{add_node_name(Config, State), State}
- catch Error:Reason ->
+ catch error:{badmatch,{error,enoent}} ->
+ {add_node_name(Config, State), State};
+ Error:Reason ->
Stack = erlang:get_stacktrace(),
ct:pal("~p failed! ~p:{~p,~p}",[?MODULE,Error,Reason,Stack]),
{{fail,{?MODULE,{Error,Reason, Stack}}},State}
diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el
index ddd22707dd..f3bc95e3e5 100644
--- a/lib/tools/emacs/erlang.el
+++ b/lib/tools/emacs/erlang.el
@@ -883,6 +883,7 @@ resulting regexp is surrounded by \\_< and \\_>."
"fun_to_list"
"function_exported"
"garbage_collect_message_area"
+ "gather_gc_info_result"
"gather_sched_wall_time_result"
"get_cookie"
"get_module_info"