diff options
54 files changed, 5824 insertions, 7710 deletions
diff --git a/lib/asn1/c_src/asn1_erl_nif.c b/lib/asn1/c_src/asn1_erl_nif.c index dbff14f9b3..7f1870d5b0 100644 --- a/lib/asn1/c_src/asn1_erl_nif.c +++ b/lib/asn1/c_src/asn1_erl_nif.c @@ -27,7 +27,6 @@ #define ASN1_OK 0 #define ASN1_ERROR -1 #define ASN1_COMPL_ERROR 1 -#define ASN1_MEMORY_ERROR 0 #define ASN1_DECODE_ERROR 2 #define ASN1_TAG_ERROR -3 #define ASN1_LEN_ERROR -4 @@ -851,11 +850,8 @@ int ber_decode_begin(ErlNifEnv* env, ERL_NIF_TERM *term, unsigned char *in_buf, }; // The remaining binary after one ASN1 segment has been decoded - if ((rest_data = enif_make_new_binary(env, in_buf_len - ib_index, &rest)) - == NULL) { - *term = enif_make_atom(env, "could_not_alloc_binary"); - return ASN1_ERROR; - } + rest_data = enif_make_new_binary(env, in_buf_len - ib_index, &rest); + memcpy(rest_data, in_buf+ib_index, in_buf_len - ib_index); *term = enif_make_tuple2(env, decoded_term, rest); return ASN1_OK; @@ -1221,7 +1217,33 @@ static ERL_NIF_TERM encode_per_complete(ErlNifEnv* env, int argc, return enif_make_binary(env, &out_binary); } -static ERL_NIF_TERM decode_ber_tlv(ErlNifEnv* env, int argc, +static ERL_NIF_TERM +make_ber_error_term(ErlNifEnv* env, unsigned int return_code, + unsigned int err_pos) +{ + ERL_NIF_TERM reason; + ERL_NIF_TERM t; + + switch (return_code) { + case ASN1_TAG_ERROR: + reason = enif_make_atom(env, "invalid_tag"); + break; + case ASN1_LEN_ERROR: + case ASN1_INDEF_LEN_ERROR: + reason = enif_make_atom(env, "invalid_length"); + break; + case ASN1_VALUE_ERROR: + reason = enif_make_atom(env, "invalid_value"); + break; + default: + reason = enif_make_atom(env, "unknown"); + break; + } + t = enif_make_tuple2(env, reason, enif_make_int(env, err_pos)); + return enif_make_tuple2(env, enif_make_atom(env, "error"), t); +} + +static ERL_NIF_TERM decode_ber_tlv_raw(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { ErlNifBinary in_binary; ERL_NIF_TERM return_term; @@ -1230,11 +1252,11 @@ static ERL_NIF_TERM decode_ber_tlv(ErlNifEnv* env, int argc, if (!enif_inspect_iolist_as_binary(env, argv[0], &in_binary)) return enif_make_badarg(env); - if ((return_code = ber_decode_begin(env, &return_term, in_binary.data, - in_binary.size, &err_pos)) != ASN1_OK - ) - return enif_make_tuple2(env, enif_make_atom(env,"error"), enif_make_tuple2(env, - enif_make_int(env, return_code),enif_make_int(env, err_pos))); + return_code = ber_decode_begin(env, &return_term, in_binary.data, + in_binary.size, &err_pos); + if (return_code != ASN1_OK) { + return make_ber_error_term(env, return_code, err_pos); + } return return_term; } @@ -1297,8 +1319,10 @@ static void unload(ErlNifEnv* env, void* priv_data) { } -static ErlNifFunc nif_funcs[] = { { "encode_per_complete", 1, - encode_per_complete }, { "decode_ber_tlv", 1, decode_ber_tlv }, { - "encode_ber_tlv", 1, encode_ber_tlv } }; +static ErlNifFunc nif_funcs[] = { + { "encode_per_complete", 1, encode_per_complete }, + { "decode_ber_tlv_raw", 1, decode_ber_tlv_raw }, + { "encode_ber_tlv", 1, encode_ber_tlv }, +}; ERL_NIF_INIT(asn1rt_nif, nif_funcs, load, NULL, upgrade, unload) diff --git a/lib/asn1/doc/src/asn1_ug.xml b/lib/asn1/doc/src/asn1_ug.xml index 6cb251c3e2..a0ab98cf7a 100644 --- a/lib/asn1/doc/src/asn1_ug.xml +++ b/lib/asn1/doc/src/asn1_ug.xml @@ -324,13 +324,6 @@ erlc -o ../asnfiles -I ../asnfiles -I /usr/local/standards/asn1 Person.asn are several places to search in. The compiler will always search the current directory first.</p> </item> - <tag><c>+compact_bit_string</c></tag> - <item> - <p>Gives the user the option to use a compact format of the BIT - STRING type to save memory space, typing space and - increase encode/decode performance, for details see - <seealso marker="#BIT STRING">BIT STRING </seealso>type section.</p> - </item> <tag><c>+der</c></tag> <item> <p>DER encoding rule. Only when using <c>-ber</c> option.</p> @@ -352,22 +345,6 @@ erlc -o ../asnfiles -I ../asnfiles -I /usr/local/standards/asn1 Person.asn list or a binary. Earlier versions of the compiler ignored those following bytes.</p> </item> - <tag><c>{inline,OutputName}</c></tag> - <item> - <p>Compiling with this option gives one output module - containing all asn1 run-time functionality. The asn1 specs - are provided in a target module <c>Module.set.asn</c> as - described in the <seealso marker="asn1ct#asn1set">reference manual</seealso>. The name of the resulting module - containing generated encode/decode functions and inlined - run-time functions will be <c>OutputName.erl</c>. The - merging/inlining of code is done by the <c>igor</c> module - of <c>syntax_tools</c>. By default the functions generated - from the first asn1 spec in the <c>.set.asn</c> are - exported, unless a <c>{export,[atom()]}</c> or - <c>{export_all,true}</c> option are provided. The list of - atoms are names of choosen asn1 specs from the - <c>.set.asn</c> file. See further examples of usage <seealso marker="#inlineExamples">below</seealso></p> - </item> <tag><c>+'Any Erlc Option'</c></tag> <item> <p>You may add any option to the Erlang compiler when @@ -454,21 +431,8 @@ asn1rt:decode('H323-MESSAGES','SomeChoiceType',Bytes). </pre> any reason. Maybe you need to compile the same specs for different encoding/decoding standards.</item> <item>You want only one resulting module.</item> - <item>If it is crucial to have a minimal system. Using - <c>{inline,OutputModule}</c> includes all necessary run-time - functions of the asn1 application, but skips those modules not - used.</item> - <item>Upgrading issues: Even if you upgrade your Erlang system - you may want to continue running the old asn1 run-time - functionality.</item> - <item>Performance issues: If you have an asn1 system with a lot - of cross references you may gain in performance. Measurements - must be done for each case.</item> </list> - <p>You may choose either the plain multi file compilation that just - merges the chosen asn1 specs or the <c>{inline,OutputModule}</c> - that also includes the used asn1 run-time functionality.</p> - <p>For both cases you need to specify which asn1 specs you will + <p>You need to specify which asn1 specs you will compile in a module that must have the extension <c>.set.asn</c>. You chose name of the module and provide the names of the asn1 specs. For instance, if you have the specs @@ -482,17 +446,7 @@ File3.asn </pre> <code type="none"> ~> erlc MyModule.set.asn </code> <p>the result will be one merged module <c>MyModule.erl</c> with - the generated code from the three asn1 specs. But if you compile - with:</p> - <code type="none"> -~> erlc +"{inline,'OutputModule'}" MyModule.set.asn </code> - <p>the result will be a module <c>OutputModule.erl</c> that - contains all encode/decode functions for the three asn1 specs and - all used functions from the asn1 run-time modules, in this case - <c>asn1rt_ber_bin</c>. In the former case all encode/decode - functions are exported but in the latter only the encode/decode - functions of the first spec in the <c>.set.asn</c>, i.e. those - from <c>File1.asn</c>. + the generated code from the three asn1 specs. </p> </section> @@ -688,7 +642,7 @@ Day1 = saturday, <section> <marker id="BIT STRING"></marker> - <title>BIT STRING </title> + <title>BIT STRING</title> <p>The BIT STRING type can be used to model information which is made up of arbitrary length series of bits. It is intended to be used for a selection of flags, not for binary files. <br></br> @@ -699,56 +653,66 @@ Day1 = saturday, Bits1 ::= BIT STRING Bits2 ::= BIT STRING {foo(0),bar(1),gnu(2),gnome(3),punk(14)} </pre> - <p>There are four different notations available for representation of + <p>There are five different notations available for representation of BIT STRING values in Erlang and as input to the encode functions.</p> <list type="ordered"> - <item>A list of binary digits (0 or 1).</item> - <item>A hexadecimal number (or an integer). This format should be - avoided, since it is easy to misinterpret a <c>BIT STRING</c> - value in this format. This format may be withdrawn in a future - release.</item> + <item>A bitstring. By default, a BIT STRING with no + symbolic names will be decoded to an Erlang bitstring.</item> <item>A list of atoms corresponding to atoms in the <c>NamedBitList</c> - in the BIT STRING definition.</item> + in the BIT STRING definition. A BIT STRING with symbolic + names will always be decoded to this format.</item> + <item>A list of binary digits (0 or 1). This format is always + accepted as input to the encode functions. A BIT STRING will + be decoded to this format if <em>legacy_bit_string</em> option + has been given. <em>This format may be withdrawn in a future + release.</em> + </item> <item>As <c>{Unused,Binary}</c> where <c>Unused</c> denotes how - many trailing zero-bits 0 to 7 that are unused in the least - significant byte in <c>Binary</c>. This notation is only - available when the ASN.1 files have been compiled with the - <em>+compact_bit_string</em> flag in the option list. In - this case it is possible to use all kinds of notation when - encoding. But the result when decoding is always in the - compact form. The benefit from this notation is a more - compact notation when one has large BIT STRINGs. The - encode/decode performance is also much better in the case of - large BIT STRINGs. </item> + many trailing zero-bits 0 to 7 that are unused in the least + significant byte in <c>Binary</c>. This format is always + accepted as input to the encode functions. A BIT STRING will + be decoded to this format if <em>compact_bit_string</em> has + been given. <em>This format may be withdrawn in a future + release.</em> + </item> + <item>A hexadecimal number (or an integer). This format should be + avoided, since it is easy to misinterpret a <c>BIT STRING</c> + value in this format. <em>This format may be withdrawn in a future + release.</em> + </item> </list> <note> - <p>Note that it is advised not to use the integer format of a - BIT STRING, see the second point above.</p> + <p>It is recommended to either use the bitstring format (for + BIT STRINGs with no symbolic names) or a list of symbolic + names (for BIT STRINGs with symbolic names). The other formats + should be avoided since they may be withdrawn in a future + release. + </p> </note> <pre> -Bits1Val1 = [0,1,0,1,1], +Bits1Val1 = <<0:1,1:1,0:1,1:1,1:1>>, Bits1Val2 = 16#1A, -Bits1Val3 = {3,<<0:1,1:1,0:1,1:1,1:1,0:3>>} +Bits1Val3 = {3,<<0:1,1:1,0:1,1:1,1:1,0:3>>}, +Bits1Val4 = [0,1,0,1,1] </pre> - <p>Note that <c>Bits1Val1</c>, <c>Bits1Val2</c> and <c>Bits1Val3</c> - denote the same value.</p> + <p>Note that <c>Bits1Val1</c>, <c>Bits1Val2</c>, <c>Bits1Val3</c>, + and <c>Bits1Val1</c> denote the same value.</p> <pre> Bits2Val1 = [gnu,punk], -Bits2Val2 = 2#1110, +Bits2Val2 = <<2#1110:4>>, Bits2Val3 = [bar,gnu,gnome], -Bits2Val4 = [0,1,1,1] </pre> - <p>The above <c>Bits2Val2</c>, <c>Bits2Val3</c> and <c>Bits2Val4</c> - also all denote the same value.</p> + <p><c>Bits2Val2</c> and <c>Bits2Val3</c> above denote the same value.</p> <p><c>Bits2Val1</c> is assigned symbolic values. The assignment means that the bits corresponding to <c>gnu</c> and <c>punk</c> i.e. bits 2 and 14 are set to 1 and the rest set to 0. The symbolic values appear as a list of values. If a named value appears, which is not specified in the type definition, a run-time error will occur.</p> <p>The compact notation equivalent to the empty BIT STRING is - <c><![CDATA[{0,<<>>}]]></c>, which in the other notations is <c>[]</c> or + <c><![CDATA[{0,<<>>}]]></c>, which in the other notations is + <c><![CDATA[<<>>]]></c>, <c>[]</c>, or <c>0</c>.</p> - <p>BIT STRINGS may also be sub-typed with for example a SIZE + <p>BIT STRINGS may also be sub-typed with, for example, a SIZE specification:</p> <pre> Bits3 ::= BIT STRING (SIZE(0..31)) </pre> diff --git a/lib/asn1/doc/src/asn1ct.xml b/lib/asn1/doc/src/asn1ct.xml index bb3c6a4f0f..b269276a92 100644 --- a/lib/asn1/doc/src/asn1ct.xml +++ b/lib/asn1/doc/src/asn1ct.xml @@ -64,8 +64,9 @@ <v>Asn1module = atom() | string()</v> <v>Options = [Option| OldOption]</v> <v>Option = ber | per | uper | der | compact_bit_string | + legacy_bit_string | noobj | {n2n, EnumTypeName} |{outdir, Dir} | {i, IncludeDir} | - asn1config | undec_rest | {inline, OutputName} | inline | + asn1config | undec_rest | {macro_name_prefix, Prefix} | {record_name_prefix, Prefix} | verbose | warnings_as_errors</v> <v>OldOption = ber | per</v> <v>Reason = term()</v> @@ -154,22 +155,26 @@ File3.asn </pre> <tag><c>compact_bit_string</c></tag> <item> <p> - Makes it possible to use a compact notation for values - of the BIT STRING type in Erlang. The notation: + The BIT STRING type will be decoded to the "compact notation". + <em>This option is not recommended for new code.</em> </p> - <pre> -BitString = {Unused, Binary}, -Unused = integer(), -Binary = binary() - </pre> + <p>For details see + <seealso marker="asn1_ug#BIT STRING"> + BIT STRING type section in the Users Guide + </seealso>. + </p> + </item> + <tag><c>legacy_bit_string</c></tag> + <item> <p> - <c>Unused</c> must be a number in the range 0 to 7. It - tells how many bits in the least significant byte in - <c>Binary</c> that is unused. - For details see + The BIT STRING type will be decoded to the legacy + format, i.e. a list of zeroes and ones. + <em>This option is not recommended for new code.</em> + </p> + <p>For details see <seealso marker="asn1_ug#BIT STRING"> - BIT STRING type section in users guide - </seealso>. + BIT STRING type section in the Users Guide + </seealso>. </p> </item> <tag><c>{n2n, EnumTypeName}</c></tag> @@ -233,28 +238,6 @@ Binary = binary() list or a binary. Earlier versions of the compiler ignored those following bytes.</p> </item> - <tag><c>{inline, OutputName}</c></tag> - <item> - <p>Compiling with this option gives one output module - containing all asn1 run-time functionality. The asn1 specs - are provided in a target module Module.set.asn as described - <seealso marker="#asn1set">above</seealso>. The name of the - resulting module containing generated encode/decode functions - and in-lined run-time functions will be - <c>OutputName.erl</c>. The merging/in-lining of code is done - by the <c>igor</c> module of <c>syntax_tools</c>. By default - the functions generated from the first asn1 spec in the - <c>.set.asn</c> are exported, unless a - <c>{export, [atom()]}</c> or <c>{export_all, true}</c> option - are provided. The list of atoms are names of chosen asn1 - specs from the <c>.set.asn</c> file. </p> - </item> - <tag><c>inline</c></tag> - <item> - <p>It is also possible to use the sole argument <c>inline</c>. - It is as <c>{inline, OutputName}</c>, but the output file gets the - default name of the source <c>.set.asn</c> file.</p> - </item> <tag><c>{macro_name_prefix, Prefix}</c></tag> <item> <p>All macro names generated by the compiler are prefixed with diff --git a/lib/asn1/src/.gitignore b/lib/asn1/src/.gitignore new file mode 100644 index 0000000000..621f8f3623 --- /dev/null +++ b/lib/asn1/src/.gitignore @@ -0,0 +1,2 @@ +/asn1ct_rtt.erl +/asn1ct_eval_*.erl diff --git a/lib/asn1/src/Makefile b/lib/asn1/src/Makefile index 4e61a6374b..faef9efd49 100644 --- a/lib/asn1/src/Makefile +++ b/lib/asn1/src/Makefile @@ -42,11 +42,17 @@ RELSYSDIR = $(RELEASE_PATH)/lib/asn1-$(VSN) # EBIN = ../ebin + +EVAL_CT_MODULES = asn1ct_eval_ext \ + asn1ct_eval_per \ + asn1ct_eval_uper + CT_MODULES= \ asn1ct \ asn1ct_check \ asn1_db \ asn1ct_pretty_format \ + asn1ct_func \ asn1ct_gen \ asn1ct_gen_per \ asn1ct_gen_per_rt2ct \ @@ -55,27 +61,16 @@ CT_MODULES= \ asn1ct_constructed_ber_bin_v2 \ asn1ct_gen_ber_bin_v2 \ asn1ct_imm \ + asn1ct_rtt \ asn1ct_value \ asn1ct_tok \ asn1ct_parser2 \ - asn1ct_table + asn1ct_table \ + $(EVAL_CT_MODULES) RT_MODULES= \ asn1rt \ - asn1rt_ber_bin \ - asn1rt_ber_bin_v2 \ - asn1rt_per_bin_rt2ct \ - asn1rt_uper_bin \ - asn1rt_check \ asn1rt_nif -# asn1_sup \ -# asn1_app \ -# asn1_server - - -# the rt module to use is defined in asn1_records.hrl -# and must be updated when an incompatible change is done in the rt modules - MODULES= $(CT_MODULES) $(RT_MODULES) @@ -138,6 +133,13 @@ info: $(EBIN)/asn1ct.$(EMULATOR):asn1ct.erl $(V_ERLC) -b$(EMULATOR) -o$(EBIN) $(ERL_COMPILE_FLAGS) -Dvsn=\"$(VSN)\" $< +$(EBIN)/asn1ct_func.$(EMULATOR): asn1ct_func.erl + $(ERLC) -o$(EBIN) $(ERL_COMPILE_FLAGS) -I../rt_templates $< + +asn1ct_eval_%.erl: asn1ct_eval_%.funcs + erl -pa $(EBIN) -noshell -noinput \ + -run prepare_templates gen_asn1ct_eval $< >$@ + $(APP_TARGET): $(APP_SRC) ../vsn.mk $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ @@ -165,6 +167,34 @@ release_spec: opt release_docs_spec: # +# Run-time library template files. +# + +RT_TEMPLATES = asn1rtt_check \ + asn1rtt_ext \ + asn1rtt_per_common \ + asn1rtt_real_common \ + asn1rtt_ber \ + asn1rtt_per \ + asn1rtt_uper + +RT_TEMPLATES_ERL = $(RT_TEMPLATES:%=%.erl) +RT_TEMPLATES_TARGET = $(RT_TEMPLATES:%=%.$(EMULATOR)) + +asn1ct_rtt.erl: prepare_templates.$(EMULATOR) $(RT_TEMPLATES_TARGET) + erl -noshell -noinput -run prepare_templates gen_asn1ct_rtt \ + $(RT_TEMPLATES_TARGET) >asn1ct_rtt.erl + +prepare_templates.$(EMULATOR): prepare_templates.erl + erlc prepare_templates.erl + +asn1rtt_%.$(EMULATOR): asn1rtt_%.erl + erlc +debug_info $< + +$(EVAL_CT_MODULES:%=%.erl): prepare_templates.$(EMULATOR) \ + $(EBIN)/asn1ct_rtt.$(EMULATOR) + +# # Dependencies # @@ -175,6 +205,7 @@ $(EBIN)/asn1ct_check.beam: asn1ct_check.erl asn1_records.hrl $(EBIN)/asn1ct_constructed_ber_bin_v2.beam: asn1ct_constructed_ber_bin_v2.erl \ asn1_records.hrl $(EBIN)/asn1ct_constructed_per.beam: asn1ct_constructed_per.erl asn1_records.hrl +$(EBIN)/asn1ct_func.beam: asn1ct_func.erl $(EBIN)/asn1ct_gen.beam: asn1ct_gen.erl asn1_records.hrl $(EBIN)/asn1ct_gen_ber_bin_v2.beam: asn1ct_gen_ber_bin_v2.erl asn1_records.hrl $(EBIN)/asn1ct_gen_per.beam: asn1ct_gen_per.erl asn1_records.hrl diff --git a/lib/asn1/src/asn1.app.src b/lib/asn1/src/asn1.app.src index 64b33a8a30..f2ee8deb75 100644 --- a/lib/asn1/src/asn1.app.src +++ b/lib/asn1/src/asn1.app.src @@ -3,11 +3,6 @@ {vsn, "%VSN%"}, {modules, [ asn1rt, - asn1rt_per_bin_rt2ct, - asn1rt_uper_bin, - asn1rt_ber_bin, - asn1rt_ber_bin_v2, - asn1rt_check, asn1rt_nif ]}, {registered, [ diff --git a/lib/asn1/src/asn1_records.hrl b/lib/asn1/src/asn1_records.hrl index 59a9acb7e7..c229aa0759 100644 --- a/lib/asn1/src/asn1_records.hrl +++ b/lib/asn1/src/asn1_records.hrl @@ -24,12 +24,6 @@ -define(dbg(Fmt, Args), no_debug). -endif. --define('RT_BER_BIN',"asn1rt_ber_bin"). --define('RT_PER_BIN',"asn1rt_per_bin"). - -%% Some encoding are common for BER and PER. Shared code are in RT_COMMON --define('RT_COMMON',asn1rt_ber_bin). - -define('COMPLETE_ENCODE',1). -define('TLV_DECODE',2). diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index 98877320a0..46602a3071 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -41,6 +41,7 @@ maybe_rename_function/3,latest_sindex/0,current_sindex/0, set_current_sindex/1,next_sindex/0,maybe_saved_sindex/2, parse_and_save/2,verbose/3,warning/3,warning/4,error/3]). +-export([get_bit_string_format/0]). -include("asn1_records.hrl"). -include_lib("stdlib/include/erl_compile.hrl"). @@ -86,10 +87,14 @@ compile(File) -> compile(File,[]). compile(File, Options0) when is_list(Options0) -> - Options1 = translate_options(Options0), - Options2 = includes(File,Options1), - Includes = strip_includes(Options2), - in_process(fun() -> compile_proc(File, Includes, Options2) end). + try translate_options(Options0) of + Options1 -> + Options2 = includes(File,Options1), + Includes = strip_includes(Options2), + in_process(fun() -> compile_proc(File, Includes, Options2) end) + catch throw:Error -> + Error + end. compile_proc(File, Includes, Options) -> case input_file_type(File, Includes) of @@ -115,63 +120,18 @@ compile1(File,Options) when is_list(Options) -> DbFile = outfile(Base,"asn1db",Options), Includes = [I || {i,I} <- Options], EncodingRule = get_rule(Options), - asn1ct_table:new(asn1_functab), Continue1 = scan(File,Options), Continue2 = parse(Continue1,File,Options), Continue3 = check(Continue2,File,OutFile,Includes,EncodingRule, DbFile,Options,[]), Continue4 = generate(Continue3,OutFile,EncodingRule,Options), - asn1ct_table:delete(asn1_functab), - Ret = compile_erl(Continue4,OutFile,Options), - case inline(is_inline(Options), - inline_output(Options,filename:rootname(File)), - lists:concat([OutFile,".erl"]),Options) of - false -> - Ret; - InlineRet -> - InlineRet - end. + compile_erl(Continue4, OutFile, Options). %%****************************************************************************%% %% functions dealing with compiling of several input files to one output file %% %%****************************************************************************%% -%%% -%% inline/4 -%% merges the resulting erlang modules with -%% the appropriate run-time modules so the resulting module contains all -%% run-time asn1 functionality. Then compiles the resulting file to beam code. -%% The merging is done by the igor module. If this function is used in older -%% versions than R10B the igor module, part of user contribution syntax_tools, -%% must be provided. It is possible to pass options for the ASN1 compiler -%% Types: -%% Name -> atom() -%% Modules -> [filename()] -%% Options -> [term()] -%% filename() -> file:filename() -inline(true,Name,Module,Options) -> - RTmodule = get_runtime_mod(Options), - IgorOptions = igorify_options(remove_asn_flags(Options)), - IgorName = list_to_atom(filename:rootname(filename:basename(Name))), -% io:format("*****~nName: ~p~nModules: ~p~nIgorOptions: ~p~n*****~n", -% [IgorName,Modules++RTmodule,IgorOptions]), - verbose("Inlining modules: ~p in ~p~n",[[Module]++RTmodule,IgorName],Options), - case catch igor:merge(IgorName,[Module]++RTmodule,[{preprocess,true},{stubs,false},{backups,false}]++IgorOptions) of - {'EXIT',{undef,Reason}} -> %% module igor first in R10B - error("Module igor in syntax_tools must be available:~n~p~n", - [Reason],Options), - {error,'no_compilation'}; - {'EXIT',Reason} -> - error("Merge by igor module failed due to ~p~n",[Reason],Options), - {error,'no_compilation'}; - _ -> -%% io:format("compiling output module: ~p~n",[generated_file(Name,IgorOptions)]), - erl_compile(generated_file(Name,IgorOptions),Options) - end; -inline(_,_,_,_) -> - false. - %% 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) @@ -183,7 +143,6 @@ compile_set(SetBase,Files,Options) DbFile = outfile(SetBase,"asn1db",Options), Includes = [I || {i,I} <- Options], EncodingRule = get_rule(Options), - asn1ct_table:new(asn1_functab), ScanRes = scan_set(Files,Options), ParseRes = parse_set(ScanRes,Options), Result = @@ -208,7 +167,6 @@ compile_set(SetBase,Files,Options) {error,{'unexpected error in scan/parse phase', lists:map(fun(X)->element(3,X) end,Other)}} end, - asn1ct_table:delete(asn1_functab), Result. check_set(ParseRes,SetBase,OutFile,Includes,EncRule,DbFile, @@ -222,15 +180,7 @@ check_set(ParseRes,SetBase,OutFile,Includes,EncRule,DbFile, asn1ct_table:delete([renamed_defs, original_imports, automatic_tags]), - Ret = compile_erl(Continue2,OutFile,Options), - case inline(is_inline(Options), - inline_output(Options,filename:rootname(OutFile)), - lists:concat([OutFile,".erl"]),Options) of - false -> - Ret; - InlineRet -> - InlineRet - end. + compile_erl(Continue2, OutFile, Options). %% 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 @@ -817,12 +767,9 @@ check({true,M},File,OutFile,Includes,EncodingRule,DbFile,Options,InputMods) -> check({false,M},_,_,_,_,_,_,_) -> {false,M}. -generate({true,{M,_Module,GenTOrV}},OutFile,EncodingRule,Options) -> +generate({true,{M,_Module,GenTOrV}}, OutFile, EncodingRule, Options) -> debug_on(Options), - case lists:member(compact_bit_string,Options) of - true -> put(compact_bit_string,true); - _ -> ok - end, + setup_bit_string_format(Options), put(encoding_options,Options), asn1ct_table:new(check_functions), @@ -844,8 +791,8 @@ generate({true,{M,_Module,GenTOrV}},OutFile,EncodingRule,Options) -> ok end, debug_off(Options), - put(compact_bit_string,false), erase(encoding_options), + cleanup_bit_string_format(), erase(tlv_format), % used in ber erase(class_default_type),% used in ber asn1ct_table:delete(check_functions), @@ -863,6 +810,26 @@ generate({true,{M,_Module,GenTOrV}},OutFile,EncodingRule,Options) -> generate({false,M},_,_,_) -> {false,M}. +setup_bit_string_format(Opts) -> + Format = case {lists:member(compact_bit_string, Opts), + lists:member(legacy_bit_string, Opts)} of + {false,false} -> bitstring; + {true,false} -> compact; + {false,true} -> legacy; + {true,true} -> + Message = "Contradicting options given: " + "compact_bit_string and legacy_bit_string", + exit({error,{asn1,Message}}) + end, + put(bit_string_format, Format). + +cleanup_bit_string_format() -> + erase(bit_string_format). + +get_bit_string_format() -> + get(bit_string_format). + + %% parse_and_save parses an asn1 spec and saves the unchecked parse %% tree in a data base file. %% Does not support multifile compilation files @@ -1069,18 +1036,8 @@ get_rule(Options) -> ber end. -get_runtime_mod(Options) -> - RtMod1= - case get_rule(Options) of - per -> "asn1rt_per_bin_rt2ct.erl"; - ber -> ["asn1rt_ber_bin_v2.erl"]; - uper -> ["asn1rt_uper_bin.erl"] - end, - RtMod1++["asn1rt_check.erl","asn1rt.erl"]. - %% translate_options(NewOptions) -> OldOptions %% Translate the new option names to the old option name. -%% FIXME. We should rewrite all code to handle the new option names. translate_options([ber_bin|T]) -> io:format("Warning: The option 'ber_bin' is now called 'ber'.\n"), @@ -1097,6 +1054,12 @@ translate_options([nif|T]) -> translate_options([optimize|T]) -> io:format("Warning: The option 'optimize' is no longer needed.\n"), translate_options(T); +translate_options([inline|T]) -> + io:format("Warning: The option 'inline' is no longer needed.\n"), + translate_options(T); +translate_options([{inline,_}|_]) -> + io:format("ERROR: The option {inline,OutputFilename} is no longer supported.\n"), + throw({error,{unsupported_option,inline}}); translate_options([H|T]) -> [H|translate_options(T)]; translate_options([]) -> []. @@ -1122,6 +1085,7 @@ remove_asn_flags(Options) -> X /= get_rule(Options), X /= optimize, X /= compact_bit_string, + X /= legacy_bit_string, X /= debug, X /= asn1config, X /= record_name_prefix]. @@ -1134,23 +1098,6 @@ debug_on(Options) -> true end. -igorify_options(Options) -> - case lists:keysearch(outdir,1,Options) of - {value,{_,Dir}} -> - Options1 = lists:keydelete(outdir,1,Options), - [{dir,Dir}|Options1]; - _ -> - Options - end. - -generated_file(Name,Options) -> - case lists:keysearch(dir,1,Options) of - {value,{_,Dir}} -> - filename:join([Dir,filename:basename(Name)]); - _ -> - Name - end. - debug_off(_Options) -> erase(asndebug). @@ -1191,21 +1138,6 @@ option_add(Option, Options, Fun) -> strip_includes(Includes) -> [I || {i, I} <- Includes]. -is_inline(Options) -> - case lists:member(inline,Options) of - true -> true; - _ -> - lists:keymember(inline,1,Options) - end. - -inline_output(Options,Default) -> - case [X||{inline,X}<-Options] of - [OutputName] -> - OutputName; - _ -> - Default - end. - %% compile(AbsFileName, Options) %% Compile entry point for erl_compile. diff --git a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl index 78cb9297d8..d5097e83c5 100644 --- a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl @@ -66,9 +66,9 @@ gen_encode_sequence(Erules,Typename,D) when is_record(D,type) -> ValName = case Typename of ['EXTERNAL'] -> - emit([indent(4), - "NewVal = asn1rt_check:transform_to_EXTERNAL1990(Val),", - nl]), + emit([indent(4),"NewVal = ", + {call,ext,transform_to_EXTERNAL1990,["Val"]}, + com,nl]), "NewVal"; _ -> "Val" @@ -162,7 +162,8 @@ gen_encode_sequence(Erules,Typename,D) when is_record(D,type) -> emit([nl," BytesSoFar = "]), case SeqOrSet of 'SET' when (D#type.def)#'SET'.sorted == dynamic -> - emit("asn1rt_check:dynamicsort_SET_components(["), + asn1ct_func:need({ber,dynamicsort_SET_components,1}), + emit("dynamicsort_SET_components(["), mkvlist(asn1ct_name:all(encBytes)), emit(["]),",nl]); _ -> @@ -177,8 +178,8 @@ gen_encode_sequence(Erules,Typename,D) when is_record(D,type) -> mkvplus(AllLengths) end, emit([",",nl]), - emit(["?RT_BER:encode_tags(TagIn, BytesSoFar, LenSoFar)." - ,nl]). + call(encode_tags, ["TagIn","BytesSoFar","LenSoFar"]), + emit([".",nl]). gen_decode_sequence(Erules,Typename,D) when is_record(D,type) -> asn1ct_name:start(), @@ -207,7 +208,8 @@ gen_decode_sequence(Erules,Typename,D) when is_record(D,type) -> _ -> emit([{curr,tlv}," = "]) end, - emit(["?RT_BER:match_tags(",{prev,tlv},",TagIn), ",nl]), + call(match_tags, [{prev,tlv},"TagIn"]), + emit([com,nl]), asn1ct_name:new(tlv), asn1ct_name:new(v), @@ -287,8 +289,9 @@ gen_decode_sequence(Erules,Typename,D) when is_record(D,type) -> "', "]), mkvlist(asn1ct_name:all(term)), emit(["},",nl]), - emit([" asn1rt_check:transform_to_EXTERNAL1994", - "(OldFormat).",nl]); + emit([" ", + {call,ext,transform_to_EXTERNAL1994, + ["OldFormat"]},".",nl]); _ -> emit([" {'",RecordName,"', "]), mkvlist(asn1ct_name:all(term)), @@ -371,7 +374,8 @@ gen_decode_set(Erules,Typename,D) when is_record(D,type) -> _ -> emit([{curr,tlv}," = "]) end, - emit(["?RT_BER:match_tags(",{prev,tlv},",TagIn), ",nl]), + call(match_tags, [{prev,tlv},"TagIn"]), + emit([com,nl]), asn1ct_name:new(v), @@ -492,7 +496,8 @@ gen_encode_sof(Erules,Typename,_InnerTypename,D) when is_record(D,type) -> emit([" {EncBytes,EncLen} = 'enc_",asn1ct_gen:list2name(Typename), "_components'(Val",Objfun,",[],0),",nl]), - emit([" ?RT_BER:encode_tags(TagIn, EncBytes, EncLen).",nl,nl]), + emit([" ",{call,ber,encode_tags,["TagIn","EncBytes","EncLen"]}, + ".",nl,nl]), gen_encode_sof_components(Erules,Typename,SeqOrSetOf,Cont). @@ -512,8 +517,8 @@ gen_decode_sof(Erules,TypeName,_InnerTypeName,D) when is_record(D,type) -> emit([" %%-------------------------------------------------",nl]), asn1ct_name:new(tlv), - emit([{curr,tlv}, - " = ?RT_BER:match_tags(",{prev,tlv},",TagIn), ",nl]), + emit([{curr,tlv}," = ", + {call,ber,match_tags,[{prev,tlv},"TagIn"]},com,nl]), asn1ct_name:new(v), emit(["["]), @@ -551,8 +556,9 @@ gen_encode_sof_components(Erules,Typename,SeqOrSetOf,Cont) case catch lists:member(der,get(encoding_options)) of true when SeqOrSetOf=='SET OF'-> + asn1ct_func:need({ber,dynamicsort_SETOF,1}), emit([indent(3), - "{asn1rt_check:dynamicsort_SETOF(AccBytes),AccLen};",nl,nl]); + "{dynamicsort_SETOF(AccBytes),AccLen};",nl,nl]); _ -> emit([indent(3),"{lists:reverse(AccBytes),AccLen};",nl,nl]) end, @@ -672,8 +678,9 @@ gen_dec_sequence_call2(Erules,TopType,{Root1,EList,Root2},_Ext,DecObjInf) -> %% including the first mandatory element. TagList = get_root2_taglist(Root2,[]), emit({com,nl}), - emit([{curr,tlv}," = ?RT_BER:skip_ExtensionAdditions(", - {prev,tlv},", ",{asis,TagList},"),",nl]), + emit([{curr,tlv}," = ", + {call,ber,skip_ExtensionAdditions, + [{prev,tlv},{asis,TagList}]},com,nl]), asn1ct_name:new(tlv), gen_dec_sequence_call1(Erules,TopType,Root2, length(Root1)+length(EList),noext, @@ -805,8 +812,8 @@ gen_enc_choice1(Erules,TopType,_Tag,CompList,_Ext) -> emit([" {EncBytes,EncLen} = case element(1,Val) of",nl]), gen_enc_choice2(Erules,TopType,CompList), emit([nl," end,",nl,nl]), - - emit(["?RT_BER:encode_tags(TagIn, EncBytes, EncLen).",nl]). + call(encode_tags, ["TagIn","EncBytes","EncLen"]), + emit([".",nl]). gen_enc_choice2(Erules,TopType,[H1|T]) when is_record(H1,'ComponentType') -> @@ -859,8 +866,8 @@ gen_enc_choice2(_Erules,_TopType,[]) -> gen_dec_choice(Erules,TopType, _ChTag, CompList, Ext) -> asn1ct_name:clear(), asn1ct_name:new(tlv), - emit([{curr,tlv}, - " = ?RT_BER:match_tags(",{prev,tlv},",TagIn), ",nl]), + emit([{curr,tlv}," = ", + {call,ber,match_tags,[{prev,tlv},"TagIn"]},com,nl]), asn1ct_name:new(tlv), asn1ct_name:new(v), emit(["case (case ",{prev,tlv}, @@ -876,8 +883,8 @@ gen_dec_choice(Erules,TopType, _ChTag, CompList, Ext) -> emit([indent(9),"exit({error,{asn1,{invalid_choice_tag,", {curr,else},"}}})",nl]); _ -> - emit([indent(9),"{asn1_ExtAlt, ?RT_BER:encode(",{curr,else}, - asn1ct_gen:nif_parameter(),")}",nl]) + emit([indent(9),"{asn1_ExtAlt,", + {call,ber,ber_encode,[{curr,else}]},"}",nl]) end, emit([indent(3),"end",nl]), asn1ct_name:new(tag), @@ -1018,29 +1025,20 @@ gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,Assign,EncObj) case OptOrMand of mandatory -> emit(["{",{curr,encBytes},",",{curr,encLen}, - "} = "]), - emit(["?RT_BER:encode_open_type(",{curr,tmpBytes}, - ",",{asis,Tag},")"]); + "} = ", + {call,ber,encode_open_type, + [{curr,tmpBytes},{asis,Tag}]},nl]); _ -> -% emit(["{",{next,tmpBytes},", _} = "]), emit(["{",{next,tmpBytes},",",{curr,tmpLen}, - "} = "]), - emit(["?RT_BER:encode_open_type(",{curr,tmpBytes}, - ",",{asis,Tag},"),",nl]), + "} = ", + {call,ber,encode_open_type, + [{curr,tmpBytes},{asis,Tag}]},com,nl]), emit(IndDeep), emit(["{",{next,tmpBytes},", ",{curr,tmpLen},"}"]) end; Err -> throw({asn1,{'internal error',Err}}) end; -%% {{#'ObjectClassFieldType'{type={objectfield,PrimFieldName1, -%% PFNList}},_}, -%% {componentrelation,_,_}} -> -%% %% this is when the dotted list in the FieldName has more -%% %% than one element -%% {_LeadingAttrName,Fun} = EncObj, -%% emit(["?RT_BER:encode_open_type(",Fun,"(",{asis,PrimFieldName1}, -%% ", ",Element,", ",{asis,PFNList},"))"]); _ -> case WhatKind of {primitive,bif} -> @@ -1238,15 +1236,11 @@ gen_dec_call({typefield,_},_,_,_Cname,Type,BytesVar,Tag,_,_,false,_) -> asn1ct_name:new(tmptlv), {FirstPFName,RestPFName} = -% asn1ct_gen:get_constraint(Type#type.constraint, -% tableconstraint_info), (Type#type.def)#'ObjectClassFieldType'.fieldname, emit([nl,indent(6),"begin",nl]), -% emit([indent(9),{curr,opendec}," = ?RT_BER:decode_open_type(", - emit([indent(9),{curr,tmptlv}," = ?RT_BER:decode_open_type(", - BytesVar,",",{asis,Tag},asn1ct_gen:nif_parameter(),"),",nl]), -% emit([indent(9),"{",{curr,tmptlv},",_} = ?RT_BER:decode(", -% {curr,opendec},"),",nl]), + emit([indent(9),{curr,tmptlv}," = ", + {call,ber,decode_open_type, + [BytesVar,{asis,Tag}]},com,nl]), emit([indent(9),"case (catch ObjFun(",{asis,FirstPFName}, ", ",{curr,tmptlv},", ",{asis,RestPFName}, @@ -1259,8 +1253,7 @@ gen_dec_call({typefield,_},_,_,_Cname,Type,BytesVar,Tag,_,_,false,_) -> emit([indent(9),"end",nl,indent(6),"end",nl]), []; gen_dec_call({typefield,_},_,_,Cname,Type,BytesVar,Tag,_,_,_DecObjInf,OptOrMandComp) -> - emit(["?RT_BER:decode_open_type(",BytesVar,",",{asis,Tag}, - asn1ct_gen:nif_parameter(),")"]), + call(decode_open_type, [BytesVar,{asis,Tag}]), RefedFieldName = % asn1ct_gen:get_constraint(Type#type.constraint, % tableconstraint_info), @@ -1268,8 +1261,7 @@ gen_dec_call({typefield,_},_,_,Cname,Type,BytesVar,Tag,_,_,_DecObjInf,OptOrMandC [{Cname,RefedFieldName,asn1ct_gen:mk_var(asn1ct_name:curr(term)), asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),Tag,OptOrMandComp}]; gen_dec_call({objectfield,PrimFieldName,PFNList},_,_,Cname,_,BytesVar,Tag,_,_,_,OptOrMandComp) -> - emit(["?RT_BER:decode_open_type(",BytesVar,",",{asis,Tag}, - asn1ct_gen:nif_parameter(),")"]), + call(decode_open_type, [BytesVar,{asis,Tag}]), [{Cname,{PrimFieldName,PFNList},asn1ct_gen:mk_var(asn1ct_name:curr(term)), asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),Tag,OptOrMandComp}]; gen_dec_call(InnerType,Erules,TopType,Cname,Type,BytesVar,Tag,PrimOptOrMand, @@ -1301,7 +1293,6 @@ gen_dec_call1({primitive,bif},InnerType,Erules,TopType,Cname,Type,BytesVar, asn1ct:add_generated_refed_func({[Cname|TopType],undecoded, Tag,Type}), asn1ct:update_gen_state(namelist,Rest), -% emit(["?RT_BER:match_tags(",BytesVar,",",{asis,Tag},")"]); emit(["{'",asn1ct_gen:list2name([Cname|TopType]),"',", BytesVar,"}"]); {_,{fixedtypevaluefield,_,Btype}} -> @@ -1320,7 +1311,6 @@ gen_dec_call1('ASN1_OPEN_TYPE',_InnerType,Erules,TopType,Cname,Type,BytesVar, asn1ct:update_gen_state(namelist,Rest), emit(["{'",asn1ct_gen:list2name([Cname|TopType]),"',", BytesVar,"}"]); -% emit(["?RT_BER:match_tags(",BytesVar,",",{asis,Tag},")"]); {_,#'ObjectClassFieldType'{type=OpenType}} -> ?ASN1CT_GEN_BER:gen_dec_prim(Erules,#type{def=OpenType}, BytesVar,Tag,[], @@ -1393,7 +1383,8 @@ gen_dec_call1(WhatKind,_,_Erules,TopType,Cname,Type,BytesVar, parts, [],Type}), emit(["{'",asn1ct_gen:list2name([Cname|TopType]),"',"]), - EmitDecFunCall("?RT_BER:match_tags"), + asn1ct_func:need({ber,match_tags,2}), + EmitDecFunCall("match_tags"), emit("}"); _ -> {DecFunName,_,_}= @@ -1522,3 +1513,6 @@ value_match1(Value,[],Acc,Depth) -> Acc ++ Value ++ lists:concat(lists:duplicate(Depth,")")); value_match1(Value,[{VI,_}|VIs],Acc,Depth) -> value_match1(Value,VIs,Acc++lists:concat(["element(",VI,","]),Depth+1). + +call(F, Args) -> + asn1ct_func:call(ber, F, Args). diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl index 27070be966..3c59c73108 100644 --- a/lib/asn1/src/asn1ct_constructed_per.erl +++ b/lib/asn1/src/asn1ct_constructed_per.erl @@ -32,6 +32,7 @@ %-compile(export_all). -import(asn1ct_gen, [emit/1,demit/1,get_record_name_prefix/0]). +-import(asn1ct_func, [call/3]). %% ENCODE GENERATOR FOR SEQUENCE TYPE ** ********** @@ -66,9 +67,9 @@ gen_encode_constructed(Erule,Typename,D) when is_record(D,type) -> end, case Typename of ['EXTERNAL'] -> - emit({{next,val}, - " = asn1rt_check:transform_to_EXTERNAL1990(", - {curr,val},"),",nl}), + emit([{next,val}," = ", + {call,ext,transform_to_EXTERNAL1990, + [{curr,val}]},com,nl]), asn1ct_name:new(val); _ -> ok @@ -86,7 +87,8 @@ gen_encode_constructed(Erule,Typename,D) when is_record(D,type) -> end,asn1ct_name:all(fixopt)), emit({"{",{next,val},",Opt} = {",{curr,val},",[",FixOpts,"]},",nl}); {_,_,false} -> - Fixoptcall = ",Opt} = ?RT_PER:fixoptionals(", + asn1ct_func:need({Erule,fixoptionals,3}), + Fixoptcall = ",Opt} = fixoptionals(", emit({"{",{next,val},Fixoptcall, {asis,Optionals},",",length(Optionals), ",",{curr,val},"),",nl}) @@ -121,8 +123,9 @@ gen_encode_constructed(Erule,Typename,D) when is_record(D,type) -> lists:foreach(ExtGroupFun,ExtGroupPosLenList) end, asn1ct_name:new(tmpval), - emit(["Extensions = ?RT_PER:fixextensions(",{asis,Ext},",", - {curr,val},"),",nl]); + emit(["Extensions = ", + {call,Erule,fixextensions,[{asis,Ext},{curr,val}]}, + com,nl]); _ -> true end, EncObj = @@ -191,10 +194,10 @@ gen_encode_constructed(Erule,Typename,D) when is_record(D,type) -> MaybeComma1 = case Ext of {ext,_Pos,NumExt2} when NumExt2 > 0 -> - emit({"?RT_PER:setext(Extensions =/= [])"}), + call(Erule, setext, ["Extensions =/= []"]), ", "; {ext,_Pos,_} -> - emit({"?RT_PER:setext(false)"}), + call(Erule, setext, ["false"]), ", "; _ -> "" @@ -383,9 +386,10 @@ gen_dec_constructed_imm_2(Typename, CompList, "'"}), mkvlist(asn1ct_name:all(term)), emit({"},",nl}), - emit({" ASN11994Format =",nl, - " asn1rt_check:transform_to_EXTERNAL1994", - "(OldFormat),",nl}), + emit([" ASN11994Format =",nl, + " ", + {call,ext,transform_to_EXTERNAL1994, + ["OldFormat"]},com,nl]), emit(" {ASN11994Format,"); _ -> emit(["{{'",RecordName,"'"]), @@ -513,7 +517,7 @@ gen_encode_sof(Erule,Typename,SeqOrSetOf,D) when is_record(D,type) -> _-> "" end, - gen_encode_length(SizeConstraint, is_optimized(Erule)), + gen_encode_length(Erule, SizeConstraint), emit({indent(3),"'enc_",asn1ct_gen:list2name(Typename), "_components'(Val",ObjFun,", [])"}), emit({nl,"].",nl}), @@ -527,7 +531,7 @@ gen_encode_sof(Erule,Typename,SeqOrSetOf,D) when is_record(D,type) -> %% Logic copied from asn1_per_bin_rt2ct:encode_constrained_number -gen_encode_length({Lb,Ub},true) when Ub =< 65535, Lb >= 0 -> +gen_encode_length(per, {Lb,Ub}) when Ub =< 65535, Lb >= 0 -> Range = Ub - Lb + 1, V2 = ["(length(Val) - ",Lb,")"], Encode = if @@ -554,12 +558,20 @@ gen_encode_length({Lb,Ub},true) when Ub =< 65535, Lb >= 0 -> Range =< 65536 -> {"[20,2,<<",V2,":16>>]"}; true -> - {"?RT_PER:encode_length(",{asis,{Lb,Ub}},",length(Val))"} + {call,per,encode_length, + [{asis,{Lb,Ub}},"length(Val)"]} end, emit({nl,Encode,",",nl}); -gen_encode_length(SizeConstraint,_) -> - emit({nl,indent(3),"?RT_PER:encode_length(", - {asis,SizeConstraint},",length(Val)),",nl}). +gen_encode_length(Erules, SizeConstraint) -> + emit([nl,indent(3), + case SizeConstraint of + undefined -> + {call,Erules,encode_length,["length(Val)"]}; + _ -> + {call,Erules,encode_length, + [{asis,SizeConstraint},"length(Val)"]} + end, + com,nl]). gen_decode_sof(Erules,Typename,SeqOrSetOf,D) when is_record(D,type) -> asn1ct_name:start(), @@ -1003,7 +1015,9 @@ gen_enc_line(Erule,TopType,Cname,Type,Element, _Pos,DynamicEnc,Ext) -> case Ext of {ext,_Ep1,_} -> - emit(["?RT_PER:encode_open_type(dummy,?RT_PER:complete("]); + asn1ct_func:need({Erule,encode_open_type,1}), + asn1ct_func:need({Erule,complete,1}), + emit(["encode_open_type(complete("]); _ -> true end, @@ -1015,7 +1029,9 @@ gen_enc_line(Erule,TopType,Cname,Type,Element, _Pos,DynamicEnc,Ext) -> {notype,T} -> throw({error,{notype,type_from_object,T}}); {Name,RestFieldNames} when is_atom(Name) -> - emit({"?RT_PER:encode_open_type([],?RT_PER:complete(",nl}), + asn1ct_func:need({Erule,complete,1}), + asn1ct_func:need({Erule,encode_open_type,1}), + emit({"encode_open_type(complete(",nl}), emit({" ",Fun,"(",{asis,Name},", ", Element,", ",{asis,RestFieldNames},")))"}); Other -> @@ -1025,8 +1041,10 @@ gen_enc_line(Erule,TopType,Cname,Type,Element, _Pos,DynamicEnc,Ext) -> {objectfield,PrimFieldName1,PFNList} -> case DynamicEnc of {_LeadingAttrName,Fun} -> - emit({"?RT_PER:encode_open_type([]," - "?RT_PER:complete(",nl}), + asn1ct_func:need({Erule,complete,1}), + asn1ct_func:need({Erule,encode_open_type,1}), + emit({"encode_open_type(" + "complete(",nl}), emit({" ",Fun,"(",{asis,PrimFieldName1}, ", ",Element,", ",{asis,PFNList},")))"}) end; @@ -1105,8 +1123,9 @@ gen_dec_components_call(Erule,TopType,CL={Root1,ExtList,Root2}, NumExtsToSkip = ext_length(ExtList), Finish = fun(St) -> - emit([{next,bytes},"= ?RT_PER:skipextensions(",{curr,bytes},",", - NumExtsToSkip+1,",Extensions)"]), + emit([{next,bytes},"= "]), + call(Erule, skipextensions, + [{curr,bytes},NumExtsToSkip+1,"Extensions"]), asn1ct_name:new(bytes), St end, @@ -1276,8 +1295,8 @@ gen_dec_comp_call(Comp, Erule, TopType, Tpos, OptTable, DecInfObj, St end}, [{group,[{safe,Comment},{safe,Preamble}, - {safe,OptOrDef}|Lines]++ - [{safe,Postamble},{safe,AdvBuffer}]}]. + OptOrDef|Lines]++ + [Postamble,{safe,AdvBuffer}]}]. is_mandatory_predef_tab_c(noext, mandatory, {"got objfun through args","ObjFun"}) -> @@ -1499,7 +1518,6 @@ gen_dec_line_dec_inf(Comp, DecInfObj) -> gen_dec_line_other(Erule, Atype, TopType, Comp) -> #'ComponentType'{name=Cname,typespec=Type} = Comp, CurrMod = get(currmod), - Ctgenmod = asn1ct_gen:ct_gen_module(Erule), case asn1ct_gen:type(Atype) of #'Externaltypereference'{module=CurrMod,type=EType} -> fun(BytesVar) -> @@ -1513,16 +1531,16 @@ gen_dec_line_other(Erule, Atype, TopType, Comp) -> {primitive,bif} -> case Atype of {fixedtypevaluefield,_,Btype} -> - gen_dec_prim(Ctgenmod, Erule, Btype); + asn1ct_gen_per:gen_dec_imm(Erule, Btype); _ -> - gen_dec_prim(Ctgenmod, Erule, Type) + asn1ct_gen_per:gen_dec_imm(Erule, Type) end; 'ASN1_OPEN_TYPE' -> case Type#type.def of #'ObjectClassFieldType'{type=OpenType} -> - gen_dec_prim(Ctgenmod, Erule, #type{def=OpenType}); + asn1ct_gen_per:gen_dec_imm(Erule, #type{def=OpenType}); _ -> - gen_dec_prim(Ctgenmod, Erule, Type) + asn1ct_gen_per:gen_dec_imm(Erule, Type) end; #typereference{val=Dname} -> fun(BytesVar) -> @@ -1548,40 +1566,34 @@ gen_dec_line_other(Erule, Atype, TopType, Comp) -> end end. -gen_dec_prim(Ctgenmod, Erule, Type) -> - case asn1ct_gen_per:gen_dec_imm(Erule, Type) of - no -> - fun(BytesVar) -> - Ctgenmod:gen_dec_prim(Erule, Type, BytesVar) - end; - Imm -> - Imm - end. - gen_enc_choice(Erule,TopType,CompList,Ext) -> - gen_enc_choice_tag(CompList, [], Ext), + gen_enc_choice_tag(Erule, CompList, [], Ext), emit({com,nl}), emit({"case element(1,Val) of",nl}), gen_enc_choice2(Erule,TopType, CompList, Ext), emit({nl,"end"}). -gen_enc_choice_tag({C1,C2},_,_) -> +gen_enc_choice_tag(Erule, {C1,C2}, _, _) -> N1 = get_name_list(C1), N2 = get_name_list(C2), - emit(["?RT_PER:set_choice(element(1,Val),", - {asis,{N1,N2}},", ",{asis,{length(N1),length(N2)}},")"]); - -gen_enc_choice_tag({C1,C2,C3},_,_) -> + call(Erule,set_choice, + ["element(1, Val)", + {asis,{N1,N2}}, + {asis,{length(N1),length(N2)}}]); +gen_enc_choice_tag(Erule, {C1,C2,C3}, _, _) -> N1 = get_name_list(C1), N2 = get_name_list(C2), N3 = get_name_list(C3), Root = N1 ++ N3, - emit(["?RT_PER:set_choice(element(1,Val),", - {asis,{Root,N2}},", ",{asis,{length(Root),length(N2)}},")"]); -gen_enc_choice_tag(C,_,_) -> + call(Erule,set_choice, + ["element(1, Val)", + {asis,{Root,N2}}, + {asis,{length(Root),length(N2)}}]); +gen_enc_choice_tag(Erule, C, _, _) -> N = get_name_list(C), - emit(["?RT_PER:set_choice(element(1,Val),", - {asis,N},", ",{asis,length(N)},")"]). + call(Erule,set_choice, + ["element(1, Val)", + {asis,N},{asis,length(N)}]). get_name_list(L) -> get_name_list(L,[]). @@ -1650,17 +1662,18 @@ gen_enc_choice2(_Erule,_,[], _, _) -> true. gen_dec_choice(Erule,TopType,CompList,{ext,Pos,NumExt}) -> - emit({"{Ext,",{curr,bytes},"} = ?RT_PER:getbit(Bytes),",nl}), + emit(["{Ext,",{curr,bytes},"} = ", + {call,Erule,getbit,["Bytes"]},com,nl]), 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}, - "} = ?RT_PER:getchoice(",{prev,bytes},",", - length(CompList),", 0),",nl}), - emit({"{Cname,{Val,NewBytes}} = case Choice of",nl}), + 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}"}); @@ -1671,9 +1684,9 @@ 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}, - "} = ?RT_PER:getchoice(",{prev,bytes},",", - length(CompList)-ExtNum,",Ext ),",nl}), + 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}), Imm = asn1ct_imm:per_dec_open_type(is_aligned(Erule)), diff --git a/lib/asn1/src/asn1ct_eval_ext.funcs b/lib/asn1/src/asn1ct_eval_ext.funcs new file mode 100644 index 0000000000..5761901f89 --- /dev/null +++ b/lib/asn1/src/asn1ct_eval_ext.funcs @@ -0,0 +1 @@ +{ext,transform_to_EXTERNAL1994,1}. diff --git a/lib/asn1/src/asn1ct_eval_per.funcs b/lib/asn1/src/asn1ct_eval_per.funcs new file mode 100644 index 0000000000..a1ea5cd043 --- /dev/null +++ b/lib/asn1/src/asn1ct_eval_per.funcs @@ -0,0 +1,2 @@ +{per,encode_constrained_number,2}. +{per,encode_small_number,1}. diff --git a/lib/asn1/src/asn1ct_eval_uper.funcs b/lib/asn1/src/asn1ct_eval_uper.funcs new file mode 100644 index 0000000000..884a486f40 --- /dev/null +++ b/lib/asn1/src/asn1ct_eval_uper.funcs @@ -0,0 +1,2 @@ +{uper,encode_constrained_number,2}. +{uper,encode_small_number,1}. diff --git a/lib/asn1/src/asn1ct_func.erl b/lib/asn1/src/asn1ct_func.erl new file mode 100644 index 0000000000..2d221ca1b9 --- /dev/null +++ b/lib/asn1/src/asn1ct_func.erl @@ -0,0 +1,105 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(asn1ct_func). +-export([start_link/0,need/1,call/3,generate/1]). +-export([init/1,handle_call/3,handle_cast/2,terminate/2]). + +start_link() -> + {ok,Pid} = gen_server:start_link(?MODULE, [], []), + put(?MODULE, Pid), + ok. + +call(M, F, Args) -> + MFA = {M,F,length(Args)}, + need(MFA), + asn1ct_gen:emit([F,"(",call_args(Args, ""),")"]). + +need(MFA) -> + asn1ct_rtt:assert_defined(MFA), + cast({need,MFA}). + +generate(Fd) -> + req({generate,Fd}), + erase(?MODULE), + ok. + +req(Req) -> + gen_server:call(get(?MODULE), Req, infinity). + +cast(Req) -> + gen_server:cast(get(?MODULE), Req). + +%%% Internal functions. + +-record(st, {used}). + +init([]) -> + St = #st{used=gb_sets:empty()}, + {ok,St}. + +handle_cast({need,MFA}, #st{used=Used0}=St) -> + case gb_sets:is_member(MFA, Used0) of + false -> + Used = pull_in_deps(gb_sets:singleton(MFA), Used0), + {noreply,St#st{used=Used}}; + true -> + {noreply,St} + end. + +handle_call({generate,Fd}, _From, #st{used=Used}=St) -> + generate(Fd, Used), + {stop,normal,ok,St}. + +terminate(_, _) -> + ok. + +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 -> + Used0; + false -> + {MFA,Ws1} = gb_sets:take_smallest(Ws0), + Used = gb_sets:add(MFA, Used0), + Needs = asn1ct_rtt:dependencies(MFA), + Ws = update_worklist(Needs, Used, Ws1), + pull_in_deps(Ws, Used) + end. + +update_worklist([H|T], Used, Ws) -> + case gb_sets:is_member(H, Used) of + false -> + update_worklist(T, Used, gb_sets:add(H, Ws)); + true -> + update_worklist(T, Used, Ws) + end; +update_worklist([], _, Ws) -> Ws. diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index 57b12ce186..79f0593c37 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -46,7 +46,6 @@ un_hyphen_var/1]). -export([gen_encode_constructed/4, gen_decode_constructed/4]). --export([nif_parameter/0]). %% pgen(Outfile, Erules, Module, TypeOrVal, Options) %% Generate Erlang module (.erl) and (.hrl) file corresponding to an ASN.1 module @@ -78,6 +77,7 @@ pgen_module(OutFile,Erules,Module, ErlFile = lists:concat([OutFile,".erl"]), Fid = fopen(ErlFile,[write]), put(gen_file_out,Fid), + asn1ct_func:start_link(), gen_head(Erules,Module,HrlGenerated), pgen_exports(Erules,Module,TypeOrVal), pgen_dispatcher(Erules,Module,TypeOrVal), @@ -86,6 +86,11 @@ pgen_module(OutFile,Erules,Module, pgen_partial_incomplete_decode(Erules), % gen_vars(asn1_db:mod_to_vars(Module)), % gen_tag_table(AllTypes), + emit([nl, + "%%%",nl, + "%%% Run-time functions.",nl, + "%%%",nl]), + asn1ct_func:generate(Fid), file:close(Fid), asn1ct:verbose("--~p--~n",[{generated,ErlFile}],Options). @@ -528,7 +533,8 @@ gen_part_decode_funcs({constructed,bif},TypeName, {_Name,parts,Tag,_Type}) -> emit([" case Data of",nl, " L when is_list(L) ->",nl, - " 'dec_",TypeName,"'(lists:map(fun(X)->element(1,?RT_BER:decode(X)) end,L),",{asis,Tag},");",nl, + " 'dec_",TypeName,"'(lists:map(fun(X) -> element(1, ", + {call,ber,ber_decode_erlang,["X"]},") end, L),",{asis,Tag},");",nl, " _ ->",nl, " [Res] = 'dec_",TypeName,"'([Data],",{asis,Tag},"),",nl, " Res",nl, @@ -802,7 +808,7 @@ gen_decode_constructed(Erules,Typename,InnerType,D) when is_record(D,typedef) -> pgen_exports(Erules,_Module,{Types,Values,_,_,Objects,ObjectSets}) -> - emit({"-export([encoding_rule/0]).",nl}), + emit(["-export([encoding_rule/0,bit_string_format/0]).",nl]), case Types of [] -> ok; _ -> @@ -912,23 +918,24 @@ gen_selected_decode_exports1([{FuncName,_}|Rest]) -> gen_selected_decode_exports1(Rest). pgen_dispatcher(Erules,_Module,{[],_Values,_,_,_Objects,_ObjectSets}) -> - emit(["encoding_rule() ->",nl]), - emit([{asis,Erules},".",nl,nl]); + gen_info_functions(Erules); pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> - emit(["-export([encode/2,decode/2,encode_disp/2,decode_disp/2]).",nl,nl]), - emit(["encoding_rule() ->",nl]), - emit([" ",{asis,Erules},".",nl,nl]), + emit(["-export([encode/2,decode/2]).",nl,nl]), + gen_info_functions(Erules), NoFinalPadding = lists:member(no_final_padding,get(encoding_options)), {Call,BytesAsBinary} = case Erules of per -> - {["?RT_PER:complete(encode_disp(Type,Data))"],"Bytes"}; + asn1ct_func:need({Erules,complete,1}), + {["complete(encode_disp(Type, Data))"],"Bytes"}; ber -> {"encode_disp(Type,Data)","iolist_to_binary(Bytes)"}; uper when NoFinalPadding == true -> - {"?RT_PER:complete_NFP(encode_disp(Type,Data))","Bytes"}; + asn1ct_func:need({Erules,complete_NFP,1}), + {"complete_NFP(encode_disp(Type, Data))","Bytes"}; uper -> - {["?RT_PER:complete(encode_disp(Type,Data))"],"Bytes"} + asn1ct_func:need({Erules,complete,1}), + {["complete(encode_disp(Type, Data))"],"Bytes"} end, emit(["encode(Type,Data) ->",nl, "case catch ",Call," of",nl, @@ -952,12 +959,11 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> DecAnonymous = case {Erules,Return_rest} of {ber,false} -> - io_lib:format("~s~s~s~n", - ["element(1,?RT_BER:decode(Data", - nif_parameter(),"))"]); + asn1ct_func:need({ber,ber_decode_nif,1}), + "element(1, ber_decode_nif(Data))"; {ber,true} -> - emit(["{Data,Rest} = ?RT_BER:decode(Data0", - nif_parameter(),"),",nl]), + asn1ct_func:need({ber,ber_decode_nif,1}), + emit(["{Data,Rest} = ber_decode_nif(Data0),",nl]), "Data"; _ -> "Data" @@ -1020,6 +1026,11 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> emit([nl]), emit({nl,nl}). +gen_info_functions(Erules) -> + emit(["encoding_rule() -> ", + {asis,Erules},".",nl,nl, + "bit_string_format() -> ", + {asis,asn1ct:get_bit_string_format()},".",nl,nl]). gen_decode_partial_incomplete(ber) -> case {asn1ct:read_config_data(partial_incomplete_decode), @@ -1042,16 +1053,16 @@ gen_decode_partial_incomplete(ber) -> emit(["decode_partial_incomplete(Type,Data0,", "Pattern) ->",nl]), emit([" {Data,_RestBin} =",nl, - " ?RT_BER:decode_primitive_", - "incomplete(Pattern,Data0),",nl, + " ",{call,ber,decode_primitive_incomplete, + ["Pattern","Data0"]},com,nl, " case catch decode_partial_inc_disp(Type,", "Data) of",nl]), EmitCaseClauses(), emit([".",nl,nl]), emit(["decode_part(Type, Data0) " "when is_binary(Data0) ->",nl]), - emit([" case catch decode_inc_disp(Type,element(1," - "?RT_BER:decode(Data0",nif_parameter(),"))) of",nl]), + emit([" case catch decode_inc_disp(Type,element(1, ", + {call,ber,ber_decode_nif,["Data0"]},")) of",nl]), EmitCaseClauses(), emit([";",nl]), emit(["decode_part(Type, Data0) ->",nl]), @@ -1095,9 +1106,6 @@ gen_partial_inc_dispatcher([],_) -> emit(["decode_partial_inc_disp(Type,_Data) ->",nl, " exit({error,{asn1,{undefined_type,Type}}}).",nl]). -nif_parameter() -> - ",nif". - gen_dispatcher([F1,F2|T],FuncName,Prefix,ExtraArg) -> emit([FuncName,"('",F1,"',Data) -> '",Prefix,F1,"'(Data",ExtraArg,")",";",nl]), gen_dispatcher([F2|T],FuncName,Prefix,ExtraArg); @@ -1160,6 +1168,9 @@ emit({var,Variable}) -> 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)); @@ -1384,35 +1395,28 @@ gen_record(_,_,_,NumRecords) -> % skip CLASS etc for now. gen_head(Erules,Mod,Hrl) -> Options = get(encoding_options), - {Rtmac,Rtmod} = case Erules of - per -> - emit({"%% Generated by the Erlang ASN.1 PER-" - "compiler version, utilizing bit-syntax:", - asn1ct:vsn(),nl}), - {"RT_PER","asn1rt_per_bin_rt2ct"}; - ber -> - emit({"%% Generated by the Erlang ASN.1 BER_V2-" - "compiler version, utilizing bit-syntax:", - asn1ct:vsn(),nl}), - {"RT_BER","asn1rt_ber_bin_v2"}; - uper -> - emit(["%% Generated by the Erlang ASN.1 UNALIGNED" - " PER-compiler version, utilizing" - " bit-syntax:", - asn1ct:vsn(),nl]), - {"RT_PER","asn1rt_uper_bin"} + case Erules of + per -> + emit(["%% Generated by the Erlang ASN.1 PER-" + "compiler version, utilizing bit-syntax:", + asn1ct:vsn(),nl]); + ber -> + emit(["%% Generated by the Erlang ASN.1 BER_V2-" + "compiler version, utilizing bit-syntax:", + asn1ct:vsn(),nl]); + uper -> + emit(["%% Generated by the Erlang ASN.1 UNALIGNED" + " PER-compiler version, utilizing bit-syntax:", + asn1ct:vsn(),nl]) end, emit({"%% Purpose: encoder and decoder to the types in mod ",Mod,nl,nl}), emit({"-module('",Mod,"').",nl}), put(currmod,Mod), emit({"-compile(nowarn_unused_vars).",nl}), - case {Hrl,lists:member(inline,get(encoding_options))} of - {0,_} -> true; - {_,true} -> true; - _ -> - emit({"-include(\"",Mod,".hrl\").",nl}) + case Hrl of + 0 -> ok; + _ -> emit({"-include(\"",Mod,".hrl\").",nl}) end, - emit(["-define('",Rtmac,"',",Rtmod,").",nl]), emit(["-asn1_info([{vsn,'",asn1ct:vsn(),"'},",nl, " {module,'",Mod,"'},",nl, " {options,",io_lib:format("~p",[Options]),"}]).",nl,nl]). @@ -1493,50 +1497,41 @@ gen_check_call(TopType,Cname,Type,InnerType,WhatKind,DefaultValue,Element) -> emit(["fun() -> true end ()"]) end. -gen_prim_check_call(PrimType,DefaultValue,Element,Type) -> +gen_prim_check_call(PrimType, Default, Element, Type) -> case unify_if_string(PrimType) of 'BOOLEAN' -> - emit({"asn1rt_check:check_bool(",DefaultValue,", ", - Element,")"}); + check_call(check_bool, [Default,Element]); 'INTEGER' -> - NNL = - case Type#type.def of - {_,NamedNumberList} -> NamedNumberList; - _ -> [] - end, - emit({"asn1rt_check:check_int(",DefaultValue,", ", - Element,", ",{asis,NNL},")"}); + NNL = case Type#type.def of + {_,NamedNumberList} -> NamedNumberList; + _ -> [] + end, + check_call(check_int, [Default,Element,{asis,NNL}]); 'BIT STRING' -> {_,NBL} = Type#type.def, - emit({"asn1rt_check:check_bitstring(",DefaultValue,", ", - Element,", ",{asis,NBL},")"}); + check_call(check_bitstring, [Default,Element,{asis,NBL}]); 'OCTET STRING' -> - emit({"asn1rt_check:check_octetstring(",DefaultValue,", ", - Element,")"}); + check_call(check_octetstring, [Default,Element]); 'NULL' -> - emit({"asn1rt_check:check_null(",DefaultValue,", ", - Element,")"}); + check_call(check_null, [Default,Element]); 'OBJECT IDENTIFIER' -> - emit({"asn1rt_check:check_objectidentifier(",DefaultValue, - ", ",Element,")"}); + check_call(check_objectidentifier, [Default,Element]); 'RELATIVE-OID' -> - emit({"asn1rt_check:check_objectidentifier(",DefaultValue, - ", ",Element,")"}); + check_call(check_objectidentifier, [Default,Element]); 'ObjectDescriptor' -> - emit({"asn1rt_check:check_objectdescriptor(",DefaultValue, - ", ",Element,")"}); + check_call(check_objectdescriptor, [Default,Element]); 'REAL' -> - emit({"asn1rt_check:check_real(",DefaultValue, - ", ",Element,")"}); + check_call(check_real, [Default,Element]); 'ENUMERATED' -> {_,Enumerations} = Type#type.def, - emit({"asn1rt_check:check_enum(",DefaultValue, - ", ",Element,", ",{asis,Enumerations},")"}); + check_call(check_enum, [Default,Element,{asis,Enumerations}]); restrictedstring -> - emit({"asn1rt_check:check_restrictedstring(",DefaultValue, - ", ",Element,")"}) + check_call(check_restrictedstring, [Default,Element]) end. +check_call(F, Args) -> + asn1ct_func:call(check, F, Args). + %% lokahead_innertype/3 traverses Type and checks if check functions %% have to be generated, i.e. for all constructed or referenced types. lookahead_innertype(Name,'SEQUENCE',Type) -> diff --git a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl index 664dfc2086..121f452da8 100644 --- a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl @@ -170,139 +170,84 @@ gen_encode_user(Erules,D) when is_record(D,typedef) -> end. gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> - -%%% Constraint is currently not used for BER (except for BitString) and therefore replaced -%%% with [] as a placeholder BitStringConstraint = D#type.constraint, - Constraint = [], asn1ct_name:new(enumval), - case D#type.def of + Type = case D#type.def of + 'OCTET STRING' -> restricted_string; + 'ObjectDescriptor'-> restricted_string; + 'NumericString' -> restricted_string; + 'TeletexString' -> restricted_string; + 'T61String' -> restricted_string; + 'VideotexString' -> restricted_string; + 'GraphicString' -> restricted_string; + 'VisibleString' -> restricted_string; + 'GeneralString' -> restricted_string; + 'PrintableString' -> restricted_string; + 'IA5String' -> restricted_string; + Other -> Other + end, + case Type of + restricted_string -> + call(encode_restricted_string, [Value,DoTag]); 'BOOLEAN' -> - emit_encode_func('boolean',Value,DoTag); + call(encode_boolean, [Value,DoTag]); 'INTEGER' -> - emit_encode_func('integer',Constraint,Value,DoTag); + call(encode_integer, [Value,DoTag]); {'INTEGER',NamedNumberList} -> - emit_encode_func('integer',Constraint,Value, - NamedNumberList,DoTag); + call(encode_integer, [Value,{asis,NamedNumberList}, DoTag]); {'ENUMERATED',NamedNumberList={_,_}} -> - emit(["case ",Value," of",nl]), emit_enc_enumerated_cases(NamedNumberList,DoTag); {'ENUMERATED',NamedNumberList} -> - emit(["case ",Value," of",nl]), emit_enc_enumerated_cases(NamedNumberList,DoTag); - 'REAL' -> - emit_encode_func('real',Constraint,Value,DoTag); - + emit([{call,ber,encode_tags, + [DoTag,{call,real_common,ber_encode_real,[Value]}]}]); {'BIT STRING',NamedNumberList} -> - emit_encode_func('bit_string',BitStringConstraint,Value, - NamedNumberList,DoTag); + call(encode_bit_string, + [{asis,BitStringConstraint},Value, + {asis,NamedNumberList},DoTag]); 'ANY' -> - emit_encode_func('open_type', Value,DoTag); + call(encode_open_type, [Value,DoTag]); 'NULL' -> - emit_encode_func('null',Value,DoTag); + call(encode_null, [Value,DoTag]); 'OBJECT IDENTIFIER' -> - emit_encode_func("object_identifier",Value,DoTag); + call(encode_object_identifier, [Value,DoTag]); 'RELATIVE-OID' -> - emit_encode_func("relative_oid",Value,DoTag); - 'ObjectDescriptor' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_ObjectDescriptor,DoTag); - 'OCTET STRING' -> - emit_encode_func('octet_string',Constraint,Value,DoTag); - 'NumericString' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_NumericString,DoTag); - TString when TString == 'TeletexString'; - TString == 'T61String' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_TeletexString,DoTag); - 'VideotexString' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_VideotexString,DoTag); - 'GraphicString' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_GraphicString,DoTag); - 'VisibleString' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_VisibleString,DoTag); - 'GeneralString' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_GeneralString,DoTag); - 'PrintableString' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_PrintableString,DoTag); - 'IA5String' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_IA5String,DoTag); + call(encode_relative_oid, [Value,DoTag]); 'UniversalString' -> - emit_encode_func('universal_string',Constraint,Value,DoTag); + call(encode_universal_string, [Value,DoTag]); 'UTF8String' -> - emit_encode_func('UTF8_string',Constraint,Value,DoTag); + call(encode_UTF8_string, [Value,DoTag]); 'BMPString' -> - emit_encode_func('BMP_string',Constraint,Value,DoTag); + call(encode_BMP_string, [Value,DoTag]); 'UTCTime' -> - emit_encode_func('utc_time',Constraint,Value,DoTag); + call(encode_utc_time, [Value,DoTag]); 'GeneralizedTime' -> - emit_encode_func('generalized_time',Constraint,Value,DoTag); + call(encode_generalized_time, [Value,DoTag]); 'ASN1_OPEN_TYPE' -> - emit_encode_func('open_type', Value,DoTag); + 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' -> - emit_encode_func('open_type', Value,DoTag); - XX -> - exit({'can not encode' ,XX}) - end; - XX -> - exit({'can not encode' ,XX}) + call(encode_open_type, [Value,DoTag]) + end end. - -emit_encode_func(Name,Value,Tags) when is_atom(Name) -> - emit_encode_func(atom_to_list(Name),Value,Tags); -emit_encode_func(Name,Value,Tags) -> - Fname = "?RT_BER:encode_" ++ Name, - emit([Fname,"(",Value,", ",Tags,")"]). - -emit_encode_func(Name,Constraint,Value,Tags) when is_atom(Name) -> - emit_encode_func(atom_to_list(Name),Constraint,Value,Tags); -emit_encode_func(Name,Constraint,Value,Tags) -> - Fname = "?RT_BER:encode_" ++ Name, - emit([Fname,"(",{asis,Constraint},", ",Value,", ",Tags,")"]). - -emit_encode_func(Name,Constraint,Value,Asis,Tags) when is_atom(Name) -> - emit_encode_func(atom_to_list(Name),Constraint,Value,Asis,Tags); -emit_encode_func(Name,Constraint,Value,Asis,Tags) -> - Fname = "?RT_BER:encode_" ++ Name, - emit([Fname,"(",{asis,Constraint},", ",Value, - ", ",{asis,Asis}, - ", ",Tags,")"]). - emit_enc_enumerated_cases({L1,L2}, Tags) -> emit_enc_enumerated_cases(L1++L2, Tags, ext); emit_enc_enumerated_cases(L, Tags) -> emit_enc_enumerated_cases(L, Tags, noext). -emit_enc_enumerated_cases([{EnumName,EnumVal},H2|T], Tags, Ext) -> - emit([{asis,EnumName}," -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,");",nl]), -%% emit(["'",{asis,EnumName},"' -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,");",nl]), - emit_enc_enumerated_cases([H2|T], Tags, Ext); -emit_enc_enumerated_cases([{EnumName,EnumVal}], Tags, Ext) -> - emit([{asis,EnumName}," -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,")"]), -%% emit(["'",{asis,EnumName},"' -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,")"]), - case Ext of - noext -> emit([";",nl]); - ext -> - emit([";",nl]) -%% emit([";",nl,"{asn1_enum,",{curr,enumval},"} -> ", -%% "?RT_BER:encode_enumerated(",{curr,enumval},",",Tags,");",nl]), -%% asn1ct_name:new(enumval) - end, +emit_enc_enumerated_cases([{EnumName,EnumVal}|T], Tags, Ext) -> + emit([{asis,EnumName}," -> ", + {call,ber,encode_enumerated,[EnumVal,Tags]},";",nl]), + emit_enc_enumerated_cases(T, Tags, Ext); +emit_enc_enumerated_cases([], _Tags, _Ext) -> + %% FIXME: Should extension be handled? emit([{curr,enumval}," -> exit({error,{asn1, {enumerated_not_in_range,",{curr, enumval},"}}})"]), emit([nl,"end"]). @@ -365,9 +310,10 @@ gen_decode_selected(Erules,Type,FuncName) -> {value,{_,P}} -> P; false -> exit({error,{internal,no_pattern_saved}}) end, - emit([" case ?RT_BER:decode_selective(",{asis,Pattern},",Bin) of",nl, + emit([" case ",{call,ber,decode_selective, + [{asis,Pattern},"Bin"]}," of",nl, " {ok,Bin2} when is_binary(Bin2) ->",nl, - " {Tlv,_} = ?RT_BER:decode(Bin2",asn1ct_gen:nif_parameter(),"),",nl]), + " {Tlv,_} = ", {call,ber,ber_decode_nif,["Bin2"]},com,nl]), emit("{ok,"), gen_decode_selected_type(Erules,Type), emit(["};",nl," Err -> exit({error,{selective_decode,Err}})",nl, @@ -549,147 +495,123 @@ gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Form,OptOrMand) -> _ -> "" end, NewTypeName = case Typename of - 'ANY' -> 'ASN1_OPEN_TYPE'; - _ -> Typename + 'ANY' -> 'ASN1_OPEN_TYPE'; + 'OCTET STRING' -> restricted_string; + 'NumericString' -> restricted_string; + 'TeletexString' -> restricted_string; + 'T61String' -> restricted_string; + 'VideotexString' -> restricted_string; + 'GraphicString' -> restricted_string; + 'VisibleString' -> restricted_string; + 'GeneralString' -> restricted_string; + 'PrintableString' -> restricted_string; + 'IA5String' -> restricted_string; + _ -> Typename end, -% DoLength = case NewTypeName of 'BOOLEAN'-> - emit({"?RT_BER:decode_boolean(",BytesVar,","}), - add_func({decode_boolean,2}); + emit(["decode_boolean(",BytesVar,","]), + need(decode_boolean, 2); 'INTEGER' -> - emit({"?RT_BER:decode_integer(",BytesVar,",", - {asis,int_constr(SingleValue,ValueRange)},","}), - add_func({decode_integer,3}); + emit(["decode_integer(",BytesVar,",", + {asis,int_constr(SingleValue,ValueRange)},","]), + need(decode_integer, 3); {'INTEGER',NamedNumberList} -> - emit({"?RT_BER:decode_integer(",BytesVar,",", + emit(["decode_integer(",BytesVar,",", {asis,int_constr(SingleValue,ValueRange)},",", - {asis,NamedNumberList},","}), - add_func({decode_integer,4}); + {asis,NamedNumberList},","]), + need(decode_integer, 4); {'ENUMERATED',NamedNumberList} -> - emit({"?RT_BER:decode_enumerated(",BytesVar,",", - {asis,Constraint},",", - {asis,NamedNumberList},","}), - add_func({decode_enumerated,4}); + emit(["decode_enumerated(",BytesVar,",", + {asis,NamedNumberList},","]), + need(decode_enumerated, 3); 'REAL' -> - emit({"?RT_BER:decode_real(",BytesVar,","}), - add_func({decode_real,3}); - {'BIT STRING',NamedNumberList} -> - case get(compact_bit_string) of - true -> - emit({"?RT_BER:decode_compact_bit_string(", - BytesVar,",",{asis,Constraint},",", - {asis,NamedNumberList},","}), - add_func({decode_compact_bit_string,4}); - _ -> - emit({"?RT_BER:decode_bit_string(",BytesVar,",", - {asis,Constraint},",", - {asis,NamedNumberList},","}), - add_func({decode_bit_string,4}) - end; + ok; + {'BIT STRING',_NamedNumberList} -> + ok; 'NULL' -> - emit({"?RT_BER:decode_null(",BytesVar,","}), - add_func({decode_null,2}); + emit(["decode_null(",BytesVar,","]), + need(decode_null, 2); 'OBJECT IDENTIFIER' -> - emit({"?RT_BER:decode_object_identifier(",BytesVar,","}), - add_func({decode_object_identifier,2}); + emit(["decode_object_identifier(",BytesVar,","]), + need(decode_object_identifier, 2); 'RELATIVE-OID' -> - emit({"?RT_BER:decode_relative_oid(",BytesVar,","}), - add_func({decode_relative_oid,2}); + emit(["decode_relative_oid(",BytesVar,","]), + need(decode_relative_oid, 2); 'ObjectDescriptor' -> - emit({"?RT_BER:decode_restricted_string(", - BytesVar,",",{asis,Constraint},",",{asis,?T_ObjectDescriptor},","}), - add_func({decode_restricted_string,4}); - 'OCTET STRING' -> - emit({"?RT_BER:decode_octet_string",AsBin,"(",BytesVar,",",{asis,Constraint},","}), - add_func({decode_octet_string,3}); - 'NumericString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_NumericString},","}), - add_func({decode_restricted_string,4}); - TString when TString == 'TeletexString'; - TString == 'T61String' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_TeletexString},","}), - add_func({decode_restricted_string,4}); - 'VideotexString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_VideotexString},","}), - add_func({decode_restricted_string,4}); - 'GraphicString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_GraphicString},","}), - add_func({decode_restricted_string,4}); - 'VisibleString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_VisibleString},","}), - add_func({decode_restricted_string,4}); - 'GeneralString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_GeneralString},","}), - add_func({decode_restricted_string,4}); - 'PrintableString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_PrintableString},","}), - add_func({decode_restricted_string,4}); - 'IA5String' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_IA5String},","}), - add_func({decode_restricted_string,4}) ; + emit(["decode_restricted_string(", + BytesVar,",",{asis,Constraint},","]), + need(decode_restricted_string, 3); + restricted_string -> + emit(["decode_restricted_string",AsBin,"(",BytesVar,","]), + case Constraint of + [] -> + need(decode_restricted_string, 2); + _ -> + emit([{asis,Constraint},","]), + need(decode_restricted_string, 3) + end; 'UniversalString' -> - emit({"?RT_BER:decode_universal_string",AsBin,"(", - BytesVar,",",{asis,Constraint},","}), - add_func({decode_universal_string,3}); + emit(["decode_universal_string",AsBin,"(", + BytesVar,",",{asis,Constraint},","]), + need(decode_universal_string, 3); 'UTF8String' -> - emit({"?RT_BER:decode_UTF8_string",AsBin,"(", - BytesVar,","}), - add_func({decode_UTF8_string,2}); + emit(["decode_UTF8_string",AsBin,"(", + BytesVar,","]), + need(decode_UTF8_string, 2); 'BMPString' -> - emit({"?RT_BER:decode_BMP_string",AsBin,"(", - BytesVar,",",{asis,Constraint},","}), - add_func({decode_BMP_string,3}); + emit(["decode_BMP_string",AsBin,"(", + BytesVar,",",{asis,Constraint},","]), + need(decode_BMP_string, 3); 'UTCTime' -> - emit({"?RT_BER:decode_utc_time",AsBin,"(", - BytesVar,",",{asis,Constraint},","}), - add_func({decode_utc_time,3}); + emit(["decode_utc_time",AsBin,"(", + BytesVar,",",{asis,Constraint},","]), + need(decode_utc_time, 3); 'GeneralizedTime' -> - emit({"?RT_BER:decode_generalized_time",AsBin,"(", - BytesVar,",",{asis,Constraint},","}), - add_func({decode_generalized_time,3}); + emit(["decode_generalized_time",AsBin,"(", + BytesVar,",",{asis,Constraint},","]), + need(decode_generalized_time, 3); 'ASN1_OPEN_TYPE' -> - emit(["?RT_BER:decode_open_type_as_binary(", + emit(["decode_open_type_as_binary(", BytesVar,","]), - add_func({decode_open_type_as_binary,3}); + 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(["?RT_BER:decode_open_type_as_binary(", + emit(["decode_open_type_as_binary(", BytesVar,","]), - add_func({decode_open_type_as_binary,3}); + need(decode_open_type_as_binary, 2); Other -> - exit({'can not decode' ,Other}) + exit({'cannot decode',Other}) end; Other -> - exit({'can not decode' ,Other}) + exit({'cannot decode',Other}) end, - case {DoTag,NewTypeName} of - {_,#'ObjectClassFieldType'{}} -> + TagStr = case DoTag of + {string,Tag1} -> Tag1; + _ when is_list(DoTag) -> {asis,DoTag} + end, + case NewTypeName of + {'BIT STRING',NNL} -> + gen_dec_bit_string(BytesVar, Constraint, NNL, TagStr); + 'REAL' -> + asn1ct_name:new(tmpbuf), + emit(["begin",nl, + {curr,tmpbuf}," = ", + {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([{asis,DoTag},asn1ct_gen:nif_parameter(),")"]); + emit([TagStr,")"]); _ -> ok end; - {{string,TagStr},'ASN1_OPEN_TYPE'} -> - emit([TagStr,asn1ct_gen:nif_parameter(),")"]); - {_,'ASN1_OPEN_TYPE'} -> - emit([{asis,DoTag},asn1ct_gen:nif_parameter(),")"]); - {{string,TagStr},_} -> - emit([TagStr,")"]); - _ when is_list(DoTag) -> - emit([{asis,DoTag},")"]) + _ -> + emit([TagStr,")"]) end. @@ -701,6 +623,23 @@ int_constr(SingleValue,[]) -> SingleValue; int_constr(SV,VR) -> [SV,VR]. + +gen_dec_bit_string(BytesVar, _Constraint, [_|_]=NNL, TagStr) -> + call(decode_named_bit_string, + [BytesVar,{asis,NNL},TagStr]); +gen_dec_bit_string(BytesVar, Constraint, [], TagStr) -> + case asn1ct:get_bit_string_format() of + compact -> + call(decode_compact_bit_string, + [BytesVar,{asis,Constraint},TagStr]); + legacy -> + call(decode_legacy_bit_string, + [BytesVar,{asis,Constraint},TagStr]); + bitstring -> + call(decode_native_bit_string, + [BytesVar,{asis,Constraint},TagStr]) + end. + %% Object code generating for encoding and decoding %% ------------------------------------------------ @@ -1015,7 +954,7 @@ emit_tlv_format_function() -> end. emit_tlv_format_function1() -> emit(["tlv_format(Bytes) when is_binary(Bytes) ->",nl, - " {Tlv,_}=?RT_BER:decode(Bytes",asn1ct_gen:nif_parameter(),"),",nl, + " {Tlv,_} = ",{call,ber,ber_decode_nif,["Bytes"]},com,nl, " Tlv;",nl, "tlv_format(Bytes) ->",nl, " Bytes.",nl]). @@ -1449,38 +1388,22 @@ gen_objset_dec(_,ObjSetName,UniqueName,[{ObjName,Val,Fields}], emit_default_getdec(ObjSetName,UniqueName), emit([".",nl,nl]), ok; -gen_objset_dec(Erules,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, +gen_objset_dec(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, _ClFields,_NthObj) -> emit(["'getdec_",ObjSetName,"'(_, _) ->",nl]), emit([indent(2),"fun(_,Bytes, _RestPrimFieldName) ->",nl]), - case Erules of - ber -> - emit([indent(4),"case Bytes of",nl, - indent(6),"Bin when is_binary(Bin) -> ",nl, - indent(8),"Bin;",nl, - indent(6),"_ ->",nl, - indent(8),"?RT_BER:encode(Bytes",driver_parameter(),")",nl, - indent(4),"end",nl]); - _ -> - emit([indent(6),"Len = case Bytes of",nl,indent(9), - "Bin when is_binary(Bin) -> size(Bin);",nl,indent(9), - "_ -> length(Bytes)",nl,indent(6),"end,"]), - emit([indent(4),"{Bytes,[],Len}",nl]) - end, + emit([indent(4),"case Bytes of",nl, + indent(6),"Bin when is_binary(Bin) -> ",nl, + indent(8),"Bin;",nl, + indent(6),"_ ->",nl, + indent(8),{call,ber,ber_encode,["Bytes"]},nl, + indent(4),"end",nl]), emit([indent(2),"end.",nl,nl]), ok; gen_objset_dec(_,_,_,[],_,_,_) -> ok. -driver_parameter() -> - Options = get(encoding_options), - case {lists:member(driver,Options),lists:member(nif,Options)} of - {true,_} -> ",nif"; - {_,true} -> ",nif"; - _ -> ",erlang" - 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"]). @@ -1771,9 +1694,6 @@ mk_object_val(0, Ack, Len) -> mk_object_val(Val, Ack, Len) -> mk_object_val(Val bsr 7, [((Val band 127) bor 128) | Ack], Len + 1). -add_func(F={_Func,_Arity}) -> - asn1ct_table:insert(asn1_functab, {F}). - %% For BER the ExtensionAdditionGroup notation has no impact on the encoding/decoding %% and therefore we only filter away the ExtensionAdditionGroup start and end markers extaddgroup2sequence(ExtList) when is_list(ExtList) -> @@ -1785,4 +1705,8 @@ extaddgroup2sequence(ExtList) when is_list(ExtList) -> true end, ExtList). +call(F, Args) -> + asn1ct_func:call(ber, F, Args). +need(F, Arity) -> + asn1ct_func:need({ber,F,Arity}). diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl index af19edb908..3b320065d2 100644 --- a/lib/asn1/src/asn1ct_gen_per.erl +++ b/lib/asn1/src/asn1ct_gen_per.erl @@ -35,6 +35,7 @@ -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 @@ -92,13 +93,6 @@ gen_encode_user(Erules,D) when is_record(D,typedef) -> Typename = [D#typedef.name], Def = D#typedef.typespec, InnerType = asn1ct_gen:get_inner(Def#type.def), - case InnerType of - 'SET' -> true; - 'SEQUENCE' -> true; - _ -> - emit({nl,"'enc_",asn1ct_gen:list2name(Typename),"'({'",asn1ct_gen:list2name(Typename),"',Val}) ->",nl}), - emit({"'enc_",asn1ct_gen:list2name(Typename),"'(Val);",nl,nl}) - end, emit({"'enc_",asn1ct_gen:list2name(Typename),"'(Val) ->",nl}), case asn1ct_gen:type(InnerType) of {primitive,bif} -> @@ -134,107 +128,96 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> asn1ct_name:new(enumval), case D#type.def of 'INTEGER' -> - emit({"?RT_PER:encode_integer(", %fel - {asis,asn1ct_imm:effective_constraint(integer,Constraint)}, - ",",Value,")"}); + Args = [{asis,asn1ct_imm:effective_constraint(integer,Constraint)}, + Value], + call(Erules, encode_integer, Args); {'INTEGER',NamedNumberList} -> - emit({"?RT_PER:encode_integer(", - {asis,asn1ct_imm:effective_constraint(integer,Constraint)}, - ",",Value,",", - {asis,NamedNumberList},")"}); + Args = [{asis,asn1ct_imm:effective_constraint(integer,Constraint)}, + Value,{asis,NamedNumberList}], + call(Erules, encode_integer, Args); {'ENUMERATED',{Nlist1,Nlist2}} -> - NewList = lists:concat([[{0,X}||{X,_} <- Nlist1],['EXT_MARK'],[{1,X}||{X,_} <- Nlist2]]), - NewC = [{'ValueRange',{0,length(Nlist1)-1}}], - case Erules of - uper -> - emit(["case ",Value," of",nl]); - _ -> - emit(["case (case ",Value," of {_,",{curr,enumval},"}-> ", - {curr,enumval},";_->", Value," end) of",nl]), - asn1ct_name:new(enumval) - end, -%% emit_enc_enumerated_cases(Erules,NewC, NewList++[{asn1_enum,length(Nlist1)-1}], 0); - emit_enc_enumerated_cases(Erules,NewC, NewList, 0); + 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 = [{'ValueRange',{0,length(NewList)-1}}], - case Erules of - uper -> - emit(["case ",Value," of",nl]); - _ -> - emit(["case (case ",Value," of {_,",{curr,enumval}, - "}->",{curr,enumval},";_->",Value," end) of",nl]) - end, - emit_enc_enumerated_cases(Erules,NewC, NewList, 0); + NewList = [X || {X,_} <- NamedNumberList], + NewC = {0,length(NewList)-1}, + emit(["case ",Value," of",nl]), + emit_enc_enumerated_cases(Erules, NewC, NewList, 0); 'REAL' -> - emit({"?RT_PER:encode_real(",Value,")"}); + emit_enc_real(Erules, Value); {'BIT STRING',NamedNumberList} -> - emit({"?RT_PER:encode_bit_string(", - {asis,Constraint},",",Value,",", - {asis,NamedNumberList},")"}); + SizeConstr = get_constraint(Constraint, 'SizeConstraint'), + call(Erules, encode_bit_string, + [{asis,SizeConstr},Value, + {asis,NamedNumberList}]); 'NULL' -> emit("[]"); 'OBJECT IDENTIFIER' -> - emit({"?RT_PER:encode_object_identifier(",Value,")"}); + call(Erules, encode_object_identifier, [Value]); 'RELATIVE-OID' -> - emit({"?RT_PER:encode_relative_oid(",Value,")"}); + call(Erules, encode_relative_oid, [Value]); 'ObjectDescriptor' -> - emit({"?RT_PER:encode_ObjectDescriptor(",{asis,Constraint}, - ",",Value,")"}); + call(Erules, encode_ObjectDescriptor, + [{asis,Constraint},Value]); 'BOOLEAN' -> - emit({"?RT_PER:encode_boolean(",Value,")"}); + call(Erules, encode_boolean, [Value]); 'OCTET STRING' -> - emit({"?RT_PER:encode_octet_string(",{asis,Constraint},",",Value,")"}); + case get_constraint(Constraint, 'SizeConstraint') of + 0 -> + emit("[]"); + no -> + call(Erules, encode_octet_string, [Value]); + C -> + call(Erules, encode_octet_string, [{asis,C},Value]) + end; 'NumericString' -> - emit({"?RT_PER:encode_NumericString(",{asis,Constraint},",",Value,")"}); + call(Erules, encode_NumericString, [{asis,Constraint},Value]); TString when TString == 'TeletexString'; TString == 'T61String' -> - emit({"?RT_PER:encode_TeletexString(",{asis,Constraint},",",Value,")"}); + call(Erules, encode_TeletexString, [{asis,Constraint},Value]); 'VideotexString' -> - emit({"?RT_PER:encode_VideotexString(",{asis,Constraint},",",Value,")"}); + call(Erules, encode_VideotexString, [{asis,Constraint},Value]); 'UTCTime' -> - emit({"?RT_PER:encode_VisibleString(",{asis,Constraint},",",Value,")"}); + call(Erules, encode_VisibleString, [{asis,Constraint},Value]); 'GeneralizedTime' -> - emit({"?RT_PER:encode_VisibleString(",{asis,Constraint},",",Value,")"}); + call(Erules, encode_VisibleString, [{asis,Constraint},Value]); 'GraphicString' -> - emit({"?RT_PER:encode_GraphicString(",{asis,Constraint},",",Value,")"}); + call(Erules, encode_GraphicString, [{asis,Constraint},Value]); 'VisibleString' -> - emit({"?RT_PER:encode_VisibleString(",{asis,Constraint},",",Value,")"}); + call(Erules, encode_VisibleString, [{asis,Constraint},Value]); 'GeneralString' -> - emit({"?RT_PER:encode_GeneralString(",{asis,Constraint}, - ",",Value,")"}); + call(Erules, encode_GeneralString, [{asis,Constraint},Value]); 'PrintableString' -> - emit({"?RT_PER:encode_PrintableString(",{asis,Constraint}, - ",",Value,")"}); + call(Erules, encode_PrintableString, [{asis,Constraint},Value]); 'IA5String' -> - emit({"?RT_PER:encode_IA5String(",{asis,Constraint}, - ",",Value,")"}); + call(Erules, encode_IA5String, [{asis,Constraint},Value]); 'BMPString' -> - emit({"?RT_PER:encode_BMPString(",{asis,Constraint}, - ",",Value,")"}); + call(Erules, encode_BMPString, [{asis,Constraint},Value]); 'UniversalString' -> - emit({"?RT_PER:encode_UniversalString(",{asis,Constraint}, - ",",Value,")"}); + call(Erules, encode_UniversalString, [{asis,Constraint},Value]); 'UTF8String' -> - emit({"?RT_PER:encode_UTF8String(",Value,")"}); + call(Erules, encode_UTF8String, [Value]); 'ANY' -> - emit(["?RT_PER:encode_open_type(", {asis,Constraint}, ",", - Value, ")"]); + call(Erules, encode_open_type, [Value]); 'ASN1_OPEN_TYPE' -> NewValue = case Constraint of [#'Externaltypereference'{type=Tname}] -> - io_lib:format( - "?RT_PER:complete(enc_~s(~s))",[Tname,Value]); + asn1ct_func:need({Erules,complete,1}), + io_lib:format( + "complete(enc_~s(~s))",[Tname,Value]); [#type{def=#'Externaltypereference'{type=Tname}}] -> + asn1ct_func:need({Erules,complete,1}), io_lib:format( - "?RT_PER:complete(enc_~s(~s))", + "complete(enc_~s(~s))", [Tname,Value]); _ -> Value end, - emit(["?RT_PER:encode_open_type(", {asis,Constraint}, ",", - NewValue, ")"]); + call(Erules, encode_open_type, [NewValue]); #'ObjectClassFieldType'{} -> case asn1ct_gen:get_inner(D#type.def) of {fixedtypevaluefield,_,InnerType} -> @@ -246,46 +229,48 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> exit({asn1_error,nyi,XX}) end. - -emit_enc_enumerated_cases(Erule,C, [H], Count) -> - emit_enc_enumerated_case(Erule,C, H, Count), - case H of - 'EXT_MARK' -> ok; - _ -> - emit([";",nl]) - end, - emit([nl,"EnumVal -> exit({error,{asn1, {enumerated_not_in_range, EnumVal}}})"]), - emit([nl,"end"]); -emit_enc_enumerated_cases(Erule, C, ['EXT_MARK'|T], _Count) -> - emit_enc_enumerated_cases(Erule, C, T, 0); -emit_enc_enumerated_cases(Erule, C, [H1,H2|T], Count) -> - emit_enc_enumerated_case(Erule, C, H1, Count), +emit_enc_real(Erules, Real) -> + asn1ct_name:new(tmpval), + asn1ct_name:new(tmplen), + emit(["begin",nl, + "{",{curr,tmpval},com,{curr,tmplen},"} = ", + {call,real_common,encode_real,[Real]},com,nl, + "[",{call,Erules,encode_length,[{curr,tmplen}]},",", + {curr,tmpval},"]",nl, + "end"]). + +emit_enc_enumerated_cases(Erules, C, ['EXT_MARK'|T], _Count) -> + %% Reset enumeration counter. + emit_enc_enumerated_cases(Erules, C, T, 0); +emit_enc_enumerated_cases(Erules, C, [H|T], Count) -> + emit_enc_enumerated_case(Erules, C, H, Count), emit([";",nl]), - emit_enc_enumerated_cases(Erule, C, [H2|T], Count+1). + emit_enc_enumerated_cases(Erules, C, T, Count+1); +emit_enc_enumerated_cases(_Erules, _, [], _Count) -> + emit(["EnumVal -> " + "exit({error,{asn1,{enumerated_not_in_range, EnumVal}}})",nl, + "end"]). +emit_enc_enumerated_case(Erules, C, {0,EnumName}, Count) -> + %% ENUMERATED with extensionmark; the value lies within then extension root + Enc = enc_ext_and_val(Erules, 0, encode_constrained_number, [C,Count]), + emit(["'",EnumName,"' -> ",{asis,Enc}]); +emit_enc_enumerated_case(Erules, _C, {1,EnumName}, Count) -> + %% ENUMERATED with extensionmark; the value is higher than extension root + Enc = enc_ext_and_val(Erules, 1, encode_small_number, [Count]), + emit(["'",EnumName,"' -> ",{asis,Enc}]); +emit_enc_enumerated_case(Erules, C, EnumName, Count) -> + %% ENUMERATED without extension + EvalMod = eval_module(Erules), + emit(["'",EnumName,"' -> ", + {asis,EvalMod:encode_constrained_number(C, Count)}]). + +enc_ext_and_val(per, E, F, Args) -> + [E|apply(asn1ct_eval_per, F, Args)]; +enc_ext_and_val(uper, E, F, Args) -> + <<E:1,(apply(asn1ct_eval_uper, F, Args))/bitstring>>. -emit_enc_enumerated_case(uper,_C, {asn1_enum,High}, _) -> - emit([ - "{asn1_enum,EnumV} when is_integer(EnumV), EnumV > ",High," -> ", - "[<<1:1>>,?RT_PER:encode_small_number(EnumV)]"]); -emit_enc_enumerated_case(_Per,_C, {asn1_enum,High}, _) -> - emit([ - "{asn1_enum,EnumV} when is_integer(EnumV), EnumV > ",High," -> ", - "[{bit,1},?RT_PER:encode_small_number(EnumV)]"]); -emit_enc_enumerated_case(_Erule, _C, 'EXT_MARK', _Count) -> - true; -emit_enc_enumerated_case(uper,_C, {1,EnumName}, Count) -> - emit(["'",EnumName,"' -> [<<1:1>>,?RT_PER:encode_small_number(",Count,")]"]); -emit_enc_enumerated_case(_Per,_C, {1,EnumName}, Count) -> - emit(["'",EnumName,"' -> [{bit,1},?RT_PER:encode_small_number(",Count,")]"]); -emit_enc_enumerated_case(uper,C, {0,EnumName}, Count) -> - emit(["'",EnumName,"' -> [<<0:1>>,?RT_PER:encode_integer(",{asis,C},", ",Count,")]"]); -emit_enc_enumerated_case(_Per,C, {0,EnumName}, Count) -> - emit(["'",EnumName,"' -> [{bit,0},?RT_PER:encode_integer(",{asis,C},", ",Count,")]"]); -emit_enc_enumerated_case(_Erule, C, EnumName, Count) -> - emit(["'",EnumName,"' -> ?RT_PER:encode_integer(",{asis,C},", ",Count,")"]). - get_constraint([{Key,V}], Key) -> V; get_constraint([], _) -> @@ -446,7 +431,7 @@ gen_encode_field_call(ObjName,FieldName,Type) -> Def = Type#typedef.typespec, case Type#typedef.name of {primitive,bif} -> - gen_encode_prim(per,Def,"false", + gen_encode_prim(uper,Def,"false", "Val"), []; {constructed,bif} -> @@ -584,7 +569,7 @@ 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), + gen_dec_prim(uper, Def, Bytes), []; {constructed,bif} -> emit({" 'dec_",ObjName,'_',FieldName, @@ -845,7 +830,7 @@ emit_inner_of_fun(TDef=#typedef{name={ExtMod,Name},typespec=Type}, case {ExtMod,Name} of {primitive,bif} -> emit(indent(12)), - gen_encode_prim(per,Type,dotag,"Val"), + gen_encode_prim(uper,Type,dotag,"Val"), {[],0}; {constructed,bif} -> emit([indent(12),"'enc_", @@ -988,7 +973,7 @@ emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type}, case {ExtName,Name} of {primitive,bif} -> emit(indent(12)), - gen_dec_prim(per,Type,"Val"), + gen_dec_prim(uper, Type, "Val"), 0; {constructed,bif} -> emit({indent(12),"'dec_", @@ -1006,7 +991,7 @@ emit_inner_of_decfun(Type,_) when is_record(Type,type) -> case Type#type.def of Def when is_atom(Def) -> emit({indent(9),Def," ->",nl,indent(12)}), - gen_dec_prim(erules,Type,"Val"); + 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)"}); @@ -1104,6 +1089,31 @@ 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'), + Imm = asn1ct_imm:per_dec_raw_bitstring(Constr, Aligned), + case NNL of + [] -> + case asn1ct:get_bit_string_format() of + compact -> + gen_dec_bit_string(decode_compact_bit_string, + Imm); + legacy -> + gen_dec_bit_string(decode_legacy_bit_string, + Imm); + bitstring -> + gen_dec_copy_bitstring(Imm) + end; + [_|_] -> + D = fun(V, Buf) -> + As = [V,{asis,NNL}], + Call = {call,per_common,decode_named_bit_string,As}, + emit(["{",Call,com,Buf,"}"]) + end, + {call,D,Imm} + end; +gen_dec_imm_1('NULL', _Constr, _Aligned) -> + {value,'NULL'}; gen_dec_imm_1('BOOLEAN', _Constr, _Aligned) -> asn1ct_imm:per_dec_boolean(); gen_dec_imm_1({'ENUMERATED',{Base,Ext}}, _Constr, Aligned) -> @@ -1116,97 +1126,84 @@ gen_dec_imm_1({'INTEGER',NamedNumberList}, Constraint, Aligned) -> asn1ct_imm:per_dec_named_integer(Constraint, NamedNumberList, Aligned); +gen_dec_imm_1('BMPString'=Type, Constraint, Aligned) -> + gen_dec_k_m_string(Type, Constraint, Aligned); +gen_dec_imm_1('NumericString'=Type, Constraint, Aligned) -> + gen_dec_k_m_string(Type, Constraint, Aligned); +gen_dec_imm_1('PrintableString'=Type, Constraint, Aligned) -> + gen_dec_k_m_string(Type, Constraint, Aligned); +gen_dec_imm_1('VisibleString'=Type, Constraint, Aligned) -> + gen_dec_k_m_string(Type, Constraint, Aligned); +gen_dec_imm_1('IA5String'=Type, Constraint, Aligned) -> + gen_dec_k_m_string(Type, Constraint, Aligned); +gen_dec_imm_1('UniversalString'=Type, Constraint, Aligned) -> + gen_dec_k_m_string(Type, Constraint, Aligned); +gen_dec_imm_1('UTCTime', Constraint, Aligned) -> + gen_dec_k_m_string('VisibleString', 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'), Imm = asn1ct_imm:per_dec_octet_string(SzConstr, Aligned), {convert,binary_to_list,Imm}; -gen_dec_imm_1(_, _, _) -> no. - -gen_dec_prim(Erule, Type, BytesVar) -> - case gen_dec_imm(Erule, Type) of - no -> - gen_dec_prim_1(Erule, Type, BytesVar); - Imm -> - asn1ct_imm:dec_code_gen(Imm, BytesVar) +gen_dec_imm_1('TeletexString', _Constraint, Aligned) -> + gen_dec_restricted_string(Aligned); +gen_dec_imm_1('T61String', _Constraint, Aligned) -> + gen_dec_restricted_string(Aligned); +gen_dec_imm_1('VideotexString', _Constraint, Aligned) -> + gen_dec_restricted_string(Aligned); +gen_dec_imm_1('GraphicString', _Constraint, Aligned) -> + gen_dec_restricted_string(Aligned); +gen_dec_imm_1('GeneralString', _Constraint, Aligned) -> + gen_dec_restricted_string(Aligned); +gen_dec_imm_1('ObjectDescriptor', _Constraint, Aligned) -> + gen_dec_restricted_string(Aligned); +gen_dec_imm_1('OBJECT IDENTIFIER', _Constraint, Aligned) -> + Dec = fun(V, Buf) -> + emit(["{",{call,per_common,decode_oid,[V]},com, + Buf,"}"]) + end, + {call,Dec,gen_dec_restricted_string(Aligned)}; +gen_dec_imm_1('RELATIVE-OID', _Constraint, Aligned) -> + Dec = fun(V, Buf) -> + emit(["{",{call,per_common,decode_relative_oid,[V]},com, + Buf,"}"]) + end, + {call,Dec,gen_dec_restricted_string(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,_,InnerType} -> + gen_dec_imm_1(InnerType, Constraint, Aligned); + T -> + gen_dec_imm_1(T, Constraint, Aligned) end. -gen_dec_prim_1(Erule, - #type{def=Typename,constraint=Constraint}=Att, - BytesVar) -> - case Typename of - 'REAL' -> - emit({"?RT_PER:decode_real(",BytesVar,")"}); - - {'BIT STRING',NamedNumberList} -> - case get(compact_bit_string) of - true -> - emit({"?RT_PER:decode_compact_bit_string(", - BytesVar,",",{asis,Constraint},",", - {asis,NamedNumberList},")"}); - _ -> - emit({"?RT_PER:decode_bit_string(",BytesVar,",", - {asis,Constraint},",", - {asis,NamedNumberList},")"}) - end; - 'NULL' -> - emit({"{'NULL',",BytesVar,"}"}); - 'OBJECT IDENTIFIER' -> - emit({"?RT_PER:decode_object_identifier(", - BytesVar,")"}); - 'RELATIVE-OID' -> - emit({"?RT_PER:decode_relative_oid(", - BytesVar,")"}); - 'ObjectDescriptor' -> - emit({"?RT_PER:decode_ObjectDescriptor(", - BytesVar,")"}); - 'NumericString' -> - emit({"?RT_PER:decode_NumericString(",BytesVar,",", - {asis,Constraint},")"}); - TString when TString == 'TeletexString'; - TString == 'T61String' -> - emit({"?RT_PER:decode_TeletexString(",BytesVar,",", - {asis,Constraint},")"}); - 'VideotexString' -> - emit({"?RT_PER:decode_VideotexString(",BytesVar,",", - {asis,Constraint},")"}); - 'UTCTime' -> - emit({"?RT_PER:decode_VisibleString(",BytesVar,",", - {asis,Constraint},")"}); - 'GeneralizedTime' -> - emit({"?RT_PER:decode_VisibleString(",BytesVar,",", - {asis,Constraint},")"}); - 'GraphicString' -> - emit({"?RT_PER:decode_GraphicString(",BytesVar,",", - {asis,Constraint},")"}); - 'VisibleString' -> - emit({"?RT_PER:decode_VisibleString(",BytesVar,",", - {asis,Constraint},")"}); - 'GeneralString' -> - emit({"?RT_PER:decode_GeneralString(",BytesVar,",", - {asis,Constraint},")"}); - 'PrintableString' -> - emit({"?RT_PER:decode_PrintableString(",BytesVar,",",{asis,Constraint},")"}); - 'IA5String' -> - emit({"?RT_PER:decode_IA5String(",BytesVar,",",{asis,Constraint},")"}); - 'BMPString' -> - emit({"?RT_PER:decode_BMPString(",BytesVar,",", - {asis,Constraint},")"}); - 'UniversalString' -> - emit({"?RT_PER:decode_UniversalString(",BytesVar, - ",",{asis,Constraint},")"}); - 'UTF8String' -> - emit({"?RT_PER:decode_UTF8String(",BytesVar,")"}); - #'ObjectClassFieldType'{} -> - case asn1ct_gen:get_inner(Typename) of - {fixedtypevaluefield,_,InnerType} -> - gen_dec_prim(Erule, InnerType, BytesVar); - T -> - gen_dec_prim(Erule, Att#type{def=T}, BytesVar) - end; - Other -> - exit({'cant decode' ,Other}) - end. +gen_dec_bit_string(F, Imm) -> + D = fun(V, Buf) -> + emit(["{",{call,per_common,F,[V]},com,Buf,"}"]) + end, + {call,D,Imm}. +gen_dec_copy_bitstring(Imm) -> + D = fun(V, Buf) -> + emit(["{list_to_bitstring([",V,"]),",Buf,"}"]) + end, + {call,D,Imm}. + +gen_dec_k_m_string(Type, Constraint, Aligned) -> + asn1ct_imm:per_dec_k_m_string(Type, Constraint, Aligned). + +gen_dec_restricted_string(Aligned) -> + Imm = asn1ct_imm:per_dec_restricted_string(Aligned), + {convert,binary_to_list,Imm}. + +gen_dec_prim(Erule, Type, BytesVar) -> + Imm = gen_dec_imm(Erule, Type), + asn1ct_imm:dec_code_gen(Imm, BytesVar). is_already_generated(Operation,Name) -> case get(class_default_type) of @@ -1280,3 +1277,6 @@ imm_dec_open_type_1(Type, Aligned) -> "end"]) end, {call,D,asn1ct_imm:per_dec_open_type(Aligned)}. + +eval_module(per) -> asn1ct_eval_per; +eval_module(uper) -> asn1ct_eval_uper. diff --git a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl index 4f4563833f..8dd0297f89 100644 --- a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl +++ b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl @@ -34,6 +34,7 @@ -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 @@ -82,13 +83,6 @@ gen_encode_user(Erules,D) when is_record(D,typedef) -> Typename = [D#typedef.name], Def = D#typedef.typespec, InnerType = asn1ct_gen:get_inner(Def#type.def), - case InnerType of - 'SET' -> true; - 'SEQUENCE' -> true; - _ -> - emit({nl,"'enc_",asn1ct_gen:list2name(Typename),"'({'",asn1ct_gen:list2name(Typename),"',Val}) ->",nl}), - emit({"'enc_",asn1ct_gen:list2name(Typename),"'(Val);",nl,nl}) - end, emit({"'enc_",asn1ct_gen:list2name(Typename),"'(Val) ->",nl}), case asn1ct_gen:type(InnerType) of {primitive,bif} -> @@ -137,41 +131,30 @@ 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',{Nlist1,Nlist2}} -> - NewList = lists:append([[{0,X}||{X,_} <- Nlist1],['EXT_MARK'],[{1,X}||{X,_} <- Nlist2]]), - NewC = [{'ValueRange',{0,length(Nlist1)-1}}], - emit(["case ",Value," of",nl]), -%% emit_enc_enumerated_cases(Erules,NewC, NewList++[{asn1_enum,length(Nlist1)-1}], 0); - emit_enc_enumerated_cases(Erules,NewC, NewList, 0); - {'ENUMERATED',NamedNumberList} -> - NewList = [X||{X,_} <- NamedNumberList], - NewC = effective_constraint(integer, - [{'ValueRange', - {0,length(NewList)-1}}]), - NewVal = enc_enum_cases(Value,NewList), - emit_enc_integer(Erules,NewC,NewVal); - + {'ENUMERATED',_} -> + asn1ct_gen_per:gen_encode_prim(Erules, D, DoTag, Value); 'REAL' -> - emit({"?RT_PER:encode_real(",Value,")"}); + emit_enc_real(Erules, Value); {'BIT STRING',NamedNumberList} -> EffectiveC = effective_constraint(bitstring,Constraint), case EffectiveC of - 0 -> emit({"[]"}); + 0 -> + emit({"[]"}); _ -> - emit({"?RT_PER:encode_bit_string(", - {asis,EffectiveC},",",Value,",", - {asis,NamedNumberList},")"}) + call(Erules, encode_bit_string, + [{asis,EffectiveC},Value, + {asis,NamedNumberList}]) end; 'NULL' -> emit("[]"); 'OBJECT IDENTIFIER' -> - emit({"?RT_PER:encode_object_identifier(",Value,")"}); + call(Erules, encode_object_identifier, [Value]); 'RELATIVE-OID' -> - emit({"?RT_PER:encode_relative_oid(",Value,")"}); + call(Erules, encode_relative_oid, [Value]); 'ObjectDescriptor' -> - emit({"?RT_PER:encode_ObjectDescriptor(",{asis,Constraint}, - ",",Value,")"}); + call(Erules, encode_ObjectDescriptor, + [{asis,Constraint},Value]); 'BOOLEAN' -> emit({"case ",Value," of",nl, " true -> [1];",nl, @@ -185,19 +168,19 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> emit_enc_known_multiplier_string('NumericString',Constraint,Value); TString when TString == 'TeletexString'; TString == 'T61String' -> - emit({"?RT_PER:encode_TeletexString(",{asis,Constraint},",",Value,")"}); + call(Erules, encode_TeletexString, [{asis,Constraint},Value]); 'VideotexString' -> - emit({"?RT_PER:encode_VideotexString(",{asis,Constraint},",",Value,")"}); + call(Erules, encode_VideotexString, [{asis,Constraint},Value]); 'UTCTime' -> emit_enc_known_multiplier_string('VisibleString',Constraint,Value); 'GeneralizedTime' -> emit_enc_known_multiplier_string('VisibleString',Constraint,Value); 'GraphicString' -> - emit({"?RT_PER:encode_GraphicString(",{asis,Constraint},",",Value,")"}); + call(Erules, encode_GraphicString, [{asis,Constraint},Value]); 'VisibleString' -> emit_enc_known_multiplier_string('VisibleString',Constraint,Value); 'GeneralString' -> - emit({"?RT_PER:encode_GeneralString(",{asis,Constraint},",",Value,")"}); + call(Erules, encode_GeneralString, [{asis,Constraint},Value]); 'PrintableString' -> emit_enc_known_multiplier_string('PrintableString',Constraint,Value); 'IA5String' -> @@ -207,23 +190,23 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> 'UniversalString' -> emit_enc_known_multiplier_string('UniversalString',Constraint,Value); 'UTF8String' -> - emit({"?RT_PER:encode_UTF8String(",Value,")"}); + call(Erules, encode_UTF8String, [Value]); 'ANY' -> - emit(["?RT_PER:encode_open_type(", {asis,Constraint}, ",", - Value, ")"]); + call(Erules, encode_open_type, [Value]); 'ASN1_OPEN_TYPE' -> NewValue = case Constraint of [#'Externaltypereference'{type=Tname}] -> - io_lib:format( - "?RT_PER:complete(enc_~s(~s))",[Tname,Value]); + asn1ct_func:need({Erules,complete,1}), + io_lib:format( + "complete(enc_~s(~s))",[Tname,Value]); [#type{def=#'Externaltypereference'{type=Tname}}] -> + asn1ct_func:need({Erules,complete,1}), io_lib:format( - "?RT_PER:complete(enc_~s(~s))", + "complete(enc_~s(~s))", [Tname,Value]); _ -> Value end, - emit(["?RT_PER:encode_open_type(", {asis,Constraint}, ",", - NewValue, ")"]); + call(Erules, encode_open_type, [NewValue]); #'ObjectClassFieldType'{} -> case asn1ct_gen:get_inner(D#type.def) of {fixedtypevaluefield,_,InnerType} -> @@ -235,6 +218,17 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> exit({asn1_error,nyi,XX}) end. +emit_enc_real(Erules, Real) -> + asn1ct_name:new(tmpval), + asn1ct_name:new(tmplen), + emit(["begin",nl, + "{",{curr,tmpval},com,{curr,tmplen},"} = ", + {call,real_common,encode_real,[Real]},com,nl, + "[",{call,Erules,encode_length,[{curr,tmplen}]},",",nl, + {call,Erules,octets_to_complete, + [{curr,tmplen},{curr,tmpval}]},"]",nl, + "end"]). + emit_enc_known_multiplier_string(StringType,C,Value) -> SizeC = case get_constraint(C,'SizeConstraint') of @@ -254,62 +248,34 @@ emit_enc_known_multiplier_string(StringType,C,Value) -> NumBits = get_NumBits(C,StringType), CharOutTab = get_CharOutTab(C,StringType), %% NunBits and CharOutTab for chars_encode - emit_enc_k_m_string(StringType,SizeC,NumBits,CharOutTab,Value). + emit_enc_k_m_string(SizeC, NumBits, CharOutTab, Value). -emit_enc_k_m_string(_StringType,0,_NumBits,_CharOutTab,_Value) -> +emit_enc_k_m_string(0, _NumBits, _CharOutTab, _Value) -> emit({"[]"}); -emit_enc_k_m_string(StringType,SizeC,NumBits,CharOutTab,Value) -> - emit({"?RT_PER:encode_known_multiplier_string(",{asis,StringType},",", - {asis,SizeC},",",NumBits,",",{asis,CharOutTab},",",Value,")"}). - -emit_dec_known_multiplier_string(StringType,C,BytesVar) -> - SizeC = get_constraint(C,'SizeConstraint'), - PAlphabC = get_constraint(C,'PermittedAlphabet'), - case {StringType,PAlphabC} of - {'BMPString',{_,_}} -> - exit({error,{asn1, - {'not implemented', - "BMPString with PermittedAlphabet " - "constraint"}}}); - _ -> - ok - end, - NumBits = get_NumBits(C,StringType), - CharInTab = get_CharInTab(C,StringType), - case SizeC of - 0 -> - emit({"{[],",BytesVar,"}"}); - _ -> - emit({"?RT_PER:decode_known_multiplier_string(", - {asis,StringType},",",{asis,SizeC},",",NumBits, - ",",{asis,CharInTab},",",BytesVar,")"}) - end. +emit_enc_k_m_string(SizeC, NumBits, CharOutTab, Value) -> + call(per, encode_known_multiplier_string, + [{asis,SizeC},NumBits,{asis,CharOutTab},Value]). %% copied from run time module -get_CharOutTab(C,StringType) -> - get_CharTab(C,StringType,out). - -get_CharInTab(C,StringType) -> - get_CharTab(C,StringType,in). - -get_CharTab(C,StringType,InOut) -> +get_CharOutTab(C, StringType) -> case get_constraint(C,'PermittedAlphabet') of {'SingleValue',Sv} -> - get_CharTab2(C,StringType,hd(Sv),lists:max(Sv),Sv,InOut); + get_CharTab2(C, 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,InOut); + get_CharTab2(C, StringType, 16#20, 16#7F, notab); 'PrintableString' -> Chars = lists:sort( " '()+,-./0123456789:=?ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"), - get_CharTab2(C,StringType,hd(Chars),lists:max(Chars),Chars,InOut); + get_CharTab2(C, StringType, hd(Chars), + lists:max(Chars), Chars); 'NumericString' -> - get_CharTab2(C,StringType,16#20,$9," 0123456789",InOut); + get_CharTab2(C, StringType, 16#20, $9, " 0123456789"); 'UniversalString' -> {0,16#FFFFFFFF,notab}; 'BMPString' -> @@ -317,18 +283,13 @@ get_CharTab(C,StringType,InOut) -> end end. -get_CharTab2(C,StringType,Min,Max,Chars,InOut) -> +get_CharTab2(C, StringType, Min, Max, Chars) -> BitValMax = (1 bsl get_NumBits(C,StringType))-1, if Max =< BitValMax -> {0,Max,notab}; true -> - case InOut of - out -> - {Min,Max,create_char_tab(Min,Chars)}; - in -> - {Min,Max,list_to_tuple(Chars)} - end + {Min,Max,create_char_tab(Min,Chars)} end. create_char_tab(Min,L) -> @@ -397,7 +358,7 @@ charbits1(NumOfChars) -> %% copied from run time module -emit_enc_octet_string(_Erules,Constraint,Value) -> +emit_enc_octet_string(Erules, Constraint, Value) -> case get_constraint(Constraint,'SizeConstraint') of 0 -> emit({" []"}); @@ -446,7 +407,8 @@ emit_enc_octet_string(_Erules,Constraint,Value) -> " end",nl, " end"]); C -> - emit({" ?RT_PER:encode_octet_string(",{asis,C},",false,",Value,")",nl}) + call(Erules, encode_octet_string, + [{asis,C},false,Value]) end. emit_enc_integer_case(Value) -> @@ -533,71 +495,12 @@ emit_enc_integer(_Erule,[{_,{Lb,Ub},Range,_}],Value) when Range =< 65536 -> nl," end",nl]), emit_enc_integer_end_case(); +emit_enc_integer(Erule, [{'ValueRange',{Lb,Ub}=VR}], Value) + when is_integer(Lb), is_integer(Ub) -> + call(Erule, encode_constrained_number, [{asis,VR},Value]); -emit_enc_integer(_Erule,C,Value) -> - emit({" ?RT_PER:encode_integer(",{asis,C},",",Value,")"}). - - - - -enc_enum_cases(Value,NewList) -> - asn1ct_name:new(tmpval), - TmpVal = asn1ct_gen:mk_var(asn1ct_name:curr(tmpval)), - Cases=enc_enum_cases1(NewList), - lists:flatten(io_lib:format("(case ~s of "++Cases++ - "~s ->exit({error," - "{asn1,{enumerated,~s}}})" - " end)", - [Value,TmpVal,TmpVal])). -enc_enum_cases1(NNL) -> - enc_enum_cases1(NNL,0). -enc_enum_cases1([H|T],Index) -> - io_lib:format("~w->~w;",[H,Index])++enc_enum_cases1(T,Index+1); -enc_enum_cases1([],_) -> - "". - - -emit_enc_enumerated_cases(Erule, C, [H], Count) -> - emit_enc_enumerated_case(Erule, C, H, Count), - case H of - 'EXT_MARK' -> - ok; - _ -> - emit([";",nl]) - end, - emit([nl,"EnumVal -> exit({error,{asn1, {enumerated_not_in_range, EnumVal}}})"]), - emit([nl,"end"]); -emit_enc_enumerated_cases(Erule, C, ['EXT_MARK'|T], _Count) -> - emit_enc_enumerated_cases(Erule, C, T, 0); -emit_enc_enumerated_cases(Erule, C, [H1,H2|T], Count) -> - emit_enc_enumerated_case(Erule, C, H1, Count), - emit([";",nl]), - emit_enc_enumerated_cases(Erule, C, [H2|T], Count+1). - - -%% The function clauses matching on tuples with first element -%% asn1_enum, 1 or 0 and the atom 'EXT_MARK' are for ENUMERATED -%% with extension mark. -%% emit_enc_enumerated_case(_Erule,_C, {asn1_enum,High}, _) -> -%% %% ENUMERATED with extensionmark -%% %% value higher than the extension base and not -%% %% present in the extension range. -%% emit(["{asn1_enum,EnumV} when is_integer(EnumV), EnumV > ",High," -> ", -%% "[1,?RT_PER:encode_small_number(EnumV)]"]); -emit_enc_enumerated_case(_Erule,_C, {1,EnumName}, Count) -> - %% ENUMERATED with extensionmark - %% values higher than extension root - emit(["'",EnumName,"' -> [1,?RT_PER:encode_small_number(",Count,")]"]); -emit_enc_enumerated_case(_Erule,C, {0,EnumName}, Count) -> - %% ENUMERATED with extensionmark - %% values within extension root -%% emit(["'",EnumName,"' -> [0,?RT_PER:encode_integer(",{asis,C},", ",Count,")]"]); - emit(["'",EnumName,"' -> ",{asis,[0|asn1rt_per_bin_rt2ct:encode_integer(C,Count)]}]); -emit_enc_enumerated_case(_Erule, _C, 'EXT_MARK', _Count) -> - true. -%% %% This clause is invoked in case of an ENUMERATED without extension mark -%% emit_enc_enumerated_case(_Erule,_C, EnumName, Count) -> -%% emit(["'",EnumName,"' -> ",Count]). +emit_enc_integer(Erule, C, Value) -> + call(Erule, encode_integer, [{asis,C},Value]). get_constraint([{Key,V}],Key) -> @@ -1367,7 +1270,7 @@ emit_inner_of_decfun(Type,_) when is_record(Type,type) -> case Type#type.def of Def when is_atom(Def) -> emit({indent(9),Def," ->",nl,indent(12)}), - gen_dec_prim(erules,Type,"Val"); + 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)"}); @@ -1456,105 +1359,8 @@ gen_decode_user(Erules,D) when is_record(D,typedef) -> -gen_dec_prim(Erules,Att,BytesVar) -> - Typename = Att#type.def, - Constraint = Att#type.constraint, - case Typename of - 'INTEGER' -> - asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar); - {'INTEGER',_NamedNumberList} -> - asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar); - 'REAL' -> - emit(["?RT_PER:decode_real(",BytesVar,")"]); - - {'BIT STRING',NamedNumberList} -> - case get(compact_bit_string) of - true -> - emit({"?RT_PER:decode_compact_bit_string(", - BytesVar,",",{asis,Constraint},",", - {asis,NamedNumberList},")"}); - _ -> - emit({"?RT_PER:decode_bit_string(",BytesVar,",", - {asis,Constraint},",", - {asis,NamedNumberList},")"}) - end; - 'NULL' -> - emit({"{'NULL',",BytesVar,"}"}); - 'OBJECT IDENTIFIER' -> - emit({"?RT_PER:decode_object_identifier(", - BytesVar,")"}); - 'RELATIVE-OID' -> - emit({"?RT_PER:decode_relative_oid(", - BytesVar,")"}); - 'ObjectDescriptor' -> - emit({"?RT_PER:decode_ObjectDescriptor(", - BytesVar,")"}); - {'ENUMERATED',_} -> - asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar); - 'BOOLEAN'-> - asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar); - - 'OCTET STRING' -> - asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar); - - 'NumericString' -> - emit_dec_known_multiplier_string('NumericString', - Constraint,BytesVar); - TString when TString == 'TeletexString'; - TString == 'T61String' -> - emit({"?RT_PER:decode_TeletexString(",BytesVar,",", - {asis,Constraint},")"}); - - 'VideotexString' -> - emit({"?RT_PER:decode_VideotexString(",BytesVar,",", - {asis,Constraint},")"}); - - 'UTCTime' -> - emit_dec_known_multiplier_string('VisibleString', - Constraint,BytesVar); - 'GeneralizedTime' -> - emit_dec_known_multiplier_string('VisibleString', - Constraint,BytesVar); - 'GraphicString' -> - emit({"?RT_PER:decode_GraphicString(",BytesVar,",", - {asis,Constraint},")"}); - - 'VisibleString' -> - emit_dec_known_multiplier_string('VisibleString', - Constraint,BytesVar); - 'GeneralString' -> - emit({"?RT_PER:decode_GeneralString(",BytesVar,",", - {asis,Constraint},")"}); - - 'PrintableString' -> - emit_dec_known_multiplier_string('PrintableString', - Constraint,BytesVar); - 'IA5String' -> - emit_dec_known_multiplier_string('IA5String',Constraint,BytesVar); - - 'BMPString' -> - emit_dec_known_multiplier_string('BMPString',Constraint,BytesVar); - - 'UniversalString' -> - emit_dec_known_multiplier_string('UniversalString', - Constraint,BytesVar); - - 'UTF8String' -> - emit({"?RT_PER:decode_UTF8String(",BytesVar,")"}); - 'ANY' -> - asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar); - 'ASN1_OPEN_TYPE' -> - asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar); - #'ObjectClassFieldType'{} -> - case asn1ct_gen:get_inner(Att#type.def) of - {fixedtypevaluefield,_,InnerType} -> - gen_dec_prim(Erules,InnerType,BytesVar); - T -> - gen_dec_prim(Erules,Att#type{def=T},BytesVar) - end; - Other -> - exit({'cant decode' ,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 diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl index 34bb0b8714..5bdaed8f4f 100644 --- a/lib/asn1/src/asn1ct_imm.erl +++ b/lib/asn1/src/asn1ct_imm.erl @@ -18,10 +18,13 @@ %% %% -module(asn1ct_imm). --export([per_dec_boolean/0,per_dec_enumerated/2,per_dec_enumerated/3, +-export([per_dec_raw_bitstring/2, + per_dec_boolean/0,per_dec_enumerated/2,per_dec_enumerated/3, per_dec_extension_map/1, - per_dec_integer/2,per_dec_length/3,per_dec_named_integer/3, - per_dec_octet_string/2,per_dec_open_type/1]). + per_dec_integer/2,per_dec_k_m_string/3, + 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([optimize_alignment/1,optimize_alignment/2, dec_slim_cg/2,dec_code_gen/2]). -export([effective_constraint/2]). @@ -59,9 +62,17 @@ per_dec_boolean() -> {map,{get_bits,1,[1]},[{0,false},{1,true}]}. per_dec_enumerated(NamedList0, Aligned) -> - Constraint = [{'ValueRange',{0,length(NamedList0)-1}}], - NamedList = per_dec_enumerated_fix_list(NamedList0, [enum_error], 0), + Ub = length(NamedList0) - 1, + Constraint = [{'ValueRange',{0,Ub}}], Int = per_dec_integer(Constraint, Aligned), + EnumTail = case matched_range(Int) of + {0,Ub} -> + %% The error case can never happen. + []; + _ -> + [enum_error] + end, + NamedList = per_dec_enumerated_fix_list(NamedList0, EnumTail, 0), {map,Int,NamedList}. per_dec_enumerated(BaseNamedList, NamedListExt0, Aligned) -> @@ -100,13 +111,36 @@ per_dec_named_integer(Constraint, NamedList0, Aligned) -> NamedList = [{K,V} || {V,K} <- NamedList0] ++ [integer_default], {map,Int,NamedList}. +per_dec_k_m_string(StringType, Constraint, Aligned) -> + SzConstr = get_constraint(Constraint, 'SizeConstraint'), + N = string_num_bits(StringType, Constraint, Aligned), + Imm = dec_string(SzConstr, N, Aligned), + Chars = char_tab(Constraint, StringType, N), + convert_string(N, Chars, Imm). + per_dec_octet_string(Constraint, Aligned) -> dec_string(Constraint, 8, Aligned). +per_dec_raw_bitstring(Constraint, Aligned) -> + dec_string(Constraint, 1, Aligned). + per_dec_open_type(Aligned) -> {get_bits,decode_unconstrained_length(true, Aligned), [8,binary,{align,Aligned}]}. +per_dec_real(Aligned) -> + Dec = fun(V, Buf) -> + emit(["{",{call,real_common,decode_real,[V]}, + com,Buf,"}"]) + end, + {call,Dec, + {get_bits,decode_unconstrained_length(true, Aligned), + [8,binary,{align,Aligned}]}}. + +per_dec_restricted_string(Aligned) -> + DecLen = decode_unconstrained_length(true, Aligned), + {get_bits,DecLen,[8,binary]}. + %%% %%% Local functions. @@ -116,7 +150,7 @@ 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 -> {get_bits,Sv,[U,binary,{align,Aligned}]}; -dec_string(C, U, Aligned) when is_list(C) -> +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); @@ -129,8 +163,9 @@ dec_string({Lb,Ub}, U, Aligned) when Ub < 16#10000 -> dec_string(_, U, Aligned) -> Al = [{align,Aligned}], DecRest = fun(V, Buf) -> - emit(["?RT_PER:decode_fragmented(",V,", ", - Buf,", ",U,")"]) + asn1ct_func:call(per_common, + decode_fragmented, + [V,Buf,U]) end, {'case',[{test,{get_bits,1,[1|Al]},0, {value,{get_bits, @@ -228,6 +263,103 @@ per_num_bits(N) when N =< 64 -> 6; per_num_bits(N) when N =< 128 -> 7; per_num_bits(N) when N =< 255 -> 8. +matched_range({get_bits,Bits0,[U|Flags]}) when is_integer(U) -> + case lists:member(signed, Flags) of + false -> + Bits = U*Bits0, + {0,(1 bsl Bits) - 1}; + true -> + unknown + end; +matched_range(_Op) -> unknown. + +string_num_bits(StringType, Constraint, Aligned) -> + case get_constraint(Constraint, 'PermittedAlphabet') of + {'SingleValue',Sv} -> + charbits(length(Sv), Aligned); + no -> + case StringType of + 'IA5String' -> + charbits(128, Aligned); + 'VisibleString' -> + charbits(95, Aligned); + 'PrintableString' -> + charbits(74, Aligned); + 'NumericString' -> + charbits(11, Aligned); + 'UniversalString' -> + 32; + 'BMPString' -> + 16 + end + end. + +charbits(NumChars, false) -> + uper_num_bits(NumChars); +charbits(NumChars, true) -> + 1 bsl uper_num_bits(uper_num_bits(NumChars)). + +convert_string(8, notab, Imm) -> + {convert,binary_to_list,Imm}; +convert_string(NumBits, notab, Imm) when NumBits < 8 -> + Dec = fun(V, Buf) -> + emit(["{",{call,per_common,decode_chars, + [V,NumBits]},com,Buf,"}"]) + end, + {call,Dec,Imm}; +convert_string(NumBits, notab, Imm) when NumBits =:= 16 -> + Dec = fun(V, Buf) -> + emit(["{",{call,per_common,decode_chars_16bit, + [V]},com,Buf,"}"]) + end, + {call,Dec,Imm}; +convert_string(NumBits, notab, Imm) -> + Dec = fun(V, Buf) -> + emit(["{",{call,per_common,decode_big_chars, + [V,NumBits]},com,Buf,"}"]) + end, + {call,Dec,Imm}; +convert_string(NumBits, Chars, Imm) -> + Dec = fun(V, Buf) -> + emit(["{",{call,per_common,decode_chars, + [V,NumBits,{asis,Chars}]},com,Buf,"}"]) + end, + {call,Dec,Imm}. + +char_tab(C, StringType, NumBits) -> + case get_constraint(C, 'PermittedAlphabet') of + {'SingleValue',Sv} -> + char_tab_1(Sv, NumBits); + no -> + case StringType of + 'IA5String' -> + notab; + 'VisibleString' -> + notab; + 'PrintableString' -> + Chars = " '()+,-./0123456789:=?" + "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyz", + char_tab_1(Chars, NumBits); + 'NumericString' -> + char_tab_1(" 0123456789", NumBits); + 'UniversalString' -> + notab; + 'BMPString' -> + notab + end + end. + +char_tab_1(Chars, NumBits) -> + Max = lists:max(Chars), + BitValMax = (1 bsl NumBits) - 1, + if + Max =< BitValMax -> + notab; + true -> + list_to_tuple(lists:sort(Chars)) + end. + %%% %%% Remove unnecessary aligning to octet boundaries. %%% @@ -259,6 +391,8 @@ opt_al({'case',Cs0}, A0) -> opt_al({map,E0,Cs}, A0) -> {E,A} = opt_al(E0, A0), {{map,E,Cs},A}; +opt_al('NULL'=Null, A) -> + {Null,A}; opt_al(I, A) when is_integer(I) -> {I,A}. @@ -346,6 +480,8 @@ flatten({map,E0,Cs0}, Buf0, St0) -> {Dst,St2} = new_var("Int", St1), Cs = flatten_map_cs(Cs0, E), {{Dst,DstBuf},Pre++[{'map',E,Cs,{Dst,DstBuf}}],St2}; +flatten({value,'NULL'}, Buf0, St0) -> + {{"'NULL'",Buf0},[],St0}; flatten({value,V0}, Buf0, St0) when is_integer(V0) -> {{V0,Buf0},[],St0}; flatten({value,V0}, Buf0, St0) -> @@ -515,8 +651,6 @@ dcg_list_inside([{get_bits,{Sz,_},Fl0,{Dst,DstBuf}}|T], _) -> dcg_list_inside(T, DstBuf); dcg_list_inside(L, Dst) -> {L,Dst}. -bit_flags([1|T], Acc) -> - bit_flags(T, Acc); bit_flags([{align,_}|T], Acc) -> bit_flags(T, Acc); bit_flags([non_zero|T], Acc) -> @@ -528,7 +662,11 @@ bit_flags([H|T], Acc) -> bit_flags([], []) -> ""; bit_flags([], Acc) -> - "/" ++ bit_flags_1(Acc, ""). + case "/" ++ bit_flags_1(Acc, "") of + "/unit:1" -> []; + Opts -> Opts + end. + bit_flags_1([H|T], Sep) -> Sep ++ H ++ bit_flags_1(T, "-"); diff --git a/lib/asn1/src/asn1ct_value.erl b/lib/asn1/src/asn1ct_value.erl index 389642c446..8f3dc1d8b8 100644 --- a/lib/asn1/src/asn1ct_value.erl +++ b/lib/asn1/src/asn1ct_value.erl @@ -54,7 +54,7 @@ from_type(M,Typename,Type) when is_record(Type,type) -> {notype,_} -> true; {primitive,bif} -> - from_type_prim(Type); + from_type_prim(M, Type); 'ASN1_OPEN_TYPE' -> case Type#type.constraint of [#'Externaltypereference'{type=TrefConstraint}] -> @@ -65,7 +65,7 @@ from_type(M,Typename,Type) when is_record(Type,type) -> end; {constructed,bif} when Typename == ['EXTERNAL'] -> Val=from_type_constructed(M,Typename,InnerType,Type), - asn1rt_check:transform_to_EXTERNAL1994(Val); + asn1ct_eval_ext:transform_to_EXTERNAL1994(Val); {constructed,bif} -> from_type_constructed(M,Typename,InnerType,Type) end; @@ -164,7 +164,7 @@ gen_list(_,_,_,0) -> gen_list(M,Typename,Oftype,N) -> [from_type(M,Typename,Oftype)|gen_list(M,Typename,Oftype,N-1)]. -from_type_prim(D) -> +from_type_prim(M, D) -> C = D#type.constraint, case D#type.def of 'INTEGER' -> @@ -212,18 +212,7 @@ from_type_prim(D) -> NN = [X||{X,_} <- NamedNumberList], case NN of [] -> - Bl1 =lists:reverse(adjust_list(size_random(C),[1,0,1,1])), - Bl2 = lists:reverse(lists:dropwhile(fun(0)->true;(1)->false end,Bl1)), - case {length(Bl2),get_constraint(C,'SizeConstraint')} of - {Len,Len} -> - Bl2; - {_Len,Int} when is_integer(Int) -> - Bl1; - {Len,{Min,_}} when Min > Len -> - Bl1; - _ -> - Bl2 - end; + random_unnamed_bit_string(M, C); _ -> [lists:nth(random(length(NN)),NN)] end; @@ -320,6 +309,32 @@ c_string(C,Default) -> Default end. +random_unnamed_bit_string(M, C) -> + Bl1 = lists:reverse(adjust_list(size_random(C), [1,0,1,1])), + Bl2 = lists:reverse(lists:dropwhile(fun(0)-> true; + (1) -> false + end,Bl1)), + Val = case {length(Bl2),get_constraint(C, 'SizeConstraint')} of + {Len,Len} -> + Bl2; + {_Len,Int} when is_integer(Int) -> + Bl1; + {Len,{Min,_}} when Min > Len -> + Bl1; + _ -> + Bl2 + end, + case M:bit_string_format() of + legacy -> + Val; + bitstring -> + << <<B:1>> || B <- Val >>; + compact -> + BitString = << <<B:1>> || B <- Val >>, + PadLen = (8 - (bit_size(BitString) band 7)) band 7, + {PadLen,<<BitString/bitstring,0:PadLen>>} + end. + %% FIXME: %% random_sign(integer) -> %% case random(2) of diff --git a/lib/asn1/src/asn1rt_ber_bin.erl b/lib/asn1/src/asn1rt_ber_bin.erl deleted file mode 100644 index ec1549804b..0000000000 --- a/lib/asn1/src/asn1rt_ber_bin.erl +++ /dev/null @@ -1,525 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-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% -%% -%% --module(asn1rt_ber_bin). - --export([decode_length/1, - encode_real/2, encode_real/3, - decode_real/2, decode_real/4, - decode_tag/1]). - --include("asn1_records.hrl"). - -%% the encoding of class of tag bits 8 and 7 --define(UNIVERSAL, 0). - -%%% primitive or constructed encoding % bit 6 --define(PRIMITIVE, 0). --define(CONSTRUCTED, 2#00100000). - -%%% The tag-number for universal types --define(N_REAL, 9). - -encode_tag_val({Class, Form, TagNo}) when (TagNo =< 30) -> - <<(Class bsr 6):2,(Form bsr 5):1,TagNo:5>>; - -encode_tag_val({Class, Form, TagNo}) -> - {Octets,_Len} = mk_object_val(TagNo), - BinOct = list_to_binary(Octets), - <<(Class bsr 6):2, (Form bsr 5):1, 31:5,BinOct/binary>>. - -%%=============================================================================== -%% Decode a tag -%% -%% decode_tag(OctetListBuffer) -> {{Class, Form, TagNo}, RestOfBuffer, RemovedBytes} -%%=============================================================================== - -%% multiple octet tag -decode_tag(<<Class:2, Form:1, 31:5, Buffer/binary>>) -> - {TagNo, Buffer1, RemovedBytes} = decode_tag(Buffer, 0, 1), - {{(Class bsl 6), (Form bsl 5), TagNo}, Buffer1, RemovedBytes}; - -%% single tag (< 31 tags) -decode_tag(<<Class:2,Form:1,TagNo:5, Buffer/binary>>) -> - {{(Class bsl 6), (Form bsl 5), TagNo}, Buffer, 1}. - -%% last partial tag -decode_tag(<<0:1,PartialTag:7, Buffer/binary>>, TagAck, RemovedBytes) -> - TagNo = (TagAck bsl 7) bor PartialTag, - %%<<TagNo>> = <<TagAck:1, PartialTag:7>>, - {TagNo, Buffer, RemovedBytes+1}; -% more tags -decode_tag(<<_:1,PartialTag:7, Buffer/binary>>, TagAck, RemovedBytes) -> - TagAck1 = (TagAck bsl 7) bor PartialTag, - %%<<TagAck1:16>> = <<TagAck:1, PartialTag:7,0:8>>, - decode_tag(Buffer, TagAck1, RemovedBytes+1). - -%%------------------------------------------------------------------ -%% check_tags_i is the same as check_tags except that it stops and -%% returns the remaining tags not checked when it encounters an -%% indefinite length field -%% only called internally within this module - -check_tags_i([Tag], Buffer, OptOrMand) -> % optimized very usual case - {[],check_one_tag(Tag, Buffer, OptOrMand)}; -check_tags_i(Tags, Buffer, OptOrMand) -> - check_tags_i(Tags, Buffer, 0, OptOrMand). - -check_tags_i([Tag1,Tag2|TagRest], Buffer, Rb, OptOrMand) - when Tag1#tag.type == 'IMPLICIT' -> - check_tags_i([Tag1#tag{type=Tag2#tag.type}|TagRest], Buffer, Rb, OptOrMand); - -check_tags_i([Tag1|TagRest], Buffer, Rb, OptOrMand) -> - {Form_Length,Buffer2,Rb1} = check_one_tag(Tag1, Buffer, OptOrMand), - case TagRest of - [] -> {TagRest, {Form_Length, Buffer2, Rb + Rb1}}; - _ -> - case Form_Length of - {?CONSTRUCTED,_} -> - {TagRest, {Form_Length, Buffer2, Rb + Rb1}}; - _ -> - check_tags_i(TagRest, Buffer2, Rb + Rb1, mandatory) - end - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% This function is called from generated code - -check_one_tag(Tag=#tag{class=ExpectedClass,number=ExpectedNumber}, Buffer, OptOrMand) -> - case catch decode_tag(Buffer) of - {'EXIT',_Reason} -> - tag_error(no_data,Tag,Buffer,OptOrMand); - {{ExpectedClass,Form,ExpectedNumber},Buffer2,Rb} -> - {{L,Buffer3},RemBytes2} = decode_length(Buffer2), - {{Form,L}, Buffer3, RemBytes2+Rb}; - {ErrorTag,_,_} -> - tag_error(ErrorTag, Tag, Buffer, OptOrMand) - end. - -tag_error(ErrorTag, Tag, Buffer, OptOrMand) -> - case OptOrMand of - mandatory -> - exit({error,{asn1, {invalid_tag, - {ErrorTag, Tag, Buffer}}}}); - _ -> - exit({error,{asn1, {no_optional_tag, - {ErrorTag, Tag, Buffer}}}}) - end. -%%======================================================================= -%% -%% Encode all tags in the list Tags and return a possibly deep list of -%% bytes with tag and length encoded -%% -%% prepend_tags(Tags, BytesSoFar, LenSoFar) -> {Bytes, Len} -encode_tags(Tags, BytesSoFar, LenSoFar) -> - NewTags = encode_tags1(Tags, []), - %% NewTags contains the resulting tags in reverse order - encode_tags2(NewTags, BytesSoFar, LenSoFar). - -%encode_tags2([#tag{class=?UNIVERSAL,number=No}|Trest], BytesSoFar, LenSoFar) -> -% {Bytes2,L2} = encode_length(LenSoFar), -% encode_tags2(Trest,[[No|Bytes2],BytesSoFar], LenSoFar + 1 + L2); -encode_tags2([Tag|Trest], BytesSoFar, LenSoFar) -> - {Bytes1,L1} = encode_one_tag(Tag), - {Bytes2,L2} = encode_length(LenSoFar), - encode_tags2(Trest, [Bytes1,Bytes2|BytesSoFar], - LenSoFar + L1 + L2); -encode_tags2([], BytesSoFar, LenSoFar) -> - {BytesSoFar,LenSoFar}. - -encode_tags1([Tag1, Tag2| Trest], Acc) when Tag1#tag.type =:= 'IMPLICIT' -> - encode_tags1([Tag1#tag{type=Tag2#tag.type,form=Tag2#tag.form}|Trest],Acc); -encode_tags1([Tag1 | Trest], Acc) -> - encode_tags1(Trest, [Tag1|Acc]); -encode_tags1([], Acc) -> - Acc. % the resulting tags are returned in reverse order - -encode_one_tag(Bin) when is_binary(Bin) -> - {Bin,byte_size(Bin)}; -encode_one_tag(#tag{class=Class,number=No,type=Type, form = Form}) -> - NewForm = case Type of - 'EXPLICIT' -> - ?CONSTRUCTED; - _ -> - Form - end, - Bytes = encode_tag_val({Class,NewForm,No}), - {Bytes,size(Bytes)}. - -%%============================================================================ -%% -%% Real value, ITU_T X.690 Chapter 8.5 -%%============================================================================ -%% -%% encode real value -%%============================================================================ - -%% only base 2 internally so far!! -encode_real(_C,0, DoTag) -> - dotag(DoTag, ?N_REAL, {[],0}); -encode_real(_C,'PLUS-INFINITY', DoTag) -> - dotag(DoTag, ?N_REAL, {[64],1}); -encode_real(_C,'MINUS-INFINITY', DoTag) -> - dotag(DoTag, ?N_REAL, {[65],1}); -encode_real(C,Val, DoTag) when is_tuple(Val); is_list(Val) -> - dotag(DoTag, ?N_REAL, encode_real(C,Val)). - -%%%%%%%%%%%%%% -%% only base 2 encoding! -%% binary encoding: -%% +------------+ +------------+ +-+-+-+-+---+---+ -%% | (tag)9 | | n + p + 1 | |1|S|BB |FF |EE | -%% +------------+ +------------+ +-+-+-+-+---+---+ -%% -%% +------------+ +------------+ -%% | | | | -%% +------------+ ...+------------+ -%% n octets for exponent -%% -%% +------------+ +------------+ -%% | | | | -%% +------------+ ...+------------+ -%% p octets for pos mantissa -%% -%% S is 0 for positive sign -%% 1 for negative sign -%% BB: encoding base, 00 = 2, (01 = 8, 10 = 16) -%% 01 and 10 not used -%% FF: scale factor 00 = 0 (used in base 2 encoding) -%% EE: encoding of the exponent: -%% 00 - on the following octet -%% 01 - on the 2 following octets -%% 10 - on the 3 following octets -%% 11 - encoding of the length of the two's-complement encoding of -%% exponent on the following octet, and two's-complement -%% encoding of exponent on the other octets. -%% -%% In DER and base 2 encoding the mantissa is encoded as value 0 or -%% bit shifted until it is an odd number. Thus, do this for BER as -%% well. -%% This interface also used by RT_COMMON -encode_real(_C,{Mantissa, Base, Exponent}) when Base =:= 2 -> -%% io:format("Mantissa: ~w Base: ~w, Exp: ~w~n",[Man, Base, Exp]), - {Man,ExpAdd} = truncate_zeros(Mantissa), %% DER adjustment - Exp = Exponent + ExpAdd, - OctExp = if Exp >= 0 -> list_to_binary(encode_integer_pos(Exp, [])); - true -> list_to_binary(encode_integer_neg(Exp, [])) - end, -%% ok = io:format("OctExp: ~w~n",[OctExp]), - SignBit = if Man > 0 -> 0; % bit 7 is pos or neg, no Zeroval - true -> 1 - end, -%% ok = io:format("SignBitMask: ~w~n",[SignBitMask]), - SFactor = 0, - OctExpLen = size(OctExp), - if OctExpLen > 255 -> - exit({error,{asn1, {to_big_exp_in_encode_real, OctExpLen}}}); - true -> true %% make real assert later.. - end, - {LenCode, EOctets} = case OctExpLen of % bit 2,1 - 1 -> {0, OctExp}; - 2 -> {1, OctExp}; - 3 -> {2, OctExp}; - _ -> {3, <<OctExpLen, OctExp/binary>>} - end, - BB = 0, %% 00 for base 2 - FirstOctet = <<1:1,SignBit:1,BB:2,SFactor:2,LenCode:2>>, - OctMantissa = if Man > 0 -> list_to_binary(minimum_octets(Man)); - true -> list_to_binary(minimum_octets(-(Man))) % signbit keeps track of sign - end, - %% ok = io:format("LenMask: ~w EOctets: ~w~nFirstOctet: ~w OctMantissa: ~w OctExpLen: ~w~n", [LenMask, EOctets, FirstOctet, OctMantissa, OctExpLen]), - Bin = <<FirstOctet/binary, EOctets/binary, OctMantissa/binary>>, - {Bin, size(Bin)}; -encode_real(C,{Mantissa,Base,Exponent}) - when Base =:= 10, is_integer(Mantissa), is_integer(Exponent) -> - %% always encode as NR3 due to DER on the format - %% mmmm.Eseeee where - %% m := digit - %% s := '-' | '+' | [] - %% '+' only allowed in +0 - %% e := digit - %% ex: 1234.E-5679 -%% {Man,AddExp} = truncate_zeros(Mantissa,0), -%% ManNum = trunc(Mantissa), -%% {TruncatedMan,NumZeros} = truncate_zeros10(Mantissa), - ManStr = integer_to_list(Mantissa), - - encode_real_as_string(C,ManStr,Exponent); -encode_real(_C,{_,Base,_}) -> - exit({error,{asn1, {encode_real_non_supported_encodeing, Base}}}); -%% base 10 -encode_real(C,Real) when is_list(Real) -> - %% The Real string may come in as a NR1, NR2 or NR3 string. - {Mantissa, Exponent} = - case string:tokens(Real,"Ee") of - [NR2] -> - {NR2,0}; - [NR3MB,NR3E] -> - %% remove beginning zeros - {NR3MB,list_to_integer(NR3E)} - end, - - %% .Decimal | Number | Number.Decimal - ZeroDecimal = - fun("0") -> ""; - (L) -> L - end, - {NewMantissa,LenDecimal} = - case Mantissa of - [$.|Dec] -> - NewMan = remove_trailing_zeros(Dec), - {NewMan,length(ZeroDecimal(NewMan))}; - _ -> - case string:tokens(Mantissa,",.") of - [Num] -> %% No decimal-mark - {integer_to_list(list_to_integer(Num)),0}; - [Num,Dec] -> - NewDec = ZeroDecimal(remove_trailing_zeros(Dec)), - NewMan = integer_to_list(list_to_integer(Num)) ++ NewDec, - {integer_to_list(list_to_integer(NewMan)), - length(NewDec)} - end - end, - -% DER_Exponent = integer_to_list(Exponent - ExpReduce), - encode_real_as_string(C,NewMantissa,Exponent - LenDecimal). - -encode_real_as_string(_C,Mantissa,Exponent) - when is_list(Mantissa), is_integer(Exponent) -> - %% Remove trailing zeros in Mantissa and add this to Exponent - TruncMant = remove_trailing_zeros(Mantissa), - - ExpIncr = length(Mantissa) - length(TruncMant), - - ExpStr = integer_to_list(Exponent + ExpIncr), - - ExpBin = - case ExpStr of - "0" -> - <<"E+0">>; - _ -> - ExpB = list_to_binary(ExpStr), - <<$E,ExpB/binary>> - end, - ManBin = list_to_binary(TruncMant), - NR3 = 3, - {<<NR3,ManBin/binary,$.,ExpBin/binary>>,2 + size(ManBin) + size(ExpBin)}. - -remove_trailing_zeros(IntStr) -> - case lists:dropwhile(fun($0)-> true; - (_) -> false - end, lists:reverse(IntStr)) of - [] -> - "0"; - ReversedIntStr -> - lists:reverse(ReversedIntStr) - end. - -truncate_zeros(Num) -> - truncate_zeros(Num,0). -truncate_zeros(0,Sum) -> - {0,Sum}; -truncate_zeros(M,Sum) -> - case M band 16#f =:= M band 16#e of - true -> truncate_zeros(M bsr 1,Sum+1); - _ -> {M,Sum} - end. - - -%%============================================================================ -%% decode real value -%% -%% decode_real([OctetBufferList], tuple|value, tag|notag) -> -%% {{Mantissa, Base, Exp} | realval | PLUS-INFINITY | MINUS-INFINITY | 0, -%% RestBuff} -%% -%% only for base 2 decoding sofar!! -%%============================================================================ - -decode_real(Buffer, C, Tags, OptOrMand) -> - NewTags = new_tags(Tags,#tag{class=?UNIVERSAL,number=?N_REAL}), - decode_real_notag(Buffer, C, NewTags, OptOrMand). - -%% This interface used by RT_COMMON -decode_real(Buffer,Len) -> - decode_real2(Buffer,[],Len,0). - -decode_real_notag(Buffer, C, Tags, OptOrMand) -> - {_RestTags, {{_,Len}, Buffer0, Rb0}} = - check_tags_i(Tags, Buffer, OptOrMand), - decode_real2(Buffer0, C, Len, Rb0). - -decode_real2(Buffer, _C, 0, _RemBytes) -> - {0,Buffer}; -decode_real2(Buffer0, _C, Len, RemBytes1) -> - <<First, Buffer2/binary>> = Buffer0, - if - First =:= 2#01000000 -> {'PLUS-INFINITY', Buffer2}; - First =:= 2#01000001 -> {'MINUS-INFINITY', Buffer2}; -%% First =:= 2#00000000 -> {0, Buffer2}; - First =:= 1 orelse First =:= 2 orelse First =:= 3 -> - %% charcter string encoding of base 10 - {NRx,Rest} = split_binary(Buffer2,Len-1), - {binary_to_list(NRx),Rest,Len}; - true -> - %% have some check here to verify only supported bases (2) - %% not base 8 or 16 - <<_B7:1,Sign:1,BB:2,_FF:2,EE:2>> = <<First>>, - Base = - case BB of - 0 -> 2; % base 2, only one so far - _ -> exit({error,{asn1, {non_supported_base, BB}}}) - end, - {FirstLen, {Exp, Buffer3,_Rb2}, RemBytes2} = - case EE of - 0 -> {2, decode_integer2(1, Buffer2, RemBytes1), RemBytes1+1}; - 1 -> {3, decode_integer2(2, Buffer2, RemBytes1), RemBytes1+2}; - 2 -> {4, decode_integer2(3, Buffer2, RemBytes1), RemBytes1+3}; - 3 -> - <<ExpLen1,RestBuffer/binary>> = Buffer2, - { ExpLen1 + 2, - decode_integer2(ExpLen1, RestBuffer, RemBytes1), - RemBytes1+ExpLen1} - end, - %% io:format("FirstLen: ~w, Exp: ~w, Buffer3: ~w ~n", - - Length = Len - FirstLen, - <<LongInt:Length/unit:8,RestBuff/binary>> = Buffer3, - {{Mantissa, Buffer4}, RemBytes3} = - if Sign =:= 0 -> - %% io:format("sign plus~n"), - {{LongInt, RestBuff}, 1 + Length}; - true -> - %% io:format("sign minus~n"), - {{-LongInt, RestBuff}, 1 + Length} - end, - {{Mantissa, Base, Exp}, Buffer4, RemBytes2+RemBytes3} - end. - -encode_integer_pos(0, L=[B|_Acc]) when B < 128 -> - L; -encode_integer_pos(N, Acc) -> - encode_integer_pos((N bsr 8), [N band 16#ff| Acc]). - -encode_integer_neg(-1, L=[B1|_T]) when B1 > 127 -> - L; -encode_integer_neg(N, Acc) -> - encode_integer_neg(N bsr 8, [N band 16#ff|Acc]). - - -%%%%%%%%%%% -%% mk_object_val(Value) -> {OctetList, Len} -%% returns a Val as a list of octets, the 8 bit is allways set to one except -%% for the last octet, where its 0 -%% - - -mk_object_val(Val) when Val =< 127 -> - {[255 band Val], 1}; -mk_object_val(Val) -> - mk_object_val(Val bsr 7, [Val band 127], 1). -mk_object_val(0, Ack, Len) -> - {Ack, Len}; -mk_object_val(Val, Ack, Len) -> - mk_object_val(Val bsr 7, [((Val band 127) bor 128) | Ack], Len + 1). - - -%%============================================================================ -%% Length handling -%% -%% Encode length -%% -%% encode_length(Int | indefinite) -> -%% [<127]| [128 + Int (<127),OctetList] | [16#80] -%%============================================================================ - -encode_length(L) when L =< 16#7F -> - {[L],1}; -encode_length(L) -> - Oct = minimum_octets(L), - Len = length(Oct), - if - Len =< 126 -> - {[ (16#80+Len) | Oct ],Len+1}; - true -> - exit({error,{asn1, to_long_length_oct, Len}}) - end. - - -%% Val must be >= 0 -minimum_octets(Val) -> - minimum_octets(Val,[]). - -minimum_octets(0,Acc) -> - Acc; -minimum_octets(Val, Acc) -> - minimum_octets((Val bsr 8),[Val band 16#FF | Acc]). - - -%%=========================================================================== -%% Decode length -%% -%% decode_length(OctetList) -> {{indefinite, RestOctetsL}, NoRemovedBytes} | -%% {{Length, RestOctetsL}, NoRemovedBytes} -%%=========================================================================== - -decode_length(<<1:1,0:7,T/binary>>) -> - {{indefinite, T}, 1}; -decode_length(<<0:1,Length:7,T/binary>>) -> - {{Length,T},1}; -decode_length(<<1:1,LL:7,T/binary>>) -> - <<Length:LL/unit:8,Rest/binary>> = T, - {{Length,Rest}, LL+1}. - - -dotag([], Tag, {Bytes,Len}) -> - dotag_universal(Tag,Bytes,Len); -dotag(Tags, Tag, {Bytes,Len}) -> - encode_tags(Tags ++ [#tag{class=?UNIVERSAL,number=Tag,form=?PRIMITIVE}], - Bytes, Len). - -dotag_universal(UniversalTag,Bytes,Len) when Len =< 16#7F-> - {[UniversalTag,Len,Bytes],2+Len}; -dotag_universal(UniversalTag,Bytes,Len) -> - {EncLen,LenLen}=encode_length(Len), - {[UniversalTag,EncLen,Bytes],1+LenLen+Len}. - -%% decoding postitive integer values. -decode_integer2(Len,Bin = <<0:1,_:7,_Bs/binary>>,RemovedBytes) -> - <<Int:Len/unit:8,Buffer2/binary>> = Bin, - {Int,Buffer2,RemovedBytes}; -%% decoding negative integer values. -decode_integer2(Len,<<1:1,B2:7,Bs/binary>>,RemovedBytes) -> - <<N:Len/unit:8,Buffer2/binary>> = <<B2,Bs/binary>>, - Int = N - (1 bsl (8 * Len - 1)), - {Int,Buffer2,RemovedBytes}. - -new_tags([],LastTag) -> - [LastTag]; -new_tags(Tags = [#tag{type='IMPLICIT'}],_LastTag) -> - Tags; -new_tags([T1 = #tag{type='IMPLICIT'},#tag{type=T2Type}|Rest],LastTag) -> - new_tags([T1#tag{type=T2Type}|Rest],LastTag); -new_tags(Tags,LastTag) -> - case lists:last(Tags) of - #tag{type='IMPLICIT'} -> - Tags; - _ -> - Tags ++ [LastTag] - end. diff --git a/lib/asn1/src/asn1rt_ber_bin_v2.erl b/lib/asn1/src/asn1rt_ber_bin_v2.erl deleted file mode 100644 index 92ca11cf89..0000000000 --- a/lib/asn1/src/asn1rt_ber_bin_v2.erl +++ /dev/null @@ -1,1992 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2012. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% 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(asn1rt_ber_bin_v2). - -%% encoding / decoding of BER - --export([decode/1, decode/2, match_tags/2, encode/1, encode/2]). --export([fixoptionals/2, - encode_tag_val/1, - encode_tags/3, - skip_ExtensionAdditions/2]). --export([encode_boolean/2,decode_boolean/2, - encode_integer/3,encode_integer/4, - decode_integer/3, decode_integer/4, - encode_enumerated/2, - encode_enumerated/4,decode_enumerated/4, - encode_real/3,decode_real/2, - encode_bit_string/4,decode_bit_string/4, - decode_compact_bit_string/4, - encode_octet_string/3,decode_octet_string/3, - encode_null/2,decode_null/2, - encode_relative_oid/2,decode_relative_oid/2, - encode_object_identifier/2,decode_object_identifier/2, - encode_restricted_string/4,decode_restricted_string/4, - encode_universal_string/3,decode_universal_string/3, - encode_UTF8_string/3,decode_UTF8_string/2, - encode_BMP_string/3,decode_BMP_string/3, - encode_generalized_time/3,decode_generalized_time/3, - encode_utc_time/3,decode_utc_time/3, - encode_length/1,decode_length/1, - decode_tag_and_length/1]). - --export([encode_open_type/1,encode_open_type/2, - decode_open_type/2,decode_open_type/3, - decode_open_type_as_binary/2, - decode_open_type_as_binary/3]). - --export([decode_primitive_incomplete/2,decode_selective/2]). - -% the encoding of class of tag bits 8 and 7 --define(UNIVERSAL, 0). --define(APPLICATION, 16#40). --define(CONTEXT, 16#80). --define(PRIVATE, 16#C0). - -%%% primitive or constructed encoding % bit 6 --define(PRIMITIVE, 0). --define(CONSTRUCTED, 2#00100000). - -%%% The tag-number for universal types --define(N_BOOLEAN, 1). --define(N_INTEGER, 2). --define(N_BIT_STRING, 3). --define(N_OCTET_STRING, 4). --define(N_NULL, 5). --define(N_OBJECT_IDENTIFIER, 6). --define(N_OBJECT_DESCRIPTOR, 7). --define(N_EXTERNAL, 8). --define(N_REAL, 9). --define(N_ENUMERATED, 10). --define(N_EMBEDDED_PDV, 11). --define(N_SEQUENCE, 16). --define(N_SET, 17). --define(N_NumericString, 18). --define(N_PrintableString, 19). --define(N_TeletexString, 20). --define(N_VideotexString, 21). --define(N_IA5String, 22). --define(N_UTCTime, 23). --define(N_GeneralizedTime, 24). --define(N_GraphicString, 25). --define(N_VisibleString, 26). --define(N_GeneralString, 27). --define(N_UniversalString, 28). --define(N_BMPString, 30). - - -% the complete tag-word of built-in types --define(T_BOOLEAN, ?UNIVERSAL bor ?PRIMITIVE bor 1). --define(T_INTEGER, ?UNIVERSAL bor ?PRIMITIVE bor 2). --define(T_BIT_STRING, ?UNIVERSAL bor ?PRIMITIVE bor 3). % can be CONSTRUCTED --define(T_OCTET_STRING, ?UNIVERSAL bor ?PRIMITIVE bor 4). % can be CONSTRUCTED --define(T_NULL, ?UNIVERSAL bor ?PRIMITIVE bor 5). --define(T_OBJECT_IDENTIFIER,?UNIVERSAL bor ?PRIMITIVE bor 6). --define(T_OBJECT_DESCRIPTOR,?UNIVERSAL bor ?PRIMITIVE bor 7). --define(T_EXTERNAL, ?UNIVERSAL bor ?PRIMITIVE bor 8). --define(T_REAL, ?UNIVERSAL bor ?PRIMITIVE bor 9). --define(T_ENUMERATED, ?UNIVERSAL bor ?PRIMITIVE bor 10). --define(T_EMBEDDED_PDV, ?UNIVERSAL bor ?PRIMITIVE bor 11). --define(T_SEQUENCE, ?UNIVERSAL bor ?CONSTRUCTED bor 16). --define(T_SET, ?UNIVERSAL bor ?CONSTRUCTED bor 17). --define(T_NumericString, ?UNIVERSAL bor ?PRIMITIVE bor 18). %can be constructed --define(T_PrintableString, ?UNIVERSAL bor ?PRIMITIVE bor 19). %can be constructed --define(T_TeletexString, ?UNIVERSAL bor ?PRIMITIVE bor 20). %can be constructed --define(T_VideotexString, ?UNIVERSAL bor ?PRIMITIVE bor 21). %can be constructed --define(T_IA5String, ?UNIVERSAL bor ?PRIMITIVE bor 22). %can be constructed --define(T_UTCTime, ?UNIVERSAL bor ?PRIMITIVE bor 23). --define(T_GeneralizedTime, ?UNIVERSAL bor ?PRIMITIVE bor 24). --define(T_GraphicString, ?UNIVERSAL bor ?PRIMITIVE bor 25). %can be constructed --define(T_VisibleString, ?UNIVERSAL bor ?PRIMITIVE bor 26). %can be constructed --define(T_GeneralString, ?UNIVERSAL bor ?PRIMITIVE bor 27). %can be constructed --define(T_UniversalString, ?UNIVERSAL bor ?PRIMITIVE bor 28). %can be constructed --define(T_BMPString, ?UNIVERSAL bor ?PRIMITIVE bor 30). %can be constructed - -% encode(Tlv={_Tag={?PRIMITIVE,_},_VList}) -> -% encode_primitive(Tlv); -% encode(Tlv) -> -% encode_constructed(Tlv). - -encode(Tlv) -> - encode(Tlv,erlang). - -encode(Tlv,_) when is_binary(Tlv) -> - Tlv; -encode([Tlv],Method) -> - encode(Tlv,Method); -encode(Tlv, nif) -> - asn1rt_nif:encode_ber_tlv(Tlv); -encode(Tlv, _) -> - encode_erl(Tlv). - -encode_erl({TlvTag,TlvVal}) when is_list(TlvVal) -> - %% constructed form of value - encode_tlv(TlvTag,TlvVal,?CONSTRUCTED); -encode_erl({TlvTag,TlvVal}) -> - encode_tlv(TlvTag,TlvVal,?PRIMITIVE). - -encode_tlv(TlvTag,TlvVal,Form) -> - Tag = encode_tlv_tag(TlvTag,Form), - {Val,VLen} = encode_tlv_val(TlvVal), - {Len,_LLen} = encode_length(VLen), - BinLen = list_to_binary(Len), - <<Tag/binary,BinLen/binary,Val/binary>>. - -encode_tlv_tag(ClassTagNo,Form) -> - Class = ClassTagNo bsr 16, - encode_tag_val({Class bsl 6,Form,(ClassTagNo - (Class bsl 16))}). - -encode_tlv_val(TlvL) when is_list(TlvL) -> - encode_tlv_list(TlvL,[]); -encode_tlv_val(Bin) -> - {Bin,size(Bin)}. - -encode_tlv_list([Tlv|Tlvs],Acc) -> - EncTlv = encode_erl(Tlv), - encode_tlv_list(Tlvs,[EncTlv|Acc]); -encode_tlv_list([],Acc) -> - Bin=list_to_binary(lists:reverse(Acc)), - {Bin,size(Bin)}. - -decode(B) -> - decode(B, erlang). - -%% asn1-1.7 -decode(B, nif) -> - case asn1rt_nif:decode_ber_tlv(B) of - {error, Reason} -> handle_error(Reason, B); - Else -> Else - end; -decode(B,erlang) when is_binary(B) -> - decode_primitive(B); -decode(Tlv,erlang) -> - {Tlv,<<>>}. - -handle_error([],_)-> - exit({error,{asn1,{"memory allocation problem"}}}); -handle_error({$1,_},L) -> % error in nif - exit({error,{asn1,L}}); -handle_error({$2,T},L) -> % error in nif due to wrong tag - exit({error,{asn1,{"bad tag after byte:",error_pos(T),L}}}); -handle_error({$3,T},L) -> % error in driver due to length error - exit({error,{asn1,{"bad length field after byte:", - error_pos(T),L}}}); -handle_error({$4,T},L) -> % error in driver due to indefinite length error - exit({error,{asn1, - {"indefinite length without end bytes after byte:", - error_pos(T),L}}}); -handle_error({$5,T},L) -> % error in driver due to indefinite length error - exit({error,{asn1,{"bad encoded value after byte:", - error_pos(T),L}}}); -handle_error(ErrL,L) -> - exit({error,{asn1,ErrL,L}}). - -error_pos([]) -> - "unknown position"; -error_pos([B])-> - B; -error_pos([B|Bs]) -> - BS = 8 * length(Bs), - B bsl BS + error_pos(Bs). - -decode_primitive(Bin) -> - {Form,TagNo,V,Rest} = decode_tag_and_length(Bin), - case Form of - 1 -> % constructed - {{TagNo,decode_constructed(V)},Rest}; - 0 -> % primitive - {{TagNo,V},Rest}; - 2 -> % constructed indefinite - {Vlist,Rest2} = decode_constructed_indefinite(V,[]), - {{TagNo,Vlist},Rest2} - end. - -decode_constructed(Bin) when byte_size(Bin) =:= 0 -> - []; -decode_constructed(Bin) -> - {Tlv,Rest} = decode_primitive(Bin), - [Tlv|decode_constructed(Rest)]. - -decode_constructed_indefinite(<<0,0,Rest/binary>>,Acc) -> - {lists:reverse(Acc),Rest}; -decode_constructed_indefinite(Bin,Acc) -> - {Tlv,Rest} = decode_primitive(Bin), - decode_constructed_indefinite(Rest, [Tlv|Acc]). - -%% decode_primitive_incomplete/2 decodes an encoded message incomplete -%% by help of the pattern attribute (first argument). -decode_primitive_incomplete([[default,TagNo]],Bin) -> %default - case decode_tag_and_length(Bin) of - {Form,TagNo,V,Rest} -> - decode_incomplete2(Form,TagNo,V,[],Rest); - _ -> - %{asn1_DEFAULT,Bin} - asn1_NOVALUE - end; -decode_primitive_incomplete([[default,TagNo,Directives]],Bin) -> %default, constructed type, Directives points into this type - case decode_tag_and_length(Bin) of - {Form,TagNo,V,Rest} -> - decode_incomplete2(Form,TagNo,V,Directives,Rest); - _ -> - %{asn1_DEFAULT,Bin} - asn1_NOVALUE - end; -decode_primitive_incomplete([[opt,TagNo]],Bin) -> %optional - case decode_tag_and_length(Bin) of - {Form,TagNo,V,Rest} -> - decode_incomplete2(Form,TagNo,V,[],Rest); - _ -> - %{{TagNo,asn1_NOVALUE},Bin} - asn1_NOVALUE - end; -decode_primitive_incomplete([[opt,TagNo,Directives]],Bin) -> %optional - case decode_tag_and_length(Bin) of - {Form,TagNo,V,Rest} -> - decode_incomplete2(Form,TagNo,V,Directives,Rest); - _ -> - %{{TagNo,asn1_NOVALUE},Bin} - asn1_NOVALUE - end; -%% An optional that shall be undecoded -decode_primitive_incomplete([[opt_undec,Tag]],Bin) -> - case decode_tag_and_length(Bin) of - {_,Tag,_,_} -> - decode_incomplete_bin(Bin); - _ -> - asn1_NOVALUE - end; -%% A choice alternative that shall be undecoded -decode_primitive_incomplete([[alt_undec,TagNo]|RestAlts],Bin) -> -% decode_incomplete_bin(Bin); -% case decode_tlv(Bin) of - case decode_tag_and_length(Bin) of -% {{_Form,TagNo,_Len,_V},_R} -> - {_,TagNo,_,_} -> - decode_incomplete_bin(Bin); - _ -> - decode_primitive_incomplete(RestAlts,Bin) - end; -decode_primitive_incomplete([[alt,TagNo]|RestAlts],Bin) -> - case decode_tag_and_length(Bin) of - {_Form,TagNo,V,Rest} -> - {{TagNo,V},Rest}; - _ -> - decode_primitive_incomplete(RestAlts,Bin) - end; -decode_primitive_incomplete([[alt,TagNo,Directives]|RestAlts],Bin) -> - case decode_tag_and_length(Bin) of - {Form,TagNo,V,Rest} -> - decode_incomplete2(Form,TagNo,V,Directives,Rest); - _ -> - decode_primitive_incomplete(RestAlts,Bin) - end; -decode_primitive_incomplete([[alt_parts,TagNo]],Bin) -> - case decode_tag_and_length(Bin) of - {_Form,TagNo,V,Rest} -> - {{TagNo,V},Rest}; - _ -> - asn1_NOVALUE - end; -decode_primitive_incomplete([[alt_parts,TagNo]|RestAlts],Bin) -> - case decode_tag_and_length(Bin) of - {_Form,TagNo,V,Rest} -> - {{TagNo,decode_parts_incomplete(V)},Rest}; - _ -> - decode_primitive_incomplete(RestAlts,Bin) - end; -decode_primitive_incomplete([[undec,_TagNo]|_RestTag],Bin) -> %incomlete decode - decode_incomplete_bin(Bin); -decode_primitive_incomplete([[parts,TagNo]|_RestTag],Bin) -> - case decode_tag_and_length(Bin) of - {_Form,TagNo,V,Rest} -> - {{TagNo,decode_parts_incomplete(V)},Rest}; - Err -> - {error,{asn1,"tag failure",TagNo,Err}} - end; -decode_primitive_incomplete([mandatory|RestTag],Bin) -> - {Form,TagNo,V,Rest} = decode_tag_and_length(Bin), - decode_incomplete2(Form,TagNo,V,RestTag,Rest); -%% A choice that is a toptype or a mandatory component of a -%% SEQUENCE or SET. -decode_primitive_incomplete([[mandatory|Directives]],Bin) -> - {Form,TagNo,V,Rest} = decode_tag_and_length(Bin), - decode_incomplete2(Form,TagNo,V,Directives,Rest); -decode_primitive_incomplete([],Bin) -> - decode_primitive(Bin). - -%% decode_parts_incomplete/1 receives a number of values encoded in -%% sequence and returns the parts as unencoded binaries -decode_parts_incomplete(<<>>) -> - []; -decode_parts_incomplete(Bin) -> - {ok,Rest} = skip_tag(Bin), - {ok,Rest2} = skip_length_and_value(Rest), - LenPart = size(Bin) - size(Rest2), - <<Part:LenPart/binary,RestBin/binary>> = Bin, - [Part|decode_parts_incomplete(RestBin)]. - - -%% decode_incomplete2 checks if V is a value of a constructed or -%% primitive type, and continues the decode propeerly. -decode_incomplete2(_Form=2,TagNo,V,TagMatch,_) -> - %% constructed indefinite length - {Vlist,Rest2} = decode_constr_indef_incomplete(TagMatch,V,[]), - {{TagNo,Vlist},Rest2}; -decode_incomplete2(1,TagNo,V,[TagMatch],Rest) when is_list(TagMatch) -> - {{TagNo,decode_constructed_incomplete(TagMatch,V)},Rest}; -decode_incomplete2(1,TagNo,V,TagMatch,Rest) -> - {{TagNo,decode_constructed_incomplete(TagMatch,V)},Rest}; -decode_incomplete2(0,TagNo,V,_TagMatch,Rest) -> - {{TagNo,V},Rest}. - -decode_constructed_incomplete([Tags=[Ts]],Bin) when is_list(Ts) -> - decode_constructed_incomplete(Tags,Bin); -decode_constructed_incomplete(_TagMatch,<<>>) -> - []; -decode_constructed_incomplete([mandatory|RestTag],Bin) -> - {Tlv,Rest} = decode_primitive(Bin), - [Tlv|decode_constructed_incomplete(RestTag,Rest)]; -decode_constructed_incomplete(Directives=[[Alt,_]|_],Bin) - when Alt == alt_undec; Alt == alt; Alt == alt_parts -> - {_Form,TagNo,V,Rest} = decode_tag_and_length(Bin), - case incomplete_choice_alt(TagNo,Directives) of - {alt_undec,_} -> - LenA = size(Bin)-size(Rest), - <<A:LenA/binary,Rest/binary>> = Bin, - A; - {alt,InnerDirectives} -> - {Tlv,Rest} = decode_primitive_incomplete(InnerDirectives,V), - {TagNo,Tlv}; - {alt_parts,_} -> - [{TagNo,decode_parts_incomplete(V)}]; - no_match -> %% if a choice alternative was encoded that - %% was not specified in the config file, - %% thus decode component anonomous. - {Tlv,_}=decode_primitive(Bin), - Tlv - end; -decode_constructed_incomplete([TagNo|RestTag],Bin) -> -%% {Tlv,Rest} = decode_primitive_incomplete([TagNo],Bin), - case decode_primitive_incomplete([TagNo],Bin) of - {Tlv,Rest} -> - [Tlv|decode_constructed_incomplete(RestTag,Rest)]; - asn1_NOVALUE -> - decode_constructed_incomplete(RestTag,Bin) - end; -decode_constructed_incomplete([],Bin) -> - {Tlv,Rest}=decode_primitive(Bin), - [Tlv|decode_constructed_incomplete([],Rest)]. - -decode_constr_indef_incomplete(_TagMatch,<<0,0,Rest/binary>>,Acc) -> - {lists:reverse(Acc),Rest}; -decode_constr_indef_incomplete([Tag|RestTags],Bin,Acc) -> -% {Tlv,Rest} = decode_primitive_incomplete([Tag],Bin), - case decode_primitive_incomplete([Tag],Bin) of - {Tlv,Rest} -> - decode_constr_indef_incomplete(RestTags,Rest,[Tlv|Acc]); - asn1_NOVALUE -> - decode_constr_indef_incomplete(RestTags,Bin,Acc) - end. - - -decode_incomplete_bin(Bin) -> - {ok,Rest} = skip_tag(Bin), - {ok,Rest2} = skip_length_and_value(Rest), - IncLen = size(Bin) - size(Rest2), - <<IncBin:IncLen/binary,Ret/binary>> = Bin, - {IncBin,Ret}. - -incomplete_choice_alt(TagNo,[[Alt,TagNo]|Directives]) -> - {Alt,Directives}; -incomplete_choice_alt(TagNo,[D]) when is_list(D) -> - incomplete_choice_alt(TagNo,D); -incomplete_choice_alt(TagNo,[_H|Directives]) -> - incomplete_choice_alt(TagNo,Directives); -incomplete_choice_alt(_,[]) -> - no_match. - - - - -%% decode_selective(Pattern, Binary) the first argument is a pattern that tells -%% what to do with the next element the second is the BER encoded -%% message as a binary -%% Returns {ok,Value} or {error,Reason} -%% Value is a binary that in turn must be decoded to get the decoded -%% value. -decode_selective([],Binary) -> - {ok,Binary}; -decode_selective([skip|RestPattern],Binary)-> - {ok,RestBinary}=skip_tag(Binary), - {ok,RestBinary2}=skip_length_and_value(RestBinary), - decode_selective(RestPattern,RestBinary2); -decode_selective([[skip_optional,Tag]|RestPattern],Binary) -> - case skip_optional_tag(Tag,Binary) of - {ok,RestBinary} -> - {ok,RestBinary2}=skip_length_and_value(RestBinary), - decode_selective(RestPattern,RestBinary2); - missing -> - decode_selective(RestPattern,Binary) - end; -decode_selective([[choosen,Tag]],Binary) -> - return_value(Tag,Binary); -% case skip_optional_tag(Tag,Binary) of %may be optional/default -% {ok,RestBinary} -> -% {ok,Value} = get_value(RestBinary); -% missing -> -% {ok,<<>>} -% end; -decode_selective([[choosen,Tag]|RestPattern],Binary) -> - case skip_optional_tag(Tag,Binary) of - {ok,RestBinary} -> - {ok,Value} = get_value(RestBinary), - decode_selective(RestPattern,Value); - missing -> - {ok,<<>>} - end; -decode_selective(P,_) -> - {error,{asn1,{partial_decode,"bad pattern",P}}}. - -return_value(Tag,Binary) -> - {ok,{Tag,RestBinary}}=get_tag(Binary), - {ok,{LenVal,_RestBinary2}} = get_length_and_value(RestBinary), - {ok,<<Tag/binary,LenVal/binary>>}. - - -%% skip_tag and skip_length_and_value are rutines used both by -%% decode_partial_incomplete and decode_selective (decode/2). - -skip_tag(<<_:3,31:5,Rest/binary>>)-> - skip_long_tag(Rest); -skip_tag(<<_:3,_Tag:5,Rest/binary>>) -> - {ok,Rest}. - -skip_long_tag(<<1:1,_:7,Rest/binary>>) -> - skip_long_tag(Rest); -skip_long_tag(<<0:1,_:7,Rest/binary>>) -> - {ok,Rest}. - -skip_optional_tag(<<>>,Binary) -> - {ok,Binary}; -skip_optional_tag(<<Tag,RestTag/binary>>,<<Tag,Rest/binary>>) -> - skip_optional_tag(RestTag,Rest); -skip_optional_tag(_,_) -> - missing. - - - - -skip_length_and_value(Binary) -> - case decode_length(Binary) of - {indefinite,RestBinary} -> - skip_indefinite_value(RestBinary); - {Length,RestBinary} -> - <<_:Length/unit:8,Rest/binary>> = RestBinary, - {ok,Rest} - end. - -skip_indefinite_value(<<0,0,Rest/binary>>) -> - {ok,Rest}; -skip_indefinite_value(Binary) -> - {ok,RestBinary}=skip_tag(Binary), - {ok,RestBinary2} = skip_length_and_value(RestBinary), - skip_indefinite_value(RestBinary2). - -get_value(Binary) -> - case decode_length(Binary) of - {indefinite,RestBinary} -> - get_indefinite_value(RestBinary,[]); - {Length,RestBinary} -> - <<Value:Length/binary,_Rest/binary>> = RestBinary, - {ok,Value} - end. - -get_indefinite_value(<<0,0,_Rest/binary>>,Acc) -> - {ok,list_to_binary(lists:reverse(Acc))}; -get_indefinite_value(Binary,Acc) -> - {ok,{Tag,RestBinary}}=get_tag(Binary), - {ok,{LenVal,RestBinary2}} = get_length_and_value(RestBinary), - get_indefinite_value(RestBinary2,[LenVal,Tag|Acc]). - -get_tag(<<H:1/binary,Rest/binary>>) -> - case H of - <<_:3,31:5>> -> - get_long_tag(Rest,[H]); - _ -> {ok,{H,Rest}} - end. -get_long_tag(<<H:1/binary,Rest/binary>>,Acc) -> - case H of - <<0:1,_:7>> -> - {ok,{list_to_binary(lists:reverse([H|Acc])),Rest}}; - _ -> - get_long_tag(Rest,[H|Acc]) - end. - -get_length_and_value(Bin = <<0:1,Length:7,_T/binary>>) -> - <<Len,Val:Length/binary,Rest/binary>> = Bin, - {ok,{<<Len,Val/binary>>, Rest}}; -get_length_and_value(Bin = <<1:1,0:7,_T/binary>>) -> - get_indefinite_length_and_value(Bin); -get_length_and_value(<<1:1,LL:7,T/binary>>) -> - <<Length:LL/unit:8,Rest/binary>> = T, - <<Value:Length/binary,Rest2/binary>> = Rest, - {ok,{<<1:1,LL:7,Length:LL/unit:8,Value/binary>>,Rest2}}. - -get_indefinite_length_and_value(<<H,T/binary>>) -> - get_indefinite_length_and_value(T,[H]). - -get_indefinite_length_and_value(<<0,0,Rest/binary>>,Acc) -> - {ok,{list_to_binary(lists:reverse(Acc)),Rest}}; -get_indefinite_length_and_value(Binary,Acc) -> - {ok,{Tag,RestBinary}}=get_tag(Binary), - {ok,{LenVal,RestBinary2}}=get_length_and_value(RestBinary), - get_indefinite_length_and_value(RestBinary2,[LenVal,Tag|Acc]). - - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% match_tags takes a Tlv (Tag, Length, Value) structure and matches -%% it with the tags in TagList. If the tags does not match the function -%% crashes otherwise it returns the remaining Tlv after that the tags have -%% been removed. -%% -%% match_tags(Tlv, TagList) -%% - -match_tags({T,V},[T]) -> - V; -match_tags({T,V}, [T|Tt]) -> - match_tags(V,Tt); -match_tags([{T,V}],[T|Tt]) -> - match_tags(V, Tt); -match_tags(Vlist = [{T,_V}|_], [T]) -> - Vlist; -match_tags(Tlv, []) -> - Tlv; -match_tags(Tlv = {Tag,_V},[T|_Tt]) -> - exit({error,{asn1,{wrong_tag,{{expected,T},{got,Tag,Tlv}}}}}). - -%%% -%% skips components that do not match a tag in Tags -skip_ExtensionAdditions([],_Tags) -> - []; -skip_ExtensionAdditions(TLV=[{Tag,_}|Rest],Tags) -> - case [X||X=T<-Tags,T==Tag] of - [] -> - %% skip this TLV and continue with next - skip_ExtensionAdditions(Rest,Tags); - _ -> - TLV - end. - - -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== -%% Optionals, preset not filled optionals with asn1_NOVALUE -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== - -fixoptionals(OptList,Val) when is_list(Val) -> - fixoptionals(OptList,Val,1,[],[]). - -fixoptionals([{Name,Pos}|Ot],[{Name,Val}|Vt],_Opt,Acc1,Acc2) -> - fixoptionals(Ot,Vt,Pos+1,[1|Acc1],[{Name,Val}|Acc2]); -fixoptionals([{_Name,Pos}|Ot],V,Pos,Acc1,Acc2) -> - fixoptionals(Ot,V,Pos+1,[0|Acc1],[asn1_NOVALUE|Acc2]); -fixoptionals(O,[Vh|Vt],Pos,Acc1,Acc2) -> - fixoptionals(O,Vt,Pos+1,Acc1,[Vh|Acc2]); -fixoptionals([],[Vh|Vt],Pos,Acc1,Acc2) -> - fixoptionals([],Vt,Pos+1,Acc1,[Vh|Acc2]); -fixoptionals([],[],_,_Acc1,Acc2) -> - % return Val as a record - list_to_tuple([asn1_RECORDNAME|lists:reverse(Acc2)]). - - -%%encode_tag(TagClass(?UNI, APP etc), Form (?PRIM etx), TagInteger) -> -%% 8bit Int | binary -encode_tag_val({Class, Form, TagNo}) when (TagNo =< 30) -> - <<(Class bsr 6):2,(Form bsr 5):1,TagNo:5>>; - -encode_tag_val({Class, Form, TagNo}) -> - {Octets,_Len} = mk_object_val(TagNo), - BinOct = list_to_binary(Octets), - <<(Class bsr 6):2, (Form bsr 5):1, 31:5,BinOct/binary>>. - - -%%=============================================================================== -%% Decode a tag -%% -%% decode_tag(OctetListBuffer) -> {{Form, (Class bsl 16)+ TagNo}, RestOfBuffer, RemovedBytes} -%%=============================================================================== - -decode_tag_and_length(<<Class:2, Form:1, TagNo:5, 0:1, Length:7, V:Length/binary, RestBuffer/binary>>) when TagNo < 31 -> - {Form, (Class bsl 16) + TagNo, V, RestBuffer}; -decode_tag_and_length(<<Class:2, 1:1, TagNo:5, 1:1, 0:7, T/binary>>) when TagNo < 31 -> - {2, (Class bsl 16) + TagNo, T, <<>>}; -decode_tag_and_length(<<Class:2, Form:1, TagNo:5, 1:1, LL:7, Length:LL/unit:8,V:Length/binary, T/binary>>) when TagNo < 31 -> - {Form, (Class bsl 16) + TagNo, V, T}; -decode_tag_and_length(<<Class:2, Form:1, 31:5, 0:1, TagNo:7, 0:1, Length:7, V:Length/binary, RestBuffer/binary>>) -> - {Form, (Class bsl 16) + TagNo, V, RestBuffer}; -decode_tag_and_length(<<Class:2, 1:1, 31:5, 0:1, TagNo:7, 1:1, 0:7, T/binary>>) -> - {2, (Class bsl 16) + TagNo, T, <<>>}; -decode_tag_and_length(<<Class:2, Form:1, 31:5, 0:1, TagNo:7, 1:1, LL:7, Length:LL/unit:8, V:Length/binary, T/binary>>) -> - {Form, (Class bsl 16) + TagNo, V, T}; -decode_tag_and_length(<<Class:2, Form:1, 31:5, 1:1, TagPart1:7, 0:1, TagPartLast, Buffer/binary>>) -> - TagNo = (TagPart1 bsl 7) bor TagPartLast, - {Length, RestBuffer} = decode_length(Buffer), - << V:Length/binary, RestBuffer2/binary>> = RestBuffer, - {Form, (Class bsl 16) + TagNo, V, RestBuffer2}; -decode_tag_and_length(<<Class:2, Form:1, 31:5, Buffer/binary>>) -> - {TagNo, Buffer1} = decode_tag(Buffer, 0), - {Length, RestBuffer} = decode_length(Buffer1), - << V:Length/binary, RestBuffer2/binary>> = RestBuffer, - {Form, (Class bsl 16) + TagNo, V, RestBuffer2}. - - - -%% last partial tag -decode_tag(<<0:1,PartialTag:7, Buffer/binary>>, TagAck) -> - TagNo = (TagAck bsl 7) bor PartialTag, - %%<<TagNo>> = <<TagAck:1, PartialTag:7>>, - {TagNo, Buffer}; -% more tags -decode_tag(<<_:1,PartialTag:7, Buffer/binary>>, TagAck) -> - TagAck1 = (TagAck bsl 7) bor PartialTag, - %%<<TagAck1:16>> = <<TagAck:1, PartialTag:7,0:8>>, - decode_tag(Buffer, TagAck1). - - -%%======================================================================= -%% -%% Encode all tags in the list Tags and return a possibly deep list of -%% bytes with tag and length encoded -%% The taglist must be in reverse order (fixed by the asn1 compiler) -%% e.g [T1,T2] will result in -%% {[EncodedT2,EncodedT1|BytesSoFar],LenSoFar+LenT2+LenT1} -%% - -encode_tags([Tag|Trest], BytesSoFar, LenSoFar) -> -% remove {Bytes1,L1} = encode_one_tag(Tag), - {Bytes2,L2} = encode_length(LenSoFar), - encode_tags(Trest, [Tag,Bytes2|BytesSoFar], - LenSoFar + size(Tag) + L2); -encode_tags([], BytesSoFar, LenSoFar) -> - {BytesSoFar,LenSoFar}. - -encode_tags(TagIn, {BytesSoFar,LenSoFar}) -> - encode_tags(TagIn, BytesSoFar, LenSoFar). - -% encode_one_tag(#tag{class=Class,number=No,type=Type, form = Form}) -> -% NewForm = case Type of -% 'EXPLICIT' -> -% ?CONSTRUCTED; -% _ -> -% Form -% end, -% Bytes = encode_tag_val({Class,NewForm,No}), -% {Bytes,size(Bytes)}. - - -%%=============================================================================== -%% -%% This comment is valid for all the encode/decode functions -%% -%% C = Constraint -> typically {'ValueRange',LowerBound,UpperBound} -%% used for PER-coding but not for BER-coding. -%% -%% Val = Value. If Val is an atom then it is a symbolic integer value -%% (i.e the atom must be one of the names in the NamedNumberList). -%% The NamedNumberList is used to translate the atom to an integer value -%% before encoding. -%% -%%=============================================================================== - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_open_type(Value) -> io_list (i.e nested list with integers, binaries) -%% Value = list of bytes of an already encoded value (the list must be flat) -%% | binary - -%% -encode_open_type(Val) when is_list(Val) -> -% {Val,length(Val)}; - encode_open_type(list_to_binary(Val)); -encode_open_type(Val) -> - {Val, size(Val)}. - -%% -encode_open_type(Val, T) when is_list(Val) -> - encode_open_type(list_to_binary(Val),T); -encode_open_type(Val,[]) -> - {Val, size(Val)}; -encode_open_type(Val,Tag) -> - encode_tags(Tag,Val, size(Val)). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_open_type(Tlv, TagIn) -> Value -%% Tlv = {Tag,V} | V where V -> binary() -%% TagIn = [TagVal] where TagVal -> int() -%% Value = binary with decoded data (which must be decoded again as some type) -%% -decode_open_type(Tlv, TagIn) -> - decode_open_type(Tlv, TagIn, erlang). -decode_open_type(Tlv, TagIn, Method) -> - case match_tags(Tlv,TagIn) of - Bin when is_binary(Bin) -> - {InnerTlv,_} = decode(Bin,Method), - InnerTlv; - TlvBytes -> TlvBytes - end. - - -decode_open_type_as_binary(Tlv, TagIn) -> - decode_open_type_as_binary(Tlv, TagIn, erlang). -decode_open_type_as_binary(Tlv,TagIn, Method)-> - case match_tags(Tlv,TagIn) of - V when is_binary(V) -> - V; - [Tlv2] -> encode(Tlv2, Method); - Tlv2 -> encode(Tlv2, Method) - end. - -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== -%% Boolean, ITU_T X.690 Chapter 8.2 -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== - -%%=============================================================================== -%% encode_boolean(Integer, ReversedTagList) -> {[Octet],Len} -%%=============================================================================== - -encode_boolean({Name, Val}, TagIn) when is_atom(Name) -> - encode_boolean(Val, TagIn); -encode_boolean(true, TagIn) -> - encode_tags(TagIn, [16#FF],1); -encode_boolean(false, TagIn) -> - encode_tags(TagIn, [0],1); -encode_boolean(X,_) -> - exit({error,{asn1, {encode_boolean, X}}}). - - -%%=============================================================================== -%% decode_boolean(BuffList, HasTag, TotalLen) -> {true, Remain, RemovedBytes} | -%% {false, Remain, RemovedBytes} -%%=============================================================================== -decode_boolean(Tlv,TagIn) -> - Val = match_tags(Tlv, TagIn), - case Val of - <<0:8>> -> - false; - <<_:8>> -> - true; - _ -> - exit({error,{asn1, {decode_boolean, Val}}}) - end. - - -%%=========================================================================== -%% Integer, ITU_T X.690 Chapter 8.3 - -%% encode_integer(Constraint, Value, Tag) -> [octet list] -%% encode_integer(Constraint, Name, NamedNumberList, Tag) -> [octet list] -%% Value = INTEGER | {Name,INTEGER} -%% Tag = tag | notag -%%=========================================================================== - -encode_integer(C, Val, Tag) when is_integer(Val) -> - encode_tags(Tag, encode_integer(C, Val)); -encode_integer(C,{Name,Val},Tag) when is_atom(Name) -> - encode_integer(C,Val,Tag); -encode_integer(_C, Val, _Tag) -> - exit({error,{asn1, {encode_integer, Val}}}). - - - -encode_integer(C, Val, NamedNumberList, Tag) when is_atom(Val) -> - case lists:keysearch(Val, 1, NamedNumberList) of - {value,{_, NewVal}} -> - encode_tags(Tag, encode_integer(C, NewVal)); - _ -> - exit({error,{asn1, {encode_integer_namednumber, Val}}}) - end; -encode_integer(C,{_Name,Val},NamedNumberList,Tag) -> - encode_integer(C,Val,NamedNumberList,Tag); -encode_integer(C, Val, _NamedNumberList, Tag) -> - encode_tags(Tag, encode_integer(C, Val)). - - -encode_integer(_, Val) -> - Bytes = - if - Val >= 0 -> - encode_integer_pos(Val, []); - true -> - encode_integer_neg(Val, []) - end, - {Bytes,length(Bytes)}. - -encode_integer_pos(0, L=[B|_Acc]) when B < 128 -> - L; -encode_integer_pos(N, Acc) -> - encode_integer_pos((N bsr 8), [N band 16#ff| Acc]). - -encode_integer_neg(-1, L=[B1|_T]) when B1 > 127 -> - L; -encode_integer_neg(N, Acc) -> - encode_integer_neg(N bsr 8, [N band 16#ff|Acc]). - -%%=============================================================================== -%% decode integer -%% (Buffer, Range, HasTag, TotalLen) -> {Integer, Remain, RemovedBytes} -%% (Buffer, Range, NamedNumberList, HasTag, TotalLen) -> {Integer, Remain, RemovedBytes} -%%=============================================================================== - -decode_integer(Tlv,Range,NamedNumberList,TagIn) -> - V = match_tags(Tlv,TagIn), - Int = decode_integer(V), - range_check_integer(Int,Range), - number2name(Int,NamedNumberList). - -decode_integer(Tlv,Range,TagIn) -> - V = match_tags(Tlv, TagIn), - Int = decode_integer(V), - range_check_integer(Int,Range), - Int. - -%% decoding postitive integer values. -decode_integer(Bin = <<0:1,_:7,_/binary>>) -> - Len = size(Bin), -% <<Int:Len/unit:8,Buffer2/binary>> = Bin, - <<Int:Len/unit:8>> = Bin, - Int; -%% decoding negative integer values. -decode_integer(Bin = <<1:1,B2:7,Bs/binary>>) -> - Len = size(Bin), -% <<N:Len/unit:8,Buffer2/binary>> = <<B2,Bs/binary>>, - <<N:Len/unit:8>> = <<B2,Bs/binary>>, - Int = N - (1 bsl (8 * Len - 1)), - Int. - -range_check_integer(Int,Range) -> - case Range of - [] -> % No length constraint - Int; - {Lb,Ub} when Int >= Lb, Ub >= Int -> % variable length constraint - Int; - Int -> % fixed value constraint - Int; - {_,_} -> - exit({error,{asn1,{integer_range,Range,Int}}}); - SingleValue when is_integer(SingleValue) -> - exit({error,{asn1,{integer_range,Range,Int}}}); - _ -> % some strange constraint that we don't support yet - Int - end. - -number2name(Int,[]) -> - Int; -number2name(Int,NamedNumberList) -> - case lists:keysearch(Int, 2, NamedNumberList) of - {value,{NamedVal, _}} -> - NamedVal; - _ -> - Int - end. - - -%%============================================================================ -%% Enumerated value, ITU_T X.690 Chapter 8.4 - -%% encode enumerated value -%%============================================================================ -encode_enumerated(Val, TagIn) when is_integer(Val)-> - encode_tags(TagIn, encode_integer(false,Val)); -encode_enumerated({Name,Val}, TagIn) when is_atom(Name) -> - encode_enumerated(Val, TagIn). - -%% The encode_enumerated functions below this line can be removed when the -%% new code generation is stable. (the functions might have to be kept here -%% a while longer for compatibility reasons) - -encode_enumerated(C, Val, {NamedNumberList,ExtList}, TagIn) when is_atom(Val) -> - case catch encode_enumerated(C, Val, NamedNumberList, TagIn) of - {'EXIT',_} -> encode_enumerated(C, Val, ExtList, TagIn); - Result -> Result - end; - -encode_enumerated(C, Val, NamedNumberList, TagIn) when is_atom(Val) -> - case lists:keysearch(Val, 1, NamedNumberList) of - {value, {_, NewVal}} -> - encode_tags(TagIn, encode_integer(C, NewVal)); - _ -> - exit({error,{asn1, {enumerated_not_in_range, Val}}}) - end; - -encode_enumerated(C, {asn1_enum, Val}, {_,_}, TagIn) when is_integer(Val) -> - encode_tags(TagIn, encode_integer(C,Val)); - -encode_enumerated(C, {Name,Val}, NamedNumberList, TagIn) when is_atom(Name) -> - encode_enumerated(C, Val, NamedNumberList, TagIn); - -encode_enumerated(_C, Val, _NamedNumberList, _TagIn) -> - exit({error,{asn1, {enumerated_not_namednumber, Val}}}). - - - -%%============================================================================ -%% decode enumerated value -%% (Buffer, Range, NamedNumberList, HasTag, TotalLen) -> Value -%%=========================================================================== -decode_enumerated(Tlv, Range, NamedNumberList, Tags) -> - Buffer = match_tags(Tlv,Tags), - decode_enumerated_notag(Buffer, Range, NamedNumberList, Tags). - -decode_enumerated_notag(Buffer, _Range, {NamedNumberList,ExtList}, _Tags) -> - - IVal = decode_integer2(size(Buffer), Buffer), - case decode_enumerated1(IVal, NamedNumberList) of - {asn1_enum,IVal} -> - decode_enumerated1(IVal,ExtList); - EVal -> - EVal - end; -decode_enumerated_notag(Buffer, _Range, NNList, _Tags) -> - IVal = decode_integer2(size(Buffer), Buffer), - case decode_enumerated1(IVal, NNList) of - {asn1_enum,_} -> - exit({error,{asn1, {illegal_enumerated, IVal}}}); - EVal -> - EVal - end. - -decode_enumerated1(Val, NamedNumberList) -> - %% it must be a named integer - case lists:keysearch(Val, 2, NamedNumberList) of - {value,{NamedVal, _}} -> - NamedVal; - _ -> - {asn1_enum,Val} - end. - - -%%============================================================================ -%% -%% Real value, ITU_T X.690 Chapter 8.5 -%%============================================================================ -%% -%% encode real value -%%============================================================================ - -%% only base 2 internally so far!! -encode_real(_C,0, TagIn) -> - encode_tags(TagIn, {[],0}); -encode_real(_C,'PLUS-INFINITY', TagIn) -> - encode_tags(TagIn, {[64],1}); -encode_real(_C,'MINUS-INFINITY', TagIn) -> - encode_tags(TagIn, {[65],1}); -encode_real(C,Val, TagIn) when is_tuple(Val); is_list(Val) -> - encode_tags(TagIn, encode_real(C,Val)). - - - -encode_real(C,Val) -> - asn1rt_ber_bin:encode_real(C,Val). - - -%%============================================================================ -%% decode real value -%% -%% decode_real([OctetBufferList], tuple|value, tag|notag) -> -%% {{Mantissa, Base, Exp} | realval | PLUS-INFINITY | MINUS-INFINITY | 0, -%% RestBuff} -%% -%% only for base 2 and 10 decoding sofar!! -%%============================================================================ - -decode_real(Tlv, Tags) -> - Buffer = match_tags(Tlv,Tags), - decode_real_notag(Buffer). - -decode_real_notag(Buffer) -> - Len = - case Buffer of - Bin when is_binary(Bin) -> - size(Bin); - {_T,_V} -> - exit({error,{asn1,{real_not_in_primitive_form,Buffer}}}) - end, - {Val,_Rest,Len} = asn1rt_ber_bin:decode_real(Buffer,Len), - Val. -%% exit({error,{asn1, {unimplemented,real}}}). -%% decode_real2(Buffer, Form, size(Buffer)). - -% decode_real2(Buffer, Form, Len) -> -% <<First, Buffer2/binary>> = Buffer, -% if -% First =:= 2#01000000 -> {'PLUS-INFINITY', Buffer2}; -% First =:= 2#01000001 -> {'MINUS-INFINITY', Buffer2}; -% First =:= 2#00000000 -> {0, Buffer2}; -% true -> -% %% have some check here to verify only supported bases (2) -% <<B7:1,B6:1,B5_4:2,B3_2:2,B1_0:2>> = <<First>>, -% Sign = B6, -% Base = -% case B5_4 of -% 0 -> 2; % base 2, only one so far -% _ -> exit({error,{asn1, {non_supported_base, First}}}) -% end, -% ScalingFactor = -% case B3_2 of -% 0 -> 0; % no scaling so far -% _ -> exit({error,{asn1, {non_supported_scaling, First}}}) -% end, - -% {FirstLen,Exp,Buffer3} = -% case B1_0 of -% 0 -> -% <<_:1/unit:8,Buffer21/binary>> = Buffer2, -% {2, decode_integer2(1, Buffer2),Buffer21}; -% 1 -> -% <<_:2/unit:8,Buffer21/binary>> = Buffer2, -% {3, decode_integer2(2, Buffer2)}; -% 2 -> -% <<_:3/unit:8,Buffer21/binary>> = Buffer2, -% {4, decode_integer2(3, Buffer2)}; -% 3 -> -% <<ExpLen1,RestBuffer/binary>> = Buffer2, -% <<_:ExpLen1/unit:8,RestBuffer2/binary>> = RestBuffer, -% { ExpLen1 + 2, -% decode_integer2(ExpLen1, RestBuffer, RemBytes1), -% RestBuffer2} -% end, -% Length = Len - FirstLen, -% <<LongInt:Length/unit:8,RestBuff/binary>> = Buffer3, -% {Mantissa, Buffer4} = -% if Sign =:= 0 -> - -% {LongInt, RestBuff};% sign plus, -% true -> - -% {-LongInt, RestBuff}% sign minus -% end, -% case Form of -% tuple -> -% {Val,Buf,RemB} = Exp, -% {{Mantissa, Base, {Val,Buf}}, Buffer4, RemBytes2+RemBytes3}; -% _value -> -% comming -% end -% end. - - -%%============================================================================ -%% Bitstring value, ITU_T X.690 Chapter 8.6 -%% -%% encode bitstring value -%% -%% bitstring NamedBitList -%% Val can be of: -%% - [identifiers] where only named identifers are set to one, -%% the Constraint must then have some information of the -%% bitlength. -%% - [list of ones and zeroes] all bits -%% - integer value representing the bitlist -%% C is constrint Len, only valid when identifiers -%%============================================================================ - -encode_bit_string(C,Bin={Unused,BinBits},NamedBitList,TagIn) when is_integer(Unused), is_binary(BinBits) -> - encode_bin_bit_string(C,Bin,NamedBitList,TagIn); -encode_bit_string(C, [FirstVal | RestVal], NamedBitList, TagIn) when is_atom(FirstVal) -> - encode_bit_string_named(C, [FirstVal | RestVal], NamedBitList, TagIn); - -encode_bit_string(C, [{bit,X} | RestVal], NamedBitList, TagIn) -> - encode_bit_string_named(C, [{bit,X} | RestVal], NamedBitList, TagIn); - -encode_bit_string(C, [FirstVal| RestVal], NamedBitList, TagIn) when is_integer(FirstVal) -> - encode_bit_string_bits(C, [FirstVal | RestVal], NamedBitList, TagIn); - -encode_bit_string(_C, 0, _NamedBitList, TagIn) -> - encode_tags(TagIn, <<0>>,1); - -encode_bit_string(_C, [], _NamedBitList, TagIn) -> - encode_tags(TagIn, <<0>>,1); - -encode_bit_string(C, IntegerVal, NamedBitList, TagIn) when is_integer(IntegerVal) -> - BitListVal = int_to_bitlist(IntegerVal), - encode_bit_string_bits(C, BitListVal, NamedBitList, TagIn); - -encode_bit_string(C, {Name,BitList}, NamedBitList, TagIn) when is_atom(Name) -> - encode_bit_string(C, BitList, NamedBitList, TagIn). - - - -int_to_bitlist(0) -> - []; -int_to_bitlist(Int) when is_integer(Int), Int >= 0 -> - [Int band 1 | int_to_bitlist(Int bsr 1)]. - - -%%================================================================= -%% Encode BIT STRING of the form {Unused,BinBits}. -%% Unused is the number of unused bits in the last byte in BinBits -%% 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 -> - remove_unused_then_dotag(TagIn, Unused, BinBits); - {_Min,Max} -> - BBLen = (size(BinBits)*8)-Unused, - if - BBLen > Max -> - exit({error,{asn1, - {bitstring_length, - {{was,BBLen},{maximum,Max}}}}}); - true -> - remove_unused_then_dotag(TagIn, Unused, BinBits) - end; - Size -> - case ((size(BinBits)*8)-Unused) of - BBSize when BBSize =< Size -> - remove_unused_then_dotag(TagIn, Unused, BinBits); - BBSize -> - exit({error,{asn1, - {bitstring_length, - {{was,BBSize},{should_be,Size}}}}}) - end - end. - -remove_unused_then_dotag(TagIn,Unused,BinBits) -> - case Unused of - 0 when (size(BinBits) == 0) -> - encode_tags(TagIn,<<0>>,1); - 0 -> - Bin = <<Unused,BinBits/binary>>, - encode_tags(TagIn,Bin,size(Bin)); - Num -> - N = (size(BinBits)-1), - <<BBits:N/binary,LastByte>> = BinBits, - encode_tags(TagIn, - [Unused,binary_to_list(BBits) ++[(LastByte bsr Num) bsl Num]], - 1+size(BinBits)) - end. - - -%%================================================================= -%% Encode named bits -%%================================================================= - -encode_bit_string_named(C, [FirstVal | RestVal], NamedBitList, TagIn) -> - ToSetPos = get_all_bitposes([FirstVal | RestVal], NamedBitList, []), - Size = - case get_constraint(C,'SizeConstraint') of - no -> - lists:max(ToSetPos)+1; - {_Min,Max} -> - Max; - TSize -> - TSize - end, - BitList = make_and_set_list(Size, ToSetPos, 0), - {Len, Unused, OctetList} = encode_bitstring(BitList), - encode_tags(TagIn, [Unused|OctetList],Len+1). - - -%%---------------------------------------- -%% get_all_bitposes([list of named bits to set], named_bit_db, []) -> -%% [sorted_list_of_bitpositions_to_set] -%%---------------------------------------- - -get_all_bitposes([{bit,ValPos}|Rest], NamedBitList, Ack) -> - get_all_bitposes(Rest, NamedBitList, [ValPos | Ack ]); -get_all_bitposes([Val | Rest], NamedBitList, Ack) when is_atom(Val) -> - case lists:keysearch(Val, 1, NamedBitList) of - {value, {_ValName, ValPos}} -> - get_all_bitposes(Rest, NamedBitList, [ValPos | Ack]); - _ -> - exit({error,{asn1, {bitstring_namedbit, Val}}}) - end; -get_all_bitposes([], _NamedBitList, Ack) -> - lists:sort(Ack). - - -%%---------------------------------------- -%% make_and_set_list(Len of list to return, [list of positions to set to 1])-> -%% returns list of Len length, with all in SetPos set. -%% in positioning in list the first element is 0, the second 1 etc.., but -%% Len will make a list of length Len, not Len + 1. -%% BitList = make_and_set_list(C, ToSetPos, 0), -%%---------------------------------------- - -make_and_set_list(0, [], _) -> []; -make_and_set_list(0, _, _) -> - exit({error,{asn1,bitstring_sizeconstraint}}); -make_and_set_list(Len, [XPos|SetPos], XPos) -> - [1 | make_and_set_list(Len - 1, SetPos, XPos + 1)]; -make_and_set_list(Len, [Pos|SetPos], XPos) -> - [0 | make_and_set_list(Len - 1, [Pos | SetPos], XPos + 1)]; -make_and_set_list(Len, [], XPos) -> - [0 | make_and_set_list(Len - 1, [], XPos + 1)]. - - - - - - -%%================================================================= -%% 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 -> - {Len, Unused, OctetList} = encode_bitstring(BitListVal), - %%add unused byte to the Len - encode_tags(TagIn, [Unused | OctetList], Len+1); - Constr={Min,_Max} when is_integer(Min) -> - %% Max may be an integer or 'MAX' - encode_constr_bit_str_bits(Constr,BitListVal,TagIn); - {Constr={_,_},[]} ->%Constr={Min,Max} - %% constraint with extension mark - encode_constr_bit_str_bits(Constr,BitListVal,TagIn); - Constr={{_,_},{_,_}} ->%{{Min1,Max1},{Min2,Max2}} - %% constraint with extension mark - encode_constr_bit_str_bits(Constr,BitListVal,TagIn); - Size -> - case length(BitListVal) of - BitSize when BitSize == Size -> - {Len, Unused, OctetList} = encode_bitstring(BitListVal), - %%add unused byte to the Len - encode_tags(TagIn, [Unused | OctetList], Len+1); - BitSize when BitSize < Size -> - PaddedList = pad_bit_list(Size-BitSize,BitListVal), - {Len, Unused, OctetList} = encode_bitstring(PaddedList), - %%add unused byte to the Len - encode_tags(TagIn, [Unused | OctetList], Len+1); - BitSize -> - exit({error,{asn1, - {bitstring_length, {{was,BitSize},{should_be,Size}}}}}) - end - - end. - -encode_constr_bit_str_bits({{_Min1,Max1},{Min2,Max2}},BitListVal,TagIn) -> - BitLen = length(BitListVal), - case BitLen of - Len when Len > Max2 -> - exit({error,{asn1,{bitstring_length,{{was,BitLen}, - {maximum,Max2}}}}}); - Len when Len > Max1, Len < Min2 -> - exit({error,{asn1,{bitstring_length,{{was,BitLen}, - {not_allowed_interval, - Max1,Min2}}}}}); - _ -> - {Len, Unused, OctetList} = encode_bitstring(BitListVal), - %%add unused byte to the Len - encode_tags(TagIn, [Unused, OctetList], Len+1) - end; -encode_constr_bit_str_bits({Min,Max},BitListVal,TagIn) -> - BitLen = length(BitListVal), - if - BitLen > Max -> - exit({error,{asn1,{bitstring_length,{{was,BitLen}, - {maximum,Max}}}}}); - BitLen < Min -> - exit({error,{asn1,{bitstring_length,{{was,BitLen}, - {minimum,Max}}}}}); - true -> - {Len, Unused, OctetList} = encode_bitstring(BitListVal), - %%add unused byte to the Len - encode_tags(TagIn, [Unused, OctetList], Len+1) - end. - - -%% returns a list of length Size + length(BitListVal), with BitListVal -%% as the most significant elements followed by padded zero elements -pad_bit_list(Size,BitListVal) -> - Tail = lists:duplicate(Size,0), - lists:append(BitListVal,Tail). - -%%================================================================= -%% Do the actual encoding -%% ([bitlist]) -> {ListLen, UnusedBits, OctetList} -%%================================================================= - -encode_bitstring([B8, B7, B6, B5, B4, B3, B2, B1 | Rest]) -> - Val = (B8 bsl 7) bor (B7 bsl 6) bor (B6 bsl 5) bor (B5 bsl 4) bor - (B4 bsl 3) bor (B3 bsl 2) bor (B2 bsl 1) bor B1, - encode_bitstring(Rest, [Val], 1); -encode_bitstring(Val) -> - {Unused, Octet} = unused_bitlist(Val, 7, 0), - {1, Unused, [Octet]}. - -encode_bitstring([B8, B7, B6, B5, B4, B3, B2, B1 | Rest], Ack, Len) -> - Val = (B8 bsl 7) bor (B7 bsl 6) bor (B6 bsl 5) bor (B5 bsl 4) bor - (B4 bsl 3) bor (B3 bsl 2) bor (B2 bsl 1) bor B1, - encode_bitstring(Rest, [Ack | [Val]], Len + 1); -%%even multiple of 8 bits.. -encode_bitstring([], Ack, Len) -> - {Len, 0, Ack}; -%% unused bits in last octet -encode_bitstring(Rest, Ack, Len) -> -% io:format("uneven ~w ~w ~w~n",[Rest, Ack, Len]), - {Unused, Val} = unused_bitlist(Rest, 7, 0), - {Len + 1, Unused, [Ack | [Val]]}. - -%%%%%%%%%%%%%%%%%% -%% unused_bitlist([list of ones and zeros <= 7], 7, []) -> -%% {Unused bits, Last octet with bits moved to right} -unused_bitlist([], Trail, Ack) -> - {Trail + 1, Ack}; -unused_bitlist([Bit | Rest], Trail, Ack) -> -%% io:format("trail Bit: ~w Rest: ~w Trail: ~w Ack:~w~n",[Bit, Rest, Trail, Ack]), - unused_bitlist(Rest, Trail - 1, (Bit bsl Trail) bor Ack). - - -%%============================================================================ -%% decode bitstring value -%% (Buffer, Range, NamedNumberList, HasTag, TotalLen) -> {Integer, Remain, RemovedBytes} -%%============================================================================ - -decode_compact_bit_string(Buffer, Range, NamedNumberList, Tags) -> -% NewTags = new_tags(HasTag,#tag{class=?UNIVERSAL,number=?N_BIT_STRING}), - decode_restricted_string(Buffer, Range, ?N_BIT_STRING, Tags, - NamedNumberList,bin). - -decode_bit_string(Buffer, Range, NamedNumberList, Tags) -> -% NewTags = new_tags(HasTag,#tag{class=?UNIVERSAL,number=?N_BIT_STRING}), - decode_restricted_string(Buffer, Range, ?N_BIT_STRING, Tags, - NamedNumberList,old). - - -decode_bit_string2(<<0>>,_NamedNumberList,BinOrOld) -> - case BinOrOld of - bin -> - {0,<<>>}; - _ -> - [] - end; -decode_bit_string2(<<Unused,Bits/binary>>,NamedNumberList,BinOrOld) -> - case NamedNumberList of - [] -> - case BinOrOld of - bin -> - {Unused,Bits}; - _ -> - decode_bitstring2(size(Bits), Unused, Bits) - end; - _ -> - BitString = decode_bitstring2(size(Bits), Unused, Bits), - decode_bitstring_NNL(BitString,NamedNumberList) - end. - -%%---------------------------------------- -%% Decode the in buffer to bits -%%---------------------------------------- -decode_bitstring2(1,Unused,<<B7:1,B6:1,B5:1,B4:1,B3:1,B2:1,B1:1,B0:1,_/binary>>) -> - lists:sublist([B7,B6,B5,B4,B3,B2,B1,B0],8-Unused); -decode_bitstring2(Len, Unused, - <<B7:1,B6:1,B5:1,B4:1,B3:1,B2:1,B1:1,B0:1,Buffer/binary>>) -> - [B7, B6, B5, B4, B3, B2, B1, B0 | - decode_bitstring2(Len - 1, Unused, Buffer)]. - -%%decode_bitstring2(1, Unused, Buffer) -> -%% make_bits_of_int(hd(Buffer), 128, 8-Unused); -%%decode_bitstring2(Len, Unused, [BitVal | Buffer]) -> -%% [B7, B6, B5, B4, B3, B2, B1, B0] = make_bits_of_int(BitVal, 128, 8), -%% [B7, B6, B5, B4, B3, B2, B1, B0 | -%% decode_bitstring2(Len - 1, Unused, Buffer)]. - - -%%make_bits_of_int(_, _, 0) -> -%% []; -%%make_bits_of_int(BitVal, MaskVal, Unused) when Unused > 0 -> -%% X = case MaskVal band BitVal of -%% 0 -> 0 ; -%% _ -> 1 -%% end, -%% [X | make_bits_of_int(BitVal, MaskVal bsr 1, Unused - 1)]. - - - -%%---------------------------------------- -%% Decode the bitlist to names -%%---------------------------------------- - - -decode_bitstring_NNL(BitList,NamedNumberList) -> - decode_bitstring_NNL(BitList,NamedNumberList,0,[]). - - -decode_bitstring_NNL([],_,_No,Result) -> - lists:reverse(Result); - -decode_bitstring_NNL([B|BitList],[{Name,No}|NamedNumberList],No,Result) -> - if - B == 0 -> - decode_bitstring_NNL(BitList,NamedNumberList,No+1,Result); - true -> - decode_bitstring_NNL(BitList,NamedNumberList,No+1,[Name|Result]) - end; -decode_bitstring_NNL([1|BitList],NamedNumberList,No,Result) -> - decode_bitstring_NNL(BitList,NamedNumberList,No+1,[{bit,No}|Result]); -decode_bitstring_NNL([0|BitList],NamedNumberList,No,Result) -> - decode_bitstring_NNL(BitList,NamedNumberList,No+1,Result). - - -%%============================================================================ -%% Octet string, ITU_T X.690 Chapter 8.7 -%% -%% encode octet string -%% The OctetList must be a flat list of integers in the range 0..255 -%% the function does not check this because it takes to much time -%%============================================================================ -encode_octet_string(_C, OctetList, TagIn) when is_binary(OctetList) -> - encode_tags(TagIn, OctetList, size(OctetList)); -encode_octet_string(_C, OctetList, TagIn) when is_list(OctetList) -> - encode_tags(TagIn, OctetList, length(OctetList)); -encode_octet_string(C, {Name,OctetList}, TagIn) when is_atom(Name) -> - encode_octet_string(C, OctetList, TagIn). - - -%%============================================================================ -%% decode octet string -%% (Buffer, Range, HasTag, TotalLen) -> {String, Remain, RemovedBytes} -%% -%% Octet string is decoded as a restricted string -%%============================================================================ -decode_octet_string(Buffer, Range, Tags) -> -% NewTags = new_tags(HasTag,#tag{class=?UNIVERSAL,number=?N_OCTET_STRING}), - decode_restricted_string(Buffer, Range, ?N_OCTET_STRING, - Tags, [], old). - -%%============================================================================ -%% Null value, ITU_T X.690 Chapter 8.8 -%% -%% encode NULL value -%%============================================================================ - -encode_null({Name, _Val}, TagIn) when is_atom(Name) -> - encode_tags(TagIn, [], 0); -encode_null(_Val, TagIn) -> - encode_tags(TagIn, [], 0). - -%%============================================================================ -%% decode NULL value -%% (Buffer, HasTag, TotalLen) -> {NULL, Remain, RemovedBytes} -%%============================================================================ - -decode_null(Tlv, Tags) -> - Val = match_tags(Tlv, Tags), - case Val of - <<>> -> - 'NULL'; - _ -> - exit({error,{asn1,{decode_null,Val}}}) - end. - -%%============================================================================ -%% Object identifier, ITU_T X.690 Chapter 8.19 -%% -%% encode Object Identifier value -%%============================================================================ - -encode_object_identifier({Name,Val}, TagIn) when is_atom(Name) -> - encode_object_identifier(Val, TagIn); -encode_object_identifier(Val, TagIn) -> - encode_tags(TagIn, e_object_identifier(Val)). - -e_object_identifier({'OBJECT IDENTIFIER', V}) -> - e_object_identifier(V); -e_object_identifier({Cname, V}) when is_atom(Cname), is_tuple(V) -> - e_object_identifier(tuple_to_list(V)); -e_object_identifier({Cname, V}) when is_atom(Cname), is_list(V) -> - e_object_identifier(V); -e_object_identifier(V) when is_tuple(V) -> - e_object_identifier(tuple_to_list(V)); - -%%%%%%%%%%%%%%% -%% e_object_identifier([List of Obect Identifiers]) -> -%% {[Encoded Octetlist of ObjIds], IntLength} -%% -e_object_identifier([E1, E2 | Tail]) -> - Head = 40*E1 + E2, % wow! - {H,Lh} = mk_object_val(Head), - {R,Lr} = lists:mapfoldl(fun enc_obj_id_tail/2,0,Tail), - {[H|R], Lh+Lr}. - -enc_obj_id_tail(H, Len) -> - {B, L} = mk_object_val(H), - {B,Len+L}. - - -%%%%%%%%%%% -%% mk_object_val(Value) -> {OctetList, Len} -%% returns a Val as a list of octets, the 8 bit is allways set to one except -%% for the last octet, where its 0 -%% - - -mk_object_val(Val) when Val =< 127 -> - {[255 band Val], 1}; -mk_object_val(Val) -> - mk_object_val(Val bsr 7, [Val band 127], 1). -mk_object_val(0, Ack, Len) -> - {Ack, Len}; -mk_object_val(Val, Ack, Len) -> - mk_object_val(Val bsr 7, [((Val band 127) bor 128) | Ack], Len + 1). - - - -%%============================================================================ -%% decode Object Identifier value -%% (Buffer, HasTag, TotalLen) -> {{ObjId}, Remain, RemovedBytes} -%%============================================================================ - -decode_object_identifier(Tlv, Tags) -> - Val = match_tags(Tlv, Tags), - [AddedObjVal|ObjVals] = dec_subidentifiers(Val,0,[]), - {Val1, Val2} = if - AddedObjVal < 40 -> - {0, AddedObjVal}; - AddedObjVal < 80 -> - {1, AddedObjVal - 40}; - true -> - {2, AddedObjVal - 80} - end, - list_to_tuple([Val1, Val2 | ObjVals]). - -dec_subidentifiers(<<>>,_Av,Al) -> - lists:reverse(Al); -dec_subidentifiers(<<1:1,H:7,T/binary>>,Av,Al) -> - dec_subidentifiers(T,(Av bsl 7) + H,Al); -dec_subidentifiers(<<H,T/binary>>,Av,Al) -> - dec_subidentifiers(T,0,[((Av bsl 7) + H)|Al]). - -%%============================================================================ -%% RELATIVE-OID, ITU_T X.690 Chapter 8.20 -%% -%% encode Relative Object Identifier -%%============================================================================ -encode_relative_oid({Name,Val},TagIn) when is_atom(Name) -> - encode_relative_oid(Val,TagIn); -encode_relative_oid(Val,TagIn) when is_tuple(Val) -> - encode_relative_oid(tuple_to_list(Val),TagIn); -encode_relative_oid(Val,TagIn) -> - encode_tags(TagIn, enc_relative_oid(Val)). - -enc_relative_oid(Tuple) when is_tuple(Tuple) -> - enc_relative_oid(tuple_to_list(Tuple)); -enc_relative_oid(Val) -> - lists:mapfoldl(fun(X,AccIn) -> - {SO,L}=mk_object_val(X), - {SO,L+AccIn} - end - ,0,Val). - -%%============================================================================ -%% decode Relative Object Identifier value -%% (Buffer, HasTag, TotalLen) -> {{ObjId}, Remain, RemovedBytes} -%%============================================================================ -decode_relative_oid(Tlv, Tags) -> - Val = match_tags(Tlv, Tags), - ObjVals = dec_subidentifiers(Val,0,[]), - list_to_tuple(ObjVals). - -%%============================================================================ -%% Restricted character string types, ITU_T X.690 Chapter 8.20 -%% -%% encode Numeric Printable Teletex Videotex Visible IA5 Graphic General strings -%%============================================================================ -%% The StringType arg is kept for future use but might be removed -encode_restricted_string(_C, OctetList, _StringType, TagIn) - when is_binary(OctetList) -> - encode_tags(TagIn, OctetList, size(OctetList)); -encode_restricted_string(_C, OctetList, _StringType, TagIn) - when is_list(OctetList) -> - encode_tags(TagIn, OctetList, length(OctetList)); -encode_restricted_string(C,{Name,OctetL}, StringType, TagIn) when is_atom(Name)-> - encode_restricted_string(C, OctetL, StringType, TagIn). - -%%============================================================================ -%% decode Numeric Printable Teletex Videotex Visible IA5 Graphic General strings -%% (Buffer, Range, StringType, HasTag, TotalLen) -> -%% {String, Remain, RemovedBytes} -%%============================================================================ - -decode_restricted_string(Buffer, Range, StringType, Tags) -> - decode_restricted_string(Buffer, Range, StringType, Tags, [], old). - - -decode_restricted_string(Tlv, Range, StringType, TagsIn, - NamedNumberList, BinOrOld) -> - Val = match_tags(Tlv, TagsIn), - Val2 = - case Val of - PartList = [_H|_T] -> % constructed val - Bin = collect_parts(PartList), - decode_restricted(Bin, StringType, - NamedNumberList, BinOrOld); - Bin -> - decode_restricted(Bin, StringType, - NamedNumberList, BinOrOld) - end, - check_and_convert_restricted_string(Val2,StringType,Range,NamedNumberList,BinOrOld). - - - -% case StringType of -% ?N_BIT_STRING when BinOrOld == bin -> -% {concat_bit_binaries(AccVal, Val), AccRb+Rb}; -% _ when is_binary(Val),is_binary(AccVal) -> -% {<<AccVal/binary,Val/binary>>,AccRb+Rb}; -% _ when is_binary(Val), AccVal==[] -> -% {Val,AccRb+Rb}; -% _ -> -% {AccVal++Val, AccRb+Rb} -% end, - - - -decode_restricted(Bin, StringType, NamedNumberList,BinOrOld) -> - case StringType of - ?N_BIT_STRING -> - decode_bit_string2(Bin, NamedNumberList, BinOrOld); - ?N_UniversalString -> - mk_universal_string(binary_to_list(Bin)); - ?N_BMPString -> - mk_BMP_string(binary_to_list(Bin)); - _ -> - Bin - end. - - -check_and_convert_restricted_string(Val,StringType,Range,NamedNumberList,_BinOrOld) -> - {StrLen,NewVal} = case StringType of - ?N_BIT_STRING when NamedNumberList /= [] -> - {no_check,Val}; - ?N_BIT_STRING when is_list(Val) -> - {length(Val),Val}; - ?N_BIT_STRING when is_tuple(Val) -> - {(size(element(2,Val))*8) - element(1,Val),Val}; - _ when is_binary(Val) -> - {size(Val),binary_to_list(Val)}; - _ when is_list(Val) -> - {length(Val), Val} - end, - case Range of - _ when StrLen == no_check -> - NewVal; - [] -> % No length constraint - NewVal; - {Lb,Ub} when StrLen >= Lb, Ub >= StrLen -> % variable length constraint - NewVal; - {{Lb,_Ub},[]} when StrLen >= Lb -> - NewVal; - {{Lb,_Ub},_Ext=[Min|_]} when StrLen >= Lb; StrLen >= Min -> - NewVal; - {{Lb1,Ub1},{Lb2,Ub2}} when StrLen >= Lb1, StrLen =< Ub1; - StrLen =< Ub2, StrLen >= Lb2 -> - NewVal; - StrLen -> % fixed length constraint - NewVal; - {_,_} -> - 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 - NewVal - end. - - -%%============================================================================ -%% encode Universal string -%%============================================================================ - -encode_universal_string(C, {Name, Universal}, TagIn) when is_atom(Name) -> - encode_universal_string(C, Universal, TagIn); -encode_universal_string(_C, Universal, TagIn) -> - OctetList = mk_uni_list(Universal), - encode_tags(TagIn, OctetList, length(OctetList)). - -mk_uni_list(In) -> - mk_uni_list(In,[]). - -mk_uni_list([],List) -> - lists:reverse(List); -mk_uni_list([{A,B,C,D}|T],List) -> - mk_uni_list(T,[D,C,B,A|List]); -mk_uni_list([H|T],List) -> - mk_uni_list(T,[H,0,0,0|List]). - -%%=========================================================================== -%% decode Universal strings -%% (Buffer, Range, StringType, HasTag, LenIn) -> -%% {String, Remain, RemovedBytes} -%%=========================================================================== - -decode_universal_string(Buffer, Range, Tags) -> - decode_restricted_string(Buffer, Range, ?N_UniversalString, - Tags, [], old). - - -mk_universal_string(In) -> - mk_universal_string(In,[]). - -mk_universal_string([],Acc) -> - lists:reverse(Acc); -mk_universal_string([0,0,0,D|T],Acc) -> - mk_universal_string(T,[D|Acc]); -mk_universal_string([A,B,C,D|T],Acc) -> - mk_universal_string(T,[{A,B,C,D}|Acc]). - - -%%============================================================================ -%% encode UTF8 string -%%============================================================================ - -encode_UTF8_string(_C,UTF8String,TagIn) when is_binary(UTF8String) -> - encode_tags(TagIn, UTF8String, size(UTF8String)); -encode_UTF8_string(_C,UTF8String,TagIn) -> - encode_tags(TagIn, UTF8String, length(UTF8String)). - - -%%============================================================================ -%% decode UTF8 string -%%============================================================================ - -decode_UTF8_string(Tlv,TagsIn) -> - Val = match_tags(Tlv, TagsIn), - case Val of - PartList = [_H|_T] -> % constructed val - collect_parts(PartList); - Bin -> - Bin - end. - - -%%============================================================================ -%% encode BMP string -%%============================================================================ - -encode_BMP_string(C, {Name,BMPString}, TagIn) when is_atom(Name)-> - encode_BMP_string(C, BMPString, TagIn); -encode_BMP_string(_C, BMPString, TagIn) -> - OctetList = mk_BMP_list(BMPString), - encode_tags(TagIn, OctetList, length(OctetList)). - -mk_BMP_list(In) -> - mk_BMP_list(In,[]). - -mk_BMP_list([],List) -> - lists:reverse(List); -mk_BMP_list([{0,0,C,D}|T],List) -> - mk_BMP_list(T,[D,C|List]); -mk_BMP_list([H|T],List) -> - mk_BMP_list(T,[H,0|List]). - -%%============================================================================ -%% decode (OctetList, Range(ignored), tag|notag) -> {ValList, RestList} -%% (Buffer, Range, StringType, HasTag, TotalLen) -> -%% {String, Remain, RemovedBytes} -%%============================================================================ -decode_BMP_string(Buffer, Range, Tags) -> - decode_restricted_string(Buffer, Range, ?N_BMPString, - Tags, [], old). - -mk_BMP_string(In) -> - mk_BMP_string(In,[]). - -mk_BMP_string([],US) -> - lists:reverse(US); -mk_BMP_string([0,B|T],US) -> - mk_BMP_string(T,[B|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(C, {Name,OctetList}, TagIn) when is_atom(Name) -> - encode_generalized_time(C, OctetList, TagIn); -encode_generalized_time(_C, 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 - PartList = [_H|_T] -> % 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(C, {Name,OctetList}, TagIn) when is_atom(Name) -> - encode_utc_time(C, OctetList, TagIn); -encode_utc_time(_C, 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 = [_H|_T] -> % constructed - collect_parts(PartList); - Bin -> - Bin - end, - binary_to_list(NewVal). - - -%%============================================================================ -%% Length handling -%% -%% Encode length -%% -%% encode_length(Int | indefinite) -> -%% [<127]| [128 + Int (<127),OctetList] | [16#80] -%%============================================================================ - -encode_length(indefinite) -> - {[16#80],1}; % 128 -encode_length(L) when L =< 16#7F -> - {[L],1}; -encode_length(L) -> - Oct = minimum_octets(L), - Len = length(Oct), - if - Len =< 126 -> - {[ (16#80+Len) | Oct ],Len+1}; - true -> - exit({error,{asn1, to_long_length_oct, Len}}) - end. - - -%% Val must be >= 0 -minimum_octets(Val) -> - minimum_octets(Val,[]). - -minimum_octets(0,Acc) -> - Acc; -minimum_octets(Val, Acc) -> - minimum_octets((Val bsr 8),[Val band 16#FF | Acc]). - - -%%=========================================================================== -%% Decode length -%% -%% decode_length(OctetList) -> {{indefinite, RestOctetsL}, NoRemovedBytes} | -%% {{Length, RestOctetsL}, NoRemovedBytes} -%%=========================================================================== - -decode_length(<<1:1,0:7,T/binary>>) -> - {indefinite, T}; -decode_length(<<0:1,Length:7,T/binary>>) -> - {Length,T}; -decode_length(<<1:1,LL:7,T/binary>>) -> - <<Length:LL/unit:8,Rest/binary>> = T, - {Length,Rest}. - - - -%%------------------------------------------------------------------------- -%% INTERNAL HELPER FUNCTIONS (not exported) -%%------------------------------------------------------------------------- - - -%% decoding postitive integer values. -decode_integer2(Len,Bin = <<0:1,_:7,_Bs/binary>>) -> - <<Int:Len/unit:8>> = Bin, - Int; -%% decoding negative integer values. -decode_integer2(Len,<<1:1,B2:7,Bs/binary>>) -> - <<N:Len/unit:8>> = <<B2,Bs/binary>>, - Int = N - (1 bsl (8 * Len - 1)), - Int. - -get_constraint(C,Key) -> - case lists:keysearch(Key,1,C) of - false -> - no; - {value,{_,V}} -> - V - end. - -collect_parts(TlvList) -> - collect_parts(TlvList,[]). - -collect_parts([{_,L}|Rest],Acc) when is_list(L) -> - collect_parts(Rest,[collect_parts(L)|Acc]); -collect_parts([{?N_BIT_STRING,<<Unused,Bits/binary>>}|Rest],_Acc) -> - collect_parts_bit(Rest,[Bits],Unused); -collect_parts([{_T,V}|Rest],Acc) -> - collect_parts(Rest,[V|Acc]); -collect_parts([],Acc) -> - list_to_binary(lists:reverse(Acc)). - -collect_parts_bit([{?N_BIT_STRING,<<Unused,Bits/binary>>}|Rest],Acc,Uacc) -> - collect_parts_bit(Rest,[Bits|Acc],Unused+Uacc); -collect_parts_bit([],Acc,Uacc) -> - list_to_binary([Uacc|lists:reverse(Acc)]). - - - - - - - - - - - - - - - - - - - - diff --git a/lib/asn1/src/asn1rt_check.erl b/lib/asn1/src/asn1rt_check.erl deleted file mode 100644 index 35b993fc71..0000000000 --- a/lib/asn1/src/asn1rt_check.erl +++ /dev/null @@ -1,360 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% -%% --module(asn1rt_check). - --export([check_bool/2, - check_int/3, - check_bitstring/3, - check_octetstring/2, - check_null/2, - check_objectidentifier/2, - check_objectdescriptor/2, - check_real/2, - check_enum/3, - check_restrictedstring/2]). - --export([transform_to_EXTERNAL1990/1, - transform_to_EXTERNAL1994/1]). - --export([dynamicsort_SET_components/1, - dynamicsort_SETOF/1]). - -check_bool(_Bool,asn1_DEFAULT) -> - true; -check_bool(Bool,Bool) when Bool == true; Bool == false -> - true; -check_bool(_Bool1,Bool2) -> - throw({error,Bool2}). - -check_int(_,asn1_DEFAULT,_) -> - true; -check_int(Value,Value,_) when is_integer(Value) -> - true; -check_int(DefValue,Value,NNL) when is_atom(Value) -> - case lists:keysearch(Value,1,NNL) of - {value,{_,DefValue}} -> - true; - _ -> - throw({error,DefValue}) - end; -check_int(DefaultValue,_Value,_) -> - throw({error,DefaultValue}). - -% check_bitstring([H|T],[H|T],_) when is_integer(H) -> -% true; -% check_bitstring(V,V,_) when is_integer(V) -> -% true; -%% Two equal lists or integers -check_bitstring(_,asn1_DEFAULT,_) -> - true; -check_bitstring(V,V,_) -> - true; -%% Default value as a list of 1 and 0 and user value as an integer -check_bitstring(L=[H|T],Int,_) when is_integer(Int),is_integer(H) -> - case bit_list_to_int(L,length(T)) of - Int -> true; - _ -> throw({error,L,Int}) - end; -%% Default value as an integer, val as list -check_bitstring(Int,Val,NBL) when is_integer(Int),is_list(Val) -> - BL = int_to_bit_list(Int,[],length(Val)), - check_bitstring(BL,Val,NBL); -%% Default value and user value as lists of ones and zeros -check_bitstring(L1=[H1|_T1],L2=[H2|_T2],NBL=[_H|_T]) when is_integer(H1),is_integer(H2) -> - L2new = remove_trailing_zeros(L2), - check_bitstring(L1,L2new,NBL); -%% Default value as a list of 1 and 0 and user value as a list of atoms -check_bitstring(L1=[H1|_T1],L2=[H2|_T2],NBL) when is_integer(H1),is_atom(H2) -> - L3 = bit_list_to_nbl(L1,NBL,0,[]), - check_bitstring(L3,L2,NBL); -%% Both default value and user value as a list of atoms -check_bitstring(L1=[H1|T1],L2=[H2|_T2],_) - when is_atom(H1),is_atom(H2),length(L1) == length(L2) -> - case lists:member(H1,L2) of - true -> - check_bitstring1(T1,L2); - false -> throw({error,L2}) - end; -%% Default value as a list of atoms and user value as a list of 1 and 0 -check_bitstring(L1=[H1|_T1],L2=[H2|_T2],NBL) when is_atom(H1),is_integer(H2) -> - L3 = bit_list_to_nbl(L2,NBL,0,[]), - check_bitstring(L1,L3,NBL); -%% User value in compact format -check_bitstring(DefVal,CBS={_,_},NBL) -> - NewVal = cbs_to_bit_list(CBS), - check_bitstring(DefVal,NewVal,NBL); -check_bitstring(DV,V,_) -> - throw({error,DV,V}). - - -bit_list_to_int([0|Bs],ShL)-> - bit_list_to_int(Bs,ShL-1) + 0; -bit_list_to_int([1|Bs],ShL) -> - bit_list_to_int(Bs,ShL-1) + (1 bsl ShL); -bit_list_to_int([],_) -> - 0. - -int_to_bit_list(0,Acc,0) -> - Acc; -int_to_bit_list(Int,Acc,Len) -> - int_to_bit_list(Int bsr 1,[Int band 1|Acc],Len - 1). - -bit_list_to_nbl([0|T],NBL,Pos,Acc) -> - bit_list_to_nbl(T,NBL,Pos+1,Acc); -bit_list_to_nbl([1|T],NBL,Pos,Acc) -> - case lists:keysearch(Pos,2,NBL) of - {value,{N,_}} -> - bit_list_to_nbl(T,NBL,Pos+1,[N|Acc]); - _ -> - throw({error,{no,named,element,at,pos,Pos}}) - end; -bit_list_to_nbl([],_,_,Acc) -> - Acc. - -remove_trailing_zeros(L2) -> - remove_trailing_zeros1(lists:reverse(L2)). -remove_trailing_zeros1(L) -> - lists:reverse(lists:dropwhile(fun(0)->true; - (_) ->false - end, - L)). - -check_bitstring1([H|T],NBL) -> - case lists:member(H,NBL) of - true -> - check_bitstring1(T,NBL); - V -> throw({error,V}) - end; -check_bitstring1([],_) -> - true. - -cbs_to_bit_list({Unused,<<B7:1,B6:1,B5:1,B4:1,B3:1,B2:1,B1:1,B0:1,Rest/binary>>}) when size(Rest) >= 1 -> - [B7,B6,B5,B4,B3,B2,B1,B0|cbs_to_bit_list({Unused,Rest})]; -cbs_to_bit_list({0,<<B7:1,B6:1,B5:1,B4:1,B3:1,B2:1,B1:1,B0:1>>}) -> - [B7,B6,B5,B4,B3,B2,B1,B0]; -cbs_to_bit_list({Unused,Bin}) when size(Bin) == 1 -> - Used = 8-Unused, - <<Int:Used,_:Unused>> = Bin, - int_to_bit_list(Int,[],Used). - - -check_octetstring(_,asn1_DEFAULT) -> - true; -check_octetstring(L,L) -> - true; -check_octetstring(L,Int) when is_list(L),is_integer(Int) -> - case integer_to_octetlist(Int) of - L -> true; - V -> throw({error,V}) - end; -check_octetstring(_,V) -> - throw({error,V}). - -integer_to_octetlist(Int) -> - integer_to_octetlist(Int,[]). -integer_to_octetlist(0,Acc) -> - Acc; -integer_to_octetlist(Int,Acc) -> - integer_to_octetlist(Int bsr 8,[(Int band 255)|Acc]). - -check_null(_,asn1_DEFAULT) -> - true; -check_null('NULL','NULL') -> - true; -check_null(_,V) -> - throw({error,V}). - -check_objectidentifier(_,asn1_DEFAULT) -> - true; -check_objectidentifier(OI,OI) -> - true; -check_objectidentifier(DOI,OI) when is_tuple(DOI),is_tuple(OI) -> - check_objectidentifier1(tuple_to_list(DOI),tuple_to_list(OI)); -check_objectidentifier(_,OI) -> - throw({error,OI}). - -check_objectidentifier1([V|Rest1],[V|Rest2]) -> - check_objectidentifier1(Rest1,Rest2,V); -check_objectidentifier1([V1|Rest1],[V2|Rest2]) -> - case reserved_objectid(V2,[]) of - V1 -> - check_objectidentifier1(Rest1,Rest2,[V1]); - V -> - throw({error,V}) - end. -check_objectidentifier1([V|Rest1],[V|Rest2],Above) -> - check_objectidentifier1(Rest1,Rest2,[V|Above]); -check_objectidentifier1([V1|Rest1],[V2|Rest2],Above) -> - case reserved_objectid(V2,Above) of - V1 -> - check_objectidentifier1(Rest1,Rest2,[V1|Above]); - V -> - throw({error,V}) - end; -check_objectidentifier1([],[],_) -> - true; -check_objectidentifier1(_,V,_) -> - throw({error,object,identifier,V}). - -%% ITU-T Rec. X.680 Annex B - D -reserved_objectid('itu-t',[]) -> 0; -reserved_objectid('ccitt',[]) -> 0; -%% arcs below "itu-t" -reserved_objectid('recommendation',[0]) -> 0; -reserved_objectid('question',[0]) -> 1; -reserved_objectid('administration',[0]) -> 2; -reserved_objectid('network-operator',[0]) -> 3; -reserved_objectid('identified-organization',[0]) -> 4; - -reserved_objectid(iso,[]) -> 1; -%% arcs below "iso", note that number 1 is not used -reserved_objectid('standard',[1]) -> 0; -reserved_objectid('member-body',[1]) -> 2; -reserved_objectid('identified-organization',[1]) -> 3; - -reserved_objectid('joint-iso-itu-t',[]) -> 2; -reserved_objectid('joint-iso-ccitt',[]) -> 2; - -reserved_objectid(_,_) -> false. - - -check_objectdescriptor(_,asn1_DEFAULT) -> - true; -check_objectdescriptor(OD,OD) -> - true; -check_objectdescriptor(OD,OD) -> - throw({error,{not_implemented_yet,check_objectdescriptor}}). - -check_real(_,asn1_DEFAULT) -> - true; -check_real(R,R) -> - true; -check_real(_,_) -> - throw({error,{not_implemented_yet,check_real}}). - -check_enum(_,asn1_DEFAULT,_) -> - true; -check_enum(Val,Val,_) -> - true; -check_enum(Int,Atom,Enumerations) when is_integer(Int),is_atom(Atom) -> - case lists:keysearch(Atom,1,Enumerations) of - {value,{_,Int}} -> true; - _ -> throw({error,{enumerated,Int,Atom}}) - end; -check_enum(DefVal,Val,_) -> - throw({error,{enumerated,DefVal,Val}}). - - -check_restrictedstring(_,asn1_DEFAULT) -> - true; -check_restrictedstring(Val,Val) -> - true; -check_restrictedstring([V|Rest1],[V|Rest2]) -> - check_restrictedstring(Rest1,Rest2); -check_restrictedstring([V1|Rest1],[V2|Rest2]) -> - check_restrictedstring(V1,V2), - check_restrictedstring(Rest1,Rest2); -%% tuple format of value -check_restrictedstring({V1,V2},[V1,V2]) -> - true; -check_restrictedstring([V1,V2],{V1,V2}) -> - true; -%% quadruple format of value -check_restrictedstring({V1,V2,V3,V4},[V1,V2,V3,V4]) -> - true; -check_restrictedstring([V1,V2,V3,V4],{V1,V2,V3,V4}) -> - true; -%% character string list -check_restrictedstring(V1,V2) when is_list(V1),is_tuple(V2) -> - check_restrictedstring(V1,tuple_to_list(V2)); -check_restrictedstring(V1,V2) -> - throw({error,{restricted,string,V1,V2}}). - -transform_to_EXTERNAL1990(Val) when is_tuple(Val),size(Val) == 4 -> - transform_to_EXTERNAL1990(tuple_to_list(Val),[]); -transform_to_EXTERNAL1990(Val) when is_tuple(Val) -> - %% Data already in ASN1 1990 format - Val. - -transform_to_EXTERNAL1990(['EXTERNAL'|Rest],Acc) -> - transform_to_EXTERNAL1990(Rest,['EXTERNAL'|Acc]); -transform_to_EXTERNAL1990([{syntax,Syntax}|Rest],Acc) -> - transform_to_EXTERNAL1990(Rest,[asn1_NOVALUE,Syntax|Acc]); -transform_to_EXTERNAL1990([{'presentation-context-id',PCid}|Rest],Acc) -> - transform_to_EXTERNAL1990(Rest,[PCid,asn1_NOVALUE|Acc]); -transform_to_EXTERNAL1990([{'context-negotiation',Context_negot}|Rest],Acc) -> - {_,Presentation_Cid,Transfer_syntax} = Context_negot, - transform_to_EXTERNAL1990(Rest,[Presentation_Cid,Transfer_syntax|Acc]); -transform_to_EXTERNAL1990([asn1_NOVALUE|Rest],Acc) -> - transform_to_EXTERNAL1990(Rest,[asn1_NOVALUE|Acc]); -transform_to_EXTERNAL1990([Data_val_desc,Data_value],Acc) when is_list(Data_value)-> - list_to_tuple(lists:reverse([{'octet-aligned',Data_value}, - Data_val_desc|Acc])); -transform_to_EXTERNAL1990([Data_val_desc,Data_value],Acc) - when is_binary(Data_value)-> - list_to_tuple(lists:reverse([{'single-ASN1-type',Data_value}, - Data_val_desc|Acc])); -transform_to_EXTERNAL1990([Data_value],Acc) - when is_list(Data_value); is_binary(Data_value) -> - list_to_tuple(lists:reverse([{'octet-aligned',Data_value}|Acc])). - - -transform_to_EXTERNAL1994(V={'EXTERNAL',DRef,IndRef,Data_v_desc,Encoding}) -> - Identification = - case {DRef,IndRef} of - {DRef,asn1_NOVALUE} -> - {syntax,DRef}; - {asn1_NOVALUE,IndRef} -> - {'presentation-context-id',IndRef}; - _ -> - {'context-negotiation', - {'EXTERNAL_identification_context-negotiation',IndRef,DRef}} - end, - case Encoding of - {_,Val} when is_list(Val);is_binary(Val) -> - {'EXTERNAL',Identification,Data_v_desc,Val}; - - _ -> - V - end. - - -%% dynamicsort_SET_components(Arg) -> -%% Res Arg -> list() -%% Res -> list() -%% Sorts the elements in Arg according to the encoded tag in -%% increasing order. -dynamicsort_SET_components(ListOfEncCs) -> - BinL = lists:map(fun(X) -> list_to_binary(X) end,ListOfEncCs), - TagBinL = lists:map(fun(X) -> - {{T,_,TN},_,_} = asn1rt_ber_bin:decode_tag(X), - {{T,TN},X} - end,BinL), - ClassTagNoSorted = lists:keysort(1,TagBinL), - lists:map(fun({_,El}) -> El end,ClassTagNoSorted). - -%% dynamicsort_SETOF(Arg) -> Res -%% Arg -> list() -%% Res -> list() -%% Sorts the elements in Arg in increasing size -dynamicsort_SETOF(ListOfEncVal) -> - BinL = lists:map(fun(L) when is_list(L) -> list_to_binary(L); - (B) -> B end,ListOfEncVal), - lists:sort(BinL). diff --git a/lib/asn1/src/asn1rt_nif.erl b/lib/asn1/src/asn1rt_nif.erl index de1fb94816..0b2e5a62a5 100644 --- a/lib/asn1/src/asn1rt_nif.erl +++ b/lib/asn1/src/asn1rt_nif.erl @@ -77,10 +77,31 @@ load_nif() -> Status end. -encode_per_complete(_TagValueList) -> +decode_ber_tlv(Binary) -> + case decode_ber_tlv_raw(Binary) of + {error,Reason} -> + exit({error,{asn1,Reason}}); + Other -> + Other + end. + +encode_per_complete(TagValueList) -> + case encode_per_complete_raw(TagValueList) of + {error,Reason} -> handle_error(Reason, TagValueList); + Other when is_binary(Other) -> Other + end. + +handle_error([], _)-> + exit({error,{asn1,enomem}}); +handle_error($1, L) -> % error in complete in driver + exit({error,{asn1,L}}); +handle_error(ErrL, L) -> + exit({error,{asn1,ErrL,L}}). + +encode_per_complete_raw(_TagValueList) -> erlang:nif_error({nif_not_loaded,module,?MODULE,line,?LINE}). -decode_ber_tlv(_Binary) -> +decode_ber_tlv_raw(_Binary) -> erlang:nif_error({nif_not_loaded,module,?MODULE,line,?LINE}). encode_ber_tlv(_TagValueList) -> diff --git a/lib/asn1/src/asn1rt_per_bin_rt2ct.erl b/lib/asn1/src/asn1rt_per_bin_rt2ct.erl deleted file mode 100644 index 5997232f13..0000000000 --- a/lib/asn1/src/asn1rt_per_bin_rt2ct.erl +++ /dev/null @@ -1,1587 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2012. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% 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(asn1rt_per_bin_rt2ct). -%% encoding / decoding of PER aligned - --include("asn1_records.hrl"). - --export([decode_fragmented/3]). --export([setchoiceext/1, setext/1, fixoptionals/3, fixextensions/2, - skipextensions/3, getbit/1, getchoice/3 ]). --export([set_choice/3, encode_integer/2, encode_integer/3 ]). --export([encode_small_number/1, - encode_length/2, - encode_small_length/1, - decode_compact_bit_string/3]). --export([encode_bit_string/3, decode_bit_string/3 ]). --export([encode_octet_string/2, - encode_object_identifier/1, decode_object_identifier/1, - encode_real/1, decode_real/1, - encode_relative_oid/1, decode_relative_oid/1, - complete/1]). - --export([encode_open_type/2, decode_open_type/2]). - --export([encode_GeneralString/2, decode_GeneralString/2, - encode_GraphicString/2, decode_GraphicString/2, - encode_TeletexString/2, decode_TeletexString/2, - encode_VideotexString/2, decode_VideotexString/2, - encode_ObjectDescriptor/2, decode_ObjectDescriptor/1, - encode_UTF8String/1,decode_UTF8String/1 - ]). - --export([encode_unconstrained_number/1, - encode_octet_string/3, - encode_known_multiplier_string/5, - decode_known_multiplier_string/5]). - - --export([eint_positive/1]). --export([pre_complete_bits/2]). - --define('16K',16384). --define('32K',32768). --define('64K',65536). - -%%-------------------------------------------------------- -%% setchoiceext(InRootSet) -> [{bit,X}] -%% X is set to 1 when InRootSet==false -%% X is set to 0 when InRootSet==true -%% -setchoiceext(true) -> - [0]; -setchoiceext(false) -> - [1]. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% setext(true|false) -> CompleteList -%% - -setext(false) -> -% [{debug,ext},{bits,1,0}]; - [0]; -setext(true) -> -% [{debug,ext},{bits,1,1}]; - [1]. - -fixoptionals(OptList,_OptLength,Val) when is_tuple(Val) -> -% Bits = fixoptionals(OptList,Val,0), -% {Val,{bits,OptLength,Bits}}; -% {Val,[10,OptLength,Bits]}; - {Val,fixoptionals(OptList,Val,[])}; - -fixoptionals([],_,Acc) -> - %% Optbits - lists:reverse(Acc); -fixoptionals([{Pos,DefVal}|Ot],Val,Acc) -> - case element(Pos,Val) of - asn1_DEFAULT -> fixoptionals(Ot,Val,[0|Acc]); - DefVal -> fixoptionals(Ot,Val,[0|Acc]); - _ -> fixoptionals(Ot,Val,[1|Acc]) - end; -fixoptionals([Pos|Ot],Val,Acc) -> - case element(Pos,Val) of - asn1_NOVALUE -> fixoptionals(Ot,Val,[0|Acc]); - asn1_DEFAULT -> fixoptionals(Ot,Val,[0|Acc]); - _ -> fixoptionals(Ot,Val,[1|Acc]) - end. - - -fixextensions({ext,ExtPos,ExtNum},Val) -> - case fixextensions(ExtPos,ExtNum+ExtPos,Val,0) of - 0 -> []; - ExtBits -> - [encode_small_length(ExtNum),pre_complete_bits(ExtNum,ExtBits)] - end. - -fixextensions(Pos,MaxPos,_,Acc) when Pos >= MaxPos -> - Acc; -fixextensions(Pos,ExtPos,Val,Acc) -> - Bit = case catch(element(Pos+1,Val)) of - asn1_NOVALUE -> - 0; - asn1_NOEXTVALUE -> - 0; - {'EXIT',_} -> - 0; - _ -> - 1 - end, - fixextensions(Pos+1,ExtPos,Val,(Acc bsl 1)+Bit). - -skipextensions(Bytes,Nr,ExtensionBitstr) when is_bitstring(ExtensionBitstr) -> - Prev = Nr - 1, - case ExtensionBitstr of - <<_:Prev,1:1,_/bitstring>> -> - {_,Bytes2} = decode_open_type(Bytes,[]), - skipextensions(Bytes2, Nr+1, ExtensionBitstr); - <<_:Prev,0:1,_/bitstring>> -> - skipextensions(Bytes, Nr+1, ExtensionBitstr); - _ -> - Bytes - 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}). - - -%% getbits_as_binary(Num,Bytes) -> {Bin,Rest} -%% Num = integer(), -%% Bytes = bitstring(), -%% Bin = bitstring(), -%% Rest = bitstring() -getbits_as_binary(Num,Bytes) when is_bitstring(Bytes) -> - <<BS:Num/bitstring,Rest/bitstring>> = Bytes, - {BS,Rest}. - -getbits_as_list(Num,Bytes) when is_bitstring(Bytes) -> - <<BitStr:Num/bitstring,Rest/bitstring>> = Bytes, - {[ B || <<B:1>> <= BitStr],Rest}. - - -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) -> - AlignBits = bit_size(BitStr) rem 8, - <<_: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}. - - -%% same as above but returns octets as a List -getoctets_as_list(Buffer,Num) -> - {Bin,Buffer2} = getoctets_as_bin(Buffer,Num), - {binary_to_list(Bin),Buffer2}. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% set_choice(Alt,Choices,Altnum) -> ListofBitSettings -%% Alt = atom() -%% Altnum = integer() | {integer(),integer()}% number of alternatives -%% Choices = [atom()] | {[atom()],[atom()]} -%% When Choices is a tuple the first list is the Rootset and the -%% second is the Extensions and then Altnum must also be a tuple with the -%% lengths of the 2 lists -%% -set_choice(Alt,{L1,L2},{Len1,_Len2}) -> - case set_choice_tag(Alt,L1) of - N when is_integer(N), Len1 > 1 -> -% [{bits,1,0}, % the value is in the root set -% encode_constrained_number({0,Len1-1},N)]; - [0, % the value is in the root set - encode_constrained_number({0,Len1-1},N)]; - N when is_integer(N) -> -% [{bits,1,0}]; % no encoding if only 0 or 1 alternative - [0]; % no encoding if only 0 or 1 alternative - false -> -% [{bits,1,1}, % extension value - [1, % extension value - case set_choice_tag(Alt,L2) of - N2 when is_integer(N2) -> - encode_small_number(N2); - false -> - unknown_choice_alt - end] - end; -set_choice(Alt,L,Len) -> - case set_choice_tag(Alt,L) of - N when is_integer(N), Len > 1 -> - encode_constrained_number({0,Len-1},N); - N when is_integer(N) -> - []; % no encoding if only 0 or 1 alternative - false -> - [unknown_choice_alt] - end. - -set_choice_tag(Alt,Choices) -> - set_choice_tag(Alt,Choices,0). - -set_choice_tag(Alt,[Alt|_Rest],Tag) -> - Tag; -set_choice_tag(Alt,[_H|Rest],Tag) -> - set_choice_tag(Alt,Rest,Tag+1); -set_choice_tag(_Alt,[],_Tag) -> - false. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_fragmented_XXX; decode of values encoded fragmented according -%% to ITU-T X.691 clause 10.9.3.8. The unit (XXX) is either bits, octets, -%% characters or number of components (in a choice,sequence or similar). -%% Buffer is a buffer binary(). -%% C is the constrained length. -%% If the buffer is not aligned, this function does that. -decode_fragmented_bits(Buffer,C) when is_binary(Buffer) -> - decode_fragmented_bits(Buffer,C,[]); -decode_fragmented_bits(Buffer,C) when is_bitstring(Buffer) -> - AlignBits = bit_size(Buffer) rem 8, - <<_:AlignBits,Rest/binary>> = Buffer, - decode_fragmented_bits(Rest,C,[]). - -decode_fragmented_bits(<<3:2,Len:6,Bin/binary>>,C,Acc) -> - {Value,Bin2} = split_binary(Bin, Len * ?'16K'), % Len = 1 | 2 | 3 | 4 - decode_fragmented_bits(Bin2,C,[Value|Acc]); -decode_fragmented_bits(<<0:1,0:7,Bin/binary>>,C,Acc) -> - BinBits = erlang:list_to_bitstring(lists:reverse(Acc)), - case C of - Int when is_integer(Int),C == bit_size(BinBits) -> - {BinBits,Bin}; - Int when is_integer(Int) -> - exit({error,{asn1,{illegal_value,C,BinBits}}}) - end; -decode_fragmented_bits(<<0:1,Len:7,Bin/binary>>,C,Acc) -> - <<Value:Len/bitstring,Rest/bitstring>> = Bin, - BinBits = erlang:list_to_bitstring([Value|Acc]), - case C of - Int when is_integer(Int),C == bit_size(BinBits) -> - {BinBits,Rest}; - Int when is_integer(Int) -> - exit({error,{asn1,{illegal_value,C,BinBits}}}) - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_open_type(Constraint, Value) -> CompleteList -%% Value = list of bytes of an already encoded value (the list must be flat) -%% | binary -%% Contraint = not used in this version -%% -encode_open_type(_Constraint, Val) when is_list(Val) -> - Bin = list_to_binary(Val), - case size(Bin) of - Size when Size>255 -> - [encode_length(undefined,Size),[21,<<Size:16>>,Bin]]; - Size -> - [encode_length(undefined,Size),[20,Size,Bin]] - end; -encode_open_type(_Constraint, Val) when is_binary(Val) -> - case size(Val) of - Size when Size>255 -> - [encode_length(undefined,size(Val)),[21,<<Size:16>>,Val]]; % octets implies align - Size -> - [encode_length(undefined,Size),[20,Size,Val]] - end. -%% the binary_to_list is not optimal but compatible with the current solution - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_open_type(Buffer,Constraint) -> Value -%% Constraint is not used in this version -%% Buffer = [byte] with PER encoded data -%% Value = [byte] with decoded data (which must be decoded again as some type) -%% -decode_open_type(Bytes, _Constraint) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - getoctets_as_bin(Bytes2,Len). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_integer(Constraint,Value,NamedNumberList) -> CompleteList -%% encode_integer(Constraint,Value) -> CompleteList -%% encode_integer(Constraint,{Name,Value}) -> CompleteList -%% -%% -encode_integer(C,V,NamedNumberList) when is_atom(V) -> - case lists:keysearch(V,1,NamedNumberList) of - {value,{_,NewV}} -> - encode_integer(C,NewV); - _ -> - exit({error,{asn1,{namednumber,V}}}) - end; -encode_integer(C,V,_NamedNumberList) when is_integer(V) -> - encode_integer(C,V); -encode_integer(C,{Name,V},NamedNumberList) when is_atom(Name) -> - encode_integer(C,V,NamedNumberList). - -encode_integer(C,{Name,Val}) when is_atom(Name) -> - encode_integer(C,Val); - -encode_integer([{Rc,_Ec}],Val) when is_tuple(Rc) -> % XXX when is this invoked? First argument most often a list,...Ok this is the extension case...but it doesn't work. - case (catch encode_integer([Rc],Val)) of - {'EXIT',{error,{asn1,_}}} -> -% [{bits,1,1},encode_unconstrained_number(Val)]; - [1,encode_unconstrained_number(Val)]; - Encoded -> -% [{bits,1,0},Encoded] - [0,Encoded] - end; - -encode_integer([],Val) -> - encode_unconstrained_number(Val); -%% The constraint is the effective constraint, and in this case is a number -encode_integer([{'SingleValue',V}],V) -> - []; -encode_integer([{'ValueRange',VR={Lb,Ub},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_semi_constrained_number(Lb,Val); -encode_integer([{'ValueRange',{'MIN',_}}],Val) -> - encode_unconstrained_number(Val); -encode_integer([{'ValueRange',VR={_Lb,_Ub}}],Val) -> - encode_constrained_number(VR,Val); -encode_integer(_,Val) -> - exit({error,{asn1,{illegal_value,Val}}}). - - -%% X.691:10.6 Encoding of a normally small non-negative whole number -%% Use this for encoding of CHOICE index if there is an extension marker in -%% the CHOICE -encode_small_number({Name,Val}) when is_atom(Name) -> - encode_small_number(Val); -encode_small_number(Val) when Val =< 63 -> -% [{bits,1,0},{bits,6,Val}]; -% [{bits,7,Val}]; % same as above but more efficient - [10,7,Val]; % same as above but more efficient -encode_small_number(Val) -> -% [{bits,1,1},encode_semi_constrained_number(0,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 -%% might be an optimization encode_semi_constrained_number(0,Val) -> -encode_semi_constrained_number(C,{Name,Val}) when is_atom(Name) -> - encode_semi_constrained_number(C,Val); -encode_semi_constrained_number({Lb,'MAX'},Val) -> - encode_semi_constrained_number(Lb,Val); -encode_semi_constrained_number(Lb,Val) -> - Val2 = Val - Lb, - Oct = eint_positive(Val2), - Len = length(Oct), - if - Len < 128 -> - %{octets,[Len|Oct]}; % equiv with encode_length(undefined,Len) but faster - [20,Len+1,[Len|Oct]]; - Len < 256 -> - [encode_length(undefined,Len),[20,Len,Oct]]; - true -> - [encode_length(undefined,Len),[21,<<Len:16>>,Oct]] - end. - -decode_semi_constrained_number(Bytes) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - {V,Bytes3} = getoctets(Bytes2,Len), - {V,Bytes3}. - -encode_constrained_number({Lb,_Ub},_Range,{bits,N},Val) -> - Val2 = Val-Lb, -% {bits,N,Val2}; - [10,N,Val2]; -encode_constrained_number({Lb,_Ub},_Range,{octets,N},Val) when N < 256-> - %% N is 8 or 16 (1 or 2 octets) - Val2 = Val-Lb, -% {octets,<<Val2:N/unit:8>>}; - [20,N,Val2]; -encode_constrained_number({Lb,_Ub},_Range,{octets,N},Val) -> % N>255 - %% N is 8 or 16 (1 or 2 octets) - Val2 = Val-Lb, -% {octets,<<Val2:N/unit:8>>}; - [21,<<N:16>>,Val2]; -encode_constrained_number({Lb,_Ub},Range,_,Val) -> - Val2 = Val-Lb, - if - Range =< 16#1000000 -> % max 3 octets - Octs = eint_positive(Val2), -% [encode_length({1,3},size(Octs)),{octets,Octs}]; - L = length(Octs), - [encode_length({1,3},L),[20,L,Octs]]; - Range =< 16#100000000 -> % max 4 octets - Octs = eint_positive(Val2), -% [encode_length({1,4},size(Octs)),{octets,Octs}]; - L = length(Octs), - [encode_length({1,4},L),[20,L,Octs]]; - Range =< 16#10000000000 -> % max 5 octets - Octs = eint_positive(Val2), -% [encode_length({1,5},size(Octs)),{octets,Octs}]; - L = length(Octs), - [encode_length({1,5},L),[20,L,Octs]]; - true -> - exit({not_supported,{integer_range,Range}}) - end. - -encode_constrained_number(Range,{Name,Val}) when is_atom(Name) -> - encode_constrained_number(Range,Val); -encode_constrained_number({Lb,Ub},Val) when Val >= Lb, Ub >= Val -> - Range = Ub - Lb + 1, - Val2 = Val - Lb, - if - Range == 1 -> []; - Range == 2 -> -% Size = {bits,1,Val2}; - [Val2]; - Range =< 4 -> -% Size = {bits,2,Val2}; - [10,2,Val2]; - Range =< 8 -> - [10,3,Val2]; - Range =< 16 -> - [10,4,Val2]; - Range =< 32 -> - [10,5,Val2]; - Range =< 64 -> - [10,6,Val2]; - Range =< 128 -> - [10,7,Val2]; - Range =< 255 -> - [10,8,Val2]; - Range =< 256 -> -% Size = {octets,[Val2]}; - [20,1,Val2]; - Range =< 65536 -> -% Size = {octets,<<Val2:16>>}; - [20,2,<<Val2:16>>]; - Range =< (1 bsl (255*8)) -> - Octs = binary:encode_unsigned(Val2), - RangeOcts = binary:encode_unsigned(Range - 1), - OctsLen = erlang:byte_size(Octs), - RangeOctsLen = erlang:byte_size(RangeOcts), - LengthBitsNeeded = minimum_bits(RangeOctsLen - 1), - [10,LengthBitsNeeded,OctsLen-1,20,OctsLen,Octs]; - true -> - exit({not_supported,{integer_range,Range}}) - end; -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; -minimum_bits(N) when N < 8 -> 3; -minimum_bits(N) when N < 16 -> 4; -minimum_bits(N) when N < 32 -> 5; -minimum_bits(N) when N < 64 -> 6; -minimum_bits(N) when N < 128 -> 7; -minimum_bits(_N) -> 8. - -%% X.691:10.8 Encoding of an unconstrained whole number - -encode_unconstrained_number(Val) when Val >= 0 -> - Oct = eint(Val,[]), - Len = length(Oct), - if - Len < 128 -> - %{octets,[Len|Oct]}; % equiv with encode_length(undefined,Len) but faster - [20,Len+1,[Len|Oct]]; - Len < 256 -> -% [encode_length(undefined,Len),20,Len,Oct]; - [20,Len+2,<<2:2,Len:14>>,Oct];% equiv with encode_length(undefined,Len) but faster - true -> -% [encode_length(undefined,Len),{octets,Oct}] - [encode_length(undefined,Len),[21,<<Len:16>>,Oct]] - end; -encode_unconstrained_number(Val) -> % negative - Oct = enint(Val,[]), - Len = length(Oct), - if - Len < 128 -> -% {octets,[Len|Oct]}; % equiv with encode_length(undefined,Len) but faster - [20,Len+1,[Len|Oct]];% equiv with encode_length(undefined,Len) but faster - Len < 256 -> -% [encode_length(undefined,Len),20,Len,Oct]; - [20,Len+2,<<2:2,Len:14>>,Oct];% equiv with encode_length(undefined,Len) but faster - true -> - %[encode_length(undefined,Len),{octets,Oct}] - [encode_length(undefined,Len),[21,<<Len:16>>,Oct]] - end. - - -%% used for positive Values which don't need a sign bit -%% returns a list -eint_positive(Val) -> - case eint(Val,[]) of - [0,B1|T] -> - [B1|T]; - T -> - T - end. - - -eint(0, [B|Acc]) when B < 128 -> - [B|Acc]; -eint(N, Acc) -> - eint(N bsr 8, [N band 16#ff| Acc]). - -enint(-1, [B1|T]) when B1 > 127 -> - [B1|T]; -enint(N, Acc) -> - enint(N bsr 8, [N band 16#ff|Acc]). - -%% X.691:10.9 Encoding of a length determinant -%%encode_small_length(undefined,Len) -> % null means no UpperBound -%% encode_small_number(Len). - -%% X.691:10.9.3.5 -%% X.691:10.9.3.7 -encode_length(undefined,Len) -> % un-constrained - if - Len < 128 -> -% {octets,[Len]}; - [20,1,Len]; - Len < 16384 -> - %{octets,<<2:2,Len:14>>}; - [20,2,<<2:2,Len:14>>]; - true -> % should be able to endode length >= 16384 i.e. fragmented length - exit({error,{asn1,{encode_length,{nyi,above_16k}}}}) - end; - -encode_length({0,'MAX'},Len) -> - encode_length(undefined,Len); -encode_length(Vr={Lb,Ub},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(undefined,Len); -encode_length({Vr={Lb,Ub},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) -> - []. - -%% X.691 10.9.3.4 (only used for length of bitmap that prefixes extension -%% additions in a sequence or set -encode_small_length(Len) when Len =< 64 -> -%% [{bits,1,0},{bits,6,Len-1}]; -% {bits,7,Len-1}; % the same as above but more efficient - [10,7,Len-1]; -encode_small_length(Len) -> -% [{bits,1,1},encode_length(undefined,Len)]. - [1,encode_length(undefined,Len)]. - - -decode_length(Buffer,undefined) -> % un-constrained - case align(Buffer) of - <<0:1,Oct:7,Rest/binary>> -> - {Oct,Rest}; - <<2:2,Val:14,Rest/binary>> -> - {Val,Rest}; - <<3:2,_Val:14,_Rest/binary>> -> - %% this case should be fixed - 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,undefined); -decode_length(Buffer,{{Lb,Ub},Ext}) when is_list(Ext) -> - case getbit(Buffer) of - {0,Buffer2} -> - decode_length(Buffer2, {Lb,Ub}); - {1,Buffer2} -> - decode_length(Buffer2, undefined) - end; - - -%When does this case occur with {_,_Lb,Ub} ?? -% X.691:10.9.3.5 -decode_length(Bin,{_,_Lb,_Ub}) -> % Unconstrained or large Ub NOTE! this case does not cover case when Ub > 65535 - case Bin of - <<0:1,Val:7,Rest/bitstring>> -> - {Val,Rest}; - _ -> - case align(Bin) of - <<2:2,Val:14,Rest/binary>> -> - {Val,Rest}; - <<3:2,_:14,_Rest/binary>> -> - exit({error,{asn1,{decode_length,{nyi,length_above_64K}}}}) - end - end; -decode_length(Buffer,SingleValue) when is_integer(SingleValue) -> - {SingleValue,Buffer}. - - - -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== -%% Bitstring value, ITU_T X.690 Chapter 8.5 -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== - -%%=============================================================================== -%% encode bitstring value -%%=============================================================================== - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% bitstring NamedBitList -%% Val can be of: -%% - [identifiers] where only named identifers are set to one, -%% the Constraint must then have some information of the -%% bitlength. -%% - [list of ones and zeroes] all bits -%% - integer value representing the bitlist -%% C is constraint Len, only valid when identifiers - - -%% when the value is a list of {Unused,BinBits}, where -%% Unused = integer(), -%% BinBits = binary(). - -encode_bit_string(C,Bin={Unused,BinBits},NamedBitList) when is_integer(Unused), - is_binary(BinBits) -> - encode_bin_bit_string(C,Bin,NamedBitList); - -%% when the value is a list of named bits - -encode_bit_string(C, LoNB=[FirstVal | _RestVal], NamedBitList) when is_atom(FirstVal) -> - ToSetPos = get_all_bitposes(LoNB, NamedBitList, []), - BitList = make_and_set_list(ToSetPos,0), - encode_bit_string(C,BitList,NamedBitList);% consider the constraint - -encode_bit_string(C, BL=[{bit,_} | _RestVal], NamedBitList) -> - ToSetPos = get_all_bitposes(BL, NamedBitList, []), - BitList = make_and_set_list(ToSetPos,0), - encode_bit_string(C,BitList,NamedBitList); - -%% when the value is a list of ones and zeroes -encode_bit_string(Int, BitListValue, _) - when is_list(BitListValue),is_integer(Int),Int =< 16 -> - %% The type is constrained by a single value size constraint - %% range_check(Int,length(BitListValue)), - [40,Int,length(BitListValue),BitListValue]; -encode_bit_string(Int, BitListValue, _) - when is_list(BitListValue),is_integer(Int), Int =< 255 -> - %% The type is constrained by a single value size constraint - %% range_check(Int,length(BitListValue)), - [2,40,Int,length(BitListValue),BitListValue]; -encode_bit_string(Int, BitListValue, _) - when is_list(BitListValue),is_integer(Int), Int < ?'64K' -> - {Code,DesiredLength,Length} = - case length(BitListValue) of - B1 when B1 > Int -> - exit({error,{'BIT_STRING_length_greater_than_SIZE', - Int,BitListValue}}); - B1 when B1 =< 255,Int =< 255 -> - {40,Int,B1}; - B1 when B1 =< 255 -> - {42,<<Int:16>>,B1}; - B1 -> - {43,<<Int:16>>,<<B1:16>>} - end, - %% The type is constrained by a single value size constraint - [2,Code,DesiredLength,Length,BitListValue]; -encode_bit_string(no, BitListValue,[]) - when is_list(BitListValue) -> - [encode_length(undefined,length(BitListValue)), - 2,BitListValue]; -encode_bit_string({{Fix,Fix},Ext}, BitListValue,[]) - when is_integer(Fix), is_list(Ext) -> - case length(BitListValue) of - Len when Len =< Fix -> - [0,encode_bit_string(Fix,BitListValue,[])]; - _ -> - [1,encode_bit_string(no,BitListValue,[])] - end; -encode_bit_string(C, BitListValue,[]) - when is_list(BitListValue) -> - [encode_length(C,length(BitListValue)), - 2,BitListValue]; -encode_bit_string(no, BitListValue,_NamedBitList) - when is_list(BitListValue) -> - %% this case with an unconstrained BIT STRING can be made more efficient - %% if the complete driver can take a special code so the length field - %% is encoded there. - NewBitLVal = lists:reverse(lists:dropwhile(fun(0)->true;(1)->false end, - lists:reverse(BitListValue))), - [encode_length(undefined,length(NewBitLVal)), - 2,NewBitLVal]; -encode_bit_string({{Fix,Fix},Ext}, BitListValue,_NamedBitList) - when is_integer(Fix), is_list(Ext) -> - case length(BitListValue) of - Len when Len =< Fix -> - [0,encode_bit_string(Fix,BitListValue,_NamedBitList)]; - _ -> - [1,encode_bit_string(no,BitListValue,_NamedBitList)] - end; -encode_bit_string(C,BitListValue,_NamedBitList) - when is_list(BitListValue) ->% C = {_,'MAX'} -% NewBitLVal = lists:reverse(lists:dropwhile(fun(0)->true;(1)->false end, -% lists:reverse(BitListValue))), - NewBitLVal = bit_string_trailing_zeros(BitListValue,C), - [encode_length(C,length(NewBitLVal)), - 2,NewBitLVal]; - - -%% when the value is an integer -encode_bit_string(C, IntegerVal, NamedBitList) when is_integer(IntegerVal)-> - BitList = int_to_bitlist(IntegerVal), - encode_bit_string(C,BitList,NamedBitList); - -%% when the value is a tuple -encode_bit_string(C,{Name,Val}, NamedBitList) when is_atom(Name) -> - encode_bit_string(C,Val,NamedBitList). - -bit_string_trailing_zeros(BitList,C) when is_integer(C) -> - bit_string_trailing_zeros1(BitList,C,C); -bit_string_trailing_zeros(BitList,{Lb,Ub}) when is_integer(Lb) -> - bit_string_trailing_zeros1(BitList,Lb,Ub); -bit_string_trailing_zeros(BitList,{{Lb,Ub},_}) when is_integer(Lb) -> - bit_string_trailing_zeros1(BitList,Lb,Ub); -bit_string_trailing_zeros(BitList,_) -> - BitList. - -bit_string_trailing_zeros1(BitList,Lb,Ub) -> - case length(BitList) of - Lb -> BitList; - B when B<Lb -> BitList++lists:duplicate(Lb-B,0); - D -> F = fun(L,LB,LB,_,_)->lists:reverse(L); - ([0|R],L1,LB,UB,Fun)->Fun(R,L1-1,LB,UB,Fun); - (L,L1,_,UB,_)when L1 =< UB -> lists:reverse(L); - (_,_L1,_,_,_) ->exit({error,{list_length_BIT_STRING, - BitList}}) end, - F(lists:reverse(BitList),D,Lb,Ub,F) - end. - -%% encode_bin_bit_string/3, when value is a tuple of Unused and BinBits. -%% Unused = integer(),i.e. number unused bits in least sign. byte of -%% BinBits = binary(). -encode_bin_bit_string(C,{Unused,BinBits},_NamedBitList) - when is_integer(C),C=<16 -> - range_check(C,bit_size(BinBits) - Unused), - [45,C,size(BinBits),BinBits]; -encode_bin_bit_string(C,{Unused,BinBits},_NamedBitList) - when is_integer(C), C =< 255 -> - range_check(C,bit_size(BinBits) - Unused), - [2,45,C,size(BinBits),BinBits]; -encode_bin_bit_string(C,{Unused,BinBits},_NamedBitList) - when is_integer(C), C =< 65535 -> - range_check(C,bit_size(BinBits) - Unused), - case size(BinBits) of - Size when Size =< 255 -> - [2,46,<<C:16>>,Size,BinBits]; - Size -> - [2,47,<<C:16>>,<<Size:16>>,BinBits] - end; -%% encode_bin_bit_string(C,{_Unused,BinBits},_NamedBitList) -%% when is_integer(C) -> -%% exit({error,{asn1, {bitstring_size, not_supported, C}}}); -encode_bin_bit_string(C,UnusedAndBin={_,_},NamedBitList) -> -% UnusedAndBin1 = {Unused1,Bin1} = - {Unused1,Bin1} = - %% removes all trailing bits if NamedBitList is not empty - remove_trailing_bin(NamedBitList,UnusedAndBin), - case C of - {Lb,Ub} when is_integer(Lb),is_integer(Ub) -> -% [encode_length({Lb,Ub},size(Bin1)*8 - Unused1), -% align,UnusedAndBin1]; - Size=size(Bin1), - [encode_length({Lb,Ub},Size*8 - Unused1), - 2,octets_unused_to_complete(Unused1,Size,Bin1)]; - no -> - Size=size(Bin1), - [encode_length(undefined,Size*8 - Unused1), - 2,octets_unused_to_complete(Unused1,Size,Bin1)]; - {{Fix,Fix},Ext} when is_integer(Fix),is_list(Ext) -> - %%[encode_length(Sc,size(Bin1)*8 - Unused1), - case size(Bin1)*8 - Unused1 of - Size when Size =< Fix -> - [0,encode_bin_bit_string(Fix,UnusedAndBin,NamedBitList)]; - _Size -> - [1,encode_bin_bit_string(no,UnusedAndBin,NamedBitList)] - end; - Sc -> - Size=size(Bin1), - [encode_length(Sc,Size*8 - Unused1), - 2,octets_unused_to_complete(Unused1,Size,Bin1)] - end. - -range_check(C,C) when is_integer(C) -> - ok; -range_check(C1,C2) when is_integer(C1) -> - exit({error,{asn1,{bit_string_out_of_range,{C1,C2}}}}). - -remove_trailing_bin([], {Unused,Bin}) -> - {Unused,Bin}; -remove_trailing_bin(_NamedNumberList,{_Unused,<<>>}) -> - {0,<<>>}; -remove_trailing_bin(NamedNumberList, {_Unused,Bin}) -> - Size = size(Bin)-1, - <<Bfront:Size/binary, LastByte:8>> = Bin, - %% clear the Unused bits to be sure -% LastByte1 = LastByte band (((1 bsl Unused) -1) bxor 255),% why this??? - Unused1 = trailingZeroesInNibble(LastByte band 15), - Unused2 = - case Unused1 of - 4 -> - 4 + trailingZeroesInNibble(LastByte bsr 4); - _ -> Unused1 - end, - case Unused2 of - 8 -> - remove_trailing_bin(NamedNumberList,{0,Bfront}); - _ -> - {Unused2,Bin} - end. - - -trailingZeroesInNibble(0) -> - 4; -trailingZeroesInNibble(1) -> - 0; -trailingZeroesInNibble(2) -> - 1; -trailingZeroesInNibble(3) -> - 0; -trailingZeroesInNibble(4) -> - 2; -trailingZeroesInNibble(5) -> - 0; -trailingZeroesInNibble(6) -> - 1; -trailingZeroesInNibble(7) -> - 0; -trailingZeroesInNibble(8) -> - 3; -trailingZeroesInNibble(9) -> - 0; -trailingZeroesInNibble(10) -> - 1; -trailingZeroesInNibble(11) -> - 0; -trailingZeroesInNibble(12) -> %#1100 - 2; -trailingZeroesInNibble(13) -> - 0; -trailingZeroesInNibble(14) -> - 1; -trailingZeroesInNibble(15) -> - 0. - -%%%%%%%%%%%%%%% -%% The result is presented as a list of named bits (if possible) -%% else as a tuple {Unused,Bits}. Unused is the number of unused -%% bits, least significant bits in the last byte of Bits. Bits is -%% the BIT STRING represented as a binary. -%% -decode_compact_bit_string(Buffer, C, NamedNumberList) -> - case get_constraint(C,'SizeConstraint') of - 0 -> % fixed length - {{8,0},Buffer}; - V when is_integer(V),V=<16 -> %fixed length 16 bits or less - compact_bit_string(Buffer,V,NamedNumberList); - V when is_integer(V),V=<65536 -> %fixed length > 16 bits - Bytes2 = align(Buffer), - compact_bit_string(Bytes2,V,NamedNumberList); - V when is_integer(V) -> % V > 65536 => fragmented value - {BitStr,Buffer2} = decode_fragmented_bits(Buffer,V), - case bit_size(BitStr) band 7 of - 0 -> {{0,BitStr},Buffer2}; - N -> {{8-N,<<BitStr/bitstring,0:(8-N)>>},Buffer2} - end; - {Lb,Ub} when is_integer(Lb),is_integer(Ub) -> - %% This case may demand decoding of fragmented length/value - {Len,Bytes2} = decode_length(Buffer,{Lb,Ub}), - Bytes3 = align(Bytes2), - compact_bit_string(Bytes3,Len,NamedNumberList); - no -> - %% This case may demand decoding of fragmented length/value - {Len,Bytes2} = decode_length(Buffer,undefined), - Bytes3 = align(Bytes2), - compact_bit_string(Bytes3,Len,NamedNumberList); - {{Fix,Fix},Ext} = Sc when is_integer(Fix), is_list(Ext) -> - case decode_length(Buffer,Sc) of - {Len,Bytes2} when Len > Fix -> - Bytes3 = align(Bytes2), - compact_bit_string(Bytes3,Len,NamedNumberList); - {Len,Bytes2} when Len > 16 -> - Bytes3 = align(Bytes2), - compact_bit_string(Bytes3,Len,NamedNumberList); - {Len,Bytes2} -> - compact_bit_string(Bytes2,Len,NamedNumberList) - end; - Sc -> - {Len,Bytes2} = decode_length(Buffer,Sc), - Bytes3 = align(Bytes2), - compact_bit_string(Bytes3,Len,NamedNumberList) - end. - - -%%%%%%%%%%%%%%% -%% The result is presented as a list of named bits (if possible) -%% else as a list of 0 and 1. -%% -decode_bit_string(Buffer, C, NamedNumberList) -> - case get_constraint(C,'SizeConstraint') of - {Lb,Ub} when is_integer(Lb),is_integer(Ub) -> - {Len,Bytes2} = decode_length(Buffer,{Lb,Ub}), - Bytes3 = align(Bytes2), - bit_list_or_named(Bytes3,Len,NamedNumberList); - no -> - {Len,Bytes2} = decode_length(Buffer,undefined), - Bytes3 = align(Bytes2), - bit_list_or_named(Bytes3,Len,NamedNumberList); - 0 -> % fixed length - {[],Buffer}; % nothing to encode - V when is_integer(V),V=<16 -> % fixed length 16 bits or less - bit_list_or_named(Buffer,V,NamedNumberList); - V when is_integer(V),V=<65536 -> - Bytes2 = align(Buffer), - bit_list_or_named(Bytes2,V,NamedNumberList); - V when is_integer(V) -> - Bytes2 = align(Buffer), - {BinBits,_Bytes3} = decode_fragmented_bits(Bytes2,V), - bit_list_or_named(BinBits,V,NamedNumberList); - {{Fix,Fix},Ext} =Sc when is_integer(Fix), is_list(Ext) -> - case decode_length(Buffer,Sc) of - {Len,Bytes2} when Len > Fix -> - Bytes3 = align(Bytes2), - bit_list_or_named(Bytes3,Len,NamedNumberList); - {Len,Bytes2} when Len > 16 -> - Bytes3 = align(Bytes2), - bit_list_or_named(Bytes3,Len,NamedNumberList); - {Len,Bytes2} -> - bit_list_or_named(Bytes2,Len,NamedNumberList) - end; - Sc -> % extension marker - {Len,Bytes2} = decode_length(Buffer,Sc), - Bytes3 = align(Bytes2), - bit_list_or_named(Bytes3,Len,NamedNumberList) - end. - - -%% if no named bits are declared we will return a -%% {Unused,Bits}. Unused = integer(), -%% Bits = binary(). -compact_bit_string(Buffer,Len,[]) -> - {BitStr,Rest} = getbits_as_binary(Len,Buffer), % {{Unused,BinBits},NewBuffer} - PadLen = (8 - (bit_size(BitStr) rem 8)) rem 8, - {{PadLen,<<BitStr/bitstring,0:PadLen>>},Rest}; -compact_bit_string(Buffer,Len,NamedNumberList) -> - bit_list_or_named(Buffer,Len,NamedNumberList). - - -%% if no named bits are declared we will return a -%% BitList = [0 | 1] - -bit_list_or_named(Buffer,Len,[]) -> - getbits_as_list(Len,Buffer); - -%% if there are named bits declared we will return a named -%% BitList where the names are atoms and unnamed bits represented -%% as {bit,Pos} -%% BitList = [atom() | {bit,Pos}] -%% Pos = integer() - -bit_list_or_named(Buffer,Len,NamedNumberList) -> - {BitList,Rest} = getbits_as_list(Len,Buffer), - {bit_list_or_named1(0,BitList,NamedNumberList,[]), Rest}. - -bit_list_or_named1(Pos,[0|Bt],Names,Acc) -> - bit_list_or_named1(Pos+1,Bt,Names,Acc); -bit_list_or_named1(Pos,[1|Bt],Names,Acc) -> - case lists:keysearch(Pos,2,Names) of - {value,{Name,_}} -> - bit_list_or_named1(Pos+1,Bt,Names,[Name|Acc]); - _ -> - bit_list_or_named1(Pos+1,Bt,Names,[{bit,Pos}|Acc]) - end; -bit_list_or_named1(_Pos,[],_Names,Acc) -> - lists:reverse(Acc). - - - -%%%%%%%%%%%%%%% -%% - -int_to_bitlist(Int) when is_integer(Int), Int > 0 -> - [Int band 1 | int_to_bitlist(Int bsr 1)]; -int_to_bitlist(0) -> - []. - - -%%%%%%%%%%%%%%%%%% -%% get_all_bitposes([list of named bits to set], named_bit_db, []) -> -%% [sorted_list_of_bitpositions_to_set] - -get_all_bitposes([{bit,ValPos}|Rest], NamedBitList, Ack) -> - get_all_bitposes(Rest, NamedBitList, [ValPos | Ack ]); - -get_all_bitposes([Val | Rest], NamedBitList, Ack) -> - case lists:keysearch(Val, 1, NamedBitList) of - {value, {_ValName, ValPos}} -> - get_all_bitposes(Rest, NamedBitList, [ValPos | Ack]); - _ -> - exit({error,{asn1, {bitstring_namedbit, Val}}}) - end; -get_all_bitposes([], _NamedBitList, Ack) -> - lists:sort(Ack). - -%%%%%%%%%%%%%%%%%% -%% make_and_set_list([list of positions to set to 1])-> -%% returns list with all in SetPos set. -%% in positioning in list the first element is 0, the second 1 etc.., but -%% - -make_and_set_list([XPos|SetPos], XPos) -> - [1 | make_and_set_list(SetPos, XPos + 1)]; -make_and_set_list([Pos|SetPos], XPos) -> - [0 | make_and_set_list([Pos | SetPos], XPos + 1)]; -make_and_set_list([], _) -> - []. - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% X.691:16 -%% encode_octet_string(Constraint,ExtensionMarker,Val) -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -encode_octet_string(C,Val) -> - encode_octet_string(C,false,Val). - -encode_octet_string(C,Bool,{_Name,Val}) -> - encode_octet_string(C,Bool,Val); -encode_octet_string(_C,true,_Val) -> - exit({error,{asn1,{'not_supported',extensionmarker}}}); -encode_octet_string(SZ={_,_},false,Val) -> -% [encode_length(SZ,length(Val)),align, -% {octets,Val}]; - Len = length(Val), - try - [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(SZ,false,Val) when is_list(SZ) -> - Len = length(Val), - try - [encode_length({hd(SZ),lists:max(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_fragmented_octet_string(Val); -encode_octet_string(no,false,Val) -> - Len = length(Val), - try - [encode_length(undefined,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}}). - -encode_fragmented_octet_string(Val) -> - Bin = iolist_to_binary(Val), - efos_1(Bin). - -efos_1(<<B1:16#C000/binary,B2:16#4000/binary,T/binary>>) -> - [20,1,<<3:2,4:6>>, - octets_to_complete(16#C000, B1), - octets_to_complete(16#4000, B2)|efos_1(T)]; -efos_1(<<B:16#C000/binary,T/binary>>) -> - [20,1,<<3:2,3:6>>,octets_to_complete(16#C000, B)|efos_1(T)]; -efos_1(<<B:16#8000/binary,T/binary>>) -> - [20,1,<<3:2,2:6>>,octets_to_complete(16#8000, B)|efos_1(T)]; -efos_1(<<B:16#4000/binary,T/binary>>) -> - [20,1,<<3:2,1:6>>,octets_to_complete(16#4000, B)|efos_1(T)]; -efos_1(<<>>) -> - [20,1,0]; -efos_1(<<B/bitstring>>) -> - Len = byte_size(B), - [encode_length(undefined, Len),octets_to_complete(Len, B)]. - -decode_fragmented(SegSz0, Buf0, Unit) -> - SegSz = SegSz0 * Unit * ?'16K', - <<Res:SegSz/bitstring,Buf/bitstring>> = Buf0, - decode_fragmented_1(Buf, Unit, Res). - -decode_fragmented_1(<<0:1,N:7,Buf0/bitstring>>, Unit, Res) -> - Sz = N*Unit, - <<S:Sz/bitstring,Buf/bitstring>> = Buf0, - {<<Res/bitstring,S/bitstring>>,Buf}; -decode_fragmented_1(<<1:1,0:1,N:14,Buf0/bitstring>>, Unit, Res) -> - Sz = N*Unit, - <<S:Sz/bitstring,Buf/bitstring>> = Buf0, - {<<Res/bitstring,S/bitstring>>,Buf}; -decode_fragmented_1(<<1:1,1:1,SegSz0:6,Buf0/bitstring>>, Unit, Res0) -> - SegSz = SegSz0 * Unit * ?'16K', - <<Frag:SegSz/bitstring,Buf/bitstring>> = Buf0, - Res = <<Res0/bitstring,Frag/bitstring>>, - decode_fragmented_1(Buf, Unit, Res). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Restricted char string types -%% (NumericString, PrintableString,VisibleString,IA5String,BMPString,UniversalString) -%% X.691:26 and X.680:34-36 -%%encode_restricted_string(aligned,'BMPString',Constraints,Extension,Val) - - -encode_restricted_string(aligned,{Name,Val}) when is_atom(Name) -> - encode_restricted_string(aligned,Val); - -encode_restricted_string(aligned,Val) when is_list(Val)-> - Len = length(Val), - [encode_length(undefined,Len),octets_to_complete(Len,Val)]. - - -encode_known_multiplier_string(StringType,SizeC,NumBits,CharOutTab,{Name,Val}) when is_atom(Name) -> - encode_known_multiplier_string(StringType,SizeC,NumBits,CharOutTab,Val); -encode_known_multiplier_string(_StringType,SizeC,NumBits,CharOutTab,Val) -> - Result = chars_encode2(Val,NumBits,CharOutTab), - case SizeC of - Ub when is_integer(Ub), Ub*NumBits =< 16 -> - Result; - Ub when is_integer(Ub),Ub =<65535 -> % fixed length - [2,Result]; - {Ub,Lb} -> - [encode_length({Ub,Lb},length(Val)),2,Result]; - no -> - [encode_length(undefined,length(Val)),2,Result] - end. - -decode_restricted_string(Bytes,aligned) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - getoctets_as_list(Bytes2,Len). - -decode_known_multiplier_string(StringType,SizeC,NumBits,CharInTab,Bytes) -> - case SizeC of - Ub when is_integer(Ub), Ub*NumBits =< 16 -> - chars_decode(Bytes,NumBits,StringType,CharInTab,Ub); - Ub when is_integer(Ub),Ub =<65535 -> % fixed length - Bytes1 = align(Bytes), - chars_decode(Bytes1,NumBits,StringType,CharInTab,Ub); - Vl when is_list(Vl) -> - {Len,Bytes1} = decode_length(Bytes,{hd(Vl),lists:max(Vl)}), - Bytes2 = align(Bytes1), - chars_decode(Bytes2,NumBits,StringType,CharInTab,Len); - no -> - {Len,Bytes1} = decode_length(Bytes,undefined), - Bytes2 = align(Bytes1), - chars_decode(Bytes2,NumBits,StringType,CharInTab,Len); - {Lb,Ub}-> - {Len,Bytes1} = decode_length(Bytes,{Lb,Ub}), - Bytes2 = align(Bytes1), - chars_decode(Bytes2,NumBits,StringType,CharInTab,Len) - end. - -encode_GeneralString(_C,Val) -> - encode_restricted_string(aligned,Val). -decode_GeneralString(Bytes,_C) -> - decode_restricted_string(Bytes,aligned). - -encode_GraphicString(_C,Val) -> - encode_restricted_string(aligned,Val). -decode_GraphicString(Bytes,_C) -> - decode_restricted_string(Bytes,aligned). - -encode_ObjectDescriptor(_C,Val) -> - encode_restricted_string(aligned,Val). -decode_ObjectDescriptor(Bytes) -> - decode_restricted_string(Bytes,aligned). - -encode_TeletexString(_C,Val) -> % equivalent with T61String - encode_restricted_string(aligned,Val). -decode_TeletexString(Bytes,_C) -> - decode_restricted_string(Bytes,aligned). - -encode_VideotexString(_C,Val) -> - encode_restricted_string(aligned,Val). -decode_VideotexString(Bytes,_C) -> - decode_restricted_string(Bytes,aligned). - - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% getBMPChars(Bytes,Len) ->{BMPcharList,RemainingBytes} -%% -getBMPChars(<<T/binary>>, 0, Acc) -> - {lists:reverse(Acc),T}; -getBMPChars(<<0,O2,Bytes1/bitstring>>, Len, Acc) -> - getBMPChars(Bytes1,Len-1,[O2|Acc]); -getBMPChars(<<O1,O2,Bytes1/bitstring>>, Len, Acc) -> - getBMPChars(Bytes1,Len-1,[{0,0,O1,O2}|Acc]). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% chars_encode(C,StringType,Value) -> ValueList -%% -%% encodes chars according to the per rules taking the constraint PermittedAlphabet -%% 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 -% {'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)}, -% chars_encode2(Value,NumBits,CharOutTab) -% end. - - -chars_encode2([H|T],NumBits,T1={Min,Max,notab}) when H =< Max, H >= Min -> -% [[10,NumBits,H-Min]|chars_encode2(T,NumBits,T1)]; - [pre_complete_bits(NumBits,H-Min)|chars_encode2(T,NumBits,T1)]; -chars_encode2([H|T],NumBits,T1={Min,Max,Tab}) when H =< Max, H >= Min -> -% [[10,NumBits,element(H-Min+1,Tab)]|chars_encode2(T,NumBits,T1)]; - [pre_complete_bits(NumBits,exit_if_false(H,element(H-Min+1,Tab)))| - chars_encode2(T,NumBits,T1)]; -chars_encode2([{A,B,C,D}|T],NumBits,T1={Min,_Max,notab}) -> - %% no value range check here (ought to be, but very expensive) -% [{bits,NumBits,(A*B*C*D)-Min}|chars_encode2(T,NumBits,{Min,Max,notab})]; -% [[10,NumBits,((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min]|chars_encode2(T,NumBits,T1)]; - [pre_complete_bits(NumBits, - ((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min)| - chars_encode2(T,NumBits,T1)]; -chars_encode2([H={A,B,C,D}|T],NumBits,{Min,Max,Tab}) -> - %% no value range check here (ought to be, but very expensive) - [pre_complete_bits(NumBits,exit_if_false(H,element(((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min,Tab)))|chars_encode2(T,NumBits,{Min,Max,notab})]; -chars_encode2([H|_T],_NumBits,{_Min,_Max,_Tab}) -> - exit({error,{asn1,{illegal_char_value,H}}}); -chars_encode2([],_,_) -> - []. - -exit_if_false(V,false)-> - exit({error,{asn1,{"illegal value according to Permitted alphabet constraint",V}}}); -exit_if_false(_,V) ->V. - -pre_complete_bits(NumBits,Val) when NumBits =< 8 -> - [10,NumBits,Val]; -pre_complete_bits(NumBits,Val) when NumBits =< 16 -> - [10,NumBits-8,Val bsr 8,10,8,(Val band 255)]; -pre_complete_bits(NumBits,Val) when NumBits =< 2040 -> % 255 * 8 -% LBUsed = NumBits rem 8, -% {Unused,Len} = case (8 - LBUsed) of -% 8 -> {0,NumBits div 8}; -% U -> {U,(NumBits div 8) + 1} -% end, -% NewVal = Val bsr LBUsed, -% [30,Unused,Len,<<NewVal:Len/unit:8,Val:LBUsed,0:Unused>>]. - Unused = (8 - (NumBits rem 8)) rem 8, - Len = NumBits + Unused, - [30,Unused,Len div 8,<<(Val bsl Unused):Len>>]. - - -chars_decode(Bytes,_,'BMPString',_,Len) -> - getBMPChars(Bytes,Len,[]); -chars_decode(Bytes,NumBits,_StringType,CharInTab,Len) -> - chars_decode2(Bytes,CharInTab,NumBits,Len). - - -chars_decode2(Bytes,CharInTab,NumBits,Len) -> - chars_decode2(Bytes,CharInTab,NumBits,Len,[]). - -chars_decode2(Bytes,_CharInTab,_NumBits,0,Acc) -> - {lists:reverse(Acc),Bytes}; -chars_decode2(Bytes,{Min,Max,notab},NumBits,Len,Acc) when NumBits > 8 -> - {Char,Bytes2} = getbits(Bytes,NumBits), - Result = - if - Char < 256 -> Char; - true -> - list_to_tuple(binary_to_list(<<Char:32>>)) - end, - chars_decode2(Bytes2,{Min,Max,notab},NumBits,Len -1,[Result|Acc]); -chars_decode2(Bytes,{Min,Max,notab},NumBits,Len,Acc) -> - {Char,Bytes2} = getbits(Bytes,NumBits), - chars_decode2(Bytes2,{Min,Max,notab},NumBits,Len -1,[Char+Min|Acc]); - -%% BMPString and UniversalString with PermittedAlphabet is currently not supported -chars_decode2(Bytes,{Min,Max,CharInTab},NumBits,Len,Acc) -> - {Char,Bytes2} = getbits(Bytes,NumBits), - chars_decode2(Bytes2,{Min,Max,CharInTab},NumBits,Len -1,[element(Char+1,CharInTab)|Acc]). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_UTF8String(Val) -> CompleteList -%% Val -> <<utf8encoded binary>> -%% CompleteList -> [apropriate codes and values for driver complete] -%% -encode_UTF8String(Val) when is_binary(Val) -> - [encode_length(undefined,size(Val)), - octets_to_complete(size(Val),Val)]; -encode_UTF8String(Val) -> - encode_UTF8String(list_to_binary(Val)). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_UTF8String(Bytes) -> {Utf8Binary,RemainingBytes} -%% Utf8Binary -> <<utf8 encoded binary>> -%% RemainingBytes -> <<buffer>> -decode_UTF8String(Bytes) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - {_Bin,_Bytes3} = getoctets_as_bin(Bytes2,Len). - - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_object_identifier(Val) -> CompleteList -%% encode_object_identifier({Name,Val}) -> CompleteList -%% Val -> {Int1,Int2,...,IntN} % N >= 2 -%% Name -> atom() -%% Int1 -> integer(0..2) -%% Int2 -> integer(0..39) when Int1 (0..1) else integer() -%% Int3-N -> integer() -%% CompleteList -> [{bits,8,Val}|{octets,Ol}|align|...] -%% -encode_object_identifier({Name,Val}) when is_atom(Name) -> - encode_object_identifier(Val); -encode_object_identifier(Val) -> - OctetList = e_object_identifier(Val), - Octets = list_to_binary(OctetList), - [encode_length(undefined,size(Octets)), - octets_to_complete(size(Octets),Octets)]. - -e_object_identifier({'OBJECT IDENTIFIER',V}) -> - e_object_identifier(V); -e_object_identifier({Cname,V}) when is_atom(Cname),is_tuple(V) -> - e_object_identifier(tuple_to_list(V)); -e_object_identifier({Cname,V}) when is_atom(Cname),is_list(V) -> - e_object_identifier(V); -e_object_identifier(V) when is_tuple(V) -> - e_object_identifier(tuple_to_list(V)); - -%% E1 = 0|1|2 and (E2 < 40 when E1 = 0|1) -e_object_identifier([E1,E2|Tail]) when E1 >= 0, E1 < 2, E2 < 40 ; E1==2 -> - Head = 40*E1 + E2, % weird - e_object_elements([Head|Tail],[]); -e_object_identifier(Oid=[_,_|_Tail]) -> - exit({error,{asn1,{'illegal_value',Oid}}}). - -e_object_elements([],Acc) -> - lists:reverse(Acc); -e_object_elements([H|T],Acc) -> - e_object_elements(T,[e_object_element(H)|Acc]). - -e_object_element(Num) when Num < 128 -> - [Num]; -e_object_element(Num) -> - [e_o_e(Num bsr 7)|[Num band 2#1111111]]. -e_o_e(Num) when Num < 128 -> - Num bor 2#10000000; -e_o_e(Num) -> - [e_o_e(Num bsr 7)|[(Num band 2#1111111) bor 2#10000000]]. - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_object_identifier(Bytes) -> {ObjId,RemainingBytes} -%% ObjId -> {integer(),integer(),...} % at least 2 integers -%% RemainingBytes -> [integer()] when integer() (0..255) -decode_object_identifier(Bytes) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), - [First|Rest] = dec_subidentifiers(Octs,0,[]), - Idlist = if - First < 40 -> - [0,First|Rest]; - First < 80 -> - [1,First - 40|Rest]; - true -> - [2,First - 80|Rest] - end, - {list_to_tuple(Idlist),Bytes3}. - -dec_subidentifiers([H|T],Av,Al) when H >=16#80 -> - dec_subidentifiers(T,(Av bsl 7) + (H band 16#7F),Al); -dec_subidentifiers([H|T],Av,Al) -> - dec_subidentifiers(T,0,[(Av bsl 7) + H |Al]); -dec_subidentifiers([],_Av,Al) -> - lists:reverse(Al). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_relative_oid(Val) -> CompleteList -%% encode_relative_oid({Name,Val}) -> CompleteList -encode_relative_oid({Name,Val}) when is_atom(Name) -> - encode_relative_oid(Val); -encode_relative_oid(Val) when is_tuple(Val) -> - encode_relative_oid(tuple_to_list(Val)); -encode_relative_oid(Val) when is_list(Val) -> - Octets = list_to_binary([e_object_element(X)||X <- Val]), - [encode_length(undefined,size(Octets)), - octets_to_complete(size(Octets),Octets)]. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_relative_oid(Val) -> CompleteList -%% decode_relative_oid({Name,Val}) -> CompleteList -decode_relative_oid(Bytes) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), - ObjVals = dec_subidentifiers(Octs,0,[]), - {list_to_tuple(ObjVals),Bytes3}. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_real(Val) -> CompleteList -%% encode_real({Name,Val}) -> CompleteList -encode_real({Name,Val}) when is_atom(Name) -> - encode_real(Val); -encode_real(Real) -> - {EncVal,Len} = ?RT_COMMON:encode_real([],Real), - [encode_length(undefined,Len),octets_to_complete(size(EncVal),EncVal)]. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_real(Val) -> {REALvalue,Rest} -%% decode_real({Name,Val}) -> {REALvalue,Rest} -decode_real(Bytes) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - {RealVal,Rest,Len} = ?RT_COMMON:decode_real(Bytes2,Len), - {RealVal,Rest}. - - -get_constraint([{Key,V}],Key) -> - V; -get_constraint([],_) -> - no; -get_constraint(C,Key) -> - case lists:keysearch(Key,1,C) of - false -> - no; - {value,{_,V}} -> - V - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% complete(InList) -> ByteList -%% Takes a coded list with bits and bytes and converts it to a list of bytes -%% Should be applied as the last step at encode of a complete ASN.1 type -%% - --ifdef(nodriver). - -complete(L) -> - erlang_complete(L). - --else. - -%% asn1-1.7 -complete(L) -> - case asn1rt_nif:encode_per_complete(L) of - {error, Reason} -> handle_error(Reason, L); - Else when is_binary(Else) -> Else - end. - -handle_error([],_)-> - exit({error,{asn1,{"memory allocation problem in driver"}}}); -handle_error($1,L) -> % error in complete in driver - exit({error,{asn1,L}}); -handle_error(ErrL,L) -> - exit({error,{asn1,ErrL,L}}). - --endif. - - -octets_to_complete(Len,Val) when Len < 256 -> - [20,Len,Val]; -octets_to_complete(Len,Val) -> - [21,<<Len:16>>,Val]. - -octets_unused_to_complete(Unused,Len,Val) when Len < 256 -> - [30,Unused,Len,Val]; -octets_unused_to_complete(Unused,Len,Val) -> - [31,Unused,<<Len:16>>,Val]. diff --git a/lib/asn1/src/asn1rt_uper_bin.erl b/lib/asn1/src/asn1rt_uper_bin.erl deleted file mode 100644 index fc65d80245..0000000000 --- a/lib/asn1/src/asn1rt_uper_bin.erl +++ /dev/null @@ -1,1487 +0,0 @@ -%% -%% %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% -%% -%% --module(asn1rt_uper_bin). - -%% encoding / decoding of PER unaligned - --include("asn1_records.hrl"). - -%%-compile(export_all). - --export([decode_fragmented/3]). --export([setext/1, fixoptionals/3, - fixextensions/2, - skipextensions/3, getbit/1, getchoice/3 ]). --export([set_choice/3, encode_integer/2, encode_integer/3]). --export([encode_small_number/1, encode_boolean/1, - encode_length/2, - encode_small_length/1, - decode_compact_bit_string/3]). --export([encode_bit_string/3, decode_bit_string/3 ]). --export([encode_octet_string/2, - encode_relative_oid/1, decode_relative_oid/1, - encode_object_identifier/1, decode_object_identifier/1, - encode_real/1, decode_real/1, - complete/1, complete_NFP/1]). - - - -export([encode_open_type/2, decode_open_type/2]). - - -export([encode_UniversalString/2, decode_UniversalString/2, - encode_PrintableString/2, decode_PrintableString/2, - encode_GeneralString/2, decode_GeneralString/2, - encode_GraphicString/2, decode_GraphicString/2, - encode_TeletexString/2, decode_TeletexString/2, - encode_VideotexString/2, decode_VideotexString/2, - encode_VisibleString/2, decode_VisibleString/2, - encode_UTF8String/1, decode_UTF8String/1, - encode_BMPString/2, decode_BMPString/2, - encode_IA5String/2, decode_IA5String/2, - encode_NumericString/2, decode_NumericString/2, - encode_ObjectDescriptor/2, decode_ObjectDescriptor/1 - ]). - --define('16K',16384). --define('32K',32768). --define('64K',65536). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% setext(true|false) -> CompleteList -%% - -setext(false) -> - <<0:1>>; -setext(true) -> - <<1:1>>. - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% This is the new fixoptionals/3 which is used by the new generates -%% -fixoptionals(OptList,OptLength,Val) when is_tuple(Val) -> - Bits = fixoptionals(OptList,Val,0), - {Val,<<Bits:OptLength>>}; - -fixoptionals([],_Val,Acc) -> - %% Optbits - Acc; -fixoptionals([{Pos,DefVal}|Ot],Val,Acc) -> - case element(Pos,Val) of - asn1_DEFAULT -> fixoptionals(Ot,Val,Acc bsl 1); - DefVal -> fixoptionals(Ot,Val,Acc bsl 1); - _ -> fixoptionals(Ot,Val,(Acc bsl 1) + 1) - end; -fixoptionals([Pos|Ot],Val,Acc) -> - case element(Pos,Val) of - asn1_NOVALUE -> fixoptionals(Ot,Val,Acc bsl 1); - asn1_DEFAULT -> fixoptionals(Ot,Val,Acc bsl 1); - _ -> fixoptionals(Ot,Val,(Acc bsl 1) + 1) - end. - - -fixextensions({ext,ExtPos,ExtNum},Val) -> - case fixextensions(ExtPos,ExtNum+ExtPos,Val,0) of - 0 -> []; - ExtBits -> - [encode_small_length(ExtNum),<<ExtBits:ExtNum>>] - end. - -fixextensions(Pos,MaxPos,_,Acc) when Pos >= MaxPos -> - Acc; -fixextensions(Pos,ExtPos,Val,Acc) -> - Bit = case catch(element(Pos+1,Val)) of - asn1_NOVALUE -> - 0; - asn1_NOEXTVALUE -> - 0; - {'EXIT',_} -> - 0; - _ -> - 1 - end, - fixextensions(Pos+1,ExtPos,Val,(Acc bsl 1)+Bit). - -skipextensions(Bytes,Nr,ExtensionBitstr) when is_bitstring(ExtensionBitstr) -> - Prev = Nr - 1, - case ExtensionBitstr of - <<_:Prev,1:1,_/bitstring>> -> - {_,Bytes2} = decode_open_type(Bytes,[]), - skipextensions(Bytes2, Nr+1, ExtensionBitstr); - <<_:Prev,0:1,_/bitstring>> -> - skipextensions(Bytes, Nr+1, ExtensionBitstr); - _ -> - Bytes - 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}). - - -%% getbits_as_binary(Num,Bytes) -> {{Unused,BinBits},RestBytes}, -%% Num = integer(), -%% Bytes = list() | tuple(), -%% Unused = integer(), -%% BinBits = binary(), -%% RestBytes = tuple() -getbits_as_binary(Num,Bytes) when is_bitstring(Bytes) -> - <<BS:Num/bitstring,Rest/bitstring>> = Bytes, - {BS,Rest}. - -getbits_as_list(Num,Bytes) when is_bitstring(Bytes) -> - <<BitStr:Num/bitstring,Rest/bitstring>> = Bytes, - {[ B || <<B:1>> <= BitStr],Rest}. - -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}. - -%% Pick the first Num octets. -%% Returns octets as a binary -getoctets_as_bin(Bin,Num) when is_bitstring(Bin) -> - <<Octets:Num/binary,RestBin/bitstring>> = Bin, - {Octets,RestBin}. - -%% same as above but returns octets as a List -getoctets_as_list(Buffer,Num) -> - {Bin,Buffer2} = getoctets_as_bin(Buffer,Num), - {binary_to_list(Bin),Buffer2}. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% set_choice(Alt,Choices,Altnum) -> ListofBitSettings -%% Alt = atom() -%% Altnum = integer() | {integer(),integer()}% number of alternatives -%% Choices = [atom()] | {[atom()],[atom()]} -%% When Choices is a tuple the first list is the Rootset and the -%% second is the Extensions and then Altnum must also be a tuple with the -%% lengths of the 2 lists -%% -set_choice(Alt,{L1,L2},{Len1,_Len2}) -> - case set_choice_tag(Alt,L1) of - N when is_integer(N), Len1 > 1 -> - [<<0:1>>, % the value is in the root set - encode_integer([{'ValueRange',{0,Len1-1}}],N)]; - N when is_integer(N) -> - <<0:1>>; % no encoding if only 0 or 1 alternative - false -> - [<<1:1>>, % extension value - case set_choice_tag(Alt,L2) of - N2 when is_integer(N2) -> - encode_small_number(N2); - false -> - unknown_choice_alt - end] - end; -set_choice(Alt,L,Len) -> - case set_choice_tag(Alt,L) of - N when is_integer(N), Len > 1 -> - encode_integer([{'ValueRange',{0,Len-1}}],N); - N when is_integer(N) -> - []; % no encoding if only 0 or 1 alternative - false -> - [unknown_choice_alt] - end. - -set_choice_tag(Alt,Choices) -> - set_choice_tag(Alt,Choices,0). - -set_choice_tag(Alt,[Alt|_Rest],Tag) -> - Tag; -set_choice_tag(Alt,[_H|Rest],Tag) -> - set_choice_tag(Alt,Rest,Tag+1); -set_choice_tag(_Alt,[],_Tag) -> - false. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_fragmented_XXX; decode of values encoded fragmented according -%% to ITU-T X.691 clause 10.9.3.8. The unit (XXX) is either bits, octets, -%% characters or number of components (in a choice,sequence or similar). -%% Buffer is a buffer {Used, Bin}. -%% C is the constrained length. -%% If the buffer is not aligned, this function does that. -decode_fragmented_bits(Buffer,C) -> - decode_fragmented_bits(Buffer,C,[]). -decode_fragmented_bits(<<3:2,Len:6,BitStr/bitstring>>,C,Acc) -> -%% {Value,Bin2} = split_binary(Bin, Len * ?'16K'), - FragLen = (Len*?'16K') div 8, - <<Value:FragLen/binary,BitStr2/bitstring>> = BitStr, - decode_fragmented_bits(BitStr2,C,[Value|Acc]); -decode_fragmented_bits(<<0:1,0:7,BitStr/bitstring>>,C,Acc) -> - BinBits = list_to_binary(lists:reverse(Acc)), - case C of - Int when is_integer(Int),C == size(BinBits) -> - {BinBits,BitStr}; - Int when is_integer(Int) -> - exit({error,{asn1,{illegal_value,C,BinBits}}}) - end; -decode_fragmented_bits(<<0:1,Len:7,BitStr/bitstring>>,C,Acc) -> - <<Val:Len/bitstring,Rest/bitstring>> = BitStr, -%% <<Value:Len/binary-unit:1,Bin2/binary>> = Bin, - ResBitStr = list_to_bitstring(lists:reverse([Val|Acc])), - case C of - Int when is_integer(Int),C == bit_size(ResBitStr) -> - {ResBitStr,Rest}; - Int when is_integer(Int) -> - exit({error,{asn1,{illegal_value,C,ResBitStr}}}) - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_open_type(Constraint, Value) -> CompleteList -%% Value = list of bytes of an already encoded value (the list must be flat) -%% | binary -%% Contraint = not used in this version -%% -encode_open_type(C, Val) when is_list(Val) -> - encode_open_type(C, list_to_binary(Val)); -encode_open_type(_C, Val) when is_binary(Val) -> - [encode_length(undefined,size(Val)),Val]. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_open_type(Buffer,Constraint) -> Value -%% Constraint is not used in this version -%% Buffer = [byte] with PER encoded data -%% Value = [byte] with decoded data (which must be decoded again as some type) -%% -decode_open_type(Bytes, _C) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - getoctets_as_bin(Bytes2,Len). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_integer(Constraint,Value,NamedNumberList) -> CompleteList -%% encode_integer(Constraint,Value) -> CompleteList -%% encode_integer(Constraint,{Name,Value}) -> CompleteList -%% -%% -encode_integer(C,V,NamedNumberList) when is_atom(V) -> - case lists:keysearch(V,1,NamedNumberList) of - {value,{_,NewV}} -> - encode_integer(C,NewV); - _ -> - exit({error,{asn1,{namednumber,V}}}) - end; -encode_integer(C,V,_NamedNumberList) when is_integer(V) -> - encode_integer(C,V); -encode_integer(C,{Name,V},NamedNumberList) when is_atom(Name) -> - encode_integer(C,V,NamedNumberList). - -encode_integer(C,{Name,Val}) when is_atom(Name) -> - encode_integer(C,Val); - -encode_integer([{Rc,_Ec}],Val) when is_tuple(Rc) -> % XXX when is this invoked? First argument most often a list,...Ok this is the extension case...but it doesn't work. - case (catch encode_integer([Rc],Val)) of - {'EXIT',{error,{asn1,_}}} -> - [<<1:1>>,encode_unconstrained_number(Val)]; - Encoded -> - [<<0:1>>,Encoded] - end; -encode_integer(C,Val ) when is_list(C) -> - case get_constraint(C,'SingleValue') of - no -> - encode_integer1(C,Val); - V when is_integer(V),V == Val -> - []; % a type restricted to a single value encodes to nothing - V when is_list(V) -> - case lists:member(Val,V) of - true -> - encode_integer1(C,Val); - _ -> - exit({error,{asn1,{illegal_value,Val}}}) - end; - _ -> - exit({error,{asn1,{illegal_value,Val}}}) - end. - -encode_integer1(C, Val) -> - case VR = get_constraint(C,'ValueRange') of - no -> - encode_unconstrained_number(Val); - {Lb,'MAX'} -> - encode_semi_constrained_number(Lb,Val); - %% positive with range - {Lb,Ub} when Val >= Lb, - Ub >= Val -> - encode_constrained_number(VR,Val); - _ -> - exit({error,{asn1,{illegal_value,VR,Val}}}) - end. - -%% X.691:10.6 Encoding of a normally small non-negative whole number -%% Use this for encoding of CHOICE index if there is an extension marker in -%% the CHOICE -encode_small_number({Name,Val}) when is_atom(Name) -> - encode_small_number(Val); -encode_small_number(Val) when Val =< 63 -> - <<Val:7>>; -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 -%% might be an optimization encode_semi_constrained_number(0,Val) -> -encode_semi_constrained_number(C,{Name,Val}) when is_atom(Name) -> - encode_semi_constrained_number(C,Val); -encode_semi_constrained_number({Lb,'MAX'},Val) -> - encode_semi_constrained_number(Lb,Val); -encode_semi_constrained_number(Lb,Val) -> - %% encoding in minimum no of octets preceeded by a length - Val2 = Val - Lb, -%% NumBits = num_bits(Val2), - Bin = eint_bin_positive(Val2), - Size = size(Bin), - if - Size < 128 -> - [<<Size>>,Bin]; % equiv with encode_length(undefined,Len) but faster - Size < 16384 -> - [<<2:2,Size:14>>,Bin]; - true -> - [encode_length(undefined,Size),Bin] - end. - -decode_semi_constrained_number(Bytes) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - {V,Bytes3} = getoctets(Bytes2,Len), - {V,Bytes3}. - -encode_constrained_number(Range,{Name,Val}) when is_atom(Name) -> - encode_constrained_number(Range,Val); -encode_constrained_number({Lb,Ub},Val) when Val >= Lb, Ub >= Val -> - Range = Ub - Lb + 1, - Val2 = Val - Lb, - NumBits = num_bits(Range), - <<Val2:NumBits>>; -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 -> - Oct = eint_bin_2Cs(Val), - Len = size(Oct), - if - Len < 128 -> - [<<Len>>,Oct]; % equiv with encode_length(undefined,Len) but faster - Len < 16384 -> - [<<2:2,Len:14>>,Oct]; - true -> - [encode_length(undefined,Len),<<Len:16>>,Oct] - end; -encode_unconstrained_number(Val) -> % negative - Oct = enint(Val,[]), - Len = size(Oct), - if - Len < 128 -> - [<<Len>>,Oct]; % equiv with encode_length(undefined,Len) but faster - Len < 16384 -> - [<<2:2,Len:14>>,Oct]; - true -> - [encode_length(undefined,Len),Oct] - end. - - -eint_bin_2Cs(Int) -> - case eint_bin_positive(Int) of - Bin = <<B,_/binary>> when B > 16#7f -> - <<0,Bin/binary>>; - Bin -> Bin - end. - -%% returns the integer as a binary -eint_bin_positive(Val) when Val < 16#100 -> - <<Val>>; -eint_bin_positive(Val) when Val < 16#10000 -> - <<Val:16>>; -eint_bin_positive(Val) when Val < 16#1000000 -> - <<Val:24>>; -eint_bin_positive(Val) when Val < 16#100000000 -> - <<Val:32>>; -eint_bin_positive(Val) -> - list_to_binary([eint_bin_positive2(Val bsr 32)|<<Val:32>>]). -eint_bin_positive2(Val) when Val < 16#100 -> - <<Val>>; -eint_bin_positive2(Val) when Val < 16#10000 -> - <<Val:16>>; -eint_bin_positive2(Val) when Val < 16#1000000 -> - <<Val:24>>; -eint_bin_positive2(Val) when Val < 16#100000000 -> - <<Val:32>>; -eint_bin_positive2(Val) -> - [eint_bin_positive2(Val bsr 32)|<<Val:32>>]. - - - - -enint(-1, [B1|T]) when B1 > 127 -> - list_to_binary([B1|T]); -enint(N, Acc) -> - enint(N bsr 8, [N band 16#ff|Acc]). - - -%% X.691:10.9 Encoding of a length determinant -%%encode_small_length(undefined,Len) -> % null means no UpperBound -%% encode_small_number(Len). - -%% X.691:10.9.3.5 -%% X.691:10.9.3.7 -encode_length(undefined,Len) -> % un-constrained - if - Len < 128 -> - <<Len>>; - Len < 16384 -> - <<2:2,Len:14>>; - true -> % should be able to endode length >= 16384 - error({error,{asn1,{encode_length,{nyi,above_16k}}}}) - end; - -encode_length({0,'MAX'},Len) -> - encode_length(undefined,Len); -encode_length(Vr={Lb,Ub},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(undefined,Len); -encode_length({Vr={Lb,Ub},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) -> - []. - -%% X.691 10.9.3.4 (only used for length of bitmap that prefixes extension -%% additions in a sequence or set -encode_small_length(Len) when Len =< 64 -> - <<(Len-1):7>>; -encode_small_length(Len) -> - [<<1:1>>,encode_length(undefined,Len)]. - - -%% un-constrained -decode_length(<<0:1,Oct:7,Rest/bitstring>>,undefined) -> - {Oct,Rest}; -decode_length(<<2:2,Val:14,Rest/bitstring>>,undefined) -> - {Val,Rest}; -decode_length(<<3:2,_:14,_Rest/bitstring>>,undefined) -> - exit({error,{asn1,{decode_length,{nyi,above_16k}}}}); - -decode_length(Buffer,{Lb,Ub}) when Ub =< 65535 ,Lb >= 0 -> % constrained - decode_constrained_number(Buffer,{Lb,Ub}); -decode_length(Buffer,{Lb,_}) when is_integer(Lb), Lb >= 0 -> % Ub > 65535 - decode_length(Buffer,undefined); -decode_length(Buffer,{VR={_Lb,_Ub},Ext}) when is_list(Ext) -> - {0,Buffer2} = getbit(Buffer), - decode_length(Buffer2, VR); - - -%When does this case occur with {_,_Lb,Ub} ?? -% X.691:10.9.3.5 -decode_length(Bin,{_,_Lb,_Ub}) -> %when Len =< 127 -> % Unconstrained or large Ub NOTE! this case does not cover case when Ub > 65535 - case Bin of - <<0:1,Val:7,Rest/bitstring>> -> - {Val,Rest}; - <<2:2,Val:14,Rest/bitstring>> -> - {Val,Rest}; - <<3:2,_:14,_Rest/bitstring>> -> - exit({error,{asn1,{decode_length,{nyi,length_above_64K}}}}) - end; -decode_length(Buffer,SingleValue) when is_integer(SingleValue) -> - {SingleValue,Buffer}. - - - % X.691:11 -encode_boolean(true) -> - <<1:1>>; -encode_boolean(false) -> - <<0:1>>; -encode_boolean({Name,Val}) when is_atom(Name) -> - encode_boolean(Val); -encode_boolean(Val) -> - exit({error,{asn1,{encode_boolean,Val}}}). - - -%%============================================================================ -%%============================================================================ -%% Bitstring value, ITU_T X.690 Chapter 8.5 -%%============================================================================ -%%============================================================================ - -%%============================================================================ -%% encode bitstring value -%%============================================================================ - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% bitstring NamedBitList -%% Val can be of: -%% - [identifiers] where only named identifers are set to one, -%% the Constraint must then have some information of the -%% bitlength. -%% - [list of ones and zeroes] all bits -%% - integer value representing the bitlist -%% C is constraint Len, only valid when identifiers - - -%% when the value is a list of {Unused,BinBits}, where -%% Unused = integer(), -%% BinBits = binary(). - -encode_bit_string(C,Bin={Unused,BinBits},NamedBitList) when is_integer(Unused), - is_binary(BinBits) -> - encode_bin_bit_string(get_constraint(C,'SizeConstraint'),Bin,NamedBitList); - -encode_bit_string(C, BitListVal, NamedBitList) -> - encode_bit_string1(get_constraint(C,'SizeConstraint'), BitListVal, NamedBitList). -%% when the value is a list of named bits -encode_bit_string1(C, LoNB=[FirstVal | _RestVal], NamedBitList) when is_atom(FirstVal) -> - ToSetPos = get_all_bitposes(LoNB, NamedBitList, []), - BitList = make_and_set_list(ToSetPos,0), - encode_bit_string1(C,BitList,NamedBitList); - -encode_bit_string1(C, BL=[{bit,_No} | _RestVal], NamedBitList) -> - ToSetPos = get_all_bitposes(BL, NamedBitList, []), - BitList = make_and_set_list(ToSetPos,0), - encode_bit_string1(C,BitList,NamedBitList); -%% when the value is a list of ones and zeroes -encode_bit_string1(Int, BitListValue, _) - when is_list(BitListValue),is_integer(Int) -> - %% The type is constrained by a single value size constraint - bit_list2bitstr(Int,BitListValue); -encode_bit_string1(no, BitListValue,[]) - when is_list(BitListValue) -> - Len = length(BitListValue), - [encode_length(undefined,Len),bit_list2bitstr(Len,BitListValue)]; -encode_bit_string1(C, BitListValue,[]) - when is_list(BitListValue) -> - Len = length(BitListValue), - [encode_length(C,Len),bit_list2bitstr(Len,BitListValue)]; -encode_bit_string1(no, BitListValue,_NamedBitList) - when is_list(BitListValue) -> - %% this case with an unconstrained BIT STRING can be made more efficient - %% if the complete driver can take a special code so the length field - %% is encoded there. - NewBitLVal = lists:reverse(lists:dropwhile(fun(0)->true;(1)->false end, - lists:reverse(BitListValue))), - Len = length(NewBitLVal), - [encode_length(undefined,Len),bit_list2bitstr(Len,NewBitLVal)]; -encode_bit_string1(C,BitListValue,_NamedBitList) - when is_list(BitListValue) ->% C = {_,'MAX'} - NewBitStr = bitstr_trailing_zeros(BitListValue,C), - [encode_length(C,bit_size(NewBitStr)),NewBitStr]; - - -%% when the value is an integer -encode_bit_string1(C, IntegerVal, NamedBitList) when is_integer(IntegerVal)-> - BitList = int_to_bitlist(IntegerVal), - encode_bit_string1(C,BitList,NamedBitList); - -%% when the value is a tuple -encode_bit_string1(C,{Name,Val}, NamedBitList) when is_atom(Name) -> - encode_bit_string1(C,Val,NamedBitList). - -bit_list2bitstr(Len,BitListValue) -> - case length(BitListValue) of - Len -> - << <<B:1>> ||B <- BitListValue>>; - L when L > Len -> % truncate - << << <<B:1>> ||B <- BitListValue>> :Len/bitstring>>; - L -> % Len > L -> pad - << << <<B:1>> ||B <- BitListValue>>/bitstring ,0:(Len-L)>> - end. - -adjust_trailing_zeros(Len,Bin) when Len == bit_size(Bin) -> - Bin; -adjust_trailing_zeros(Len,Bin) when Len > bit_size(Bin) -> - <<Bin/bitstring,0:(Len-bit_size(Bin))>>; -adjust_trailing_zeros(Len,Bin) -> - <<Bin:Len/bitstring>>. - -bitstr_trailing_zeros(BitList,C) when is_integer(C) -> - bitstr_trailing_zeros1(BitList,C,C); -bitstr_trailing_zeros(BitList,{Lb,Ub}) when is_integer(Lb) -> - bitstr_trailing_zeros1(BitList,Lb,Ub); -bitstr_trailing_zeros(BitList,{{Lb,Ub},_}) when is_integer(Lb) -> - bitstr_trailing_zeros1(BitList,Lb,Ub); -bitstr_trailing_zeros(BitList,_) -> - bit_list2bitstr(length(BitList),BitList). - -bitstr_trailing_zeros1(BitList,Lb,Ub) -> - case length(BitList) of - Lb -> bit_list2bitstr(Lb,BitList); - B when B<Lb -> bit_list2bitstr(Lb,BitList); - D -> F = fun(L,LB,LB,_,_)->bit_list2bitstr(LB,lists:reverse(L)); - ([0|R],L1,LB,UB,Fun)->Fun(R,L1-1,LB,UB,Fun); - (L,L1,_,UB,_)when L1 =< UB -> - bit_list2bitstr(L1,lists:reverse(L)); - (_,_L1,_,_,_) ->exit({error,{list_length_BIT_STRING, - BitList}}) end, - F(lists:reverse(BitList),D,Lb,Ub,F) - end. - -%% encode_bin_bit_string/3, when value is a tuple of Unused and BinBits. -%% Unused = integer(),i.e. number unused bits in least sign. byte of -%% BinBits = binary(). -encode_bin_bit_string(C,{_,BinBits},_NamedBitList) - when is_integer(C),C=<16 -> - adjust_trailing_zeros(C,BinBits); -encode_bin_bit_string(C,{_Unused,BinBits},_NamedBitList) - when is_integer(C) -> - adjust_trailing_zeros(C,BinBits); -encode_bin_bit_string(C,UnusedAndBin={_,_},NamedBitList) -> - %% removes all trailing bits if NamedBitList is not empty - BitStr = remove_trailing_bin(NamedBitList,UnusedAndBin), - case C of - {Lb,Ub} when is_integer(Lb),is_integer(Ub) -> - [encode_length({Lb,Ub},bit_size(BitStr)),BitStr]; - no -> - [encode_length(undefined,bit_size(BitStr)),BitStr]; - Sc -> - [encode_length(Sc,bit_size(BitStr)),BitStr] - end. - - -remove_trailing_bin([], {Unused,Bin}) -> - BS = bit_size(Bin)-Unused, - <<BitStr:BS/bitstring,_:Unused>> = Bin, - BitStr; -remove_trailing_bin(_NamedNumberList,{_Unused,<<>>}) -> - <<>>; -remove_trailing_bin(NamedNumberList, {_Unused,Bin}) -> - Size = size(Bin)-1, - <<Bfront:Size/binary, LastByte:8>> = Bin, - - %% clear the Unused bits to be sure - Unused1 = trailingZeroesInNibble(LastByte band 15), - Unused2 = - case Unused1 of - 4 -> - 4 + trailingZeroesInNibble(LastByte bsr 4); - _ -> Unused1 - end, - case Unused2 of - 8 -> - remove_trailing_bin(NamedNumberList,{0,Bfront}); - _ -> - BS = bit_size(Bin) - Unused2, - <<BitStr:BS/bitstring,_:Unused2>> = Bin, - BitStr - end. - -trailingZeroesInNibble(0) -> - 4; -trailingZeroesInNibble(1) -> - 0; -trailingZeroesInNibble(2) -> - 1; -trailingZeroesInNibble(3) -> - 0; -trailingZeroesInNibble(4) -> - 2; -trailingZeroesInNibble(5) -> - 0; -trailingZeroesInNibble(6) -> - 1; -trailingZeroesInNibble(7) -> - 0; -trailingZeroesInNibble(8) -> - 3; -trailingZeroesInNibble(9) -> - 0; -trailingZeroesInNibble(10) -> - 1; -trailingZeroesInNibble(11) -> - 0; -trailingZeroesInNibble(12) -> %#1100 - 2; -trailingZeroesInNibble(13) -> - 0; -trailingZeroesInNibble(14) -> - 1; -trailingZeroesInNibble(15) -> - 0. - -%%%%%%%%%%%%%%% -%% The result is presented as a list of named bits (if possible) -%% else as a tuple {Unused,Bits}. Unused is the number of unused -%% bits, least significant bits in the last byte of Bits. Bits is -%% the BIT STRING represented as a binary. -%% -decode_compact_bit_string(Buffer, C, NamedNumberList) -> - case get_constraint(C,'SizeConstraint') of - 0 -> % fixed length - {{8,0},Buffer}; - V when is_integer(V),V=<16 -> %fixed length 16 bits or less - compact_bit_string(Buffer,V,NamedNumberList); - V when is_integer(V),V=<65536 -> %fixed length > 16 bits - compact_bit_string(Buffer,V,NamedNumberList); - V when is_integer(V) -> % V > 65536 => fragmented value - {Bin,Buffer2} = decode_fragmented_bits(Buffer,V), - PadLen = (8 - (bit_size(Bin) rem 8)) rem 8, - {{PadLen,<<Bin/bitstring,0:PadLen>>},Buffer2}; -%% {0,_} -> {{0,Bin},Buffer2}; -%% {U,_} -> {{8-U,Bin},Buffer2} - {Lb,Ub} when is_integer(Lb),is_integer(Ub) -> - %% This case may demand decoding of fragmented length/value - {Len,Bytes2} = decode_length(Buffer,{Lb,Ub}), - compact_bit_string(Bytes2,Len,NamedNumberList); - no -> - %% This case may demand decoding of fragmented length/value - {Len,Bytes2} = decode_length(Buffer,undefined), - compact_bit_string(Bytes2,Len,NamedNumberList); - Sc -> - {Len,Bytes2} = decode_length(Buffer,Sc), - compact_bit_string(Bytes2,Len,NamedNumberList) - end. - - -%%%%%%%%%%%%%%% -%% The result is presented as a list of named bits (if possible) -%% else as a list of 0 and 1. -%% -decode_bit_string(Buffer, C, NamedNumberList) -> - case get_constraint(C,'SizeConstraint') of - {Lb,Ub} when is_integer(Lb),is_integer(Ub) -> - {Len,Bytes2} = decode_length(Buffer,{Lb,Ub}), - bit_list_or_named(Bytes2,Len,NamedNumberList); - no -> - {Len,Bytes2} = decode_length(Buffer,undefined), - bit_list_or_named(Bytes2,Len,NamedNumberList); - 0 -> % fixed length - {[],Buffer}; % nothing to encode - V when is_integer(V),V=<16 -> % fixed length 16 bits or less - bit_list_or_named(Buffer,V,NamedNumberList); - V when is_integer(V),V=<65536 -> - bit_list_or_named(Buffer,V,NamedNumberList); - V when is_integer(V) -> - {BinBits,_} = decode_fragmented_bits(Buffer,V), - bit_list_or_named(BinBits,V,NamedNumberList); - Sc -> % extension marker - {Len,Bytes2} = decode_length(Buffer,Sc), - bit_list_or_named(Bytes2,Len,NamedNumberList) - end. - - -%% if no named bits are declared we will return a -%% {Unused,Bits}. Unused = integer(), -%% Bits = binary(). -compact_bit_string(Buffer,Len,[]) -> - {BitStr,Rest} = getbits_as_binary(Len,Buffer), % {{Unused,BinBits},NewBuffer} - PadLen = (8 - (bit_size(BitStr) rem 8)) rem 8, - {{PadLen,<<BitStr/bitstring,0:PadLen>>},Rest}; -compact_bit_string(Buffer,Len,NamedNumberList) -> - bit_list_or_named(Buffer,Len,NamedNumberList). - - -%% if no named bits are declared we will return a -%% BitList = [0 | 1] - -bit_list_or_named(Buffer,Len,[]) -> - getbits_as_list(Len,Buffer); - -%% if there are named bits declared we will return a named -%% BitList where the names are atoms and unnamed bits represented -%% as {bit,Pos} -%% BitList = [atom() | {bit,Pos}] -%% Pos = integer() - -bit_list_or_named(Buffer,Len,NamedNumberList) -> - {BitList,Rest} = getbits_as_list(Len,Buffer), - {bit_list_or_named1(0,BitList,NamedNumberList,[]), Rest}. - -bit_list_or_named1(Pos,[0|Bt],Names,Acc) -> - bit_list_or_named1(Pos+1,Bt,Names,Acc); -bit_list_or_named1(Pos,[1|Bt],Names,Acc) -> - case lists:keysearch(Pos,2,Names) of - {value,{Name,_}} -> - bit_list_or_named1(Pos+1,Bt,Names,[Name|Acc]); - _ -> - bit_list_or_named1(Pos+1,Bt,Names,[{bit,Pos}|Acc]) - end; -bit_list_or_named1(_,[],_,Acc) -> - lists:reverse(Acc). - - - -%%%%%%%%%%%%%%% -%% - -int_to_bitlist(Int) when is_integer(Int), Int > 0 -> - [Int band 1 | int_to_bitlist(Int bsr 1)]; -int_to_bitlist(0) -> - []. - - -%%%%%%%%%%%%%%%%%% -%% get_all_bitposes([list of named bits to set], named_bit_db, []) -> -%% [sorted_list_of_bitpositions_to_set] - -get_all_bitposes([{bit,ValPos}|Rest], NamedBitList, Ack) -> - get_all_bitposes(Rest, NamedBitList, [ValPos | Ack ]); - -get_all_bitposes([Val | Rest], NamedBitList, Ack) -> - case lists:keysearch(Val, 1, NamedBitList) of - {value, {_ValName, ValPos}} -> - get_all_bitposes(Rest, NamedBitList, [ValPos | Ack]); - _ -> - exit({error,{asn1, {bitstring_namedbit, Val}}}) - end; -get_all_bitposes([], _NamedBitList, Ack) -> - lists:sort(Ack). - -%%%%%%%%%%%%%%%%%% -%% make_and_set_list([list of positions to set to 1])-> -%% returns list with all in SetPos set. -%% in positioning in list the first element is 0, the second 1 etc.., but -%% - -make_and_set_list([XPos|SetPos], XPos) -> - [1 | make_and_set_list(SetPos, XPos + 1)]; -make_and_set_list([Pos|SetPos], XPos) -> - [0 | make_and_set_list([Pos | SetPos], XPos + 1)]; -make_and_set_list([], _) -> - []. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% X.691:16 -%% encode_octet_string(Constraint,Val) -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -encode_octet_string(C,{_Name,Val}) -> - encode_octet_string(C,Val); -encode_octet_string(C,Val) -> - case get_constraint(C,'SizeConstraint') of - 0 -> - <<>>; - 1 -> - list_to_binary(Val); - 2 -> - list_to_binary(Val); - {_,_}=VR -> - try - [encode_length(VR, length(Val)),list_to_binary(Val)] - catch - error:{error,{asn1,{encode_length,_}}} -> - 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; - no -> - try - [encode_length(undefined, length(Val)),list_to_binary(Val)] - catch - error:{error,{asn1,{encode_length,_}}} -> - encode_fragmented_octet_string(Val) - end - end. - -encode_fragmented_octet_string(Val) -> - Bin = list_to_binary(Val), - efos_1(Bin). - -efos_1(<<B:16#10000/binary,T/binary>>) -> - [<<3:2,4:6>>,B|efos_1(T)]; -efos_1(<<B:16#C000/binary,T/binary>>) -> - [<<3:2,3:6>>,B|efos_1(T)]; -efos_1(<<B:16#8000/binary,T/binary>>) -> - [<<3:2,2:6>>,B|efos_1(T)]; -efos_1(<<B:16#4000/binary,T/binary>>) -> - [<<3:2,1:6>>,B|efos_1(T)]; -efos_1(<<B/bitstring>>) -> - Len = byte_size(B), - [encode_length(undefined, Len),B]. - -decode_fragmented(SegSz0, Buf0, Unit) -> - SegSz = SegSz0 * Unit * ?'16K', - <<Res:SegSz/bitstring,Buf/bitstring>> = Buf0, - decode_fragmented_1(Buf, Unit, Res). - -decode_fragmented_1(<<0:1,N:7,Buf0/bitstring>>, Unit, Res) -> - Sz = N*Unit, - <<S:Sz/bitstring,Buf/bitstring>> = Buf0, - {<<Res/bitstring,S/bitstring>>,Buf}; -decode_fragmented_1(<<1:1,0:1,N:14,Buf0/bitstring>>, Unit, Res) -> - Sz = N*Unit, - <<S:Sz/bitstring,Buf/bitstring>> = Buf0, - {<<Res/bitstring,S/bitstring>>,Buf}; -decode_fragmented_1(<<1:1,1:1,SegSz0:6,Buf0/bitstring>>, Unit, Res0) -> - SegSz = SegSz0 * Unit * ?'16K', - <<Frag:SegSz/bitstring,Buf/bitstring>> = Buf0, - Res = <<Res0/bitstring,Frag/bitstring>>, - decode_fragmented_1(Buf, Unit, Res). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Restricted char string types -%% (NumericString, PrintableString,VisibleString,IA5String,BMPString,UniversalString) -%% X.691:26 and X.680:34-36 -%%encode_restricted_string('BMPString',Constraints,Extension,Val) - - -encode_restricted_string({Name,Val}) when is_atom(Name) -> - encode_restricted_string(Val); - -encode_restricted_string(Val) when is_list(Val)-> - [encode_length(undefined,length(Val)),list_to_binary(Val)]. - -encode_known_multiplier_string(StringType,C,{Name,Val}) when is_atom(Name) -> - encode_known_multiplier_string(StringType,C,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 - 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]; - no -> - [encode_length(undefined,length(Val)),Result] - end. - -decode_restricted_string(Bytes) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - getoctets_as_list(Bytes2,Len). - -decode_known_multiplier_string(Bytes,StringType,C,_Ext) -> - NumBits = get_NumBits(C,StringType), - case get_constraint(C,'SizeConstraint') of - Ub when is_integer(Ub), Ub*NumBits =< 16 -> - chars_decode(Bytes,NumBits,StringType,C,Ub); - Ub when is_integer(Ub),Ub =<65535 -> % fixed length - chars_decode(Bytes,NumBits,StringType,C,Ub); - 0 -> - {[],Bytes}; - Vl when is_list(Vl) -> - {Len,Bytes1} = decode_length(Bytes,{hd(Vl),lists:max(Vl)}), - chars_decode(Bytes1,NumBits,StringType,C,Len); - no -> - {Len,Bytes1} = decode_length(Bytes,undefined), - chars_decode(Bytes1,NumBits,StringType,C,Len); - {Lb,Ub}-> - {Len,Bytes1} = decode_length(Bytes,{Lb,Ub}), - chars_decode(Bytes1,NumBits,StringType,C,Len) - end. - - -encode_NumericString(C,Val) -> - encode_known_multiplier_string('NumericString',C,Val). -decode_NumericString(Bytes,C) -> - decode_known_multiplier_string(Bytes,'NumericString',C,false). - -encode_PrintableString(C,Val) -> - encode_known_multiplier_string('PrintableString',C,Val). -decode_PrintableString(Bytes,C) -> - decode_known_multiplier_string(Bytes,'PrintableString',C,false). - -encode_VisibleString(C,Val) -> % equivalent with ISO646String - encode_known_multiplier_string('VisibleString',C,Val). -decode_VisibleString(Bytes,C) -> - decode_known_multiplier_string(Bytes,'VisibleString',C,false). - -encode_IA5String(C,Val) -> - encode_known_multiplier_string('IA5String',C,Val). -decode_IA5String(Bytes,C) -> - decode_known_multiplier_string(Bytes,'IA5String',C,false). - -encode_BMPString(C,Val) -> - encode_known_multiplier_string('BMPString',C,Val). -decode_BMPString(Bytes,C) -> - decode_known_multiplier_string(Bytes,'BMPString',C,false). - -encode_UniversalString(C,Val) -> - encode_known_multiplier_string('UniversalString',C,Val). -decode_UniversalString(Bytes,C) -> - decode_known_multiplier_string(Bytes,'UniversalString',C,false). - - -%% end of known-multiplier strings for which PER visible constraints are -%% applied - -encode_GeneralString(_C,Val) -> - encode_restricted_string(Val). -decode_GeneralString(Bytes,_C) -> - decode_restricted_string(Bytes). - -encode_GraphicString(_C,Val) -> - encode_restricted_string(Val). -decode_GraphicString(Bytes,_C) -> - decode_restricted_string(Bytes). - -encode_ObjectDescriptor(_C,Val) -> - encode_restricted_string(Val). -decode_ObjectDescriptor(Bytes) -> - decode_restricted_string(Bytes). - -encode_TeletexString(_C,Val) -> % equivalent with T61String - encode_restricted_string(Val). -decode_TeletexString(Bytes,_C) -> - decode_restricted_string(Bytes). - -encode_VideotexString(_C,Val) -> - encode_restricted_string(Val). -decode_VideotexString(Bytes,_C) -> - decode_restricted_string(Bytes). - - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% getBMPChars(Bytes,Len) ->{BMPcharList,RemainingBytes} -%% -getBMPChars(Bytes,1) -> - {O1,Bytes2} = getbits(Bytes,8), - {O2,Bytes3} = getbits(Bytes2,8), - if - O1 == 0 -> - {[O2],Bytes3}; - true -> - {[{0,0,O1,O2}],Bytes3} - end; -getBMPChars(Bytes,Len) -> - getBMPChars(Bytes,Len,[]). - -getBMPChars(Bytes,0,Acc) -> - {lists:reverse(Acc),Bytes}; -getBMPChars(Bytes,Len,Acc) -> - {Octs,Bytes1} = getoctets_as_list(Bytes,2), - case Octs of - [0,O2] -> - getBMPChars(Bytes1,Len-1,[O2|Acc]); - [O1,O2]-> - getBMPChars(Bytes1,Len-1,[{0,0,O1,O2}|Acc]) - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% chars_encode(C,StringType,Value) -> ValueList -%% -%% encodes chars according to the per rules taking the constraint PermittedAlphabet -%% 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 - {'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)}, - chars_encode2(Value,NumBits,CharOutTab) - end. - -chars_encode2([H|T],NumBits,{Min,Max,notab}) when H =< Max, H >= Min -> - %%[{bits,NumBits,H-Min}|chars_encode2(T,NumBits,{Min,Max,notab})]; - [<<(H-Min):NumBits>>|chars_encode2(T,NumBits,{Min,Max,notab})]; -chars_encode2([H|T],NumBits,{Min,Max,Tab}) when H =< Max, H >= Min -> -%% [{bits,NumBits,exit_if_false(H,element(H-Min+1,Tab))}|chars_encode2(T,NumBits,{Min,Max,Tab})]; - Ch = exit_if_false(H,element(H-Min+1,Tab)), - [<<Ch:NumBits>>|chars_encode2(T,NumBits,{Min,Max,Tab})]; -chars_encode2([{A,B,C,D}|T],NumBits,{Min,Max,notab}) -> - %% no value range check here (ought to be, but very expensive) -%% [{bits,NumBits,((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min}|chars_encode2(T,NumBits,{Min,Max,notab})]; - Ch = ((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min, - [<<Ch:NumBits>>|chars_encode2(T,NumBits,{Min,Max,notab})]; -chars_encode2([{A,B,C,D}|T],NumBits,{Min,Max,Tab}) -> - %% no value range check here (ought to be, but very expensive) -%% [{bits,NumBits,exit_if_false({A,B,C,D},element(((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min,Tab))}|chars_encode2(T,NumBits,{Min,Max,notab})]; - Ch = exit_if_false({A,B,C,D},element(((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min,Tab)), - [<<Ch:NumBits>>|chars_encode2(T,NumBits,{Min,Max,notab})]; -chars_encode2([H|_T],_,{_,_,_}) -> - exit({error,{asn1,{illegal_char_value,H}}}); -chars_encode2([],_,_) -> - []. - -exit_if_false(V,false)-> - exit({error,{asn1,{"illegal value according to Permitted alphabet constraint",V}}}); -exit_if_false(_,V) ->V. - - -get_NumBits(C,StringType) -> - case get_constraint(C,'PermittedAlphabet') of - {'SingleValue',Sv} -> - charbits(length(Sv)); - no -> - case StringType of - 'IA5String' -> - charbits(128); % 16#00..16#7F - 'VisibleString' -> - charbits(95); % 16#20..16#7E - 'PrintableString' -> - charbits(74); % [$\s,$',$(,$),$+,$,,$-,$.,$/,"0123456789",$:,$=,$?,$A..$Z,$a..$z - 'NumericString' -> - charbits(11); % $ ,"0123456789" - 'UniversalString' -> - 32; - 'BMPString' -> - 16 - end - end. - -get_CharOutTab(C,StringType) -> - get_CharTab(C,StringType,out). - -get_CharInTab(C,StringType) -> - get_CharTab(C,StringType,in). - -get_CharTab(C,StringType,InOut) -> - case get_constraint(C,'PermittedAlphabet') of - {'SingleValue',Sv} -> - get_CharTab2(C,StringType,hd(Sv),lists:max(Sv),Sv,InOut); - no -> - case StringType of - 'IA5String' -> - {0,16#7F,notab}; - 'VisibleString' -> - get_CharTab2(C,StringType,16#20,16#7F,notab,InOut); - 'PrintableString' -> - Chars = lists:sort( - " '()+,-./0123456789:=?ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"), - get_CharTab2(C,StringType,hd(Chars),lists:max(Chars),Chars,InOut); - 'NumericString' -> - get_CharTab2(C,StringType,16#20,$9," 0123456789",InOut); - 'UniversalString' -> - {0,16#FFFFFFFF,notab}; - 'BMPString' -> - {0,16#FFFF,notab} - end - end. - -get_CharTab2(C,StringType,Min,Max,Chars,InOut) -> - BitValMax = (1 bsl get_NumBits(C,StringType))-1, - if - Max =< BitValMax -> - {0,Max,notab}; - true -> - case InOut of - out -> - {Min,Max,create_char_tab(Min,Chars)}; - in -> - {Min,Max,list_to_tuple(Chars)} - end - end. - -create_char_tab(Min,L) -> - list_to_tuple(create_char_tab(Min,L,0)). -create_char_tab(Min,[Min|T],V) -> - [V|create_char_tab(Min+1,T,V+1)]; -create_char_tab(_Min,[],_V) -> - []; -create_char_tab(Min,L,V) -> - [false|create_char_tab(Min+1,L,V)]. - -%% See Table 20.3 in Dubuisson -charbits(NumOfChars) when NumOfChars =< 2 -> 1; -charbits(NumOfChars) when NumOfChars =< 4 -> 2; -charbits(NumOfChars) when NumOfChars =< 8 -> 3; -charbits(NumOfChars) when NumOfChars =< 16 -> 4; -charbits(NumOfChars) when NumOfChars =< 32 -> 5; -charbits(NumOfChars) when NumOfChars =< 64 -> 6; -charbits(NumOfChars) when NumOfChars =< 128 -> 7; -charbits(NumOfChars) when NumOfChars =< 256 -> 8; -charbits(NumOfChars) when NumOfChars =< 512 -> 9; -charbits(NumOfChars) when NumOfChars =< 1024 -> 10; -charbits(NumOfChars) when NumOfChars =< 2048 -> 11; -charbits(NumOfChars) when NumOfChars =< 4096 -> 12; -charbits(NumOfChars) when NumOfChars =< 8192 -> 13; -charbits(NumOfChars) when NumOfChars =< 16384 -> 14; -charbits(NumOfChars) when NumOfChars =< 32768 -> 15; -charbits(NumOfChars) when NumOfChars =< 65536 -> 16; -charbits(NumOfChars) when is_integer(NumOfChars) -> - 16 + charbits1(NumOfChars bsr 16). - -charbits1(0) -> - 0; -charbits1(NumOfChars) -> - 1 + charbits1(NumOfChars bsr 1). - - -chars_decode(Bytes,_,'BMPString',C,Len) -> - case get_constraint(C,'PermittedAlphabet') of - no -> - getBMPChars(Bytes,Len); - _ -> - exit({error,{asn1, - {'not implemented', - "BMPString with PermittedAlphabet constraint"}}}) - end; -chars_decode(Bytes,NumBits,StringType,C,Len) -> - CharInTab = get_CharInTab(C,StringType), - chars_decode2(Bytes,CharInTab,NumBits,Len). - - -chars_decode2(Bytes,CharInTab,NumBits,Len) -> - chars_decode2(Bytes,CharInTab,NumBits,Len,[]). - -chars_decode2(Bytes,_CharInTab,_NumBits,0,Acc) -> - {lists:reverse(Acc),Bytes}; -chars_decode2(Bytes,{Min,Max,notab},NumBits,Len,Acc) when NumBits > 8 -> - {Char,Bytes2} = getbits(Bytes,NumBits), - Result = - if - Char < 256 -> Char; - true -> - list_to_tuple(binary_to_list(<<Char:32>>)) - end, - chars_decode2(Bytes2,{Min,Max,notab},NumBits,Len -1,[Result|Acc]); -chars_decode2(Bytes,{Min,Max,notab},NumBits,Len,Acc) -> - {Char,Bytes2} = getbits(Bytes,NumBits), - chars_decode2(Bytes2,{Min,Max,notab},NumBits,Len -1,[Char+Min|Acc]); - -%% BMPString and UniversalString with PermittedAlphabet is currently not supported -chars_decode2(Bytes,{Min,Max,CharInTab},NumBits,Len,Acc) -> - {Char,Bytes2} = getbits(Bytes,NumBits), - chars_decode2(Bytes2,{Min,Max,CharInTab},NumBits,Len -1,[element(Char+1,CharInTab)|Acc]). - - -%% UTF8String -encode_UTF8String(Val) when is_binary(Val) -> - [encode_length(undefined,size(Val)),Val]; -encode_UTF8String(Val) -> - Bin = list_to_binary(Val), - encode_UTF8String(Bin). - -decode_UTF8String(Bytes) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - getoctets_as_bin(Bytes2,Len). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_object_identifier(Val) -> CompleteList -%% encode_object_identifier({Name,Val}) -> CompleteList -%% Val -> {Int1,Int2,...,IntN} % N >= 2 -%% Name -> atom() -%% Int1 -> integer(0..2) -%% Int2 -> integer(0..39) when Int1 (0..1) else integer() -%% Int3-N -> integer() -%% CompleteList -> [binary()|bitstring()|list()] -%% -encode_object_identifier({Name,Val}) when is_atom(Name) -> - encode_object_identifier(Val); -encode_object_identifier(Val) -> - OctetList = e_object_identifier(Val), - Octets = list_to_binary(OctetList), % performs a flatten at the same time - [encode_length(undefined,size(Octets)),Octets]. - -%% This code is copied from asn1_encode.erl (BER) and corrected and modified - -e_object_identifier({'OBJECT IDENTIFIER',V}) -> - e_object_identifier(V); -e_object_identifier({Cname,V}) when is_atom(Cname),is_tuple(V) -> - e_object_identifier(tuple_to_list(V)); -e_object_identifier({Cname,V}) when is_atom(Cname),is_list(V) -> - e_object_identifier(V); -e_object_identifier(V) when is_tuple(V) -> - e_object_identifier(tuple_to_list(V)); - -%% E1 = 0|1|2 and (E2 < 40 when E1 = 0|1) -e_object_identifier([E1,E2|Tail]) when E1 >= 0, E1 < 2, E2 < 40 ; E1==2 -> - Head = 40*E1 + E2, % weird - e_object_elements([Head|Tail],[]); -e_object_identifier(Oid=[_,_|_Tail]) -> - exit({error,{asn1,{'illegal_value',Oid}}}). - -e_object_elements([],Acc) -> - lists:reverse(Acc); -e_object_elements([H|T],Acc) -> - e_object_elements(T,[e_object_element(H)|Acc]). - -e_object_element(Num) when Num < 128 -> - [Num]; -e_object_element(Num) -> - [e_o_e(Num bsr 7)|[Num band 2#1111111]]. -e_o_e(Num) when Num < 128 -> - Num bor 2#10000000; -e_o_e(Num) -> - [e_o_e(Num bsr 7)|[(Num band 2#1111111) bor 2#10000000]]. - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_object_identifier(Bytes) -> {ObjId,RemainingBytes} -%% ObjId -> {integer(),integer(),...} % at least 2 integers -%% RemainingBytes -> [integer()] when integer() (0..255) -decode_object_identifier(Bytes) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), - [First|Rest] = dec_subidentifiers(Octs,0,[]), - Idlist = if - First < 40 -> - [0,First|Rest]; - First < 80 -> - [1,First - 40|Rest]; - true -> - [2,First - 80|Rest] - end, - {list_to_tuple(Idlist),Bytes3}. - -dec_subidentifiers([H|T],Av,Al) when H >=16#80 -> - dec_subidentifiers(T,(Av bsl 7) + (H band 16#7F),Al); -dec_subidentifiers([H|T],Av,Al) -> - dec_subidentifiers(T,0,[(Av bsl 7) + H |Al]); -dec_subidentifiers([],_Av,Al) -> - lists:reverse(Al). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_relative_oid(Val) -> CompleteList -%% encode_relative_oid({Name,Val}) -> CompleteList -encode_relative_oid({Name,Val}) when is_atom(Name) -> - encode_relative_oid(Val); -encode_relative_oid(Val) when is_tuple(Val) -> - encode_relative_oid(tuple_to_list(Val)); -encode_relative_oid(Val) when is_list(Val) -> - Octets = list_to_binary([e_object_element(X)||X <- Val]), - [encode_length(undefined,size(Octets)),Octets]. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_relative_oid(Val) -> CompleteList -%% decode_relative_oid({Name,Val}) -> CompleteList -decode_relative_oid(Bytes) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), - ObjVals = dec_subidentifiers(Octs,0,[]), - {list_to_tuple(ObjVals),Bytes3}. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_real(Val) -> CompleteList -%% encode_real({Name,Val}) -> CompleteList -encode_real({Name,Val}) when is_atom(Name) -> - encode_real(Val); -encode_real(Real) -> - {EncVal,Len} = ?RT_COMMON:encode_real([],Real), - [encode_length(undefined,Len),EncVal]. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_real(Val) -> {REALvalue,Rest} -%% decode_real({Name,Val}) -> {REALvalue,Rest} -decode_real(Bytes) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - <<Bytes3:Len/binary,Rest/bitstring>> = Bytes2, - {RealVal,Rest,Len} = ?RT_COMMON:decode_real(Bytes3,Len), - {RealVal,Rest}. - - -get_constraint([{Key,V}],Key) -> - V; -get_constraint([],_Key) -> - no; -get_constraint(C,Key) -> - case lists:keysearch(Key,1,C) of - false -> - no; - {value,{_,V}} -> - V - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% complete(InList) -> ByteList -%% Takes a coded list with bits and bytes and converts it to a list of bytes -%% Should be applied as the last step at encode of a complete ASN.1 type -%% -complete(InList) when is_list(InList) -> - case complete1(InList) of - <<>> -> - <<0>>; - Res -> - case bit_size(Res) band 7 of - 0 -> Res; - Bits -> <<Res/bitstring,0:(8-Bits)>> - end - end; -complete(InList) when is_binary(InList) -> - InList; -complete(InList) when is_bitstring(InList) -> - PadLen = 8 - (bit_size(InList) band 7), - <<InList/bitstring,0:PadLen>>. - -complete1(L) when is_list(L) -> - list_to_bitstring(L). - -%% Special version of complete that does not align the completed message. -complete_NFP(InList) when is_list(InList) -> - list_to_bitstring(InList); -complete_NFP(InList) when is_bitstring(InList) -> - InList. - -%% unaligned helpers - -%% 10.5.6 NOTE: If "range" satisfies the inequality 2^m < "range" =< -%% 2^(m+1) then the number of bits = m + 1 - -num_bits(N) -> - num_bits(N,1,0). -num_bits(N,T,B) when N=<T->B; -num_bits(N,T,B) ->num_bits(N,T bsl 1, B+1). diff --git a/lib/asn1/src/asn1rtt_ber.erl b/lib/asn1/src/asn1rtt_ber.erl new file mode 100644 index 0000000000..889a421e4f --- /dev/null +++ b/lib/asn1/src/asn1rtt_ber.erl @@ -0,0 +1,1561 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(asn1rtt_ber). + +%% encoding / decoding of BER + +-export([ber_decode_nif/1,ber_decode_erlang/1,match_tags/2,ber_encode/1]). +-export([encode_tags/2, + encode_tags/3, + skip_ExtensionAdditions/2]). +-export([encode_boolean/2,decode_boolean/2, + encode_integer/2,encode_integer/3, + decode_integer/3,decode_integer/4, + encode_enumerated/2,decode_enumerated/3, + encode_bit_string/4, + decode_named_bit_string/3, + decode_compact_bit_string/3, + decode_legacy_bit_string/3, + decode_native_bit_string/3, + encode_null/2,decode_null/2, + encode_relative_oid/2,decode_relative_oid/2, + encode_object_identifier/2,decode_object_identifier/2, + encode_restricted_string/2, + 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]). + +-export([encode_open_type/2,decode_open_type/2, + decode_open_type_as_binary/2]). + +-export([decode_primitive_incomplete/2,decode_selective/2]). + +%% For DER. +-export([dynamicsort_SET_components/1,dynamicsort_SETOF/1]). + +%% the encoding of class of tag bits 8 and 7 +-define(UNIVERSAL, 0). +-define(APPLICATION, 16#40). +-define(CONTEXT, 16#80). +-define(PRIVATE, 16#C0). + +%%% primitive or constructed encoding % bit 6 +-define(PRIMITIVE, 0). +-define(CONSTRUCTED, 2#00100000). + +%%% The tag-number for universal types +-define(N_BOOLEAN, 1). +-define(N_INTEGER, 2). +-define(N_BIT_STRING, 3). +-define(N_OCTET_STRING, 4). +-define(N_NULL, 5). +-define(N_OBJECT_IDENTIFIER, 6). +-define(N_OBJECT_DESCRIPTOR, 7). +-define(N_EXTERNAL, 8). +-define(N_REAL, 9). +-define(N_ENUMERATED, 10). +-define(N_EMBEDDED_PDV, 11). +-define(N_SEQUENCE, 16). +-define(N_SET, 17). +-define(N_NumericString, 18). +-define(N_PrintableString, 19). +-define(N_TeletexString, 20). +-define(N_VideotexString, 21). +-define(N_IA5String, 22). +-define(N_UTCTime, 23). +-define(N_GeneralizedTime, 24). +-define(N_GraphicString, 25). +-define(N_VisibleString, 26). +-define(N_GeneralString, 27). +-define(N_UniversalString, 28). +-define(N_BMPString, 30). + + +% the complete tag-word of built-in types +-define(T_BOOLEAN, ?UNIVERSAL bor ?PRIMITIVE bor 1). +-define(T_INTEGER, ?UNIVERSAL bor ?PRIMITIVE bor 2). +-define(T_BIT_STRING, ?UNIVERSAL bor ?PRIMITIVE bor 3). % can be CONSTRUCTED +-define(T_OCTET_STRING, ?UNIVERSAL bor ?PRIMITIVE bor 4). % can be CONSTRUCTED +-define(T_NULL, ?UNIVERSAL bor ?PRIMITIVE bor 5). +-define(T_OBJECT_IDENTIFIER,?UNIVERSAL bor ?PRIMITIVE bor 6). +-define(T_OBJECT_DESCRIPTOR,?UNIVERSAL bor ?PRIMITIVE bor 7). +-define(T_EXTERNAL, ?UNIVERSAL bor ?PRIMITIVE bor 8). +-define(T_REAL, ?UNIVERSAL bor ?PRIMITIVE bor 9). +-define(T_ENUMERATED, ?UNIVERSAL bor ?PRIMITIVE bor 10). +-define(T_EMBEDDED_PDV, ?UNIVERSAL bor ?PRIMITIVE bor 11). +-define(T_SEQUENCE, ?UNIVERSAL bor ?CONSTRUCTED bor 16). +-define(T_SET, ?UNIVERSAL bor ?CONSTRUCTED bor 17). +-define(T_NumericString, ?UNIVERSAL bor ?PRIMITIVE bor 18). %can be constructed +-define(T_PrintableString, ?UNIVERSAL bor ?PRIMITIVE bor 19). %can be constructed +-define(T_TeletexString, ?UNIVERSAL bor ?PRIMITIVE bor 20). %can be constructed +-define(T_VideotexString, ?UNIVERSAL bor ?PRIMITIVE bor 21). %can be constructed +-define(T_IA5String, ?UNIVERSAL bor ?PRIMITIVE bor 22). %can be constructed +-define(T_UTCTime, ?UNIVERSAL bor ?PRIMITIVE bor 23). +-define(T_GeneralizedTime, ?UNIVERSAL bor ?PRIMITIVE bor 24). +-define(T_GraphicString, ?UNIVERSAL bor ?PRIMITIVE bor 25). %can be constructed +-define(T_VisibleString, ?UNIVERSAL bor ?PRIMITIVE bor 26). %can be constructed +-define(T_GeneralString, ?UNIVERSAL bor ?PRIMITIVE bor 27). %can be constructed +-define(T_UniversalString, ?UNIVERSAL bor ?PRIMITIVE bor 28). %can be constructed +-define(T_BMPString, ?UNIVERSAL bor ?PRIMITIVE bor 30). %can be constructed + +ber_encode([Tlv]) -> + ber_encode(Tlv); +ber_encode(Tlv) when is_binary(Tlv) -> + Tlv; +ber_encode(Tlv) -> + asn1rt_nif:encode_ber_tlv(Tlv). + +ber_decode_nif(B) -> + asn1rt_nif:decode_ber_tlv(B). + +ber_decode_erlang(B) when is_binary(B) -> + decode_primitive(B); +ber_decode_erlang(Tlv) -> + {Tlv,<<>>}. + +decode_primitive(Bin) -> + {Form,TagNo,V,Rest} = decode_tag_and_length(Bin), + case Form of + 1 -> % constructed + {{TagNo,decode_constructed(V)},Rest}; + 0 -> % primitive + {{TagNo,V},Rest}; + 2 -> % constructed indefinite + {Vlist,Rest2} = decode_constructed_indefinite(V,[]), + {{TagNo,Vlist},Rest2} + end. + +decode_constructed(Bin) when byte_size(Bin) =:= 0 -> + []; +decode_constructed(Bin) -> + {Tlv,Rest} = decode_primitive(Bin), + [Tlv|decode_constructed(Rest)]. + +decode_constructed_indefinite(<<0,0,Rest/binary>>,Acc) -> + {lists:reverse(Acc),Rest}; +decode_constructed_indefinite(Bin,Acc) -> + {Tlv,Rest} = decode_primitive(Bin), + decode_constructed_indefinite(Rest, [Tlv|Acc]). + +%% decode_primitive_incomplete/2 decodes an encoded message incomplete +%% by help of the pattern attribute (first argument). +decode_primitive_incomplete([[default,TagNo]],Bin) -> %default + case decode_tag_and_length(Bin) of + {Form,TagNo,V,Rest} -> + decode_incomplete2(Form,TagNo,V,[],Rest); + _ -> + %{asn1_DEFAULT,Bin} + asn1_NOVALUE + end; +decode_primitive_incomplete([[default,TagNo,Directives]],Bin) -> %default, constructed type, Directives points into this type + case decode_tag_and_length(Bin) of + {Form,TagNo,V,Rest} -> + decode_incomplete2(Form,TagNo,V,Directives,Rest); + _ -> + %{asn1_DEFAULT,Bin} + asn1_NOVALUE + end; +decode_primitive_incomplete([[opt,TagNo]],Bin) -> %optional + case decode_tag_and_length(Bin) of + {Form,TagNo,V,Rest} -> + decode_incomplete2(Form,TagNo,V,[],Rest); + _ -> + %{{TagNo,asn1_NOVALUE},Bin} + asn1_NOVALUE + end; +decode_primitive_incomplete([[opt,TagNo,Directives]],Bin) -> %optional + case decode_tag_and_length(Bin) of + {Form,TagNo,V,Rest} -> + decode_incomplete2(Form,TagNo,V,Directives,Rest); + _ -> + %{{TagNo,asn1_NOVALUE},Bin} + asn1_NOVALUE + end; +%% An optional that shall be undecoded +decode_primitive_incomplete([[opt_undec,Tag]],Bin) -> + case decode_tag_and_length(Bin) of + {_,Tag,_,_} -> + decode_incomplete_bin(Bin); + _ -> + asn1_NOVALUE + end; +%% A choice alternative that shall be undecoded +decode_primitive_incomplete([[alt_undec,TagNo]|RestAlts],Bin) -> + case decode_tag_and_length(Bin) of + {_,TagNo,_,_} -> + decode_incomplete_bin(Bin); + _ -> + decode_primitive_incomplete(RestAlts,Bin) + end; +decode_primitive_incomplete([[alt,TagNo]|RestAlts],Bin) -> + case decode_tag_and_length(Bin) of + {_Form,TagNo,V,Rest} -> + {{TagNo,V},Rest}; + _ -> + decode_primitive_incomplete(RestAlts,Bin) + end; +decode_primitive_incomplete([[alt,TagNo,Directives]|RestAlts],Bin) -> + case decode_tag_and_length(Bin) of + {Form,TagNo,V,Rest} -> + decode_incomplete2(Form,TagNo,V,Directives,Rest); + _ -> + decode_primitive_incomplete(RestAlts,Bin) + end; +decode_primitive_incomplete([[alt_parts,TagNo]],Bin) -> + case decode_tag_and_length(Bin) of + {_Form,TagNo,V,Rest} -> + {{TagNo,V},Rest}; + _ -> + asn1_NOVALUE + end; +decode_primitive_incomplete([[alt_parts,TagNo]|RestAlts],Bin) -> + case decode_tag_and_length(Bin) of + {_Form,TagNo,V,Rest} -> + {{TagNo,decode_parts_incomplete(V)},Rest}; + _ -> + decode_primitive_incomplete(RestAlts,Bin) + end; +decode_primitive_incomplete([[undec,_TagNo]|_RestTag],Bin) -> %incomlete decode + decode_incomplete_bin(Bin); +decode_primitive_incomplete([[parts,TagNo]|_RestTag],Bin) -> + case decode_tag_and_length(Bin) of + {_Form,TagNo,V,Rest} -> + {{TagNo,decode_parts_incomplete(V)},Rest}; + Err -> + {error,{asn1,"tag failure",TagNo,Err}} + end; +decode_primitive_incomplete([mandatory|RestTag],Bin) -> + {Form,TagNo,V,Rest} = decode_tag_and_length(Bin), + decode_incomplete2(Form,TagNo,V,RestTag,Rest); +%% A choice that is a toptype or a mandatory component of a +%% SEQUENCE or SET. +decode_primitive_incomplete([[mandatory|Directives]],Bin) -> + {Form,TagNo,V,Rest} = decode_tag_and_length(Bin), + decode_incomplete2(Form,TagNo,V,Directives,Rest); +decode_primitive_incomplete([],Bin) -> + decode_primitive(Bin). + +%% decode_parts_incomplete/1 receives a number of values encoded in +%% sequence and returns the parts as unencoded binaries +decode_parts_incomplete(<<>>) -> + []; +decode_parts_incomplete(Bin) -> + {ok,Rest} = skip_tag(Bin), + {ok,Rest2} = skip_length_and_value(Rest), + LenPart = byte_size(Bin) - byte_size(Rest2), + <<Part:LenPart/binary,RestBin/binary>> = Bin, + [Part|decode_parts_incomplete(RestBin)]. + + +%% decode_incomplete2 checks if V is a value of a constructed or +%% primitive type, and continues the decode propeerly. +decode_incomplete2(_Form=2,TagNo,V,TagMatch,_) -> + %% constructed indefinite length + {Vlist,Rest2} = decode_constr_indef_incomplete(TagMatch,V,[]), + {{TagNo,Vlist},Rest2}; +decode_incomplete2(1,TagNo,V,[TagMatch],Rest) when is_list(TagMatch) -> + {{TagNo,decode_constructed_incomplete(TagMatch,V)},Rest}; +decode_incomplete2(1,TagNo,V,TagMatch,Rest) -> + {{TagNo,decode_constructed_incomplete(TagMatch,V)},Rest}; +decode_incomplete2(0,TagNo,V,_TagMatch,Rest) -> + {{TagNo,V},Rest}. + +decode_constructed_incomplete([Tags=[Ts]],Bin) when is_list(Ts) -> + decode_constructed_incomplete(Tags,Bin); +decode_constructed_incomplete(_TagMatch,<<>>) -> + []; +decode_constructed_incomplete([mandatory|RestTag],Bin) -> + {Tlv,Rest} = decode_primitive(Bin), + [Tlv|decode_constructed_incomplete(RestTag,Rest)]; +decode_constructed_incomplete(Directives=[[Alt,_]|_],Bin) + when Alt =:= alt_undec; Alt =:= alt; Alt =:= alt_parts -> + {_Form,TagNo,V,Rest} = decode_tag_and_length(Bin), + case incomplete_choice_alt(TagNo, Directives) of + {alt_undec,_} -> + LenA = byte_size(Bin) - byte_size(Rest), + <<A:LenA/binary,Rest/binary>> = Bin, + A; + {alt,InnerDirectives} -> + {Tlv,Rest} = decode_primitive_incomplete(InnerDirectives,V), + {TagNo,Tlv}; + {alt_parts,_} -> + [{TagNo,decode_parts_incomplete(V)}]; + no_match -> %% if a choice alternative was encoded that + %% was not specified in the config file, + %% thus decode component anonomous. + {Tlv,_}=decode_primitive(Bin), + Tlv + end; +decode_constructed_incomplete([TagNo|RestTag],Bin) -> + case decode_primitive_incomplete([TagNo],Bin) of + {Tlv,Rest} -> + [Tlv|decode_constructed_incomplete(RestTag,Rest)]; + asn1_NOVALUE -> + decode_constructed_incomplete(RestTag,Bin) + end; +decode_constructed_incomplete([],Bin) -> + {Tlv,Rest}=decode_primitive(Bin), + [Tlv|decode_constructed_incomplete([],Rest)]. + +decode_constr_indef_incomplete(_TagMatch,<<0,0,Rest/binary>>,Acc) -> + {lists:reverse(Acc),Rest}; +decode_constr_indef_incomplete([Tag|RestTags],Bin,Acc) -> + case decode_primitive_incomplete([Tag],Bin) of + {Tlv,Rest} -> + decode_constr_indef_incomplete(RestTags,Rest,[Tlv|Acc]); + asn1_NOVALUE -> + decode_constr_indef_incomplete(RestTags,Bin,Acc) + end. + + +decode_incomplete_bin(Bin) -> + {ok,Rest} = skip_tag(Bin), + {ok,Rest2} = skip_length_and_value(Rest), + IncLen = byte_size(Bin) - byte_size(Rest2), + <<IncBin:IncLen/binary,Ret/binary>> = Bin, + {IncBin,Ret}. + +incomplete_choice_alt(TagNo,[[Alt,TagNo]|Directives]) -> + {Alt,Directives}; +incomplete_choice_alt(TagNo,[D]) when is_list(D) -> + incomplete_choice_alt(TagNo,D); +incomplete_choice_alt(TagNo,[_H|Directives]) -> + incomplete_choice_alt(TagNo,Directives); +incomplete_choice_alt(_,[]) -> + no_match. + + +%% decode_selective(Pattern, Binary) the first argument is a pattern that tells +%% what to do with the next element the second is the BER encoded +%% message as a binary +%% Returns {ok,Value} or {error,Reason} +%% Value is a binary that in turn must be decoded to get the decoded +%% value. +decode_selective([],Binary) -> + {ok,Binary}; +decode_selective([skip|RestPattern],Binary)-> + {ok,RestBinary}=skip_tag(Binary), + {ok,RestBinary2}=skip_length_and_value(RestBinary), + decode_selective(RestPattern,RestBinary2); +decode_selective([[skip_optional,Tag]|RestPattern],Binary) -> + case skip_optional_tag(Tag,Binary) of + {ok,RestBinary} -> + {ok,RestBinary2}=skip_length_and_value(RestBinary), + decode_selective(RestPattern,RestBinary2); + missing -> + decode_selective(RestPattern,Binary) + end; +decode_selective([[choosen,Tag]],Binary) -> + return_value(Tag,Binary); +decode_selective([[choosen,Tag]|RestPattern],Binary) -> + case skip_optional_tag(Tag,Binary) of + {ok,RestBinary} -> + {ok,Value} = get_value(RestBinary), + decode_selective(RestPattern,Value); + missing -> + {ok,<<>>} + end; +decode_selective(P,_) -> + {error,{asn1,{partial_decode,"bad pattern",P}}}. + +return_value(Tag,Binary) -> + {ok,{Tag,RestBinary}}=get_tag(Binary), + {ok,{LenVal,_RestBinary2}} = get_length_and_value(RestBinary), + {ok,<<Tag/binary,LenVal/binary>>}. + + +%% skip_tag and skip_length_and_value are rutines used both by +%% decode_partial_incomplete and decode_selective (decode/2). + +skip_tag(<<_:3,31:5,Rest/binary>>)-> + skip_long_tag(Rest); +skip_tag(<<_:3,_Tag:5,Rest/binary>>) -> + {ok,Rest}. + +skip_long_tag(<<1:1,_:7,Rest/binary>>) -> + skip_long_tag(Rest); +skip_long_tag(<<0:1,_:7,Rest/binary>>) -> + {ok,Rest}. + +skip_optional_tag(<<>>,Binary) -> + {ok,Binary}; +skip_optional_tag(<<Tag,RestTag/binary>>,<<Tag,Rest/binary>>) -> + skip_optional_tag(RestTag,Rest); +skip_optional_tag(_,_) -> + missing. + + +skip_length_and_value(Binary) -> + case decode_length(Binary) of + {indefinite,RestBinary} -> + skip_indefinite_value(RestBinary); + {Length,RestBinary} -> + <<_:Length/unit:8,Rest/binary>> = RestBinary, + {ok,Rest} + end. + +skip_indefinite_value(<<0,0,Rest/binary>>) -> + {ok,Rest}; +skip_indefinite_value(Binary) -> + {ok,RestBinary}=skip_tag(Binary), + {ok,RestBinary2} = skip_length_and_value(RestBinary), + skip_indefinite_value(RestBinary2). + +get_value(Binary) -> + case decode_length(Binary) of + {indefinite,RestBinary} -> + get_indefinite_value(RestBinary,[]); + {Length,RestBinary} -> + <<Value:Length/binary,_Rest/binary>> = RestBinary, + {ok,Value} + end. + +get_indefinite_value(<<0,0,_Rest/binary>>,Acc) -> + {ok,list_to_binary(lists:reverse(Acc))}; +get_indefinite_value(Binary,Acc) -> + {ok,{Tag,RestBinary}}=get_tag(Binary), + {ok,{LenVal,RestBinary2}} = get_length_and_value(RestBinary), + get_indefinite_value(RestBinary2,[LenVal,Tag|Acc]). + +get_tag(<<H:1/binary,Rest/binary>>) -> + case H of + <<_:3,31:5>> -> + get_long_tag(Rest,[H]); + _ -> {ok,{H,Rest}} + end. +get_long_tag(<<H:1/binary,Rest/binary>>,Acc) -> + case H of + <<0:1,_:7>> -> + {ok,{list_to_binary(lists:reverse([H|Acc])),Rest}}; + _ -> + get_long_tag(Rest,[H|Acc]) + end. + +get_length_and_value(Bin = <<0:1,Length:7,_T/binary>>) -> + <<Len,Val:Length/binary,Rest/binary>> = Bin, + {ok,{<<Len,Val/binary>>, Rest}}; +get_length_and_value(Bin = <<1:1,0:7,_T/binary>>) -> + get_indefinite_length_and_value(Bin); +get_length_and_value(<<1:1,LL:7,T/binary>>) -> + <<Length:LL/unit:8,Rest/binary>> = T, + <<Value:Length/binary,Rest2/binary>> = Rest, + {ok,{<<1:1,LL:7,Length:LL/unit:8,Value/binary>>,Rest2}}. + +get_indefinite_length_and_value(<<H,T/binary>>) -> + get_indefinite_length_and_value(T,[H]). + +get_indefinite_length_and_value(<<0,0,Rest/binary>>,Acc) -> + {ok,{list_to_binary(lists:reverse(Acc)),Rest}}; +get_indefinite_length_and_value(Binary,Acc) -> + {ok,{Tag,RestBinary}}=get_tag(Binary), + {ok,{LenVal,RestBinary2}}=get_length_and_value(RestBinary), + get_indefinite_length_and_value(RestBinary2,[LenVal,Tag|Acc]). + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% match_tags takes a Tlv (Tag, Length, Value) structure and matches +%% it with the tags in TagList. If the tags does not match the function +%% crashes otherwise it returns the remaining Tlv after that the tags have +%% been removed. +%% +%% match_tags(Tlv, TagList) +%% + +match_tags({T,V}, [T]) -> + V; +match_tags({T,V}, [T|Tt]) -> + match_tags(V,Tt); +match_tags([{T,V}], [T|Tt]) -> + match_tags(V, Tt); +match_tags([{T,_V}|_]=Vlist, [T]) -> + Vlist; +match_tags(Tlv, []) -> + Tlv; +match_tags({Tag,_V}=Tlv, [T|_Tt]) -> + exit({error,{asn1,{wrong_tag,{{expected,T},{got,Tag,Tlv}}}}}). + +%%% +%% skips components that do not match a tag in Tags +skip_ExtensionAdditions([], _Tags) -> + []; +skip_ExtensionAdditions([{Tag,_}|Rest]=TLV, Tags) -> + case [X || X=T <- Tags, T =:= Tag] of + [] -> + %% skip this TLV and continue with next + skip_ExtensionAdditions(Rest,Tags); + _ -> + TLV + end. + + +%%=============================================================================== +%% Decode a tag +%% +%% decode_tag(OctetListBuffer) -> {{Form, (Class bsl 16)+ TagNo}, RestOfBuffer, RemovedBytes} +%%=============================================================================== + +decode_tag_and_length(<<Class:2, Form:1, TagNo:5, 0:1, Length:7, V:Length/binary, RestBuffer/binary>>) when TagNo < 31 -> + {Form, (Class bsl 16) bor TagNo, V, RestBuffer}; +decode_tag_and_length(<<Class:2, 1:1, TagNo:5, 1:1, 0:7, T/binary>>) when TagNo < 31 -> + {2, (Class bsl 16) + TagNo, T, <<>>}; +decode_tag_and_length(<<Class:2, Form:1, TagNo:5, 1:1, LL:7, Length:LL/unit:8,V:Length/binary, T/binary>>) when TagNo < 31 -> + {Form, (Class bsl 16) bor TagNo, V, T}; +decode_tag_and_length(<<Class:2, Form:1, 31:5, 0:1, TagNo:7, 0:1, Length:7, V:Length/binary, RestBuffer/binary>>) -> + {Form, (Class bsl 16) bor TagNo, V, RestBuffer}; +decode_tag_and_length(<<Class:2, 1:1, 31:5, 0:1, TagNo:7, 1:1, 0:7, T/binary>>) -> + {2, (Class bsl 16) bor TagNo, T, <<>>}; +decode_tag_and_length(<<Class:2, Form:1, 31:5, 0:1, TagNo:7, 1:1, LL:7, Length:LL/unit:8, V:Length/binary, T/binary>>) -> + {Form, (Class bsl 16) bor TagNo, V, T}; +decode_tag_and_length(<<Class:2, Form:1, 31:5, 1:1, TagPart1:7, 0:1, TagPartLast, Buffer/binary>>) -> + TagNo = (TagPart1 bsl 7) bor TagPartLast, + {Length, RestBuffer} = decode_length(Buffer), + << V:Length/binary, RestBuffer2/binary>> = RestBuffer, + {Form, (Class bsl 16) bor TagNo, V, RestBuffer2}; +decode_tag_and_length(<<Class:2, Form:1, 31:5, Buffer/binary>>) -> + {TagNo, Buffer1} = decode_tag(Buffer, 0), + {Length, RestBuffer} = decode_length(Buffer1), + << V:Length/binary, RestBuffer2/binary>> = RestBuffer, + {Form, (Class bsl 16) bor TagNo, V, RestBuffer2}. + + + +%% last partial tag +decode_tag(<<0:1,PartialTag:7, Buffer/binary>>, TagAck) -> + TagNo = (TagAck bsl 7) bor PartialTag, + {TagNo, Buffer}; +% more tags +decode_tag(<<_:1,PartialTag:7, Buffer/binary>>, TagAck) -> + TagAck1 = (TagAck bsl 7) bor PartialTag, + decode_tag(Buffer, TagAck1). + +%%======================================================================= +%% +%% Encode all tags in the list Tags and return a possibly deep list of +%% bytes with tag and length encoded +%% The taglist must be in reverse order (fixed by the asn1 compiler) +%% e.g [T1,T2] will result in +%% {[EncodedT2,EncodedT1|BytesSoFar],LenSoFar+LenT2+LenT1} +%% + +encode_tags([Tag|Trest], BytesSoFar, LenSoFar) -> + {Bytes2,L2} = encode_length(LenSoFar), + encode_tags(Trest, [Tag,Bytes2|BytesSoFar], + LenSoFar + byte_size(Tag) + L2); +encode_tags([], BytesSoFar, LenSoFar) -> + {BytesSoFar,LenSoFar}. + +encode_tags(TagIn, {BytesSoFar,LenSoFar}) -> + encode_tags(TagIn, BytesSoFar, LenSoFar). + +%%=============================================================================== +%% +%% This comment is valid for all the encode/decode functions +%% +%% C = Constraint -> typically {'ValueRange',LowerBound,UpperBound} +%% used for PER-coding but not for BER-coding. +%% +%% Val = Value. If Val is an atom then it is a symbolic integer value +%% (i.e the atom must be one of the names in the NamedNumberList). +%% The NamedNumberList is used to translate the atom to an integer value +%% before encoding. +%% +%%=============================================================================== + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_open_type(Value) -> io_list (i.e nested list with integers, binaries) +%% Value = list of bytes of an already encoded value (the list must be flat) +%% | binary + +encode_open_type(Val, T) when is_list(Val) -> + encode_open_type(list_to_binary(Val), T); +encode_open_type(Val, []) -> + {Val,byte_size(Val)}; +encode_open_type(Val, Tag) -> + encode_tags(Tag, Val, byte_size(Val)). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% decode_open_type(Tlv, TagIn) -> Value +%% Tlv = {Tag,V} | V where V -> binary() +%% TagIn = [TagVal] where TagVal -> int() +%% Value = binary with decoded data (which must be decoded again as some type) +%% +decode_open_type(Tlv, TagIn) -> + case match_tags(Tlv, TagIn) of + Bin when is_binary(Bin) -> + {InnerTlv,_} = ber_decode_nif(Bin), + InnerTlv; + TlvBytes -> TlvBytes + end. + +decode_open_type_as_binary(Tlv, TagIn)-> + ber_encode(match_tags(Tlv, TagIn)). + +%%=============================================================================== +%%=============================================================================== +%%=============================================================================== +%% Boolean, ITU_T X.690 Chapter 8.2 +%%=============================================================================== +%%=============================================================================== +%%=============================================================================== + +%%=============================================================================== +%% encode_boolean(Integer, ReversedTagList) -> {[Octet],Len} +%%=============================================================================== + +encode_boolean(true, TagIn) -> + encode_tags(TagIn, [16#FF],1); +encode_boolean(false, TagIn) -> + encode_tags(TagIn, [0],1); +encode_boolean(X,_) -> + exit({error,{asn1, {encode_boolean, X}}}). + + +%%=============================================================================== +%% decode_boolean(BuffList, HasTag, TotalLen) -> {true, Remain, RemovedBytes} | +%% {false, Remain, RemovedBytes} +%%=============================================================================== +decode_boolean(Tlv,TagIn) -> + Val = match_tags(Tlv, TagIn), + case Val of + <<0:8>> -> + false; + <<_:8>> -> + true; + _ -> + exit({error,{asn1, {decode_boolean, Val}}}) + end. + + +%%=========================================================================== +%% Integer, ITU_T X.690 Chapter 8.3 + +%% encode_integer(Constraint, Value, Tag) -> [octet list] +%% encode_integer(Constraint, Name, NamedNumberList, Tag) -> [octet list] +%% Value = INTEGER | {Name,INTEGER} +%% Tag = tag | notag +%%=========================================================================== + +encode_integer(Val, Tag) when is_integer(Val) -> + encode_tags(Tag, encode_integer(Val)); +encode_integer(Val, _Tag) -> + exit({error,{asn1,{encode_integer,Val}}}). + + +encode_integer(Val, NamedNumberList, Tag) when is_atom(Val) -> + case lists:keyfind(Val, 1, NamedNumberList) of + {_, NewVal} -> + encode_tags(Tag, encode_integer(NewVal)); + _ -> + exit({error,{asn1, {encode_integer_namednumber, Val}}}) + end; +encode_integer(Val, _NamedNumberList, Tag) -> + encode_tags(Tag, encode_integer(Val)). + +encode_integer(Val) -> + Bytes = + if + Val >= 0 -> + encode_integer_pos(Val, []); + true -> + encode_integer_neg(Val, []) + end, + {Bytes,length(Bytes)}. + +encode_integer_pos(0, [B|_Acc]=L) when B < 128 -> + L; +encode_integer_pos(N, Acc) -> + encode_integer_pos((N bsr 8), [N band 16#ff| Acc]). + +encode_integer_neg(-1, [B1|_T]=L) when B1 > 127 -> + L; +encode_integer_neg(N, Acc) -> + encode_integer_neg(N bsr 8, [N band 16#ff|Acc]). + +%%=============================================================================== +%% decode integer +%% (Buffer, Range, HasTag, TotalLen) -> {Integer, Remain, RemovedBytes} +%% (Buffer, Range, NamedNumberList, HasTag, TotalLen) -> {Integer, Remain, RemovedBytes} +%%=============================================================================== + +decode_integer(Tlv, Range, NamedNumberList, TagIn) -> + V = match_tags(Tlv, TagIn), + Int = range_check_integer(decode_integer(V), Range), + number2name(Int, NamedNumberList). + +decode_integer(Tlv, Range, TagIn) -> + V = match_tags(Tlv, TagIn), + Int = decode_integer(V), + range_check_integer(Int, Range). + +decode_integer(Bin) -> + Len = byte_size(Bin), + <<Int:Len/signed-unit:8>> = Bin, + 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. + +number2name(Int, []) -> + Int; +number2name(Int, NamedNumberList) -> + case lists:keyfind(Int, 2, NamedNumberList) of + {NamedVal,_} -> + NamedVal; + _ -> + Int + end. + + +%%============================================================================ +%% Enumerated value, ITU_T X.690 Chapter 8.4 + +%% encode enumerated value +%%============================================================================ +encode_enumerated(Val, TagIn) when is_integer(Val) -> + encode_tags(TagIn, encode_integer(Val)). + +%%============================================================================ +%% decode enumerated value +%% (Buffer, Range, NamedNumberList, HasTag, TotalLen) -> Value +%%=========================================================================== +decode_enumerated(Tlv, NamedNumberList, Tags) -> + Buffer = match_tags(Tlv, Tags), + decode_enumerated_notag(Buffer, NamedNumberList, Tags). + +decode_enumerated_notag(Buffer, {NamedNumberList,ExtList}, _Tags) -> + IVal = decode_integer(Buffer), + case decode_enumerated1(IVal, NamedNumberList) of + {asn1_enum,IVal} -> + decode_enumerated1(IVal,ExtList); + EVal -> + EVal + end; +decode_enumerated_notag(Buffer, NNList, _Tags) -> + IVal = decode_integer(Buffer), + case decode_enumerated1(IVal, NNList) of + {asn1_enum,_} -> + exit({error,{asn1, {illegal_enumerated, IVal}}}); + EVal -> + EVal + end. + +decode_enumerated1(Val, NamedNumberList) -> + %% it must be a named integer + case lists:keyfind(Val, 2, NamedNumberList) of + {NamedVal, _} -> + NamedVal; + _ -> + {asn1_enum,Val} + end. + + +%%============================================================================ +%% Bitstring value, ITU_T X.690 Chapter 8.6 +%% +%% encode bitstring value +%% +%% bitstring NamedBitList +%% Val can be of: +%% - [identifiers] where only named identifers are set to one, +%% the Constraint must then have some information of the +%% bitlength. +%% - [list of ones and zeroes] all bits +%% - integer value representing the bitlist +%% C is constrint Len, only valid when identifiers +%%============================================================================ + +encode_bit_string(C, Bits, NamedBitList, TagIn) when is_bitstring(Bits) -> + PadLen = (8 - (bit_size(Bits) band 7)) band 7, + Compact = {PadLen,<<Bits/bitstring,0:PadLen>>}, + encode_bin_bit_string(C, Compact, NamedBitList, TagIn); +encode_bit_string(C,Bin={Unused,BinBits},NamedBitList,TagIn) when is_integer(Unused), is_binary(BinBits) -> + encode_bin_bit_string(C,Bin,NamedBitList,TagIn); +encode_bit_string(C, [FirstVal | RestVal], NamedBitList, TagIn) when is_atom(FirstVal) -> + encode_bit_string_named(C, [FirstVal | RestVal], NamedBitList, TagIn); + +encode_bit_string(C, [{bit,X} | RestVal], NamedBitList, TagIn) -> + encode_bit_string_named(C, [{bit,X} | RestVal], NamedBitList, TagIn); + +encode_bit_string(C, [FirstVal| RestVal], NamedBitList, TagIn) when is_integer(FirstVal) -> + encode_bit_string_bits(C, [FirstVal | RestVal], NamedBitList, TagIn); + +encode_bit_string(_C, 0, _NamedBitList, TagIn) -> + encode_tags(TagIn, <<0>>,1); + +encode_bit_string(_C, [], _NamedBitList, TagIn) -> + encode_tags(TagIn, <<0>>,1); + +encode_bit_string(C, IntegerVal, NamedBitList, TagIn) when is_integer(IntegerVal) -> + BitListVal = int_to_bitlist(IntegerVal), + encode_bit_string_bits(C, BitListVal, NamedBitList, TagIn). + + +int_to_bitlist(0) -> + []; +int_to_bitlist(Int) when is_integer(Int), Int >= 0 -> + [Int band 1 | int_to_bitlist(Int bsr 1)]. + + +%%================================================================= +%% Encode BIT STRING of the form {Unused,BinBits}. +%% Unused is the number of unused bits in the last byte in BinBits +%% 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 -> + remove_unused_then_dotag(TagIn, Unused, BinBits); + {_Min,Max} -> + BBLen = (byte_size(BinBits)*8)-Unused, + if + BBLen > Max -> + exit({error,{asn1, + {bitstring_length, + {{was,BBLen},{maximum,Max}}}}}); + true -> + remove_unused_then_dotag(TagIn, Unused, BinBits) + end; + Size -> + case ((byte_size(BinBits)*8)-Unused) of + BBSize when BBSize =< Size -> + remove_unused_then_dotag(TagIn, Unused, BinBits); + BBSize -> + exit({error,{asn1, + {bitstring_length, + {{was,BBSize},{should_be,Size}}}}}) + end + end. + +remove_unused_then_dotag(TagIn,Unused,BinBits) -> + case Unused of + 0 when byte_size(BinBits) =:= 0 -> + encode_tags(TagIn, <<0>>, 1); + 0 -> + Bin = <<Unused,BinBits/binary>>, + encode_tags(TagIn,Bin,size(Bin)); + Num -> + N = byte_size(BinBits)-1, + <<BBits:N/binary,LastByte>> = BinBits, + encode_tags(TagIn, + [Unused,binary_to_list(BBits) ++[(LastByte bsr Num) bsl Num]], + 1+byte_size(BinBits)) + end. + + +%%================================================================= +%% Encode named bits +%%================================================================= + +encode_bit_string_named(C, [FirstVal | RestVal], NamedBitList, TagIn) -> + ToSetPos = get_all_bitposes([FirstVal | RestVal], NamedBitList, []), + Size = + case get_constraint(C,'SizeConstraint') of + no -> + lists:max(ToSetPos)+1; + {_Min,Max} -> + Max; + TSize -> + TSize + end, + BitList = make_and_set_list(Size, ToSetPos, 0), + {Len, Unused, OctetList} = encode_bitstring(BitList), + encode_tags(TagIn, [Unused|OctetList],Len+1). + + +%%---------------------------------------- +%% get_all_bitposes([list of named bits to set], named_bit_db, []) -> +%% [sorted_list_of_bitpositions_to_set] +%%---------------------------------------- + +get_all_bitposes([{bit,ValPos}|Rest], NamedBitList, Ack) -> + get_all_bitposes(Rest, NamedBitList, [ValPos | Ack ]); +get_all_bitposes([Val | Rest], NamedBitList, Ack) when is_atom(Val) -> + case lists:keyfind(Val, 1, NamedBitList) of + {_ValName, ValPos} -> + get_all_bitposes(Rest, NamedBitList, [ValPos | Ack]); + _ -> + exit({error,{asn1, {bitstring_namedbit, Val}}}) + end; +get_all_bitposes([], _NamedBitList, Ack) -> + lists:sort(Ack). + + +%%---------------------------------------- +%% make_and_set_list(Len of list to return, [list of positions to set to 1])-> +%% returns list of Len length, with all in SetPos set. +%% in positioning in list the first element is 0, the second 1 etc.., but +%% Len will make a list of length Len, not Len + 1. +%% BitList = make_and_set_list(C, ToSetPos, 0), +%%---------------------------------------- + +make_and_set_list(0, [], _) -> []; +make_and_set_list(0, _, _) -> + exit({error,{asn1,bitstring_sizeconstraint}}); +make_and_set_list(Len, [XPos|SetPos], XPos) -> + [1 | make_and_set_list(Len - 1, SetPos, XPos + 1)]; +make_and_set_list(Len, [Pos|SetPos], XPos) -> + [0 | make_and_set_list(Len - 1, [Pos | SetPos], XPos + 1)]; +make_and_set_list(Len, [], XPos) -> + [0 | make_and_set_list(Len - 1, [], XPos + 1)]. + + + + + + +%%================================================================= +%% 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 -> + {Len, Unused, OctetList} = encode_bitstring(BitListVal), + %%add unused byte to the Len + encode_tags(TagIn, [Unused | OctetList], Len+1); + Constr={Min,_Max} when is_integer(Min) -> + %% Max may be an integer or 'MAX' + encode_constr_bit_str_bits(Constr,BitListVal,TagIn); + {Constr={_,_},[]} ->%Constr={Min,Max} + %% constraint with extension mark + encode_constr_bit_str_bits(Constr,BitListVal,TagIn); + Constr={{_,_},{_,_}} ->%{{Min1,Max1},{Min2,Max2}} + %% constraint with extension mark + encode_constr_bit_str_bits(Constr,BitListVal,TagIn); + Size -> + case length(BitListVal) of + BitSize when BitSize == Size -> + {Len, Unused, OctetList} = encode_bitstring(BitListVal), + %%add unused byte to the Len + encode_tags(TagIn, [Unused | OctetList], Len+1); + BitSize when BitSize < Size -> + PaddedList = pad_bit_list(Size-BitSize,BitListVal), + {Len, Unused, OctetList} = encode_bitstring(PaddedList), + %%add unused byte to the Len + encode_tags(TagIn, [Unused | OctetList], Len+1); + BitSize -> + exit({error,{asn1, + {bitstring_length, {{was,BitSize},{should_be,Size}}}}}) + end + + end. + +encode_constr_bit_str_bits({{_Min1,Max1},{Min2,Max2}},BitListVal,TagIn) -> + BitLen = length(BitListVal), + case BitLen of + Len when Len > Max2 -> + exit({error,{asn1,{bitstring_length,{{was,BitLen}, + {maximum,Max2}}}}}); + Len when Len > Max1, Len < Min2 -> + exit({error,{asn1,{bitstring_length,{{was,BitLen}, + {not_allowed_interval, + Max1,Min2}}}}}); + _ -> + {Len, Unused, OctetList} = encode_bitstring(BitListVal), + %%add unused byte to the Len + encode_tags(TagIn, [Unused, OctetList], Len+1) + end; +encode_constr_bit_str_bits({Min,Max},BitListVal,TagIn) -> + BitLen = length(BitListVal), + if + BitLen > Max -> + exit({error,{asn1,{bitstring_length,{{was,BitLen}, + {maximum,Max}}}}}); + BitLen < Min -> + exit({error,{asn1,{bitstring_length,{{was,BitLen}, + {minimum,Max}}}}}); + true -> + {Len, Unused, OctetList} = encode_bitstring(BitListVal), + %%add unused byte to the Len + encode_tags(TagIn, [Unused, OctetList], Len+1) + end. + + +%% returns a list of length Size + length(BitListVal), with BitListVal +%% as the most significant elements followed by padded zero elements +pad_bit_list(Size, BitListVal) -> + Tail = lists:duplicate(Size,0), + lists:append(BitListVal, Tail). + +%%================================================================= +%% Do the actual encoding +%% ([bitlist]) -> {ListLen, UnusedBits, OctetList} +%%================================================================= + +encode_bitstring([B8, B7, B6, B5, B4, B3, B2, B1 | Rest]) -> + Val = (B8 bsl 7) bor (B7 bsl 6) bor (B6 bsl 5) bor (B5 bsl 4) bor + (B4 bsl 3) bor (B3 bsl 2) bor (B2 bsl 1) bor B1, + encode_bitstring(Rest, [Val], 1); +encode_bitstring(Val) -> + {Unused, Octet} = unused_bitlist(Val, 7, 0), + {1, Unused, [Octet]}. + +encode_bitstring([B8, B7, B6, B5, B4, B3, B2, B1 | Rest], Ack, Len) -> + Val = (B8 bsl 7) bor (B7 bsl 6) bor (B6 bsl 5) bor (B5 bsl 4) bor + (B4 bsl 3) bor (B3 bsl 2) bor (B2 bsl 1) bor B1, + encode_bitstring(Rest, [Ack | [Val]], Len + 1); +%%even multiple of 8 bits.. +encode_bitstring([], Ack, Len) -> + {Len, 0, Ack}; +%% unused bits in last octet +encode_bitstring(Rest, Ack, Len) -> + {Unused, Val} = unused_bitlist(Rest, 7, 0), + {Len + 1, Unused, [Ack | [Val]]}. + +%%%%%%%%%%%%%%%%%% +%% unused_bitlist([list of ones and zeros <= 7], 7, []) -> +%% {Unused bits, Last octet with bits moved to right} +unused_bitlist([], Trail, Ack) -> + {Trail + 1, Ack}; +unused_bitlist([Bit | Rest], Trail, Ack) -> + unused_bitlist(Rest, Trail - 1, (Bit bsl Trail) bor Ack). + + +%%============================================================================ +%% decode bitstring value +%%============================================================================ + +decode_compact_bit_string(Buffer, Range, Tags) -> + case match_and_collect(Buffer, Tags) of + <<0>> -> + check_restricted_string({0,<<>>}, 0, Range); + <<Unused,Bits/binary>> -> + Val = {Unused,Bits}, + Len = bit_size(Bits) - Unused, + check_restricted_string(Val, Len, Range) + end. + +decode_legacy_bit_string(Buffer, Range, Tags) -> + Val = case match_and_collect(Buffer, Tags) of + <<0>> -> + []; + <<Unused,Bits/binary>> -> + decode_bitstring2(byte_size(Bits), Unused, Bits) + end, + check_restricted_string(Val, length(Val), Range). + +decode_native_bit_string(Buffer, Range, Tags) -> + case match_and_collect(Buffer, Tags) of + <<0>> -> + check_restricted_string(<<>>, 0, Range); + <<Unused,Bits/binary>> -> + Size = bit_size(Bits) - Unused, + <<Val:Size/bitstring,_:Unused/bitstring>> = Bits, + check_restricted_string(Val, Size, Range) + end. + +decode_named_bit_string(Buffer, NamedNumberList, Tags) -> + case match_and_collect(Buffer, Tags) of + <<0>> -> + []; + <<Unused,Bits/binary>> -> + BitString = decode_bitstring2(byte_size(Bits), Unused, Bits), + decode_bitstring_NNL(BitString, NamedNumberList) + end. + +%%---------------------------------------- +%% Decode the in buffer to bits +%%---------------------------------------- +decode_bitstring2(1, Unused, + <<B7:1,B6:1,B5:1,B4:1,B3:1,B2:1,B1:1,B0:1,_/binary>>) -> + lists:sublist([B7,B6,B5,B4,B3,B2,B1,B0], 8-Unused); +decode_bitstring2(Len, Unused, + <<B7:1,B6:1,B5:1,B4:1,B3:1,B2:1,B1:1,B0:1,Buffer/binary>>) -> + [B7,B6,B5,B4,B3,B2,B1,B0| + decode_bitstring2(Len - 1, Unused, Buffer)]. + +%%---------------------------------------- +%% Decode the bitlist to names +%%---------------------------------------- + +decode_bitstring_NNL(BitList, NamedNumberList) -> + decode_bitstring_NNL(BitList, NamedNumberList, 0, []). + + +decode_bitstring_NNL([],_,_No,Result) -> + lists:reverse(Result); +decode_bitstring_NNL([B|BitList],[{Name,No}|NamedNumberList],No,Result) -> + if + B =:= 0 -> + decode_bitstring_NNL(BitList,NamedNumberList,No+1,Result); + true -> + decode_bitstring_NNL(BitList,NamedNumberList,No+1,[Name|Result]) + end; +decode_bitstring_NNL([1|BitList],NamedNumberList,No,Result) -> + decode_bitstring_NNL(BitList,NamedNumberList,No+1,[{bit,No}|Result]); +decode_bitstring_NNL([0|BitList],NamedNumberList,No,Result) -> + decode_bitstring_NNL(BitList,NamedNumberList,No+1,Result). + +%%============================================================================ +%% Null value, ITU_T X.690 Chapter 8.8 +%% +%% encode NULL value +%%============================================================================ + +encode_null(_Val, TagIn) -> + encode_tags(TagIn, [], 0). + +%%============================================================================ +%% decode NULL value +%% (Buffer, HasTag, TotalLen) -> {NULL, Remain, RemovedBytes} +%%============================================================================ + +decode_null(Tlv, Tags) -> + Val = match_tags(Tlv, Tags), + case Val of + <<>> -> + 'NULL'; + _ -> + exit({error,{asn1,{decode_null,Val}}}) + end. + +%%============================================================================ +%% Object identifier, ITU_T X.690 Chapter 8.19 +%% +%% encode Object Identifier value +%%============================================================================ + +encode_object_identifier(Val, TagIn) -> + encode_tags(TagIn, e_object_identifier(Val)). + +e_object_identifier({'OBJECT IDENTIFIER', V}) -> + e_object_identifier(V); +e_object_identifier(V) when is_tuple(V) -> + e_object_identifier(tuple_to_list(V)); + +%%%%%%%%%%%%%%% +%% e_object_identifier([List of Obect Identifiers]) -> +%% {[Encoded Octetlist of ObjIds], IntLength} +%% +e_object_identifier([E1,E2|Tail]) -> + Head = 40*E1 + E2, % wow! + {H,Lh} = mk_object_val(Head), + {R,Lr} = lists:mapfoldl(fun enc_obj_id_tail/2, 0, Tail), + {[H|R],Lh+Lr}. + +enc_obj_id_tail(H, Len) -> + {B,L} = mk_object_val(H), + {B,Len+L}. + + +%%%%%%%%%%% +%% mk_object_val(Value) -> {OctetList, Len} +%% returns a Val as a list of octets, the 8th bit is always set to one +%% except for the last octet, where it's 0 +%% + + +mk_object_val(Val) when Val =< 127 -> + {[255 band Val], 1}; +mk_object_val(Val) -> + mk_object_val(Val bsr 7, [Val band 127], 1). +mk_object_val(0, Ack, Len) -> + {Ack, Len}; +mk_object_val(Val, Ack, Len) -> + mk_object_val(Val bsr 7, [((Val band 127) bor 128) | Ack], Len + 1). + + + +%%============================================================================ +%% decode Object Identifier value +%% (Buffer, HasTag, TotalLen) -> {{ObjId}, Remain, RemovedBytes} +%%============================================================================ + +decode_object_identifier(Tlv, Tags) -> + Val = match_tags(Tlv, Tags), + [AddedObjVal|ObjVals] = dec_subidentifiers(Val,0,[]), + {Val1, Val2} = if + AddedObjVal < 40 -> + {0, AddedObjVal}; + AddedObjVal < 80 -> + {1, AddedObjVal - 40}; + true -> + {2, AddedObjVal - 80} + end, + list_to_tuple([Val1, Val2 | ObjVals]). + +dec_subidentifiers(<<>>,_Av,Al) -> + lists:reverse(Al); +dec_subidentifiers(<<1:1,H:7,T/binary>>,Av,Al) -> + dec_subidentifiers(T,(Av bsl 7) + H,Al); +dec_subidentifiers(<<H,T/binary>>,Av,Al) -> + dec_subidentifiers(T,0,[((Av bsl 7) + H)|Al]). + +%%============================================================================ +%% RELATIVE-OID, ITU_T X.690 Chapter 8.20 +%% +%% encode Relative Object Identifier +%%============================================================================ + +encode_relative_oid(Val,TagIn) when is_tuple(Val) -> + encode_relative_oid(tuple_to_list(Val),TagIn); +encode_relative_oid(Val,TagIn) -> + encode_tags(TagIn, enc_relative_oid(Val)). + +enc_relative_oid(Tuple) when is_tuple(Tuple) -> + enc_relative_oid(tuple_to_list(Tuple)); +enc_relative_oid(Val) -> + lists:mapfoldl(fun(X,AccIn) -> + {SO,L} = mk_object_val(X), + {SO,L+AccIn} + end, 0, Val). + +%%============================================================================ +%% decode Relative Object Identifier value +%% (Buffer, HasTag, TotalLen) -> {{ObjId}, Remain, RemovedBytes} +%%============================================================================ +decode_relative_oid(Tlv, Tags) -> + Val = match_tags(Tlv, Tags), + ObjVals = dec_subidentifiers(Val,0,[]), + list_to_tuple(ObjVals). + +%%============================================================================ +%% Restricted character string types, ITU_T X.690 Chapter 8.20 +%% +%% encode Numeric Printable Teletex Videotex Visible IA5 Graphic General strings +%%============================================================================ +encode_restricted_string(OctetList, TagIn) when is_binary(OctetList) -> + encode_tags(TagIn, OctetList, byte_size(OctetList)); +encode_restricted_string(OctetList, TagIn) when is_list(OctetList) -> + encode_tags(TagIn, OctetList, length(OctetList)). + +%%============================================================================ +%% decode Numeric Printable Teletex Videotex Visible IA5 Graphic General strings +%%============================================================================ + +decode_restricted_string(Tlv, TagsIn) -> + Bin = match_and_collect(Tlv, TagsIn), + binary_to_list(Bin). + +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. + + +%%============================================================================ +%% encode Universal string +%%============================================================================ + +encode_universal_string(Universal, TagIn) -> + OctetList = mk_uni_list(Universal), + encode_tags(TagIn, OctetList, length(OctetList)). + +mk_uni_list(In) -> + mk_uni_list(In,[]). + +mk_uni_list([],List) -> + lists:reverse(List); +mk_uni_list([{A,B,C,D}|T],List) -> + mk_uni_list(T,[D,C,B,A|List]); +mk_uni_list([H|T],List) -> + mk_uni_list(T,[H,0,0,0|List]). + +%%=========================================================================== +%% decode Universal strings +%% (Buffer, Range, StringType, HasTag, LenIn) -> +%% {String, Remain, RemovedBytes} +%%=========================================================================== + +decode_universal_string(Buffer, Range, Tags) -> + Bin = match_and_collect(Buffer, Tags), + Val = mk_universal_string(binary_to_list(Bin)), + check_restricted_string(Val, length(Val), Range). + +mk_universal_string(In) -> + mk_universal_string(In, []). + +mk_universal_string([], Acc) -> + lists:reverse(Acc); +mk_universal_string([0,0,0,D|T], Acc) -> + mk_universal_string(T, [D|Acc]); +mk_universal_string([A,B,C,D|T], Acc) -> + mk_universal_string(T, [{A,B,C,D}|Acc]). + + +%%============================================================================ +%% encode UTF8 string +%%============================================================================ + +encode_UTF8_string(UTF8String, TagIn) when is_binary(UTF8String) -> + encode_tags(TagIn, UTF8String, byte_size(UTF8String)); +encode_UTF8_string(UTF8String, TagIn) -> + encode_tags(TagIn, UTF8String, length(UTF8String)). + + +%%============================================================================ +%% decode UTF8 string +%%============================================================================ + +decode_UTF8_string(Tlv,TagsIn) -> + Val = match_tags(Tlv, TagsIn), + case Val of + [_|_]=PartList -> % constructed val + collect_parts(PartList); + Bin -> + Bin + end. + + +%%============================================================================ +%% encode BMP string +%%============================================================================ + +encode_BMP_string(BMPString, TagIn) -> + OctetList = mk_BMP_list(BMPString), + encode_tags(TagIn, OctetList, length(OctetList)). + +mk_BMP_list(In) -> + mk_BMP_list(In, []). + +mk_BMP_list([],List) -> + lists:reverse(List); +mk_BMP_list([{0,0,C,D}|T], List) -> + mk_BMP_list(T, [D,C|List]); +mk_BMP_list([H|T], List) -> + mk_BMP_list(T, [H,0|List]). + +%%============================================================================ +%% decode (OctetList, Range(ignored), tag|notag) -> {ValList, RestList} +%% (Buffer, Range, StringType, HasTag, TotalLen) -> +%% {String, Remain, RemovedBytes} +%%============================================================================ +decode_BMP_string(Buffer, Range, Tags) -> + Bin = match_and_collect(Buffer, Tags), + Val = mk_BMP_string(binary_to_list(Bin)), + check_restricted_string(Val, length(Val), Range). + +mk_BMP_string(In) -> + mk_BMP_string(In,[]). + +mk_BMP_string([], US) -> + lists:reverse(US); +mk_BMP_string([0,B|T], US) -> + mk_BMP_string(T, [B|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 +%% +%% Encode length +%% +%% encode_length(Int) -> +%% [<127]| [128 + Int (<127),OctetList] | [16#80] +%%============================================================================ + +encode_length(L) when L =< 16#7F -> + {[L],1}; +encode_length(L) -> + Oct = minimum_octets(L), + Len = length(Oct), + if + Len =< 126 -> + {[16#80 bor Len|Oct],Len+1}; + true -> + exit({error,{asn1, too_long_length_oct, Len}}) + end. + +%% Val must be >= 0 +minimum_octets(Val) -> + minimum_octets(Val, []). + +minimum_octets(0, Acc) -> + Acc; +minimum_octets(Val, Acc) -> + minimum_octets(Val bsr 8, [Val band 16#FF|Acc]). + + +%%=========================================================================== +%% Decode length +%% +%% decode_length(OctetList) -> {{indefinite, RestOctetsL}, NoRemovedBytes} | +%% {{Length, RestOctetsL}, NoRemovedBytes} +%%=========================================================================== + +decode_length(<<1:1,0:7,T/binary>>) -> + {indefinite,T}; +decode_length(<<0:1,Length:7,T/binary>>) -> + {Length,T}; +decode_length(<<1:1,LL:7,Length:LL/unit:8,T/binary>>) -> + {Length,T}. + +%% dynamicsort_SET_components(Arg) -> +%% Res Arg -> list() +%% Res -> list() +%% Sorts the elements in Arg according to the encoded tag in +%% increasing order. +dynamicsort_SET_components(ListOfEncCs) -> + TagBinL = [begin + Bin = list_to_binary(L), + {dynsort_decode_tag(Bin),Bin} + end || L <- ListOfEncCs], + [E || {_,E} <- lists:keysort(1, TagBinL)]. + +%% dynamicsort_SETOF(Arg) -> Res +%% Arg -> list() +%% Res -> list() +%% Sorts the elements in Arg in increasing size +dynamicsort_SETOF(ListOfEncVal) -> + BinL = lists:map(fun(L) when is_list(L) -> list_to_binary(L); + (B) -> B end, ListOfEncVal), + lists:sort(BinL). + +%% multiple octet tag +dynsort_decode_tag(<<Class:2,_Form:1,31:5,Buffer/binary>>) -> + TagNum = dynsort_decode_tag(Buffer, 0), + {Class,TagNum}; + +%% single tag (< 31 tags) +dynsort_decode_tag(<<Class:2,_Form:1,TagNum:5,_/binary>>) -> + {Class,TagNum}. + +dynsort_decode_tag(<<0:1,PartialTag:7,_/binary>>, TagAcc) -> + (TagAcc bsl 7) bor PartialTag; +dynsort_decode_tag(<<_:1,PartialTag:7,Buffer/binary>>, TagAcc0) -> + TagAcc = (TagAcc0 bsl 7) bor PartialTag, + dynsort_decode_tag(Buffer, TagAcc). + + +%%------------------------------------------------------------------------- +%% INTERNAL HELPER FUNCTIONS (not exported) +%%------------------------------------------------------------------------- + +match_and_collect(Tlv, TagsIn) -> + Val = match_tags(Tlv, TagsIn), + case Val of + [_|_]=PartList -> % constructed val + collect_parts(PartList); + Bin when is_binary(Bin) -> + Bin + end. + +get_constraint(C, Key) -> + case lists:keyfind(Key, 1, C) of + false -> + no; + {_,V} -> + V + end. + +collect_parts(TlvList) -> + collect_parts(TlvList, []). + +collect_parts([{_,L}|Rest], Acc) when is_list(L) -> + collect_parts(Rest, [collect_parts(L)|Acc]); +collect_parts([{?N_BIT_STRING,<<Unused,Bits/binary>>}|Rest], _Acc) -> + collect_parts_bit(Rest, [Bits], Unused); +collect_parts([{_T,V}|Rest], Acc) -> + collect_parts(Rest, [V|Acc]); +collect_parts([], Acc) -> + list_to_binary(lists:reverse(Acc)). + +collect_parts_bit([{?N_BIT_STRING,<<Unused,Bits/binary>>}|Rest], Acc, Uacc) -> + collect_parts_bit(Rest, [Bits|Acc], Unused+Uacc); +collect_parts_bit([], Acc, Uacc) -> + list_to_binary([Uacc|lists:reverse(Acc)]). diff --git a/lib/asn1/src/asn1rtt_check.erl b/lib/asn1/src/asn1rtt_check.erl new file mode 100644 index 0000000000..e78b65a8fb --- /dev/null +++ b/lib/asn1/src/asn1rtt_check.erl @@ -0,0 +1,276 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(asn1rtt_check). + +-export([check_bool/2, + check_int/3, + check_bitstring/3, + check_octetstring/2, + check_null/2, + check_objectidentifier/2, + check_objectdescriptor/2, + check_real/2, + check_enum/3, + check_restrictedstring/2]). + +check_bool(_Bool, asn1_DEFAULT) -> + true; +check_bool(Bool, Bool) when is_boolean(Bool) -> + true; +check_bool(_Bool1, Bool2) -> + throw({error,Bool2}). + +check_int(_, asn1_DEFAULT, _) -> + true; +check_int(Value, Value, _) when is_integer(Value) -> + true; +check_int(DefValue, Value, NNL) when is_atom(Value) -> + case lists:keyfind(Value, 1, NNL) of + {_,DefValue} -> + true; + _ -> + throw({error,DefValue}) + end; +check_int(DefaultValue, _Value, _) -> + throw({error,DefaultValue}). + +%% Two equal lists or integers +check_bitstring(_, asn1_DEFAULT, _) -> + true; +check_bitstring(V, V, _) -> + true; +%% Default value as a list of 1 and 0 and user value as an integer +check_bitstring(L=[H|T], Int, _) when is_integer(Int), is_integer(H) -> + case bit_list_to_int(L, length(T)) of + Int -> true; + _ -> throw({error,L,Int}) + end; +%% Default value as an integer, val as list +check_bitstring(Int, Val, NBL) when is_integer(Int), is_list(Val) -> + BL = int_to_bit_list(Int, [], length(Val)), + check_bitstring(BL, Val, NBL); +%% Default value and user value as lists of ones and zeros +check_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL=[_H|_T]) when is_integer(H1), is_integer(H2) -> + L2new = remove_trailing_zeros(L2), + check_bitstring(L1, L2new, NBL); +%% Default value as a list of 1 and 0 and user value as a list of atoms +check_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL) when is_integer(H1), is_atom(H2) -> + L3 = bit_list_to_nbl(L1, NBL, 0, []), + check_bitstring(L3, L2, NBL); +%% Both default value and user value as a list of atoms +check_bitstring(L1=[H1|T1], L2=[H2|_T2], _) + when is_atom(H1), is_atom(H2), length(L1) =:= length(L2) -> + case lists:member(H1, L2) of + true -> + check_bitstring1(T1, L2); + false -> throw({error,L2}) + end; +%% Default value as a list of atoms and user value as a list of 1 and 0 +check_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL) when is_atom(H1), is_integer(H2) -> + L3 = bit_list_to_nbl(L2, NBL, 0, []), + check_bitstring(L1, L3, NBL); +%% User value in compact format +check_bitstring(DefVal,CBS={_,_}, NBL) -> + NewVal = cbs_to_bit_list(CBS), + check_bitstring(DefVal, NewVal, NBL); +check_bitstring(DV, V, _) -> + throw({error,DV,V}). + + +bit_list_to_int([0|Bs], ShL)-> + bit_list_to_int(Bs, ShL-1) + 0; +bit_list_to_int([1|Bs], ShL) -> + bit_list_to_int(Bs, ShL-1) + (1 bsl ShL); +bit_list_to_int([], _) -> + 0. + +int_to_bit_list(0, Acc, 0) -> + Acc; +int_to_bit_list(Int, Acc, Len) -> + int_to_bit_list(Int bsr 1, [Int band 1|Acc], Len - 1). + +bit_list_to_nbl([0|T], NBL, Pos, Acc) -> + bit_list_to_nbl(T, NBL, Pos+1, Acc); +bit_list_to_nbl([1|T], NBL, Pos, Acc) -> + case lists:keyfind(Pos, 2, NBL) of + {N,_} -> + bit_list_to_nbl(T, NBL, Pos+1, [N|Acc]); + _ -> + throw({error,{no,named,element,at,pos,Pos}}) + end; +bit_list_to_nbl([], _, _, Acc) -> + Acc. + +remove_trailing_zeros(L2) -> + remove_trailing_zeros1(lists:reverse(L2)). +remove_trailing_zeros1(L) -> + lists:reverse(lists:dropwhile(fun(0)->true; + (_) ->false + end, + L)). + +check_bitstring1([H|T], NBL) -> + case lists:member(H, NBL) of + true -> check_bitstring1(T, NBL); + V -> throw({error,V}) + end; +check_bitstring1([], _) -> + true. + +cbs_to_bit_list({Unused, <<B7:1,B6:1,B5:1,B4:1,B3:1,B2:1,B1:1,B0:1,Rest/binary>>}) when byte_size(Rest) >= 1 -> + [B7,B6,B5,B4,B3,B2,B1,B0|cbs_to_bit_list({Unused,Rest})]; +cbs_to_bit_list({0,<<B7:1,B6:1,B5:1,B4:1,B3:1,B2:1,B1:1,B0:1>>}) -> + [B7,B6,B5,B4,B3,B2,B1,B0]; +cbs_to_bit_list({Unused,Bin}) when byte_size(Bin) =:= 1 -> + Used = 8-Unused, + <<Int:Used,_:Unused>> = Bin, + int_to_bit_list(Int, [], Used). + + +check_octetstring(_, asn1_DEFAULT) -> + true; +check_octetstring(L, L) -> + true; +check_octetstring(L, Int) when is_list(L), is_integer(Int) -> + case integer_to_octetlist(Int) of + L -> true; + V -> throw({error,V}) + end; +check_octetstring(_, V) -> + throw({error,V}). + +integer_to_octetlist(Int) -> + integer_to_octetlist(Int, []). +integer_to_octetlist(0, Acc) -> + Acc; +integer_to_octetlist(Int, Acc) -> + integer_to_octetlist(Int bsr 8, [(Int band 255)|Acc]). + +check_null(_, asn1_DEFAULT) -> + true; +check_null('NULL', 'NULL') -> + true; +check_null(_, V) -> + throw({error,V}). + +check_objectidentifier(_, asn1_DEFAULT) -> + true; +check_objectidentifier(OI, OI) -> + true; +check_objectidentifier(DOI, OI) when is_tuple(DOI), is_tuple(OI) -> + check_objectidentifier1(tuple_to_list(DOI), tuple_to_list(OI)); +check_objectidentifier(_, OI) -> + throw({error,OI}). + +check_objectidentifier1([V|Rest1], [V|Rest2]) -> + check_objectidentifier1(Rest1, Rest2, V); +check_objectidentifier1([V1|Rest1], [V2|Rest2]) -> + case reserved_objectid(V2, []) of + V1 -> + check_objectidentifier1(Rest1, Rest2, [V1]); + V -> + throw({error,V}) + end. +check_objectidentifier1([V|Rest1], [V|Rest2], Above) -> + check_objectidentifier1(Rest1, Rest2, [V|Above]); +check_objectidentifier1([V1|Rest1], [V2|Rest2], Above) -> + case reserved_objectid(V2, Above) of + V1 -> + check_objectidentifier1(Rest1, Rest2, [V1|Above]); + V -> + throw({error,V}) + end; +check_objectidentifier1([], [], _) -> + true; +check_objectidentifier1(_, V, _) -> + throw({error,object,identifier,V}). + +%% ITU-T Rec. X.680 Annex B - D +reserved_objectid('itu-t', []) -> 0; +reserved_objectid('ccitt', []) -> 0; +%% arcs below "itu-t" +reserved_objectid('recommendation', [0]) -> 0; +reserved_objectid('question', [0]) -> 1; +reserved_objectid('administration', [0]) -> 2; +reserved_objectid('network-operator', [0]) -> 3; +reserved_objectid('identified-organization', [0]) -> 4; + +reserved_objectid(iso, []) -> 1; +%% arcs below "iso", note that number 1 is not used +reserved_objectid('standard', [1]) -> 0; +reserved_objectid('member-body', [1]) -> 2; +reserved_objectid('identified-organization', [1]) -> 3; + +reserved_objectid('joint-iso-itu-t', []) -> 2; +reserved_objectid('joint-iso-ccitt', []) -> 2; + +reserved_objectid(_, _) -> false. + + +check_objectdescriptor(_, asn1_DEFAULT) -> + true; +check_objectdescriptor(OD, OD) -> + true; +check_objectdescriptor(OD, OD) -> + throw({error,{not_implemented_yet,check_objectdescriptor}}). + +check_real(_, asn1_DEFAULT) -> + true; +check_real(R, R) -> + true; +check_real(_, _) -> + throw({error,{not_implemented_yet,check_real}}). + +check_enum(_, asn1_DEFAULT, _) -> + true; +check_enum(Val, Val, _) -> + true; +check_enum(Int, Atom, Enumerations) when is_integer(Int), is_atom(Atom) -> + case lists:keyfind(Atom, 1, Enumerations) of + {_,Int} -> true; + _ -> throw({error,{enumerated,Int,Atom}}) + end; +check_enum(DefVal, Val, _) -> + throw({error,{enumerated,DefVal,Val}}). + + +check_restrictedstring(_, asn1_DEFAULT) -> + true; +check_restrictedstring(Val, Val) -> + true; +check_restrictedstring([V|Rest1], [V|Rest2]) -> + check_restrictedstring(Rest1, Rest2); +check_restrictedstring([V1|Rest1], [V2|Rest2]) -> + check_restrictedstring(V1, V2), + check_restrictedstring(Rest1, Rest2); +%% tuple format of value +check_restrictedstring({V1,V2}, [V1,V2]) -> + true; +check_restrictedstring([V1,V2], {V1,V2}) -> + true; +%% quadruple format of value +check_restrictedstring({V1,V2,V3,V4}, [V1,V2,V3,V4]) -> + true; +check_restrictedstring([V1,V2,V3,V4], {V1,V2,V3,V4}) -> + true; +%% character string list +check_restrictedstring(V1, V2) when is_list(V1), is_tuple(V2) -> + check_restrictedstring(V1, tuple_to_list(V2)); +check_restrictedstring(V1, V2) -> + throw({error,{restricted,string,V1,V2}}). diff --git a/lib/asn1/src/asn1rtt_ext.erl b/lib/asn1/src/asn1rtt_ext.erl new file mode 100644 index 0000000000..7510b01f17 --- /dev/null +++ b/lib/asn1/src/asn1rtt_ext.erl @@ -0,0 +1,72 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(asn1rtt_ext). +-export([transform_to_EXTERNAL1990/1,transform_to_EXTERNAL1994/1]). + +transform_to_EXTERNAL1990({_,_,_,_}=Val) -> + transform_to_EXTERNAL1990(tuple_to_list(Val), []); +transform_to_EXTERNAL1990(Val) when is_tuple(Val) -> + %% Data already in ASN1 1990 format + Val. + +transform_to_EXTERNAL1990(['EXTERNAL'|Rest], Acc) -> + transform_to_EXTERNAL1990(Rest, ['EXTERNAL'|Acc]); +transform_to_EXTERNAL1990([{syntax,Syntax}|Rest], Acc) -> + transform_to_EXTERNAL1990(Rest, [asn1_NOVALUE,Syntax|Acc]); +transform_to_EXTERNAL1990([{'presentation-context-id',PCid}|Rest], Acc) -> + transform_to_EXTERNAL1990(Rest, [PCid,asn1_NOVALUE|Acc]); +transform_to_EXTERNAL1990([{'context-negotiation',Context_negot}|Rest], Acc) -> + {_,Presentation_Cid,Transfer_syntax} = Context_negot, + transform_to_EXTERNAL1990(Rest, [Presentation_Cid,Transfer_syntax|Acc]); +transform_to_EXTERNAL1990([asn1_NOVALUE|Rest], Acc) -> + transform_to_EXTERNAL1990(Rest, [asn1_NOVALUE|Acc]); +transform_to_EXTERNAL1990([Data_val_desc,Data_value], Acc) + when is_list(Data_value)-> + list_to_tuple(lists:reverse([{'octet-aligned',Data_value}, + Data_val_desc|Acc])); +transform_to_EXTERNAL1990([Data_val_desc,Data_value], Acc) + when is_binary(Data_value) -> + list_to_tuple(lists:reverse([{'single-ASN1-type',Data_value}, + Data_val_desc|Acc])); +transform_to_EXTERNAL1990([Data_value], Acc) + when is_list(Data_value); is_binary(Data_value) -> + list_to_tuple(lists:reverse([{'octet-aligned',Data_value}|Acc])). + + +transform_to_EXTERNAL1994({'EXTERNAL',DRef,IndRef,Data_v_desc,Encoding}=V) -> + Identification = + case {DRef,IndRef} of + {DRef,asn1_NOVALUE} -> + {syntax,DRef}; + {asn1_NOVALUE,IndRef} -> + {'presentation-context-id',IndRef}; + _ -> + {'context-negotiation', + {'EXTERNAL_identification_context-negotiation',IndRef,DRef}} + end, + case Encoding of + {'octet-aligned',Val} when is_list(Val); is_binary(Val) -> + %% Transform to the EXTERNAL 1994 definition. + {'EXTERNAL',Identification,Data_v_desc,Val}; + _ -> + %% Keep the EXTERNAL 1990 definition to avoid losing + %% information. + V + end. diff --git a/lib/asn1/src/asn1rtt_per.erl b/lib/asn1/src/asn1rtt_per.erl new file mode 100644 index 0000000000..4713125ffc --- /dev/null +++ b/lib/asn1/src/asn1rtt_per.erl @@ -0,0 +1,976 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(asn1rtt_per). + +-export([setext/1, fixextensions/2, + skipextensions/3, getbit/1, getchoice/3, + set_choice/3,encode_integer/2, + encode_small_number/1, + encode_constrained_number/2, + encode_length/1, + encode_length/2, + encode_bit_string/3, + encode_object_identifier/1, + encode_relative_oid/1, + complete/1, + encode_open_type/1, + encode_GeneralString/2, + encode_GraphicString/2, + encode_TeletexString/2, + encode_VideotexString/2, + encode_ObjectDescriptor/2, + encode_UTF8String/1, + encode_octet_string/3, + encode_known_multiplier_string/4, + octets_to_complete/2]). + +-define('16K',16384). +-define('32K',32768). +-define('64K',65536). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% setext(true|false) -> CompleteList +%% + +setext(false) -> + [0]; +setext(true) -> + [1]. + +fixextensions({ext,ExtPos,ExtNum},Val) -> + case fixextensions(ExtPos,ExtNum+ExtPos,Val,0) of + 0 -> []; + ExtBits -> + [encode_small_length(ExtNum)|pre_complete_bits(ExtNum,ExtBits)] + end. + +fixextensions(Pos,MaxPos,_,Acc) when Pos >= MaxPos -> + Acc; +fixextensions(Pos,ExtPos,Val,Acc) -> + Bit = case catch(element(Pos+1,Val)) of + asn1_NOVALUE -> + 0; + asn1_NOEXTVALUE -> + 0; + {'EXIT',_} -> + 0; + _ -> + 1 + end, + fixextensions(Pos+1,ExtPos,Val,(Acc bsl 1)+Bit). + +skipextensions(Bytes0, Nr, ExtensionBitstr) when is_bitstring(ExtensionBitstr) -> + Prev = Nr - 1, + case ExtensionBitstr of + <<_:Prev,1:1,_/bitstring>> -> + {Len,Bytes1} = decode_length(Bytes0), + <<_:Len/binary,Bytes2/bitstring>> = Bytes1, + skipextensions(Bytes2, Nr+1, ExtensionBitstr); + <<_:Prev,0:1,_/bitstring>> -> + skipextensions(Bytes0, Nr+1, 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) -> + AlignBits = bit_size(BitStr) rem 8, + <<_: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() +%% Altnum = integer() | {integer(),integer()}% number of alternatives +%% Choices = [atom()] | {[atom()],[atom()]} +%% When Choices is a tuple the first list is the Rootset and the +%% second is the Extensions and then Altnum must also be a tuple with the +%% lengths of the 2 lists +%% +set_choice(Alt,{L1,L2},{Len1,_Len2}) -> + case set_choice_tag(Alt,L1) of + N when is_integer(N), Len1 > 1 -> + [0, % the value is in the root set + encode_constrained_number({0,Len1-1},N)]; + N when is_integer(N) -> + [0]; % no encoding if only 0 or 1 alternative + false -> + [1, % extension value + case set_choice_tag(Alt, L2) of + N2 when is_integer(N2) -> + encode_small_number(N2); + false -> + unknown_choice_alt + end] + end; +set_choice(Alt, L, Len) -> + case set_choice_tag(Alt, L) of + N when is_integer(N), Len > 1 -> + encode_constrained_number({0,Len-1},N); + N when is_integer(N) -> + []; % no encoding if only 0 or 1 alternative + false -> + [unknown_choice_alt] + end. + +set_choice_tag(Alt,Choices) -> + set_choice_tag(Alt,Choices,0). + +set_choice_tag(Alt,[Alt|_Rest],Tag) -> + Tag; +set_choice_tag(Alt,[_H|Rest],Tag) -> + set_choice_tag(Alt,Rest,Tag+1); +set_choice_tag(_Alt,[],_Tag) -> + false. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_open_type(Constraint, Value) -> CompleteList +%% Value = list of bytes of an already encoded value (the list must be flat) +%% | 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) -> + case byte_size(Val) of + Size when Size > 255 -> + [encode_length(Size),21,<<Size:16>>,Val]; % octets implies align + Size -> + [encode_length(Size),20,Size,Val] + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_integer(Constraint, Value) -> CompleteList +%% +encode_integer([{Rc,_Ec}],Val) when is_tuple(Rc) -> + try + [0|encode_integer([Rc], Val)] + catch + _:{error,{asn1,_}} -> + [1|encode_unconstrained_number(Val)] + end; +encode_integer([], Val) -> + encode_unconstrained_number(Val); +%% The constraint is the effective constraint, and in this case is a number +encode_integer([{'SingleValue',V}], V) -> + []; +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_semi_constrained_number(Lb, Val); +encode_integer([{'ValueRange',{'MIN',_}}], Val) -> + encode_unconstrained_number(Val); +encode_integer([{'ValueRange',VR={_Lb,_Ub}}], Val) -> + encode_constrained_number(VR, Val); +encode_integer(_,Val) -> + exit({error,{asn1,{illegal_value,Val}}}). + + +%% X.691:10.6 Encoding of a normally small non-negative whole number +%% Use this for encoding of CHOICE index if there is an extension marker in +%% the CHOICE +encode_small_number(Val) when Val < 64 -> + [10,7,Val]; +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, + Oct = eint_positive(Val2), + Len = length(Oct), + if + Len < 128 -> + [20,Len+1,Len|Oct]; + Len < 256 -> + [encode_length(Len),20,Len|Oct]; + true -> + [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]; +encode_constrained_number({Lb,_Ub},_Range,{octets,N},Val) when N < 256-> + %% N is 8 or 16 (1 or 2 octets) + Val2 = Val-Lb, + [20,N,Val2]; +encode_constrained_number({Lb,_Ub},_Range,{octets,N},Val) -> % N>255 + %% N is 8 or 16 (1 or 2 octets) + Val2 = Val-Lb, + [21,<<N:16>>,Val2]; +encode_constrained_number({Lb,_Ub},Range,_,Val) -> + Val2 = Val-Lb, + if + Range =< 16#1000000 -> % max 3 octets + Octs = eint_positive(Val2), + L = length(Octs), + [encode_length({1,3},L),[20,L,Octs]]; + Range =< 16#100000000 -> % max 4 octets + Octs = eint_positive(Val2), + L = length(Octs), + [encode_length({1,4},L),[20,L,Octs]]; + Range =< 16#10000000000 -> % max 5 octets + Octs = eint_positive(Val2), + L = length(Octs), + [encode_length({1,5},L),[20,L,Octs]]; + true -> + exit({not_supported,{integer_range,Range}}) + end. + +encode_constrained_number({Lb,Ub}, Val) when Val >= Lb, Ub >= Val -> + Range = Ub - Lb + 1, + Val2 = Val - Lb, + if + Range == 1 -> []; + Range == 2 -> + [Val2]; + Range =< 4 -> + [10,2,Val2]; + Range =< 8 -> + [10,3,Val2]; + Range =< 16 -> + [10,4,Val2]; + Range =< 32 -> + [10,5,Val2]; + Range =< 64 -> + [10,6,Val2]; + Range =< 128 -> + [10,7,Val2]; + Range =< 255 -> + [10,8,Val2]; + Range =< 256 -> + [20,1,Val2]; + Range =< 65536 -> + [20,2,<<Val2:16>>]; + Range =< (1 bsl (255*8)) -> + Octs = binary:encode_unsigned(Val2), + RangeOcts = binary:encode_unsigned(Range - 1), + OctsLen = byte_size(Octs), + RangeOctsLen = byte_size(RangeOcts), + LengthBitsNeeded = minimum_bits(RangeOctsLen - 1), + [10,LengthBitsNeeded,OctsLen-1,20,OctsLen,Octs]; + true -> + exit({not_supported,{integer_range,Range}}) + end; +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; +minimum_bits(N) when N < 8 -> 3; +minimum_bits(N) when N < 16 -> 4; +minimum_bits(N) when N < 32 -> 5; +minimum_bits(N) when N < 64 -> 6; +minimum_bits(N) when N < 128 -> 7; +minimum_bits(_N) -> 8. + +%% X.691:10.8 Encoding of an unconstrained whole number + +encode_unconstrained_number(Val) -> + Oct = if + Val >= 0 -> + eint(Val, []); + true -> + enint(Val, []) + end, + Len = length(Oct), + if + Len < 128 -> + [20,Len + 1,Len|Oct]; + Len < 256 -> + [20,Len + 2,<<2:2,Len:14>>|Oct]; + true -> + [encode_length(Len),21,<<Len:16>>|Oct] + end. + +%% used for positive Values which don't need a sign bit +%% returns a list +eint_positive(Val) -> + case eint(Val,[]) of + [0,B1|T] -> + [B1|T]; + T -> + T + end. + + +eint(0, [B|Acc]) when B < 128 -> + [B|Acc]; +eint(N, Acc) -> + eint(N bsr 8, [N band 16#ff| Acc]). + +enint(-1, [B1|T]) when B1 > 127 -> + [B1|T]; +enint(N, Acc) -> + enint(N bsr 8, [N band 16#ff|Acc]). + +%% X.691:10.9 Encoding of a length determinant +%%encode_small_length(undefined,Len) -> % null means no UpperBound +%% encode_small_number(Len). + +%% X.691:10.9.3.5 +%% X.691:10.9.3.7 +encode_length(Len) -> % unconstrained + if + Len < 128 -> + [20,1,Len]; + Len < 16384 -> + <<20,2,2:2,Len:14>>; + true -> % should be able to endode length >= 16384 i.e. fragmented length + 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) -> + []. + +%% X.691 10.9.3.4 (only used for length of bitmap that prefixes extension +%% additions in a sequence or set +encode_small_length(Len) when Len =< 64 -> + [10,7,Len-1]; +encode_small_length(Len) -> + [1,encode_length(Len)]. + + +decode_length(Buffer) -> % un-constrained + case align(Buffer) of + <<0:1,Oct:7,Rest/binary>> -> + {Oct,Rest}; + <<2:2,Val:14,Rest/binary>> -> + {Val,Rest}; + <<3:2,_Val:14,_Rest/binary>> -> + %% this case should be fixed + 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: +%% - [identifiers] where only named identifers are set to one, +%% the Constraint must then have some information of the +%% bitlength. +%% - [list of ones and zeroes] all bits +%% - integer value representing the bitlist +%% C is constraint Len, only valid when identifiers + + +%% when the value is a list of {Unused,BinBits}, where +%% Unused = integer(), +%% BinBits = binary(). + +encode_bit_string(C, Bits, NamedBitList) when is_bitstring(Bits) -> + PadLen = (8 - (bit_size(Bits) band 7)) band 7, + Compact = {PadLen,<<Bits/bitstring,0:PadLen>>}, + encode_bin_bit_string(C, Compact, NamedBitList); +encode_bit_string(C, {Unused,BinBits}=Bin, NamedBitList) + when is_integer(Unused), is_binary(BinBits) -> + encode_bin_bit_string(C,Bin,NamedBitList); + +%% when the value is a list of named bits + +encode_bit_string(C, LoNB=[FirstVal | _RestVal], NamedBitList) when is_atom(FirstVal) -> + ToSetPos = get_all_bitposes(LoNB, NamedBitList, []), + BitList = make_and_set_list(ToSetPos,0), + encode_bit_string(C,BitList,NamedBitList);% consider the constraint + +encode_bit_string(C, BL=[{bit,_} | _RestVal], NamedBitList) -> + ToSetPos = get_all_bitposes(BL, NamedBitList, []), + BitList = make_and_set_list(ToSetPos,0), + encode_bit_string(C,BitList,NamedBitList); + +%% when the value is a list of ones and zeroes +encode_bit_string(Int, BitListValue, _) + when is_list(BitListValue),is_integer(Int),Int =< 16 -> + %% The type is constrained by a single value size constraint + %% range_check(Int,length(BitListValue)), + [40,Int,length(BitListValue),BitListValue]; +encode_bit_string(Int, BitListValue, _) + when is_list(BitListValue),is_integer(Int), Int =< 255 -> + %% The type is constrained by a single value size constraint + %% range_check(Int,length(BitListValue)), + [2,40,Int,length(BitListValue),BitListValue]; +encode_bit_string(Int, BitListValue, _) + when is_list(BitListValue),is_integer(Int), Int < ?'64K' -> + {Code,DesiredLength,Length} = + case length(BitListValue) of + B1 when B1 > Int -> + exit({error,{'BIT_STRING_length_greater_than_SIZE', + Int,BitListValue}}); + B1 when B1 =< 255,Int =< 255 -> + {40,Int,B1}; + B1 when B1 =< 255 -> + {42,<<Int:16>>,B1}; + B1 -> + {43,<<Int:16>>,<<B1:16>>} + end, + %% The type is constrained by a single value size constraint + [2,Code,DesiredLength,Length,BitListValue]; +encode_bit_string(no, BitListValue,[]) + when is_list(BitListValue) -> + [encode_length(length(BitListValue)), + 2|BitListValue]; +encode_bit_string({{Fix,Fix},Ext}, BitListValue,[]) + when is_integer(Fix), is_list(Ext) -> + case length(BitListValue) of + Len when Len =< Fix -> + [0|encode_bit_string(Fix, BitListValue, [])]; + _ -> + [1|encode_bit_string(no, BitListValue, [])] + end; +encode_bit_string(C, BitListValue,[]) + when is_list(BitListValue) -> + [encode_length(C, length(BitListValue)), + 2|BitListValue]; +encode_bit_string(no, BitListValue,_NamedBitList) + when is_list(BitListValue) -> + %% this case with an unconstrained BIT STRING can be made more efficient + %% if the complete driver can take a special code so the length field + %% is encoded there. + NewBitLVal = lists:reverse(lists:dropwhile(fun(0)->true;(1)->false end, + lists:reverse(BitListValue))), + [encode_length(length(NewBitLVal)),2|NewBitLVal]; +encode_bit_string({{Fix,Fix},Ext}, BitListValue, NamedBitList) + when is_integer(Fix), is_list(Ext) -> + case length(BitListValue) of + Len when Len =< Fix -> + [0|encode_bit_string(Fix, BitListValue, NamedBitList)]; + _ -> + [1|encode_bit_string(no, BitListValue, NamedBitList)] + end; +encode_bit_string(C, BitListValue, _NamedBitList) + when is_list(BitListValue) -> % C = {_,'MAX'} + NewBitLVal = bit_string_trailing_zeros(BitListValue, C), + [encode_length(C, length(NewBitLVal)),2|NewBitLVal]; + + +%% when the value is an integer +encode_bit_string(C, IntegerVal, NamedBitList) when is_integer(IntegerVal)-> + BitList = int_to_bitlist(IntegerVal), + encode_bit_string(C,BitList,NamedBitList). + +bit_string_trailing_zeros(BitList,C) when is_integer(C) -> + bit_string_trailing_zeros1(BitList,C,C); +bit_string_trailing_zeros(BitList,{Lb,Ub}) when is_integer(Lb) -> + bit_string_trailing_zeros1(BitList,Lb,Ub); +bit_string_trailing_zeros(BitList,{{Lb,Ub},_}) when is_integer(Lb) -> + bit_string_trailing_zeros1(BitList,Lb,Ub); +bit_string_trailing_zeros(BitList,_) -> + BitList. + +bit_string_trailing_zeros1(BitList,Lb,Ub) -> + case length(BitList) of + Lb -> BitList; + B when B < Lb -> BitList++lists:duplicate(Lb-B, 0); + D -> F = fun(L,LB,LB,_,_)->lists:reverse(L); + ([0|R],L1,LB,UB,Fun)->Fun(R,L1-1,LB,UB,Fun); + (L,L1,_,UB,_)when L1 =< UB -> lists:reverse(L); + (_,_L1,_,_,_) ->exit({error,{list_length_BIT_STRING, + BitList}}) end, + F(lists:reverse(BitList),D,Lb,Ub,F) + end. + +%% encode_bin_bit_string/3, when value is a tuple of Unused and BinBits. +%% Unused = integer(),i.e. number unused bits in least sign. byte of +%% BinBits = binary(). +encode_bin_bit_string(C, {Unused,BinBits}, _NamedBitList) + when is_integer(C),C=<16 -> + range_check(C, bit_size(BinBits) - Unused), + [45,C,size(BinBits),BinBits]; +encode_bin_bit_string(C, {Unused,BinBits}, _NamedBitList) + when is_integer(C), C =< 255 -> + range_check(C, bit_size(BinBits) - Unused), + [2,45,C,size(BinBits),BinBits]; +encode_bin_bit_string(C, {Unused,BinBits}, _NamedBitList) + when is_integer(C), C =< 65535 -> + range_check(C, bit_size(BinBits) - Unused), + case byte_size(BinBits) of + Size when Size =< 255 -> + [2,46,<<C:16>>,Size,BinBits]; + Size -> + [2,47,<<C:16>>,<<Size:16>>,BinBits] + end; +encode_bin_bit_string(C,UnusedAndBin={_,_},NamedBitList) -> + {Unused1,Bin1} = + %% removes all trailing bits if NamedBitList is not empty + remove_trailing_bin(NamedBitList,UnusedAndBin), + case C of + {Lb,Ub} when is_integer(Lb),is_integer(Ub) -> + Size = byte_size(Bin1), + [encode_length({Lb,Ub}, Size*8 - Unused1), + 2,octets_unused_to_complete(Unused1,Size,Bin1)]; + no -> + Size = byte_size(Bin1), + [encode_length(Size*8 - Unused1), + 2|octets_unused_to_complete(Unused1, Size, Bin1)]; + {{Fix,Fix},Ext} when is_integer(Fix),is_list(Ext) -> + case byte_size(Bin1)*8 - Unused1 of + Size when Size =< Fix -> + [0|encode_bin_bit_string(Fix,UnusedAndBin,NamedBitList)]; + _Size -> + [1|encode_bin_bit_string(no,UnusedAndBin,NamedBitList)] + end; + Sc -> + Size = byte_size(Bin1), + [encode_length(Sc, Size*8 - Unused1), + 2|octets_unused_to_complete(Unused1,Size,Bin1)] + end. + +range_check(C,C) when is_integer(C) -> + ok; +range_check(C1,C2) when is_integer(C1) -> + exit({error,{asn1,{bit_string_out_of_range,{C1,C2}}}}). + +remove_trailing_bin([], {Unused,Bin}) -> + {Unused,Bin}; +remove_trailing_bin(_NamedNumberList,{_Unused,<<>>}) -> + {0,<<>>}; +remove_trailing_bin(NamedNumberList, {_Unused,Bin}) -> + Size = byte_size(Bin)-1, + <<Bfront:Size/binary, LastByte:8>> = Bin, + %% clear the Unused bits to be sure + Unused1 = trailingZeroesInNibble(LastByte band 15), + Unused2 = + case Unused1 of + 4 -> + 4 + trailingZeroesInNibble(LastByte bsr 4); + _ -> Unused1 + end, + case Unused2 of + 8 -> + remove_trailing_bin(NamedNumberList,{0,Bfront}); + _ -> + {Unused2,Bin} + end. + + +trailingZeroesInNibble(0) -> + 4; +trailingZeroesInNibble(1) -> + 0; +trailingZeroesInNibble(2) -> + 1; +trailingZeroesInNibble(3) -> + 0; +trailingZeroesInNibble(4) -> + 2; +trailingZeroesInNibble(5) -> + 0; +trailingZeroesInNibble(6) -> + 1; +trailingZeroesInNibble(7) -> + 0; +trailingZeroesInNibble(8) -> + 3; +trailingZeroesInNibble(9) -> + 0; +trailingZeroesInNibble(10) -> + 1; +trailingZeroesInNibble(11) -> + 0; +trailingZeroesInNibble(12) -> %#1100 + 2; +trailingZeroesInNibble(13) -> + 0; +trailingZeroesInNibble(14) -> + 1; +trailingZeroesInNibble(15) -> + 0. + + +%%%%%%%%%%%%%%% +%% + +int_to_bitlist(Int) when is_integer(Int), Int > 0 -> + [Int band 1 | int_to_bitlist(Int bsr 1)]; +int_to_bitlist(0) -> + []. + + +%%%%%%%%%%%%%%%%%% +%% get_all_bitposes([list of named bits to set], named_bit_db, []) -> +%% [sorted_list_of_bitpositions_to_set] + +get_all_bitposes([{bit,ValPos}|Rest], NamedBitList, Ack) -> + get_all_bitposes(Rest, NamedBitList, [ValPos | Ack ]); + +get_all_bitposes([Val | Rest], NamedBitList, Ack) -> + case lists:keyfind(Val, 1, NamedBitList) of + {_ValName, ValPos} -> + get_all_bitposes(Rest, NamedBitList, [ValPos | Ack]); + false -> + exit({error,{asn1, {bitstring_namedbit, Val}}}) + end; +get_all_bitposes([], _NamedBitList, Ack) -> + lists:sort(Ack). + +%%%%%%%%%%%%%%%%%% +%% make_and_set_list([list of positions to set to 1])-> +%% returns list with all in SetPos set. +%% in positioning in list the first element is 0, the second 1 etc.., but +%% + +make_and_set_list([XPos|SetPos], XPos) -> + [1 | make_and_set_list(SetPos, XPos + 1)]; +make_and_set_list([Pos|SetPos], XPos) -> + [0 | make_and_set_list([Pos | SetPos], XPos + 1)]; +make_and_set_list([], _) -> + []. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% X.691:16 +%% encode_octet_string(Constraint,ExtensionMarker,Val) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +encode_octet_string(_C, true, _Val) -> + exit({error,{asn1,{'not_supported',extensionmarker}}}); +encode_octet_string({_,_}=SZ, false, Val) -> + Len = length(Val), + try + [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(SZ, false, Val) when is_list(SZ) -> + Len = length(Val), + try + [encode_length({hd(SZ),lists:max(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_fragmented_octet_string(Val); +encode_octet_string(no, false, 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}}). + +encode_fragmented_octet_string(Val) -> + Bin = iolist_to_binary(Val), + efos_1(Bin). + +efos_1(<<B1:16#C000/binary,B2:16#4000/binary,T/binary>>) -> + [20,1,<<3:2,4:6>>, + octets_to_complete(16#C000, B1), + octets_to_complete(16#4000, B2)|efos_1(T)]; +efos_1(<<B:16#C000/binary,T/binary>>) -> + [20,1,<<3:2,3:6>>,octets_to_complete(16#C000, B)|efos_1(T)]; +efos_1(<<B:16#8000/binary,T/binary>>) -> + [20,1,<<3:2,2:6>>,octets_to_complete(16#8000, B)|efos_1(T)]; +efos_1(<<B:16#4000/binary,T/binary>>) -> + [20,1,<<3:2,1:6>>,octets_to_complete(16#4000, B)|efos_1(T)]; +efos_1(<<>>) -> + [20,1,0]; +efos_1(<<B/bitstring>>) -> + Len = byte_size(B), + [encode_length(Len)|octets_to_complete(Len, B)]. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Restricted char string types +%% (NumericString, PrintableString,VisibleString,IA5String,BMPString,UniversalString) +%% X.691:26 and X.680:34-36 + +encode_restricted_string(Val) when is_list(Val)-> + Len = length(Val), + [encode_length(Len)|octets_to_complete(Len, 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 -> + Result; + Ub when is_integer(Ub), Ub =<65535 -> % fixed length + [2,Result]; + {Ub,Lb} -> + [encode_length({Ub,Lb},length(Val)),2,Result]; + no -> + [encode_length(length(Val)),2,Result] + end. + +encode_GeneralString(_C,Val) -> + encode_restricted_string(Val). + +encode_GraphicString(_C,Val) -> + encode_restricted_string(Val). + +encode_ObjectDescriptor(_C,Val) -> + encode_restricted_string(Val). + +encode_TeletexString(_C,Val) -> % equivalent with T61String + encode_restricted_string(Val). + +encode_VideotexString(_C,Val) -> + encode_restricted_string(Val). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% chars_encode(C,StringType,Value) -> ValueList +%% +%% encodes chars according to the per rules taking the constraint +%% PermittedAlphabet into account. +%% +%% This function only encodes the value part and NOT the length. + +chars_encode2([H|T],NumBits,T1={Min,Max,notab}) when H =< Max, H >= Min -> + [pre_complete_bits(NumBits,H-Min)|chars_encode2(T,NumBits,T1)]; +chars_encode2([H|T],NumBits,T1={Min,Max,Tab}) when H =< Max, H >= Min -> + [pre_complete_bits(NumBits,exit_if_false(H,element(H-Min+1,Tab)))| + chars_encode2(T,NumBits,T1)]; +chars_encode2([{A,B,C,D}|T],NumBits,T1={Min,_Max,notab}) -> + %% no value range check here (ought to be, but very expensive) + [pre_complete_bits(NumBits, + ((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min)| + chars_encode2(T,NumBits,T1)]; +chars_encode2([H={A,B,C,D}|T],NumBits,{Min,Max,Tab}) -> + %% no value range check here (ought to be, but very expensive) + [pre_complete_bits(NumBits,exit_if_false(H,element(((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min,Tab)))|chars_encode2(T,NumBits,{Min,Max,notab})]; +chars_encode2([H|_T],_NumBits,{_Min,_Max,_Tab}) -> + exit({error,{asn1,{illegal_char_value,H}}}); +chars_encode2([],_,_) -> + []. + +exit_if_false(V,false)-> + exit({error,{asn1,{"illegal value according to Permitted alphabet constraint",V}}}); +exit_if_false(_,V) ->V. + +pre_complete_bits(NumBits,Val) when NumBits =< 8 -> + [10,NumBits,Val]; +pre_complete_bits(NumBits,Val) when NumBits =< 16 -> + [10,NumBits-8,Val bsr 8,10,8,(Val band 255)]; +pre_complete_bits(NumBits,Val) when NumBits =< 2040 -> % 255 * 8 + Unused = (8 - (NumBits rem 8)) rem 8, + Len = NumBits + Unused, + [30,Unused,Len div 8,<<(Val bsl Unused):Len>>]. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_UTF8String(Val) -> CompleteList +%% Val -> <<utf8encoded binary>> +%% CompleteList -> [apropriate codes and values for driver complete] +%% +encode_UTF8String(Val) when is_binary(Val) -> + Sz = byte_size(Val), + [encode_length(Sz),octets_to_complete(Sz, Val)]; +encode_UTF8String(Val) -> + encode_UTF8String(list_to_binary(Val)). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_object_identifier(Val) -> CompleteList +%% encode_object_identifier({Name,Val}) -> CompleteList +%% Val -> {Int1,Int2,...,IntN} % N >= 2 +%% Name -> atom() +%% Int1 -> integer(0..2) +%% Int2 -> integer(0..39) when Int1 (0..1) else integer() +%% Int3-N -> integer() +%% CompleteList -> [{bits,8,Val}|{octets,Ol}|align|...] +%% +encode_object_identifier(Val) -> + OctetList = e_object_identifier(Val), + Octets = list_to_binary(OctetList), + Sz = byte_size(Octets), + [encode_length(Sz), + octets_to_complete(Sz, Octets)]. + +e_object_identifier({'OBJECT IDENTIFIER',V}) -> + e_object_identifier(V); +e_object_identifier(V) when is_tuple(V) -> + e_object_identifier(tuple_to_list(V)); + +%% E1 = 0|1|2 and (E2 < 40 when E1 = 0|1) +e_object_identifier([E1,E2|Tail]) when E1 >= 0, E1 < 2, E2 < 40 ; E1==2 -> + Head = 40*E1 + E2, % weird + e_object_elements([Head|Tail],[]); +e_object_identifier(Oid=[_,_|_Tail]) -> + exit({error,{asn1,{'illegal_value',Oid}}}). + +e_object_elements([],Acc) -> + lists:reverse(Acc); +e_object_elements([H|T],Acc) -> + e_object_elements(T,[e_object_element(H)|Acc]). + +e_object_element(Num) when Num < 128 -> + [Num]; +e_object_element(Num) -> + [e_o_e(Num bsr 7)|[Num band 2#1111111]]. +e_o_e(Num) when Num < 128 -> + Num bor 2#10000000; +e_o_e(Num) -> + [e_o_e(Num bsr 7)|[(Num band 2#1111111) bor 2#10000000]]. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_relative_oid(Val) -> CompleteList +%% encode_relative_oid({Name,Val}) -> CompleteList +encode_relative_oid(Val) when is_tuple(Val) -> + encode_relative_oid(tuple_to_list(Val)); +encode_relative_oid(Val) when is_list(Val) -> + Octets = list_to_binary([e_object_element(X)||X <- Val]), + Sz = byte_size(Octets), + [encode_length(Sz)|octets_to_complete(Sz, Octets)]. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% complete(InList) -> ByteList +%% Takes a coded list with bits and bytes and converts it to a list of bytes +%% Should be applied as the last step at encode of a complete ASN.1 type +%% + +complete(L) -> + asn1rt_nif:encode_per_complete(L). + +octets_to_complete(Len,Val) when Len < 256 -> + [20,Len,Val]; +octets_to_complete(Len,Val) -> + [21,<<Len:16>>,Val]. + +octets_unused_to_complete(Unused,Len,Val) when Len < 256 -> + [30,Unused,Len,Val]; +octets_unused_to_complete(Unused,Len,Val) -> + [31,Unused,<<Len:16>>,Val]. diff --git a/lib/asn1/src/asn1rtt_per_common.erl b/lib/asn1/src/asn1rtt_per_common.erl new file mode 100644 index 0000000000..a7d359a288 --- /dev/null +++ b/lib/asn1/src/asn1rtt_per_common.erl @@ -0,0 +1,126 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(asn1rtt_per_common). + +-include("asn1_records.hrl"). + +-export([decode_fragmented/3, + decode_compact_bit_string/1, + decode_legacy_bit_string/1, + decode_named_bit_string/2, + decode_chars/2,decode_chars/3, + decode_chars_16bit/1, + decode_big_chars/2, + decode_oid/1,decode_relative_oid/1]). + +-define('16K',16384). + +decode_fragmented(SegSz0, Buf0, Unit) -> + SegSz = SegSz0 * Unit * ?'16K', + <<Res:SegSz/bitstring,Buf/bitstring>> = Buf0, + decode_fragmented_1(Buf, Unit, Res). + +decode_fragmented_1(<<0:1,N:7,Buf0/bitstring>>, Unit, Res) -> + Sz = N*Unit, + <<S:Sz/bitstring,Buf/bitstring>> = Buf0, + {<<Res/bitstring,S/bitstring>>,Buf}; +decode_fragmented_1(<<1:1,0:1,N:14,Buf0/bitstring>>, Unit, Res) -> + Sz = N*Unit, + <<S:Sz/bitstring,Buf/bitstring>> = Buf0, + {<<Res/bitstring,S/bitstring>>,Buf}; +decode_fragmented_1(<<1:1,1:1,SegSz0:6,Buf0/bitstring>>, Unit, Res0) -> + SegSz = SegSz0 * Unit * ?'16K', + <<Frag:SegSz/bitstring,Buf/bitstring>> = Buf0, + Res = <<Res0/bitstring,Frag/bitstring>>, + decode_fragmented_1(Buf, Unit, Res). + +decode_named_bit_string(Val, NNL) -> + Bits = [B || <<B:1>> <= Val], + decode_named_bit_string_1(0, Bits, NNL, []). + +decode_legacy_bit_string(Val) -> + [B || <<B:1>> <= Val]. + +decode_compact_bit_string(Val) -> + PadLen = (8 - (bit_size(Val) band 7)) band 7, + {PadLen,<<Val/bitstring,0:PadLen>>}. + +decode_chars(Val, N) -> + [C || <<C:N>> <= Val]. + +decode_chars(Val, N, Chars) -> + [element(C+1, Chars) || <<C:N>> <= Val]. + +decode_chars_16bit(Val) -> + Cs = [C || <<C:16>> <= Val], + decode_chars_16bit_1(Cs). + +decode_big_chars(Val, N) -> + decode_big_chars_1(decode_chars(Val, N)). + +decode_oid(Octets) -> + [First|Rest] = dec_subidentifiers(Octets, 0, []), + Idlist = if + First < 40 -> + [0,First|Rest]; + First < 80 -> + [1,First - 40|Rest]; + true -> + [2,First - 80|Rest] + end, + list_to_tuple(Idlist). + +decode_relative_oid(Octets) -> + list_to_tuple(dec_subidentifiers(Octets, 0, [])). + +%%% +%%% Internal functions. +%%% + +decode_named_bit_string_1(Pos, [0|Bt], Names, Acc) -> + decode_named_bit_string_1(Pos+1, Bt, Names, Acc); +decode_named_bit_string_1(Pos, [1|Bt], Names, Acc) -> + case lists:keyfind(Pos, 2, Names) of + {Name,_} -> + decode_named_bit_string_1(Pos+1, Bt, Names, [Name|Acc]); + false -> + decode_named_bit_string_1(Pos+1, Bt, Names, [{bit,Pos}|Acc]) + end; +decode_named_bit_string_1(_Pos, [], _Names, Acc) -> + lists:reverse(Acc). + +decode_chars_16bit_1([H|T]) when H < 256 -> + [H|decode_chars_16bit_1(T)]; +decode_chars_16bit_1([H|T]) -> + [{0,0,H bsr 8,H band 255}|decode_chars_16bit_1(T)]; +decode_chars_16bit_1([]) -> []. + +decode_big_chars_1([H|T]) when H < 256 -> + [H|decode_big_chars_1(T)]; +decode_big_chars_1([H|T]) -> + [list_to_tuple(binary_to_list(<<H:32>>))|decode_big_chars_1(T)]; +decode_big_chars_1([]) -> []. + +dec_subidentifiers([H|T], Av, Al) when H >=16#80 -> + dec_subidentifiers(T, (Av bsl 7) bor (H band 16#7F), Al); +dec_subidentifiers([H|T], Av, Al) -> + dec_subidentifiers(T, 0, [(Av bsl 7) bor H|Al]); +dec_subidentifiers([], _Av, Al) -> + lists:reverse(Al). diff --git a/lib/asn1/src/asn1rtt_real_common.erl b/lib/asn1/src/asn1rtt_real_common.erl new file mode 100644 index 0000000000..540f0d60a5 --- /dev/null +++ b/lib/asn1/src/asn1rtt_real_common.erl @@ -0,0 +1,292 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(asn1rtt_real_common). + +-export([encode_real/1,decode_real/1, + ber_encode_real/1]). + +%%============================================================================ +%% +%% Real value, ITU_T X.690 Chapter 8.5 +%%============================================================================ +%% +%% encode real value +%%============================================================================ + +ber_encode_real(0) -> + {[],0}; +ber_encode_real('PLUS-INFINITY') -> + {[64],1}; +ber_encode_real('MINUS-INFINITY') -> + {[65],1}; +ber_encode_real(Val) when is_tuple(Val); is_list(Val) -> + encode_real(Val). + +%%%%%%%%%%%%%% +%% only base 2 encoding! +%% binary encoding: +%% +------------+ +------------+ +-+-+-+-+---+---+ +%% | (tag)9 | | n + p + 1 | |1|S|BB |FF |EE | +%% +------------+ +------------+ +-+-+-+-+---+---+ +%% +%% +------------+ +------------+ +%% | | | | +%% +------------+ ...+------------+ +%% n octets for exponent +%% +%% +------------+ +------------+ +%% | | | | +%% +------------+ ...+------------+ +%% p octets for pos mantissa +%% +%% S is 0 for positive sign +%% 1 for negative sign +%% BB: encoding base, 00 = 2, (01 = 8, 10 = 16) +%% 01 and 10 not used +%% FF: scale factor 00 = 0 (used in base 2 encoding) +%% EE: encoding of the exponent: +%% 00 - on the following octet +%% 01 - on the 2 following octets +%% 10 - on the 3 following octets +%% 11 - encoding of the length of the two's-complement encoding of +%% exponent on the following octet, and two's-complement +%% encoding of exponent on the other octets. +%% +%% In DER and base 2 encoding the mantissa is encoded as value 0 or +%% bit shifted until it is an odd number. Thus, do this for BER as +%% well. + +encode_real(Real) -> + encode_real([], Real). + +encode_real(_C, {Mantissa, Base, Exponent}) when Base =:= 2 -> +%% io:format("Mantissa: ~w Base: ~w, Exp: ~w~n",[Man, Base, Exp]), + {Man,ExpAdd} = truncate_zeros(Mantissa), %% DER adjustment + Exp = Exponent + ExpAdd, + OctExp = if Exp >= 0 -> list_to_binary(encode_pos_integer(Exp, [])); + true -> list_to_binary(encode_neg_integer(Exp, [])) + end, +%% ok = io:format("OctExp: ~w~n",[OctExp]), + SignBit = if Man > 0 -> 0; % bit 7 is pos or neg, no Zeroval + true -> 1 + end, +%% ok = io:format("SignBitMask: ~w~n",[SignBitMask]), + SFactor = 0, + OctExpLen = size(OctExp), + if OctExpLen > 255 -> + exit({error,{asn1, {to_big_exp_in_encode_real, OctExpLen}}}); + true -> true %% make real assert later.. + end, + {LenCode, EOctets} = case OctExpLen of % bit 2,1 + 1 -> {0, OctExp}; + 2 -> {1, OctExp}; + 3 -> {2, OctExp}; + _ -> {3, <<OctExpLen, OctExp/binary>>} + end, + BB = 0, %% 00 for base 2 + FirstOctet = <<1:1,SignBit:1,BB:2,SFactor:2,LenCode:2>>, + OctMantissa = if Man > 0 -> list_to_binary(real_mininum_octets(Man)); + true -> list_to_binary(real_mininum_octets(-(Man))) % signbit keeps track of sign + end, + %% ok = io:format("LenMask: ~w EOctets: ~w~nFirstOctet: ~w OctMantissa: ~w OctExpLen: ~w~n", [LenMask, EOctets, FirstOctet, OctMantissa, OctExpLen]), + Bin = <<FirstOctet/binary, EOctets/binary, OctMantissa/binary>>, + {Bin, size(Bin)}; +encode_real(C, {Mantissa,Base,Exponent}) + when Base =:= 10, is_integer(Mantissa), is_integer(Exponent) -> + %% always encode as NR3 due to DER on the format + %% mmmm.Eseeee where + %% m := digit + %% s := '-' | '+' | [] + %% '+' only allowed in +0 + %% e := digit + %% ex: 1234.E-5679 + ManStr = integer_to_list(Mantissa), + + encode_real_as_string(C,ManStr,Exponent); +encode_real(_C, {_,Base,_}) -> + exit({error,{asn1, {encode_real_non_supported_encoding, Base}}}); +%% base 10 +encode_real(C, Real) when is_list(Real) -> + %% The Real string may come in as a NR1, NR2 or NR3 string. + {Mantissa, Exponent} = + case string:tokens(Real,"Ee") of + [NR2] -> + {NR2,0}; + [NR3MB,NR3E] -> + %% remove beginning zeros + {NR3MB,list_to_integer(NR3E)} + end, + + %% .Decimal | Number | Number.Decimal + ZeroDecimal = + fun("0") -> ""; + (L) -> L + end, + {NewMantissa,LenDecimal} = + case Mantissa of + [$.|Dec] -> + NewMan = remove_trailing_zeros(Dec), + {NewMan,length(ZeroDecimal(NewMan))}; + _ -> + case string:tokens(Mantissa,",.") of + [Num] -> %% No decimal-mark + {integer_to_list(list_to_integer(Num)),0}; + [Num,Dec] -> + NewDec = ZeroDecimal(remove_trailing_zeros(Dec)), + NewMan = integer_to_list(list_to_integer(Num)) ++ NewDec, + {integer_to_list(list_to_integer(NewMan)), + length(NewDec)} + end + end, + + encode_real_as_string(C, NewMantissa, Exponent - LenDecimal). + +encode_real_as_string(_C, Mantissa, Exponent) + when is_list(Mantissa), is_integer(Exponent) -> + %% Remove trailing zeros in Mantissa and add this to Exponent + TruncMant = remove_trailing_zeros(Mantissa), + + ExpIncr = length(Mantissa) - length(TruncMant), + + ExpStr = integer_to_list(Exponent + ExpIncr), + + ExpBin = + case ExpStr of + "0" -> + <<"E+0">>; + _ -> + ExpB = list_to_binary(ExpStr), + <<$E,ExpB/binary>> + end, + ManBin = list_to_binary(TruncMant), + NR3 = 3, + {<<NR3,ManBin/binary,$.,ExpBin/binary>>, + 2 + byte_size(ManBin) + byte_size(ExpBin)}. + +remove_trailing_zeros(IntStr) -> + case lists:dropwhile(fun($0)-> true; + (_) -> false + end, lists:reverse(IntStr)) of + [] -> + "0"; + ReversedIntStr -> + lists:reverse(ReversedIntStr) + end. + +truncate_zeros(Num) -> + truncate_zeros(Num, 0). +truncate_zeros(0, Sum) -> + {0,Sum}; +truncate_zeros(M, Sum) -> + case M band 16#f =:= M band 16#e of + true -> truncate_zeros(M bsr 1, Sum+1); + _ -> {M,Sum} + end. + + +%%============================================================================ +%% decode real value +%% +%% decode_real([OctetBufferList], tuple|value, tag|notag) -> +%% {{Mantissa, Base, Exp} | realval | PLUS-INFINITY | MINUS-INFINITY | 0, +%% RestBuff} +%% +%% only for base 2 decoding sofar!! +%%============================================================================ + +decode_real(Buffer) -> + Sz = byte_size(Buffer), + {RealVal,<<>>,Sz} = decode_real2(Buffer, [], Sz, 0), + RealVal. + +decode_real2(Buffer, _C, 0, _RemBytes) -> + {0,Buffer}; +decode_real2(Buffer0, _C, Len, RemBytes1) -> + <<First, Buffer2/binary>> = Buffer0, + if + First =:= 2#01000000 -> {'PLUS-INFINITY', Buffer2}; + First =:= 2#01000001 -> {'MINUS-INFINITY', Buffer2}; + First =:= 1 orelse First =:= 2 orelse First =:= 3 -> + %% charcter string encoding of base 10 + {NRx,Rest} = split_binary(Buffer2,Len-1), + {binary_to_list(NRx),Rest,Len}; + true -> + %% have some check here to verify only supported bases (2) + %% not base 8 or 16 + <<_B7:1,Sign:1,BB:2,_FF:2,EE:2>> = <<First>>, + Base = + case BB of + 0 -> 2; % base 2, only one so far + _ -> exit({error,{asn1, {non_supported_base, BB}}}) + end, + {FirstLen, {Exp, Buffer3,_Rb2}, RemBytes2} = + case EE of + 0 -> {2, decode_integer2(1, Buffer2, RemBytes1), RemBytes1+1}; + 1 -> {3, decode_integer2(2, Buffer2, RemBytes1), RemBytes1+2}; + 2 -> {4, decode_integer2(3, Buffer2, RemBytes1), RemBytes1+3}; + 3 -> + <<ExpLen1,RestBuffer/binary>> = Buffer2, + { ExpLen1 + 2, + decode_integer2(ExpLen1, RestBuffer, RemBytes1), + RemBytes1+ExpLen1} + end, + %% io:format("FirstLen: ~w, Exp: ~w, Buffer3: ~w ~n", + + Length = Len - FirstLen, + <<LongInt:Length/unit:8,RestBuff/binary>> = Buffer3, + {{Mantissa, Buffer4}, RemBytes3} = + if Sign =:= 0 -> + %% io:format("sign plus~n"), + {{LongInt, RestBuff}, 1 + Length}; + true -> + %% io:format("sign minus~n"), + {{-LongInt, RestBuff}, 1 + Length} + end, + {{Mantissa, Base, Exp}, Buffer4, RemBytes2+RemBytes3} + end. + +encode_pos_integer(0, [B|_Acc]=L) when B < 128 -> + L; +encode_pos_integer(N, Acc) -> + encode_pos_integer(N bsr 8, [N band 16#ff| Acc]). + +encode_neg_integer(-1, [B1|_T]=L) when B1 > 127 -> + L; +encode_neg_integer(N, Acc) -> + encode_neg_integer(N bsr 8, [N band 16#ff|Acc]). + + +%% Val must be >= 0 +real_mininum_octets(Val) -> + real_mininum_octets(Val, []). + +real_mininum_octets(0, Acc) -> + Acc; +real_mininum_octets(Val, Acc) -> + real_mininum_octets(Val bsr 8, [Val band 16#FF | Acc]). + +%% decoding postitive integer values. +decode_integer2(Len, <<0:1,_:7,_Bs/binary>> = Bin, RemovedBytes) -> + <<Int:Len/unit:8,Buffer2/binary>> = Bin, + {Int,Buffer2,RemovedBytes}; +%% decoding negative integer values. +decode_integer2(Len, <<1:1,B2:7,Bs/binary>>, RemovedBytes) -> + <<N:Len/unit:8,Buffer2/binary>> = <<B2,Bs/binary>>, + Int = N - (1 bsl (8 * Len - 1)), + {Int,Buffer2,RemovedBytes}. diff --git a/lib/asn1/src/asn1rtt_uper.erl b/lib/asn1/src/asn1rtt_uper.erl new file mode 100644 index 0000000000..b5e8a3c3bb --- /dev/null +++ b/lib/asn1/src/asn1rtt_uper.erl @@ -0,0 +1,1042 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(asn1rtt_uper). + +-export([setext/1, fixoptionals/3, + fixextensions/2, + skipextensions/3, getbit/1, getchoice/3 ]). +-export([set_choice/3, encode_integer/2, encode_integer/3]). +-export([encode_small_number/1, encode_constrained_number/2, + encode_boolean/1, + encode_length/1, encode_length/2, + encode_bit_string/3]). +-export([encode_octet_string/1,encode_octet_string/2, + encode_relative_oid/1, + encode_object_identifier/1, + complete/1, complete_NFP/1]). + + -export([encode_open_type/1]). + + -export([encode_UniversalString/2, + encode_PrintableString/2, + encode_GeneralString/2, + encode_GraphicString/2, + encode_TeletexString/2, + encode_VideotexString/2, + encode_VisibleString/2, + encode_UTF8String/1, + encode_BMPString/2, + encode_IA5String/2, + encode_NumericString/2, + encode_ObjectDescriptor/2 + ]). + +-define('16K',16384). +-define('32K',32768). +-define('64K',65536). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% setext(true|false) -> CompleteList +%% + +setext(false) -> + <<0:1>>; +setext(true) -> + <<1:1>>. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% This is the new fixoptionals/3 which is used by the new generates +%% +fixoptionals(OptList,OptLength,Val) when is_tuple(Val) -> + Bits = fixoptionals(OptList,Val,0), + {Val,<<Bits:OptLength>>}; + +fixoptionals([],_Val,Acc) -> + %% Optbits + Acc; +fixoptionals([{Pos,DefVal}|Ot],Val,Acc) -> + case element(Pos,Val) of + asn1_DEFAULT -> fixoptionals(Ot,Val,Acc bsl 1); + DefVal -> fixoptionals(Ot,Val,Acc bsl 1); + _ -> fixoptionals(Ot,Val,(Acc bsl 1) + 1) + end; +fixoptionals([Pos|Ot],Val,Acc) -> + case element(Pos,Val) of + asn1_NOVALUE -> fixoptionals(Ot,Val,Acc bsl 1); + asn1_DEFAULT -> fixoptionals(Ot,Val,Acc bsl 1); + _ -> fixoptionals(Ot,Val,(Acc bsl 1) + 1) + end. + + +fixextensions({ext,ExtPos,ExtNum},Val) -> + case fixextensions(ExtPos,ExtNum+ExtPos,Val,0) of + 0 -> []; + ExtBits -> + [encode_small_length(ExtNum),<<ExtBits:ExtNum>>] + end. + +fixextensions(Pos,MaxPos,_,Acc) when Pos >= MaxPos -> + Acc; +fixextensions(Pos,ExtPos,Val,Acc) -> + Bit = case catch(element(Pos+1,Val)) of + asn1_NOVALUE -> + 0; + asn1_NOEXTVALUE -> + 0; + {'EXIT',_} -> + 0; + _ -> + 1 + end, + fixextensions(Pos+1,ExtPos,Val,(Acc bsl 1)+Bit). + +skipextensions(Bytes0, Nr, ExtensionBitstr) when is_bitstring(ExtensionBitstr) -> + Prev = Nr - 1, + case ExtensionBitstr of + <<_:Prev,1:1,_/bitstring>> -> + {Len,Bytes1} = decode_length(Bytes0), + <<_:Len/binary,Bytes2/bitstring>> = Bytes1, + skipextensions(Bytes2, Nr+1, ExtensionBitstr); + <<_:Prev,0:1,_/bitstring>> -> + skipextensions(Bytes0, Nr+1, 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}. + + +%% 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() +%% Altnum = integer() | {integer(),integer()}% number of alternatives +%% Choices = [atom()] | {[atom()],[atom()]} +%% When Choices is a tuple the first list is the Rootset and the +%% second is the Extensions and then Altnum must also be a tuple with the +%% lengths of the 2 lists +%% +set_choice(Alt, {L1,L2}, {Len1,_Len2}) -> + case set_choice_tag(Alt, L1) of + N when is_integer(N), Len1 > 1 -> + [<<0:1>>, % the value is in the root set + encode_integer([{'ValueRange',{0,Len1-1}}],N)]; + N when is_integer(N) -> + <<0:1>>; % no encoding if only 0 or 1 alternative + false -> + [<<1:1>>, % extension value + case set_choice_tag(Alt,L2) of + N2 when is_integer(N2) -> + encode_small_number(N2); + false -> + unknown_choice_alt + end] + end; +set_choice(Alt,L,Len) -> + case set_choice_tag(Alt,L) of + N when is_integer(N), Len > 1 -> + encode_integer([{'ValueRange',{0,Len-1}}],N); + N when is_integer(N) -> + []; % no encoding if only 0 or 1 alternative + false -> + [unknown_choice_alt] + end. + +set_choice_tag(Alt,Choices) -> + set_choice_tag(Alt,Choices,0). + +set_choice_tag(Alt,[Alt|_Rest],Tag) -> + Tag; +set_choice_tag(Alt,[_H|Rest],Tag) -> + set_choice_tag(Alt,Rest,Tag+1); +set_choice_tag(_Alt,[],_Tag) -> + false. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_open_type(Constraint, Value) -> CompleteList +%% Value = list of bytes of an already encoded value (the list must be flat) +%% | 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_length(byte_size(Val)),Val]. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_integer(Constraint,Value,NamedNumberList) -> CompleteList +%% encode_integer(Constraint,Value) -> CompleteList +%% encode_integer(Constraint,{Name,Value}) -> CompleteList +%% +%% +encode_integer(C, V, NamedNumberList) when is_atom(V) -> + case lists:keyfind(V, 1, NamedNumberList) of + {_,NewV} -> + encode_integer(C, NewV); + false -> + exit({error,{asn1,{namednumber,V}}}) + end; +encode_integer(C, V, _NamedNumberList) when is_integer(V) -> + encode_integer(C, V). + +encode_integer([{Rc,_Ec}],Val) when is_tuple(Rc) -> + try + [<<0:1>>,encode_integer([Rc], Val)] + catch + _:{error,{asn1,_}} -> + [<<1:1>>,encode_unconstrained_number(Val)] + end; +encode_integer(C, Val) when is_list(C) -> + case get_constraint(C, 'SingleValue') of + no -> + encode_integer1(C,Val); + V when is_integer(V), V =:= Val -> + []; % a type restricted to a single value encodes to nothing + V when is_list(V) -> + case lists:member(Val,V) of + true -> + encode_integer1(C,Val); + _ -> + exit({error,{asn1,{illegal_value,Val}}}) + end; + _ -> + exit({error,{asn1,{illegal_value,Val}}}) + end. + +encode_integer1(C, Val) -> + case VR = get_constraint(C, 'ValueRange') of + no -> + encode_unconstrained_number(Val); + {Lb,'MAX'} -> + encode_semi_constrained_number(Lb, Val); + %% positive with range + {Lb,Ub} when Val >= Lb, Ub >= Val -> + encode_constrained_number(VR,Val); + _ -> + exit({error,{asn1,{illegal_value,VR,Val}}}) + end. + +%% X.691:10.6 Encoding of a normally small non-negative whole number +%% Use this for encoding of CHOICE index if there is an extension marker in +%% the CHOICE +encode_small_number(Val) when Val < 64 -> + <<Val:7>>; +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 + Val2 = Val - Lb, + Bin = eint_bin_positive(Val2), + Size = byte_size(Bin), + if + Size < 128 -> + [<<Size>>,Bin]; + Size < 16384 -> + [<<2:2,Size:14>>,Bin]; + true -> + [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, + NumBits = num_bits(Range), + <<Val2:NumBits>>; +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 -> + Oct = eint_bin_2Cs(Val), + Len = byte_size(Oct), + if + Len < 128 -> + [<<Len>>,Oct]; % equiv with encode_length(undefined,Len) but faster + Len < 16384 -> + [<<2:2,Len:14>>,Oct]; + true -> + [encode_length(Len),<<Len:16>>,Oct] + end; +encode_unconstrained_number(Val) -> % negative + Oct = enint(Val,[]), + Len = byte_size(Oct), + if + Len < 128 -> + [<<Len>>,Oct]; % equiv with encode_length(undefined,Len) but faster + Len < 16384 -> + [<<2:2,Len:14>>,Oct]; + true -> + [encode_length(Len),Oct] + end. + + +eint_bin_2Cs(Int) -> + case eint_bin_positive(Int) of + <<B,_/binary>> = Bin when B > 16#7f -> + <<0,Bin/binary>>; + Bin -> Bin + end. + +%% returns the integer as a binary +eint_bin_positive(Val) when Val < 16#100 -> + <<Val>>; +eint_bin_positive(Val) when Val < 16#10000 -> + <<Val:16>>; +eint_bin_positive(Val) when Val < 16#1000000 -> + <<Val:24>>; +eint_bin_positive(Val) when Val < 16#100000000 -> + <<Val:32>>; +eint_bin_positive(Val) -> + list_to_binary([eint_bin_positive2(Val bsr 32),<<Val:32>>]). + +eint_bin_positive2(Val) when Val < 16#100 -> + <<Val>>; +eint_bin_positive2(Val) when Val < 16#10000 -> + <<Val:16>>; +eint_bin_positive2(Val) when Val < 16#1000000 -> + <<Val:24>>; +eint_bin_positive2(Val) when Val < 16#100000000 -> + <<Val:32>>; +eint_bin_positive2(Val) -> + [eint_bin_positive2(Val bsr 32),<<Val:32>>]. + + + + +enint(-1, [B1|T]) when B1 > 127 -> + list_to_binary([B1|T]); +enint(N, Acc) -> + enint(N bsr 8, [N band 16#ff|Acc]). + + +%% X.691:10.9 Encoding of a length determinant +%%encode_small_length(undefined,Len) -> % null means no UpperBound +%% encode_small_number(Len). + +%% X.691:10.9.3.5 +%% X.691:10.9.3.7 +encode_length(Len) -> % un-constrained + if + Len < 128 -> + <<Len>>; + Len < 16384 -> + <<2:2,Len:14>>; + true -> % should be able to endode length >= 16384 + 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) -> + []. + +%% X.691 10.9.3.4 (only used for length of bitmap that prefixes extension +%% additions in a sequence or set +encode_small_length(Len) when Len =< 64 -> + <<(Len-1):7>>; +encode_small_length(Len) -> + [<<1:1>>,encode_length(Len)]. + + +%% un-constrained +decode_length(<<0:1,Oct:7,Rest/bitstring>>) -> + {Oct,Rest}; +decode_length(<<2:2,Val:14,Rest/bitstring>>) -> + {Val,Rest}; +decode_length(<<3:2,_:14,_Rest/bitstring>>) -> + exit({error,{asn1,{decode_length,{nyi,above_16k}}}}). + + % X.691:11 +encode_boolean(true) -> + <<1:1>>; +encode_boolean(false) -> + <<0:1>>; +encode_boolean(Val) -> + exit({error,{asn1,{encode_boolean,Val}}}). + + +%%============================================================================ +%%============================================================================ +%% Bitstring value, ITU_T X.690 Chapter 8.5 +%%============================================================================ +%%============================================================================ + +%%============================================================================ +%% encode bitstring value +%%============================================================================ + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% bitstring NamedBitList +%% Val can be of: +%% - [identifiers] where only named identifers are set to one, +%% the Constraint must then have some information of the +%% bitlength. +%% - [list of ones and zeroes] all bits +%% - integer value representing the bitlist +%% C is constraint Len, only valid when identifiers are present + + +%% when the value is a list of {Unused,BinBits}, where +%% Unused = integer(), +%% BinBits = binary(). + +encode_bit_string(C, Bits, NamedBitList) when is_bitstring(Bits) -> + PadLen = (8 - (bit_size(Bits) band 7)) band 7, + Compact = {PadLen,<<Bits/bitstring,0:PadLen>>}, + encode_bit_string(C, Compact, NamedBitList); +encode_bit_string(C, {Unused,BinBits}=Bin, NamedBitList) + when is_integer(Unused), is_binary(BinBits) -> + encode_bin_bit_string(C, Bin, NamedBitList); + +encode_bit_string(C, BitListVal, NamedBitList) -> + encode_bit_string1(C, BitListVal, NamedBitList). + +%% when the value is a list of named bits +encode_bit_string1(C, [FirstVal|_RestVal]=LoNB, NamedBitList) + when is_atom(FirstVal) -> + ToSetPos = get_all_bitposes(LoNB, NamedBitList, []), + BitList = make_and_set_list(ToSetPos, 0), + encode_bit_string1(C, BitList, NamedBitList); +encode_bit_string1(C, [{bit,_No}|_RestVal]=BL, NamedBitList) -> + ToSetPos = get_all_bitposes(BL, NamedBitList, []), + BitList = make_and_set_list(ToSetPos, 0), + encode_bit_string1(C, BitList, NamedBitList); +%% when the value is a list of ones and zeroes +encode_bit_string1(Int, BitListValue, _) + when is_list(BitListValue), is_integer(Int) -> + %% The type is constrained by a single value size constraint + bit_list2bitstr(Int, BitListValue); +encode_bit_string1(no, BitListValue, []) + when is_list(BitListValue) -> + Len = length(BitListValue), + [encode_length(Len),bit_list2bitstr(Len,BitListValue)]; +encode_bit_string1(C, BitListValue,[]) + when is_list(BitListValue) -> + Len = length(BitListValue), + [encode_length(C, Len),bit_list2bitstr(Len,BitListValue)]; +encode_bit_string1(no, BitListValue,_NamedBitList) + when is_list(BitListValue) -> + NewBitLVal = lists:reverse(lists:dropwhile(fun(0)->true;(1)->false end, + lists:reverse(BitListValue))), + Len = length(NewBitLVal), + [encode_length(Len),bit_list2bitstr(Len,NewBitLVal)]; +encode_bit_string1(C, BitListValue, _NamedBitList) + when is_list(BitListValue) ->% C = {_,'MAX'} + NewBitStr = bitstr_trailing_zeros(BitListValue, C), + [encode_length(C, bit_size(NewBitStr)),NewBitStr]; + + +%% when the value is an integer +encode_bit_string1(C, IntegerVal, NamedBitList) when is_integer(IntegerVal)-> + BitList = int_to_bitlist(IntegerVal), + encode_bit_string1(C, BitList, NamedBitList). + +bit_list2bitstr(Len,BitListValue) -> + case length(BitListValue) of + Len -> + << <<B:1>> || B <- BitListValue>>; + L when L > Len -> % truncate + <<(<< <<B:1>> || B <- BitListValue>>):Len/bitstring>>; + L -> % Len > L -> pad + <<(<< <<B:1>> || B <- BitListValue>>)/bitstring,0:(Len-L)>> + end. + +adjust_trailing_zeros(Len, Bin) when Len =:= bit_size(Bin) -> + Bin; +adjust_trailing_zeros(Len, Bin) when Len > bit_size(Bin) -> + <<Bin/bitstring,0:(Len-bit_size(Bin))>>; +adjust_trailing_zeros(Len,Bin) -> + <<Bin:Len/bitstring>>. + +bitstr_trailing_zeros(BitList, C) when is_integer(C) -> + bitstr_trailing_zeros1(BitList, C, C); +bitstr_trailing_zeros(BitList, {Lb,Ub}) when is_integer(Lb) -> + bitstr_trailing_zeros1(BitList,Lb,Ub); +bitstr_trailing_zeros(BitList, {{Lb,Ub},_}) when is_integer(Lb) -> + bitstr_trailing_zeros1(BitList, Lb, Ub); +bitstr_trailing_zeros(BitList, _) -> + bit_list2bitstr(length(BitList), BitList). + +bitstr_trailing_zeros1(BitList, Lb, Ub) -> + case length(BitList) of + Lb -> bit_list2bitstr(Lb, BitList); + B when B < Lb -> bit_list2bitstr(Lb, BitList); + D -> F = fun(L,LB,LB,_,_)->bit_list2bitstr(LB,lists:reverse(L)); + ([0|R],L1,LB,UB,Fun)->Fun(R,L1-1,LB,UB,Fun); + (L,L1,_,UB,_)when L1 =< UB -> + bit_list2bitstr(L1,lists:reverse(L)); + (_,_L1,_,_,_) ->exit({error,{list_length_BIT_STRING, + BitList}}) end, + F(lists:reverse(BitList),D,Lb,Ub,F) + end. + +%% encode_bin_bit_string/3, when value is a tuple of Unused and BinBits. +%% Unused = integer(),i.e. number unused bits in least sign. byte of +%% BinBits = binary(). +encode_bin_bit_string(C, {_,BinBits}, _NamedBitList) + when is_integer(C), C =< 16 -> + adjust_trailing_zeros(C, BinBits); +encode_bin_bit_string(C, {_Unused,BinBits}, _NamedBitList) + when is_integer(C) -> + adjust_trailing_zeros(C, BinBits); +encode_bin_bit_string(C, {_,_}=UnusedAndBin, NamedBitList) -> + %% removes all trailing bits if NamedBitList is not empty + BitStr = remove_trailing_bin(NamedBitList, UnusedAndBin), + case C of + {Lb,Ub} when is_integer(Lb),is_integer(Ub) -> + [encode_length({Lb,Ub},bit_size(BitStr)),BitStr]; + no -> + [encode_length(bit_size(BitStr)),BitStr]; + Sc -> + [encode_length(Sc,bit_size(BitStr)),BitStr] + end. + + +remove_trailing_bin([], {Unused,Bin}) -> + BS = bit_size(Bin)-Unused, + <<BitStr:BS/bitstring,_:Unused>> = Bin, + BitStr; +remove_trailing_bin(_NamedNumberList, {_Unused,<<>>}) -> + <<>>; +remove_trailing_bin(NamedNumberList, {_Unused,Bin}) -> + Size = byte_size(Bin)-1, + <<Bfront:Size/binary, LastByte:8>> = Bin, + + %% clear the Unused bits to be sure + Unused1 = trailingZeroesInNibble(LastByte band 15), + Unused2 = + case Unused1 of + 4 -> + 4 + trailingZeroesInNibble(LastByte bsr 4); + _ -> Unused1 + end, + case Unused2 of + 8 -> + remove_trailing_bin(NamedNumberList,{0,Bfront}); + _ -> + BS = bit_size(Bin) - Unused2, + <<BitStr:BS/bitstring,_:Unused2>> = Bin, + BitStr + end. + +trailingZeroesInNibble(0) -> + 4; +trailingZeroesInNibble(1) -> + 0; +trailingZeroesInNibble(2) -> + 1; +trailingZeroesInNibble(3) -> + 0; +trailingZeroesInNibble(4) -> + 2; +trailingZeroesInNibble(5) -> + 0; +trailingZeroesInNibble(6) -> + 1; +trailingZeroesInNibble(7) -> + 0; +trailingZeroesInNibble(8) -> + 3; +trailingZeroesInNibble(9) -> + 0; +trailingZeroesInNibble(10) -> + 1; +trailingZeroesInNibble(11) -> + 0; +trailingZeroesInNibble(12) -> %#1100 + 2; +trailingZeroesInNibble(13) -> + 0; +trailingZeroesInNibble(14) -> + 1; +trailingZeroesInNibble(15) -> + 0. + + +%%%%%%%%%%%%%%% +%% + +int_to_bitlist(Int) when is_integer(Int), Int > 0 -> + [Int band 1 | int_to_bitlist(Int bsr 1)]; +int_to_bitlist(0) -> + []. + + +%%%%%%%%%%%%%%%%%% +%% get_all_bitposes([list of named bits to set], named_bit_db, []) -> +%% [sorted_list_of_bitpositions_to_set] + +get_all_bitposes([{bit,ValPos}|Rest], NamedBitList, Ack) -> + get_all_bitposes(Rest, NamedBitList, [ValPos | Ack ]); + +get_all_bitposes([Val | Rest], NamedBitList, Ack) -> + case lists:keyfind(Val, 1, NamedBitList) of + {_ValName, ValPos} -> + get_all_bitposes(Rest, NamedBitList, [ValPos | Ack]); + false -> + exit({error,{asn1, {bitstring_namedbit, Val}}}) + end; +get_all_bitposes([], _NamedBitList, Ack) -> + lists:sort(Ack). + +%%%%%%%%%%%%%%%%%% +%% make_and_set_list([list of positions to set to 1])-> +%% returns list with all in SetPos set. +%% in positioning in list the first element is 0, the second 1 etc.., but +%% + +make_and_set_list([XPos|SetPos], XPos) -> + [1 | make_and_set_list(SetPos, XPos + 1)]; +make_and_set_list([Pos|SetPos], XPos) -> + [0 | make_and_set_list([Pos | SetPos], XPos + 1)]; +make_and_set_list([], _) -> + []. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% X.691:16 +%% encode_octet_string(Val) +%% encode_octet_string(Constraint, Val) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +encode_octet_string(Val) -> + try + [encode_length(length(Val)),list_to_binary(Val)] + catch + error:{error,{asn1,{encode_length,_}}} -> + encode_fragmented_octet_string(Val) + end. + +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)] + catch + error:{error,{asn1,{encode_length,_}}} -> + 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 + end. + + +encode_fragmented_octet_string(Val) -> + Bin = list_to_binary(Val), + efos_1(Bin). + +efos_1(<<B:16#10000/binary,T/binary>>) -> + [<<3:2,4:6>>,B|efos_1(T)]; +efos_1(<<B:16#C000/binary,T/binary>>) -> + [<<3:2,3:6>>,B|efos_1(T)]; +efos_1(<<B:16#8000/binary,T/binary>>) -> + [<<3:2,2:6>>,B|efos_1(T)]; +efos_1(<<B:16#4000/binary,T/binary>>) -> + [<<3:2,1:6>>,B|efos_1(T)]; +efos_1(<<B/bitstring>>) -> + Len = byte_size(B), + [encode_length(Len),B]. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Restricted char string types +%% (NumericString, PrintableString,VisibleString,IA5String,BMPString,UniversalString) +%% X.691:26 and X.680:34-36 +%%encode_restricted_string('BMPString',Constraints,Extension,Val) + + +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 + 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]; + no -> + [encode_length(length(Val)),Result] + end. + +encode_NumericString(C,Val) -> + encode_known_multiplier_string('NumericString',C,Val). + +encode_PrintableString(C,Val) -> + encode_known_multiplier_string('PrintableString',C,Val). + +encode_VisibleString(C,Val) -> % equivalent with ISO646String + encode_known_multiplier_string('VisibleString',C,Val). + +encode_IA5String(C,Val) -> + encode_known_multiplier_string('IA5String',C,Val). + +encode_BMPString(C,Val) -> + encode_known_multiplier_string('BMPString',C,Val). + +encode_UniversalString(C,Val) -> + encode_known_multiplier_string('UniversalString',C,Val). + + +%% end of known-multiplier strings for which PER visible constraints are +%% applied + +encode_GeneralString(_C,Val) -> + encode_restricted_string(Val). + +encode_GraphicString(_C,Val) -> + encode_restricted_string(Val). + +encode_ObjectDescriptor(_C,Val) -> + encode_restricted_string(Val). + +encode_TeletexString(_C,Val) -> % equivalent with T61String + encode_restricted_string(Val). + +encode_VideotexString(_C,Val) -> + encode_restricted_string(Val). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% chars_encode(C,StringType,Value) -> ValueList +%% +%% encodes chars according to the per rules taking the constraint PermittedAlphabet +%% 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 + {'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)}, + chars_encode2(Value,NumBits,CharOutTab) + end. + +chars_encode2([H|T],NumBits,{Min,Max,notab}) when H =< Max, H >= Min -> + [<<(H-Min):NumBits>>|chars_encode2(T,NumBits,{Min,Max,notab})]; +chars_encode2([H|T],NumBits,{Min,Max,Tab}) when H =< Max, H >= Min -> + Ch = exit_if_false(H,element(H-Min+1,Tab)), + [<<Ch:NumBits>>|chars_encode2(T,NumBits,{Min,Max,Tab})]; +chars_encode2([{A,B,C,D}|T],NumBits,{Min,Max,notab}) -> + %% no value range check here (ought to be, but very expensive) + Ch = ((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min, + [<<Ch:NumBits>>|chars_encode2(T,NumBits,{Min,Max,notab})]; +chars_encode2([{A,B,C,D}|T],NumBits,{Min,Max,Tab}) -> + %% no value range check here (ought to be, but very expensive) + Ch = exit_if_false({A,B,C,D},element(((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min,Tab)), + [<<Ch:NumBits>>|chars_encode2(T,NumBits,{Min,Max,notab})]; +chars_encode2([H|_T],_,{_,_,_}) -> + exit({error,{asn1,{illegal_char_value,H}}}); +chars_encode2([],_,_) -> + []. + +exit_if_false(V,false)-> + exit({error,{asn1,{"illegal value according to Permitted alphabet constraint",V}}}); +exit_if_false(_,V) ->V. + + +get_NumBits(C,StringType) -> + case get_constraint(C,'PermittedAlphabet') of + {'SingleValue',Sv} -> + charbits(length(Sv)); + no -> + case StringType of + 'IA5String' -> + charbits(128); % 16#00..16#7F + 'VisibleString' -> + charbits(95); % 16#20..16#7E + 'PrintableString' -> + charbits(74); % [$\s,$',$(,$),$+,$,,$-,$.,$/,"0123456789",$:,$=,$?,$A..$Z,$a..$z + 'NumericString' -> + charbits(11); % $ ,"0123456789" + 'UniversalString' -> + 32; + 'BMPString' -> + 16 + end + end. + +get_CharOutTab(C,StringType) -> + case get_constraint(C,'PermittedAlphabet') of + {'SingleValue',Sv} -> + get_CharTab2(C,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); + 'PrintableString' -> + Chars = lists:sort( + " '()+,-./0123456789:=?ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"), + get_CharTab2(C,StringType,hd(Chars),lists:max(Chars),Chars); + 'NumericString' -> + get_CharTab2(C,StringType,16#20,$9," 0123456789"); + 'UniversalString' -> + {0,16#FFFFFFFF,notab}; + 'BMPString' -> + {0,16#FFFF,notab} + end + end. + +get_CharTab2(C,StringType,Min,Max,Chars) -> + BitValMax = (1 bsl get_NumBits(C,StringType))-1, + if + Max =< BitValMax -> + {0,Max,notab}; + true -> + {Min,Max,create_char_tab(Min,Chars)} + end. + +create_char_tab(Min,L) -> + list_to_tuple(create_char_tab(Min,L,0)). +create_char_tab(Min,[Min|T],V) -> + [V|create_char_tab(Min+1,T,V+1)]; +create_char_tab(_Min,[],_V) -> + []; +create_char_tab(Min,L,V) -> + [false|create_char_tab(Min+1,L,V)]. + +%% See Table 20.3 in Dubuisson +charbits(NumOfChars) when NumOfChars =< 2 -> 1; +charbits(NumOfChars) when NumOfChars =< 4 -> 2; +charbits(NumOfChars) when NumOfChars =< 8 -> 3; +charbits(NumOfChars) when NumOfChars =< 16 -> 4; +charbits(NumOfChars) when NumOfChars =< 32 -> 5; +charbits(NumOfChars) when NumOfChars =< 64 -> 6; +charbits(NumOfChars) when NumOfChars =< 128 -> 7; +charbits(NumOfChars) when NumOfChars =< 256 -> 8; +charbits(NumOfChars) when NumOfChars =< 512 -> 9; +charbits(NumOfChars) when NumOfChars =< 1024 -> 10; +charbits(NumOfChars) when NumOfChars =< 2048 -> 11; +charbits(NumOfChars) when NumOfChars =< 4096 -> 12; +charbits(NumOfChars) when NumOfChars =< 8192 -> 13; +charbits(NumOfChars) when NumOfChars =< 16384 -> 14; +charbits(NumOfChars) when NumOfChars =< 32768 -> 15; +charbits(NumOfChars) when NumOfChars =< 65536 -> 16; +charbits(NumOfChars) when is_integer(NumOfChars) -> + 16 + charbits1(NumOfChars bsr 16). + +charbits1(0) -> + 0; +charbits1(NumOfChars) -> + 1 + charbits1(NumOfChars bsr 1). + + +%% UTF8String +encode_UTF8String(Val) when is_binary(Val) -> + [encode_length(byte_size(Val)),Val]; +encode_UTF8String(Val) -> + Bin = list_to_binary(Val), + encode_UTF8String(Bin). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_object_identifier(Val) -> CompleteList +%% encode_object_identifier({Name,Val}) -> CompleteList +%% Val -> {Int1,Int2,...,IntN} % N >= 2 +%% Name -> atom() +%% Int1 -> integer(0..2) +%% Int2 -> integer(0..39) when Int1 (0..1) else integer() +%% Int3-N -> integer() +%% CompleteList -> [binary()|bitstring()|list()] +%% +encode_object_identifier(Val) -> + OctetList = e_object_identifier(Val), + Octets = list_to_binary(OctetList), % performs a flatten at the same time + [encode_length(byte_size(Octets)),Octets]. + +%% This code is copied from asn1_encode.erl (BER) and corrected and modified + +e_object_identifier({'OBJECT IDENTIFIER',V}) -> + e_object_identifier(V); +e_object_identifier(V) when is_tuple(V) -> + e_object_identifier(tuple_to_list(V)); + +%% E1 = 0|1|2 and (E2 < 40 when E1 = 0|1) +e_object_identifier([E1,E2|Tail]) when E1 >= 0, E1 < 2, E2 < 40 ; E1==2 -> + Head = 40*E1 + E2, % weird + e_object_elements([Head|Tail],[]); +e_object_identifier(Oid=[_,_|_Tail]) -> + exit({error,{asn1,{'illegal_value',Oid}}}). + +e_object_elements([],Acc) -> + lists:reverse(Acc); +e_object_elements([H|T],Acc) -> + e_object_elements(T,[e_object_element(H)|Acc]). + +e_object_element(Num) when Num < 128 -> + [Num]; +e_object_element(Num) -> + [e_o_e(Num bsr 7)|[Num band 2#1111111]]. +e_o_e(Num) when Num < 128 -> + Num bor 2#10000000; +e_o_e(Num) -> + [e_o_e(Num bsr 7)|[(Num band 2#1111111) bor 2#10000000]]. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_relative_oid(Val) -> CompleteList +%% encode_relative_oid({Name,Val}) -> CompleteList +encode_relative_oid(Val) when is_tuple(Val) -> + encode_relative_oid(tuple_to_list(Val)); +encode_relative_oid(Val) when is_list(Val) -> + Octets = list_to_binary([e_object_element(X)||X <- Val]), + [encode_length(byte_size(Octets)),Octets]. + + +get_constraint([{Key,V}],Key) -> + V; +get_constraint([],_Key) -> + no; +get_constraint(C,Key) -> + case lists:keyfind(Key, 1, C) of + false -> + no; + {_,V} -> + V + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% complete(InList) -> ByteList +%% Takes a coded list with bits and bytes and converts it to a list of bytes +%% Should be applied as the last step at encode of a complete ASN.1 type +%% +complete(InList) when is_list(InList) -> + case complete1(InList) of + <<>> -> + <<0>>; + Res -> + case bit_size(Res) band 7 of + 0 -> Res; + Bits -> <<Res/bitstring,0:(8-Bits)>> + end + end; +complete(InList) when is_binary(InList) -> + InList; +complete(InList) when is_bitstring(InList) -> + PadLen = 8 - (bit_size(InList) band 7), + <<InList/bitstring,0:PadLen>>. + +complete1(L) when is_list(L) -> + list_to_bitstring(L). + +%% Special version of complete that does not align the completed message. +complete_NFP(InList) when is_list(InList) -> + list_to_bitstring(InList); +complete_NFP(InList) when is_bitstring(InList) -> + InList. + +%% unaligned helpers + +%% 10.5.6 NOTE: If "range" satisfies the inequality 2^m < "range" =< +%% 2^(m+1) then the number of bits = m + 1 + +num_bits(N) -> num_bits(N, 1, 0). + +num_bits(N,T,B) when N =< T -> B; +num_bits(N,T,B) -> num_bits(N, T bsl 1, B+1). diff --git a/lib/asn1/src/prepare_templates.erl b/lib/asn1/src/prepare_templates.erl new file mode 100644 index 0000000000..83155b2e52 --- /dev/null +++ b/lib/asn1/src/prepare_templates.erl @@ -0,0 +1,135 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(prepare_templates). +-export([gen_asn1ct_rtt/1,gen_asn1ct_eval/1]). + +gen_asn1ct_rtt(Ms) -> + io:format("%% Generated by ~s. DO NOT EDIT THIS FILE.\n" + "%%\n" + "%% Input files:\n", [?MODULE]), + [io:put_chars(["%% ",M,$\n]) || M <- Ms], + io:nl(), + io:put_chars("-module(asn1ct_rtt).\n" + "-export([assert_defined/1,dependencies/1,code/0]).\n" + "\n"), + Forms = lists:sort(lists:append([abstract(M) || M <- Ms])), + Exp = lists:sort(exports(Forms)), + defined(Exp), + io:nl(), + Calls = calls(Forms), + R = sofs:relation(Calls), + Fam0 = sofs:relation_to_family(R), + Fam = sofs:to_external(Fam0), + dependencies(Fam), + io:nl(), + Funcs = [begin + Bin = list_to_binary([$\n|erl_pp:function(Func)]), + {{M,F,A},Bin} + end || {M,{function,_,F,A,_}=Func} <- Forms], + io:format("code() ->\n~p.\n\n", [Funcs]), + halt(0). + +gen_asn1ct_eval([File]) -> + {ok,Funcs} = file:consult(File), + asn1ct_func:start_link(), + [asn1ct_func:need(MFA) || MFA <- Funcs], + io:format("%% Generated by ~s. DO NOT EDIT THIS FILE.\n" + "%%\n" + "%% Input file: ~s\n\n", [?MODULE,File]), + io:format("-module(~s).\n", [filename:rootname(File)]), + gen_asn1ct_eval_exp(Funcs), + asn1ct_func:generate(group_leader()), + halt(0). + +gen_asn1ct_eval_exp(Funcs) -> + io:put_chars("-export(["), + gen_asn1ct_eval_exp_1(Funcs, ""), + io:put_chars("]).\n"). + +gen_asn1ct_eval_exp_1([{_,F,A}|T], Sep) -> + io:put_chars(Sep), + io:format("~p/~p", [F,A]), + gen_asn1ct_eval_exp_1(T, ",\n"); +gen_asn1ct_eval_exp_1([], _) -> ok. + +defined([H|T]) -> + io:format("assert_defined(~p) -> ok", [H]), + case T of + [] -> + io:put_chars(".\n"); + [_|_] -> + io:put_chars(";\n"), + defined(T) + end. + +dependencies([{K,V}|T]) -> + io:format("dependencies(~p) ->\n~p;\n", [K,V]), + dependencies(T); +dependencies([]) -> + io:put_chars("dependencies(_) -> [].\n"). + +abstract(File) -> + {ok,{M0,[{abstract_code,Abstract}]}} = + beam_lib:chunks(File, [abstract_code]), + {raw_abstract_v1,Forms} = Abstract, + M = module(M0), + [{M,F} || F <- Forms]. + +module(M0) -> + "asn1rtt_" ++ M = atom_to_list(M0), + list_to_atom(M). + +exports([{M,{attribute,_,export,L}}|T]) -> + [{M,F,A} || {F,A} <- L] ++ exports(T); +exports([_|T]) -> + exports(T); +exports([]) -> []. + +calls([{M,{function,_,F,A,Body}}|T]) -> + MFA = {M,F,A}, + case find_calls(Body, M) -- [MFA] of + [] -> + calls(T); + [_|_]=Calls -> + [{MFA,Callee} || Callee <- Calls] ++ calls(T) + end; +calls([_|T]) -> + calls(T); +calls([]) -> []. + +find_calls([{call,_,{atom,_,F},Args}|T], M) -> + Calls = find_calls(Args, M) ++ find_calls(T, M), + Arity = length(Args), + case is_bif(F, Arity) of + false -> + [{M,F,Arity}|Calls]; + true -> + Calls + end; +find_calls([{'fun',_,{function,F,A}}|T], M) -> + [{M,F,A}|find_calls(T, M)]; +find_calls([H|T], M) -> + find_calls(H, M) ++ find_calls(T, M); +find_calls(Tuple, M) when is_tuple(Tuple) -> + find_calls(tuple_to_list(Tuple), M); +find_calls(_, _) -> []. + +is_bif(F, Arity) -> + erl_internal:bif(F, Arity). diff --git a/lib/asn1/test/Makefile b/lib/asn1/test/Makefile index 1794d6bb71..1fa495d8f1 100644 --- a/lib/asn1/test/Makefile +++ b/lib/asn1/test/Makefile @@ -102,7 +102,6 @@ MODULES= \ test_driver_load \ testSelectionTypes \ test_undecoded_rest \ - test_inline \ testTcapsystem \ testNBAPsystem \ test_compile_options \ diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index 325293f35d..0d09929f6d 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -66,12 +66,12 @@ groups() -> {appup_test, [], [{asn1_appup_test, all}]}, {parallel, parallel([]), - [{group, ber}, + [cover, + {group, ber}, % Uses 'P-Record', 'Constraints', 'MEDIA-GATEWAY-CONTROL'... {group, [], [parse, test_driver_load, test_undecoded_rest, - test_inline, specialized_decodes, special_decode_performance, testMegaco, @@ -296,6 +296,28 @@ case_dir([C|Config], Opt) -> %% Test cases %%------------------------------------------------------------------------------ +%% Cover run-time functions that are only called by the ASN.1 compiler +%% (if any). +cover(_) -> + Wc = filename:join([code:lib_dir(asn1),"ebin","asn1ct_eval_*.beam"]), + Beams = filelib:wildcard(Wc), + true = Beams =/= [], + [begin + M0 = filename:basename(Beam), + M1 = filename:rootname(M0), + M = list_to_atom(M1), + "asn1ct_eval_" ++ Group0 = M1, + Group = list_to_atom(Group0), + io:format("%%\n" + "%% ~s\n" + "%%\n", [M]), + asn1ct_func:start_link(), + [asn1ct_func:need({Group,F,A}) || + {F,A} <- M:module_info(exports), F =/= module_info], + asn1ct_func:generate(group_leader()) + end || Beam <- Beams], + ok. + testPrim(Config) -> test(Config, fun testPrim/3). testPrim(Config, Rule, Opts) -> asn1_test_lib:compile_all(["Prim", "Real"], Config, [Rule|Opts]), @@ -323,11 +345,16 @@ testPrimStrings(Config) -> test(Config, fun testPrimStrings/3). testPrimStrings(Config, Rule, Opts) -> asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, [Rule|Opts]), testPrimStrings_cases(Rule), + asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, + [legacy_bit_string,Rule|Opts]), + testPrimStrings:bit_string(Rule), + asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, + [compact_bit_string,Rule|Opts]), + testPrimStrings:bit_string(Rule), ?only_ber(testPrimStrings:more_strings(Rule)). testPrimStrings_cases(Rule) -> testPrimStrings:bit_string(Rule), - testPrimStrings:bit_string_unnamed(Rule), testPrimStrings:octet_string(Rule), testPrimStrings:numeric_string(Rule), testPrimStrings:other_strings(Rule), @@ -978,14 +1005,8 @@ testSSLspecs(Config, Rule, Opts) -> ok = testSSLspecs:compile(Config, [Rule, compact_bit_string, der|Opts]), testSSLspecs:run(Rule), - - case code:which(asn1ct) of - cover_compiled -> - ok; - _ -> - ok = testSSLspecs:compile_inline(Config, Rule), - ok = testSSLspecs:run_inline(Rule) - end. + ok = testSSLspecs:compile_combined(Config, Rule), + ok = testSSLspecs:run_combined(Rule). testNortel(Config) -> test(Config, fun testNortel/3). testNortel(Config, Rule, Opts) -> @@ -996,23 +1017,7 @@ test_undecoded_rest(Config, Rule, Opts) -> asn1_test_lib:compile("P-Record", Config, [Rule|Opts]), ok = test_undecoded_rest:test([], Config), asn1_test_lib:compile("P-Record", Config, [Rule,undec_rest|Opts]), - case Rule of - ber -> ok; - _ -> test_undecoded_rest:test(undec_rest, Config) - end. - -test_inline(Config) -> - test(Config, fun test_inline/3, [ber]). -test_inline(Config, Rule, Opts) -> - case code:which(asn1ct) of - cover_compiled -> - {skip, "Not runnable when cover compiled"}; - _ -> - test_inline:compile(Config, Opts), - test_inline:main(Config, Rule), - test_inline:inline1(Config, Rule, Opts), - test_inline:performance2() - end. + test_undecoded_rest:test(undec_rest, Config). testTcapsystem(Config) -> test(Config, fun testTcapsystem/3, [ber]). @@ -1025,17 +1030,12 @@ testNBAPsystem(Config, Rule, Opts) -> testNBAPsystem:test(Rule, Config). test_compile_options(Config) -> - case code:which(asn1ct) of - cover_compiled -> - {skip, "Not runnable when cover compiled"}; - _ -> - ok = test_compile_options:wrong_path(Config), - ok = test_compile_options:path(Config), - ok = test_compile_options:noobj(Config), - ok = test_compile_options:record_name_prefix(Config), - ok = test_compile_options:verbose(Config), - ok = test_compile_options:warnings_as_errors(Config) - end. + ok = test_compile_options:wrong_path(Config), + ok = test_compile_options:path(Config), + ok = test_compile_options:noobj(Config), + ok = test_compile_options:record_name_prefix(Config), + ok = test_compile_options:verbose(Config), + ok = test_compile_options:warnings_as_errors(Config). testDoubleEllipses(Config) -> test(Config, fun testDoubleEllipses/3). testDoubleEllipses(Config, Rule, Opts) -> diff --git a/lib/asn1/test/asn1_SUITE_data/Prim.asn1 b/lib/asn1/test/asn1_SUITE_data/Prim.asn1 index 1a905988f5..17a5d3490a 100644 --- a/lib/asn1/test/asn1_SUITE_data/Prim.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/Prim.asn1 @@ -29,4 +29,10 @@ BEGIN Null ::= NULL + -- Test that REAL numbers can co-exist with other data types. + App-X-Real ::= REAL (WITH COMPONENTS { + mantissa (-16777215..16777215), + base (2), + exponent (-125..128) } ) + END diff --git a/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 b/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 index 9b6b34a776..cfaf4cf034 100644 --- a/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 @@ -87,14 +87,17 @@ BS1024 ::= BIT STRING (SIZE (1024)) NsExpCon ::= [71] EXPLICIT NumericString Ps ::= PrintableString + Ps11 ::= PrintableString (FROM ("0123456789*")) Ts ::= TeletexString Vxs ::= VideotexString Vis ::= VisibleString + Vis8 ::= VisibleString (FROM ("01234567")) IA5 ::= IA5String + IA5Visible ::= IA5String (FROM (" ".."~")) Grs ::= GraphicString diff --git a/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl b/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl index 8148381d92..1aec3e1fab 100644 --- a/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl +++ b/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl @@ -140,7 +140,7 @@ run3() -> Barring = #'AC-BarringConfig'{ 'ac-BarringFactor' = p00, 'ac-BarringTime' = s4, - 'ac-BarringForSpecialAC' = [0,0,0,0,0]}, + 'ac-BarringForSpecialAC' = <<0:5>>}, roundtrip(SI), roundtrip(SI#'SystemInformationBlockType2'{ 'ssac-BarringForMMTEL-Voice-r9'=Barring}), diff --git a/lib/asn1/test/asn1_app_test.erl b/lib/asn1/test/asn1_app_test.erl index 9dbe1b50e0..1225e36778 100644 --- a/lib/asn1/test/asn1_app_test.erl +++ b/lib/asn1/test/asn1_app_test.erl @@ -139,7 +139,8 @@ check_asn1ct_modules(Extra) -> asn1ct_gen_ber,asn1ct_constructed_ber_bin_v2, asn1ct_gen_ber_bin_v2,asn1ct_value, asn1ct_tok,asn1ct_parser2,asn1ct_table, - asn1ct_imm], + asn1ct_imm,asn1ct_func,asn1ct_rtt, + asn1ct_eval_ext,asn1ct_eval_per,asn1ct_eval_uper], case Extra -- ASN1CTMods of [] -> ok; diff --git a/lib/asn1/test/asn1_test_lib.erl b/lib/asn1/test/asn1_test_lib.erl index fda635d0eb..1e40fd7b9e 100644 --- a/lib/asn1/test/asn1_test_lib.erl +++ b/lib/asn1/test/asn1_test_lib.erl @@ -61,15 +61,12 @@ compile_erlang(Mod, Config, Options) -> [{i, CaseDir}, {outdir, CaseDir}|Options]). should_load(File, Options) -> - should_load(File, lists:member(abs, Options), - proplists:lookup(inline, Options)). - -should_load(_File, true, _Inline) -> - false; -should_load(_File, _Abs, {inline, Module}) when Module /= true -> - {module, Module}; -should_load(File, _Abs, _Inline) -> - {module, list_to_atom(strip_extension(filename:basename(File)))}. + case lists:member(abs, Options) of + true -> + false; + false -> + {module,list_to_atom(strip_extension(filename:basename(File)))} + end. strip_extension(File) -> strip_extension(File, filename:extension(File)). diff --git a/lib/asn1/test/ber_decode_error.erl b/lib/asn1/test/ber_decode_error.erl index ff6e386a88..af0105bf26 100644 --- a/lib/asn1/test/ber_decode_error.erl +++ b/lib/asn1/test/ber_decode_error.erl @@ -21,31 +21,34 @@ -export([run/1]). --include_lib("test_server/include/test_server.hrl"). - run([]) -> - ?line {ok,B} = asn1_wrapper:encode('Constructed','S3',{'S3',17}), - ?line [T,L|V] = lists:flatten(B), - ?line Bytes = [T,L+3|V] ++ [2,1,3], - ?line case asn1_wrapper:decode('Constructed','S3',Bytes) of - {error,{asn1,{unexpected,_}}} -> ok - end, - %% Unexpected bytes must be accepted if there is an extensionmark - ?line {ok,{'S3ext',17}} = asn1_wrapper:decode('Constructed','S3ext',Bytes), - ok; -run([driver]) -> - %% test of OTP-4797, bad indata to driver does not cause an EXIT - ?line {error,_Reason} = asn1rt:decode('Constructed','S3',[3,5]), - ok; -run([nif]) -> - %% test of OTP-4797, bad indata to driver does not cause an EXIT - ?line {error,_Reason} = asn1rt:decode('Constructed','S3',[3,5]), - ok. - + {ok,B} = asn1_wrapper:encode('Constructed','S3',{'S3',17}), + [T,L|V] = lists:flatten(B), + Bytes = [T,L+3|V] ++ [2,1,3], + case asn1_wrapper:decode('Constructed','S3',Bytes) of + {error,{asn1,{unexpected,_}}} -> ok + end, + %% Unexpected bytes must be accepted if there is an extensionmark + {ok,{'S3ext',17}} = asn1_wrapper:decode('Constructed','S3ext',Bytes), + %% Truncated tag. + {error,{asn1,{invalid_tag,_}}} = + (catch 'Constructed':decode('I', <<31,255,255>>)), + %% Overlong tag. + {error,{asn1,{invalid_tag,_}}} = + (catch 'Constructed':decode('I', <<31,255,255,255,127>>)), + %% Invalid length. + {error,{asn1,{invalid_length,_}}} = + (catch 'Constructed':decode('I', <<8,255>>)), + %% Other errors. + {error,{asn1,{invalid_value,_}}} = + (catch 'Constructed':decode('I', <<>>)), + {error,{asn1,{invalid_value,_}}} = + (catch 'Constructed':decode('I', <<8,7>>)), + ok. diff --git a/lib/asn1/test/testContextSwitchingTypes.erl b/lib/asn1/test/testContextSwitchingTypes.erl index 4f67942922..f06cc7c117 100644 --- a/lib/asn1/test/testContextSwitchingTypes.erl +++ b/lib/asn1/test/testContextSwitchingTypes.erl @@ -52,22 +52,36 @@ test(Config) -> check_EXTERNAL({'EXTERNAL',Identif,DVD,DV})-> - ?line ok=check_EXTERNAL_Idef(Identif), - ?line ok = check_EXTERNAL_DVD(DVD), - ?line ok = check_EXTERNAL_DV(DV). -check_EXTERNAL_Idef({Alt,_}) when Alt=='context-negotiation'; - Alt=='presentation-context-id'; - Alt==syntax -> - ok; -check_EXTERNAL_Idef(I) -> - {error,"failed on identification alternative",I}. -check_EXTERNAL_DVD(DVD) when is_list(DVD) -> - ok; -check_EXTERNAL_DVD(asn1_NOVALUE) -> - ok; -check_EXTERNAL_DVD(DVD) -> - {error,"failed on data-value-descriptor alternative",DVD}. -check_EXTERNAL_DV(DV) when is_list(DV);is_binary(DV) -> - ok; -check_EXTERNAL_DV(DV) -> - {error,"failed on data-value alternative",DV}. + %% EXTERNAL in the 1994 format. + case Identif of + {'context-negotiation',_} -> + ok; + {'presentation-context-id',Id} -> + true = is_integer(Id); + {syntax,ObjId} -> + check_object_identifier(ObjId) + end, + check_EXTERNAL_DVD(DVD), + check_EXTERNAL_DV(DV); +check_EXTERNAL({'EXTERNAL',ObjId,IndirectRef,Descriptor,Enc})-> + %% EXTERNAL in the 1990 format. + check_object_identifier(ObjId), + true = is_integer(IndirectRef), + true = is_binary(Descriptor) orelse is_list(Descriptor), + case Enc of + {arbitrary,_} -> ok; + {'single-ASN1-type',_} -> ok; + {'octet-aligned',_} -> ok + end. + +check_EXTERNAL_DVD(DVD) when is_list(DVD) -> ok; +check_EXTERNAL_DVD(asn1_NOVALUE) -> ok. + +check_EXTERNAL_DV(DV) when is_list(DV); is_binary(DV) -> ok. + +check_object_identifier(Tuple) when is_tuple(Tuple) -> + %% An OBJECT IDENTIFIER is a tuple with integer elements. + case [E || E <- tuple_to_list(Tuple), + not is_integer(E)] of + [] -> ok + end. diff --git a/lib/asn1/test/testDoubleEllipses.erl b/lib/asn1/test/testDoubleEllipses.erl index 9030a99ce2..72ff693667 100644 --- a/lib/asn1/test/testDoubleEllipses.erl +++ b/lib/asn1/test/testDoubleEllipses.erl @@ -51,7 +51,7 @@ main(_Rules) -> b = [1,0,1,0], e = true, c = false, f = 14, g = 16}), ?line {ok,#'SeqAltV2'{a = 10, d = 12, - b = [1,0,1,0], e = true, + b = <<2#1010:4>>, e = true, h = asn1_NOVALUE, i = asn1_NOVALUE, c = false, f = 14, g = 16}} = asn1_wrapper:decode('DoubleEllipses','SeqAltV2',Bytes3), @@ -62,7 +62,7 @@ main(_Rules) -> h = "PS", i = 13, c = false, f = 14, g = 16}), ?line {ok,#'SeqAlt'{a = 10, d = 12, - b = [1,0,1,0], e = true, + b = <<2#1010:4>>, e = true, c = false, f = 14, g = 16}} = asn1_wrapper:decode('DoubleEllipses','SeqAlt',Bytes4), @@ -83,7 +83,7 @@ main(_Rules) -> b = [1,0,1,0], e = true, c = false, f = 14, g = 16}), ?line {ok,#'SetAltV2'{a = 10, d = 12, - b = [1,0,1,0], e = true, + b = <<2#1010:4>>, e = true, h = asn1_NOVALUE, i = asn1_NOVALUE, c = false, f = 14, g = 16}} = asn1_wrapper:decode('DoubleEllipses','SetAltV2',Bytes7), @@ -94,7 +94,7 @@ main(_Rules) -> h = "PS", i = 13, c = false, f = 14, g = 16}), ?line {ok,#'SetAlt'{a = 10, d = 12, - b = [1,0,1,0], e = true, + b = <<2#1010:4>>, e = true, c = false, f = 14, g = 16}} = asn1_wrapper:decode('DoubleEllipses','SetAlt',Bytes8), ok. diff --git a/lib/asn1/test/testNBAPsystem.erl b/lib/asn1/test/testNBAPsystem.erl index 4e8381e51e..3e7dfb0522 100644 --- a/lib/asn1/test/testNBAPsystem.erl +++ b/lib/asn1/test/testNBAPsystem.erl @@ -142,8 +142,7 @@ audit_req() -> protocolIEs = [#'ProtocolIE-Field'{id=114, criticality=ignore, - value={'Start-Of-Audit-Sequence-Indicator', - 'start-of-audit-sequence' } + value='start-of-audit-sequence' } ] }. diff --git a/lib/asn1/test/testParamBasic.erl b/lib/asn1/test/testParamBasic.erl index b5780195b8..e5e2de804c 100644 --- a/lib/asn1/test/testParamBasic.erl +++ b/lib/asn1/test/testParamBasic.erl @@ -40,8 +40,8 @@ main(Rules) -> ?line {ok,Bytes12} = asn1_wrapper:encode('ParamBasic','T12', #'T12'{number = 11, - string = [1,0,1,0,1]}), - ?line {ok,{'T12',11,[1,0,1,0,1]}} = + string = <<2#10101:5>>}), + {ok,{'T12',11,<<2#10101:5>>}} = asn1_wrapper:decode('ParamBasic','T12',Bytes12), ?line {ok,Bytes13} = @@ -54,8 +54,8 @@ main(Rules) -> ?line {ok,Bytes14} = asn1_wrapper:encode('ParamBasic','T22', #'T22'{number = 11, - string = [1,0,1,0,1]}), - ?line {ok,{'T22',11,[1,0,1,0,1]}} = + string = <<2#10101:5>>}), + {ok,{'T22',11,<<2#10101:5>>}} = asn1_wrapper:decode('ParamBasic','T22',Bytes14), case Rules of diff --git a/lib/asn1/test/testPrimStrings.erl b/lib/asn1/test/testPrimStrings.erl index 263d9e5ed2..935e730ca1 100644 --- a/lib/asn1/test/testPrimStrings.erl +++ b/lib/asn1/test/testPrimStrings.erl @@ -20,7 +20,6 @@ -module(testPrimStrings). -export([bit_string/1]). --export([bit_string_unnamed/1]). -export([octet_string/1]). -export([numeric_string/1]). -export([other_strings/1]). @@ -37,93 +36,35 @@ bit_string(Rules) -> %%========================================================== %% Bs1 ::= BIT STRING %%========================================================== + + bs_roundtrip('Bs1', 0, <<>>), + bs_roundtrip('Bs1', 4, <<1:3>>), + bs_roundtrip('Bs1', 15, <<15:4>>), + bs_roundtrip('Bs1', 255, <<255:8>>), + + bs_roundtrip('Bs1', 256, [0,0,0,0,0,0,0,0,1]), + bs_roundtrip('Bs1', 257, [1,0,0,0,0,0,0,0,1]), + bs_roundtrip('Bs1', 444, [0,0,1,1,1,1,0,1,1]), - ?line {ok,Bytes1} = asn1_wrapper:encode('PrimStrings','Bs1',0), - ?line {ok,[]} = asn1_wrapper:decode('PrimStrings','Bs1',lists:flatten(Bytes1)), - - ?line {ok,Bytes2} = asn1_wrapper:encode('PrimStrings','Bs1',4), - ?line {ok,[0,0,1]} = asn1_wrapper:decode('PrimStrings','Bs1',lists:flatten(Bytes2)), - - ?line {ok,Bytes3} = asn1_wrapper:encode('PrimStrings','Bs1',15), - ?line {ok,[1,1,1,1]} = asn1_wrapper:decode('PrimStrings','Bs1',lists:flatten(Bytes3)), - - ?line {ok,Bytes4} = asn1_wrapper:encode('PrimStrings','Bs1',255), - ?line {ok,[1,1,1,1,1,1,1,1]} = asn1_wrapper:decode('PrimStrings','Bs1',lists:flatten(Bytes4)), - - ?line {ok,Bytes5} = asn1_wrapper:encode('PrimStrings','Bs1',256), - ?line {ok,[0,0,0,0,0,0,0,0,1]} = asn1_wrapper:decode('PrimStrings','Bs1',lists:flatten(Bytes5)), - - ?line {ok,Bytes6} = asn1_wrapper:encode('PrimStrings','Bs1',257), - ?line {ok,[1,0,0,0,0,0,0,0,1]} = asn1_wrapper:decode('PrimStrings','Bs1',lists:flatten(Bytes6)), - - ?line {ok,Bytes7} = asn1_wrapper:encode('PrimStrings','Bs1',444), - ?line {ok,[0,0,1,1,1,1,0,1,1]} = asn1_wrapper:decode('PrimStrings','Bs1',lists:flatten(Bytes7)), - - ?line {ok,Bytes8} = asn1_wrapper:encode('PrimStrings','Bs1',12345678901234567890), - ?line {ok,_} = asn1_wrapper:decode('PrimStrings','Bs1',lists:flatten(Bytes8)), - -%% Removed due to beam cannot handle this big integers -%% Bs1_1 = 123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890, -%% ?line {ok,Bytes9} = asn1_wrapper:encode('PrimStrings','Bs1',Bs1_1), -%% ?line {ok,_} = asn1_wrapper:decode('PrimStrings','Bs1',lists:flatten(Bytes9)), - -%% Bs1_2 = 12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890, -%% ?line {ok,Bytes10} = asn1_wrapper:encode('PrimStrings','Bs1',Bs1_2), -%% ?line {ok,_} = asn1_wrapper:decode('PrimStrings','Bs1',lists:flatten(Bytes10)), - - ?line {ok,Bytes11} = asn1_wrapper:encode('PrimStrings','Bs1',[1,1,1,1,1,1,1,1]), - ?line {ok,[1,1,1,1,1,1,1,1]} = asn1_wrapper:decode('PrimStrings','Bs1',lists:flatten(Bytes11)), - - ?line case asn1_wrapper:erule(Rules) of - ber -> - ?line {ok,Bytes12} = asn1_wrapper:encode('PrimStrings','Bs1',[0,1,0,0,1,0]), - ?line {ok,[0,1,0,0,1,0]} = - asn1_wrapper:decode('PrimStrings','Bs1',lists:flatten(Bytes12)), - - ?line {ok,Bytes13} = asn1_wrapper:encode('PrimStrings','Bs1',[1,0,0,0,0,0,0,0,0]), - ?line {ok,[1,0,0,0,0,0,0,0,0]} = - asn1_wrapper:decode('PrimStrings','Bs1',lists:flatten(Bytes13)), - ok; - per -> - ?line {ok,Bytes12} = asn1_wrapper:encode('PrimStrings','Bs1',[0,1,0,0,1,0]), - ?line {ok,[0,1,0,0,1,0]} = - asn1_wrapper:decode('PrimStrings','Bs1',lists:flatten(Bytes12)), - - ?line {ok,Bytes13} = asn1_wrapper:encode('PrimStrings','Bs1',[1,0,0,0,0,0,0,0,0]), - ?line {ok,[1,0,0,0,0,0,0,0,0]} = - asn1_wrapper:decode('PrimStrings','Bs1',lists:flatten(Bytes13)), - ok - end, - - ?line {ok,Bytes14} = - asn1_wrapper:encode('PrimStrings','Bs1',[0,1,0,0,1,0,1,1,1,1,1,0,0,0,1,0,0,1,1]), - ?line {ok,[0,1,0,0,1,0,1,1,1,1,1,0,0,0,1,0,0,1,1]} = - asn1_wrapper:decode('PrimStrings','Bs1',lists:flatten(Bytes14)), - - - ?line case asn1_wrapper:erule(Rules) of - ber -> - ?line Bytes15 = [35,8,3,2,0,73,3,2,4,32], - ?line {ok,[0,1,0,0,1,0,0,1,0,0,1,0]} = - asn1_wrapper:decode('PrimStrings','Bs1',lists:flatten(Bytes15)), - - ?line Bytes16 = [35,9,3,2,0,234,3,3,7,156,0], - ?line {ok,[1,1,1,0,1,0,1,0,1,0,0,1,1,1,0,0,0]} = - asn1_wrapper:decode('PrimStrings','Bs1',lists:flatten(Bytes16)), - - ?line Bytes17 = [35,128,3,2,0,73,3,2,4,32,0,0], - ?line {ok,[0,1,0,0,1,0,0,1,0,0,1,0]} = - asn1_wrapper:decode('PrimStrings','Bs1',lists:flatten(Bytes17)), - - ?line Bytes18 = [35,128,3,2,0,234,3,3,7,156,0,0,0], - ?line {ok,[1,1,1,0,1,0,1,0,1,0,0,1,1,1,0,0,0]} = - asn1_wrapper:decode('PrimStrings','Bs1',lists:flatten(Bytes18)), - ok; - - per -> - ok - end, + {ok,Enc1} = 'PrimStrings':encode('Bs1', 12345678901234567890), + {ok,_} = 'PrimStrings':decode('Bs1', Enc1), + + bs_roundtrip('Bs1', [1,1,1,1,1,1,1,1]), + bs_roundtrip('Bs1', [0,1,0,0,1,0]), + 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 + 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]), + bs_decode('Bs1', <<35,9,3,2,0,234,3,3,7,156,0>>, + [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, %%========================================================== @@ -156,77 +97,55 @@ bit_string(Rules) -> %% Bs3 ::= BIT STRING {su(0), mo(1), tu(2), we(3), th(4), fr(5), sa(6) } (SIZE (1..7)) %%========================================================== - ?line {ok,Bytes31} = asn1_wrapper:encode('PrimStrings','Bs3',[mo,tu,fr]), - ?line {ok,[mo,tu,fr]} = asn1_wrapper:decode('PrimStrings','Bs3',lists:flatten(Bytes31)), - - ?line {ok,Bytes32} = asn1_wrapper:encode('PrimStrings','Bs3',[0,1,1,0,0,1,0]), - ?line {ok,[mo,tu,fr]} = asn1_wrapper:decode('PrimStrings','Bs3',lists:flatten(Bytes32)), - + roundtrip('Bs3', [mo,tu,fr]), + bs_roundtrip('Bs3', [0,1,1,0,0,1,0], [mo,tu,fr]), %%========================================================== %% Bs7 ::= BIT STRING (SIZE (24)) %%========================================================== - ?line {ok,Bytes33} = asn1_wrapper:encode('PrimStrings','Bs7',53245), - ?line {ok,[1,0,1,1,1,1,1,1,1,1,1,1,0,0,1,1,0,0,0,0,0,0,0,0]} = - asn1_wrapper:decode('PrimStrings','Bs7',Bytes33), - - ?line {ok,Bytes34} = asn1_wrapper:encode('PrimStrings','Bs7',[1,0,1,0]), - ?line {ok,[1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]} = - asn1_wrapper:decode('PrimStrings','Bs7',Bytes34), + bs_roundtrip('Bs7', 53245, + [1,0,1,1,1,1,1,1,1,1,1,1,0,0,1,1,0,0,0,0,0,0,0,0]), + bs_roundtrip('Bs7', [1,0,1,0], + [1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]), %%========================================================== %% BsPri ::= [PRIVATE 61] BIT STRING %%========================================================== - ?line {ok,Bytes41} = asn1_wrapper:encode('PrimStrings','BsPri',45), - ?line {ok,[1,0,1,1,0,1]} = asn1_wrapper:decode('PrimStrings','BsPri',lists:flatten(Bytes41)), + bs_roundtrip('BsPri', 45, [1,0,1,1,0,1]), - ?line {ok,Bytes42} = asn1_wrapper:encode('PrimStrings','BsPri',211), - ?line {ok,[1,1,0,0,1,0,1,1]} = asn1_wrapper:decode('PrimStrings','BsPri',lists:flatten(Bytes42)), - - ?line case asn1_wrapper:erule(Rules) of - ber -> - ?line {ok,[0,1,0,0,1,0,1,1,1,1,1,0,0,0,1,0,0,1,1]} = - asn1_wrapper:decode('PrimStrings','BsPri',[223,61,4,5,75,226,96]), - - ?line {ok,[0,1,0,0,1,0,1,1,1,1,1,0,0,0,1,0,0,1,1]} = - asn1_wrapper:decode('PrimStrings','BsPri',[255,61,128,3,4,5,75,226,96,0,0]), - - ?line {ok,[0,1,0,0,1,0,1,1,1,1,1,0,0,0,1,0,0,1,1]} = - asn1_wrapper:decode('PrimStrings','BsPri',[255,61,9,3,2,0,75,3,3,5,226,96]), - - ?line {ok,[0,1,0,0,1,0,1,1,1,1,1,0,0,0,1,0,0,1,1]} = - asn1_wrapper:decode('PrimStrings','BsPri',[255,61,128,3,2,0,75,3,3,5,226,96,0,0]), - ok; - - per -> - ok - end, + bs_roundtrip('BsPri', 211, [1,1,0,0,1,0,1,1]), + case asn1_wrapper:erule(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]), + bs_decode('BsPri', <<255,61,128,3,4,5,75,226,96,0,0>>, + [0,1,0,0,1,0,1,1,1,1,1,0,0,0,1,0,0,1,1]), + bs_decode('BsPri', <<255,61,9,3,2,0,75,3,3,5,226,96>>, + [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, %%========================================================== %% BsExpPri ::= [PRIVATE 61] EXPLICIT BIT STRING %%========================================================== - ?line {ok,Bytes51} = asn1_wrapper:encode('PrimStrings','BsExpPri',45), - ?line {ok,[1,0,1,1,0,1]} = - asn1_wrapper:decode('PrimStrings','BsExpPri',lists:flatten(Bytes51)), - - ?line {ok,Bytes52} = asn1_wrapper:encode('PrimStrings','BsExpPri',211), - ?line {ok,[1,1,0,0,1,0,1,1]} = - asn1_wrapper:decode('PrimStrings','BsExpPri',lists:flatten(Bytes52)), + bs_roundtrip('BsExpPri', 45, [1,0,1,1,0,1]), + bs_roundtrip('BsExpPri', 211, [1,1,0,0,1,0,1,1]), - ?line case asn1_wrapper:erule(Rules) of - ber -> - ?line {ok,[0,1,0,0,1,0,1,1,1,1,1,0,0,0,1,0,0,1,1]} = - asn1_wrapper:decode('PrimStrings','BsExpPri',[255,61,6,3,4,5,75,226,96]), - ok; - - per -> - ok - end, + case asn1_wrapper:erule(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, %%========================================================== %% TestS ::= BIT STRING {a(0),b(1)} (SIZE (3..8)), test case for OTP-4353 @@ -248,14 +167,10 @@ bit_string(Rules) -> %% 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 ber -> - ?line {error,_} = asn1_wrapper:encode('PrimStrings','BSMAX', - [1,0,1]), - ?line {ok,Bytes55} = - asn1_wrapper:encode('PrimStrings','BSMAX',[1,0,1,0,1]), - ?line {ok,[1,0,1,0,1]} = - asn1_wrapper:decode('PrimStrings','BSMAX',Bytes55); + {error,_} = 'PrimStrings':encode('BSMAX', [1,0,1]); _ -> ok end, @@ -274,47 +189,13 @@ bit_string(Rules) -> end, BSList255 = BSmaker(BSmaker,0,255,{1,0},[]), + bs_roundtrip('BS255', BSList255), BSList256 = BSmaker(BSmaker,0,256,{1,0},[]), + bs_roundtrip('BS256', BSList256), BSList1024 = BSmaker(BSmaker,0,1024,{1,0},[]), - ?line {ok,Bytes56} = - asn1_wrapper:encode('PrimStrings','BS255',BSList255), - ?line {ok,BSList255} = - asn1_wrapper:decode('PrimStrings','BS255',Bytes56), - ?line {ok,Bytes57} = - asn1_wrapper:encode('PrimStrings','BS256',BSList256), - ?line {ok,BSList256} = - asn1_wrapper:decode('PrimStrings','BS256',Bytes57), - ?line {ok,Bytes58} = - asn1_wrapper:encode('PrimStrings','BS1024',BSList1024), - ?line {ok,BSList1024} = - asn1_wrapper:decode('PrimStrings','BS1024',Bytes58). - - - -bit_string_unnamed(Rules) -> - case asn1_wrapper:erule(Rules) of - ber -> - ok; - per -> - ?line {ok,Bytes1} = - case catch asn1_wrapper:encode('PrimStrings','TransportLayerAddress',[0,1,1,0]) of - Ret = {ok,_} -> Ret; - Err -> - Config = file:consult(test_config), - ?line OutDir = ?config(priv_dir,Config), - MyOut = "/home/bertil/daily_build", - file:copy(filename:join([OutDir,"PrimStrings.erl"]), - filename:join([MyOut,"PrimStrings.erl"])), - file:copy(filename:join([OutDir,"PrimStrings.beam"]), - filename:join([MyOut,"PrimStrings.beam"])), - file:copy(code:which(asn1rt_per_v1), - filename:join([MyOut,"asn1rt_per_v1.beam"])), - file:copy(filename:join([code:lib_dir(asn1),src,"asn1rt_per_v1.erl"]),filename:join([MyOut,"asn1rt_per_v1.erl"])), - io:format("Err: ~p~n",[Err]), - Err - end, - ?line {ok,[0,1,1,0]} = asn1_wrapper:decode('PrimStrings','TransportLayerAddress',lists:flatten(Bytes1)) - end. + bs_roundtrip('BS1024', BSList1024), + + bs_roundtrip('TransportLayerAddress', [0,1,1,0]). octet_string(Rules) -> @@ -534,7 +415,7 @@ other_strings(_Rules) -> roundtrip('Ps', [47,23,99,75,47]), roundtrip('Ps', []), - + roundtrip('Ps11', "*0123456789*"), %%========================================================== %% Vis ::= VisibleString @@ -542,7 +423,8 @@ other_strings(_Rules) -> roundtrip('Vis', [47,23,99,75,47]), roundtrip('Vis', []), - + roundtrip('Vis8', "7654321001234567"), + roundtrip('Vis8', []), %%========================================================== %% IA5 ::= IA5String @@ -553,6 +435,9 @@ other_strings(_Rules) -> IA5_1 = "12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890", roundtrip('IA5', IA5_1), + + roundtrip('IA5Visible', lists:seq($\s, $~)), + ok. @@ -828,3 +713,39 @@ roundtrip(Type, Value) -> {ok,Encoded} = 'PrimStrings':encode(Type, Value), {ok,Value} = '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), + case M:decode(Type, Encoded) of + {ok,Expected} -> + ok; + {ok,Other} -> + Expected = convert(Other, Expected) + end. + +bs_decode(Type, Encoded, Expected) -> + M = 'PrimStrings', + case M:decode(Type, Encoded) of + {ok,Expected} -> + ok; + {ok,Other} -> + Expected = convert(Other, Expected) + end. + +convert(Val, E) when is_bitstring(Val) -> + convert_1(Val, E); +convert({Unused,Bin}, E) -> + Sz = bit_size(Bin) - Unused, + <<Val:Sz/bitstring,_:Unused>> = Bin, + convert_1(Val, E); +convert(List, E) when is_list(List) -> + Val = << <<B:1>> || B <- List >>, + convert_1(Val, E). + +convert_1(Val, E) when is_list(E) -> + [B || <<B:1>> <= Val]; +convert_1(Val, E) when is_bitstring(E) -> Val. diff --git a/lib/asn1/test/testSSLspecs.erl b/lib/asn1/test/testSSLspecs.erl index 45c5da50f0..08da92243e 100644 --- a/lib/asn1/test/testSSLspecs.erl +++ b/lib/asn1/test/testSSLspecs.erl @@ -20,7 +20,7 @@ -module(testSSLspecs). --export([compile/2,run/1,compile_inline/2,run_inline/1]). +-export([compile/2,run/1,compile_combined/2,run_combined/1]). -include_lib("test_server/include/test_server.hrl"). @@ -42,15 +42,13 @@ compile(Config, Options) -> asn1_test_lib:compile_all(["PKIX1Explicit93", "PKIX1Implicit93"], Config, NewOptions). -compile_inline(Config, ber=Rule) -> +compile_combined(Config, ber=Rule) -> DataDir = ?config(data_dir, Config), CaseDir = ?config(case_dir, Config), Options = [{i, CaseDir}, {i, DataDir}, Rule, - der, compact_bit_string, asn1config, inline], - ok = remove_db_file_inline(CaseDir), - asn1_test_lib:compile("OTP-PKIX.set.asn", Config, Options); -compile_inline(_Config, _Rule) -> - ok. + der, compact_bit_string, asn1config], + ok = remove_db_files_combined(CaseDir), + asn1_test_lib:compile("OTP-PKIX.set.asn", Config, Options). remove_db_files(Dir) -> ?line ok = remove_db_file(Dir ++ "PKIX1Explicit93.asn1db"), @@ -65,7 +63,7 @@ remove_db_file(File) -> Err end. -remove_db_file_inline(Dir) -> +remove_db_files_combined(Dir) -> ?line ok = remove_db_file(Dir ++ "OTP-PKIX.asn1db"), ?line ok = remove_db_file(Dir ++ "SSL-PKIX.asn1db"), ?line ok = remove_db_file(Dir ++ "PKIXAttributeCertificate.asn1db"), @@ -74,14 +72,11 @@ remove_db_file_inline(Dir) -> ?line ok = remove_db_file(Dir ++ "PKIX1Implicit88.asn1db"). run(ber) -> - run1(1); -run(_) -> - ok. + run1(1). run1(6) -> ?line f1(6), ?line f2(6), -%% ?line transform3(ex(7)), ?line transform4(ex(7)); run1(N) -> ?line f1(N), @@ -146,12 +141,10 @@ ex(7) -> {1,2,840,113549,1,9,1}, [[19,5,111,116,112,67,65]]}. -run_inline(ber) -> +run_combined(ber) -> Cert = cert(), ?line {ok,{'CertificatePKIX1Explicit88',{Type,UnDec},_,_}} = 'OTP-PKIX':decode_TBSCert_exclusive(Cert), ?line {ok,_} = 'OTP-PKIX':decode_part(Type,UnDec), - ok; -run_inline(_) -> ok. cert() -> diff --git a/lib/asn1/test/testSeqSetDefaultVal.erl b/lib/asn1/test/testSeqSetDefaultVal.erl index ab484db5f2..6e680feafa 100644 --- a/lib/asn1/test/testSeqSetDefaultVal.erl +++ b/lib/asn1/test/testSeqSetDefaultVal.erl @@ -134,7 +134,7 @@ main(_Rules) -> c={5,<<64>>}, d=0}), - ?line {ok,{'SeqBS',[1,0,1,0,1,1,0],2698,[second],[]}} = + {ok,{'SeqBS',[1,0,1,0,1,1,0],2698,[second],<<>>}} = asn1_wrapper:decode('Default','SeqBS',[48,3,131,1,0]), ?line {ok,{'SeqBS',[1,0,1,0,1,1,0],2698,[second],[1,0,0,1]}} = @@ -161,7 +161,7 @@ main(_Rules) -> c={5,<<64>>}, d=0}), - ?line {ok,{'SetBS',[1,0,1,0,1,1,0],2698,[second],[]}} = + {ok,{'SetBS',[1,0,1,0,1,1,0],2698,[second],<<>>}} = asn1_wrapper:decode('Default','SetBS',[49,3,131,1,0]), ?line {ok,{'SetBS',[1,0,1,0,1,1,0],2698,[second],[1,0,0,1]}} = diff --git a/lib/asn1/test/testTypeValueNotation.erl b/lib/asn1/test/testTypeValueNotation.erl index 59f7385f08..d21b054e8d 100644 --- a/lib/asn1/test/testTypeValueNotation.erl +++ b/lib/asn1/test/testTypeValueNotation.erl @@ -28,7 +28,7 @@ main(_Rule, _Option) -> int = 12, bool = true, enum = a, - bitstr = [1, 0, 1, 0], + bitstr = <<2#1010:4>>, null = 'NULL', oid = {1, 2, 55}, vstr = "Hello World"}, diff --git a/lib/asn1/test/test_compile_options.erl b/lib/asn1/test/test_compile_options.erl index b973c5fbcc..179299c78d 100644 --- a/lib/asn1/test/test_compile_options.erl +++ b/lib/asn1/test/test_compile_options.erl @@ -51,14 +51,13 @@ path(Config) -> {ok,CWD} = file:get_cwd(), ?line file:set_cwd(filename:join([DataDir,subdir])), - %%?line ok=asn1ct:compile(filename:join([DataDir,"../MyMerge.set.asn"]),[{inline,mymerge},{outdir,OutDir}]), - ?line ok=asn1ct:compile("../MyMerge.set.asn",[{inline,mymerge},{outdir,OutDir}]), + ok = asn1ct:compile("../MyMerge.set.asn",[{outdir,OutDir}]), ?line ok=outfiles_check(OutDir), ?line outfiles_remove(OutDir), file:set_cwd(filename:join([DataDir,subdir,subsubdir])), - ?line ok = asn1ct:compile('../../MyMerge.set.asn',[{inline,mymerge},{i,'..'},{outdir,OutDir}]), + ok = asn1ct:compile('../../MyMerge.set.asn',[{i,'..'},{outdir,OutDir}]), ?line ok=outfiles_check(OutDir,outfiles2()), file:set_cwd(CWD), @@ -182,11 +181,10 @@ outfiles_check(OutDir,[H|T]) -> outfiles_check(OutDir,T). outfiles1() -> - ["mymerge.erl","mymerge.beam","MyMerge.asn1db","MyMerge.beam", + ["MyMerge.asn1db","MyMerge.beam", "MyMerge.erl","MyMerge.hrl"]. outfiles2() -> - ["MyMerge.beam","mymerge.erl","MyMerge.asn1db","MyMerge.erl", - "mymerge.beam"]. + ["MyMerge.beam","MyMerge.asn1db","MyMerge.erl"]. outfiles_remove(OutDir) -> lists:foreach(fun(F)-> file:delete(filename:join([OutDir,F])) end, diff --git a/lib/asn1/test/test_inline.erl b/lib/asn1/test/test_inline.erl deleted file mode 100644 index e03ad739f9..0000000000 --- a/lib/asn1/test/test_inline.erl +++ /dev/null @@ -1,270 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2012. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% 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(test_inline). - --export([compile/2,main/2,inline1/3,performance/1,performance2/0]). --export([mvrasn_inlined_encdec/2,mvrasn_encdec/2, - mi_encdec/2,m_encdec/2]). - --include_lib("test_server/include/test_server.hrl"). --define(times, 5000). --define(times2, 50000). - -compile(Config, Options) -> - CaseDir = ?config(case_dir, Config), - asn1_test_lib:compile("Mvrasn.set.asn", Config, [{inline, mvrasn_inlined}|Options]), - asn1_test_lib:compile("Mod.set.asn", Config, [{inline, m}|Options]), - ok = remove_inlined_files(CaseDir, [filename:join([CaseDir, X])||X<-["m.erl", "m.beam"]]), - asn1_test_lib:compile("Mod.set.asn", Config, [inline|Options]), - ok = remove_inlined_files(CaseDir, []). - -inline1(Config, Rule, Opt) -> - CaseDir = ?config(case_dir, Config), - - asn1_test_lib:compile("P-Record", Config, [{inline, 'inlined_P_Record'}|Opt]), - test_inline1(), - - ok=remove_inlined_files2(CaseDir, ber), - - case Rule of - ber -> - asn1_test_lib:compile("P-Record", Config, - [ber, inline, asn1config|Opt]), - test_inline2(Rule, 'P-Record'), - remove_inlined_files3(CaseDir, Rule), - asn1_test_lib:compile("p_record.set.asn", Config, - [ber, inline, asn1config|Opt]), - test_inline2(Rule, 'p_record'), - remove_inlined_files4(CaseDir, Rule); - _ -> - ok - end. - -main(Config, _Erule) -> - Val = val(Config), - ?line {ok,Bytes}=asn1_wrapper:encode(mvrasn_inlined,'InsertSubscriberDataArg',Val), - ?line {ok,_Val2}=asn1_wrapper:decode(mvrasn_inlined,'InsertSubscriberDataArg',Bytes). - -test_inline1() -> - PRecMsg = {'PersonnelRecord',{'Name',"Sven","S","Svensson"}, - "manager",123,"20000202",{'Name',"Inga","K","Svensson"}, - asn1_DEFAULT}, - ?line {ok,Bytes}=asn1_wrapper:encode('inlined_P_Record','PersonnelRecord', - PRecMsg), - ?line {ok,_}=asn1_wrapper:decode('inlined_P_Record', - 'PersonnelRecord',Bytes). - -test_inline2(ber,Mod) -> - PRecMsg = {'PersonnelRecord',{'Name',"Sven","S","Svensson"}, - "manager",123,"20000202",{'Name',"Inga","K","Svensson"}, - asn1_DEFAULT}, - ?line {ok,Bytes} = Mod:encode('PersonnelRecord',PRecMsg), - {ok,_} = Mod:sel_dec(Bytes); -test_inline2(_,_) -> - ok. - -val(Config) -> - {ok,Val} = asn1ct:value('Mvrasn','InsertSubscriberDataArg', - [{i, ?config(case_dir, Config)}]), - Val. - -performance(Config) -> - Val = val(Config), - %% warm up - timer:tc(?MODULE,mvrasn_inlined_encdec,[2,Val]), - %% performance test - ?line {Time1,ok}=timer:tc(?MODULE,mvrasn_inlined_encdec,[?times,Val]), - %% warm up - timer:tc(?MODULE,mvrasn_encdec,[2,Val]), - %% performance test - ?line {Time2,ok}=timer:tc(?MODULE,mvrasn_encdec,[?times,Val]), - - ?line Comment = "inlined_code: "++ - integer_to_list(round(Time1/?times))++ - " micro,<br>original_code: "++ - integer_to_list(round(Time2/?times))++ -% " micro,~ninlined_code[inline]: "++ -% integer_to_list(round(Time3/?times))++ - " micro", - {comment,Comment}. - - -mvrasn_inlined_encdec(0,_) -> - ok; -mvrasn_inlined_encdec(N,V) -> - ?line {ok,B}=mvrasn_inlined:encode('InsertSubscriberDataArg',V), - ?line {ok,_R}=mvrasn_inlined:decode('InsertSubscriberDataArg',B), - mvrasn_inlined_encdec(N-1,V). - -mvrasn_encdec(0,_) -> - ok; -mvrasn_encdec(N,V) -> - ?line {ok,B}='Mvrasn-11-6':encode('InsertSubscriberDataArg',V), - ?line {ok,_R}='Mvrasn-11-6':decode('InsertSubscriberDataArg',B), - mvrasn_encdec(N-1,V). - -%% mvrasn_inlined_i_encdec(0,_) -> -%% ok; -%% mvrasn_inlined_i_encdec(N,V) -> -%% {ok,B}=mvrasn_inlined_i:encode('InsertSubscriberDataArg',V), -%% {ok,_R}=mvrasn_inlined_i:decode('InsertSubscriberDataArg',B), -%% mvrasn_inlined_i_encdec(N-1,V). - -performance2() -> - Val = mval(), - %% warm up - timer:tc(?MODULE,mi_encdec,[?times,Val]), - %% performance test - {Time1,_R1}=timer:tc(?MODULE,mi_encdec,[?times2,Val]), - %% warm up - timer:tc(?MODULE,m_encdec,[?times,Val]), - %% performance test - {Time2,_R2}=timer:tc(?MODULE,m_encdec,[?times2,Val]), - ?line Comment = "inlined_code: "++ - integer_to_list(round(Time1/?times2))++ - " micro,<br>original_code: "++ - integer_to_list(round(Time2/?times2))++ - " micro<br>"++ - "The inlined code was "++ - integer_to_list(round(((Time2-Time1)/Time2)*100))++ - " % faster than the original code.", - {comment,Comment}. - -mi_encdec(0,_) -> - ok; -mi_encdec(N,Val) -> - {ok,B}=m:encode('L',Val), - {ok,_R}=m:decode('L',B), -% io:format("a"), - mi_encdec(N-1,Val). - -m_encdec(0,_) -> - ok; -m_encdec(N,Val) -> - {ok,B}='Mod':encode('L',Val), - {ok,_R}='Mod':decode('L',B), - m_encdec(N-1,Val). - - --record('L', {country, region, name}). --record('OtherName', {locationName, thingName}). --record('FamilyName', {prefix, secondname}). --record('Lang', {l}). --record('Inhabitant', {name, country}). --record('Country', {name, language}). --record('PersonName', {name1, name2}). --record('LocName', {region, name}). --record('Reg', {name, inhabitants}). - - -mval() -> - 'L'(). -'L'() -> - #'L'{ - country='Co'(), - region='Reg'(), - name='Name'(othername)}. -'Co'() -> - 'Country'(). -'Country'()-> - #'Country'{name='Name'(othername), - language='Lang'()}. -'Lang'()-> - #'Lang'{l="englsh"}. -'Reg'() -> - #'Reg'{ - name='Name'(othername), - inhabitants='Inhabitants'()}. -'Inhabitants'()-> - lists:duplicate(5,'Inhabitant'()). -'Inhabitant'()-> - #'Inhabitant'{name='Name'(person), - country='Country'()}. -'Name'(person) -> - {person,'PersonName'()}; -'Name'(othername) -> - {othername,'OtherName'()}. -'PersonName'()-> - #'PersonName'{name1='FirstName'(firstname), - name2='FamilyName'()}. -'OtherName'()-> - #'OtherName'{locationName='LocName'(), - thingName='ThingName'()}. -'FirstName'(firstname)-> - {firstname,"Henry"}; -'FirstName'(nickname) -> - {nickname,"nick"}. -'FamilyName'() -> - #'FamilyName'{prefix=none, - secondname="Lloyd"}. -'ThingName'()-> - "Enkoping". -'LocName'()-> - #'LocName'{ - region=svealand, - name="Enkoping"}. - -remove_inlined_files(Dir,Files) -> - ModList=[filename:join([Dir,X])||X<-["Mod"]], - FileList=Files++ mods2files(ModList,".asn1db")++ - mods2files(ModList,".beam")++ - mods2files(ModList,".erl")++mods2files(ModList,".hrl"), - lists:foreach(fun(X) -> - io:format("X: ~p~n",[X]), - ?line ok=file:delete(X) - end,FileList), - ok. -mods2files(ModList,Extension) -> - [X++Extension||X<-ModList]. - - -remove_inlined_files2(Dir,Rule) -> - ?line ok=remove_inlined_files3(Dir,Rule), - TargetErl=filename:join([Dir,"inlined_P_Record.erl"]), - TargetBeam=filename:join([Dir,"inlined_P_Record.beam"]), - lists:foreach(fun(X) -> - ?line ok=file:delete(X) - end,[TargetErl,TargetBeam]), - ok. -remove_inlined_files3(Dir,ber) -> - Erl=filename:join([Dir,"P-Record.erl"]), - Beam=filename:join([Dir,"P-Record.beam"]), - Asn1DB=filename:join([Dir,"P-Record.asn1db"]), - Hrl=filename:join([Dir,"P-Record.hrl"]), - lists:foreach(fun(X) -> - ?line ok=file:delete(X) - end,[Erl,Beam,Asn1DB,Hrl]), - ok; -remove_inlined_files3(_,_) -> - ok. - -remove_inlined_files4(Dir,ber) -> - Erl=filename:join([Dir,"p_record.erl"]), - Beam=filename:join([Dir,"p_record.beam"]), - Asn1DB=filename:join([Dir,"p_record.asn1db"]), - Hrl=filename:join([Dir,"p_record.hrl"]), - ErlBak=filename:join([Dir,"p_record.erl.bak"]), - file:delete(ErlBak), - lists:foreach(fun(X) -> - ?line ok=file:delete(X) - end,[Erl,Beam,Asn1DB,Hrl]), - ok; -remove_inlined_files4(_,_) -> - ok. diff --git a/lib/eldap/src/eldap.erl b/lib/eldap/src/eldap.erl index d030408770..d11f904996 100644 --- a/lib/eldap/src/eldap.erl +++ b/lib/eldap/src/eldap.erl @@ -699,7 +699,6 @@ do_recv(S, #eldap{use_tls=true, timeout=Timeout}, Len) -> recv_response(S, Data) -> case do_recv(S, Data, 0) of {ok, Packet} -> - check_tag(Packet), case asn1rt:decode('ELDAPv3', 'LDAPMessage', Packet) of {ok,Resp} -> {ok,Resp}; Error -> throw(Error) @@ -708,21 +707,6 @@ recv_response(S, Data) -> throw({gen_tcp_error, Reason}) end. -%%% Sanity check of received packet -check_tag(Data) -> - try - {_Tag, Data1, _Rb} = asn1rt_ber_bin:decode_tag(l2b(Data)), - try - {{_Len, _Data2}, _Rb2} = asn1rt_ber_bin:decode_length(l2b(Data1)), - ok - catch - _ -> throw({error,decoded_tag_length}) - end - catch - _ -> - throw({error, decoded_tag}) - end. - %%% Check for expected kind of reply check_reply(Data, {ok,Msg}, Op) when Msg#'LDAPMessage'.messageID == Data#eldap.id -> @@ -1115,7 +1099,3 @@ get_head(Str,Tail) -> %%% Should always succeed ! get_head([H|Tail],Tail,Rhead) -> lists:reverse([H|Rhead]); get_head([H|Rest],Tail,Rhead) -> get_head(Rest,Tail,[H|Rhead]). - -l2b(B) when is_binary(B) -> B; -l2b(L) when is_list(L) -> list_to_binary(L). - diff --git a/lib/public_key/asn1/Makefile b/lib/public_key/asn1/Makefile index f765906b3b..a4e36c7293 100644 --- a/lib/public_key/asn1/Makefile +++ b/lib/public_key/asn1/Makefile @@ -66,7 +66,7 @@ EBIN = ../ebin EXTRA_ERLC_FLAGS = ERL_COMPILE_FLAGS += $(EXTRA_ERLC_FLAGS) -ASN_FLAGS = -bber +der +compact_bit_string +noobj +asn1config +inline +ASN_FLAGS = -bber +der +compact_bit_string +noobj +asn1config # ---------------------------------------------------- # Targets |