diff options
| author | Björn Gustavsson <[email protected]> | 2012-11-26 11:53:23 +0100 |
|---|---|---|
| committer | Björn Gustavsson <[email protected]> | 2012-11-26 11:53:23 +0100 |
| commit | 1204bb9dc739a80557fb1fa6e35cc113bf943823 (patch) | |
| tree | c7f9030962b5d78e01dbd4137e915eb61e55f26f /lib/asn1 | |
| parent | b4db457fdf813de7046056a0cf71ec104af8b871 (diff) | |
| parent | 66ae461376c17806b25b8165d8ff86782fbacfa6 (diff) | |
| download | otp-1204bb9dc739a80557fb1fa6e35cc113bf943823.tar.gz otp-1204bb9dc739a80557fb1fa6e35cc113bf943823.tar.bz2 otp-1204bb9dc739a80557fb1fa6e35cc113bf943823.zip | |
Merge branch 'bjorn/asn1/clean-up-backends/OTP-10410'
* bjorn/asn1/clean-up-backends/OTP-10410:
Simplify the code for the generated info/0 function
Don't try to work around a non-loadable NIF library
Fix BER encoding when multiple levels of typedefs are used
Update megaco documentation
Update documentation for the asn1 application
Fix other applications
Fix use of asn1 in megaco
Remove the unused asn1ct_gen_ber module
Remove the unused asn1ct_constructed_ber module
Remove the unused asn1ct_per_bin module
Remove unused functions in asn1rt_ber_bin
Remove obsolete back-ends and simplify the options
Make the specialized decodes work with the 'nif' option
Remove support for the obsolete {Typename,Value} tuple notation
Remove tests for the obsolete {TypeName,Value} notation
Remove the obsolete and deprecated 'keyed_list' option
Diffstat (limited to 'lib/asn1')
49 files changed, 508 insertions, 8914 deletions
diff --git a/lib/asn1/doc/src/asn1_ug.xml b/lib/asn1/doc/src/asn1_ug.xml index 1b399fb641..6cb251c3e2 100644 --- a/lib/asn1/doc/src/asn1_ug.xml +++ b/lib/asn1/doc/src/asn1_ug.xml @@ -186,13 +186,21 @@ END </pre> The following shows how the compiler can be called from the Erlang shell:</p> <pre> -1><input>asn1ct:compile("People",[ber_bin]).</input> +1><input>asn1ct:compile("People", [ber]).</input> +ok +2> </pre> + + <p>The <c>verbose</c> option can be given to have information + about the generated files printed:</p> + <pre> +2><input>asn1ct:compile("People", [ber,verbose]).</input> Erlang ASN.1 compiling "People.asn" --{generated,"People.asn1db"}-- --{generated,"People.hrl"}-- --{generated,"People.erl"}-- ok -2> </pre> +3> </pre> + <p>The ASN.1 module People is now accepted and the abstract syntax tree is saved in the <c>People.asn1db</c> file, the generated Erlang code is compiled using the Erlang compiler and @@ -229,7 +237,7 @@ receive constructed and encoded using <c>'People':encode('Person',Answer)</c> which takes an instance of a defined ASN.1 type and transforms it to a - (possibly) nested list of bytes according to the BER or PER + binary according to the BER or PER encoding-rules. <br></br> The encoder and the decoder can also be run from @@ -239,24 +247,12 @@ The encoder and the decoder can also be run from <pre> 2> <input>Rockstar = {'Person',"Some Name",roving,50}.</input> {'Person',"Some Name",roving,50} -3> <input>{ok,Bytes} = asn1rt:encode('People','Person',Rockstar).</input> -{ok,[<<243>>, - [17], - [19,9,"Some Name"], - [2,1,[2]], - [2,1,"2"]]} -4> <input>Bin = list_to_binary(Bytes).</input> -<<243,17,19,9,83,111,109,101,32,78,97,109,101,2,1,2,2,1,50>> -5> <input>{ok,Person} = asn1rt:decode('People','Person',Bin).</input> +3> <input>{ok,Bin} = asn1rt:encode('People','Person',Rockstar).</input> +{ok,<<243,17,19,9,83,111,109,101,32,78,97,109,101,2,1,2, + 2,1,50>>} +4> <input>{ok,Person} = asn1rt:decode('People','Person',Bin).</input> {ok,{'Person',"Some Name",roving,50}} -6> </pre> - <p>Notice that the result from <c>encode</c> is a nested list which - must be turned into a binary before the call to <c>decode</c>. A - binary is necessary as input to decode since the module was compiled - with the <c>ber_bin</c> option - The reason for returning a nested list is that it is faster to produce - and the <c>list_to_binary</c> operation is - performed automatically when the list is sent via the Erlang port mechanism.</p> +5> </pre> </section> <section> @@ -305,17 +301,15 @@ The encoder and the decoder can also be run from ASN.1 compiler:</p> <pre> erlc Person.asn -erlc -bper_bin Person.asn -erlc -bber_bin +optimize ../Example.asn +erlc -bper Person.asn +erlc -bber ../Example.asn erlc -o ../asnfiles -I ../asnfiles -I /usr/local/standards/asn1 Person.asn </pre> <p>The useful options for the ASN.1 compiler are:</p> <taglist> - <tag><c>-b[ber | per | ber_bin | per_bin | uper_bin]</c></tag> + <tag><c>-b[ber | per | uper]</c></tag> <item> <p>Choice of encoding rules, if omitted <c>ber</c> is the - default. The <c>ber_bin</c> and <c>per_bin</c> options - allows for optimizations and are therefore recommended - instead of the <c>ber</c> and <c>per</c> options.</p> + default.</p> </item> <tag><c>-o OutDirectory</c></tag> <item> @@ -339,42 +333,12 @@ erlc -o ../asnfiles -I ../asnfiles -I /usr/local/standards/asn1 Person.asn </item> <tag><c>+der</c></tag> <item> - <p>DER encoding rule. Only when using <c>-ber</c> or - <c>-ber_bin</c> option.</p> - </item> - <tag><c>+optimize</c></tag> - <item> - <p>This flag has effect only when used together with one of - <c>per_bin</c> or <c>ber_bin</c> flags. It gives time optimized - code in the generated modules and it uses another runtime module. - In the <c>per_bin</c> case a nif is used. The - result from an encode is a binary.</p> - <p><em>When this flag is used you cannot use the old format</em><c>{TypeName,Value}</c> when you encode values. Since it is - an unnecessary construct it has been removed in favor of - performance. It - is neither admitted to construct SEQUENCE or SET component values - with the format <c>{ComponentName,Value}</c> since it also is - unnecessary. The only case were it is necessary is in a CHOICE, - were you have to pass values to the right component by specifying - <c>{ComponentName,Value}</c>. See also about - <seealso marker="#TypeNameValue">{Typename,Value}</seealso> below - and in the sections for each type.</p> - </item> - <tag><c>+driver</c></tag> - <item> - <p>As of R15B this means the same as the <c>nif</c> option. Kept for - backwards compatability reasons.</p> - </item> - <tag><c>+nif</c></tag> - <item> - <p>Together with the flags <c>ber_bin</c> - and <c>optimize</c> you choose to use a nif for considerable - faster encode and decode. </p> + <p>DER encoding rule. Only when using <c>-ber</c> option.</p> </item> <tag><c>+asn1config</c></tag> <item> <p>This functionality works together with the flags - <c>ber_bin</c> and <c>optimize</c>. You enables the + <c>ber</c>. It enables the specialized decodes, see the <seealso marker="asn1_spec">Specialized Decode</seealso> chapter. </p> </item> @@ -413,7 +377,6 @@ erlc -o ../asnfiles -I ../asnfiles -I /usr/local/standards/asn1 Person.asn </item> </taglist> <p>For a complete description of <c>erlc</c> see Erts Reference Manual.</p> - <p>For preferred option use see <seealso marker="#preferred option use">Preferred Option Use</seealso> section.</p> <p>The compiler and other compile-time functions can also be invoked from the Erlang shell. Below follows a brief description of the primary functions, for a @@ -429,9 +392,9 @@ asn1ct:compile("H323-MESSAGES.asn1"). </pre> <p>which equals:</p> <pre> asn1ct:compile("H323-MESSAGES.asn1",[ber]). </pre> - <p>If one wants PER encoding with optimizations:</p> + <p>If one wants PER encoding:</p> <pre> -asn1ct:compile("H323-MESSAGES.asn1",[per_bin,optimize]). </pre> +asn1ct:compile("H323-MESSAGES.asn1",[per]). </pre> <p>The generic encode and decode functions can be invoked like this:</p> <pre> asn1ct:encode('H323-MESSAGES','SomeChoiceType',{call,"octetstring"}). @@ -443,269 +406,6 @@ asn1ct:decode('H323-MESSAGES','SomeChoiceType',Bytes). </pre> </section> <section> - <marker id="preferred option use"></marker> - <title>Preferred Option Use</title> - <p> - It may not be obvious which compile options best fit a - situation. This section describes the format of the result of - encode and decode. It also gives some performance statistics - when using certain options. Finally there is a recommendation - which option combinations should be used. - </p> - <p> - The default option is <c>ber</c>. It is the same backend as - <c>ber_bin</c> except that the result of encode is transformed - to a flat list. Below is a table that gives the different - formats of input and output of encode and decode using the - <em>allowed combinations</em> of coding and optimization - options: (EAVF stands for how ASN1 values are represented in - Erlang which is described in the <seealso - marker="#ASN1Types">ASN1 Types chapter</seealso>) - </p> - <table> - <row> - <cell align="left" valign="middle"><em>Encoding Rule</em></cell> - <cell align="left" valign="middle"><em>Compile options, allowed combinations</em></cell> - <cell align="left" valign="middle"><em>encode input</em></cell> - <cell align="left" valign="middle"><em>encode output</em></cell> - <cell align="left" valign="middle"><em>decode input</em></cell> - <cell align="left" valign="middle"><em>decode output</em></cell> - </row> - <row> - <cell align="left" valign="middle">BER</cell> - <cell align="left" valign="middle">[ber] (default)</cell> - <cell align="left" valign="middle">EAVF</cell> - <cell align="left" valign="middle">flat list</cell> - <cell align="left" valign="middle">flat list / binary</cell> - <cell align="left" valign="middle">EAVF</cell> - </row> - <row> - <cell align="left" valign="middle">BER</cell> - <cell align="left" valign="middle">[ber_bin]</cell> - <cell align="left" valign="middle">EAVF</cell> - <cell align="left" valign="middle">iolist</cell> - <cell align="left" valign="middle">binary</cell> - <cell align="left" valign="middle">EAVF</cell> - </row> - <row> - <cell align="left" valign="middle">BER</cell> - <cell align="left" valign="middle"><em>[ber_bin, optimize]</em></cell> - <cell align="left" valign="middle">EAVF</cell> - <cell align="left" valign="middle">iolist</cell> - <cell align="left" valign="middle">binary</cell> - <cell align="left" valign="middle">EAVF</cell> - </row> - <row> - <cell align="left" valign="middle">BER</cell> - <cell align="left" valign="middle"><em>[ber_bin, optimize, nif]</em></cell> - <cell align="left" valign="middle">EAVF</cell> - <cell align="left" valign="middle">iolist</cell> - <cell align="left" valign="middle">iolist / binary</cell> - <cell align="left" valign="middle">EAVF</cell> - </row> - <row> - <cell align="left" valign="middle">PER aligned variant</cell> - <cell align="left" valign="middle">[per]</cell> - <cell align="left" valign="middle">EAVF</cell> - <cell align="left" valign="middle">flat list</cell> - <cell align="left" valign="middle">flat list</cell> - <cell align="left" valign="middle">EAVF</cell> - </row> - <row> - <cell align="left" valign="middle">PER aligned variant</cell> - <cell align="left" valign="middle"><em>[per_bin]</em></cell> - <cell align="left" valign="middle">EAVF</cell> - <cell align="left" valign="middle">iolist / binary</cell> - <cell align="left" valign="middle">binary</cell> - <cell align="left" valign="middle">EAVF</cell> - </row> - <row> - <cell align="left" valign="middle">PER aligned variant</cell> - <cell align="left" valign="middle"><em>[per_bin, optimize]</em></cell> - <cell align="left" valign="middle">EAVF</cell> - <cell align="left" valign="middle">binary</cell> - <cell align="left" valign="middle">binary</cell> - <cell align="left" valign="middle">EAVF</cell> - </row> - <row> - <cell align="left" valign="middle">PER unaligned variant</cell> - <cell align="left" valign="middle"><em>[uper_bin]</em></cell> - <cell align="left" valign="middle">EAVF</cell> - <cell align="left" valign="middle">binary</cell> - <cell align="left" valign="middle">binary</cell> - <cell align="left" valign="middle">EAVF</cell> - </row> - - <row> - <cell align="left" valign="middle">DER</cell> - <cell align="left" valign="middle">[(ber), der]</cell> - <cell align="left" valign="middle">EAVF</cell> - <cell align="left" valign="middle">flat list</cell> - <cell align="left" valign="middle">flat list / binary</cell> - <cell align="left" valign="middle">EAVF</cell> - </row> - <row> - <cell align="left" valign="middle">DER</cell> - <cell align="left" valign="middle">[ber_bin, der]</cell> - <cell align="left" valign="middle">EAVF</cell> - <cell align="left" valign="middle">iolist</cell> - <cell align="left" valign="middle">binary</cell> - <cell align="left" valign="middle">EAVF</cell> - </row> - <row> - <cell align="left" valign="middle">DER</cell> - <cell align="left" valign="middle"><em>[ber_bin, optimize, der]</em></cell> - <cell align="left" valign="middle">EAVF</cell> - <cell align="left" valign="middle">iolist</cell> - <cell align="left" valign="middle">binary</cell> - <cell align="left" valign="middle">EAVF</cell> - </row> - <row> - <cell align="left" valign="middle">DER</cell> - <cell align="left" valign="middle"><em>[ber_bin, optimize, nif, der]</em></cell> - <cell align="left" valign="middle">EAVF</cell> - <cell align="left" valign="middle">iolist</cell> - <cell align="left" valign="middle">binary</cell> - <cell align="left" valign="middle">EAVF</cell> - </row> - - - <tcaption>The output / input formats for different combinations of compile options.</tcaption> - </table> - <p> - Encode / decode speed comparison in one user case for the above - alternatives (except <c>DER</c>) is showed in the table below. The - <c>DER</c> alternatives are slower than their corresponding - <c>BER</c> alternative. - </p> - - <table> - <row> - <cell align="left" valign="middle"><em>compile options</em></cell> - <cell align="left" valign="middle"><em>encode time</em></cell> - <cell align="left" valign="middle"><em>decode time</em></cell> - </row> - <row> - <cell align="left" valign="middle">[ber]</cell> - <cell align="left" valign="middle">120</cell> - <cell align="left" valign="middle">162</cell> - </row> - <row> - <cell align="left" valign="middle">[ber_bin]</cell> - <cell align="left" valign="middle">124</cell> - <cell align="left" valign="middle">154</cell> - </row> - <row> - <cell align="left" valign="middle"><em>[ber_bin, optimize]</em></cell> - <cell align="left" valign="middle">50</cell> - <cell align="left" valign="middle">78</cell> - </row> - <row> - <cell align="left" valign="middle"><em>[ber_bin, optimize, driver]</em></cell> - <cell align="left" valign="middle">50</cell> - <cell align="left" valign="middle">62</cell> - </row> - <row> - <cell align="left" valign="middle">[per]</cell> - <cell align="left" valign="middle">141</cell> - <cell align="left" valign="middle">133</cell> - </row> - <row> - <cell align="left" valign="middle"><em>[per_bin]</em></cell> - <cell align="left" valign="middle">125</cell> - <cell align="left" valign="middle">123</cell> - </row> - <row> - <cell align="left" valign="middle"><em>[per_bin, optimize]</em></cell> - <cell align="left" valign="middle">77</cell> - <cell align="left" valign="middle">72</cell> - </row> - <row> - <cell align="left" valign="middle"><em>[uper_bin]</em></cell> - <cell align="left" valign="middle">97</cell> - <cell align="left" valign="middle">104</cell> - </row> - <tcaption> - One example of difference in speed for the compile option alternatives. - </tcaption> - </table> - - <p> - The compile options <c>ber</c>, <c>per</c> and - <c>driver</c> are kept for backwards compatibility and should not be - used in new code. The nif implementation which replaces the linked-in - driver has been shown to be about 5-15% faster. - </p> - <p> - You are strongly recommended to use the appropriate alternative - of the bold typed options. The <c>optimize</c> and - <c>nif</c> options does not affect the encode or decode - result, just the time spent in run-time. When <c>ber_bin</c> and - <c>nif</c> or <c>per_bin</c> and <c>optimize</c> is - combined the C-code nif is used in chosen parts of encode / - decode procedure. - </p> - <table> - <row> - <cell align="left" valign="middle"><em>Compile options, allowed combinations</em></cell> - <cell align="left" valign="middle"><em>use of nif</em></cell> - </row> - <row> - <cell align="left" valign="middle">[ber]</cell> - <cell align="left" valign="middle">no</cell> - </row> - <row> - <cell align="left" valign="middle">[ber_bin]</cell> - <cell align="left" valign="middle">no</cell> - </row> - <row> - <cell align="left" valign="middle"><em>[ber_bin, optimize]</em></cell> - <cell align="left" valign="middle">no</cell> - </row> - <row> - <cell align="left" valign="middle"><em>[ber_bin, optimize, nif]</em></cell> - <cell align="left" valign="middle">yes</cell> - </row> - <row> - <cell align="left" valign="middle">[per]</cell> - <cell align="left" valign="middle">no</cell> - </row> - <row> - <cell align="left" valign="middle"><em>[per_bin]</em></cell> - <cell align="left" valign="middle">no</cell> - </row> - <row> - <cell align="left" valign="middle"><em>[per_bin, optimize]</em></cell> - <cell align="left" valign="middle">yes</cell> - </row> - <row> - <cell align="left" valign="middle"><em>[uper_bin]</em></cell> - <cell align="left" valign="middle">no</cell> - </row> - - <row> - <cell align="left" valign="middle">[(ber), der]</cell> - <cell align="left" valign="middle">no</cell> - </row> - <row> - <cell align="left" valign="middle">[ber_bin, der]</cell> - <cell align="left" valign="middle">no</cell> - </row> - <row> - <cell align="left" valign="middle"><em>[ber_bin, optimize, der]</em></cell> - <cell align="left" valign="middle">no</cell> - </row> - <row> - <cell align="left" valign="middle"><em>[ber_bin, optimize, nif, der]</em></cell> - <cell align="left" valign="middle">yes</cell> - </row> - - - <tcaption>When the ASN1 nif is used.</tcaption> - </table> - - </section> - <section> <title>Run-time Functions</title> <p>A brief description of the major functions is given here. For a complete description of each function see @@ -719,9 +419,9 @@ asn1rt:decode('H323-MESSAGES','SomeChoiceType',Bytes). </pre> 'H323-MESSAGES':encode('SomeChoiceType',{call,"octetstring"}). 'H323-MESSAGES':decode('SomeChoiceType',Bytes). </pre> <p>The asn1 nif is enabled in two occasions: encoding of - asn1 values when the asn1 spec is compiled with <c>per_bin</c> and - <c>optimize</c> or decode of encoded asn1 values when the asn1 spec is - compiled with <c>ber_bin</c>, <c>optimize</c> and <c>nif</c>. In + asn1 values when the asn1 spec is compiled with <c>per</c> and + or decode of encoded asn1 values when the asn1 spec is + compiled with <c>ber</c>. In those cases the nif will be loaded automatically at the first call to <c>encode</c>/<c>decode</c>. If one doesn't want the performance overhead of the nif being loaded at the first call it is possible @@ -868,26 +568,6 @@ Operational ::= BOOLEAN --ASN.1 definition </pre> <pre> Val = true, {ok,Bytes}=asn1rt:encode(MyModule,'Operational',Val), </pre> - <p>For historical reasons it is also possible to assign ASN.1 values - in Erlang using a tuple notation - with type and value as this</p> - <pre> -Val = {'Operational',true} </pre> - <warning> - <marker id="warning"></marker> - <p>The tuple notation, <c>{Typename, Value}</c> is only kept - because of backward compatibility and may be withdrawn in a - future release. If the notation is used the <c>Typename</c> - element must be spelled correctly, otherwise a run-time error - will occur. - </p> - <p>If the ASN.1 module is compiled with the flags - <c>per_bin</c> or <c>ber_bin</c> and <c>optimize</c> it is not - allowed to use the tuple notation. That possibility has been - removed due to performance reasons. Neither is it allowed to - use the <c>{ComponentName,Value}</c> notation in case of a - SEQUENCE or SET type.</p> - </warning> <p>Below follows a description of how values of each type can be represented in Erlang. </p> @@ -1149,7 +829,7 @@ TextFileVal2 = [88,76,55,44,99,121 .......... a lot of characters here ....] The following example shows how it works:</p> <p>In a file <c>PrimStrings.asn1</c> the type <c>BMP</c> is defined as <br></br> -<c>BMP ::= BMPString</c> then using BER encoding (<c>ber_bin</c> +<c>BMP ::= BMPString</c> then using BER encoding (<c>ber</c> option)the input/output format will be:</p> <pre> 1> <input>{ok,Bytes1} = asn1rt:encode('PrimStrings','BMP',[{0,0,53,53},{0,0,45,56}]).</input> @@ -1174,9 +854,9 @@ TextFileVal2 = [88,76,55,44,99,121 .......... a lot of characters here ....] <c>utf8_list_to_binary</c>, are in the <c>asn1rt</c> module. In the example below we assume an asn1 definition <c>UTF ::= UTF8String</c> in a module <c>UTF.asn</c>:</p> <pre> -1> <input>asn1ct:compile('UTF',[ber_bin]).</input> +1> <input>asn1ct:compile('UTF',[ber]).</input> Erlang ASN.1 version "1.4.3.3" compiling "UTF.asn" -Compiler Options: [ber_bin] +Compiler Options: [ber] --{generated,"UTF.asn1db"}-- --{generated,"UTF.erl"}-- ok @@ -1287,14 +967,6 @@ Pdu ::= SEQUENCE { <p>Values can be assigned in Erlang as shown below:</p> <pre> MyPdu = #'Pdu'{a=22,b=77.99,c={0,1,2,3,4},d='NULL'}. </pre> -<note> - <p> - In very early versions of the asn1 compiler it was also possible to - specify the values of the components in - a SEQUENCE or a SET as a list of tuples <c>{ComponentName,Value}</c>. - This is no longer supported. - </p> -</note> <p>The decode functions will return a record as result when decoding a <c>SEQUENCE</c> or a <c>SET</c>. <marker id="DEFAULT"></marker> @@ -1739,12 +1411,9 @@ SS ::= SET { 1> <input>Val = 'Values':tt().</input> {'TT',77,["kalle","kula"]} 2> <input>{ok,Bytes} = 'Values':encode('TT',Val).</input> -{ok,["0", - [18], - [[[128],[1],"M"],["\\241","\\r",[[[4],[5],"kalle"],[[4],[4],"kula"]]]]]} -3> <input>FlatBytes = lists:flatten(Bytes).</input> -[48,18,128,1,77,161,13,4,5,107,97,108,108,101,4,4,107,117,108,97] -4> <input>'Values':decode('TT',FlatBytes).</input> +{ok,<<48,18,128,1,77,161,13,4,5,107,97,108,108,101,4,4, + 107,117,108,97>>} +4> <input>'Values':decode('TT',Bytes).</input> {ok,{'TT',77,["kalle","kula"]}} 5> </pre> diff --git a/lib/asn1/doc/src/asn1ct.xml b/lib/asn1/doc/src/asn1ct.xml index 3be58cbc8e..9a9bb7ec1b 100644 --- a/lib/asn1/doc/src/asn1ct.xml +++ b/lib/asn1/doc/src/asn1ct.xml @@ -41,6 +41,19 @@ encode/decode functions. There are also some generic functions which can be used in during development of applications which handles ASN.1 data (encoded as BER or PER).</p> + <note> + <p>In R16, the options have been simplified. The back-end is chosen + using one of the options <c>ber</c>, <c>per</c>, or <c>uper</c>. + The options <c>optimize</c>, <c>nif</c>, and <c>driver</c> options + are no longer necessary (and the ASN.1 compiler will print a + warning if they are used). The options <c>ber_bin</c>, <c>per_bin</c>, + and <c>uper_bin</c> options will still work, but will print a warning. + </p> + <p>Another change in R16 is that the generated <c>encode/2</c> + function (and <c>asn1rt:encode/3</c>) always returns a binary. + The <c>encode/2</c> function for the BER back-end used to return + an iolist.</p> + </note> </description> <funcs> <func> @@ -50,9 +63,9 @@ <type> <v>Asn1module = atom() | string()</v> <v>Options = [Option| OldOption]</v> - <v>Option = ber_bin | per_bin | uper_bin | der | compact_bit_string | - noobj | {n2n, EnumTypeName} |{outdir, Dir} | {i, IncludeDir} | optimize | - nif | asn1config | undec_rest | {inline, OutputName} | inline | + <v>Option = ber | per | uper | der | compact_bit_string | + noobj | {n2n, EnumTypeName} |{outdir, Dir} | {i, IncludeDir} | + asn1config | undec_rest | {inline, OutputName} | inline | {macro_name_prefix, Prefix} | {record_name_prefix, Prefix} | verbose | warnings_as_errors</v> <v>OldOption = ber | per</v> <v>Reason = term()</v> @@ -112,7 +125,7 @@ File3.asn </pre> section in users guide</seealso>. Available options are: </p> <taglist> - <tag><c>ber | ber_bin | per | per_bin | uper_bin</c></tag> + <tag><c>ber | per | uper</c></tag> <item> <p> The encoding rule to be used. The supported encoding rules @@ -120,23 +133,12 @@ File3.asn </pre> PER aligned (Packed Encoding Rules) and PER unaligned. If the encoding rule option is omitted <c>ber</c> is the default. - The <c>per_bin</c> option means the aligned - variant. To use the unaligned variant the <c>uper_bin</c> - option has to be used. </p> <p> The generated Erlang module always gets the same name as the ASN.1 module and as a consequence of this only one encoding rule per ASN.1 module can be used at runtime. </p> - <p> - The <c>ber_bin</c> and <c>per_bin</c> options are - equivalent with the <c>OldOptions</c> <c>ber</c> and <c>per</c> - with the difference that the generated encoding/decoding - functions take advantage of the bit syntax, which in most - cases increases the performance considerably. The result - from encoding is a binary or an iolist. - </p> </item> <tag><c>der</c></tag> <item> @@ -144,7 +146,7 @@ File3.asn </pre> By this option the Distinguished Encoding Rules (DER) is chosen. DER is regarded as a specialized variant of the BER encoding rule, therefore the <c>der</c> option only makes sense together - with the <c>ber</c> or <c>ber_bin</c> option. + with the <c>ber</c> option. This option sometimes adds sorting and value checks when encoding, which implies a slower encoding. The decoding routines are the same @@ -206,28 +208,6 @@ Binary = binary() shall be placed. If omitted the files are placed in the current directory.</p> </item> - <tag><c>optimize</c></tag> - <item> - <p>This option is only valid together with one of the - <c>per_bin</c> - or <c>ber_bin</c> option. It gives time optimized code - generated and it uses another runtime module and - in the <c>per_bin</c> case a nif. The result - in the <c>per_bin</c> case from an encode when compiled - with this option will be a binary.</p> - </item> - <tag><c>driver</c></tag> - <item> - <p>As of R15B this means the same as the <c>nif</c> option. Kept for - backwards compatability reasons.</p> - </item> - <tag><c>nif</c></tag> - <item> - <p>Option valid together with <c>ber_bin</c> and <c>optimize</c> - options. It enables the use of several nifs that gives faster - encode and decode. Nifs are only enabled by the explicit use of - the option <c>nif</c></p> - </item> <tag><c>asn1config</c></tag> <item> <p>When one of the specialized decodes, exclusive or @@ -270,10 +250,6 @@ Binary = binary() <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> - <p>When used together with <c>nif</c> for <c>ber_bin</c>, the - asn1 nifs will be used if the <c>asn1rt_nif</c> module is - available. If it is not available, a slower erlang fallback - will be used.</p> </item> <tag><c>inline</c></tag> <item> @@ -327,13 +303,12 @@ Binary = binary() <type> <v>Module = Type = atom()</v> <v>Value = term()</v> - <v>Bytes = [Int] when integer(Int), Int >= 0, Int =< 255</v> + <v>Bytes = binary()</v> <v>Reason = term()</v> </type> <desc> <p>Encodes <c>Value</c> of <c>Type</c> defined in the ASN.1 module - <c>Module</c>. Returns a list of bytes if successful. To get as fast execution as - possible the + <c>Module</c>. To get as fast execution as possible the encode function only performs rudimentary tests that the input <c>Value</c> is a correct instance of <c>Type</c>. The length of strings is for example @@ -348,10 +323,10 @@ Binary = binary() <type> <v>Module = Type = atom()</v> <v>Value = Reason = term()</v> - <v>Bytes = [Int] when integer(Int), Int >= 0, Int =< 255</v> + <v>Bytes = binary()</v> </type> <desc> - <p>Decodes <c>Type</c> from <c>Module</c> from the list of bytes + <p>Decodes <c>Type</c> from <c>Module</c> from the binary <c>Bytes</c>. Returns <c>{ok, Value}</c> if successful.</p> </desc> </func> diff --git a/lib/asn1/doc/src/asn1rt.xml b/lib/asn1/doc/src/asn1rt.xml index 0c3c257189..f2cac0c9e7 100644 --- a/lib/asn1/doc/src/asn1rt.xml +++ b/lib/asn1/doc/src/asn1rt.xml @@ -47,35 +47,34 @@ <type> <v>Module = Type = atom()</v> <v>Value = Reason = term()</v> - <v>Bytes = binary | [Int] when integer(Int), Int >= 0, Int =< 255 | binary</v> + <v>Bytes = binary</v> </type> <desc> - <p>Decodes <c>Type</c> from <c>Module</c> from the list of bytes or - binary <c>Bytes</c>. If the module is compiled with <c>ber_bin</c> - or <c>per_bin</c> option <c>Bytes</c> must be a binary. + <p>Decodes <c>Type</c> from <c>Module</c> from the binary <c>Bytes</c>. Returns <c>{ok,Value}</c> if successful.</p> </desc> </func> <func> - <name>encode(Module,Type,Value)-> {ok,BinOrList} | {error,Reason}</name> + <name>encode(Module,Type,Value)-> {ok,Bytes} | {error,Reason}</name> <fsummary>Encode an ASN.1 value.</fsummary> <type> <v>Module = Type = atom()</v> <v>Value = term()</v> - <v>BinOrList = Bytes | binary()</v> - <v>Bytes = [Int|binary|Bytes] when integer(Int), Int >= 0, Int =< 255</v> + <v>Bytes = binary</v> <v>Reason = term()</v> </type> <desc> <p>Encodes <c>Value</c> of <c>Type</c> defined in the ASN.1 module <c>Module</c>. Returns a possibly nested list of bytes and or binaries - if successful. If <c>Module</c> was compiled with the options <c>per_bin</c> and <c>optimize</c> the result is a binary. To get as - fast execution as possible the + if successful. To get as fast execution as possible the encode function only performs rudimentary tests that the input <c>Value</c> is a correct instance of <c>Type</c>. The length of strings is for example not always checked. </p> + <note> + <p>Starting in R16, <c>Bytes</c> is always a binary.</p> + </note> </desc> </func> @@ -95,28 +94,6 @@ </func> <func> - <name>load_driver() -> ok | {error,Reason}</name> - <fsummary>Loads the linked-in driver. (deprecated)</fsummary> - <type> - <v>Reason = term()</v> - </type> - <desc> - <p>This function is obsolete and will be removed in R16A</p> - </desc> - </func> - - <func> - <name>unload_driver() -> ok | {error,Reason}</name> - <fsummary>Unloads the linked-in driver. (deprecated)</fsummary> - <type> - <v>Reason = term()</v> - </type> - <desc> - <p>This function is obsolete and will be removed in R16A</p> - </desc> - </func> - - <func> <name>utf8_binary_to_list(UTF8Binary) -> {ok,UnicodeList} | {error,Reason}</name> <fsummary>Transforms an utf8 encoded binary to a unicode list.</fsummary> <type> diff --git a/lib/asn1/doc/src/notes.xml b/lib/asn1/doc/src/notes.xml index 5ca86130a1..72b496caf7 100644 --- a/lib/asn1/doc/src/notes.xml +++ b/lib/asn1/doc/src/notes.xml @@ -483,7 +483,7 @@ ENUMERATION type, the compilation will be terminated with an error code.<br/> Below follows an example on how to use the option from the command line with <c>erlc</c>:<br/> - <c>erlc -bper_bin +optimize +driver +"{n2n,'CauseMisc'}" +"{n2n,'CausePcl'}" MyModyle.asn</c> + <c>erlc -bper+"{n2n,'CauseMisc'}" +"{n2n,'CausePcl'}" MyModyle.asn</c> </p> <p> Own Id: OTP-8136 Aux Id: seq11347 </p> diff --git a/lib/asn1/src/Makefile b/lib/asn1/src/Makefile index 4bd49aa93b..3d66583745 100644 --- a/lib/asn1/src/Makefile +++ b/lib/asn1/src/Makefile @@ -52,8 +52,6 @@ CT_MODULES= \ asn1ct_gen_per_rt2ct \ asn1ct_name \ asn1ct_constructed_per \ - asn1ct_constructed_ber \ - asn1ct_gen_ber \ asn1ct_constructed_ber_bin_v2 \ asn1ct_gen_ber_bin_v2 \ asn1ct_value \ @@ -63,7 +61,6 @@ CT_MODULES= \ RT_MODULES= \ asn1rt \ - asn1rt_per_bin \ asn1rt_ber_bin \ asn1rt_ber_bin_v2 \ asn1rt_per_bin_rt2ct \ diff --git a/lib/asn1/src/asn1.app.src b/lib/asn1/src/asn1.app.src index 09144ba2f7..64b33a8a30 100644 --- a/lib/asn1/src/asn1.app.src +++ b/lib/asn1/src/asn1.app.src @@ -3,7 +3,6 @@ {vsn, "%VSN%"}, {modules, [ asn1rt, - asn1rt_per_bin, asn1rt_per_bin_rt2ct, asn1rt_uper_bin, asn1rt_ber_bin, diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index 8e971a1c76..90882462ac 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -85,14 +85,8 @@ compile(File) -> compile(File,[]). -compile(File,Options) when is_list(Options) -> - case lists:member(driver, Options) of %% remove me in R16A! - true -> - io:format("Warning: driver option is obsolete and will be removed in R16A, use nif instead!"); - false -> - ok - end, - Options1 = optimize_ber_bin(Options), +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). @@ -852,8 +846,8 @@ generate({true,{M,_Module,GenTOrV}},OutFile,EncodingRule,Options) -> debug_off(Options), put(compact_bit_string,false), erase(encoding_options), - erase(tlv_format), % used in ber_bin, optimize - erase(class_default_type),% used in ber_bin, optimize + erase(tlv_format), % used in ber + erase(class_default_type),% used in ber asn1ct_table:delete(check_functions), case Result of {error,_} -> @@ -876,14 +870,13 @@ parse_and_save(Module,S) -> Options = S#state.options, SourceDir = S#state.sourcedir, Includes = [I || {i,I} <-Options], - Options1 = optimize_ber_bin(Options), - + case get_input_file(Module,[SourceDir|Includes]) of %% search for asn1 source {file,SuffixedASN1source} -> - case dbfile_uptodate(SuffixedASN1source,Options1) of + case dbfile_uptodate(SuffixedASN1source,Options) of false -> - parse_and_save1(S,SuffixedASN1source,Options1,Includes); + parse_and_save1(S,SuffixedASN1source,Options,Includes); _ -> ok end; Err -> @@ -1065,9 +1058,9 @@ get_file_list1(Stream,Dir,Includes,Acc) -> end. get_rule(Options) -> - case [Rule ||Rule <-[per,ber,ber_bin,ber_bin_v2,per_bin,uper_bin], - Opt <- Options, - Rule==Opt] of + case [Rule || Rule <- [ber,per,uper], + Opt <- Options, + Rule =:= Opt] of [Rule] -> Rule; [Rule|_] -> @@ -1079,19 +1072,34 @@ get_rule(Options) -> get_runtime_mod(Options) -> RtMod1= case get_rule(Options) of - per -> ["asn1rt_per_bin.erl"]; - ber -> ["asn1rt_ber_bin.erl"]; - per_bin -> - case lists:member(optimize,Options) of - true -> ["asn1rt_per_bin_rt2ct.erl"]; - _ -> ["asn1rt_per_bin.erl"] - end; - ber_bin -> ["asn1rt_ber_bin.erl"]; - ber_bin_v2 -> ["asn1rt_ber_bin_v2.erl"]; - uper_bin -> ["asn1rt_uper_bin.erl"] + 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"), + [ber|translate_options(T)]; +translate_options([per_bin|T]) -> + io:format("Warning: The option 'per_bin' is now called 'per'.\n"), + [per|translate_options(T)]; +translate_options([uper_bin|T]) -> + io:format("Warning: The option 'uper_bin' is now called 'uper'.\n"), + translate_options([uper|T]); +translate_options([nif|T]) -> + io:format("Warning: The option 'nif' is no longer needed.\n"), + translate_options(T); +translate_options([optimize|T]) -> + io:format("Warning: The option 'optimize' is no longer needed.\n"), + translate_options(T); +translate_options([H|T]) -> + [H|translate_options(T)]; +translate_options([]) -> []. erl_compile(OutFile,Options) -> % io:format("Options:~n~p~n",[Options]), @@ -1115,7 +1123,6 @@ remove_asn_flags(Options) -> X /= optimize, X /= compact_bit_string, X /= debug, - X /= keyed_list, X /= asn1config, X /= record_name_prefix]. @@ -1125,12 +1132,6 @@ debug_on(Options) -> put(asndebug,true); _ -> true - end, - case lists:member(keyed_list,Options) of - true -> - put(asn_keyed_list,true); - _ -> - true end. igorify_options(Options) -> @@ -1151,8 +1152,7 @@ generated_file(Name,Options) -> end. debug_off(_Options) -> - erase(asndebug), - erase(asn_keyed_list). + erase(asndebug). outfile(Base, Ext, Opts) -> @@ -1168,13 +1168,6 @@ outfile(Base, Ext, Opts) -> lists:concat([Obase,".",Ext]) end. -optimize_ber_bin(Options) -> - case {lists:member(optimize,Options),lists:member(ber_bin,Options)} of - {true,true} -> - [ber_bin_v2|Options--[ber_bin]]; - _ -> Options - end. - includes(File,Options) -> Options2 = include_append(".", Options), Options3 = include_append(filename:dirname(File), Options2), @@ -1284,12 +1277,7 @@ make_erl_options(Opts) -> Defines) ++ case OutputType of undefined -> [ber]; % temporary default (ber when it's ready) - ber -> [ber]; - ber_bin -> [ber_bin]; - ber_bin_v2 -> [ber_bin_v2]; - per -> [per]; - per_bin -> [per_bin]; - uper_bin -> [uper_bin] + _ -> [OutputType] % pass through end, Options++[errors, {cwd, Cwd}, {outdir, Outdir}| @@ -1400,8 +1388,7 @@ test_value(Module, Type, Value) -> in_process(fun() -> case catch encode(Module, Type, Value) of {ok, Bytes} -> - M = to_atom(Module), - NewBytes = prepare_bytes(M:encoding_rule(), Bytes), + NewBytes = prepare_bytes(Bytes), case decode(Module, Type, NewBytes) of {ok, Value} -> {ok, {Module, Type, Value}}; @@ -1452,18 +1439,8 @@ check(Module, Includes) -> end end. -to_atom(Term) when is_list(Term) -> list_to_atom(Term); -to_atom(Term) when is_atom(Term) -> Term. - -prepare_bytes(ber, Bytes) -> lists:flatten(Bytes); -prepare_bytes(ber_bin, Bytes) when is_binary(Bytes) -> Bytes; -prepare_bytes(ber_bin, Bytes) -> list_to_binary(Bytes); -prepare_bytes(ber_bin_v2, Bytes) when is_binary(Bytes) -> Bytes; -prepare_bytes(ber_bin_v2, Bytes) -> list_to_binary(Bytes); -prepare_bytes(per, Bytes) -> lists:flatten(Bytes); -prepare_bytes(per_bin, Bytes) when is_binary(Bytes) -> Bytes; -prepare_bytes(per_bin, Bytes) -> list_to_binary(Bytes); -prepare_bytes(uper_bin, Bytes) -> Bytes. +prepare_bytes(Bytes) when is_binary(Bytes) -> Bytes; +prepare_bytes(Bytes) -> list_to_binary(Bytes). vsn() -> ?vsn. @@ -1504,7 +1481,7 @@ specialized_decode_prepare(Erule,M,TsAndVs,Options) -> end. %% Reads the configuration file if it exists and stores information %% about partial decode and incomplete decode -partial_decode_prepare(ber_bin_v2,M,TsAndVs,Options) when is_tuple(TsAndVs) -> +partial_decode_prepare(ber,M,TsAndVs,Options) when is_tuple(TsAndVs) -> %% read configure file ModName = diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 59e82b7a57..fe1b2e14a8 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -61,13 +61,13 @@ -define(TAG_PRIMITIVE(Num), case S#state.erule of - ber_bin_v2 -> + ber -> #tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=0}; _ -> [] end). -define(TAG_CONSTRUCTED(Num), case S#state.erule of - ber_bin_v2 -> + ber -> #tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=32}; _ -> [] end). @@ -3262,7 +3262,7 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> inlined=IsInlined}, TestFun = fun(Tref) -> - {_,MaybeChoice} = get_referenced_type(S,Tref), + MaybeChoice = get_non_typedef(S, Tref), case catch((MaybeChoice#typedef.typespec)#type.def) of {'CHOICE',_} -> maybe_illicit_implicit_tag(choice,Tag); @@ -3347,7 +3347,7 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> TempNewDef#newt{ type = check_externaltypereference(S,NewExt), tag = case S#state.erule of - ber_bin_v2 -> + ber -> merge_tags(Ct,RefType#type.tag); _ -> Ct @@ -3617,6 +3617,14 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> check_type(_S,Type,Ts) -> exit({error,{asn1,internal_error,Type,Ts}}). +get_non_typedef(S, Tref0) -> + case get_referenced_type(S, Tref0) of + {_,#typedef{typespec=#type{def=#'Externaltypereference'{}=Tref}}} -> + get_non_typedef(S, Tref); + {_,Type} -> + Type + end. + %% tablecinf_choose. A SEQUENCE or SET may be inserted in another %% SEQUENCE or SET by the COMPONENTS OF directive. If this inserted %% type is a referenced type that already has been checked it already @@ -5289,7 +5297,7 @@ iof_associated_type(S,[]) -> AssociateSeq = iof_associated_type1(S,[]), Tag = case S#state.erule of - ber_bin_v2 -> + ber -> [?TAG_CONSTRUCTED(?N_INSTANCE_OF)]; _ -> [] end, @@ -5320,7 +5328,7 @@ iof_associated_type1(S,C) -> end, {ObjIdTag,C1TypeTag}= case S#state.erule of - ber_bin_v2 -> + ber -> {[{'UNIVERSAL',8}], [#tag{class='UNIVERSAL', number=6, @@ -5551,8 +5559,9 @@ complist_as_tuple(_Per,[],Acc,Ext,_Acc2,ext) -> complist_as_tuple(_Per,[],Acc,Ext,Acc2,root2) -> {lists:reverse(Acc),lists:reverse(Ext),lists:reverse(Acc2)}. -is_erule_per(Erule) -> - lists:member(Erule,[per,per_bin,uper_bin]). +is_erule_per(per) -> true; +is_erule_per(uper) -> true; +is_erule_per(ber) -> false. expand_components(S, [{'COMPONENTS OF',Type}|T]) -> CompList = expand_components2(S,get_referenced_type(S,Type#type.def)), @@ -5641,7 +5650,7 @@ check_set(S,Type,Components) -> {true,_} -> {Sorted,SortedComponents} = sort_components(der,S,NewComponents), {Sorted,TableCInf,SortedComponents}; - {_,PER} when PER =:= per; PER =:= per_bin; PER =:= uper_bin -> + {_,PER} when PER =:= per; PER =:= uper -> {Sorted,SortedComponents} = sort_components(per,S,NewComponents), {Sorted,TableCInf,SortedComponents}; _ -> @@ -5765,7 +5774,7 @@ sort_universal_type(Components) -> decode_type(I) when is_integer(I) -> I; decode_type(T) -> - asn1ct_gen_ber:decode_type(T). + asn1ct_gen_ber_bin_v2:decode_type(T). untagged_choice(_S,[#'ComponentType'{typespec=#type{tag=[],def={'CHOICE',_}}}|_Rest]) -> true; @@ -6884,16 +6893,16 @@ get_taglist(S,{ObjCl,FieldNameList}) when is_record(ObjCl,objectclass), {TypeFieldName,_} when is_atom(TypeFieldName) -> []%should check if allowed end; get_taglist(S,Def) -> - case lists:member(S#state.erule,[ber_bin_v2]) of - false -> + case S#state.erule of + ber -> + []; + _ -> case Def of 'ASN1_OPEN_TYPE' -> % open_type has no UNIVERSAL tag as such []; _ -> [asn1ct_gen:def_to_tag(Def)] - end; - _ -> - [] + end end. get_taglist1(S,[#'ComponentType'{name=_Cname,tags=TagL}|Rest]) when is_list(TagL) -> diff --git a/lib/asn1/src/asn1ct_constructed_ber.erl b/lib/asn1/src/asn1ct_constructed_ber.erl deleted file mode 100644 index 360de77663..0000000000 --- a/lib/asn1/src/asn1ct_constructed_ber.erl +++ /dev/null @@ -1,1596 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-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(asn1ct_constructed_ber). - --export([gen_encode_sequence/3]). --export([gen_decode_sequence/3]). --export([gen_encode_set/3]). --export([gen_decode_set/3]). --export([gen_encode_sof/4]). --export([gen_decode_sof/4]). --export([gen_encode_choice/3]). --export([gen_decode_choice/3]). - -%%%% Application internal exports --export([match_tag/2]). - --include("asn1_records.hrl"). - --import(asn1ct_gen, [emit/1,demit/1,get_record_name_prefix/0]). - -% 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). - - - - -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== -%% Encode/decode SEQUENCE -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== - -gen_encode_sequence(Erules,Typename,D) when is_record(D,type) -> - asn1ct_name:start(), - asn1ct_name:new(term), - asn1ct_name:new(bytes), - - %% if EXTERNAL type the input value must be transformed to - %% ASN1 1990 format - case Typename of - ['EXTERNAL'] -> - emit([" NewVal = asn1rt_check:transform_to_EXTERNAL1990(Val),", - nl]); - _ -> - ok - end, - - {SeqOrSet,TableConsInfo,CompList0} = - case D#type.def of - #'SEQUENCE'{tablecinf=TCI,components=CL} -> - {'SEQUENCE',TCI,CL}; - #'SET'{tablecinf=TCI,components=CL} -> - {'SET',TCI,CL} - end, - %% filter away extensionAdditiongroup markers - CompList = filter_complist(CompList0), - Ext = extensible(CompList), - CompList1 = case CompList of - {Rl1,El,Rl2} -> Rl1 ++ El ++ Rl2; - {Rl,El} -> Rl ++ El; - _ -> CompList - end, - EncObj = - case TableConsInfo of - #simpletableattributes{usedclassfield=Used, - uniqueclassfield=Unique} when Used /= Unique -> - false; - %% ObjectSetRef, name of the object set in constraints - %% - %%{ObjectSetRef,AttrN,N,UniqueFieldName} - #simpletableattributes{objectsetname=ObjectSetRef, - c_name=AttrN, - c_index=N, - usedclassfield=UniqueFieldName, - uniqueclassfield=UniqueFieldName, - valueindex=ValueIndex - } -> - OSDef = - case ObjectSetRef of - {Module,OSName} -> - asn1_db:dbget(Module,OSName); - OSName -> - asn1_db:dbget(get(currmod),OSName) - end, -% io:format("currmod: ~p~nOSName: ~p~nAttrN: ~p~nN: ~p~nUniqueFieldName: ~p~n", -% [get(currmod),OSName,AttrN,N,UniqueFieldName]), - case (OSDef#typedef.typespec)#'ObjectSet'.gen of - true -> -% Val = lists:concat(["?RT_BER:cindex(", -% N+1,",Val,"]), - ObjectEncode = - asn1ct_gen:un_hyphen_var(lists:concat(['Obj', - AttrN])), - emit({ObjectEncode," = ",nl}), - {ObjSetMod,ObjSetName} = - case ObjectSetRef of - {M,O} -> - {{asis,M},O}; - O -> - {"?MODULE",O} - end, - emit({" ",ObjSetMod,":'getenc_",ObjSetName,"'(",{asis,UniqueFieldName}, - ", ",nl}), -% emit({indent(35),"?RT_BER:cindex(",N+1,", Val,", -% {asis,AttrN},")),",nl}), - Length = fun(X,_LFun) when is_atom(X) -> - length(atom_to_list(X)); - (X,_LFun) when is_list(X) -> - length(X); - ({X1,X2},LFun) -> - LFun(X1,LFun) + LFun(X2,LFun) - end, - emit([indent(10+Length(ObjectSetRef,Length)), - "value_match(",{asis,ValueIndex},",", - "?RT_BER:cindex(",N+1,",Val,", - {asis,AttrN},"))),",nl]), - notice_value_match(), - {AttrN,ObjectEncode}; - _ -> - false - end; - _ -> - case D#type.tablecinf of - [{objfun,_}|_] -> - %% when the simpletableattributes was at an - %% outer level and the objfun has been passed - %% through the function call - {"got objfun through args","ObjFun"}; - _ -> - false - end - end, - - gen_enc_sequence_call(Erules,Typename,CompList1,1,Ext,EncObj), - - MyTag = [X#tag{class=asn1ct_gen_ber:decode_class(X#tag.class)}|| X <- D#type.tag] - ++ - [#tag{class = asn1ct_gen_ber:decode_class('UNIVERSAL'), - number = asn1ct_gen_ber:decode_type(SeqOrSet), - form = ?CONSTRUCTED, - type = 'IMPLICIT'}], - emit([nl," BytesSoFar = "]), - case SeqOrSet of - 'SET' when (D#type.def)#'SET'.sorted == dynamic -> - emit("asn1rt_check:dynamicsort_SET_components(["), - mkvlist(asn1ct_name:all(encBytes)), - emit(["]),",nl]); - _ -> - emit("["), - mkvlist(asn1ct_name:all(encBytes)), - emit(["],",nl]) - end, - emit(" LenSoFar = "), - case asn1ct_name:all(encLen) of - [] -> emit("0"); - AllLengths -> - mkvplus(AllLengths) - end, - emit([",",nl]), -% emit(["{TagBytes,Len} = ?RT_BER:encode_tags(TagIn ++ ", - emit([" ?RT_BER:encode_tags(TagIn ++ ", - {asis,MyTag},", BytesSoFar, LenSoFar).",nl]). - - -gen_decode_sequence(Erules,Typename,D) when is_record(D,type) -> - asn1ct_name:start(), - asn1ct_name:new(tag), - #'SEQUENCE'{tablecinf=TableConsInfo,components=CList0} = D#type.def, - - %% filter away extensionAdditiongroup markers - CList = filter_complist(CList0), - - Ext = extensible(CList), - {CompList,CompList2} = case CList of - {Rl1,El,Rl2} -> {Rl1 ++ El ++ Rl2,CList}; - {Rl,El} -> {Rl ++ El, Rl ++ El}; - _ -> {CList,CList} - end, - - emit([" %%-------------------------------------------------",nl]), - emit([" %% decode tag and length ",nl]), - emit([" %%-------------------------------------------------",nl]), - - asn1ct_name:new(rb), - MyTag = [X#tag{class=asn1ct_gen_ber:decode_class(X#tag.class)}|| X <- D#type.tag] - ++ - [#tag{class = asn1ct_gen_ber:decode_class('UNIVERSAL'), - number = asn1ct_gen_ber:decode_type('SEQUENCE'), - form = ?CONSTRUCTED, - type = 'IMPLICIT'}], - emit([" {{_,",asn1ct_gen_ber:unused_var("Len",D#type.def),"},",{next,bytes},",",{curr,rb}, - "} = ?RT_BER:check_tags(TagIn ++ ",{asis,MyTag},", ", - {curr,bytes},", OptOrMand), ",nl]), - asn1ct_name:new(bytes), - asn1ct_name:new(len), - - case CompList of - [] -> true; - _ -> - emit({"{",{next,bytes}, - ",RemBytes} = ?RT_BER:split_list(", - {curr,bytes}, - ",", {prev,len},"),",nl}), - asn1ct_name:new(bytes) - end, - - {DecObjInf,UniqueFName,ValueIndex} = - case TableConsInfo of - #simpletableattributes{objectsetname=ObjectSet, - c_name=AttrN, - usedclassfield=UniqueFieldName, - uniqueclassfield=UniqueFieldName, - valueindex=ValIndex - } -> - F = fun(#'ComponentType'{typespec=CT})-> - case {asn1ct_gen:get_constraint(CT#type.constraint,componentrelation),CT#type.tablecinf} of -% case {CT#type.constraint,CT#type.tablecinf} of - {no,[{objfun,_}|_R]} -> true; - _ -> false - end - end, - case lists:any(F,CompList) of - %%AttributeName = asn1ct_gen:un_hyphen_var(AttrN), - true -> % when component relation constraint establish - %% relation from a component to another components - %% subtype component - {{AttrN,{deep,ObjectSet,UniqueFieldName, - ValIndex}}, - UniqueFieldName,ValIndex}; - false -> - {{AttrN,ObjectSet},UniqueFieldName,ValIndex} - end; - _ -> - {false,false,false} - end, - RecordName = lists:concat([get_record_name_prefix(),asn1ct_gen:list2rname(Typename)]), - case gen_dec_sequence_call(Erules,Typename,CompList2,Ext,DecObjInf) of - no_terms -> % an empty sequence - emit([nl,nl]), - demit({"Result = "}), %dbg - %% return value as record - asn1ct_name:new(rb), - emit([" {{'",RecordName,"'}, ",{curr,bytes},",",nl," "]), - asn1ct_gen_ber:add_removed_bytes(), - emit(["}.",nl]); - {LeadingAttrTerm,PostponedDecArgs} -> - emit([com,nl,nl]), - case {LeadingAttrTerm,PostponedDecArgs} of - {[],[]} -> - ok; - {_,[]} -> - ok; - {[{ObjSet,LeadingAttr,Term}],PostponedDecArgs} -> - DecObj = asn1ct_gen:un_hyphen_var(lists:concat(['DecObj',LeadingAttr,Term])), - ValueMatch = value_match(ValueIndex,Term), - {ObjSetMod,ObjSetName} = - case ObjSet of - {M,O} -> - {{asis,M},O}; - _ -> - {"?MODULE",ObjSet} - end, - emit([DecObj," =",nl," ",ObjSetMod,":'getdec_",ObjSetName,"'(", -% {asis,UniqueFName},", ",Term,"),",nl}), - {asis,UniqueFName},", ",ValueMatch,"),",nl]), - gen_dec_postponed_decs(DecObj,PostponedDecArgs) - end, - demit({"Result = "}), %dbg - %% return value as record - asn1ct_name:new(rb), - asn1ct_name:new(bytes), - ExtStatus = case Ext of - {ext,_,_} -> ext; - _ -> noext % noext | extensible - end, - emit([" {",{next,bytes},",",{curr,rb},"} = ?RT_BER:restbytes2(RemBytes, ", - {curr,bytes},",",ExtStatus,"),",nl]), - asn1ct_name:new(rb), - case Typename of - ['EXTERNAL'] -> - emit([" OldFormat={'",RecordName, - "', "]), - mkvlist(asn1ct_name:all(term)), - emit(["},",nl]), - emit([" ASN11994Format =",nl, - " asn1rt_check:transform_to_EXTERNAL1994", - "(OldFormat),",nl]), - emit([" {ASN11994Format,",{next,bytes},", "]); - _ -> - emit([" {{'",RecordName,"', "]), - mkvlist(asn1ct_name:all(term)), - emit(["}, ",{next,bytes},", "]) - end, - asn1ct_gen_ber:add_removed_bytes(), - emit(["}.",nl]) - end. - -gen_dec_postponed_decs(_,[]) -> - emit(nl); -gen_dec_postponed_decs(DecObj,[{_Cname,{FirstPFN,PFNList},Term,TmpTerm,_Tag,OptOrMand}|Rest]) -> -% asn1ct_name:new(term), - asn1ct_name:new(tmpterm), - asn1ct_name:new(reason), - - emit({"{",Term,", _, _} = ",nl}), - N = case OptOrMand of - mandatory -> 0; - 'OPTIONAL' -> - emit_opt_or_mand_check(asn1_NOVALUE,TmpTerm), - 6; - {'DEFAULT',Val} -> - emit_opt_or_mand_check(Val,TmpTerm), - 6 - end, - emit({indent(N+3),"case (catch ",DecObj,"(",{asis,FirstPFN}, -% ", ",TmpTerm,", ", {asis,Tag},", ",{asis,PFNList},")) of",nl}), - ", ",TmpTerm,", [], ",{asis,PFNList},")) of",nl}), - emit({indent(N+6),"{'EXIT', ",{curr,reason},"} ->",nl}), - emit({indent(N+9),"exit({'Type not compatible with table constraint',", - {curr,reason},"});",nl}), - emit({indent(N+6),{curr,tmpterm}," ->",nl}), - emit({indent(N+9),{curr,tmpterm},nl}), - - case OptOrMand of - mandatory -> emit([indent(N+3),"end,",nl]); - _ -> - emit([indent(N+3),"end",nl, - indent(3),"end,",nl]) - end, -% emit({indent(3),"end,",nl}), - gen_dec_postponed_decs(DecObj,Rest). - - -emit_opt_or_mand_check(Value,TmpTerm) -> - emit([indent(3),"case ",TmpTerm," of",nl, - indent(6),{asis,Value}," -> {",{asis,Value},",[],[]};",nl, - indent(6),"_ ->",nl]). - -%%============================================================================ -%% Encode/decode SET -%% -%%============================================================================ - -gen_encode_set(Erules,Typename,D) when is_record(D,type) -> - gen_encode_sequence(Erules,Typename,D). - -gen_decode_set(Erules,Typename,D) when is_record(D,type) -> - asn1ct_name:start(), - asn1ct_name:clear(), - asn1ct_name:new(term), - asn1ct_name:new(tag), - #'SET'{components=TCompList0} = D#type.def, - - %% filter away extensionAdditiongroup markers - TCompList = filter_complist(TCompList0), - Ext = extensible(TCompList), - ToOptional = fun(mandatory) -> - 'OPTIONAL'; - (X) -> X - end, - CompList = case TCompList of - {Rl1,El,Rl2} -> - Rl1 ++ [X#'ComponentType'{prop=ToOptional(Y)}||X = #'ComponentType'{prop=Y}<-El] ++ Rl2; - {Rl,El} -> Rl ++ El; - _ -> TCompList - end, - - emit([" %%-------------------------------------------------",nl]), - emit([" %% decode tag and length ",nl]), - emit([" %%-------------------------------------------------",nl]), - - asn1ct_name:new(rb), - MyTag = [X#tag{class=asn1ct_gen_ber:decode_class(X#tag.class)}|| X <- D#type.tag] - ++ - [#tag{class = asn1ct_gen_ber:decode_class('UNIVERSAL'), - number = asn1ct_gen_ber:decode_type('SET'), - form = ?CONSTRUCTED, - type = 'IMPLICIT'}], - emit([" {{_,Len},",{next,bytes},",",{curr,rb}, - "} = ?RT_BER:check_tags(TagIn ++ ",{asis,MyTag},", ", - {curr,bytes},", OptOrMand), ",nl]), - asn1ct_name:new(bytes), - asn1ct_name:new(len), - asn1ct_name:new(rb), - - emit([" {SetTerm, SetBytes, ",{curr,rb},"} = ?RT_BER:decode_set(0, Len, ", - {curr,bytes},", OptOrMand, ", - "fun 'dec_",asn1ct_gen:list2name(Typename),"_fun'/2, []),",nl]), - - asn1ct_name:new(rb), - {ExtFlatten1,ExtFlatten2} = - case Ext of - noext -> {"",""}; - _ -> {"lists:flatten(",")"} - end, - emit([" 'dec_",asn1ct_gen:list2name(Typename), - "__result__'(lists:sort(",ExtFlatten1,"SetTerm",ExtFlatten2,"), SetBytes, "]), - asn1ct_gen_ber:add_removed_bytes(), - emit([").",nl,nl,nl]), - - emit({"%%-------------------------------------------------",nl}), - emit({"%% Set loop fun for ",asn1ct_gen:list2name(Typename),nl}), - emit({"%%-------------------------------------------------",nl}), - - asn1ct_name:clear(), - asn1ct_name:new(term), - emit(["'dec_",asn1ct_gen:list2name(Typename),"_fun'(",{curr,bytes}, - ", OptOrMand) ->",nl]), - - asn1ct_name:new(bytes), - gen_dec_set(Erules,Typename,CompList,1,Ext), - - emit([" %% tag not found, if extensionmark we should skip bytes here",nl]), - emit([indent(6),"_ -> ",nl]), - case Ext of - noext -> - emit([indent(9),"{[], Bytes,0}",nl]); - _ -> - asn1ct_name:new(rbCho), - emit([indent(9),"{RestBytes, ",{curr,rbCho}, - "} = ?RT_BER:skipvalue(Bytes),",nl, - indent(9),"{[], RestBytes, ",{curr,rbCho},"}",nl]) - end, - emit([indent(3),"end.",nl,nl,nl]), - - - emit({"%%-------------------------------------------------",nl}), - emit({"%% Result ",asn1ct_gen:list2name(Typename),nl}), - emit({"%%-------------------------------------------------",nl}), - - asn1ct_name:clear(), - emit({"'dec_",asn1ct_gen:list2name(Typename),"__result__'(", - asn1ct_gen_ber:unused_var("TermList",D#type.def),", Bytes, Rb) ->",nl}), - RecordName = lists:concat([get_record_name_prefix(), - asn1ct_gen:list2rname(Typename)]), - case gen_dec_set_result(Erules,Typename,CompList) of - no_terms -> - %% return value as record - asn1ct_name:new(rb), - emit({" {{'",RecordName,"'}, Bytes, Rb}.",nl}); - _ -> - emit({nl," case ",{curr,termList}," of",nl}), - emit({" [] -> {{'",RecordName,"', "}), - mkvlist(asn1ct_name:all(term)), - emit({"}, Bytes, Rb};",nl}), - emit({" ExtraAtt -> exit({error,{asn1,{too_many_attributes, ExtraAtt}}})",nl}), - emit({" end.",nl}), - emit({nl,nl,nl}) - end. - - -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== -%% Encode/decode SEQUENCE OF and SET OF -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== - -gen_encode_sof(Erules,Typename,_InnerTypename,D) when is_record(D,type) -> - asn1ct_name:start(), - {SeqOrSetOf, Cont} = D#type.def, - - Objfun = case D#type.tablecinf of - [{objfun,_}|_R] -> - ", ObjFun"; - _ -> - "" - end, - - emit({" {EncBytes,EncLen} = 'enc_",asn1ct_gen:list2name(Typename), - "_components'(Val",Objfun,",[],0),",nl}), - - MyTag = [X#tag{class=asn1ct_gen_ber:decode_class(X#tag.class)}|| X <- D#type.tag] - ++ - [#tag{class = asn1ct_gen_ber:decode_class('UNIVERSAL'), - number = asn1ct_gen_ber:decode_type(SeqOrSetOf), - form = ?CONSTRUCTED, - type = 'IMPLICIT'}], -% gen_encode_tags(Erules,MyTag,"EncLen","EncBytes"), - emit([" ?RT_BER:encode_tags(TagIn ++ ", - {asis,MyTag},", EncBytes, EncLen).",nl,nl]), - - gen_encode_sof_components(Erules,Typename,SeqOrSetOf,Cont). -% gen_enc_line(Erules,Typename,TypeNameSuffix,Cont,"H",0, -% mandatory,"{EncBytes,EncLen} = "), - - -gen_decode_sof(Erules,Typename,_InnerTypename,D) when is_record(D,type) -> - asn1ct_name:start(), - asn1ct_name:clear(), - {SeqOrSetOf, TypeTag, Cont} = - case D#type.def of - {'SET OF',_Cont} -> {'SET OF','SET',_Cont}; - {'SEQUENCE OF',_Cont} -> {'SEQUENCE OF','SEQUENCE',_Cont} - end, - TypeNameSuffix = asn1ct_gen:constructed_suffix(SeqOrSetOf,Cont#type.def), - - emit({" %%-------------------------------------------------",nl}), - emit({" %% decode tag and length ",nl}), - emit({" %%-------------------------------------------------",nl}), - - asn1ct_name:new(rb), - MyTag = [X#tag{class=asn1ct_gen_ber:decode_class(X#tag.class)}|| X <- D#type.tag] - ++ - [#tag{class = asn1ct_gen_ber:decode_class('UNIVERSAL'), - number = asn1ct_gen_ber:decode_type(TypeTag), - form = ?CONSTRUCTED, - type = 'IMPLICIT'}], - emit([" {{_,Len},",{next,bytes},",",{curr,rb}, - "} = ?RT_BER:check_tags(TagIn ++ ",{asis,MyTag},", ", - {curr,bytes},", OptOrMand), ",nl]), - - emit([" ?RT_BER:decode_components(",{curr,rb}]), - InnerType = asn1ct_gen:get_inner(Cont#type.def), - ContName = case asn1ct_gen:type(InnerType) of - Atom when is_atom(Atom) -> Atom; - _ -> TypeNameSuffix - end, - emit([", Len, ",{next,bytes},", "]), -% NewCont = -% case Cont#type.def of -% {'ENUMERATED',_,Components}-> -% Cont#type{def={'ENUMERATED',Components}}; -% _ -> Cont -% end, - ObjFun = - case D#type.tablecinf of - [{objfun,_}|_R] -> - ", ObjFun"; - _ -> - [] - end, - gen_dec_line_sof(Erules,Typename,ContName,Cont,ObjFun), - emit([", []).",nl,nl,nl]). - - -gen_encode_sof_components(Erules,Typename,SeqOrSetOf,Cont) - when is_record(Cont,type)-> - - {Objfun,ObjFun_novar,EncObj} = - case Cont#type.tablecinf of - [{objfun,_}|_R] -> - {", ObjFun",", _",{no_attr,"ObjFun"}}; - _ -> - {"","",false} - end, - emit(["'enc_",asn1ct_gen:list2name(Typename), - "_components'([]",ObjFun_novar,", AccBytes, AccLen) -> ",nl]), - - case catch lists:member(der,get(encoding_options)) of - true when SeqOrSetOf=='SET OF' -> - emit([indent(3), - "{asn1rt_check:dynamicsort_SETOF(AccBytes),AccLen};",nl,nl]); - _ -> - emit([indent(3),"{lists:reverse(AccBytes),AccLen};",nl,nl]) - end, - emit(["'enc_",asn1ct_gen:list2name(Typename), - "_components'([H|T]",Objfun,",AccBytes, AccLen) ->",nl]), - TypeNameSuffix = asn1ct_gen:constructed_suffix(SeqOrSetOf,Cont#type.def), - gen_enc_line(Erules,Typename,TypeNameSuffix,Cont,"H",3, -% mandatory,"{EncBytes,EncLen} = ",EncObj), - mandatory,EncObj), - emit([",",nl]), - emit([indent(3),"'enc_",asn1ct_gen:list2name(Typename), - "_components'(T",Objfun,","]), - emit(["[EncBytes|AccBytes], AccLen + EncLen).",nl,nl]). - -%%============================================================================ -%% Encode/decode CHOICE -%% -%%============================================================================ - -gen_encode_choice(Erules,Typename,D) when is_record(D,type) -> - ChoiceTag = D#type.tag, - {'CHOICE',CompList} = D#type.def, - Ext = extensible(CompList), - CompList1 = case CompList of - {Rl1,El,Rl2} -> Rl1 ++ El ++ Rl2; - {Rl,El} -> Rl ++ El; - _ -> CompList - end, - gen_enc_choice(Erules,Typename,ChoiceTag,CompList1,Ext), - emit({nl,nl}). - -gen_decode_choice(Erules,Typename,D) when is_record(D,type) -> - asn1ct_name:start(), - asn1ct_name:new(bytes), - ChoiceTag = D#type.tag, - {'CHOICE',CompList} = D#type.def, - Ext = extensible(CompList), - CompList1 = case CompList of - {Rl1,El,Rl2} -> Rl1 ++ El ++Rl2; - {Rl,El} -> Rl ++ El; - _ -> CompList - end, - gen_dec_choice(Erules,Typename,ChoiceTag,CompList1,Ext), - emit({".",nl}). - - -%%============================================================================ -%% Encode SEQUENCE -%% -%%============================================================================ - -gen_enc_sequence_call(Erules,TopType,[#'ComponentType'{name=Cname,typespec=Type,prop=Prop,textual_order=Order}|Rest],Pos,Ext,EncObj) -> - asn1ct_name:new(encBytes), - asn1ct_name:new(encLen), - CindexPos = - case Order of - undefined -> - Pos; - _ -> Order % der - end, - Element = - case TopType of - ['EXTERNAL'] -> - io_lib:format("?RT_BER:cindex(~w,NewVal,~w)",[CindexPos+1,Cname]); - _ -> - io_lib:format("?RT_BER:cindex(~w,Val,~w)",[CindexPos+1,Cname]) - end, - InnerType = asn1ct_gen:get_inner(Type#type.def), - print_attribute_comment(InnerType,Pos,Prop), - gen_enc_line(Erules,TopType,Cname,Type,Element,3,Prop,EncObj), - case Rest of - [] -> - emit({com,nl}); - _ -> - emit({com,nl}), - gen_enc_sequence_call(Erules,TopType,Rest,Pos+1,Ext,EncObj) - end; - -gen_enc_sequence_call(_Erules,_TopType,[],_Num,_,_) -> - true. - -%%============================================================================ -%% Decode SEQUENCE -%% -%%============================================================================ - -gen_dec_sequence_call(Erules,TopType,CompList,Ext,DecObjInf) - when is_list(CompList) -> - gen_dec_sequence_call1(Erules,TopType, CompList, 1, Ext,DecObjInf,[],[]); -gen_dec_sequence_call(Erules,TopType,CList,Ext,DecObjInf) -> - gen_dec_sequence_call2(Erules,TopType,CList,Ext,DecObjInf). - -gen_dec_sequence_call1(Erules,TopType,[#'ComponentType'{name=Cname,typespec=Type,prop=Prop,tags=Tags}|Rest],Num,Ext,DecObjInf,LeadingAttrAcc,ArgsAcc) -> - {LA,PostponedDec} = - gen_dec_component(Erules,TopType,Cname,Tags,Type,Num,Prop, - Ext,DecObjInf), - case Rest of - [] -> - {LA ++ LeadingAttrAcc,PostponedDec ++ ArgsAcc}; - _ -> - emit({com,nl}), -% asn1ct_name:new(term), - asn1ct_name:new(bytes), - gen_dec_sequence_call1(Erules,TopType,Rest,Num+1,Ext,DecObjInf, - LA++LeadingAttrAcc,PostponedDec++ArgsAcc) - end; - -gen_dec_sequence_call1(_Erules,_TopType,[],1,_,_,_,_) -> - no_terms. - -gen_dec_sequence_call2(_Erules,_TopType,{[],[],[]},_Ext,_DecObjInf) -> - no_terms; -gen_dec_sequence_call2(Erules,TopType,{Root1,EList,Root2},_Ext,DecObjInf) -> - {LA,ArgsAcc} = - case gen_dec_sequence_call1(Erules,TopType,Root1++EList,1, - extensible({Root1,EList}),DecObjInf,[],[]) of - no_terms -> - {[],[]}; - Res -> Res - end, - %% TagList is the tags of Root2 elements from the first up to and - %% including the first mandatory element. - TagList = get_root2_taglist(Root2,[]), - emit({com,nl}), - asn1ct_name:new(bytes), - emit([" {",{next,bytes},", ",{next,rb}, - "} = ?RT_BER:skip_ExtensionAdditions(", - {curr,bytes},", ",{asis,TagList},"),",nl]), - asn1ct_name:new(rb), - asn1ct_name:new(bytes), - gen_dec_sequence_call1(Erules,TopType,Root2, - length(Root1)+length(EList),noext, - DecObjInf,LA,ArgsAcc). - -%% returns a list of tags of the elements in the component (second -%% root) list up to and including the first mandatory tag. See 24.6 in -%% X.680 (7/2002) -get_root2_taglist([],Acc) -> - lists:reverse(Acc); -get_root2_taglist([#'ComponentType'{prop=Prop,typespec=Type}|Rest],Acc) -> - FirstTag = fun([])->[]; - ([H|_T])->H#tag{class=asn1ct_gen_ber:decode_class(H#tag.class)} - end(Type#type.tag), - case Prop of - mandatory -> - %% match_tags/ may be used - %% this is the last tag of interest -> return - lists:reverse([FirstTag|Acc]); - _ -> - get_root2_taglist(Rest,[FirstTag|Acc]) - end. - - -%%---------------------------- -%%SEQUENCE mandatory -%%---------------------------- - -gen_dec_component(Erules,TopType,Cname,CTags,Type,Pos,Prop,Ext,DecObjInf) -> - InnerType = - case Type#type.def of - #'ObjectClassFieldType'{type=OCFTType} -> OCFTType; - _ -> asn1ct_gen:get_inner(Type#type.def) - end, - - Prop1 = case {Prop,Ext} of - {_,{ext,Epos,_Root2pos}} when Pos < Epos -> - Prop; - {mandatory,{ext,Epos,_}} when Pos >= Epos -> - 'OPTIONAL'; - _ -> - Prop - end, - print_attribute_comment(InnerType,Pos,Prop1), - emit(" "), - - case {InnerType,DecObjInf} of - {{typefield,_},NotFalse} when NotFalse /= false -> - asn1ct_name:new(term), - asn1ct_name:new(tmpterm), - emit({"{",{curr,tmpterm},", ",{next,bytes},",",{next,rb},"} = "}); - {{objectfield,_,_},_} -> - asn1ct_name:new(term), - asn1ct_name:new(tmpterm), - emit({"{",{curr,tmpterm},", ",{next,bytes},",",{next,rb},"} = "}); - _ -> - asn1ct_name:new(term), - emit({"{",{curr,term},",",{next,bytes},",",{next,rb},"} = "}) - end, - asn1ct_name:new(rb), - PostponedDec = - gen_dec_line(Erules,TopType,Cname,CTags,Type,Prop1,DecObjInf), - asn1ct_name:new(form), - PostponedDec. - - -%%------------------------------------- -%% Decode SET -%%------------------------------------- - -gen_dec_set(Erules,TopType,CompList,Pos,Ext) -> - ExtCatch = case Ext of - noext ->""; - _ -> " catch" - end, - TagList = get_all_choice_tags(CompList), - emit({indent(3), - {curr,tagList}," = ",{asis,TagList},",",nl}), - emit({indent(3), - "case",ExtCatch," ?RT_BER:check_if_valid_tag(Bytes, ", - {curr,tagList},", OptOrMand) of",nl}), - asn1ct_name:new(tagList), - asn1ct_name:new(rbCho), - asn1ct_name:new(choTags), - gen_dec_set_cases(Erules,TopType,CompList,TagList,Pos), - asn1ct_name:new(tag), - asn1ct_name:new(bytes). - - - -gen_dec_set_cases(_,_,[],_,_) -> - ok; -gen_dec_set_cases(Erules,TopType,[H|T],List,Pos) -> - Name = H#'ComponentType'.name, - Type = H#'ComponentType'.typespec, - - emit({indent(6),"'",Name,"' ->",nl}), - case Type#type.def of - {'CHOICE',_NewCompList} -> - gen_dec_set_cases_choice(Erules,TopType,H,Pos); - _ -> - gen_dec_set_cases_type(Erules,TopType,H,Pos) - end, - gen_dec_set_cases(Erules,TopType,T,List,Pos+1). - - - -gen_dec_set_cases_choice(_Erules,TopType,H,Pos) -> - Cname = H#'ComponentType'.name, - Tag = [X#tag{class=asn1ct_gen_ber:decode_class(X#tag.class)} - || X <- (H#'ComponentType'.typespec)#type.tag], - asn1ct_name:new(rbCho), - emit({indent(9),"{Dec, Rest, ",{curr,rbCho},"} = "}), - emit({"'dec_",asn1ct_gen:list2name([Cname|TopType]), - "'(Bytes,OptOrMand,",{asis,Tag},"),",nl}), - emit([" {{",Pos,",Dec}, Rest, ",{curr,rbCho},"}"]), - emit([";",nl,nl]). - - -gen_dec_set_cases_type(Erules,TopType,H,Pos) -> - Cname = H#'ComponentType'.name, - Type = H#'ComponentType'.typespec, - %% always use Prop = mandatory here Prop = H#'ComponentType'.prop, - - asn1ct_name:new(rbCho), - emit({indent(9),"{Dec, Rest, ",{curr,rbCho},"} = "}), - asn1ct_name:delete(bytes), - %% we have already seen the tag so now we must find the value - %% that why we always use 'mandatory' here - gen_dec_line(Erules,TopType,Cname,[],Type,mandatory,decObjInf), - asn1ct_name:new(bytes), - - emit([",",nl]), - emit(["{{",Pos,",Dec}, Rest, ",{curr,rbCho},"}"]), - emit([";",nl,nl]). - - -%%--------------------------------- -%% Decode SET result -%%--------------------------------- - -gen_dec_set_result(Erules,TopType,CompList) -> - gen_dec_set_result1(Erules,TopType, CompList, 1). - -gen_dec_set_result1(Erules,TopType, - [#'ComponentType'{name=Cname, - typespec=Type, - prop=Prop}|Rest],Num) -> - gen_dec_set_component(Erules,TopType,Cname,Type,Num,Prop), - case Rest of - [] -> - true; - _ -> - gen_dec_set_result1(Erules,TopType,Rest,Num+1) - end; - -gen_dec_set_result1(_Erules,_TopType,[],1) -> - no_terms; -gen_dec_set_result1(_Erules,_TopType,[],_Num) -> - true. - - -gen_dec_set_component(_Erules,_TopType,_Cname,Type,Pos,Prop) -> - InnerType = asn1ct_gen:get_inner(Type#type.def), - print_attribute_comment(InnerType,Pos,Prop), - emit({" {",{next,term},com,{next,termList},"} =",nl}), - emit({" case ",{curr,termList}," of",nl}), - emit({" [{",Pos,com,{curr,termTmp},"}|", - {curr,rest},"] -> "}), - emit({"{",{curr,termTmp},com, - {curr,rest},"};",nl}), - case Prop of - 'OPTIONAL' -> - emit([indent(10),"_ -> {asn1_NOVALUE, ",{curr,termList},"}",nl]); - {'DEFAULT', DefVal} -> - emit([indent(10), - "_ -> {",{asis,DefVal},", ",{curr,termList},"}",nl]); - mandatory -> - emit([indent(10), - "_ -> exit({error,{asn1,{mandatory_attribute_no, ", - Pos,", missing}}})",nl]) - end, - emit([indent(6),"end,",nl]), - asn1ct_name:new(rest), - asn1ct_name:new(term), - asn1ct_name:new(termList), - asn1ct_name:new(termTmp). - - -%%--------------------------------------------- -%% Encode CHOICE -%%--------------------------------------------- -%% for BER we currently do care (a little) if the choice has an EXTENSIONMARKER - - -gen_enc_choice(Erules,TopType,Tag,CompList,_Ext) -> - gen_enc_choice1(Erules,TopType,Tag,CompList,_Ext). - -gen_enc_choice1(Erules,TopType,Tag,CompList,_Ext) -> - asn1ct_name:clear(), - emit({" {EncBytes,EncLen} = case element(1,Val) of",nl}), - gen_enc_choice2(Erules,TopType,CompList), - emit([nl," end,",nl,nl]), - NewTag = [X#tag{class=asn1ct_gen_ber:decode_class(X#tag.class)}|| X <- Tag], -% gen_encode_tags(Erules,NewTag,"EncLen","EncBytes"). - emit(["?RT_BER:encode_tags(TagIn ++",{asis,NewTag},", EncBytes, EncLen).",nl]). - - - -gen_enc_choice2(Erules,TopType,[H1|T]) when is_record(H1,'ComponentType') -> - Cname = H1#'ComponentType'.name, - Type = H1#'ComponentType'.typespec, - emit({" ",{asis,Cname}," ->",nl}), - {Encobj,Assign} = -% case asn1ct_gen:get_constraint(Type#type.constraint, -% tableconstraint_info) of - case {Type#type.def,asn1ct_gen:get_constraint(Type#type.constraint, - componentrelation)} of - {#'ObjectClassFieldType'{},{componentrelation,_,_}} -> - asn1ct_name:new(tmpBytes), - asn1ct_name:new(encBytes), - asn1ct_name:new(encLen), - Emit = ["{",{curr,tmpBytes},", _} = "], - {{no_attr,"ObjFun"},Emit}; - _ -> - case Type#type.tablecinf of - [{objfun,_}] -> {{no_attr,"ObjFun"},[]}; - _-> {false,[]} - end - end, - gen_enc_line(Erules,TopType,Cname,Type,"element(2,Val)",9, - mandatory,Assign,Encobj), - case {Type#type.def,Encobj} of - {#'ObjectClassFieldType'{},{no_attr,"ObjFun"}} -> - emit({",",nl,indent(9),"{",{curr,encBytes},", ", - {curr,encLen},"}"}); - _ -> ok - end, - emit({";",nl}), - case T of - [] -> - emit([indent(6), "Else -> ",nl, - indent(9),"exit({error,{asn1,{invalid_choice_type,Else}}})"]); - _ -> - true - end, - gen_enc_choice2(Erules,TopType,T); - -gen_enc_choice2(_,_,[]) -> - true. - - - - -%%-------------------------------------------- -%% Decode CHOICE -%%-------------------------------------------- - -gen_dec_choice(Erules,TopType, ChTag, CompList, Ext) -> - asn1ct_name:delete(bytes), - Tags = [X#tag{class=asn1ct_gen_ber:decode_class(X#tag.class)}|| X <- ChTag], - - emit([" {{_,Len},",{next,bytes}, - ", RbExp} = ?RT_BER:check_tags(TagIn++", - {asis,Tags},", ", - {curr,bytes},", OptOrMand),",nl]), - asn1ct_name:new(bytes), - asn1ct_name:new(len), - gen_dec_choice_indef_funs(Erules), - case Erules of - ber_bin -> - emit([indent(3),"case ",{curr,bytes}," of",nl]); - ber -> - emit([indent(3), - "case (catch ?RT_BER:peek_tag(",{curr,bytes},")) of",nl]) - end, - asn1ct_name:new(tagList), - asn1ct_name:new(choTags), - gen_dec_choice_cases(Erules,TopType,CompList), - case Ext of - noext -> - emit([indent(6), {curr,else}," -> ",nl]), - emit([indent(9),"case OptOrMand of",nl, - indent(12),"mandatory ->","exit({error,{asn1,", - "{invalid_choice_tag,",{curr,else},"}}});",nl, - indent(12),"_ ->","exit({error,{asn1,{no_optional_tag,", - {curr,else},"}}})",nl, - indent(9),"end",nl]); - _ -> - emit([indent(6),"_ -> ",nl]), - emit([indent(9),"{{asn1_ExtAlt,",{curr,bytes},"},", - empty_lb(Erules),", RbExp}",nl]) - end, - emit([indent(3),"end"]), - asn1ct_name:new(tag), - asn1ct_name:new(else). - -gen_dec_choice_indef_funs(Erules) -> - emit({indent(3),"IndefEndBytes = fun(indefinite,",indefend_match(Erules,used_var), - ")-> R; (_,B)-> B end,",nl}), - emit({indent(3),"IndefEndRb = fun(indefinite,",indefend_match(Erules,unused_var), - ")-> 2; (_,_)-> 0 end,",nl}). - - -gen_dec_choice_cases(_,_, []) -> - ok; -gen_dec_choice_cases(Erules,TopType, [H|T]) -> - asn1ct_name:push(rbCho), - Name = H#'ComponentType'.name, - emit([nl,"%% '",Name,"'",nl]), - Fcases = fun([T1,T2|Tail],Fun) -> - emit([indent(6),match_tag(Erules,T1)," ->",nl]), - gen_dec_choice_cases_type(Erules,TopType, H), - Fun([T2|Tail],Fun); - ([T1],_) -> - emit([indent(6),match_tag(Erules,T1)," ->",nl]), - gen_dec_choice_cases_type(Erules,TopType, H) - end, - Fcases(H#'ComponentType'.tags,Fcases), - asn1ct_name:pop(rbCho), - gen_dec_choice_cases(Erules,TopType, T). - - - -gen_dec_choice_cases_type(Erules,TopType,H) -> - Cname = H#'ComponentType'.name, - Type = H#'ComponentType'.typespec, - Prop = H#'ComponentType'.prop, - emit({indent(9),"{Dec, Rest, ",{curr,rbCho},"} = "}), - gen_dec_line(Erules,TopType,Cname,[],Type,Prop,false), - emit([",",nl,indent(9),"{{",{asis,Cname}, - ", Dec}, IndefEndBytes(Len,Rest), RbExp + ", - {curr,rbCho}," + IndefEndRb(Len,Rest)};",nl,nl]). - -encode_tag_val(Erules,{Class,TagNo}) when is_integer(TagNo) -> - Rtmod = rtmod(Erules), - Rtmod:encode_tag_val({asn1ct_gen_ber:decode_class(Class), - 0,TagNo}); -encode_tag_val(Erules,{Class,TypeName}) -> - Rtmod = rtmod(Erules), - Rtmod:encode_tag_val({asn1ct_gen_ber:decode_class(Class), - 0,asn1ct_gen_ber:decode_type(TypeName)}). - - -match_tag(ber_bin,Arg) -> - match_tag_with_bitsyntax(Arg); -match_tag(Erules,Arg) -> - io_lib:format("~p",[encode_tag_val(Erules,Arg)]). - -match_tag_with_bitsyntax({Class,TagNo}) when is_integer(TagNo) -> - match_tag_with_bitsyntax1({asn1ct_gen_ber:decode_class(Class), - 0,TagNo}); -match_tag_with_bitsyntax({Class,TypeName}) -> - match_tag_with_bitsyntax1({asn1ct_gen_ber:decode_class(Class), - 0,asn1ct_gen_ber:decode_type(TypeName)}). - -match_tag_with_bitsyntax1({Class, _Form, TagNo}) when (TagNo =< 30) -> - io_lib:format("<<~p:2,_:1,~p:5,_/binary>>",[Class bsr 6,TagNo]); - -match_tag_with_bitsyntax1({Class, _Form, TagNo}) -> - {Octets,Len} = mk_object_val(TagNo), - OctForm = case Len of - 1 -> "~p"; - 2 -> "~p,~p"; - 3 -> "~p,~p,~p"; - 4 -> "~p,~p,~p,~p" - end, - io_lib:format("<<~p:2,_:1,31:5," ++ OctForm ++ ",_/binary>>", - [Class bsr 6] ++ Octets). - -%%%%%%%%%%% -%% 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). - - -get_all_choice_tags(ComponentTypeList) -> - get_all_choice_tags(ComponentTypeList,[]). - -get_all_choice_tags([],TagList) -> - TagList; -get_all_choice_tags([H|T],TagList) -> - Tags = H#'ComponentType'.tags, - get_all_choice_tags(T, TagList ++ [{H#'ComponentType'.name, Tags}]). - - - -%%--------------------------------------- -%% Generate the encode/decode code -%%--------------------------------------- - -gen_enc_line(Erules,TopType,Cname, - Type=#type{constraint=C, - def=#'ObjectClassFieldType'{type={typefield,_}}}, - Element,Indent,OptOrMand=mandatory,EncObj) - when is_list(Element) -> - case asn1ct_gen:get_constraint(C,componentrelation) of - {componentrelation,_,_} -> - asn1ct_name:new(tmpBytes), - gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand, - ["{",{curr,tmpBytes},",_} = "],EncObj); - _ -> - gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand, - ["{",{curr,encBytes},",",{curr,encLen},"} = "], - EncObj) - end; - gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,EncObj) - when is_list(Element) -> - gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand, - ["{",{curr,encBytes},",",{curr,encLen},"} = "],EncObj). - -gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,Assign,EncObj) - when is_list(Element) -> - IndDeep = indent(Indent), - - Tag = [X#tag{class=asn1ct_gen_ber:decode_class(X#tag.class)} - || X <- Type#type.tag], - InnerType = asn1ct_gen:get_inner(Type#type.def), - WhatKind = asn1ct_gen:type(InnerType), - emit(IndDeep), - emit(Assign), - gen_optormand_case(OptOrMand,Erules,TopType,Cname,Type,InnerType,WhatKind, - Element), - case {Type,asn1ct_gen:get_constraint(Type#type.constraint, - componentrelation)} of - {#type{def=#'ObjectClassFieldType'{type={typefield,_}, - fieldname=RefedFieldName}}, - {componentrelation,_,_}} -> - {_LeadingAttrName,Fun} = EncObj, - case RefedFieldName of - {Name,RestFieldNames} when is_atom(Name),Name =/= notype -> - case OptOrMand of - mandatory -> ok; - _ -> - emit(["{",{curr,tmpBytes},", _} = "]) - end, - emit({Fun,"(",{asis,Name},", ",Element,", [], ", - {asis,RestFieldNames},"),",nl}), - emit(IndDeep), - case OptOrMand of - mandatory -> - emit({"{",{curr,encBytes},", ",{curr,encLen},"} = "}), - emit({"?RT_BER:encode_open_type(",{curr,tmpBytes}, - ",",{asis,Tag},")"}); - _ -> - emit({"{",{next,tmpBytes},", ",{curr,tmpLen}, - "} = "}), - emit({"?RT_BER:encode_open_type(",{curr,tmpBytes}, - ",",{asis,Tag},"),",nl}), - emit(IndDeep), - emit({"{",{next,tmpBytes},", ",{curr,tmpLen},"}"}) - end; - Err -> - throw({asn1,{'internal error',Err}}) - end; - _ -> - case WhatKind of - {primitive,bif} -> - EncType = - case Type#type.def of - #'ObjectClassFieldType'{ - type={fixedtypevaluefield, - _,Btype}} -> - Btype; - _ -> - Type - end, - asn1ct_gen_ber:gen_encode_prim(ber,EncType,{asis,Tag}, - Element); - 'ASN1_OPEN_TYPE' -> - asn1ct_gen_ber:gen_encode_prim(ber,Type#type{def='ASN1_OPEN_TYPE'},{asis,Tag},Element); - _ -> - {EncFunName, _, _} = - mkfuncname(TopType,Cname,WhatKind,enc), - case {WhatKind,Type#type.tablecinf,EncObj} of - {{constructed,bif},[{objfun,_}|_R],{_,Fun}} -> - emit([EncFunName,"(",Element,", ",{asis,Tag}, - ", ",Fun,")"]); - _ -> - emit([EncFunName,"(",Element,", ",{asis,Tag},")"]) - end - end - end, - case OptOrMand of - mandatory -> true; - _ -> - emit({nl,indent(7),"end"}) - end. - - - -gen_optormand_case(mandatory,_,_,_,_,_,_, _) -> - ok; -gen_optormand_case('OPTIONAL',Erules,_,_,_,_,_,Element) -> - emit({" case ",Element," of",nl}), - emit({indent(9),"asn1_NOVALUE -> {", - empty_lb(Erules),",0};",nl}), - emit({indent(9),"_ ->",nl,indent(12)}); -gen_optormand_case({'DEFAULT',DefaultValue},Erules,TopType,Cname,Type, - InnerType,WhatKind,Element) -> - CurrMod = get(currmod), - case catch lists:member(der,get(encoding_options)) of - true -> - emit(" case catch "), - asn1ct_gen:gen_check_call(TopType,Cname,Type,InnerType, - WhatKind,{asis,DefaultValue}, - Element), - emit({" of",nl}), - emit({indent(12),"true -> {[],0};",nl}); - _ -> - emit({" case ",Element," of",nl}), - emit({indent(9),"asn1_DEFAULT -> {", - empty_lb(Erules), - ",0};",nl}), - case DefaultValue of - #'Externalvaluereference'{module=CurrMod, - value=V} -> - emit({indent(9),"?",{asis,V}," -> {", - empty_lb(Erules),",0};",nl}); - _ -> - emit({indent(9),{asis, - DefaultValue}," -> {", - empty_lb(Erules),",0};",nl}) - end - end, - emit({indent(9),"_ ->",nl,indent(12)}). - - - - -gen_dec_line_sof(Erules,TopType,Cname,Type,ObjFun) -> - - Tag = [X#tag{class=asn1ct_gen_ber:decode_class(X#tag.class)} - || X <- Type#type.tag], - InnerType = asn1ct_gen:get_inner(Type#type.def), - WhatKind = asn1ct_gen:type(InnerType), - case WhatKind of - {primitive,bif} -> - asn1ct_name:delete(len), - - asn1ct_name:new(len), - emit(["fun(FBytes,_,_)->",nl]), - EncType = case Type#type.def of - #'ObjectClassFieldType'{ - type={fixedtypevaluefield, - _,Btype}} -> - Btype; - _ -> - Type - end, - asn1ct_gen_ber:gen_dec_prim(ber,EncType,"FBytes",Tag, - [],no_length,?PRIMITIVE, - mandatory), - emit([nl,"end, []"]); - _ -> - case ObjFun of - [] -> - {DecFunName, _, _} = - mkfunname(Erules,TopType,Cname,WhatKind,dec,3), - emit([DecFunName,", ",{asis,Tag}]); - _ -> - {DecFunName, _, _} = - mkfunname(Erules,TopType,Cname,WhatKind,dec,4), - emit([DecFunName,", ",{asis,Tag},", ObjFun"]) - end - end. - - -gen_dec_line(Erules,TopType,Cname,CTags,Type,OptOrMand,DecObjInf) -> - BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)), - Tag = [X#tag{class=asn1ct_gen_ber:decode_class(X#tag.class)} - || X <- Type#type.tag], - InnerType = - case Type#type.def of - #'ObjectClassFieldType'{type=OCFTType} -> - OCFTType; - _ -> - asn1ct_gen:get_inner(Type#type.def) - end, - PostpDec = - case OptOrMand of - mandatory -> - gen_dec_call(InnerType,Erules,TopType,Cname,Type, - BytesVar,Tag,mandatory,", mandatory, ", - DecObjInf,OptOrMand); - _ -> %optional or default - case {CTags,Erules} of - {[CTag],ber_bin} when CTag =/= [] -> % R9C-0.patch-34 - emit(["case ",{curr,bytes}," of",nl]), - emit([match_tag(Erules,CTag)," ->",nl]), - PostponedDec = - gen_dec_call(InnerType,Erules,TopType,Cname,Type, - BytesVar,Tag,mandatory, - ", opt_or_default, ",DecObjInf, - OptOrMand), - emit([";",nl]), - emit(["_ ->",nl]), - case OptOrMand of - {'DEFAULT', Def} -> - emit(["{",{asis,Def},",", - BytesVar,", 0 }",nl]); - 'OPTIONAL' -> - emit(["{ asn1_NOVALUE, ", - BytesVar,", 0 }",nl]) - end, - emit("end"), - PostponedDec; - _ -> - emit("case (catch "), - PostponedDec = - gen_dec_call(InnerType,Erules,TopType,Cname,Type, - BytesVar,Tag,OptOrMand, - ", opt_or_default, ",DecObjInf, - OptOrMand), - emit([") of",nl]), - case OptOrMand of - {'DEFAULT', Def} -> - emit(["{'EXIT',{error,{asn1,{no_optional_tag,_}}}}", - " -> {",{asis,Def},",", - BytesVar,", 0 };",nl]); - 'OPTIONAL' -> - emit(["{'EXIT',{error,{asn1,{no_optional_tag,_}}}}", - " -> { asn1_NOVALUE, ", - BytesVar,", 0 };",nl]) - end, - asn1ct_name:new(casetmp), - emit([{curr,casetmp},"-> ",{curr,casetmp},nl,"end"]), - PostponedDec - end - end, - case DecObjInf of - {Cname,ObjSet} -> % this must be the component were an object is - %% choosen from the object set according to the table - %% constraint. - ObjSetName = case ObjSet of - {deep,OSName,_,_} -> - OSName; - _ -> ObjSet - end, - {[{ObjSetName,Cname,asn1ct_gen:mk_var(asn1ct_name:curr(term))}], - PostpDec}; - _ -> {[],PostpDec} - end. - - -gen_dec_call({typefield,_},Erules,_,_,Type,_,Tag,_,_,false,_) -> - %% this in case of a choice with typefield components - asn1ct_name:new(reason), - {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),"{OpenDec,TmpRest,TmpRbCho} =",nl,indent(12), - "?RT_BER:decode_open_type(",Erules,",",{curr,bytes},",", - {asis,Tag},"),",nl]), - emit([indent(9),"case (catch ObjFun(",{asis,FirstPFName}, - ", OpenDec, [], ",{asis,RestPFName}, - ")) of", nl]),%% ??? What about Tag - emit([indent(12),"{'EXIT',",{curr,reason},"} ->",nl]), -%% emit({indent(15),"throw({runtime_error,{'Type not ", -%% "compatible with tableconstraint', OpenDec}});",nl}), - emit([indent(15),"exit({'Type not ", - "compatible with table constraint', ",{curr,reason},"});",nl]), - emit([indent(12),"{TmpDec,_ ,_} ->",nl]), - emit([indent(15),"{TmpDec, TmpRest, TmpRbCho}",nl]), - emit([indent(9),"end",nl,indent(6),"end",nl]), - []; -gen_dec_call({typefield,_},_Erules,_,Cname,Type,_BytesVar,Tag,_,_, - _DecObjInf,OptOrMandComp) -> - emit(["?RT_BER:decode_open_type(",{curr,bytes},",",{asis,Tag},")"]), - RefedFieldName = - (Type#type.def)#'ObjectClassFieldType'.fieldname, -% asn1ct_gen:get_constraint(Type#type.constraint, -% tableconstraint_info), - [{Cname,RefedFieldName, - asn1ct_gen:mk_var(asn1ct_name:curr(term)), -% asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),[],OptOrMandComp}]; - asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),Tag,OptOrMandComp}]; -gen_dec_call({objectfield,PrimFieldName,PFNList},_Erules,_,Cname,_,_,Tag,_,_,_, - OptOrMandComp) -> - emit(["?RT_BER:decode_open_type(",{curr,bytes},",",{asis,Tag},")"]), - [{Cname,{PrimFieldName,PFNList}, - asn1ct_gen:mk_var(asn1ct_name:curr(term)), -% asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),[],OptOrMandComp}]; - asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),Tag,OptOrMandComp}]; -gen_dec_call(InnerType,Erules,TopType,Cname,Type,BytesVar,Tag,PrimOptOrMand, - OptOrMand,DecObjInf,_) -> - WhatKind = asn1ct_gen:type(InnerType), - gen_dec_call1(WhatKind,InnerType,Erules,TopType,Cname,Type,BytesVar,Tag, - PrimOptOrMand,OptOrMand), - case DecObjInf of - {Cname,{_,OSet,UniqueFName,ValIndex}} -> - Term = asn1ct_gen:mk_var(asn1ct_name:curr(term)), - ValueMatch = value_match(ValIndex,Term), - {ObjSetMod,ObjSetName} = - case OSet of - {M,O} -> - {{asis,M},O}; - _ -> - {"?MODULE",OSet} - end, - emit({",",nl,"ObjFun = ",ObjSetMod,":'getdec_",ObjSetName,"'(", - {asis,UniqueFName},", ",ValueMatch,")"}); - _ -> - ok - end, - []. -gen_dec_call1({primitive,bif},InnerType,Erules,_,_,Type,BytesVar, - Tag,OptOrMand,_) -> - case InnerType of - {fixedtypevaluefield,_,Btype} -> - asn1ct_gen_ber:gen_dec_prim(Erules,Btype,BytesVar,Tag,[],no_length, - ?PRIMITIVE,OptOrMand); - _ -> - asn1ct_gen_ber:gen_dec_prim(Erules,Type,BytesVar,Tag,[],no_length, - ?PRIMITIVE,OptOrMand) - end; -gen_dec_call1('ASN1_OPEN_TYPE',_InnerType,Erules,_,_,Type,BytesVar, - Tag,OptOrMand,_) -> - asn1ct_gen_ber:gen_dec_prim(Erules,Type#type{def='ASN1_OPEN_TYPE'}, - BytesVar,Tag,[],no_length, - ?PRIMITIVE,OptOrMand); -gen_dec_call1(WhatKind,_,_Erules,TopType,Cname,Type,_,Tag,_,OptOrMand) -> - {DecFunName,_,_} = - mkfuncname(TopType,Cname,WhatKind,dec), - case {WhatKind,Type#type.tablecinf} of - {{constructed,bif},[{objfun,_}|_R]} -> - emit({DecFunName,"(",{curr,bytes},OptOrMand,{asis,Tag},", ObjFun)"}); - _ -> - emit({DecFunName,"(",{curr,bytes},OptOrMand,{asis,Tag},")"}) - end. - - -%%------------------------------------------------------ -%% General and special help functions (not exported) -%%------------------------------------------------------ - - -indent(N) -> - lists:duplicate(N,32). % 32 = space - - -mkvlist([H,T1|T], Sep) -> % Sep is a string e.g ", " or "+ " - emit([{var,H},Sep]), - mkvlist([T1|T], Sep); -mkvlist([H|T], Sep) -> - emit([{var,H}]), - mkvlist(T, Sep); -mkvlist([], _) -> - true. - -mkvlist(L) -> - mkvlist(L,", "). - -mkvplus(L) -> - mkvlist(L," + "). - -extensible(CompList) when is_list(CompList) -> - noext; -extensible({RootList,ExtList}) -> - {ext,length(RootList)+1,length(ExtList)}; -extensible({_Rl1,_ExtL,_Rl2}) -> - extensible. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% filter away ExtensionAdditionGroup start and end marks since these -%% have no significance for the BER encoding -%% -filter_complist(CompList) when is_list(CompList) -> - lists:filter(fun(#'ExtensionAdditionGroup'{}) -> - false; - ('ExtensionAdditionGroupEnd') -> - false; - (_) -> - true - end, CompList); -filter_complist({Root,Ext}) -> - {Root,filter_complist(Ext)}; -filter_complist({Root1,Ext,Root2}) -> - {Root1,filter_complist(Ext),Root2}. - -print_attribute_comment(InnerType,Pos,Prop) -> - CommentLine = "%%-------------------------------------------------", - emit([nl,CommentLine]), - case InnerType of - {typereference,_,Name} -> - emit([nl,"%% attribute number ",Pos," with type ",Name]); - {'Externaltypereference',_,XModule,Name} -> - emit([nl,"%% attribute number ",Pos," External ",XModule,":",Name]); - _ -> - emit([nl,"%% attribute number ",Pos," with type ",InnerType]) - end, - case Prop of - mandatory -> - continue; - {'DEFAULT', Def} -> - emit([" DEFAULT = ",{asis,Def}]); - 'OPTIONAL' -> - emit([" OPTIONAL"]) - end, - emit([nl,CommentLine,nl]). - - -mkfuncname(TopType,Cname,WhatKind,DecOrEnc) -> - CurrMod = get(currmod), - case WhatKind of - #'Externaltypereference'{module=CurrMod,type=EType} -> - F = lists:concat(["'",DecOrEnc,"_",EType,"'"]), - {F, "?MODULE", F}; - #'Externaltypereference'{module=Mod,type=EType} -> - {lists:concat(["'",Mod,"':'",DecOrEnc,"_",EType,"'"]),Mod, - lists:concat(["'",DecOrEnc,"_",EType,"'"])}; - {constructed,bif} -> - F = lists:concat(["'",DecOrEnc,"_",asn1ct_gen:list2name([Cname|TopType]),"'"]), - {F, "?MODULE", F} - end. - -mkfunname(Erule,TopType,Cname,WhatKind,DecOrEnc,Arity) -> - CurrMod = get(currmod), - case WhatKind of - #'Externaltypereference'{module=CurrMod,type=EType} -> - F = lists:concat(["fun '",DecOrEnc,"_",EType,"'/",Arity]), - {F, "?MODULE", F}; - #'Externaltypereference'{module=Mod,type=EType} -> - {lists:concat(["fun '",Mod,"':'",DecOrEnc,"_",EType,"'/",Arity]),Mod, - lists:concat(["'",DecOrEnc,"_",EType,"'"])}; - {constructed,bif} -> - F = - lists:concat(["fun '",DecOrEnc,"_", - asn1ct_gen:list2name([Cname|TopType]),"'/", - Arity]), - {F, "?MODULE", F}; - 'ASN1_OPEN_TYPE' -> - case Arity of - 3 -> - F = lists:concat(["fun(A,_,C) -> ?RT_BER:decode_open_type(",Erule,",A,C) end"]), - {F, "?MODULE", F}; - 4 -> - F = lists:concat(["fun(A,_,C,_) -> ?RT_BER:decode_open_type(",Erule,",A,C) end"]), - {F, "?MODULE", F} - end - end. - -empty_lb(ber) -> - "[]"; -empty_lb(ber_bin) -> - "<<>>". - -rtmod(ber) -> - list_to_atom(?RT_BER_BIN); -rtmod(ber_bin) -> - list_to_atom(?RT_BER_BIN). - -indefend_match(ber,used_var) -> - "[0,0|R]"; -indefend_match(ber,unused_var) -> - "[0,0|_R]"; -indefend_match(ber_bin,used_var) -> - "<<0,0,R/binary>>"; -indefend_match(ber_bin,unused_var) -> - "<<0,0,_R/binary>>". - -notice_value_match() -> - Module = get(currmod), - put(value_match,{true,Module}). - -value_match(Index,Value) when is_atom(Value) -> - value_match(Index,atom_to_list(Value)); -value_match([],Value) -> - Value; -value_match([{VI,_Cname}|VIs],Value) -> - value_match1(Value,VIs,lists:concat(["element(",VI,","]),1). -value_match1(Value,[],Acc,Depth) -> - Acc ++ Value ++ lists:concat(lists:duplicate(Depth,")")); -value_match1(Value,[{VI,_Cname}|VIs],Acc,Depth) -> - value_match1(Value,VIs,Acc++lists:concat(["element(",VI,","]),Depth+1). diff --git a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl index 2c4b44996d..78cb9297d8 100644 --- a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl @@ -32,7 +32,6 @@ -include("asn1_records.hrl"). -import(asn1ct_gen, [emit/1,demit/1,get_record_name_prefix/0]). --import(asn1ct_constructed_ber,[match_tag/2]). -define(ASN1CT_GEN_BER,asn1ct_gen_ber_bin_v2). @@ -913,7 +912,7 @@ gen_dec_choice_cases(Erules,TopType, [H|T]) -> [DecTag],Type}), asn1ct:update_gen_state(namelist,Names), emit([indent(4),{curr,res}," = ", - match_tag(ber_bin,{FirstT#tag.class,FirstT#tag.number}), + match_tag(FirstT#tag.class, FirstT#tag.number), " -> ",nl]), emit([indent(8),"{",{asis,Cname},", {'", asn1ct_gen:list2name([Cname|TopType]),"',", @@ -928,7 +927,25 @@ gen_dec_choice_cases(Erules,TopType, [H|T]) -> end, gen_dec_choice_cases(Erules,TopType, T). +match_tag(Class, TagNo) when is_integer(TagNo) -> + match_tag1(asn1ct_gen_ber_bin_v2:decode_class(Class), TagNo). +match_tag1(Class, TagNo) when TagNo =< 30 -> + io_lib:format("<<~p:2,_:1,~p:5,_/binary>>", [Class bsr 6,TagNo]); +match_tag1(Class, TagNo) -> + Octets = mk_object_val(TagNo), + io_lib:format("<<~p:2,_:1,31:5,~s,_/binary>>", [Class bsr 6,Octets]). + +mk_object_val(Val) when Val < 16#80 -> + integer_to_list(Val); +mk_object_val(Val) -> + mk_object_val(Val bsr 7, [integer_to_list(Val band 16#7F)]). + +mk_object_val(0, Acc) -> + Acc; +mk_object_val(Val, Acc) -> + I = integer_to_list((Val band 16#7F) bor 16#80), + mk_object_val(Val bsr 7, [I,","|Acc]). %%--------------------------------------- %% Generate the encode/decode code @@ -1493,10 +1510,6 @@ mkfuncname(TopType,Cname,WhatKind,Prefix,Suffix) -> end. empty_lb(ber) -> - "[]"; -empty_lb(ber_bin) -> - "<<>>"; -empty_lb(ber_bin_v2) -> "<<>>". value_match(Index,Value) when is_atom(Value) -> diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl index 8de41a4dd4..e4e0e064e8 100644 --- a/lib/asn1/src/asn1ct_constructed_per.erl +++ b/lib/asn1/src/asn1ct_constructed_per.erl @@ -80,9 +80,7 @@ gen_encode_constructed(Erule,Typename,D) when is_record(D,type) -> "compiler warning for unused vars!",nl, "_Val = ",{curr,val},",",nl]); {[],_,_} -> - emit([{next,val}," = ?RT_PER:list_to_record("]), - emit(["'",asn1ct_gen:list2rname(Typename),"'"]), - emit([", ",{curr,val},"),",nl]); + emit([{next,val}," = ",{curr,val},",",nl]); {_,_,true} -> gen_fixoptionals(Optionals), FixOpts = param_map(fun(Var) -> @@ -155,7 +153,7 @@ gen_encode_constructed(Erule,Typename,D) when is_record(D,type) -> emit([ObjectEncode," = ",nl]), emit([" ",ObjSetMod,":'getenc_",ObjSetName,"'(", {asis,UniqueFieldName},", ",nl]), - El = make_element(N+1,asn1ct_gen:mk_var(asn1ct_name:curr(val)),AttrN), + El = make_element(N+1,asn1ct_gen:mk_var(asn1ct_name:curr(val))), Length = fun(X,_LFun) when is_atom(X) -> length(atom_to_list(X)); @@ -583,8 +581,7 @@ gen_encode_sof_components(Erule,Typename,SeqOrSetOf,Cont) -> Conttype = asn1ct_gen:get_inner(Cont#type.def), Currmod = get(currmod), - Ctgenmod = list_to_atom(lists:concat(["asn1ct_gen_",per, - asn1ct_gen:rt2ct_suffix()])), + Ctgenmod = asn1ct_gen:ct_gen_module(Erule), case asn1ct_gen:type(Conttype) of {primitive,bif} -> gen_encode_prim_wrapper(Ctgenmod,Erule,Cont,false,"H"); @@ -622,8 +619,7 @@ gen_decode_sof_components(Erule,Typename,SeqOrSetOf,Cont) -> Constructed_Suffix = asn1ct_gen:constructed_suffix(SeqOrSetOf, Cont#type.def), Conttype = asn1ct_gen:get_inner(Cont#type.def), - Ctgenmod = list_to_atom(lists:concat(["asn1ct_gen_",per, - asn1ct_gen:rt2ct_suffix()])), + Ctgenmod = asn1ct_gen:ct_gen_module(Erule), CurrMod = get(currmod), case asn1ct_gen:type(Conttype) of {primitive,bif} -> @@ -889,7 +885,7 @@ gen_enc_components_call1(_Erule,_TopType,[],Pos,_,_,_) -> Pos. gen_enc_component_default(Erule,TopType,Cname,Type,Pos,DynamicEnc,Ext,DefaultVal) -> - Element = make_element(Pos+1,asn1ct_gen:mk_var(asn1ct_name:curr(val)),Cname), + Element = make_element(Pos+1,asn1ct_gen:mk_var(asn1ct_name:curr(val))), emit({"case ",Element," of",nl}), % emit({"asn1_DEFAULT -> [];",nl}), emit({"DFLT when DFLT == asn1_DEFAULT; DFLT == ",{asis,DefaultVal}," -> [];",nl}), @@ -909,7 +905,7 @@ gen_enc_component_optional(Erule,TopType,Cname, components=_ExtGroupCompList}}, Pos,DynamicEnc,Ext) when is_integer(Number) -> - Element = make_element(Pos+1,asn1ct_gen:mk_var(asn1ct_name:curr(val)),Cname), + Element = make_element(Pos+1,asn1ct_gen:mk_var(asn1ct_name:curr(val))), emit({"case ",Element," of",nl}), emit({"asn1_NOVALUE -> [];",nl}), @@ -922,7 +918,7 @@ gen_enc_component_optional(Erule,TopType,Cname, gen_enc_line(Erule,TopType,Cname,Type,NextElement, Pos,DynamicEnc,Ext), emit({nl,"end"}); gen_enc_component_optional(Erule,TopType,Cname,Type,Pos,DynamicEnc,Ext) -> - Element = make_element(Pos+1,asn1ct_gen:mk_var(asn1ct_name:curr(val)),Cname), + Element = make_element(Pos+1,asn1ct_gen:mk_var(asn1ct_name:curr(val))), emit({"case ",Element," of",nl}), emit({"asn1_NOVALUE -> [];",nl}), @@ -942,11 +938,10 @@ gen_enc_component_mandatory(Erule,TopType,Cname,Type,Pos,DynamicEnc,Ext) -> gen_enc_line(Erule,TopType,Cname,Type,[],Pos,DynamicEnc,Ext). gen_enc_line(Erule,TopType, Cname, Type, [], Pos,DynamicEnc,Ext) -> - Element = make_element(Pos+1,asn1ct_gen:mk_var(asn1ct_name:curr(val)),Cname), + Element = make_element(Pos+1,asn1ct_gen:mk_var(asn1ct_name:curr(val))), gen_enc_line(Erule,TopType,Cname,Type,Element, Pos,DynamicEnc,Ext); gen_enc_line(Erule,TopType,Cname,Type,Element, _Pos,DynamicEnc,Ext) -> - Ctgenmod = list_to_atom(lists:concat(["asn1ct_gen_",per, - asn1ct_gen:rt2ct_suffix()])), + Ctgenmod = asn1ct_gen:ct_gen_module(Erule), Atype = case Type of #type{def=#'ObjectClassFieldType'{type=InnerType}} -> @@ -1214,8 +1209,7 @@ gen_dec_component_no_val({ext,_,_},mandatory) -> gen_dec_line(Erule,TopType,Cname,Type,Pos,DecInfObj,Ext,Prop) -> - Ctgenmod = list_to_atom(lists:concat(["asn1ct_gen_",per, - asn1ct_gen:rt2ct_suffix()])), + Ctgenmod = asn1ct_gen:ct_gen_module(Erule), Atype = case Type of #type{def=#'ObjectClassFieldType'{type=InnerType}} -> @@ -1578,22 +1572,17 @@ gen_encode_prim_wrapper(CtgenMod,Erule,Cont,DoTag,Value) -> make_elements(I,Val,ExtCnames) -> make_elements(I,Val,ExtCnames,[]). -make_elements(I,Val,[ExtCname],Acc)-> % the last one, no comma needed - Element = make_element(I,Val,ExtCname), +make_elements(I,Val,[_ExtCname],Acc)-> % the last one, no comma needed + Element = make_element(I, Val), make_elements(I+1,Val,[],[Element|Acc]); -make_elements(I,Val,[ExtCname|Rest],Acc)-> - Element = make_element(I,Val,ExtCname), +make_elements(I,Val,[_ExtCname|Rest],Acc)-> + Element = make_element(I, Val), make_elements(I+1,Val,Rest,[", ",Element|Acc]); make_elements(_I,_,[],Acc) -> lists:reverse(Acc). -make_element(I,Val,Cname) -> - case tuple_notation_allowed() of - true -> - io_lib:format("?RT_PER:cindex(~w,~s,~w)",[I,Val,Cname]); - _ -> - io_lib:format("element(~w,~s)",[I,Val]) - end. +make_element(I, Val) -> + io_lib:format("element(~w,~s)", [I,Val]). emit_extaddgroupTerms(VarSeries,[_]) -> asn1ct_name:new(VarSeries), @@ -1651,10 +1640,6 @@ wrap_extensionAdditionGroups([],_,Acc,_,_) -> lists:reverse(Acc). -tuple_notation_allowed() -> - Options = get(encoding_options), - not (lists:member(optimize,Options) orelse lists:member(uper_bin,Options)). - wrap_gen_dec_line(Erule,C,TopType,Cname,Type,Pos,DIO,Ext) -> put(component_type,{true,C}), gen_dec_line(Erule,TopType,Cname,Type,Pos,DIO,Ext,mandatory), @@ -1683,7 +1668,5 @@ notice_value_match() -> Module = get(currmod), put(value_match,{true,Module}). -is_optimized(per_bin) -> - lists:member(optimize,get(encoding_options)); -is_optimized(_Erule) -> - false. +is_optimized(per) -> true; +is_optimized(uper) -> false. diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index 64a3555f62..b0990e92cf 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -37,8 +37,7 @@ gen_check_call/7, get_constraint/2, insert_once/2, - rt2ct_suffix/1, - rt2ct_suffix/0, + ct_gen_module/1, index2suffix/1, get_record_name_prefix/0]). -export([pgen/5, @@ -52,7 +51,7 @@ %% pgen(Outfile, Erules, Module, TypeOrVal, Options) %% Generate Erlang module (.erl) and (.hrl) file corresponding to an ASN.1 module %% .hrl file is only generated if necessary -%% Erules = per | ber | ber_bin | per_bin +%% Erules = per | ber %% Module = atom() %% TypeOrVal = {TypeList,ValueList} %% TypeList = ValueList = [atom()] @@ -83,7 +82,7 @@ pgen_module(OutFile,Erules,Module, pgen_exports(Erules,Module,TypeOrVal), pgen_dispatcher(Erules,Module,TypeOrVal), pgen_info(), - pgen_typeorval(wrap_ber(Erules),Module,N2nConvEnums,TypeOrVal), + pgen_typeorval(Erules,Module,N2nConvEnums,TypeOrVal), pgen_partial_incomplete_decode(Erules), % gen_vars(asn1_db:mod_to_vars(Module)), % gen_tag_table(AllTypes), @@ -92,8 +91,7 @@ pgen_module(OutFile,Erules,Module, pgen_typeorval(Erules,Module,N2nConvEnums,{Types,Values,_Ptypes,_Classes,Objects,ObjectSets}) -> - Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules), - rt2ct_suffix(Erules)])), + Rtmod = ct_gen_module(Erules), pgen_types(Rtmod,Erules,N2nConvEnums,Module,Types), pgen_values(Erules,Module,Values), pgen_objects(Rtmod,Erules,Module,Objects), @@ -196,7 +194,7 @@ pgen_check_defaultval(Erules,Module) -> end, gen_check_defaultval(Erules,Module,CheckObjects). -pgen_partial_decode(Rtmod,Erule,Module) when Erule == ber_bin_v2 -> +pgen_partial_decode(Rtmod,Erule,Module) when Erule == ber -> pgen_partial_inc_dec(Rtmod,Erule,Module), pgen_partial_dec(Rtmod,Erule,Module); pgen_partial_decode(_,_,_) -> @@ -240,7 +238,7 @@ pgen_partial_inc_dec1(Rtmod,Erules,Module,[P|Ps]) -> pgen_partial_inc_dec1(_,_,_,[]) -> ok. -gen_partial_inc_dec_refed_funcs(Rtmod,Erule) when Erule == ber_bin_v2 -> +gen_partial_inc_dec_refed_funcs(Rtmod,Erule) when Erule == ber -> case asn1ct:next_refed_func() of [] -> ok; @@ -296,8 +294,7 @@ pgen_partial_types1(_,undefined) -> %% TypeList a decode function will be generated. traverse_type_structure(Erules,Type,[],FuncName,TopTypeName) -> %% this is the selected type - Ctmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules), - rt2ct_suffix(Erules)])), + Ctmod = ct_gen_module(Erules), TypeDef = case Type of #type{} -> @@ -457,7 +454,7 @@ pgen_partial_incomplete_decode(Erule) -> _ -> ok end. -pgen_partial_incomplete_decode1(ber_bin_v2) -> +pgen_partial_incomplete_decode1(ber) -> case asn1ct:read_config_data(partial_incomplete_decode) of undefined -> ok; @@ -552,20 +549,17 @@ gen_part_decode_funcs(WhatKind,_TypeName,{_,Directive,_,_}) -> gen_types(Erules,Tname,{RootL1,ExtList,RootL2}) when is_list(RootL1), is_list(RootL2) -> gen_types(Erules,Tname,RootL1), - Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules), - rt2ct_suffix(Erules)])), + Rtmod = ct_gen_module(Erules), gen_types(Erules,Tname,Rtmod:extaddgroup2sequence(ExtList)), gen_types(Erules,Tname,RootL2); gen_types(Erules,Tname,{RootList,ExtList}) when is_list(RootList) -> gen_types(Erules,Tname,RootList), - Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules), - rt2ct_suffix(Erules)])), + Rtmod = ct_gen_module(Erules), gen_types(Erules,Tname,Rtmod:extaddgroup2sequence(ExtList)); gen_types(Erules,Tname,[{'EXTENSIONMARK',_,_}|Rest]) -> gen_types(Erules,Tname,Rest); gen_types(Erules,Tname,[ComponentType|Rest]) -> - Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules), - rt2ct_suffix(Erules)])), + Rtmod = ct_gen_module(Erules), asn1ct_name:clear(), Rtmod:gen_encode(Erules,Tname,ComponentType), asn1ct_name:clear(), @@ -574,8 +568,7 @@ gen_types(Erules,Tname,[ComponentType|Rest]) -> gen_types(_,_,[]) -> true; gen_types(Erules,Tname,Type) when is_record(Type,type) -> - Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules), - rt2ct_suffix(Erules)])), + Rtmod = ct_gen_module(Erules), asn1ct_name:clear(), Rtmod:gen_encode(Erules,Tname,Type), asn1ct_name:clear(), @@ -754,8 +747,7 @@ gen_value(Value) when is_record(Value,valuedef) -> emit([{asis,V},".",nl,nl]). gen_encode_constructed(Erules,Typename,InnerType,D) when is_record(D,type) -> - - Rtmod = list_to_atom(lists:concat(["asn1ct_constructed_",erule(Erules)])), + Rtmod = ct_constructed_module(Erules), case InnerType of 'SET' -> Rtmod:gen_encode_set(Erules,Typename,D), @@ -787,7 +779,7 @@ gen_encode_constructed(Erules,Typename,InnerType,D) gen_encode_constructed(Erules,Typename,InnerType,D#typedef.typespec). gen_decode_constructed(Erules,Typename,InnerType,D) when is_record(D,type) -> - Rtmod = list_to_atom(lists:concat(["asn1ct_constructed_",erule(Erules)])), + Rtmod = ct_constructed_module(Erules), asn1ct:step_in_constructed(), %% updates namelist for exclusive decode case InnerType of 'SET' -> @@ -818,27 +810,11 @@ pgen_exports(Erules,_Module,{Types,Values,_,_,Objects,ObjectSets}) -> case Erules of ber -> gen_exports1(Types,"enc_",2); - ber_bin -> - gen_exports1(Types,"enc_",2); - ber_bin_v2 -> - gen_exports1(Types,"enc_",2); _ -> gen_exports1(Types,"enc_",1) end, emit({"-export([",nl}), - gen_exports1(Types,"dec_",2), - case Erules of - ber -> - emit({"-export([",nl}), - gen_exports1(Types,"dec_",3); - ber_bin -> - emit({"-export([",nl}), - gen_exports1(Types,"dec_",3); -% ber_bin_v2 -> -% emit({"-export([",nl}), -% gen_exports1(Types,"dec_",2); - _ -> ok - end + gen_exports1(Types,"dec_",2) end, case [X || {n2n,X} <- get(encoding_options)] of [] -> ok; @@ -863,16 +839,11 @@ pgen_exports(Erules,_Module,{Types,Values,_,_,Objects,ObjectSets}) -> gen_exports1(Objects,"enc_",3), emit({"-export([",nl}), gen_exports1(Objects,"dec_",4); - ber_bin_v2 -> + ber -> emit({"-export([",nl}), gen_exports1(Objects,"enc_",3), emit({"-export([",nl}), - gen_exports1(Objects,"dec_",3); - _ -> - emit({"-export([",nl}), - gen_exports1(Objects,"enc_",4), - emit({"-export([",nl}), - gen_exports1(Objects,"dec_",4) + gen_exports1(Objects,"dec_",3) end end, case ObjectSets of @@ -948,20 +919,17 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> emit(["encoding_rule() ->",nl]), emit([" ",{asis,Erules},".",nl,nl]), NoFinalPadding = lists:member(no_final_padding,get(encoding_options)), - Call = case Erules of - per -> "?RT_PER:complete(encode_disp(Type,Data))"; - per_bin -> ["?RT_PER:complete(encode_disp(Type,Data))"]; - ber -> "encode_disp(Type,Data)"; - ber_bin -> "encode_disp(Type,Data)"; - ber_bin_v2 -> "encode_disp(Type,Data)"; - uper_bin when NoFinalPadding == true -> - "?RT_PER:complete_NFP(encode_disp(Type,Data))"; - uper_bin -> ["?RT_PER:complete(encode_disp(Type,Data))"] - end, - EncWrap = case Erules of - ber -> "wrap_encode(Bytes)"; - _ -> "Bytes" - end, + {Call,BytesAsBinary} = + case Erules of + per -> + {["?RT_PER: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"}; + uper -> + {["?RT_PER:complete(encode_disp(Type,Data))"],"Bytes"} + end, emit(["encode(Type,Data) ->",nl, "case catch ",Call," of",nl, " {'EXIT',{error,Reason}} ->",nl, @@ -969,42 +937,25 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> " {'EXIT',Reason} ->",nl, " {error,{asn1,Reason}};",nl, " {Bytes,_Len} ->",nl, - " {ok,",EncWrap,"};",nl]), - case Erules of - per -> - emit([" Bytes when is_binary(Bytes) ->",nl, - " {ok,binary_to_list(Bytes)};",nl, - " Bytes ->",nl, - " {ok,binary_to_list(list_to_binary(Bytes))}",nl, - " end.",nl,nl]); - _ -> - emit([" Bytes ->",nl, - " {ok,",EncWrap,"}",nl, - "end.",nl,nl]) - end, - -% case Erules of -% ber_bin_v2 -> -% emit(["decode(Type,Data0) ->",nl]), -% emit(["{Data,_RestBin} = ?RT_BER:decode(Data0",nif_parameter(),"),",nl]); -% _ -> -% emit(["decode(Type,Data) ->",nl]) -% end, + " {ok,",BytesAsBinary,"};",nl, + " Bytes ->",nl, + " {ok,",BytesAsBinary,"}",nl, + "end.",nl,nl]), Return_rest = lists:member(undec_rest,get(encoding_options)), Data = case {Erules,Return_rest} of - {ber_bin_v2,true} -> "Data0"; + {ber,true} -> "Data0"; _ -> "Data" end, emit(["decode(Type,",Data,") ->",nl]), DecAnonymous = case {Erules,Return_rest} of - {ber_bin_v2,false} -> + {ber,false} -> io_lib:format("~s~s~s~n", ["element(1,?RT_BER:decode(Data", nif_parameter(),"))"]); - {ber_bin_v2,true} -> + {ber,true} -> emit(["{Data,Rest} = ?RT_BER:decode(Data0", nif_parameter(),"),",nl]), "Data"; @@ -1012,10 +963,8 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> "Data" end, DecWrap = case Erules of - ber -> "wrap_decode(Data)"; - ber_bin_v2 -> + ber -> DecAnonymous; - per -> "list_to_binary(Data)"; _ -> "Data" end, @@ -1025,32 +974,18 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> " {'EXIT',Reason} ->",nl, " {error,{asn1,Reason}};",nl]), case {Erules,Return_rest} of - {ber_bin_v2,false} -> + {ber,false} -> emit([" Result ->",nl, " {ok,Result}",nl]); - {ber_bin_v2,true} -> + {ber,true} -> emit([" Result ->",nl, " {ok,Result,Rest}",nl]); - {per,false} -> - emit([" {X,_Rest} ->",nl, - " {ok,if_binary2list(X)};",nl, - " {X,_Rest,_Len} ->",nl, - " {ok,if_binary2list(X)}",nl]); {_,false} -> emit([" {X,_Rest} ->",nl, " {ok,X};",nl, " {X,_Rest,_Len} ->",nl, " {ok,X}",nl]); - {per,true} -> - emit([" {X,{_,Rest}} ->",nl, - " {ok,if_binary2list(X),Rest};",nl, - " {X,{_,Rest},_Len} ->",nl, - " {ok,if_binary2list(X),Rest};",nl, - " {X,Rest} ->",nl, - " {ok,if_binary2list(X),Rest};",nl, - " {X,Rest,_Len} ->",nl, - " {ok,if_binary2list(X),Rest}",nl]); - {per_bin,true} -> + {per,true} -> emit([" {X,{_,Rest}} ->",nl, " {ok,X,Rest};",nl, " {X,{_,Rest},_Len} ->",nl, @@ -1059,7 +994,7 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> " {ok,X,Rest};",nl, " {X,Rest,_Len} ->",nl, " {ok,X,Rest}",nl]); - {uper_bin,true} -> + {uper,true} -> emit([" {X,{_,Rest}} ->",nl, " {ok,X,Rest};",nl, " {X,{_,Rest},_Len} ->",nl, @@ -1067,34 +1002,14 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> " {X,Rest} ->",nl, " {ok,X,Rest};",nl, " {X,Rest,_Len} ->",nl, - " {ok,X,Rest}",nl]); - _ -> - emit([" {X,Rest} ->",nl, - " {ok,X,Rest};",nl, - " {X,Rest,_Len} ->",nl, " {ok,X,Rest}",nl]) end, emit(["end.",nl,nl]), - case Erules of - per -> - emit(["if_binary2list(B) when is_binary(B) ->",nl, - " binary_to_list(B);",nl, - "if_binary2list(L) -> L.",nl,nl]); - _ -> - ok - end, - gen_decode_partial_incomplete(Erules), case Erules of ber -> - gen_dispatcher(Types,"encode_disp","enc_",",[]"), - gen_dispatcher(Types,"decode_disp","dec_",",mandatory"); - ber_bin -> - gen_dispatcher(Types,"encode_disp","enc_",",[]"), - gen_dispatcher(Types,"decode_disp","dec_",",mandatory"); - ber_bin_v2 -> gen_dispatcher(Types,"encode_disp","enc_",""), gen_dispatcher(Types,"decode_disp","dec_",""), gen_partial_inc_dispatcher(); @@ -1103,17 +1018,10 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> gen_dispatcher(Types,"decode_disp","dec_",",mandatory") end, emit([nl]), - - case Erules of - ber -> - gen_wrapper(); - _ -> ok - end, emit({nl,nl}). -gen_decode_partial_incomplete(Erule) when Erule == ber;Erule==ber_bin; - Erule==ber_bin_v2 -> +gen_decode_partial_incomplete(ber) -> case {asn1ct:read_config_data(partial_incomplete_decode), asn1ct:get_gen_state_field(inc_type_pattern)} of {undefined,_} -> @@ -1121,34 +1029,35 @@ gen_decode_partial_incomplete(Erule) when Erule == ber;Erule==ber_bin; {_,undefined} -> ok; _ -> - case Erule of - ber_bin_v2 -> - EmitCaseClauses = - fun() -> - emit([" {'EXIT',{error,Reason}} ->",nl, - " {error,Reason};",nl, - " {'EXIT',Reason} ->",nl, - " {error,{asn1,Reason}};",nl, - " Result ->",nl, - " {ok,Result}",nl, - " end.",nl,nl]) - end, - emit(["decode_partial_incomplete(Type,Data0,", - "Pattern) ->",nl]), - emit([" {Data,_RestBin} =",nl, - " ?RT_BER:decode_primitive_", - "incomplete(Pattern,Data0),",nl, - " case catch decode_partial_inc_disp(Type,", - "Data) of",nl]), - EmitCaseClauses(), - emit(["decode_part(Type,Data0) ->",nl]), - emit([" case catch decode_inc_disp(Type,element(1," - "?RT_BER:decode(Data0",nif_parameter(),"))) of",nl]), -% " {Data,_RestBin} = ?RT_BER:decode(Data0),",nl, -% " case catch decode_inc_disp(Type,Data) of",nl]), - EmitCaseClauses(); - _ -> ok % add later - end + EmitCaseClauses = + fun() -> + emit([" {'EXIT',{error,Reason}} ->",nl, + " {error,Reason};",nl, + " {'EXIT',Reason} ->",nl, + " {error,{asn1,Reason}};",nl, + " Result ->",nl, + " {ok,Result}",nl, + " end"]) + end, + emit(["decode_partial_incomplete(Type,Data0,", + "Pattern) ->",nl]), + emit([" {Data,_RestBin} =",nl, + " ?RT_BER:decode_primitive_", + "incomplete(Pattern,Data0),",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]), + EmitCaseClauses(), + emit([";",nl]), + emit(["decode_part(Type, Data0) ->",nl]), + emit([" case catch decode_inc_disp(Type, Data0) of",nl]), + EmitCaseClauses(), + emit([".",nl,nl]) end; gen_decode_partial_incomplete(_Erule) -> ok. @@ -1187,23 +1096,8 @@ gen_partial_inc_dispatcher([],_) -> " exit({error,{asn1,{undefined_type,Type}}}).",nl]). nif_parameter() -> - Options = get(encoding_options), - case {lists:member(driver,Options),lists:member(nif,Options)} of - {true,_} -> ",nif"; - {_,true} -> ",nif"; - _ -> "" - end. + ",nif". -gen_wrapper() -> - emit(["wrap_encode(Bytes) when is_list(Bytes) ->",nl, - " binary_to_list(list_to_binary(Bytes));",nl, - "wrap_encode(Bytes) when is_binary(Bytes) ->",nl, - " binary_to_list(Bytes);",nl, - "wrap_encode(Bytes) -> Bytes.",nl,nl]), - emit(["wrap_decode(Bytes) when is_list(Bytes) ->",nl, - " list_to_binary(Bytes);",nl, - "wrap_decode(Bytes) -> Bytes.",nl]). - gen_dispatcher([F1,F2|T],FuncName,Prefix,ExtraArg) -> emit([FuncName,"('",F1,"',Data) -> '",Prefix,F1,"'(Data",ExtraArg,")",";",nl]), gen_dispatcher([F2|T],FuncName,Prefix,ExtraArg); @@ -1213,19 +1107,16 @@ gen_dispatcher([Flast|_T],FuncName,Prefix,ExtraArg) -> pgen_info() -> emit(["info() ->",nl, - " case ?MODULE:module_info() of",nl, - " MI when is_list(MI) ->",nl, - " case lists:keysearch(attributes,1,MI) of",nl, - " {value,{_,Attributes}} when is_list(Attributes) ->",nl, - " case lists:keysearch(asn1_info,1,Attributes) of",nl, - " {value,{_,Info}} when is_list(Info) ->",nl, - " Info;",nl, - " _ ->",nl, - " []",nl, - " end;",nl, - " _ ->",nl, - " []",nl, - " end",nl, + " case ?MODULE:module_info(attributes) of",nl, + " Attributes when is_list(Attributes) ->",nl, + " case lists:keyfind(asn1_info, 1, Attributes) of",nl, + " {_,Info} when is_list(Info) ->",nl, + " Info;",nl, + " _ ->",nl, + " []",nl, + " end;",nl, + " _ ->",nl, + " []",nl, " end.",nl]). open_hrl(OutFile,Module) -> @@ -1496,32 +1387,15 @@ gen_head(Erules,Mod,Hrl) -> {Rtmac,Rtmod} = case Erules of per -> emit({"%% Generated by the Erlang ASN.1 PER-" - "compiler version:",asn1ct:vsn(),nl}), - {"RT_PER",?RT_PER_BIN}; - ber -> - emit({"%% Generated by the Erlang ASN.1 BER-" - "compiler version:",asn1ct:vsn(),nl}), - {"RT_BER",?RT_BER_BIN}; - per_bin -> - emit({"%% Generated by the Erlang ASN.1 BER-" - "compiler version, utilizing bit-syntax:", - asn1ct:vsn(),nl}), - %% temporary code to enable rt2ct optimization - case lists:member(optimize,Options) of - true -> {"RT_PER","asn1rt_per_bin_rt2ct"}; - _ -> {"RT_PER",?RT_PER_BIN} - end; - ber_bin -> - emit({"%% Generated by the Erlang ASN.1 BER-" "compiler version, utilizing bit-syntax:", asn1ct:vsn(),nl}), - {"RT_BER",?RT_BER_BIN}; - ber_bin_v2 -> + {"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_bin -> + uper -> emit(["%% Generated by the Erlang ASN.1 UNALIGNED" " PER-compiler version, utilizing" " bit-syntax:", @@ -1541,7 +1415,7 @@ gen_head(Erules,Mod,Hrl) -> emit(["-define('",Rtmac,"',",Rtmod,").",nl]), emit(["-asn1_info([{vsn,'",asn1ct:vsn(),"'},",nl, " {module,'",Mod,"'},",nl, - " {options,",io_lib:format("~w",[Options]),"}]).",nl,nl]). + " {options,",io_lib:format("~p",[Options]),"}]).",nl,nl]). gen_hrlhead(Mod) -> @@ -2019,43 +1893,29 @@ constructed_suffix('SEQUENCE OF',_) -> constructed_suffix('SET OF',_) -> 'SETOF'. -erule(ber) -> - ber; -erule(ber_bin) -> - ber; -erule(ber_bin_v2) -> - ber_bin_v2; -erule(per) -> - per; -erule(per_bin) -> - per; -erule(uper_bin) -> - per. - -wrap_ber(ber) -> - ber_bin; -wrap_ber(Erule) -> - Erule. - -rt2ct_suffix() -> - Options = get(encoding_options), - case {lists:member(optimize,Options),lists:member(per_bin,Options)} of - {true,true} -> "_rt2ct"; - _ -> "" - end. -rt2ct_suffix(per_bin) -> - Options = get(encoding_options), - case lists:member(optimize,Options) of - true -> "_rt2ct"; - _ -> "" - end; -rt2ct_suffix(_) -> "". +erule(ber) -> ber; +erule(per) -> per; +erule(uper) -> per. index2suffix(0) -> ""; index2suffix(N) -> lists:concat(["_",N]). +ct_gen_module(ber) -> + asn1ct_gen_ber_bin_v2; +ct_gen_module(per) -> + asn1ct_gen_per_rt2ct; +ct_gen_module(uper) -> + asn1ct_gen_per. + +ct_constructed_module(ber) -> + asn1ct_constructed_ber_bin_v2; +ct_constructed_module(per) -> + asn1ct_constructed_per; +ct_constructed_module(uper) -> + asn1ct_constructed_per. + get_constraint(C,Key) -> case lists:keysearch(Key,1,C) of false -> diff --git a/lib/asn1/src/asn1ct_gen_ber.erl b/lib/asn1/src/asn1ct_gen_ber.erl deleted file mode 100644 index 491ebcb8fd..0000000000 --- a/lib/asn1/src/asn1ct_gen_ber.erl +++ /dev/null @@ -1,1749 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-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(asn1ct_gen_ber). - -%% Generate erlang module which handles (PER) encode and decode for -%% all types in an ASN.1 module - --include("asn1_records.hrl"). - --export([pgen/4]). --export([decode_class/1, decode_type/1]). --export([add_removed_bytes/0]). --export([gen_encode/2,gen_encode/3,gen_decode/2,gen_decode/3]). --export([gen_encode_prim/4]). --export([gen_dec_prim/8]). --export([gen_objectset_code/2, gen_obj_code/3]). --export([re_wrap_erule/1]). --export([unused_var/2]). --export([extaddgroup2sequence/1]). - --import(asn1ct_gen, [emit/1,demit/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). - - --define(T_ObjectDescriptor, ?UNIVERSAL bor ?PRIMITIVE bor 7). - % restricted character string types --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_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 - -%% pgen(Erules, Module, TypeOrVal) -%% Generate Erlang module (.erl) and (.hrl) file corresponding to an ASN.1 module -%% .hrl file is only generated if necessary -%% Erules = per | ber -%% Module = atom() -%% TypeOrVal = {TypeList,ValueList,PTypeList} -%% TypeList = ValueList = [atom()] - -pgen(OutFile,Erules,Module,TypeOrVal) -> - asn1ct_gen:pgen_module(OutFile,Erules,Module,TypeOrVal,[],true). - - -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== -%% Generate ENCODING -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== - -%%=============================================================================== -%% encode #{typedef, {pos, name, typespec}} -%%=============================================================================== - -gen_encode(Erules,Type) when is_record(Type,typedef) -> - gen_encode_user(Erules,Type). - -%%=============================================================================== -%% encode #{type, {tag, def, constraint}} -%%=============================================================================== - -gen_encode(Erules,Typename,Type) when is_record(Type,type) -> - InnerType = asn1ct_gen:get_inner(Type#type.def), - ObjFun = - case lists:keysearch(objfun,1,Type#type.tablecinf) of - {value,{_,_Name}} -> - ", ObjFun"; - false -> - "" - end, - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> - emit([nl,nl,nl,"%%================================"]), - emit([nl,"%% ",asn1ct_gen:list2name(Typename)]), - emit([nl,"%%================================",nl]), - case lists:member(InnerType,['SET','SEQUENCE']) of - true -> - case get(asn_keyed_list) of - true -> - CompList = - case Type#type.def of - #'SEQUENCE'{components=Cl} -> Cl; - #'SET'{components=Cl} -> Cl - end, - emit([nl,"'enc_",asn1ct_gen:list2name(Typename), - "'(Val, TagIn",ObjFun, - ") when is_list(Val) ->",nl]), - emit([" 'enc_",asn1ct_gen:list2name(Typename), - "'(?RT_BER:fixoptionals(", - {asis,optionals(CompList)}, - ",Val), TagIn",ObjFun,");",nl,nl]); - _ -> true - end; - _ -> - emit([nl,"'enc_",asn1ct_gen:list2name(Typename), - "'({'",asn1ct_gen:list2name(Typename), - "',Val}, TagIn",ObjFun,") ->",nl]), - emit([" 'enc_",asn1ct_gen:list2name(Typename), - "'(Val, TagIn",ObjFun,");",nl,nl]) - end, - emit(["'enc_",asn1ct_gen:list2name(Typename), - "'(Val, TagIn",ObjFun,") ->",nl," "]), - asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,Type); - _ -> - true - end; - -%%=============================================================================== -%% encode ComponentType -%%=============================================================================== - -gen_encode(Erules,Tname,#'ComponentType'{name=Cname,typespec=Type}) -> - NewTname = [Cname|Tname], - %% The tag is set to [] to avoid that it is - %% taken into account twice, both as a component/alternative (passed as - %% argument to the encode decode function and within the encode decode - %% function it self. - NewType = Type#type{tag=[]}, - gen_encode(Erules,NewTname,NewType). - -gen_encode_user(Erules,D) when is_record(D,typedef) -> - Typename = [D#typedef.name], - Type = D#typedef.typespec, - InnerType = asn1ct_gen:get_inner(Type#type.def), - OTag = Type#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - emit([nl,nl,"%%================================"]), - emit([nl,"%% ",Typename]), - emit([nl,"%%================================",nl]), - case lists:member(InnerType,['SET','SEQUENCE']) of - true -> - case get(asn_keyed_list) of - true -> - CompList = - case Type#type.def of - #'SEQUENCE'{components=Cl} -> Cl; - #'SET'{components=Cl} -> Cl - end, - - emit([nl,"'enc_",asn1ct_gen:list2name(Typename), - "'(Val, TagIn) when is_list(Val) ->",nl]), - emit([" 'enc_",asn1ct_gen:list2name(Typename), - "'(?RT_BER:fixoptionals(", - {asis,optionals(CompList)}, - ",Val), TagIn);",nl,nl]); - _ -> true - end; - _ -> - emit({nl,"'enc_",asn1ct_gen:list2name(Typename), - "'({'",asn1ct_gen:list2name(Typename),"',Val}, TagIn) ->",nl}), - emit({" 'enc_",asn1ct_gen:list2name(Typename),"'(Val, TagIn);",nl,nl}) - end, - emit({"'enc_",asn1ct_gen:list2name(Typename),"'(", - unused_var("Val",Type#type.def),", TagIn) ->",nl}), - CurrentMod = get(currmod), - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> - asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,D); - {primitive,bif} -> - asn1ct_gen_ber:gen_encode_prim(ber,Type,["TagIn ++ ", - {asis,Tag}],"Val"), - emit([".",nl]); - #typereference{val=Ename} -> - emit([" 'enc_",Ename,"'(Val, TagIn ++ ",{asis,Tag},").",nl]); - #'Externaltypereference'{module=CurrentMod,type=Etype} -> - emit([" 'enc_",Etype,"'(Val, TagIn ++ ", - {asis,Tag},").",nl]); - #'Externaltypereference'{module=Emod,type=Etype} -> - emit([" '",Emod,"':'enc_",Etype,"'(Val, TagIn ++ ", - {asis,Tag},").",nl]); - 'ASN1_OPEN_TYPE' -> - emit(["%% OPEN TYPE",nl]), - asn1ct_gen_ber:gen_encode_prim(ber, - Type#type{def='ASN1_OPEN_TYPE'}, - ["TagIn ++ ", - {asis,Tag}],"Val"), - emit([".",nl]) - end. - -unused_var(Var,#'SEQUENCE'{components=Cl}) -> - unused_var1(Var,Cl); -unused_var(Var,#'SET'{components=Cl}) -> - unused_var1(Var,Cl); -unused_var(Var,_) -> - Var. -unused_var1(Var,Cs) when Cs == []; Cs == {[],[]} -> - lists:concat(["_",Var]); -unused_var1(Var,_) -> - Var. - -unused_optormand_var(Var,Def) -> - case asn1ct_gen:type(asn1ct_gen:get_inner(Def)) of - 'ASN1_OPEN_TYPE' -> - lists:concat(["_",Var]); - _ -> - Var - end. - - -gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> - -%%% 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 - 'BOOLEAN' -> - emit_encode_func('boolean',Value,DoTag); - 'INTEGER' -> - emit_encode_func('integer',Constraint,Value,DoTag); - {'INTEGER',NamedNumberList} -> - emit_encode_func('integer',Constraint,Value, - NamedNumberList,DoTag); - {'ENUMERATED',NamedNumberList={_,_}} -> - - emit(["case (case ",Value," of {_,",{curr,enumval},"}->", - {curr,enumval},";_->", Value," end) of",nl]), - asn1ct_name:new(enumval), - emit_enc_enumerated_cases(NamedNumberList,DoTag); - {'ENUMERATED',NamedNumberList} -> - - emit(["case (case ",Value," of {_,",{curr,enumval},"}->", - {curr,enumval},";_->", Value," end) of",nl]), - asn1ct_name:new(enumval), - emit_enc_enumerated_cases(NamedNumberList,DoTag); - - 'REAL' -> - emit_encode_func('real',Constraint,Value,DoTag); - - {'BIT STRING',NamedNumberList} -> - emit_encode_func('bit_string',BitStringConstraint,Value, - NamedNumberList,DoTag); - 'ANY' -> - emit_encode_func('open_type', Value,DoTag); - 'NULL' -> - emit_encode_func('null',Value,DoTag); - 'OBJECT IDENTIFIER' -> - emit_encode_func("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); - 'UniversalString' -> - emit_encode_func('universal_string',Constraint,Value,DoTag); - 'UTF8String' -> - emit_encode_func('UTF8_string',Constraint,Value,DoTag); - 'BMPString' -> - emit_encode_func('BMP_string',Constraint,Value,DoTag); - 'UTCTime' -> - emit_encode_func('utc_time',Constraint,Value,DoTag); - 'GeneralizedTime' -> - emit_encode_func('generalized_time',Constraint,Value,DoTag); - 'ASN1_OPEN_TYPE' -> - emit_encode_func('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}) - 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,"{asn1_enum,",{curr,enumval},"} -> ", -%% "?RT_BER:encode_enumerated(",{curr,enumval},",",Tags,");",nl]), -%% asn1ct_name:new(enumval) - emit([";",nl]) - end, - emit([{curr,enumval}," -> exit({error,{asn1, {enumerated_not_in_range,",{curr, enumval},"}}})"]), - emit([nl,"end"]). - - -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== -%% Generate DECODING -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== - -%%=============================================================================== -%% decode #{typedef, {pos, name, typespec}} -%%=============================================================================== - -gen_decode(Erules,Type) when is_record(Type,typedef) -> - D = Type, - emit({nl,nl}), - emit({"'dec_",Type#typedef.name,"'(Bytes, OptOrMand) ->",nl}), - emit({" 'dec_",Type#typedef.name,"'(Bytes, OptOrMand, []).",nl,nl}), - emit({"'dec_",Type#typedef.name,"'(Bytes, ", - unused_optormand_var("OptOrMand",(Type#typedef.typespec)#type.def),", TagIn) ->",nl}), - dbdec(Type#typedef.name), - gen_decode_user(Erules,D). - - -%%=============================================================================== -%% decode #{type, {tag, def, constraint}} -%%=============================================================================== - -gen_decode(Erules,Tname,Type) when is_record(Type,type) -> - Typename = Tname, - InnerType = asn1ct_gen:get_inner(Type#type.def), - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> - ObjFun = - case Type#type.tablecinf of - [{objfun,_}|_R] -> - ", ObjFun"; - _ -> - "" - end, - emit({"'dec_",asn1ct_gen:list2name(Typename),"'(Bytes, OptOrMand, TagIn",ObjFun,") ->",nl}), - dbdec(Typename), - asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,Type); - _ -> - true - end; - - -%%=============================================================================== -%% decode ComponentType -%%=============================================================================== - -gen_decode(Erules,Tname,#'ComponentType'{name=Cname,typespec=Type}) -> - NewTname = [Cname|Tname], - %% The tag is set to [] to avoid that it is - %% taken into account twice, both as a component/alternative (passed as - %% argument to the encode decode function and within the encode decode - %% function it self. - NewType = Type#type{tag=[]}, - gen_decode(Erules,NewTname,NewType). - - -gen_decode_user(Erules,D) when is_record(D,typedef) -> - Typename = [D#typedef.name], - Def = D#typedef.typespec, - InnerType = asn1ct_gen:get_inner(Def#type.def), - InnerTag = Def#type.tag , - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- InnerTag], - case asn1ct_gen:type(InnerType) of - 'ASN1_OPEN_TYPE' -> - BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)), - asn1ct_name:new(len), - gen_dec_prim(Erules, Def#type{def='ASN1_OPEN_TYPE'}, - BytesVar, Tag, "TagIn",no_length, - ?PRIMITIVE,"OptOrMand"), - emit({".",nl,nl}); - {primitive,bif} -> - BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)), - asn1ct_name:new(len), - gen_dec_prim(Erules, Def, BytesVar, Tag, "TagIn",no_length, - ?PRIMITIVE,"OptOrMand"), - emit({".",nl,nl}); - {constructed,bif} -> - asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,D); - TheType -> - DecFunName = mkfuncname(TheType,dec), - emit({DecFunName,"(",{curr,bytes}, - ", OptOrMand, TagIn++",{asis,Tag},")"}), - emit({".",nl,nl}) - end. - - -gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Length,Form,OptOrMand) -> - Typename = Att#type.def, -%% Currently not used for BER replaced with [] as place holder -%% Constraint = Att#type.constraint, -%% Constraint = [], - Constraint = - case get_constraint(Att#type.constraint,'SizeConstraint') of - no -> []; - Tc -> Tc - end, - ValueRange = - case get_constraint(Att#type.constraint,'ValueRange') of - no -> []; - Tv -> Tv - end, - SingleValue = - case get_constraint(Att#type.constraint,'SingleValue') of - no -> []; - Sv -> Sv - end, - AsBin = case get(binary_strings) of - true -> "_as_bin"; - _ -> "" - end, - NewTypeName = case Typename of - 'ANY' -> 'ASN1_OPEN_TYPE'; - _ -> Typename - end, - DoLength = - case NewTypeName of - 'BOOLEAN'-> - emit({"?RT_BER:decode_boolean(",BytesVar,","}), - false; - 'INTEGER' -> - emit({"?RT_BER:decode_integer(",BytesVar,",", - {asis,int_constr(SingleValue,ValueRange)},","}), - false; - {'INTEGER',NamedNumberList} -> - emit({"?RT_BER:decode_integer(",BytesVar,",", - {asis,int_constr(SingleValue,ValueRange)},",", - {asis,NamedNumberList},","}), - false; - {'ENUMERATED',NamedNumberList} -> - emit({"?RT_BER:decode_enumerated(",BytesVar,",", - {asis,Constraint},",", - {asis,NamedNumberList},","}), - false; - 'REAL' -> - emit({"?RT_BER:decode_real(",BytesVar,",", - {asis,Constraint},","}), - false; - {'BIT STRING',NamedNumberList} -> - case get(compact_bit_string) of - true -> - emit({"?RT_BER:decode_compact_bit_string(", - BytesVar,",",{asis,Constraint},",", - {asis,NamedNumberList},","}); - _ -> - emit({"?RT_BER:decode_bit_string(",BytesVar,",", - {asis,Constraint},",", - {asis,NamedNumberList},","}) - end, - true; - 'NULL' -> - emit({"?RT_BER:decode_null(",BytesVar,","}), - false; - 'OBJECT IDENTIFIER' -> - emit({"?RT_BER:decode_object_identifier(",BytesVar,","}), - false; - 'RELATIVE-OID' -> - emit({"?RT_BER:decode_relative_oid(",BytesVar,","}), - false; - 'ObjectDescriptor' -> - emit({"?RT_BER:decode_restricted_string(", - BytesVar,",",{asis,Constraint},",",{asis,?T_ObjectDescriptor},","}), - true; - 'OCTET STRING' -> - emit({"?RT_BER:decode_octet_string",AsBin,"(",BytesVar,",",{asis,Constraint},","}), - true; - 'NumericString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_NumericString},","}),true; - TString when TString == 'TeletexString'; - TString == 'T61String' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_TeletexString},","}), - true; - 'VideotexString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_VideotexString},","}), - true; - 'GraphicString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_GraphicString},","}) - ,true; - 'VisibleString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_VisibleString},","}), - true; - 'GeneralString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_GeneralString},","}), - true; - 'PrintableString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_PrintableString},","}), - true; - 'IA5String' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_IA5String},","}), - true; - 'UniversalString' -> - emit({"?RT_BER:decode_universal_string",AsBin,"(", - BytesVar,",",{asis,Constraint},","}), - true; - 'UTF8String' -> - emit({"?RT_BER:decode_UTF8_string",AsBin,"(", - BytesVar,","}), - false; - 'BMPString' -> - emit({"?RT_BER:decode_BMP_string",AsBin,"(", - BytesVar,",",{asis,Constraint},","}), - true; - 'UTCTime' -> - emit({"?RT_BER:decode_utc_time",AsBin,"(", - BytesVar,",",{asis,Constraint},","}), - true; - 'GeneralizedTime' -> - emit({"?RT_BER:decode_generalized_time",AsBin,"(", - BytesVar,",",{asis,Constraint},","}), - true; - 'ASN1_OPEN_TYPE' -> - emit(["?RT_BER:decode_open_type(",re_wrap_erule(Erules),",", - BytesVar,","]), - false; - #'ObjectClassFieldType'{} -> - case asn1ct_gen:get_inner(Att#type.def) of - {fixedtypevaluefield,_,InnerType} -> - gen_dec_prim(Erules,InnerType,BytesVar,DoTag,TagIn,Length,Form,OptOrMand), - false; - 'ASN1_OPEN_TYPE' -> - emit(["?RT_BER:decode_open_type(", - re_wrap_erule(Erules),",", - BytesVar,","]), - false; - XX -> - exit({'can not decode' ,XX}) - end; - Other -> - exit({'can not decode' ,Other}) - end, - - NewLength = case DoLength of - true -> [", ", Length]; - false -> "" - end, - NewOptOrMand = case OptOrMand of - _ when is_list(OptOrMand) -> OptOrMand; - mandatory -> {asis,mandatory}; - _ -> {asis,opt_or_default} - end, - case {TagIn,NewTypeName} of - {_,#'ObjectClassFieldType'{}} -> - case asn1ct_gen:get_inner(Att#type.def) of - 'ASN1_OPEN_TYPE' -> - emit([{asis,DoTag},")"]); - _ -> ok - end; - {[],'ASN1_OPEN_TYPE'} -> - emit([{asis,DoTag},")"]); - {_,'ASN1_OPEN_TYPE'} -> - emit([TagIn,"++",{asis,DoTag},")"]); - {[],_} -> - emit([{asis,DoTag},NewLength,", ",NewOptOrMand,")"]); - _ when is_list(TagIn) -> - emit([TagIn,"++",{asis,DoTag},NewLength,", ",NewOptOrMand,")"]) - end. - - -int_constr([],[]) -> - []; -int_constr([],ValueRange) -> - ValueRange; -int_constr(SingleValue,[]) -> - SingleValue; -int_constr(SV,VR) -> - [SV,VR]. - -%% Object code generating for encoding and decoding -%% ------------------------------------------------ - -gen_obj_code(Erules,_Module,Obj) when is_record(Obj,typedef) -> - ObjName = Obj#typedef.name, - Def = Obj#typedef.typespec, - #'Externaltypereference'{module=M,type=ClName} = Def#'Object'.classname, - Class = asn1_db:dbget(M,ClName), - - {object,_,Fields} = Def#'Object'.def, - emit({nl,nl,nl,"%%================================"}), - emit({nl,"%% ",ObjName}), - emit({nl,"%%================================",nl}), - EncConstructed = - gen_encode_objectfields(ClName,get_class_fields(Class), - ObjName,Fields,[]), - emit(nl), - gen_encode_constr_type(Erules,EncConstructed), - emit(nl), - DecConstructed = - gen_decode_objectfields(ClName,get_class_fields(Class), - ObjName,Fields,[]), - emit(nl), - gen_decode_constr_type(Erules,DecConstructed); -gen_obj_code(_Erules,_Module,Obj) when is_record(Obj,pobjectdef) -> - ok. - - -gen_encode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest], - ObjName,ObjectFields,ConstrAcc) -> - EmitFuncClause = - fun(Args) -> - emit(["'enc_",ObjName,"'(",{asis,Name}, - ", ",Args,", _RestPrimFieldName) ->",nl]) - end, -% emit(["'enc_",ObjName,"'(",{asis,Name}, -% ", Val, TagIn, _RestPrimFieldName) ->",nl]), - MaybeConstr= - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> %% this case is illegal - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> %% OPTIONAL field in class - EmitFuncClause("Val, _"), %% Value must be anything - %% already encoded - emit([" {Val,0}"]), - []; - {false,{'DEFAULT',DefaultType}} -> - EmitFuncClause("Val, TagIn"), - gen_encode_default_call(ClassName,Name,DefaultType); - {{Name,TypeSpec},_} -> - %% A specified field owerwrites any 'DEFAULT' or - %% 'OPTIONAL' field in the class - EmitFuncClause("Val, TagIn"), - gen_encode_field_call(ObjName,Name,TypeSpec) - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_encode_objectfields(ClassName,Rest,ObjName,ObjectFields, - MaybeConstr++ConstrAcc); -gen_encode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest], - ObjName,ObjectFields,ConstrAcc) -> - CurrentMod = get(currmod), - EmitFuncClause = - fun(Args) -> - emit(["'enc_",ObjName,"'(",{asis,Name}, - ", ",Args,") ->",nl]) - end, -% emit(["'enc_",ObjName,"'(",{asis,Name}, -% ", Val, TagIn, [H|T]) ->",nl]), - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause("_,_,_"), - emit([" exit({error,{'use of missing field in object', ",{asis,Name}, - "}})"]); - {false,{'DEFAULT',_DefaultObject}} -> - exit({error,{asn1,{"not implemented yet",Name}}}); - {{Name,#'Externalvaluereference'{module=CurrentMod, - value=TypeName}},_} -> - EmitFuncClause(" Val, TagIn, [H|T]"), - emit({indent(3),"'enc_",TypeName,"'(H, Val, TagIn, T)"}); - {{Name,#'Externalvaluereference'{module=M,value=TypeName}},_} -> - EmitFuncClause(" Val, TagIn, [H|T]"), - emit({indent(3),"'",M,"':'enc_",TypeName,"'(H, Val, TagIn, T)"}); - {{Name,TypeSpec},_} -> - EmitFuncClause(" Val, TagIn, [H|T]"), - case TypeSpec#typedef.name of - {ExtMod,TypeName} -> - emit({indent(3),"'",ExtMod,"':'enc_",TypeName, - "'(H, Val, TagIn, T)"}); - TypeName -> - emit({indent(3),"'enc_",TypeName,"'(H, Val, TagIn, T)"}) - end - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_encode_objectfields(ClassName,Rest,ObjName,ObjectFields,ConstrAcc); -gen_encode_objectfields(ClassName,[_|Cs],O,OF,Acc) -> - gen_encode_objectfields(ClassName,Cs,O,OF,Acc); -gen_encode_objectfields(_,[],_,_,Acc) -> - Acc. - - -% gen_encode_objectfields(Class,ObjName,[{FieldName,Type}|Rest],ConstrAcc) -> -% Fields = Class#objectclass.fields, -% MaybeConstr= -% case is_typefield(Fields,FieldName) of -% true -> -% Def = Type#typedef.typespec, -% OTag = Def#type.tag, -% Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], -% emit({"'enc_",ObjName,"'(",{asis,FieldName}, -% ", Val, TagIn, RestPrimFieldName) ->",nl}), -% CAcc= -% case Type#typedef.name of -% {primitive,bif} -> -% gen_encode_prim(ber,Def,["TagIn ++ ",{asis,Tag}], -% "Val"), -% []; -% {constructed,bif} -> -% %%InnerType = asn1ct_gen:get_inner(Def#type.def), -% %%asn1ct_gen:gen_encode_constructed(ber,[ObjName], -% %% InnerType,Def); -% emit({" 'enc_",ObjName,'_',FieldName, -% "'(Val, TagIn ++ ",{asis,Tag},")"}), -% [{['enc_',ObjName,'_',FieldName],Def}]; -% {ExtMod,TypeName} -> -% emit({" '",ExtMod,"':'enc_",TypeName, -% "'(Val, TagIn ++ ",{asis,Tag},")"}), -% []; -% TypeName -> -% emit({" 'enc_",TypeName,"'(Val, TagIn ++ ", -% {asis,Tag},")"}), -% [] -% end, -% case more_genfields(Fields,Rest) of -% true -> -% emit({";",nl}); -% false -> -% emit({".",nl}) -% end, -% CAcc; -% {false,objectfield} -> -% emit({"'enc_",ObjName,"'(",{asis,FieldName}, -% ", Val, TagIn, [H|T]) ->",nl}), -% case Type#typedef.name of -% {ExtMod,TypeName} -> -% emit({indent(3),"'",ExtMod,"':'enc_",TypeName, -% "'(H, Val, TagIn, T)"}); -% TypeName -> -% emit({indent(3),"'enc_",TypeName,"'(H, Val, TagIn, T)"}) -% end, -% case more_genfields(Fields,Rest) of -% true -> -% emit({";",nl}); -% false -> -% emit({".",nl}) -% end, -% []; -% {false,_} -> [] -% end, -% gen_encode_objectfields(Class,ObjName,Rest,MaybeConstr ++ ConstrAcc); -% gen_encode_objectfields(C,O,[H|T],Acc) -> -% gen_encode_objectfields(C,O,T,Acc); -% gen_encode_objectfields(_,_,[],Acc) -> -% Acc. - -% gen_encode_constr_type([{Name,Def}|Rest]) -> -% emit({Name,"(Val,TagIn) ->",nl}), -% InnerType = asn1ct_gen:get_inner(Def#type.def), -% asn1ct_gen:gen_encode_constructed(ber,Name,InnerType,Def), -% gen_encode_constr_type(Rest); -gen_encode_constr_type(Erules,[TypeDef|Rest]) when is_record(TypeDef,typedef) -> - case is_already_generated(enc,TypeDef#typedef.name) of - true -> ok; - _ -> gen_encode_user(Erules,TypeDef) - end, - gen_encode_constr_type(Erules,Rest); -gen_encode_constr_type(_,[]) -> - ok. - -gen_encode_field_call(_ObjName,_FieldName, - #'Externaltypereference'{module=M,type=T}) -> - CurrentMod = get(currmod), - TDef = asn1_db:dbget(M,T), - Def = TDef#typedef.typespec, - OTag = Def#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - if - M == CurrentMod -> - emit({" 'enc_",T,"'(Val, TagIn ++ ",{asis,Tag},")"}), - []; - true -> - emit({" '",M,"':'enc_",T,"'(Val, TagIn ++ ",{asis,Tag},")"}), - [] - end; -gen_encode_field_call(ObjName,FieldName,Type) -> - Def = Type#typedef.typespec, - OTag = Def#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - case Type#typedef.name of - {primitive,bif} -> %%tag should be the primitive tag - gen_encode_prim(ber,Def,["TagIn ++ ",{asis,Tag}], - "Val"), - []; - {constructed,bif} -> - emit({" 'enc_",ObjName,'_',FieldName, - "'(Val, TagIn ++",{asis,Tag},")"}), - [Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}]; - {ExtMod,TypeName} -> - emit({" '",ExtMod,"':'enc_",TypeName, - "'(Val, TagIn ++ ",{asis,Tag},")"}), - []; - TypeName -> - emit({" 'enc_",TypeName,"'(Val, TagIn ++ ",{asis,Tag},")"}), - [] - end. - -gen_encode_default_call(ClassName,FieldName,Type) -> - CurrentMod = get(currmod), - InnerType = asn1ct_gen:get_inner(Type#type.def), - OTag = Type#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> -%% asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,Type); - emit([" 'enc_",ClassName,'_',FieldName,"'(Bytes, TagIn ++ ", - {asis,Tag},")"]), - [#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])), - typespec=Type}]; - {primitive,bif} -> - gen_encode_prim(ber,Type,["TagIn ++ ",{asis,Tag}],"Val"), - []; - #'Externaltypereference'{module=CurrentMod,type=Etype} -> - emit([" 'enc_",Etype,"'(Val, TagIn ++ ",{asis,Tag},")",nl]), - []; - #'Externaltypereference'{module=Emod,type=Etype} -> - emit([" '",Emod,"':'enc_",Etype,"'(Val, TagIn ++ ",{asis,Tag},")",nl]), - [] - end. - - - -gen_decode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest], - ObjName,ObjectFields,ConstrAcc) -> - EmitFuncClause = - fun(Args) -> - emit(["'dec_",ObjName,"'(",{asis,Name}, - ", ",Args,"_) ->",nl]) - end, -% emit(["'dec_",ObjName,"'(",{asis,Name}, -% ", Bytes, TagIn, RestPrimFieldName) ->",nl]), - MaybeConstr= - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> %% this case is illegal - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause("Bytes, _,"), -% emit([" asn1_NOVALUE"]), - emit([" {Bytes,[],0}"]), - []; - {false,{'DEFAULT',DefaultType}} -> - EmitFuncClause("Bytes, TagIn,"), - gen_decode_default_call(ClassName,Name,"Bytes",DefaultType); - {{Name,TypeSpec},_} -> - %% A specified field owerwrites any 'DEFAULT' or - %% 'OPTIONAL' field in the class - EmitFuncClause("Bytes, TagIn,"), - gen_decode_field_call(ObjName,Name,"Bytes",TypeSpec) - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_decode_objectfields(ClassName,Rest,ObjName,ObjectFields,MaybeConstr++ConstrAcc); -gen_decode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest], - ObjName,ObjectFields,ConstrAcc) -> - CurrentMod = get(currmod), - EmitFuncClause = - fun(Args) -> - emit(["'dec_",ObjName,"'(",{asis,Name}, - ", ",Args,") ->",nl]) - end, -% emit(["'dec_",ObjName,"'(",{asis,Name}, -% ", Bytes,TagIn,[H|T]) ->",nl]), - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause("_,_,_"), - emit([" exit({error,{'illegal use of missing field in object', ",{asis,Name}, - "}})"]); - {false,{'DEFAULT',_DefaultObject}} -> - exit({error,{asn1,{"not implemented yet",Name}}}); - {{Name,#'Externalvaluereference'{module=CurrentMod, - value=TypeName}},_} -> - EmitFuncClause("Bytes,TagIn,[H|T]"), - emit({indent(3),"'dec_",TypeName,"'(H, Bytes, TagIn, T)"}); - {{Name,#'Externalvaluereference'{module=M,value=TypeName}},_} -> - EmitFuncClause("Bytes,TagIn,[H|T]"), - emit({indent(3),"'",M,"':'dec_",TypeName, - "'(H, Bytes, TagIn, T)"}); - {{Name,TypeSpec},_} -> - EmitFuncClause("Bytes,TagIn,[H|T]"), - case TypeSpec#typedef.name of - {ExtMod,TypeName} -> - emit({indent(3),"'",ExtMod,"':'dec_",TypeName, - "'(H, Bytes, TagIn, T)"}); - TypeName -> - emit({indent(3),"'dec_",TypeName,"'(H, Bytes, TagIn, T)"}) - end - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_decode_objectfields(ClassName,Rest,ObjName,ObjectFields,ConstrAcc); -gen_decode_objectfields(CN,[_|Cs],O,OF,CAcc) -> - gen_decode_objectfields(CN,Cs,O,OF,CAcc); -gen_decode_objectfields(_,[],_,_,CAcc) -> - CAcc. - - -gen_decode_constr_type(Erules,[TypeDef|Rest]) when is_record(TypeDef,typedef) -> - case is_already_generated(dec,TypeDef#typedef.name) of - true -> ok; - _ -> - gen_decode(Erules,TypeDef) - end, - gen_decode_constr_type(Erules,Rest); -gen_decode_constr_type(_,[]) -> - ok. - -gen_decode_field_call(_ObjName,_FieldName,Bytes, - #'Externaltypereference'{module=M,type=T}) -> - CurrentMod = get(currmod), - TDef = asn1_db:dbget(M,T), - Def = TDef#typedef.typespec, - OTag = Def#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - if - M == CurrentMod -> - emit({" 'dec_",T,"'(",Bytes, - ", opt_or_default,TagIn ++ ",{asis,Tag},")"}), - []; - true -> - emit({" '",M,"':'dec_",T, - "'(",Bytes,", opt_or_default,TagIn ++ ",{asis,Tag},")"}), - [] - end; -gen_decode_field_call(ObjName,FieldName,Bytes,Type) -> - Def = Type#typedef.typespec, - OTag = Def#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - case Type#typedef.name of - {primitive,bif} -> %%tag should be the primitive tag - gen_dec_prim(ber,Def,Bytes,Tag,"TagIn",no_length, - ?PRIMITIVE,opt_or_default), - []; - {constructed,bif} -> - emit({" 'dec_",ObjName,'_',FieldName, - "'(",Bytes,",opt_or_default, TagIn ++ ",{asis,Tag},")"}), - [Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}]; - {ExtMod,TypeName} -> - emit({" '",ExtMod,"':'dec_",TypeName, - "'(",Bytes,", opt_or_default,TagIn ++ ",{asis,Tag},")"}), - []; - TypeName -> - emit({" 'dec_",TypeName,"'(",Bytes, - ", opt_or_default,TagIn ++ ",{asis,Tag},")"}), - [] - end. - -gen_decode_default_call(ClassName,FieldName,Bytes,Type) -> - CurrentMod = get(currmod), - InnerType = asn1ct_gen:get_inner(Type#type.def), - OTag = Type#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> - emit([" 'dec_",ClassName,'_',FieldName,"'(",Bytes, - ",opt_or_default, TagIn ++ ",{asis,Tag},")"]), - [#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])), - typespec=Type}]; - {primitive,bif} -> - gen_dec_prim(ber,Type,Bytes,Tag,"TagIn",no_length, - ?PRIMITIVE,opt_or_default), - []; - #'Externaltypereference'{module=CurrentMod,type=Etype} -> - emit([" 'dec_",Etype,"'(",Bytes, - " ,opt_or_default, TagIn ++ ",{asis,Tag},")",nl]), - []; - #'Externaltypereference'{module=Emod,type=Etype} -> - emit([" '",Emod,"':'dec_",Etype,"'(",Bytes, - ", opt_or_defualt, TagIn ++ ",{asis,Tag},")",nl]), - [] - end. - - -more_genfields([]) -> - false; -more_genfields([Field|Fields]) -> - case element(1,Field) of - typefield -> - true; - objectfield -> - true; - _ -> - more_genfields(Fields) - end. - - - -%% Object Set code generating for encoding and decoding -%% ---------------------------------------------------- -gen_objectset_code(Erules,ObjSet) -> - ObjSetName = ObjSet#typedef.name, - Def = ObjSet#typedef.typespec, -% {ClassName,ClassDef} = Def#'ObjectSet'.class, - #'Externaltypereference'{module=ClassModule, - type=ClassName} = Def#'ObjectSet'.class, - ClassDef = asn1_db:dbget(ClassModule,ClassName), - UniqueFName = Def#'ObjectSet'.uniquefname, - Set = Def#'ObjectSet'.set, - emit({nl,nl,nl,"%%================================"}), - emit({nl,"%% ",ObjSetName}), - emit({nl,"%%================================",nl}), - case ClassName of - {_Module,ExtClassName} -> - gen_objset_code(Erules,ObjSetName,UniqueFName,Set, - ExtClassName,ClassDef); - _ -> - gen_objset_code(Erules,ObjSetName,UniqueFName,Set, - ClassName,ClassDef) - end, - emit(nl). - -gen_objset_code(Erules,ObjSetName,UniqueFName,Set,ClassName,ClassDef)-> - ClassFields = (ClassDef#classdef.typespec)#objectclass.fields, - InternalFuncs=gen_objset_enc(ObjSetName,UniqueFName,Set,ClassName,ClassFields,1,[]), - gen_objset_dec(Erules,ObjSetName,UniqueFName,Set,ClassName,ClassFields,1), - gen_internal_funcs(Erules,InternalFuncs). - - -%% gen_objset_enc iterates over the objects of the object set -gen_objset_enc(_,{unique,undefined},_,_,_,_,_) -> - %% There is no unique field in the class of this object set - %% don't bother about the constraint - []; -gen_objset_enc(ObjSName,UniqueName,[{_,no_unique_value,_},T|Rest], - ClName,ClFields,NthObj,Acc) -> - %% No need to check that this class has property OPTIONAL for the - %% unique field, it was detected in the previous phase - gen_objset_enc(ObjSName,UniqueName,[T|Rest],ClName,ClFields,NthObj,Acc); -gen_objset_enc(ObjSetName,UniqueName,[{_,no_unique_value,_}], - _ClName,_ClFields,_NthObj,Acc) -> - %% No need to check that this class has property OPTIONAL for the - %% unique field, it was detected in the previous phase - emit_default_getenc(ObjSetName,UniqueName), - emit({".",nl,nl}), - Acc; -gen_objset_enc(ObjSName,UniqueName, - [{ObjName,Val,Fields},T|Rest],ClName,ClFields,NthObj,Acc)-> - emit({"'getenc_",ObjSName,"'(",{asis,UniqueName},",",{asis,Val},") ->",nl}), - CurrMod = get(currmod), - {InternalFunc,NewNthObj}= - case ObjName of - {no_mod,no_name} -> - gen_inlined_enc_funs(Fields,ClFields,ObjSName,NthObj); - {CurrMod,Name} -> - emit({" fun 'enc_",Name,"'/4"}), - {[],NthObj}; - {ModuleName,Name} -> - emit_ext_fun(enc,ModuleName,Name), -% emit([" {'",ModuleName,"', 'enc_",Name,"'}"]), - {[],NthObj}; - _Other -> - emit({" fun 'enc_",ObjName,"'/4"}), - {[],NthObj} - end, - emit({";",nl}), - gen_objset_enc(ObjSName,UniqueName,[T|Rest],ClName,ClFields, - NewNthObj,InternalFunc ++ Acc); -gen_objset_enc(ObjSetName,UniqueName, - [{ObjName,Val,Fields}],_ClName,ClFields,NthObj,Acc) -> - emit({"'getenc_",ObjSetName,"'(",{asis,UniqueName},",",{asis,Val},") ->",nl}), - CurrMod = get(currmod), - {InternalFunc,_}= - case ObjName of - {no_mod,no_name} -> - gen_inlined_enc_funs(Fields,ClFields,ObjSetName,NthObj); - {CurrMod,Name} -> - emit({" fun 'enc_",Name,"'/4"}), - {[],NthObj}; - {ModuleName,Name} -> - emit_ext_fun(enc,ModuleName,Name), -% emit([" {'",ModuleName,"', 'enc_",Name,"'}"]), - {[],NthObj}; - _Other -> - emit({" fun 'enc_",ObjName,"'/4"}), - {[],NthObj} - end, - emit([";",nl]), - emit_default_getenc(ObjSetName,UniqueName), - emit({".",nl,nl}), - InternalFunc ++ Acc; -%% See X.681 Annex E for the following case -gen_objset_enc(ObjSetName,_UniqueName,['EXTENSIONMARK'], - _ClName,_ClFields,_NthObj,Acc) -> - emit({"'getenc_",ObjSetName,"'(_, _) ->",nl}), - emit({indent(3),"fun(_Attr, Val, _TagIn, _RestPrimFieldName) ->",nl}), - emit({indent(6),"Len = case Val of",nl,indent(9), - "Bin when is_binary(Bin) -> size(Bin);",nl,indent(9), - "_ -> length(Val)",nl,indent(6),"end,"}), - emit({indent(6),"{Val,Len}",nl}), - emit({indent(3),"end.",nl,nl}), - Acc; -gen_objset_enc(ObjSetName,UniqueName,['EXTENSIONMARK','EXTENSIONMARK'|Rest], - ClName,ClFields,NthObj,Acc) -> - gen_objset_enc(ObjSetName,UniqueName,['EXTENSIONMARK'|Rest], - ClName,ClFields,NthObj,Acc); -gen_objset_enc(ObjSetName,UniqueName,['EXTENSIONMARK'|Rest], - ClName,ClFields,NthObj,Acc) -> - gen_objset_enc(ObjSetName,UniqueName,Rest++['EXTENSIONMARK'], - ClName,ClFields,NthObj,Acc); -gen_objset_enc(_,_,[],_,_,_,Acc) -> - Acc. - -emit_ext_fun(EncDec,ModuleName,Name) -> - emit([indent(3),"fun(T,V,_O1,_O2) -> '",ModuleName,"':'",EncDec,"_", - Name,"'(T,V,_O1,_O2) end"]). - -emit_default_getenc(ObjSetName,UniqueName) -> - emit(["'getenc_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]), - emit([indent(3),"fun(C,V,_,_) -> exit({'Type not compatible with table constraint',{component,C},{value,V}, {unique_name_and_value,",{asis,UniqueName},", ErrV}}) end"]). - -%% gen_inlined_enc_funs for each object iterates over all fields of a -%% class, and for each typefield it checks if the object has that -%% field and emits the proper code. -gen_inlined_enc_funs(Fields,[{typefield,Name,_}|Rest],ObjSetName, - NthObj) -> - CurrMod = get(currmod), - InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]), - case lists:keysearch(Name,1,Fields) of - {value,{_,Type}} when is_record(Type,type) -> - emit({indent(3),"fun(Type, Val, TagIn, _RestPrimFieldName) ->",nl, - indent(6),"case Type of",nl}), - {Ret,N} = emit_inner_of_fun(Type,InternalDefFunName), - gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+N,Ret); - {value,{_,Type}} when is_record(Type,typedef) -> - emit({indent(3),"fun(Type, Val, TagIn, _RestPrimFieldName) ->",nl, - indent(6),"case Type of",nl}), - emit({indent(9),{asis,Name}," ->",nl}), - {Ret,N} = emit_inner_of_fun(Type,InternalDefFunName), - gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+N,Ret); - {value,{_,#'Externaltypereference'{module=M,type=T}}} -> - #typedef{typespec=Type} = asn1_db:dbget(M,T), - OTag = Type#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - emit([indent(3),"fun(Type, Val, TagIn, _RestPrimFieldName) ->",nl, - indent(6),"case Type of",nl]), - emit([indent(9),{asis,Name}," ->",nl]), - if - M == CurrMod -> - emit([indent(12),"'enc_",T,"'(Val, TagIn ++ ", - {asis,Tag},")"]); - true -> - emit([indent(12),"'",M,"':'enc_",T,"'(Val,TagIn ++", - {asis,Tag},")"]) - end, - gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj,[]); - false -> - %% This field was not present in the object thus there were no - %% type in the table and we therefore generate code that returns - %% the input for application treatment. - emit([indent(3),"fun(Type, Val, TagIn, _RestPrimFieldName) ->",nl, - indent(6),"case Type of",nl]), - emit([indent(9),{asis,Name}," ->",nl]), - emit([indent(12),"Len = case Val of",nl, - indent(15),"Bin when is_binary(Bin) -> size(Bin);",nl, - indent(15),"_ -> length(Val)",nl,indent(12),"end,",nl, - indent(12),"{Val,Len}"]), - gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj,[]) - end; -gen_inlined_enc_funs(Fields,[_H|Rest],ObjSetName,NthObj) -> - gen_inlined_enc_funs(Fields,Rest,ObjSetName,NthObj); -gen_inlined_enc_funs(_,[],_,NthObj) -> - {[],NthObj}. - -gen_inlined_enc_funs1(Fields,[{typefield,Name,_}|Rest],ObjSetName, - NthObj,Acc) -> - CurrMod = get(currmod), - InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]), - {Acc2,NAdd}= - case lists:keysearch(Name,1,Fields) of - {value,{_,Type}} when is_record(Type,type) -> - emit({";",nl}), - {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName), - {Ret++Acc,N}; - {value,{_,Type}} when is_record(Type,typedef) -> - emit({";",nl,indent(9),{asis,Name}," ->",nl}), - {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName), - {Ret++Acc,N}; - {value,{_,#'Externaltypereference'{module=M,type=T}}} -> - #typedef{typespec=Type} = asn1_db:dbget(M,T), - OTag = Type#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - emit({";",nl,indent(9),{asis,Name}," ->",nl}), - if - M == CurrMod -> - emit([indent(12),"'enc_",T,"'(Val, TagIn ++ ", - {asis,Tag},")"]); - true -> - emit([indent(12),"'",M,"':'enc_",T,"'(Val,TagIn ++", - {asis,Tag},")"]) - end, - {Acc,0}; - false -> - %% This field was not present in the object thus there were no - %% type in the table and we therefore generate code that returns - %% the input for application treatment. - emit([";",nl,indent(9),{asis,Name}," ->",nl]), - emit([indent(12),"Len = case Val of",nl, - indent(15),"Bin when is_binary(Bin) -> size(Bin);",nl, - indent(15),"_ -> length(Val)",nl,indent(12),"end,",nl, - indent(12),"{Val,Len}"]), - {Acc,0} - end, - gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+NAdd,Acc2); -gen_inlined_enc_funs1(Fields,[_H|Rest],ObjSetName,NthObj,Acc)-> - gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj,Acc); -gen_inlined_enc_funs1(_,[],_,NthObj,Acc) -> - emit({nl,indent(6),"end",nl}), - emit({indent(3),"end"}), - {Acc,NthObj}. - - -emit_inner_of_fun(TDef = #typedef{name={ExtMod,Name},typespec=Type}, - InternalDefFunName) -> - OTag = Type#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - case {ExtMod,Name} of - {primitive,bif} -> - emit(indent(12)), - gen_encode_prim(ber,Type,["TagIn ++ ",{asis,Tag}],"Val"), - {[],0}; - {constructed,bif} -> - emit([indent(12),"'enc_", - InternalDefFunName,"'(Val,TagIn ++ ", - {asis,Tag},")"]), - {[TDef#typedef{name=InternalDefFunName}],1}; - _ -> - emit({indent(12),"'",ExtMod,"':'enc_",Name,"'(Val, TagIn ++ ", - {asis,Tag},")"}), - {[],0} - end; -emit_inner_of_fun(#typedef{name=Name,typespec=Type},_) -> - OTag = Type#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - emit({indent(12),"'enc_",Name,"'(Val, TagIn ++ ",{asis,Tag},")"}), - {[],0}; -emit_inner_of_fun(Type,_) when is_record(Type,type) -> - CurrMod = get(currmod), - OTag = Type#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - case Type#type.def of - Def when is_atom(Def) -> - emit({indent(9),Def," ->",nl,indent(12)}), - gen_encode_prim(ber,Type,["TagIn ++ ",{asis,Tag}],"Val"); - TRef when is_record(TRef,typereference) -> - T = TRef#typereference.val, - emit({indent(9),T," ->",nl,indent(12),"'enc_",T, - "'(Val, TagIn ++ ",{asis,Tag},")"}); - #'Externaltypereference'{module=CurrMod,type=T} -> - emit({indent(9),T," ->",nl,indent(12),"'enc_",T, - "'(Val, TagIn ++ ",{asis,Tag},")"}); - #'Externaltypereference'{module=ExtMod,type=T} -> - emit({indent(9),T," ->",nl,indent(12),ExtMod,":'enc_", - T,"'(Val, TagIn ++ ",{asis,Tag},")"}) - end, - {[],0}. - -indent(N) -> - lists:duplicate(N,32). % 32 = space - - -gen_objset_dec(_,_,{unique,undefined},_,_,_,_) -> - %% There is no unique field in the class of this object set - %% don't bother about the constraint - ok; -gen_objset_dec(Erules,ObjSName,UniqueName,[{_,no_unique_value,_},T|Rest], - ClName,ClFields,NthObj)-> - gen_objset_dec(Erules,ObjSName,UniqueName,[T|Rest],ClName,ClFields, - NthObj); -gen_objset_dec(_Erules,ObjSetName,UniqueName,[{_,no_unique_value,_}], - _ClName,_ClFields,_NthObj)-> - emit_default_getdec(ObjSetName,UniqueName), - emit({".",nl,nl}); -gen_objset_dec(Erules,ObjSName,UniqueName,[{ObjName,Val,Fields},T|Rest], - ClName,ClFields,NthObj)-> - emit({"'getdec_",ObjSName,"'(",{asis,UniqueName},",",{asis,Val}, - ") ->",nl}), - CurrMod = get(currmod), - NewNthObj= - case ObjName of - {no_mod,no_name} -> - gen_inlined_dec_funs(Erules,Fields,ClFields,ObjSName, - NthObj); - {CurrMod,Name} -> - emit({" fun 'dec_",Name,"'/4"}), - NthObj; - {ModName,Name} -> - emit_ext_fun(dec,ModName,Name), -% emit([" {'",ModName,"', 'dec_",Name,"'}"]), - NthObj; - _Other -> - emit({" fun 'dec_",ObjName,"'/4"}), - NthObj - end, - emit({";",nl}), - gen_objset_dec(Erules,ObjSName,UniqueName,[T|Rest],ClName,ClFields, - NewNthObj); -gen_objset_dec(Erules,ObjSetName,UniqueName,[{ObjName,Val,Fields}],_ClName, - ClFields,NthObj) -> - emit({"'getdec_",ObjSetName,"'(",{asis,UniqueName},",",{asis,Val},") ->",nl}), - CurrMod = get(currmod), - case ObjName of - {no_mod,no_name} -> - gen_inlined_dec_funs(Erules,Fields,ClFields,ObjSetName, - NthObj); - {CurrMod,Name} -> - emit({" fun 'dec_",Name,"'/4"}); - {ModName,Name} -> - emit_ext_fun(dec,ModName,Name); -% emit([" {'",ModName,"', 'dec_",Name,"'}"]); - _Other -> - emit({" fun 'dec_",ObjName,"'/4"}) - end, - emit({";",nl}), - emit_default_getdec(ObjSetName,UniqueName), - emit({".",nl,nl}); -gen_objset_dec(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName,_ClFields, - _NthObj) -> - emit({"'getdec_",ObjSetName,"'(_, _) ->",nl}), - emit({indent(3),"fun(_, Bytes, _, _) ->",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(6),"{Bytes,[],Len}",nl}), - emit({indent(3),"end.",nl,nl}), - ok; -gen_objset_dec(Erule,ObjSetName,UniqueName, - ['EXTENSIONMARK','EXTENSIONMARK'|Rest], - ClName,ClFields,NthObj) -> - gen_objset_dec(Erule,ObjSetName,UniqueName,['EXTENSIONMARK'|Rest], - ClName,ClFields,NthObj); -gen_objset_dec(Erule,ObjSetName,UniqueName,['EXTENSIONMARK'|Rest], - ClName,ClFields,NthObj) -> - gen_objset_dec(Erule,ObjSetName,UniqueName,Rest++['EXTENSIONMARK'], - ClName,ClFields,NthObj); -gen_objset_dec(_,_,_,[],_,_,_) -> - ok. - -emit_default_getdec(ObjSetName,UniqueName) -> - emit(["'getdec_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]), - emit([indent(3),"fun(C,V,_,_) -> exit({{component,C},{value,V}, {unique_name_and_value,",{asis,UniqueName},", ErrV}}) end"]). - -gen_inlined_dec_funs(Erules,Fields,[{typefield,Name,Prop}|Rest], - ObjSetName,NthObj) -> - DecProp = case Prop of - 'OPTIONAL' -> opt_or_default; - {'DEFAULT',_} -> opt_or_default; - _ -> mandatory - end, - CurrMod = get(currmod), - InternalDefFunName = [NthObj,Name,ObjSetName], - case lists:keysearch(Name,1,Fields) of - {value,{_,Type}} when is_record(Type,type) -> - emit({indent(3),"fun(Type, Bytes, TagIn, _RestPrimFieldName) ->", - nl,indent(6),"case Type of",nl}), - N=emit_inner_of_decfun(Erules,Type,DecProp,InternalDefFunName), - gen_inlined_dec_funs1(Erules,Fields,Rest,ObjSetName,NthObj+N); - {value,{_,Type}} when is_record(Type,typedef) -> - emit({indent(3),"fun(Type, Bytes, TagIn, _RestPrimFieldName) ->", - nl,indent(6),"case Type of",nl}), - emit({indent(9),{asis,Name}," ->",nl}), - N=emit_inner_of_decfun(Erules,Type,DecProp,InternalDefFunName), - gen_inlined_dec_funs1(Erules,Fields,Rest,ObjSetName,NthObj+N); - {value,{_,#'Externaltypereference'{module=M,type=T}}} -> - #typedef{typespec=Type} = asn1_db:dbget(M,T), - OTag = Type#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - emit({indent(3),"fun(Type, Bytes, TagIn, _RestPrimFieldName) ->", - nl,indent(6),"case Type of",nl}), - emit({indent(9),{asis,Name}," ->",nl}), - if - M == CurrMod -> - emit([indent(12),"'dec_",T,"'(Bytes, ",DecProp, - ", TagIn ++ ",{asis,Tag},")"]); - true -> - emit([indent(12),"'",M,"':'dec_",T,"'(Bytes, ", - DecProp,", TagIn ++ ",{asis,Tag},")"]) - end, - gen_inlined_dec_funs1(Erules,Fields,Rest,ObjSetName,NthObj); - false -> - emit([indent(3),"fun(Type, Bytes, TagIn, _RestPrimFieldName) ->", - nl,indent(6),"case Type of",nl, - indent(9),{asis,Name}," ->",nl, - indent(12),"Len = case Bytes of",nl, - indent(15),"B when is_binary(B) -> size(B);",nl, - indent(15),"_ -> length(Bytes)",nl, - indent(12),"end,",nl, - indent(12),"{Bytes,[],Len}"]), - gen_inlined_dec_funs1(Erules,Fields,Rest,ObjSetName,NthObj) - end; -gen_inlined_dec_funs(Erules,Fields,[_H|Rest],ObjSetName,NthObj) -> - gen_inlined_dec_funs(Erules,Fields,Rest,ObjSetName,NthObj); -gen_inlined_dec_funs(_,_,[],_,NthObj) -> - NthObj. - -gen_inlined_dec_funs1(Erules,Fields,[{typefield,Name,Prop}|Rest], - ObjSetName,NthObj) -> - DecProp = case Prop of - 'OPTIONAL' -> opt_or_default; - {'DEFAULT',_} -> opt_or_default; - _ -> mandatory - end, - CurrMod = get(currmod), - InternalDefFunName = [NthObj,Name,ObjSetName], - N= - case lists:keysearch(Name,1,Fields) of - {value,{_,Type}} when is_record(Type,type) -> - emit({";",nl}), - emit_inner_of_decfun(Erules,Type,DecProp,InternalDefFunName); - {value,{_,Type}} when is_record(Type,typedef) -> - emit({";",nl,indent(9),{asis,Name}," ->",nl}), - emit_inner_of_decfun(Erules,Type,DecProp,InternalDefFunName); - {value,{_,#'Externaltypereference'{module=M,type=T}}} -> - #typedef{typespec=Type} = asn1_db:dbget(M,T), - OTag = Type#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - emit({";",nl,indent(9),{asis,Name}," ->",nl}), - if - M == CurrMod -> - emit([indent(12),"'dec_",T,"'(Bytes, ",DecProp, - ", TagIn ++ ",{asis,Tag},")"]); - true -> - emit([indent(12),"'",M,"':'dec_",T,"'(Bytes, ", - DecProp,", TagIn ++ ",{asis,Tag},")"]) - end, - 0; - false -> - emit([";",nl, - indent(9),{asis,Name}," ->",nl, - indent(12),"Len = case Bytes of",nl, - indent(15),"B when is_binary(B) -> size(B);",nl, - indent(15),"_ -> length(Bytes)",nl, - indent(12),"end,",nl, - indent(12),"{Bytes,[],Len}"]), - 0 - end, - gen_inlined_dec_funs1(Erules,Fields,Rest,ObjSetName,NthObj+N); -gen_inlined_dec_funs1(Erules,Fields,[_H|Rest],ObjSetName,NthObj)-> - gen_inlined_dec_funs1(Erules,Fields,Rest,ObjSetName,NthObj); -gen_inlined_dec_funs1(_,_,[],_,NthObj) -> - emit({nl,indent(6),"end",nl}), - emit({indent(3),"end"}), - NthObj. - -emit_inner_of_decfun(Erules,#typedef{name={ExtName,Name},typespec=Type}, - Prop,InternalDefFunName) -> - OTag = Type#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - case {ExtName,Name} of - {primitive,bif} -> - emit(indent(12)), - gen_dec_prim(Erules,Type,"Bytes",Tag,"TagIn",no_length, - ?PRIMITIVE,Prop), - 0; - {constructed,bif} -> - emit({indent(12),"'dec_", - asn1ct_gen:list2name(InternalDefFunName),"'(Bytes, ",Prop, - ", TagIn ++ ",{asis,Tag},")"}), - 1; - _ -> - emit({indent(12),"'",ExtName,"':'dec_",Name,"'(Bytes, ",Prop, - ", TagIn ++ ",{asis,Tag},")"}), - 0 - end; -emit_inner_of_decfun(_,#typedef{name=Name,typespec=Type},Prop,_) -> - OTag = Type#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - emit({indent(12),"'dec_",Name,"'(Bytes, ",Prop,", TagIn ++ ", - {asis,Tag},")"}), - 0; -emit_inner_of_decfun(Erules,Type,Prop,_) when is_record(Type,type) -> - OTag = Type#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - CurrMod = get(currmod), - Def = Type#type.def, - InnerType = asn1ct_gen:get_inner(Def), - WhatKind = asn1ct_gen:type(InnerType), - case WhatKind of - {primitive,bif} -> - emit({indent(9),Def," ->",nl,indent(12)}), - gen_dec_prim(Erules,Type,"Bytes",Tag,"TagIn",no_length, - ?PRIMITIVE,Prop); -% TRef when is_record(TRef,typereference) -> -% T = TRef#typereference.val, -% emit({indent(9),T," ->",nl,indent(12),"'dec_",T,"'(Val)"}); - #'Externaltypereference'{module=CurrMod,type=T} -> - emit({indent(9),T," ->",nl,indent(12),"'dec_",T, - "'(Bytes, ",Prop,", TagIn ++ ",{asis,Tag},")"}); - #'Externaltypereference'{module=ExtMod,type=T} -> - emit({indent(9),T," ->",nl,indent(12),ExtMod,":'dec_", - T,"'(Bytes, ",Prop,", TagIn ++ ",{asis,Tag},")"}) - end, - 0. - - -gen_internal_funcs(_,[]) -> - ok; -gen_internal_funcs(Erules,[TypeDef|Rest]) -> - gen_encode_user(Erules,TypeDef), - emit({"'dec_",TypeDef#typedef.name,"'(Bytes, ", - unused_optormand_var("OptOrMand",(TypeDef#typedef.typespec)#type.def),", TagIn) ->",nl}), - gen_decode_user(Erules,TypeDef), - gen_internal_funcs(Erules,Rest). - - -dbdec(Type) -> - demit({"io:format(\"decoding: ",{asis,Type},"~w~n\",[Bytes]),",nl}). - - -decode_class('UNIVERSAL') -> - ?UNIVERSAL; -decode_class('APPLICATION') -> - ?APPLICATION; -decode_class('CONTEXT') -> - ?CONTEXT; -decode_class('PRIVATE') -> - ?PRIVATE. - -decode_type('BOOLEAN') -> 1; -decode_type('INTEGER') -> 2; -decode_type('BIT STRING') -> 3; -decode_type('OCTET STRING') -> 4; -decode_type('NULL') -> 5; -decode_type('OBJECT IDENTIFIER') -> 6; -decode_type('ObjectDescriptor') -> 7; -decode_type('EXTERNAL') -> 8; -decode_type('REAL') -> 9; -decode_type('ENUMERATED') -> 10; -decode_type('EMBEDDED_PDV') -> 11; -decode_type('UTF8String') -> 12; -decode_type('RELATIVE-OID') -> 13; -decode_type('SEQUENCE') -> 16; -decode_type('SEQUENCE OF') -> 16; -decode_type('SET') -> 17; -decode_type('SET OF') -> 17; -decode_type('NumericString') -> 18; -decode_type('PrintableString') -> 19; -decode_type('TeletexString') -> 20; -decode_type('T61String') -> 20; -decode_type('VideotexString') -> 21; -decode_type('IA5String') -> 22; -decode_type('UTCTime') -> 23; -decode_type('GeneralizedTime') -> 24; -decode_type('GraphicString') -> 25; -decode_type('VisibleString') -> 26; -decode_type('GeneralString') -> 27; -decode_type('UniversalString') -> 28; -decode_type('BMPString') -> 30; -decode_type('CHOICE') -> 'CHOICE'; % choice gets the tag from the actual alternative -decode_type(Else) -> exit({error,{asn1,{unrecognized_type,Else}}}). - -add_removed_bytes() -> - asn1ct_name:delete(rb), - add_removed_bytes(asn1ct_name:all(rb)). - -add_removed_bytes([H,T1|T]) -> - emit({{var,H},"+"}), - add_removed_bytes([T1|T]); -add_removed_bytes([H|T]) -> - emit({{var,H}}), - add_removed_bytes(T); -add_removed_bytes([]) -> - true. - -mkfuncname(WhatKind,DecOrEnc) -> - case WhatKind of - #'Externaltypereference'{module=Mod,type=EType} -> - CurrMod = get(currmod), - case CurrMod of - Mod -> - lists:concat(["'",DecOrEnc,"_",EType,"'"]); - _ -> -% io:format("CurrMod: ~p, Mod: ~p~n",[CurrMod,Mod]), - lists:concat(["'",Mod,"':'",DecOrEnc,"_",EType,"'"]) - end; - #'typereference'{val=EType} -> - lists:concat(["'",DecOrEnc,"_",EType,"'"]); - 'ASN1_OPEN_TYPE' -> - lists:concat(["'",DecOrEnc,"_",WhatKind,"'"]) - - end. - -optionals(L) -> optionals(L,[],1). - -optionals([{'EXTENSIONMARK',_,_}|Rest],Acc,Pos) -> - optionals(Rest,Acc,Pos); % optionals in extension are currently not handled -optionals([#'ComponentType'{name=Name,prop='OPTIONAL'}|Rest],Acc,Pos) -> - optionals(Rest,[{Name,Pos}|Acc],Pos+1); -optionals([#'ComponentType'{name=Name,prop={'DEFAULT',_}}|Rest],Acc,Pos) -> - optionals(Rest,[{Name,Pos}|Acc],Pos+1); -optionals([#'ComponentType'{}|Rest],Acc,Pos) -> - optionals(Rest,Acc,Pos+1); -optionals([],Acc,_) -> - lists:reverse(Acc). - -get_constraint(C,Key) -> - case lists:keysearch(Key,1,C) of - false -> - no; - {value,{_,V}} -> - V - end. - -%% if the original option was ber and it has been wrapped to ber_bin -%% turn it back to ber -re_wrap_erule(ber_bin) -> - case get(encoding_options) of - Options when is_list(Options) -> - case lists:member(ber,Options) of - true -> ber; - _ -> ber_bin - end; - _ -> ber_bin - end; -re_wrap_erule(Erule) -> - Erule. - -is_already_generated(Operation,Name) -> - case get(class_default_type) of - undefined -> - put(class_default_type,[{Operation,Name}]), - false; - GeneratedList -> - case lists:member({Operation,Name},GeneratedList) of - true -> - true; - false -> - put(class_default_type,[{Operation,Name}|GeneratedList]), - false - end - end. - -get_class_fields(#classdef{typespec=ObjClass}) -> - ObjClass#objectclass.fields; -get_class_fields(#objectclass{fields=Fields}) -> - Fields; -get_class_fields(_) -> - []. - -get_object_field(Name,ObjectFields) -> - case lists:keysearch(Name,1,ObjectFields) of - {value,Field} -> Field; - false -> false - end. - -%% 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) -> - lists:filter(fun(#'ExtensionAdditionGroup'{}) -> - false; - ('ExtensionAdditionGroupEnd') -> - false; - (_) -> - true - end, ExtList). diff --git a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl index 3ccfca3784..00c3dd98b2 100644 --- a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl @@ -116,22 +116,7 @@ gen_encode(Erules,Typename,Type) when is_record(Type,type) -> end, case lists:member(InnerType,['SET','SEQUENCE']) of true -> - case get(asn_keyed_list) of - true -> - CompList = - case Type#type.def of - #'SEQUENCE'{components=Cl} -> Cl; - #'SET'{components=Cl} -> Cl - end, - emit([nl,"'enc_",asn1ct_gen:list2name(Typename), - "'(Val, TagIn",ObjFun, - ") when is_list(Val) ->",nl]), - emit([" 'enc_",asn1ct_gen:list2name(Typename), - "'(?RT_BER:fixoptionals(", - {asis,optionals(CompList)}, - ",Val), TagIn",ObjFun,");",nl,nl]); - _ -> true - end; + true; _ -> emit([nl,"'enc_",asn1ct_gen:list2name(Typename), "'({'",asn1ct_gen:list2name(Typename), @@ -175,22 +160,7 @@ gen_encode_user(Erules,D) when is_record(D,typedef) -> case lists:member(InnerType,['SET','SEQUENCE']) of true -> - case get(asn_keyed_list) of - true -> - CompList = - case Type#type.def of - #'SEQUENCE'{components=Cl} -> Cl; - #'SET'{components=Cl} -> Cl - end, - - emit([nl,"'enc_",asn1ct_gen:list2name(Typename), - "'(Val, TagIn) when is_list(Val) ->",nl]), - emit([" 'enc_",asn1ct_gen:list2name(Typename), - "'(?RT_BER:fixoptionals(", - {asis,optionals(CompList)}, - ",Val), TagIn);",nl,nl]); - _ -> true - end; + true; _ -> emit({nl,"'enc_",asn1ct_gen:list2name(Typename), "'({'",asn1ct_gen:list2name(Typename),"',Val}, TagIn) ->",nl}), @@ -1504,7 +1474,7 @@ gen_objset_dec(Erules,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, emit([indent(2),"fun(_,Bytes, _RestPrimFieldName) ->",nl]), case Erules of - ber_bin_v2 -> + ber -> emit([indent(4),"case Bytes of",nl, indent(6),"Bin when is_binary(Bin) -> ",nl, indent(8),"Bin;",nl, @@ -1772,19 +1742,6 @@ mkfuncname(WhatKind,DecOrEnc) -> end. -optionals(L) -> optionals(L,[],1). - -optionals([{'EXTENSIONMARK',_,_}|Rest],Acc,Pos) -> - optionals(Rest,Acc,Pos); % optionals in extension are currently not handled -optionals([#'ComponentType'{name=Name,prop='OPTIONAL'}|Rest],Acc,Pos) -> - optionals(Rest,[{Name,Pos}|Acc],Pos+1); -optionals([#'ComponentType'{name=Name,prop={'DEFAULT',_}}|Rest],Acc,Pos) -> - optionals(Rest,[{Name,Pos}|Acc],Pos+1); -optionals([#'ComponentType'{}|Rest],Acc,Pos) -> - optionals(Rest,Acc,Pos+1); -optionals([],Acc,_) -> - lists:reverse(Acc). - get_constraint(C,Key) -> case lists:keysearch(Key,1,C) of false -> diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl index bd5b81991d..3e100fc833 100644 --- a/lib/asn1/src/asn1ct_gen_per.erl +++ b/lib/asn1/src/asn1ct_gen_per.erl @@ -155,7 +155,7 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> NewList = lists:concat([[{0,X}||{X,_} <- Nlist1],['EXT_MARK'],[{1,X}||{X,_} <- Nlist2]]), NewC = [{'ValueRange',{0,length(Nlist1)-1}}], case Erules of - uper_bin -> + uper -> emit(["case ",Value," of",nl]); _ -> emit(["case (case ",Value," of {_,",{curr,enumval},"}-> ", @@ -168,7 +168,7 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> NewList = [X||{X,_} <- NamedNumberList], NewC = [{'ValueRange',{0,length(NewList)-1}}], case Erules of - uper_bin -> + uper -> emit(["case ",Value," of",nl]); _ -> emit(["case (case ",Value," of {_,",{curr,enumval}, @@ -274,7 +274,7 @@ emit_enc_enumerated_cases(Erule, C, [H1,H2|T], Count) -> -emit_enc_enumerated_case(uper_bin,_C, {asn1_enum,High}, _) -> +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)]"]); @@ -284,11 +284,11 @@ emit_enc_enumerated_case(_Per,_C, {asn1_enum,High}, _) -> "[{bit,1},?RT_PER:encode_small_number(EnumV)]"]); emit_enc_enumerated_case(_Erule, _C, 'EXT_MARK', _Count) -> true; -emit_enc_enumerated_case(uper_bin,_C, {1,EnumName}, Count) -> +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_bin,C, {0,EnumName}, 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,")]"]); @@ -442,7 +442,7 @@ gen_encode_objectfields(Erule,ClassName,[{typefield,Name,OptOrMand}|Rest], {false,'OPTIONAL'} -> EmitFuncClause("Val"), case Erule of - uper_bin -> + uper -> emit(" Val"); _ -> emit(" [{octets,Val}]") @@ -833,7 +833,7 @@ gen_objset_enc(Erule,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, emit({"'getenc_",ObjSetName,"'(_, _) ->",nl}), emit({indent(3),"fun(_, Val, _) ->",nl}), case Erule of - uper_bin -> + uper -> emit([indent(6),"Val",nl]); _ -> emit([indent(6),"[{octets,Val}]",nl]) @@ -883,7 +883,7 @@ gen_inlined_enc_funs(Erule,Fields,[{typefield,Name,_}|Rest],ObjSetName,NthObj) - emit({indent(9),{asis,Name}," ->",nl}), emit([indent(12),"'",M,"'",":'enc_",T,"'(Val)"]), gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,[]); - false when Erule == uper_bin -> + false when Erule =:= uper -> emit([indent(3),"fun(Type,Val,_) ->",nl, indent(6),"case Type of",nl, indent(9),{asis,Name}," -> Val",nl]), @@ -921,7 +921,7 @@ gen_inlined_enc_funs1(Erule,Fields,[{typefield,Name,_}|Rest],ObjSetName, emit({";",nl,indent(9),{asis,Name}," ->",nl}), emit([indent(12),"'",M,"'",":'enc_",T,"'(Val)"]), {Acc,0}; - false when Erule == uper_bin -> + false when Erule =:= uper -> emit([";",nl, indent(9),{asis,Name}," -> ",nl, "Val",nl]), diff --git a/lib/asn1/src/asn1ct_value.erl b/lib/asn1/src/asn1ct_value.erl index 9013baef92..6057e27b63 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,get_encoding_rule(M)); + from_type_prim(Type); 'ASN1_OPEN_TYPE' -> case Type#type.constraint of [#'Externaltypereference'{type=TrefConstraint}] -> @@ -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,Erule) -> +from_type_prim(D) -> C = D#type.constraint, case D#type.def of 'INTEGER' -> @@ -303,12 +303,7 @@ from_type_prim(D,Erule) -> adjust_list(size_random(C),c_string(C,"BMPString")); 'UTF8String' -> {ok,Res}=asn1rt:utf8_list_to_binary(adjust_list(random(50),[$U,$T,$F,$8,$S,$t,$r,$i,$n,$g,16#ffff,16#fffffff,16#ffffff,16#fffff,16#fff])), - case Erule of - per -> - binary_to_list(Res); - _ -> - Res - end; + Res; 'UniversalString' -> adjust_list(size_random(C),c_string(C,"UniversalString")); XX -> @@ -440,17 +435,9 @@ get_encoding_rule(M) -> end. open_type_value(ber) -> - [4,9,111,112,101,110,95,116,121,112,101]; -open_type_value(ber_bin) -> -% [4,9,111,112,101,110,95,116,121,112,101]; - <<4,9,111,112,101,110,95,116,121,112,101>>; -open_type_value(ber_bin_v2) -> -% [4,9,111,112,101,110,95,116,121,112,101]; <<4,9,111,112,101,110,95,116,121,112,101>>; open_type_value(per) -> - "\n\topen_type"; %octet string value "open_type" -open_type_value(per_bin) -> - <<"\n\topen_type">>; + <<"\n\topen_type">>; %octet string value "open_type" % <<10,9,111,112,101,110,95,116,121,112,101>>; open_type_value(_) -> [4,9,111,112,101,110,95,116,121,112,101]. diff --git a/lib/asn1/src/asn1rt_ber_bin.erl b/lib/asn1/src/asn1rt_ber_bin.erl index 22f9f2ecfd..ec1549804b 100644 --- a/lib/asn1/src/asn1rt_ber_bin.erl +++ b/lib/asn1/src/asn1rt_ber_bin.erl @@ -19,337 +19,30 @@ %% -module(asn1rt_ber_bin). -%% encoding / decoding of BER - --export([decode/1]). --export([fixoptionals/2,split_list/2,cindex/3,restbytes2/3, - list_to_record/2, - encode_tag_val/1,decode_tag/1,peek_tag/1, - check_tags/3, encode_tags/3]). --export([encode_boolean/2,decode_boolean/3, - encode_integer/3,encode_integer/4, - decode_integer/4,decode_integer/5,encode_enumerated/2, - encode_enumerated/4,decode_enumerated/5, +-export([decode_length/1, encode_real/2, encode_real/3, decode_real/2, decode_real/4, - encode_bit_string/4,decode_bit_string/6, - decode_compact_bit_string/6, - encode_octet_string/3,decode_octet_string/5, - encode_null/2,decode_null/3, - encode_object_identifier/2,decode_object_identifier/3, - encode_relative_oid/2,decode_relative_oid/3, - encode_restricted_string/4,decode_restricted_string/6, - encode_universal_string/3,decode_universal_string/5, - encode_UTF8_string/3, decode_UTF8_string/3, - encode_BMP_string/3,decode_BMP_string/5, - encode_generalized_time/3,decode_generalized_time/5, - encode_utc_time/3,decode_utc_time/5, - encode_length/1,decode_length/1, - check_if_valid_tag/3, - decode_tag_and_length/1, decode_components/6, - decode_components/7, decode_set/6]). - --export([encode_open_type/1,encode_open_type/2,decode_open_type/1,decode_open_type/2,decode_open_type/3]). --export([skipvalue/1, skipvalue/2,skip_ExtensionAdditions/2]). + decode_tag/1]). -include("asn1_records.hrl"). -% the encoding of class of tag bits 8 and 7 +%% 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_UTF8String, 12). --define('N_RELATIVE-OID',13). --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 - - -decode(Bin) -> - decode_primitive(Bin). - -decode_primitive(Bin) -> - {Tlv = {Tag,Len,V},<<>>} = decode_tlv(Bin), - case element(2,Tag) of - ?CONSTRUCTED -> - {Tag,Len,decode_constructed(V)}; - _ -> - Tlv - end. - -decode_constructed(<<>>) -> - []; -decode_constructed(Bin) -> - {Tlv = {Tag,Len,V},Rest} = decode_tlv(Bin), - NewTlv = - case element(2,Tag) of - ?CONSTRUCTED -> - {Tag,Len,decode_constructed(V)}; - _ -> - Tlv - end, - [NewTlv|decode_constructed(Rest)]. - -decode_tlv(Bin) -> - {Tag,Bin1,_Rb1} = decode_tag(Bin), - {{Len,Bin2},_Rb2} = decode_length(Bin1), - <<V:Len/binary,Bin3/binary>> = Bin2, - {{Tag,Len,V},Bin3}. - - - -%%%%%%%%%%%%% -% split_list(List,HeadLen) -> {HeadList,TailList} -% -% splits List into HeadList (Length=HeadLen) and TailList -% if HeadLen == indefinite -> return {List,indefinite} -split_list(List,indefinite) -> - {List, indefinite}; -split_list(Bin, Len) when is_binary(Bin) -> - split_binary(Bin,Len); -split_list(List,Len) -> - {lists:sublist(List,Len),lists:nthtail(Len,List)}. - -%%% new function which fixes a bug regarding indefinite length decoding -restbytes2(indefinite,<<0,0,RemBytes/binary>>,_) -> - {RemBytes,2}; -restbytes2(indefinite,RemBytes,ext) -> - skipvalue(indefinite,RemBytes); -restbytes2(RemBytes,<<>>,_) -> - {RemBytes,0}; -restbytes2(_RemBytes,Bytes,noext) -> - exit({error,{asn1, {unexpected,Bytes}}}); -restbytes2(RemBytes,Bytes,ext) -> -%% {RemBytes,0}. - {RemBytes,byte_size(Bytes)}. - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% skipvalue(Length, Bytes) -> {RemainingBytes, RemovedNumberOfBytes} -%% -%% skips the one complete (could be nested) TLV from Bytes -%% handles both definite and indefinite length encodings -%% - -skipvalue(L, Bytes) -> - skipvalue(L, Bytes, 0). - -skipvalue(L, Bytes, Rb) -> - skipvalue(L, Bytes, Rb, 0). - -skipvalue(indefinite, Bytes, Rb, IndefLevel) -> - {T,Bytes2,R2} = decode_tag(Bytes), - {{L,Bytes3},R3} = decode_length(Bytes2), - case {T,L} of - {_,indefinite} -> - skipvalue(indefinite,Bytes3,Rb+R2+R3,IndefLevel+1); - {{0,0,0},0} when IndefLevel =:= 0 -> - %% See X690 8.1.5 NOTE, end of indefinite content - {Bytes3,Rb+2}; - {{0,0,0},0} -> - skipvalue(indefinite,Bytes3,Rb+2,IndefLevel - 1); - _ -> - <<_:L/binary, RestBytes/binary>> = Bytes3, - skipvalue(indefinite,RestBytes,Rb+R2+R3+L, IndefLevel) - %%{RestBytes, R2+R3+L} - end; -%% case Bytes4 of -%% <<0,0,Bytes5/binary>> -> -%% {Bytes5,Rb+Rb4+2}; -%% _ -> skipvalue(indefinite,Bytes4,Rb+Rb4) -%% end; -skipvalue(L, Bytes, Rb, _) -> -% <<Skip:L/binary, RestBytes/binary>> = Bytes, - <<_:L/binary, RestBytes/binary>> = Bytes, - {RestBytes,Rb+L}. - - -skipvalue(Bytes) -> - {_T,Bytes2,R2} = decode_tag(Bytes), - {{L,Bytes3},R3} = decode_length(Bytes2), - skipvalue(L,Bytes3,R2+R3). - - -cindex(Ix,Val,Cname) -> - case element(Ix,Val) of - {Cname,Val2} -> Val2; - X -> X - end. - -%%% -%% skips byte sequence of Bytes that do not match a tag in Tags -skip_ExtensionAdditions(Bytes,Tags) -> - skip_ExtensionAdditions(Bytes,Tags,0). -skip_ExtensionAdditions(<<>>,_Tags,RmB) -> - {<<>>,RmB}; -skip_ExtensionAdditions(Bytes,Tags,RmB) -> - case catch decode_tag(Bytes) of - {'EXIT',_Reason} -> - tag_error(no_data,Tags,Bytes,'OPTIONAL'); - {_T={Class,_Form,TagNo},_Bytes2,_R2} -> - case [X||X=#tag{class=Cl,number=TN} <- Tags,Cl==Class,TN==TagNo] of - [] -> - %% skip this TLV and continue with next - {Bytes3,R3} = skipvalue(Bytes), - skip_ExtensionAdditions(Bytes3,Tags,RmB+R3); - _ -> - {Bytes,RmB} - end - end. - -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== -%% Optionals, preset not filled optionals with asn1_NOVALUE -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== - -% converts a list to a record if necessary -list_to_record(Name,List) when is_list(List) -> - list_to_tuple([Name|List]); -list_to_record(_Name,Tuple) when is_tuple(Tuple) -> - Tuple. - - -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>>; - -%% asumes whole correct tag bitpattern, multiple of 8 -encode_tag_val(Tag) when (Tag =< 255) -> Tag; %% anv�nds denna funktion??!! -%% asumes correct bitpattern of 0-5 -encode_tag_val(Tag) -> encode_tag_val2(Tag,[]). - -encode_tag_val2(Tag, OctAck) when (Tag =< 255) -> - [Tag | OctAck]; -encode_tag_val2(Tag, OctAck) -> - encode_tag_val2(Tag bsr 8, [255 band Tag | OctAck]). - - -%%%encode_tag(TagClass(?UNI, APP etc), Form (?PRIM etx), TagInteger) -> -%%% 8bit Int | [list of octets] -%encode_tag_val({Class, Form, TagNo}) when (TagNo =< 30) -> -%%% <<Class:2,Form:1,TagNo:5>>; -% [Class bor Form bor TagNo]; -%encode_tag_val({Class, Form, TagNo}) -> -% {Octets,L} = mk_object_val(TagNo), -% [Class bor Form bor 31 | Octets]; - - -%%============================================================================\%% Peek on the initial tag -%% peek_tag(Bytes) -> TagBytes -%% interprets the first byte and possible second, third and fourth byte as -%% a tag and returns all the bytes comprising the tag, the constructed/primitive bit (6:th bit of first byte) is normalised to 0 -%% - -peek_tag(<<B7_6:2,_:1,31:5,Buffer/binary>>) -> - Bin = peek_tag(Buffer, <<>>), - <<B7_6:2,31:6,Bin/binary>>; -%% single tag (tagno < 31) -peek_tag(<<B7_6:2,_:1,B4_0:5,_Buffer/binary>>) -> - <<B7_6:2,B4_0:6>>. - -peek_tag(<<0:1,PartialTag:7,_Buffer/binary>>, TagAck) -> - <<TagAck/binary,PartialTag>>; -peek_tag(<<PartialTag,Buffer/binary>>, TagAck) -> - peek_tag(Buffer,<<TagAck/binary,PartialTag>>); -peek_tag(_,TagAck) -> - exit({error,{asn1, {invalid_tag,TagAck}}}). -%%peek_tag([Tag|Buffer]) when (Tag band 31) =:= 31 -> -%% [Tag band 2#11011111 | peek_tag(Buffer,[])]; -%%%% single tag (tagno < 31) -%%peek_tag([Tag|Buffer]) -> -%% [Tag band 2#11011111]. - -%%peek_tag([PartialTag|Buffer], TagAck) when (PartialTag < 128 ) -> -%% lists:reverse([PartialTag|TagAck]); -%%peek_tag([PartialTag|Buffer], TagAck) -> -%% peek_tag(Buffer,[PartialTag|TagAck]); -%%peek_tag(Buffer,TagAck) -> -%% exit({error,{asn1, {invalid_tag,lists:reverse(TagAck)}}}). - + <<(Class bsr 6):2, (Form bsr 5):1, 31:5,BinOct/binary>>. %%=============================================================================== %% Decode a tag @@ -403,33 +96,11 @@ check_tags_i([Tag1|TagRest], Buffer, Rb, OptOrMand) -> _ -> check_tags_i(TagRest, Buffer2, Rb + Rb1, mandatory) end - end; - -check_tags_i([], Buffer, Rb, _) -> - {[],{{0,0},Buffer,Rb}}. + end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% This function is called from generated code -check_tags([Tag], Buffer, OptOrMand) -> % optimized very usual case - check_one_tag(Tag, Buffer, OptOrMand); -check_tags(Tags, Buffer, OptOrMand) -> - check_tags(Tags, Buffer, 0, OptOrMand). - -check_tags([Tag1,Tag2|TagRest], Buffer, Rb, OptOrMand) - when Tag1#tag.type == 'IMPLICIT' -> - check_tags([Tag1#tag{type=Tag2#tag.type}|TagRest], Buffer, Rb, OptOrMand); - -check_tags([Tag1|TagRest], Buffer, Rb, OptOrMand) -> - {Form_Length,Buffer2,Rb1} = check_one_tag(Tag1, Buffer, OptOrMand), - case TagRest of - [] -> {Form_Length, Buffer2, Rb + Rb1}; - _ -> check_tags(TagRest, Buffer2, Rb + Rb1, mandatory) - end; - -check_tags([], Buffer, Rb, _) -> - {{0,0},Buffer,Rb}. - check_one_tag(Tag=#tag{class=ExpectedClass,number=ExpectedNumber}, Buffer, OptOrMand) -> case catch decode_tag(Buffer) of {'EXIT',_Reason} -> @@ -491,382 +162,6 @@ encode_one_tag(#tag{class=Class,number=No,type=Type, form = Form}) -> Bytes = encode_tag_val({Class,NewForm,No}), {Bytes,size(Bytes)}. -%%=============================================================================== -%% Change the tag (used when an implicit tagged type has a reference to something else) -%% The constructed bit in the tag is taken from the tag to be replaced. -%% -%% change_tag(NewTag,[Tag,Buffer]) -> [NewTag,Buffer] -%%=============================================================================== - -%change_tag({NewClass,NewTagNr}, Buffer) -> -% {{OldClass, OldForm, OldTagNo}, Buffer1, RemovedBytes} = decode_tag(lists:flatten(Buffer)), -% [encode_tag_val({NewClass, OldForm, NewTagNr}) | Buffer1]. - - -%%=============================================================================== -%% -%% 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) -> CompleteList -%% Value = list of bytes of an already encoded value (the list must be flat) -%% | binary - -%% This version does not consider Explicit tagging of the open type. It -%% is only left because of backward compatibility. -encode_open_type(Val) when is_list(Val) -> - {Val, byte_size(list_to_binary(Val))}; -encode_open_type(Val) -> - {Val, byte_size(Val)}. - -%% -encode_open_type(Val, []) when is_list(Val) -> - {Val, byte_size(list_to_binary(Val))}; -encode_open_type(Val, []) -> - {Val, byte_size(Val)}; -encode_open_type(Val, Tag) when is_list(Val) -> - encode_tags(Tag, Val, byte_size(list_to_binary(Val))); -encode_open_type(Val, Tag) -> - encode_tags(Tag, Val, byte_size(Val)). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_open_type(Buffer) -> Value -%% Bytes = [byte] with BER encoded data -%% Value = [byte] with decoded data (which must be decoded again as some type) -%% -decode_open_type(Bytes) -> -% {_Tag, Len, _RemainingBuffer, RemovedBytes} = decode_tag_and_length(Bytes), -% N = Len + RemovedBytes, - {_Tag, Len, RemainingBuffer, RemovedBytes} = decode_tag_and_length(Bytes), - {_RemainingBuffer2, RemovedBytes2} = skipvalue(Len, RemainingBuffer, RemovedBytes), - N = RemovedBytes2, - <<Val:N/binary, RemainingBytes/binary>> = Bytes, -% {Val, RemainingBytes, Len + RemovedBytes}. - {Val,RemainingBytes,N}. - -decode_open_type(<<>>,[]=ExplTag) -> % R9C-0.patch-40 - exit({error, {asn1,{no_optional_tag, ExplTag}}}); -decode_open_type(Bytes,ExplTag) -> - {Tag, Len, RemainingBuffer, RemovedBytes} = decode_tag_and_length(Bytes), - case {Tag,ExplTag} of -% {{Class,Form,32},[#tag{class=Class,number=No,form=32}]} -> -% {_Tag2, Len2, RemainingBuffer2, RemovedBytes2} = decode_tag_and_length(RemainingBuffer), -% {_RemainingBuffer3, RemovedBytes3} = skipvalue(Len2, RemainingBuffer2, RemovedBytes2), -% N = RemovedBytes3, -% <<_:RemovedBytes/unit:8,Val:N/binary,RemainingBytes/binary>> = Bytes, -% {Val, RemainingBytes, N + RemovedBytes}; - {{Class,Form,No},[#tag{class=Class,number=No,form=Form}]} -> - {_RemainingBuffer2, RemovedBytes2} = - skipvalue(Len, RemainingBuffer), - N = RemovedBytes2, - <<_:RemovedBytes/unit:8,Val:N/binary,RemainingBytes/binary>> = Bytes, - {Val, RemainingBytes, N + RemovedBytes}; - _ -> - {_RemainingBuffer2, RemovedBytes2} = - skipvalue(Len, RemainingBuffer, RemovedBytes), - N = RemovedBytes2, - <<Val:N/binary, RemainingBytes/binary>> = Bytes, - {Val, RemainingBytes, N} - end. - -decode_open_type(ber_bin,Bytes,ExplTag) -> - decode_open_type(Bytes,ExplTag); -decode_open_type(ber,Bytes,ExplTag) -> - {Val,RemBytes,Len}=decode_open_type(Bytes,ExplTag), - {binary_to_list(Val),RemBytes,Len}. - -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== -%% Boolean, ITU_T X.690 Chapter 8.2 -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== - -%%=============================================================================== -%% encode_boolean(Integer, tag | notag) -> [octet list] -%%=============================================================================== - -encode_boolean({Name, Val}, DoTag) when is_atom(Name) -> - dotag(DoTag, ?N_BOOLEAN, encode_boolean(Val)); -encode_boolean(true,[]) -> - {[1,1,16#FF],3}; -encode_boolean(false,[]) -> - {[1,1,0],3}; -encode_boolean(Val, DoTag) -> - dotag(DoTag, ?N_BOOLEAN, encode_boolean(Val)). - -%% encode_boolean(Boolean) -> [Len, Boolean] = [1, $FF | 0] -encode_boolean(true) -> {[16#FF],1}; -encode_boolean(false) -> {[0],1}; -encode_boolean(X) -> exit({error,{asn1, {encode_boolean, X}}}). - - -%%=============================================================================== -%% decode_boolean(BuffList, HasTag, TotalLen) -> {true, Remain, RemovedBytes} | -%% {false, Remain, RemovedBytes} -%%=============================================================================== - -decode_boolean(Buffer, Tags, OptOrMand) -> - NewTags = new_tags(Tags,#tag{class=?UNIVERSAL,number=?N_BOOLEAN}), - decode_boolean_notag(Buffer, NewTags, OptOrMand). - -decode_boolean_notag(Buffer, Tags, OptOrMand) -> - {RestTags, {FormLen,Buffer0,Rb0}} = - check_tags_i(Tags, Buffer, OptOrMand), - case FormLen of - {?CONSTRUCTED,Len} -> - {Buffer00,RestBytes} = split_list(Buffer0,Len), - {Val,Buffer1,Rb1} = decode_boolean_notag(Buffer00, RestTags, OptOrMand), - {Buffer2, Rb2} = restbytes2(RestBytes,Buffer1,noext), - {Val, Buffer2, Rb0+Rb1+Rb2}; - {_,_} -> - decode_boolean2(Buffer0, Rb0) - end. - -decode_boolean2(<<0:8, Buffer/binary>>, RemovedBytes) -> - {false, Buffer, RemovedBytes + 1}; -decode_boolean2(<<_:8, Buffer/binary>>, RemovedBytes) -> - {true, Buffer, RemovedBytes + 1}; -decode_boolean2(Buffer, _) -> - exit({error,{asn1, {decode_boolean, Buffer}}}). - - -%%=========================================================================== -%% 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, []) when is_integer(Val) -> - {EncVal,Len} = encode_integer(C, Val), - dotag_universal(?N_INTEGER,EncVal,Len); -encode_integer(C, Val, Tag) when is_integer(Val) -> - dotag(Tag, ?N_INTEGER, encode_integer(C, Val)); -encode_integer(C,{Name,Val},Tag) when is_atom(Name) -> - encode_integer(C,Val,Tag); -encode_integer(_, Val, _) -> - exit({error,{asn1, {encode_integer, Val}}}). - - -encode_integer(C, Val, NamedNumberList, Tag) when is_atom(Val) -> - case lists:keyfind(Val, 1, NamedNumberList) of - {_, NewVal} -> - dotag(Tag, ?N_INTEGER, encode_integer(C, NewVal)); - _ -> - exit({error,{asn1, {encode_integer_namednumber, Val}}}) - end; -encode_integer(C,{_,Val},NamedNumberList,Tag) -> - encode_integer(C,Val,NamedNumberList,Tag); -encode_integer(C, Val, _NamedNumberList, Tag) -> - dotag(Tag, ?N_INTEGER, encode_integer(C, Val)). - - -encode_integer(_C, 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(Buffer, Range, Tags, OptOrMand) -> - NewTags = new_tags(Tags,#tag{class=?UNIVERSAL,number=?N_INTEGER}), - decode_integer_notag(Buffer, Range, [], NewTags, OptOrMand). - -decode_integer(Buffer, Range, NamedNumberList, Tags, OptOrMand) -> - NewTags = new_tags(Tags,#tag{class=?UNIVERSAL,number=?N_INTEGER}), - decode_integer_notag(Buffer, Range, NamedNumberList, NewTags, OptOrMand). - -decode_integer_notag(Buffer, Range, NamedNumberList, NewTags, OptOrMand) -> - {RestTags, {FormLen, Buffer0, Rb0}} = - check_tags_i(NewTags, Buffer, OptOrMand), -% Result = {Val, Buffer2, RemovedBytes} = - case FormLen of - {?CONSTRUCTED,Len} -> - {Buffer00, RestBytes} = split_list(Buffer0,Len), - {Val01, Buffer01, Rb01} = - decode_integer_notag(Buffer00, Range, NamedNumberList, - RestTags, OptOrMand), - {Buffer02, Rb02} = restbytes2(RestBytes,Buffer01,noext), - {Val01, Buffer02, Rb0+Rb01+Rb02}; - {_, Len} -> - Result = - decode_integer2(Len,Buffer0,Rb0+Len), - Result2 = check_integer_constraint(Result,Range), - resolve_named_value(Result2,NamedNumberList) - end. - -resolve_named_value(Result={Val,Buffer,RemBytes},NamedNumberList) -> - case NamedNumberList of - [] -> Result; - _ -> - NewVal = case lists:keyfind(Val, 2, NamedNumberList) of - {NamedVal, _} -> - NamedVal; - _ -> - Val - end, - {NewVal, Buffer, RemBytes} - end. - -check_integer_constraint(Result={Val, _Buffer,_},Range) -> - case Range of - [] -> % No length constraint - Result; - {Lb,Ub} when Val >= Lb, Ub >= Val -> % variable length constraint - Result; - Val -> % fixed value constraint - Result; - {_,_} -> - exit({error,{asn1,{integer_range,Range,Val}}}); - SingleValue when is_integer(SingleValue) -> - exit({error,{asn1,{integer_range,Range,Val}}}); - _ -> % some strange constraint that we don't support yet - Result - end. - -%%============================================================================ -%% Enumerated value, ITU_T X.690 Chapter 8.4 - -%% encode enumerated value -%%============================================================================ -encode_enumerated(Val, []) when is_integer(Val) -> - {EncVal,Len} = encode_integer(false,Val), - dotag_universal(?N_ENUMERATED,EncVal,Len); -encode_enumerated(Val, DoTag) when is_integer(Val) -> - dotag(DoTag, ?N_ENUMERATED, encode_integer(false,Val)); -encode_enumerated({Name,Val}, DoTag) when is_atom(Name) -> - encode_enumerated(Val, DoTag). - -%% 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}, DoTag) when is_atom(Val) -> - case catch encode_enumerated(C, Val, NamedNumberList, DoTag) of - {'EXIT',_} -> encode_enumerated(C, Val, ExtList, DoTag); - Result -> Result - end; - -encode_enumerated(C, Val, NamedNumberList, DoTag) when is_atom(Val) -> - case lists:keyfind(Val, 1, NamedNumberList) of - {_, NewVal} when DoTag =:= [] -> - {EncVal,Len} = encode_integer(C,NewVal), - dotag_universal(?N_ENUMERATED,EncVal,Len); - {_, NewVal} -> - dotag(DoTag, ?N_ENUMERATED, encode_integer(C, NewVal)); - _ -> - exit({error,{asn1, {enumerated_not_in_range, Val}}}) - end; - -encode_enumerated(C, {asn1_enum, Val}, {_,_}, DoTag) when is_integer(Val) -> - dotag(DoTag, ?N_ENUMERATED, encode_integer(C,Val)); - -encode_enumerated(C, {Name,Val}, NamedNumberList, DoTag) when is_atom(Name) -> - encode_enumerated(C, Val, NamedNumberList, DoTag); - -encode_enumerated(_, Val, _, _) -> - exit({error,{asn1, {enumerated_not_namednumber, Val}}}). - - - -%%============================================================================ -%% decode enumerated value -%% (Buffer, Range, NamedNumberList, HasTag, TotalLen) -> -%% {Value, RemainingBuffer, RemovedBytes} -%%=========================================================================== -decode_enumerated(Buffer, Range, NamedNumberList, Tags, OptOrMand) -> - NewTags = new_tags(Tags,#tag{class=?UNIVERSAL,number=?N_ENUMERATED}), - decode_enumerated_notag(Buffer, Range, NamedNumberList, - NewTags, OptOrMand). - -decode_enumerated_notag(Buffer, Range, NNList = {NamedNumberList,ExtList}, Tags, OptOrMand) -> - {RestTags, {FormLen, Buffer0, Rb0}} = - check_tags_i(Tags, Buffer, OptOrMand), - - case FormLen of - {?CONSTRUCTED,Len} -> - {Buffer00,RestBytes} = split_list(Buffer0,Len), - {Val01, Buffer01, Rb01} = - decode_enumerated_notag(Buffer00, Range, NNList, RestTags, OptOrMand), - {Buffer02, Rb02} = restbytes2(RestBytes,Buffer01,noext), - {Val01, Buffer02, Rb0+Rb01+Rb02}; - {_,Len} -> - {Val01, Buffer01, Rb01} = - decode_integer2(Len, Buffer0, Rb0+Len), - case decode_enumerated1(Val01, NamedNumberList) of - {asn1_enum,Val01} -> - {decode_enumerated1(Val01,ExtList), Buffer01, Rb01}; - Result01 -> - {Result01, Buffer01, Rb01} - end - end; - -decode_enumerated_notag(Buffer, Range, NNList, Tags, OptOrMand) -> - {RestTags, {FormLen, Buffer0, Rb0}} = - check_tags_i(Tags, Buffer, OptOrMand), - - case FormLen of - {?CONSTRUCTED,Len} -> - {Buffer00,RestBytes} = split_list(Buffer0,Len), - {Val01, Buffer01, Rb01} = - decode_enumerated_notag(Buffer00, Range, NNList, RestTags, OptOrMand), - {Buffer02, Rb02} = restbytes2(RestBytes,Buffer01,noext), - {Val01, Buffer02, Rb0+Rb01+Rb02}; - {_,Len} -> - {Val01, Buffer02, Rb02} = - decode_integer2(Len, Buffer0, Rb0+Len), - case decode_enumerated1(Val01, NNList) of - {asn1_enum,_} -> - exit({error,{asn1, {illegal_enumerated, Val01}}}); - Result01 -> - {Result01, Buffer02, Rb02} - end - end. - -decode_enumerated1(Val, NamedNumberList) -> - %% it must be a named integer - case lists:keyfind(Val, 2, NamedNumberList) of - {NamedVal, _} -> - NamedVal; - _ -> - {asn1_enum,Val} - end. - - %%============================================================================ %% %% Real value, ITU_T X.690 Chapter 8.5 @@ -1117,513 +412,15 @@ decode_real2(Buffer0, _C, Len, RemBytes1) -> {{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]). -%%============================================================================ -%% 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,DoTag) when is_integer(Unused), is_binary(BinBits) -> - encode_bin_bit_string(C,Bin,NamedBitList,DoTag); -encode_bit_string(C, [FirstVal | RestVal], NamedBitList, DoTag) when is_atom(FirstVal) -> - encode_bit_string_named(C, [FirstVal | RestVal], NamedBitList, DoTag); - -encode_bit_string(C, [{bit,X} | RestVal], NamedBitList, DoTag) -> - encode_bit_string_named(C, [{bit,X} | RestVal], NamedBitList, DoTag); - -encode_bit_string(C, [FirstVal| RestVal], NamedBitList, DoTag) when is_integer(FirstVal) -> - encode_bit_string_bits(C, [FirstVal | RestVal], NamedBitList, DoTag); - -encode_bit_string(_, 0, _, []) -> - {[?N_BIT_STRING,1,0],3}; - -encode_bit_string(_, 0, _, DoTag) -> - dotag(DoTag, ?N_BIT_STRING, {<<0>>,1}); - -encode_bit_string(_, [], _, []) -> - {[?N_BIT_STRING,1,0],3}; - -encode_bit_string(_, [], _, DoTag) -> - dotag(DoTag, ?N_BIT_STRING, {<<0>>,1}); - -encode_bit_string(C, IntegerVal, NamedBitList, DoTag) when is_integer(IntegerVal) -> - BitListVal = int_to_bitlist(IntegerVal), - encode_bit_string_bits(C, BitListVal, NamedBitList, DoTag); - -encode_bit_string(C, {Name,BitList}, NamedBitList, DoTag) when is_atom(Name) -> - encode_bit_string(C, BitList, NamedBitList, DoTag). - - - -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,DoTag)-> - case get_constraint(C,'SizeConstraint') of - no -> - remove_unused_then_dotag(DoTag,?N_BIT_STRING,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(DoTag,?N_BIT_STRING, - Unused,BinBits) - end; - Size -> - case ((size(BinBits)*8)-Unused) of - BBSize when BBSize =< Size -> - remove_unused_then_dotag(DoTag,?N_BIT_STRING, - Unused,BinBits); - BBSize -> - exit({error,{asn1, - {bitstring_length, - {{was,BBSize},{should_be,Size}}}}}) - end - end. - -remove_unused_then_dotag(DoTag,StringType,Unused,BinBits) -> - case Unused of - 0 when (byte_size(BinBits) =:= 0), DoTag =:= [] -> - %% time optimization of next case - {[StringType,1,0],3}; - 0 when (byte_size(BinBits) =:= 0) -> - dotag(DoTag,StringType,{<<0>>,1}); - 0 when DoTag =:= [] -> % time optimization of next case - dotag_universal(StringType,[Unused|[BinBits]],size(BinBits)+1); -% {LenEnc,Len} = encode_legth(size(BinBits)+1), -% {[StringType,LenEnc,[Unused|BinBits]],size(BinBits)+1+Len+1}; - 0 -> - dotag(DoTag,StringType,<<Unused,BinBits/binary>>); - Num when DoTag =:= [] -> % time optimization of next case - N = byte_size(BinBits) - 1, - <<BBits:N/binary,LastByte>> = BinBits, - dotag_universal(StringType, - [Unused,BBits,(LastByte bsr Num) bsl Num], - byte_size(BinBits) + 1); -% {LenEnc,Len} = encode_legth(size(BinBits)+1), -% {[StringType,LenEnc,[Unused,BBits,(LastByte bsr Num) bsl Num], -% 1+Len+size(BinBits)+1}; - Num -> - N = byte_size(BinBits) - 1, - <<BBits:N/binary,LastByte>> = BinBits, - dotag(DoTag,StringType,{[Unused,binary_to_list(BBits) ++ - [(LastByte bsr Num) bsl Num]], - byte_size(BinBits) + 1}) - end. - - -%%================================================================= -%% Encode named bits -%%================================================================= - -encode_bit_string_named(C, [FirstVal | RestVal], NamedBitList, DoTag) -> - {Len,Unused,OctetList} = - case get_constraint(C,'SizeConstraint') of - no -> - ToSetPos = get_all_bitposes([FirstVal | RestVal], - NamedBitList, []), - BitList = make_and_set_list(lists:max(ToSetPos)+1, - ToSetPos, 0), - encode_bitstring(BitList); - {_Min,Max} -> - ToSetPos = get_all_bitposes([FirstVal | RestVal], - NamedBitList, []), - BitList = make_and_set_list(Max, ToSetPos, 0), - encode_bitstring(BitList); - Size -> - ToSetPos = get_all_bitposes([FirstVal | RestVal], - NamedBitList, []), - BitList = make_and_set_list(Size, ToSetPos, 0), - encode_bitstring(BitList) - end, - case DoTag of - [] -> - dotag_universal(?N_BIT_STRING,[Unused|OctetList],Len+1); -% {EncLen,LenLen} = encode_length(Len+1), -% {[?N_BIT_STRING,EncLen,Unused,OctetList],1+LenLen+Len+1}; - _ -> - dotag(DoTag, ?N_BIT_STRING, {[Unused|OctetList],Len+1}) - end. - - -%%---------------------------------------- -%% 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, DoTag) when is_list(BitListVal) -> - {Len,Unused,OctetList} = - case get_constraint(C,'SizeConstraint') of - no -> - encode_bitstring(BitListVal); - Constr={Min,_Max} when is_integer(Min) -> - encode_constr_bit_str_bits(Constr,BitListVal,DoTag); - {Constr={_,_},[]} -> - %% constraint with extension mark - encode_constr_bit_str_bits(Constr,BitListVal,DoTag); - Constr={{_,_},{_,_}} ->%{{Min1,Max1},{Min2,Max2}} - %% constraint with extension mark - encode_constr_bit_str_bits(Constr,BitListVal,DoTag); - Size -> - case length(BitListVal) of - BitSize when BitSize =:= Size -> - encode_bitstring(BitListVal); - BitSize when BitSize < Size -> - PaddedList = - pad_bit_list(Size-BitSize,BitListVal), - encode_bitstring(PaddedList); - BitSize -> - exit({error, - {asn1, - {bitstring_length, - {{was,BitSize}, - {should_be,Size}}}}}) - end - end, - %%add unused byte to the Len - case DoTag of - [] -> - dotag_universal(?N_BIT_STRING,[Unused|OctetList],Len+1); -% {EncLen,LenLen}=encode_length(Len+1), -% {[?N_BIT_STRING,EncLen,Unused|OctetList],1+LenLen+Len+1}; - _ -> - dotag(DoTag, ?N_BIT_STRING, - {[Unused | OctetList],Len+1}) - end. - - -encode_constr_bit_str_bits({{_Min1,Max1},{Min2,Max2}},BitListVal,_DoTag) -> - 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}}}}}); - _ -> - encode_bitstring(BitListVal) - end; -encode_constr_bit_str_bits({Min,Max},BitListVal,_DoTag) -> - 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,Min}}}}}); - true -> - encode_bitstring(BitListVal) - 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), - 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, LenIn, OptOrMand) -> -% NewTags = new_tags(HasTag,#tag{class=?UNIVERSAL,number=?N_BIT_STRING}), - decode_restricted_string(Buffer, Range, ?N_BIT_STRING, Tags, LenIn, - NamedNumberList, OptOrMand,bin). - -decode_bit_string(Buffer, Range, NamedNumberList, Tags, LenIn, OptOrMand) -> -% NewTags = new_tags(HasTag,#tag{class=?UNIVERSAL,number=?N_BIT_STRING}), - decode_restricted_string(Buffer, Range, ?N_BIT_STRING, Tags, LenIn, - NamedNumberList, OptOrMand,old). - - -decode_bit_string2(1,<<0 ,Buffer/binary>>,_NamedNumberList,RemovedBytes,BinOrOld) -> - case BinOrOld of - bin -> - {{0,<<>>},Buffer,RemovedBytes}; - _ -> - {[], Buffer, RemovedBytes} - end; -decode_bit_string2(Len,<<Unused,Buffer/binary>>,NamedNumberList, - RemovedBytes,BinOrOld) -> - L = Len - 1, - <<Bits:L/binary,BufferTail/binary>> = Buffer, - case NamedNumberList of - [] -> - case BinOrOld of - bin -> - {{Unused,Bits},BufferTail,RemovedBytes}; - _ -> - BitString = decode_bitstring2(L, Unused, Buffer), - {BitString,BufferTail, RemovedBytes} - end; - _ -> - BitString = decode_bitstring2(L, Unused, Buffer), - {decode_bitstring_NNL(BitString,NamedNumberList), - BufferTail, - RemovedBytes} - 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, []) when is_binary(OctetList) -> - dotag_universal(?N_OCTET_STRING,OctetList,byte_size(OctetList)); -encode_octet_string(_C, OctetList, DoTag) when is_binary(OctetList) -> - dotag(DoTag, ?N_OCTET_STRING, {OctetList,byte_size(OctetList)}); -encode_octet_string(_C, OctetList, DoTag) when is_list(OctetList) -> - case length(OctetList) of - Len when DoTag =:= [] -> - dotag_universal(?N_OCTET_STRING,OctetList,Len); - Len -> - dotag(DoTag, ?N_OCTET_STRING, {OctetList,Len}) - end; -%% encode_octet_string(C, OctetList, DoTag) when is_list(OctetList) -> -%% dotag(DoTag, ?N_OCTET_STRING, {OctetList,length(OctetList)}); -encode_octet_string(C, {Name,OctetList}, DoTag) when is_atom(Name) -> - encode_octet_string(C, OctetList, DoTag). - - -%%============================================================================ -%% decode octet string -%% (Buffer, Range, HasTag, TotalLen) -> {String, Remain, RemovedBytes} -%% -%% Octet string is decoded as a restricted string -%%============================================================================ -decode_octet_string(Buffer, Range, Tags, TotalLen, OptOrMand) -> -%% NewTags = new_tags(HasTag,#tag{class=?UNIVERSAL,number=?N_OCTET_STRING}), - decode_restricted_string(Buffer, Range, ?N_OCTET_STRING, - Tags, TotalLen, [], OptOrMand,old). - -%%============================================================================ -%% Null value, ITU_T X.690 Chapter 8.8 -%% -%% encode NULL value -%%============================================================================ - -encode_null(_, []) -> - {[?N_NULL,0],2}; -encode_null(_, DoTag) -> - dotag(DoTag, ?N_NULL, {[],0}). - -%%============================================================================ -%% decode NULL value -%% (Buffer, HasTag, TotalLen) -> {NULL, Remain, RemovedBytes} -%%============================================================================ -decode_null(Buffer, Tags, OptOrMand) -> - NewTags = new_tags(Tags,#tag{class=?UNIVERSAL,number=?N_NULL}), - decode_null_notag(Buffer, NewTags, OptOrMand). - -decode_null_notag(Buffer, Tags, OptOrMand) -> - {RestTags, {FormLen, Buffer0, Rb0}} = - check_tags_i(Tags, Buffer, OptOrMand), - - case FormLen of - {?CONSTRUCTED,Len} -> - {_Buffer00,RestBytes} = split_list(Buffer0,Len), - {Val01, Buffer01, Rb01} = decode_null_notag(Buffer0, RestTags, - OptOrMand), - {Buffer02, Rb02} = restbytes2(RestBytes,Buffer01,noext), - {Val01, Buffer02, Rb0+Rb01+Rb02}; - {_,0} -> - {'NULL', Buffer0, Rb0}; - {_,Len} -> - exit({error,{asn1,{invalid_length,'NULL',Len}}}) - end. - - -%%============================================================================ -%% Object identifier, ITU_T X.690 Chapter 8.19 -%% -%% encode Object Identifier value -%%============================================================================ - -encode_object_identifier({Name,Val}, DoTag) when is_atom(Name) -> - encode_object_identifier(Val, DoTag); -encode_object_identifier(Val, []) -> - {EncVal,Len} = e_object_identifier(Val), - dotag_universal(?N_OBJECT_IDENTIFIER,EncVal,Len); -encode_object_identifier(Val, DoTag) -> - dotag(DoTag, ?N_OBJECT_IDENTIFIER, 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} = enc_obj_id_tail(Tail, [], 0), - {[H|R], Lh+Lr}. - -enc_obj_id_tail([], Ack, Len) -> - {lists:reverse(Ack), Len}; -enc_obj_id_tail([H|T], Ack, Len) -> - {B, L} = mk_object_val(H), - enc_obj_id_tail(T, [B|Ack], Len+L). +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]). %%%%%%%%%%% @@ -1643,476 +440,6 @@ 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(Buffer, Tags, OptOrMand) -> - NewTags = new_tags(Tags,#tag{class=?UNIVERSAL, - number=?N_OBJECT_IDENTIFIER}), - decode_object_identifier_notag(Buffer, NewTags, OptOrMand). - -decode_object_identifier_notag(Buffer, Tags, OptOrMand) -> - {RestTags, {FormLen, Buffer0, Rb0}} = - check_tags_i(Tags, Buffer, OptOrMand), - - case FormLen of - {?CONSTRUCTED,Len} -> - {Buffer00,RestBytes} = split_list(Buffer0,Len), - {Val01, Buffer01, Rb01} = - decode_object_identifier_notag(Buffer00, - RestTags, OptOrMand), - {Buffer02, Rb02} = restbytes2(RestBytes,Buffer01,noext), - {Val01, Buffer02, Rb0+Rb01+Rb02}; - {_,Len} -> - {[AddedObjVal|ObjVals],Buffer01} = - dec_subidentifiers(Buffer0,0,[],Len), - {Val1, Val2} = if - AddedObjVal < 40 -> - {0, AddedObjVal}; - AddedObjVal < 80 -> - {1, AddedObjVal - 40}; - true -> - {2, AddedObjVal - 80} - end, - {list_to_tuple([Val1, Val2 | ObjVals]), Buffer01, - Rb0+Len} - end. - -dec_subidentifiers(Buffer,_Av,Al,0) -> - {lists:reverse(Al),Buffer}; -dec_subidentifiers(<<1:1,H:7,T/binary>>,Av,Al,Len) -> - dec_subidentifiers(T,(Av bsl 7) + H,Al,Len-1); -dec_subidentifiers(<<H,T/binary>>,Av,Al,Len) -> - dec_subidentifiers(T,0,[((Av bsl 7) + H)|Al],Len-1). - -%%============================================================================ -%% 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,[]) -> - {EncVal,Len} = enc_relative_oid(Val), - dotag_universal(?'N_RELATIVE-OID',EncVal,Len); -encode_relative_oid(Val, DoTag) -> - dotag(DoTag, ?'N_RELATIVE-OID', enc_relative_oid(Val)). - -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(Buffer, Tags, OptOrMand) -> - NewTags = new_tags(Tags,#tag{class=?UNIVERSAL, - number=?'N_RELATIVE-OID'}), - decode_relative_oid_notag(Buffer, NewTags, OptOrMand). - -decode_relative_oid_notag(Buffer, Tags, OptOrMand) -> - {_RestTags, {_FormLen={_,Len}, Buffer0, Rb0}} = - check_tags_i(Tags, Buffer, OptOrMand), - {ObjVals,Buffer01} = - dec_subidentifiers(Buffer0,0,[],Len), - {list_to_tuple(ObjVals), Buffer01, Rb0+Len}. - -%%============================================================================ -%% Restricted character string types, ITU_T X.690 Chapter 8.21 -%% -%% encode Numeric Printable Teletex Videotex Visible IA5 Graphic General strings -%%============================================================================ -encode_restricted_string(_C, OctetList, StringType, []) - when is_binary(OctetList) -> - dotag_universal(StringType, OctetList, byte_size(OctetList)); -encode_restricted_string(_C, OctetList, StringType, DoTag) - when is_binary(OctetList) -> - dotag(DoTag, StringType, {OctetList, byte_size(OctetList)}); -encode_restricted_string(_C, OctetList, StringType, []) - when is_list(OctetList) -> - dotag_universal(StringType, OctetList, length(OctetList)); -encode_restricted_string(_C, OctetList, StringType, DoTag) - when is_list(OctetList) -> - dotag(DoTag, StringType, {OctetList, length(OctetList)}); -encode_restricted_string(C,{Name,OctetL},StringType,DoTag) when is_atom(Name) -> - encode_restricted_string(C, OctetL, StringType, DoTag). - -%%============================================================================ -%% 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, LenIn, OptOrMand) -> - {Val,Buffer2,Rb} = - decode_restricted_string_tag(Buffer, Range, StringType, Tags, - LenIn, [], OptOrMand,old), - {check_and_convert_restricted_string(Val,StringType,Range,[],old), - Buffer2,Rb}. - - -decode_restricted_string(Buffer, Range, StringType, Tags, LenIn, NNList, OptOrMand, BinOrOld ) -> - {Val,Buffer2,Rb} = - decode_restricted_string_tag(Buffer, Range, StringType, Tags, - LenIn, NNList, OptOrMand, BinOrOld), - {check_and_convert_restricted_string(Val,StringType,Range,NNList,BinOrOld), - Buffer2,Rb}. - -decode_restricted_string_tag(Buffer, Range, StringType, TagsIn, LenIn, NNList, OptOrMand, BinOrOld ) -> - NewTags = new_tags(TagsIn, #tag{class=?UNIVERSAL,number=StringType}), - decode_restricted_string_notag(Buffer, Range, StringType, NewTags, - LenIn, NNList, OptOrMand, BinOrOld). - - -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) -> - {byte_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=[MinExt|_]} when StrLen >= Lb; StrLen >= MinExt -> - 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. - -%%============================================================================= -%% Common routines for several string types including bit string -%% handles indefinite length -%%============================================================================= - - -decode_restricted_string_notag(Buffer, _Range, StringType, TagsIn, - _, NamedNumberList, OptOrMand, BinOrOld) -> - %%----------------------------------------------------------- - %% Get inner (the implicit tag or no tag) and - %% outer (the explicit tag) lengths. - %%----------------------------------------------------------- - {RestTags, {FormLength={_,_Len01}, Buffer0, Rb0}} = - check_tags_i(TagsIn, Buffer, OptOrMand), - - case FormLength of - {?CONSTRUCTED,Len} -> - {Buffer00, RestBytes} = split_list(Buffer0,Len), - {Val01, Buffer01, Rb01} = - decode_restricted_parts(Buffer00, RestBytes, [], StringType, - RestTags, - Len, NamedNumberList, - OptOrMand, - BinOrOld, 0, []), - {Val01, Buffer01, Rb0+Rb01}; - {_, Len} -> - {Val01, Buffer01, Rb01} = - decode_restricted(Buffer0, Len, StringType, - NamedNumberList, BinOrOld), - {Val01, Buffer01, Rb0+Rb01} - end. - - -decode_restricted_parts(Buffer, RestBytes, [], StringType, RestTags, Len, NNList, - OptOrMand, BinOrOld, AccRb, AccVal) -> - DecodeFun = case RestTags of - [] -> fun decode_restricted_string_tag/8; - _ -> fun decode_restricted_string_notag/8 - end, - {Val, Buffer1, Rb} = - DecodeFun(Buffer, [], StringType, RestTags, - no_length, NNList, - OptOrMand, BinOrOld), - {Buffer2,More} = - case Buffer1 of - <<0,0,Buffer10/binary>> when Len == indefinite -> - {Buffer10,false}; - <<>> -> - {RestBytes,false}; - _ -> - {Buffer1,true} - end, - {NewVal, NewRb} = - 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, - case More of - false -> - {NewVal, Buffer2, NewRb}; - true -> - decode_restricted_parts(Buffer2, RestBytes, [], StringType, RestTags, Len, NNList, - OptOrMand, BinOrOld, NewRb, NewVal) - end. - - - -decode_restricted(Buffer, InnerLen, StringType, NamedNumberList,BinOrOld) -> - - case StringType of - ?N_BIT_STRING -> - decode_bit_string2(InnerLen,Buffer,NamedNumberList,InnerLen,BinOrOld); - - ?N_UniversalString -> - <<PreBuff:InnerLen/binary,RestBuff/binary>> = Buffer,%%added for binary - UniString = mk_universal_string(binary_to_list(PreBuff)), - {UniString,RestBuff,InnerLen}; - ?N_BMPString -> - <<PreBuff:InnerLen/binary,RestBuff/binary>> = Buffer,%%added for binary - BMP = mk_BMP_string(binary_to_list(PreBuff)), - {BMP,RestBuff,InnerLen}; - _ -> - <<PreBuff:InnerLen/binary,RestBuff/binary>> = Buffer,%%added for binary - {PreBuff, RestBuff, InnerLen} - end. - - - -%%============================================================================ -%% encode Universal string -%%============================================================================ - -encode_universal_string(C, {Name, Universal}, DoTag) when is_atom(Name) -> - encode_universal_string(C, Universal, DoTag); -encode_universal_string(_C, Universal, []) -> - OctetList = mk_uni_list(Universal), - dotag_universal(?N_UniversalString,OctetList,length(OctetList)); -encode_universal_string(_C, Universal, DoTag) -> - OctetList = mk_uni_list(Universal), - dotag(DoTag, ?N_UniversalString, {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, LenIn, OptOrMand) -> -% NewTags = new_tags(HasTag, #tag{class=?UNIVERSAL,number=?N_UniversalString}), - decode_restricted_string(Buffer, Range, ?N_UniversalString, - Tags, LenIn, [], OptOrMand,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(_,UTF8String,[]) when is_binary(UTF8String) -> - dotag_universal(?N_UTF8String,UTF8String,byte_size(UTF8String)); -encode_UTF8_string(_,UTF8String,DoTag) when is_binary(UTF8String) -> - dotag(DoTag,?N_UTF8String,{UTF8String,byte_size(UTF8String)}); -encode_UTF8_string(_,UTF8String,[]) -> - dotag_universal(?N_UTF8String,UTF8String,length(UTF8String)); -encode_UTF8_string(_,UTF8String,DoTag) -> - dotag(DoTag,?N_UTF8String,{UTF8String,length(UTF8String)}). - -%%============================================================================ -%% decode UTF8 string -%%============================================================================ - -decode_UTF8_string(Buffer, Tags, OptOrMand) -> - NewTags = new_tags(Tags, #tag{class=?UNIVERSAL,number=?N_UTF8String}), - decode_UTF8_string_notag(Buffer, NewTags, OptOrMand). - -decode_UTF8_string_notag(Buffer, Tags, OptOrMand) -> - {RestTags, {FormLen, Buffer0, Rb0}} = - check_tags_i(Tags, Buffer, OptOrMand), - case FormLen of - {?CONSTRUCTED,Len} -> - %% an UTF8String may be encoded as a constructed type - {Buffer00,RestBytes} = split_list(Buffer0,Len), - {Val01, Buffer01, Rb01} = - decode_UTF8_string_notag(Buffer00,RestTags,OptOrMand), - {Buffer02, Rb02} = restbytes2(RestBytes,Buffer01,noext), - {Val01, Buffer02, Rb0+Rb01+Rb02}; - {_,Len} -> - <<Result:Len/binary,RestBuff/binary>> = Buffer0, - {Result,RestBuff,Rb0 + Len} - end. - - -%%============================================================================ -%% encode BMP string -%%============================================================================ - -encode_BMP_string(C, {Name,BMPString}, DoTag) when is_atom(Name) -> - encode_BMP_string(C, BMPString, DoTag); -encode_BMP_string(_C, BMPString, []) -> - OctetList = mk_BMP_list(BMPString), - dotag_universal(?N_BMPString,OctetList,length(OctetList)); -encode_BMP_string(_C, BMPString, DoTag) -> - OctetList = mk_BMP_list(BMPString), - dotag(DoTag, ?N_BMPString, {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, LenIn, OptOrMand) -> -% NewTags = new_tags(HasTag, #tag{class=?UNIVERSAL,number=?N_BMPString}), - decode_restricted_string(Buffer, Range, ?N_BMPString, - Tags, LenIn, [], OptOrMand,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}, DoTag) when is_atom(Name) -> - encode_generalized_time(C, OctetList, DoTag); -encode_generalized_time(_C, OctetList, []) -> - dotag_universal(?N_GeneralizedTime,OctetList,length(OctetList)); -encode_generalized_time(_C, OctetList, DoTag) -> - dotag(DoTag, ?N_GeneralizedTime, {OctetList,length(OctetList)}). - -%%============================================================================ -%% decode Generalized time -%% (Buffer, Range, HasTag, TotalLen) -> {String, Remain, RemovedBytes} -%%============================================================================ - -decode_generalized_time(Buffer, Range, Tags, TotalLen, OptOrMand) -> - NewTags = new_tags(Tags,#tag{class=?UNIVERSAL, - number=?N_GeneralizedTime}), - decode_generalized_time_notag(Buffer, Range, NewTags, TotalLen, OptOrMand). - -decode_generalized_time_notag(Buffer, Range, Tags, TotalLen, OptOrMand) -> - {RestTags, {FormLen, Buffer0, Rb0}} = - check_tags_i(Tags, Buffer, OptOrMand), - - case FormLen of - {?CONSTRUCTED,Len} -> - {Buffer00,RestBytes} = split_list(Buffer0,Len), - {Val01, Buffer01, Rb01} = - decode_generalized_time_notag(Buffer00, Range, - RestTags, TotalLen, - OptOrMand), - {Buffer02, Rb02} = restbytes2(RestBytes,Buffer01,noext), - {Val01, Buffer02, Rb0+Rb01+Rb02}; - {_,Len} -> - <<PreBuff:Len/binary,RestBuff/binary>> = Buffer0, - {binary_to_list(PreBuff), RestBuff, Rb0+Len} - end. - -%%============================================================================ -%% Universal time, ITU_T X.680 Chapter 40 -%% -%% encode UTC time -%%============================================================================ - -encode_utc_time(C, {Name,OctetList}, DoTag) when is_atom(Name) -> - encode_utc_time(C, OctetList, DoTag); -encode_utc_time(_C, OctetList, []) -> - dotag_universal(?N_UTCTime, OctetList,length(OctetList)); -encode_utc_time(_C, OctetList, DoTag) -> - dotag(DoTag, ?N_UTCTime, {OctetList,length(OctetList)}). - -%%============================================================================ -%% decode UTC time -%% (Buffer, Range, HasTag, TotalLen) -> {String, Remain, RemovedBytes} -%%============================================================================ - -decode_utc_time(Buffer, Range, Tags, TotalLen, OptOrMand) -> - NewTags = new_tags(Tags,#tag{class=?UNIVERSAL,number=?N_UTCTime}), - decode_utc_time_notag(Buffer, Range, NewTags, TotalLen, OptOrMand). - -decode_utc_time_notag(Buffer, Range, Tags, TotalLen, OptOrMand) -> - {RestTags, {FormLen, Buffer0, Rb0}} = - check_tags_i(Tags, Buffer, OptOrMand), - - case FormLen of - {?CONSTRUCTED,Len} -> - {Buffer00,RestBytes} = split_list(Buffer0,Len), - {Val01, Buffer01, Rb01} = - decode_utc_time_notag(Buffer00, Range, - RestTags, TotalLen, - OptOrMand), - {Buffer02, Rb02} = restbytes2(RestBytes,Buffer01,noext), - {Val01, Buffer02, Rb0+Rb01+Rb02}; - {_,Len} -> - <<PreBuff:Len/binary,RestBuff/binary>> = Buffer0, - {binary_to_list(PreBuff), RestBuff, Rb0+Len} - end. - - %%============================================================================ %% Length handling %% @@ -2122,8 +449,6 @@ decode_utc_time_notag(Buffer, Range, Tags, TotalLen, OptOrMand) -> %% [<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) -> @@ -2162,242 +487,12 @@ decode_length(<<1:1,LL:7,T/binary>>) -> <<Length:LL/unit:8,Rest/binary>> = T, {{Length,Rest}, LL+1}. -%decode_length([128 | T]) -> -% {{indefinite, T},1}; -%decode_length([H | T]) when H =< 127 -> -% {{H, T},1}; -%decode_length([H | T]) -> -% dec_long_length(H band 16#7F, T, 0, 1). - - -%%dec_long_length(0, Buffer, Acc, Len) -> -%% {{Acc, Buffer},Len}; -%%dec_long_length(Bytes, [H | T], Acc, Len) -> -%% dec_long_length(Bytes - 1, T, (Acc bsl 8) + H, Len+1). - -%%=========================================================================== -%% Decode tag and length -%% -%% decode_tag_and_length(Buffer) -> {Tag, Len, RemainingBuffer, RemovedBytes} -%% -%%=========================================================================== - -decode_tag_and_length(Buffer) -> - {Tag, Buffer2, RemBytesTag} = decode_tag(Buffer), - {{Len, Buffer3}, RemBytesLen} = decode_length(Buffer2), - {Tag, Len, Buffer3, RemBytesTag+RemBytesLen}. - - -%%============================================================================ -%% Check if valid tag -%% -%% check_if_valid_tag(Tag, List_of_valid_tags, OptOrMand) -> name of the tag -%%============================================================================ - -check_if_valid_tag(<<0,0,_/binary>>,_,_) -> - asn1_EOC; -check_if_valid_tag(<<>>, _, OptOrMand) -> - check_if_valid_tag2_error([], OptOrMand); -check_if_valid_tag(Bytes, ListOfTags, OptOrMand) when is_binary(Bytes) -> - {Tag, _, _} = decode_tag(Bytes), - check_if_valid_tag(Tag, ListOfTags, OptOrMand); - -%% This alternative should be removed in the near future -%% Bytes as input should be the only necessary call -check_if_valid_tag(Tag, ListOfTags, OptOrMand) -> - {Class, _Form, TagNo} = Tag, - C = code_class(Class), - T = case C of - 'UNIVERSAL' -> - code_type(TagNo); - _ -> - TagNo - end, - check_if_valid_tag2({C,T}, ListOfTags, Tag, OptOrMand). - -check_if_valid_tag2(_Class_TagNo, [], Tag, MandOrOpt) -> - check_if_valid_tag2_error(Tag,MandOrOpt); -check_if_valid_tag2(Class_TagNo, [{TagName,TagList}|T], Tag, OptOrMand) -> - case check_if_valid_tag_loop(Class_TagNo, TagList) of - true -> - TagName; - false -> - check_if_valid_tag2(Class_TagNo, T, Tag, OptOrMand) - end. - --spec check_if_valid_tag2_error(term(), atom()) -> no_return(). - -check_if_valid_tag2_error(Tag,mandatory) -> - exit({error,{asn1,{invalid_tag,Tag}}}); -check_if_valid_tag2_error(Tag,_) -> - exit({error,{asn1,{no_optional_tag,Tag}}}). - -check_if_valid_tag_loop(_Class_TagNo,[]) -> - false; -check_if_valid_tag_loop(Class_TagNo,[H|T]) -> - %% It is not possible to distinguish between SEQUENCE OF and SEQUENCE, and - %% between SET OF and SET because both are coded as 16 and 17, respectively. - H_without_OF = case H of - {C, 'SEQUENCE OF'} -> - {C, 'SEQUENCE'}; - {C, 'SET OF'} -> - {C, 'SET'}; - Else -> - Else - end, - - case H_without_OF of - Class_TagNo -> - true; - {_,_} -> - check_if_valid_tag_loop(Class_TagNo,T); - _ -> - check_if_valid_tag_loop(Class_TagNo,H), - check_if_valid_tag_loop(Class_TagNo,T) - end. - - - -code_class(0) -> 'UNIVERSAL'; -code_class(16#40) -> 'APPLICATION'; -code_class(16#80) -> 'CONTEXT'; -code_class(16#C0) -> 'PRIVATE'. - - -code_type(1) -> 'BOOLEAN'; -code_type(2) -> 'INTEGER'; -code_type(3) -> 'BIT STRING'; -code_type(4) -> 'OCTET STRING'; -code_type(5) -> 'NULL'; -code_type(6) -> 'OBJECT IDENTIFIER'; -code_type(7) -> 'ObjectDescriptor'; -code_type(8) -> 'EXTERNAL'; -code_type(9) -> 'REAL'; -code_type(10) -> 'ENUMERATED'; -code_type(11) -> 'EMBEDDED_PDV'; -code_type(16) -> 'SEQUENCE'; -% code_type(16) -> 'SEQUENCE OF'; -code_type(17) -> 'SET'; -% code_type(17) -> 'SET OF'; -code_type(18) -> 'NumericString'; -code_type(19) -> 'PrintableString'; -code_type(20) -> 'TeletexString'; -code_type(21) -> 'VideotexString'; -code_type(22) -> 'IA5String'; -code_type(23) -> 'UTCTime'; -code_type(24) -> 'GeneralizedTime'; -code_type(25) -> 'GraphicString'; -code_type(26) -> 'VisibleString'; -code_type(27) -> 'GeneralString'; -code_type(28) -> 'UniversalString'; -code_type(30) -> 'BMPString'; -code_type(Else) -> exit({error,{asn1,{unrecognized_type,Else}}}). - -%%------------------------------------------------------------------------- -%% decoding of the components of a SET -%%------------------------------------------------------------------------- - -decode_set(Rb, indefinite, <<0,0,Bytes/binary>>, _OptOrMand, _Fun3, Acc) -> - {lists:reverse(Acc),Bytes,Rb+2}; - -decode_set(Rb, indefinite, Bytes, OptOrMand, Fun3, Acc) -> - case Fun3(Bytes, OptOrMand) of - {_Term, _Remain, 0} -> - {lists:reverse(Acc),Bytes,Rb}; - {Term, Remain, Rb1} -> - Fun3(Bytes, OptOrMand), - decode_set(Rb+Rb1, indefinite, Remain, OptOrMand, Fun3, [Term|Acc]) - end; -%% {Term, Remain, Rb1} = Fun3(Bytes, OptOrMand), -%% decode_set(Rb+Rb1, indefinite, Remain, OptOrMand, Fun3, [Term|Acc]); - -decode_set(Rb, Num, Bytes, _OptOrMand, _Fun3, Acc) when Num == 0 -> - {lists:reverse(Acc), Bytes, Rb}; - -decode_set(_, Num, _, _, _, _) when Num < 0 -> - exit({error,{asn1,{length_error,'SET'}}}); - -decode_set(Rb, Num, Bytes, OptOrMand, Fun3, Acc) -> - case Fun3(Bytes, OptOrMand) of - {_Term, _Remain, 0} -> - {lists:reverse(Acc),Bytes,Rb}; - {Term, Remain, Rb1} -> - Fun3(Bytes, OptOrMand), - decode_set(Rb+Rb1, Num-Rb1, Remain, OptOrMand, Fun3, [Term|Acc]) - end. -%% {Term, Remain, Rb1} = Fun3(Bytes, OptOrMand), -%% decode_set(Rb+Rb1, Num-Rb1, Remain, OptOrMand, Fun3, [Term|Acc]). - - -%%------------------------------------------------------------------------- -%% decoding of SEQUENCE OF and SET OF -%%------------------------------------------------------------------------- - -decode_components(Rb, indefinite, <<0,0,Bytes/binary>>, _Fun3, _TagIn, Acc) -> - {lists:reverse(Acc),Bytes,Rb+2}; - -decode_components(Rb, indefinite, Bytes, Fun3, TagIn, Acc) -> - {Term, Remain, Rb1} = Fun3(Bytes, mandatory, TagIn), - decode_components(Rb+Rb1, indefinite, Remain, Fun3, TagIn, [Term|Acc]); - -decode_components(Rb, Num, Bytes, _Fun3, _TagIn, Acc) when Num == 0 -> - {lists:reverse(Acc), Bytes, Rb}; - -decode_components(_, Num, _, _, _, _) when Num < 0 -> - exit({error,{asn1,{length_error,'SET/SEQUENCE OF'}}}); - -decode_components(Rb, Num, Bytes, Fun3, TagIn, Acc) -> - {Term, Remain, Rb1} = Fun3(Bytes, mandatory, TagIn), - decode_components(Rb+Rb1, Num-Rb1, Remain, Fun3, TagIn, [Term|Acc]). - -%%decode_components(Rb, indefinite, [0,0|Bytes], _Fun3, _TagIn, Acc) -> -%% {lists:reverse(Acc),Bytes,Rb+2}; - -decode_components(Rb, indefinite, <<0,0,Bytes/binary>>, _Fun4, _TagIn, _Fun, Acc) -> - {lists:reverse(Acc),Bytes,Rb+2}; - -decode_components(Rb, indefinite, Bytes, _Fun4, TagIn, _Fun, Acc) -> - {Term, Remain, Rb1} = _Fun4(Bytes, mandatory, TagIn, _Fun), - decode_components(Rb+Rb1, indefinite, Remain, _Fun4, TagIn, _Fun, [Term|Acc]); - -decode_components(Rb, Num, Bytes, _Fun4, _TagIn, _Fun, Acc) when Num == 0 -> - {lists:reverse(Acc), Bytes, Rb}; - -decode_components(_, Num, _, _, _, _, _) when Num < 0 -> - exit({error,{asn1,{length_error,'SET/SEQUENCE OF'}}}); - -decode_components(Rb, Num, Bytes, _Fun4, TagIn, _Fun, Acc) -> - {Term, Remain, Rb1} = _Fun4(Bytes, mandatory, TagIn, _Fun), - decode_components(Rb+Rb1, Num-Rb1, Remain, _Fun4, TagIn, _Fun, [Term|Acc]). - - - -%%------------------------------------------------------------------------- -%% INTERNAL HELPER FUNCTIONS (not exported) -%%------------------------------------------------------------------------- - - -%%========================================================================== -%% Encode tag -%% -%% dotag(tag | notag, TagValpattern | TagValTuple, [Length, Value]) -> [Tag] -%% TagValPattern is a correct bitpattern for a tag -%% TagValTuple is a tuple of three bitpatterns, Class, Form and TagNo where -%% Class = UNIVERSAL | APPLICATION | CONTEXT | PRIVATE -%% Form = Primitive | Constructed -%% TagNo = Number of tag -%%========================================================================== - 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(Tags, Tag, Bytes) -> - encode_tags(Tags ++ [#tag{class=?UNIVERSAL,number=Tag,form=?PRIMITIVE}], - Bytes, size(Bytes)). + Bytes, Len). dotag_universal(UniversalTag,Bytes,Len) when Len =< 16#7F-> {[UniversalTag,Len,Bytes],2+Len}; @@ -2415,47 +510,6 @@ decode_integer2(Len,<<1:1,B2:7,Bs/binary>>,RemovedBytes) -> Int = N - (1 bsl (8 * Len - 1)), {Int,Buffer2,RemovedBytes}. -%%decode_integer2(Len,Buffer,Acc,RemovedBytes) when (hd(Buffer) band 16#FF) =< 16#7F -> -%% {decode_integer_pos(Buffer, 8 * (Len - 1)),skip(Buffer,Len),RemovedBytes}; -%%decode_integer2(Len,Buffer,Acc,RemovedBytes) -> -%% {decode_integer_neg(Buffer, 8 * (Len - 1)),skip(Buffer,Len),RemovedBytes}. - -%%decode_integer_pos([Byte|Tail], Shift) -> -%% (Byte bsl Shift) bor decode_integer_pos(Tail, Shift-8); -%%decode_integer_pos([], _) -> 0. - - -%%decode_integer_neg([Byte|Tail], Shift) -> -%% (-128 + (Byte band 127) bsl Shift) bor decode_integer_pos(Tail, Shift-8). - - -concat_bit_binaries([],Bin={_,_}) -> - Bin; -concat_bit_binaries({0,B1},{U2,B2}) -> - {U2,<<B1/binary,B2/binary>>}; -concat_bit_binaries({U1,B1},{U2,B2}) -> - S1 = (size(B1) * 8) - U1, - S2 = (size(B2) * 8) - U2, - PadBits = 8 - ((S1+S2) rem 8), - {PadBits, <<B1:S1/binary-unit:1,B2:S2/binary-unit:1,0:PadBits>>}; -concat_bit_binaries(L1,L2) when is_list(L1), is_list(L2) -> - %% this case occur when decoding with NNL - L1 ++ L2. - - -get_constraint(C,Key) -> - case lists:keyfind(Key,1,C) of - false -> - no; - {_, V} -> - V - end. - -%%skip(Buffer, 0) -> -%% Buffer; -%%skip([H | T], Len) -> -%% skip(T, Len-1). - new_tags([],LastTag) -> [LastTag]; new_tags(Tags = [#tag{type='IMPLICIT'}],_LastTag) -> diff --git a/lib/asn1/src/asn1rt_ber_bin_v2.erl b/lib/asn1/src/asn1rt_ber_bin_v2.erl index 9ff5017c68..92ca11cf89 100644 --- a/lib/asn1/src/asn1rt_ber_bin_v2.erl +++ b/lib/asn1/src/asn1rt_ber_bin_v2.erl @@ -22,8 +22,7 @@ %% encoding / decoding of BER -export([decode/1, decode/2, match_tags/2, encode/1, encode/2]). --export([fixoptionals/2, cindex/3, - list_to_record/2, +-export([fixoptionals/2, encode_tag_val/1, encode_tags/3, skip_ExtensionAdditions/2]). @@ -54,8 +53,6 @@ decode_open_type_as_binary/3]). -export([decode_primitive_incomplete/2,decode_selective/2]). - --export([is_nif_loadable/0]). % the encoding of class of tag bits 8 and 7 -define(UNIVERSAL, 0). @@ -135,12 +132,7 @@ encode(Tlv,_) when is_binary(Tlv) -> encode([Tlv],Method) -> encode(Tlv,Method); encode(Tlv, nif) -> - case is_nif_loadable() of - true -> - asn1rt_nif:encode_ber_tlv(Tlv); - false -> - encode_erl(Tlv) - end; + asn1rt_nif:encode_ber_tlv(Tlv); encode(Tlv, _) -> encode_erl(Tlv). @@ -178,36 +170,15 @@ decode(B) -> %% asn1-1.7 decode(B, nif) -> - case is_nif_loadable() of - true -> - case asn1rt_nif:decode_ber_tlv(B) of - {error, Reason} -> handle_error(Reason, B); - Else -> Else - end; - false -> - decode(B) + 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,<<>>}. -%% Have to check this since asn1 is not guaranteed to be available -is_nif_loadable() -> - case application:get_env(asn1, nif_loadable) of - {ok,R} -> - R; - undefined -> - case catch code:load_file(asn1rt_nif) of - {module, asn1rt_nif} -> - application:set_env(asn1, nif_loadable, true), - true; - _Else -> - application:set_env(asn1, nif_loadable, false), - false - end - end. - handle_error([],_)-> exit({error,{asn1,{"memory allocation problem"}}}); handle_error({$1,_},L) -> % error in nif @@ -612,13 +583,6 @@ match_tags(Tlv, []) -> Tlv; match_tags(Tlv = {Tag,_V},[T|_Tt]) -> exit({error,{asn1,{wrong_tag,{{expected,T},{got,Tag,Tlv}}}}}). - - -cindex(Ix,Val,Cname) -> - case element(Ix,Val) of - {Cname,Val2} -> Val2; - X -> X - end. %%% %% skips components that do not match a tag in Tags @@ -642,13 +606,6 @@ skip_ExtensionAdditions(TLV=[{Tag,_}|Rest],Tags) -> %%=============================================================================== %%=============================================================================== -% converts a list to a record if necessary -list_to_record(Name,List) when is_list(List) -> - list_to_tuple([Name|List]); -list_to_record(_Name,Tuple) when is_tuple(Tuple) -> - Tuple. - - fixoptionals(OptList,Val) when is_list(Val) -> fixoptionals(OptList,Val,1,[],[]). diff --git a/lib/asn1/src/asn1rt_per_bin.erl b/lib/asn1/src/asn1rt_per_bin.erl deleted file mode 100644 index 5772f09bf4..0000000000 --- a/lib/asn1/src/asn1rt_per_bin.erl +++ /dev/null @@ -1,2285 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2012. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% 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). -%% encoding / decoding of PER aligned - --include("asn1_records.hrl"). - --export([dec_fixup/3, cindex/3, list_to_record/2]). --export([setchoiceext/1, setext/1, fixoptionals/2, fixoptionals/3, - fixextensions/2, - getext/1, getextension/2, skipextensions/3, getbit/1, getchoice/3 ]). --export([getoptionals/2, getoptionals2/2, set_choice/3, encode_integer/2, encode_integer/3 ]). --export([decode_integer/2, decode_integer/3, encode_small_number/1, encode_boolean/1, - decode_boolean/1, encode_length/2, decode_length/1, decode_length/2, - encode_small_length/1, decode_small_length/1, - decode_compact_bit_string/3]). --export([decode_enumerated/3, - encode_bit_string/3, decode_bit_string/3 ]). --export([encode_octet_string/2, decode_octet_string/2, - encode_null/1, decode_null/1, - 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_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 - ]). --export([complete_bytes/1, getbits/2, getoctets/2, minimum_bits/1]). - --define('16K',16384). --define('32K',32768). --define('64K',65536). - -dec_fixup(Terms,Cnames,RemBytes) -> - dec_fixup(Terms,Cnames,RemBytes,[]). - -dec_fixup([novalue|T],[_Hc|Tc],RemBytes,Acc) -> - dec_fixup(T,Tc,RemBytes,Acc); -dec_fixup([{_Name,novalue}|T],[_Hc|Tc],RemBytes,Acc) -> - dec_fixup(T,Tc,RemBytes,Acc); -dec_fixup([H|T],[Hc|Tc],RemBytes,Acc) -> - dec_fixup(T,Tc,RemBytes,[{Hc,H}|Acc]); -dec_fixup([],_Cnames,RemBytes,Acc) -> - {lists:reverse(Acc),RemBytes}. - -cindex(Ix,Val,Cname) -> - case element(Ix,Val) of - {Cname,Val2} -> Val2; - X -> X - end. - -%% converts a list to a record if necessary -list_to_record(_Name,Tuple) when is_tuple(Tuple) -> - Tuple; -list_to_record(Name,List) when is_list(List) -> - list_to_tuple([Name|List]). - -%%-------------------------------------------------------- -%% setchoiceext(InRootSet) -> [{bit,X}] -%% X is set to 1 when InRootSet==false -%% X is set to 0 when InRootSet==true -%% -setchoiceext(true) -> - [{debug,choiceext},{bits,1,0}]; -setchoiceext(false) -> - [{debug,choiceext},{bits,1,1}]. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% setext(true|false) -> CompleteList -%% - -setext(false) -> - [{debug,ext},{bits,1,0}]; -setext(true) -> - [{debug,ext},{bits,1,1}]. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% This version of fixoptionals/2 are left only because of -%% backward compatibility with older generates - -fixoptionals(OptList,Val) when is_tuple(Val) -> - fixoptionals1(OptList,Val,[]); - -fixoptionals(OptList,Val) when is_list(Val) -> - fixoptionals1(OptList,Val,1,[],[]). - -fixoptionals1([],Val,Acc) -> - %% return {Val,Opt} - {Val,lists:reverse(Acc)}; -fixoptionals1([{_,Pos}|Ot],Val,Acc) -> - case element(Pos+1,Val) of - asn1_NOVALUE -> fixoptionals1(Ot,Val,[0|Acc]); - asn1_DEFAULT -> fixoptionals1(Ot,Val,[0|Acc]); - _ -> fixoptionals1(Ot,Val,[1|Acc]) - end. - - -fixoptionals1([{Name,Pos}|Ot],[{Name,Val}|Vt],_Opt,Acc1,Acc2) -> - fixoptionals1(Ot,Vt,Pos+1,[1|Acc1],[{Name,Val}|Acc2]); -fixoptionals1([{_Name,Pos}|Ot],V,Pos,Acc1,Acc2) -> - fixoptionals1(Ot,V,Pos+1,[0|Acc1],[asn1_NOVALUE|Acc2]); -fixoptionals1(O,[Vh|Vt],Pos,Acc1,Acc2) -> - fixoptionals1(O,Vt,Pos+1,Acc1,[Vh|Acc2]); -fixoptionals1([],[Vh|Vt],Pos,Acc1,Acc2) -> - fixoptionals1([],Vt,Pos+1,Acc1,[Vh|Acc2]); -fixoptionals1([],[],_,Acc1,Acc2) -> - % return {Val,Opt} - {list_to_tuple([asn1_RECORDNAME|lists:reverse(Acc2)]),lists:reverse(Acc1)}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% 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,Bits}}; - -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. - - -getext(Bytes) when is_tuple(Bytes) -> - getbit(Bytes); -getext(Bytes) when is_binary(Bytes) -> - getbit({0,Bytes}). - -getextension(0, Bytes) -> - {{},Bytes}; -getextension(1, Bytes) -> - {Len,Bytes2} = decode_small_length(Bytes), - {Blist, Bytes3} = getbits_as_list(Len,Bytes2), - {list_to_tuple(Blist),Bytes3}. - -fixextensions({ext,ExtPos,ExtNum},Val) -> - case fixextensions(ExtPos,ExtNum+ExtPos,Val,0) of - 0 -> []; - ExtBits -> - [encode_small_length(ExtNum),{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,ExtensionBitPattern) -> - case (catch element(Nr,ExtensionBitPattern)) of - 1 -> - {_,Bytes2} = decode_open_type(Bytes,[]), - skipextensions(Bytes2, Nr+1, ExtensionBitPattern); - 0 -> - skipextensions(Bytes, Nr+1, ExtensionBitPattern); - {'EXIT',_} -> % badarg, no more extensions - 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}). - -%% old version kept for backward compatibility with generates from R7B -getoptionals(Bytes,NumOpt) -> - {Blist,Bytes1} = getbits_as_list(NumOpt,Bytes), - {list_to_tuple(Blist),Bytes1}. - -%% new version used in generates from r8b_patch/3 and later -getoptionals2(Bytes,NumOpt) -> - getbits(Bytes,NumOpt). - - -%% 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_binary(Bytes) -> - getbits_as_binary(Num,{0,Bytes}); -getbits_as_binary(0,Buffer) -> - {{0,<<>>},Buffer}; -getbits_as_binary(Num,{0,Bin}) when Num > 16 -> - Used = Num rem 8, - Pad = (8 - Used) rem 8, -% Nbytes = Num div 8, - <<Bits:Num,_:Pad,RestBin/binary>> = Bin, - {{Pad,<<Bits:Num,0:Pad>>},RestBin}; -getbits_as_binary(Num,Buffer={_Used,_Bin}) -> % Unaligned buffer - %% Num =< 16, - {Bits2,Buffer2} = getbits(Buffer,Num), - Pad = (8 - (Num rem 8)) rem 8, - {{Pad,<<Bits2:Num,0:Pad>>},Buffer2}. - - -% integer_from_list(Int,[],BigInt) -> -% BigInt; -% integer_from_list(Int,[H|T],BigInt) when Int < 8 -> -% (BigInt bsl Int) bor (H bsr (8-Int)); -% integer_from_list(Int,[H|T],BigInt) -> -% integer_from_list(Int-8,T,(BigInt bsl 8) bor H). - -getbits_as_list(Num,Bytes) when is_binary(Bytes) -> - getbits_as_list(Num,{0,Bytes},[]); -getbits_as_list(Num,Bytes) -> - getbits_as_list(Num,Bytes,[]). - -%% If buffer is empty and nothing more will be picked. -getbits_as_list(0, B, Acc) -> - {lists:reverse(Acc),B}; -%% If first byte in buffer is full and at least one byte will be picked, -%% then pick one byte. -getbits_as_list(N,{0,Bin},Acc) when N >= 8 -> - <<B7:1,B6:1,B5:1,B4:1,B3:1,B2:1,B1:1,B0:1,Rest/binary>> = Bin, - getbits_as_list(N-8,{0,Rest},[B0,B1,B2,B3,B4,B5,B6,B7|Acc]); -getbits_as_list(N,{Used,Bin},Acc) when N >= 4, Used =< 4 -> - NewUsed = Used + 4, - Rem = 8 - NewUsed, - <<_:Used,B3:1,B2:1,B1:1,B0:1,_:Rem, Rest/binary>> = Bin, - NewRest = case Rem of 0 -> Rest; _ -> Bin end, - getbits_as_list(N-4,{NewUsed rem 8,NewRest},[B0,B1,B2,B3|Acc]); -getbits_as_list(N,{Used,Bin},Acc) when N >= 2, Used =< 6 -> - NewUsed = Used + 2, - Rem = 8 - NewUsed, - <<_:Used,B1:1,B0:1,_:Rem, Rest/binary>> = Bin, - NewRest = case Rem of 0 -> Rest; _ -> Bin end, - getbits_as_list(N-2,{NewUsed rem 8,NewRest},[B0,B1|Acc]); -getbits_as_list(N,{Used,Bin},Acc) when Used =< 7 -> - NewUsed = Used + 1, - Rem = 8 - NewUsed, - <<_:Used,B0:1,_:Rem, Rest/binary>> = Bin, - NewRest = case Rem of 0 -> Rest; _ -> Bin end, - getbits_as_list(N-1,{NewUsed rem 8,NewRest},[B0|Acc]). - - -getbit({7,<<_:7,B:1,Rest/binary>>}) -> - {B,{0,Rest}}; -getbit({0,Buffer = <<B:1,_:7,_/binary>>}) -> - {B,{1,Buffer}}; -getbit({Used,Buffer}) -> - Unused = (8 - Used) - 1, - <<_:Used,B:1,_:Unused,_/binary>> = Buffer, - {B,{Used+1,Buffer}}; -getbit(Buffer) when is_binary(Buffer) -> - getbit({0,Buffer}). - - -getbits({0,Buffer},Num) when (Num rem 8) == 0 -> - <<Bits:Num,Rest/binary>> = Buffer, - {Bits,{0,Rest}}; -getbits({Used,Bin},Num) -> - NumPlusUsed = Num + Used, - NewUsed = NumPlusUsed rem 8, - Unused = (8-NewUsed) rem 8, - case Unused of - 0 -> - <<_:Used,Bits:Num,Rest/binary>> = Bin, - {Bits,{0,Rest}}; - _ -> - Bytes = NumPlusUsed div 8, - <<_:Used,Bits:Num,_UBits:Unused,_/binary>> = Bin, - <<_:Bytes/binary,Rest/binary>> = Bin, - {Bits,{NewUsed,Rest}} - end; -getbits(Bin,Num) when is_binary(Bin) -> - getbits({0,Bin},Num). - - - -% getoctet(Bytes) when is_list(Bytes) -> -% getoctet({0,Bytes}); -% getoctet(Bytes) -> -% %% io:format("getoctet:Buffer = ~p~n",[Bytes]), -% getoctet1(Bytes). - -% getoctet1({0,[H|T]}) -> -% {H,{0,T}}; -% getoctet1({Pos,[_,H|T]}) -> -% {H,{0,T}}. - -align({0,L}) -> - {0,L}; -align({_Pos,<<_H,T/binary>>}) -> - {0,T}; -align(Bytes) -> - {0,Bytes}. - -%% First align buffer, then pick the first Num octets. -%% Returns octets as an integer with bit significance as in buffer. -getoctets({0,Buffer},Num) -> - <<Val:Num/integer-unit:8,RestBin/binary>> = Buffer, - {Val,{0,RestBin}}; -getoctets({U,<<_Padding,Rest/binary>>},Num) when U /= 0 -> - getoctets({0,Rest},Num); -getoctets(Buffer,Num) when is_binary(Buffer) -> - getoctets({0,Buffer},Num). -% getoctets(Buffer,Num) -> -% %% io:format("getoctets:Buffer = ~p~nNum = ~p~n",[Buffer,Num]), -% getoctets(Buffer,Num,0). - -% getoctets(Buffer,0,Acc) -> -% {Acc,Buffer}; -% getoctets(Buffer,Num,Acc) -> -% {Oct,NewBuffer} = getoctet(Buffer), -% getoctets(NewBuffer,Num-1,(Acc bsl 8)+Oct). - -% getoctets_as_list(Buffer,Num) -> -% getoctets_as_list(Buffer,Num,[]). - -% getoctets_as_list(Buffer,0,Acc) -> -% {lists:reverse(Acc),Buffer}; -% getoctets_as_list(Buffer,Num,Acc) -> -% {Oct,NewBuffer} = getoctet(Buffer), -% getoctets_as_list(NewBuffer,Num-1,[Oct|Acc]). - -%% First align buffer, then pick the first Num octets. -%% Returns octets as a binary -getoctets_as_bin({0,Bin},Num)-> - <<Octets:Num/binary,RestBin/binary>> = Bin, - {Octets,{0,RestBin}}; -getoctets_as_bin({_U,Bin},Num) -> - <<_Padding,Octets:Num/binary,RestBin/binary>> = Bin, - {Octets,{0,RestBin}}; -getoctets_as_bin(Bin,Num) when is_binary(Bin) -> - getoctets_as_bin({0,Bin},Num). - -%% 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_integer([{'ValueRange',{0,Len1-1}}],N)]; - N when is_integer(N) -> - [{bits,1,0}]; % no encoding if only 0 or 1 alternative - false -> - [{bits,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({0,Buffer},C) -> - decode_fragmented_bits(Buffer,C,[]); -decode_fragmented_bits({_N,<<_,Bs/binary>>},C) -> - decode_fragmented_bits(Bs,C,[]). - -decode_fragmented_bits(<<3:2,Len:6,Bin/binary>>,C,Acc) -> - {Value,Bin2} = split_binary(Bin, Len * ?'16K'), - decode_fragmented_bits(Bin2,C,[Value,Acc]); -decode_fragmented_bits(<<0:1,0:7,Bin/binary>>,C,Acc) -> - BinBits = list_to_binary(lists:reverse(Acc)), - case C of - Int when is_integer(Int),C == size(BinBits) -> - {BinBits,{0,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) -> - Result = {BinBits,{Used,_Rest}} = - case (Len rem 8) of - 0 -> - <<Value:Len/binary-unit:1,Bin2/binary>> = Bin, - {list_to_binary(lists:reverse([Value|Acc])),{0,Bin2}}; - Rem -> - Bytes = Len div 8, - U = 8 - Rem, - <<Value:Bytes/binary-unit:8,Bits1:Rem,Bits2:U,Bin2/binary>> = Bin, - {list_to_binary(lists:reverse([Bits1 bsl U,Value|Acc])), - {Rem,<<Bits2,Bin2/binary>>}} - end, - case C of - Int when is_integer(Int),C == (size(BinBits) - ((8 - Used) rem 8)) -> - Result; - Int when is_integer(Int) -> - exit({error,{asn1,{illegal_value,C,BinBits}}}) - end. - - -decode_fragmented_octets({0,Bin},C) -> - decode_fragmented_octets(Bin,C,[]). - -decode_fragmented_octets(<<3:2,Len:6,Bin/binary>>,C,Acc) -> - {Value,Bin2} = split_binary(Bin,Len * ?'16K'), - decode_fragmented_octets(Bin2,C,[Value,Acc]); -decode_fragmented_octets(<<0:1,0:7,Bin/binary>>,C,Acc) -> - Octets = list_to_binary(lists:reverse(Acc)), - case C of - Int when is_integer(Int), C == size(Octets) -> - {Octets,{0,Bin}}; - Int when is_integer(Int) -> - exit({error,{asn1,{illegal_value,C,Octets}}}) - end; -decode_fragmented_octets(<<0:1,Len:7,Bin/binary>>,C,Acc) -> - <<Value:Len/binary-unit:8,Bin2/binary>> = Bin, - BinOctets = list_to_binary(lists:reverse([Value|Acc])), - case C of - Int when is_integer(Int),size(BinOctets) == Int -> - {BinOctets,Bin2}; - Int when is_integer(Int) -> - exit({error,{asn1,{illegal_value,C,BinOctets}}}) - 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) -> - Bin = list_to_binary(Val), - [encode_length(undefined,size(Bin)),{octets,Bin}]; % octets implies align -encode_open_type(_C, Val) when is_binary(Val) -> - [encode_length(undefined,size(Val)),{octets,Val}]. % octets implies align -%% 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, _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,_}}} -> - [{bits,1,1},encode_unconstrained_number(Val)]; - Encoded -> - [{bits,1,0},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. - -decode_integer(Buffer,Range,NamedNumberList) -> - {Val,Buffer2} = decode_integer(Buffer,Range), - case lists:keysearch(Val,2,NamedNumberList) of - {value,{NewVal,_}} -> {NewVal,Buffer2}; - _ -> {Val,Buffer2} - end. - -decode_integer(Buffer,[{Rc,_Ec}]) when is_tuple(Rc) -> - {Ext,Buffer2} = getext(Buffer), - case Ext of - 0 -> decode_integer(Buffer2,[Rc]); - 1 -> decode_unconstrained_number(Buffer2) - end; -decode_integer(Buffer,undefined) -> - decode_unconstrained_number(Buffer); -decode_integer(Buffer,C) -> - case get_constraint(C,'SingleValue') of - V when is_integer(V) -> - {V,Buffer}; - V when is_list(V) -> - {Val,Buffer2} = decode_integer1(Buffer,C), - case lists:member(Val,V) of - true -> - {Val,Buffer2}; - _ -> - exit({error,{asn1,{illegal_value,Val}}}) - end; - _ -> - decode_integer1(Buffer,C) - end. - -decode_integer1(Buffer,C) -> - case VR = get_constraint(C,'ValueRange') of - no -> - decode_unconstrained_number(Buffer); - {Lb, 'MAX'} -> - decode_semi_constrained_number(Buffer,Lb); - {_,_} -> - decode_constrained_number(Buffer,VR) - 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 -> -% [{bits,1,0},{bits,6,Val}]; - [{bits,7,Val}]; % same as above but more efficient -encode_small_number(Val) -> - [{bits,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,0) - 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 - true -> - [encode_length(undefined,Len),{octets,Oct}] - end. - -decode_semi_constrained_number(Bytes,{Lb,_}) -> - decode_semi_constrained_number(Bytes,Lb); -decode_semi_constrained_number(Bytes,Lb) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - {V,Bytes3} = getoctets(Bytes2,Len), - {V+Lb,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, - if - Range == 1 -> - []; - Range == 2 -> - {bits,1,Val2}; - Range =< 4 -> - {bits,2,Val2}; - Range =< 8 -> - {bits,3,Val2}; - Range =< 16 -> - {bits,4,Val2}; - Range =< 32 -> - {bits,5,Val2}; - Range =< 64 -> - {bits,6,Val2}; - Range =< 128 -> - {bits,7,Val2}; - Range =< 255 -> - {bits,8,Val2}; - Range =< 256 -> - {octets,[Val2]}; - Range =< 65536 -> - {octets,<<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), - [{bits, LengthBitsNeeded, OctsLen - 1}, {octets, Octs}]; - true -> - exit({not_supported,{integer_range,Range}}) - end; -encode_constrained_number(Range,Val) -> - exit({error,{asn1,{integer_range,Range,value,Val}}}). - -%% For some reason the minimum bits needed in the length field in encoding of -%% constrained whole numbers must always be atleast 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. - -decode_constrained_number(Buffer,{Lb,Ub}) -> - Range = Ub - Lb + 1, - % 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_list(Bytes, Len), - {binary:decode_unsigned(binary:list_to_bin(Octs)), RestBytes}; - true -> - exit({not_supported,{integer_range,Range}}) - end, - {Val+Lb,Remain}. - -%% 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 - true -> - [encode_length(undefined,Len),{octets,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 - true -> - [encode_length(undefined,Len),{octets,Oct}] - end. - - -%% used for positive Values which don't need a sign bit -%% returns a binary -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]). - -decode_unconstrained_number(Bytes) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - {Ints,Bytes3} = getoctets_as_list(Bytes2,Len), - {dec_integer(Ints),Bytes3}. - -dec_integer(Ints) when hd(Ints) band 255 =< 127 -> %% Positive number - decpint(Ints, 8 * (length(Ints) - 1)); -dec_integer(Ints) -> %% Negative - decnint(Ints, 8 * (length(Ints) - 1)). - -decpint([Byte|Tail], Shift) -> - (Byte bsl Shift) bor decpint(Tail, Shift-8); -decpint([], _) -> 0. - -decnint([Byte|Tail], Shift) -> - (-128 + (Byte band 127) bsl Shift) bor decpint(Tail, Shift-8). - -% minimum_octets(Val) -> -% minimum_octets(Val,[]). - -% minimum_octets(Val,Acc) when Val > 0 -> -% minimum_octets((Val bsr 8),[Val band 16#FF|Acc]); -% minimum_octets(0,Acc) -> -% 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]}; - Len < 16384 -> - {octets,<<2:2,Len:14>>}; - true -> % should be able to endode length >= 16384 - 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 - [{bits,1,0},encode_constrained_number(Vr,Len)]; -encode_length({{Lb,_Ub},Ext},Len) when is_list(Ext) -> - [{bits,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 -> -%% [{bits,1,0},{bits,6,Len-1}]; - {bits,7,Len-1}; % the same as above but more efficient -encode_small_length(Len) -> - [{bits,1,1},encode_length(undefined,Len)]. - -% decode_small_length({Used,<<_:Used,0:1,Num:6,_:((8-Used+1) rem 8),Rest/binary>>}) -> -% case Buffer of -% <<_:Used,0:1,Num:6,_:((8-Used+1) rem 8),Rest/binary>> -> -% {Num, -% case getbit(Buffer) of -% {0,Remain} -> -% {Bits,Remain2} = getbits(Remain,6), -% {Bits+1,Remain2}; -% {1,Remain} -> -% decode_length(Remain,undefined) -% end. - -decode_small_length(Buffer) -> - case getbit(Buffer) of - {0,Remain} -> - {Bits,Remain2} = getbits(Remain,6), - {Bits+1,Remain2}; - {1,Remain} -> - decode_length(Remain,undefined) - end. - -decode_length(Buffer) -> - decode_length(Buffer,undefined). - -decode_length(Buffer,undefined) -> % un-constrained - {0,Buffer2} = align(Buffer), - case Buffer2 of - <<0:1,Oct:7,Rest/binary>> -> - {Oct,{0,Rest}}; - <<2:2,Val:14,Rest/binary>> -> - {Val,{0,Rest}}; - <<3:2,_:14,_Rest/binary>> -> - %% this case should be fixed - exit({error,{asn1,{decode_length,{nyi,above_16k}}}}) - end; -%% {Bits,_} = getbits(Buffer2,2), -% case Bits of -% 2 -> -% {Val,Bytes3} = getoctets(Buffer2,2), -% {(Val band 16#3FFF),Bytes3}; -% 3 -> -% exit({error,{asn1,{decode_length,{nyi,above_16k}}}}); -% _ -> -% {Val,Bytes3} = getoctet(Buffer2), -% {Val band 16#7F,Bytes3} -% end; - -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) -> - case getbit(Buffer) of - {0,Buffer2} -> - decode_length(Buffer2, VR); - {1,Buffer2} -> - decode_length(Buffer2, undefined) - end; -%% {0,Buffer2} = getbit(Buffer), -%% decode_length(Buffer2, VR); - - -%When does this case occur with {_,_Lb,Ub} ?? -% X.691:10.9.3.5 -decode_length({Used,Bin},{_,_Lb,_Ub}) -> %when Len =< 127 -> % Unconstrained or large Ub NOTE! this case does not cover case when Ub > 65535 - Unused = (8-Used) rem 8, - case Bin of - <<_:Used,0:1,Val:7,R:Unused,Rest/binary>> -> - {Val,{Used,<<R,Rest/binary>>}}; - <<_:Used,_:Unused,2:2,Val:14,Rest/binary>> -> - {Val, {0,Rest}}; - <<_:Used,_:Unused,3:2,_:14,_Rest/binary>> -> - exit({error,{asn1,{decode_length,{nyi,length_above_64K}}}}) - end; -% decode_length(Buffer,{_,_Lb,Ub}) -> %when Len =< 127 -> % Unconstrained or large Ub -% case getbit(Buffer) of -% {0,Remain} -> -% getbits(Remain,7); -% {1,Remain} -> -% {Val,Remain2} = getoctets(Buffer,2), -% {Val band 2#0111111111111111, Remain2} -% end; -decode_length(Buffer,SingleValue) when is_integer(SingleValue) -> - {SingleValue,Buffer}. - - - % X.691:11 -encode_boolean(true) -> - {bits,1,1}; -encode_boolean(false) -> - {bits,1,0}; -encode_boolean({Name,Val}) when is_atom(Name) -> - encode_boolean(Val); -encode_boolean(Val) -> - exit({error,{asn1,{encode_boolean,Val}}}). - -decode_boolean(Buffer) -> %when record(Buffer,buffer) - case getbit(Buffer) of - {1,Remain} -> {true,Remain}; - {0,Remain} -> {false,Remain} - end. - - -%% ENUMERATED with extension marker -decode_enumerated(Buffer,C,{Ntup1,Ntup2}) when is_tuple(Ntup1), is_tuple(Ntup2) -> - {Ext,Buffer2} = getext(Buffer), - case Ext of - 0 -> % not an extension value - {Val,Buffer3} = decode_integer(Buffer2,C), - case catch (element(Val+1,Ntup1)) of - NewVal when is_atom(NewVal) -> {NewVal,Buffer3}; - _Error -> exit({error,{asn1,{decode_enumerated,{Val,[Ntup1,Ntup2]}}}}) - end; - 1 -> % this an extension value - {Val,Buffer3} = decode_small_number(Buffer2), - case catch (element(Val+1,Ntup2)) of - NewVal when is_atom(NewVal) -> {NewVal,Buffer3}; - _ -> {{asn1_enum,Val},Buffer3} - end - end; - -decode_enumerated(Buffer,C,NamedNumberTup) when is_tuple(NamedNumberTup) -> - {Val,Buffer2} = decode_integer(Buffer,C), - case catch (element(Val+1,NamedNumberTup)) of - NewVal when is_atom(NewVal) -> {NewVal,Buffer2}; - _Error -> exit({error,{asn1,{decode_enumerated,{Val,NamedNumberTup}}}}) - end. - -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== -%% 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); - -encode_bit_string(C, BL=[{bit,_No} | _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(C, BitListValue, NamedBitList) when is_list(BitListValue) -> -% Bl1 = -% case NamedBitList of -% [] -> % dont remove trailing zeroes -% BitListValue; -% _ -> % first remove any trailing zeroes -% lists:reverse(lists:dropwhile(fun(0)->true;(1)->false end, -% lists:reverse(BitListValue))) -% end, -% BitList = [{bit,X} || X <- Bl1], -% %% BListLen = length(BitList), -% case get_constraint(C,'SizeConstraint') of -% 0 -> % fixed length -% []; % nothing to encode -% V when is_integer(V),V=<16 -> % fixed length 16 bits or less -% pad_list(V,BitList); -% V when is_integer(V) -> % fixed length 16 bits or more -% [align,pad_list(V,BitList)]; % should be another case for V >= 65537 -% {Lb,Ub} when is_integer(Lb),is_integer(Ub) -> -% [encode_length({Lb,Ub},length(BitList)),align,BitList]; -% no -> -% [encode_length(undefined,length(BitList)),align,BitList]; -% Sc -> % extension marker -% [encode_length(Sc,length(BitList)),align,BitList] -% end; -encode_bit_string(C, BitListValue, NamedBitList) when is_list(BitListValue) -> - BitListToBinary = - %% fun that transforms a list of 1 and 0 to a tuple: - %% {UnusedBitsInLastByte, Binary} - fun([1|T],Acc,N,Fun) -> - Fun(T,(Acc bsl 1)+1,N+1,Fun); - ([0|T],Acc,N,Fun) -> - Fun(T,(Acc bsl 1),N+1,Fun); - ([_H|_T],_,_,_) -> - exit({error,{asn1,{bitstring_bitlist,BitListValue}}}); - ([],Acc,N,_) -> - Unused = (8 - (N rem 8)) rem 8, - {Unused,<<Acc:N,0:Unused>>} - end, - UnusedAndBin = - case NamedBitList of - [] -> % dont remove trailing zeroes - BitListToBinary(BitListValue,0,0,BitListToBinary); - _ -> - BitListToBinary(lists:reverse( - lists:dropwhile(fun(0)->true;(_)->false end, - lists:reverse(BitListValue))), - 0,0,BitListToBinary) - end, - encode_bin_bit_string(C,UnusedAndBin,NamedBitList); - -%% 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). - - -%% 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,UnusedAndBin={_Unused,_BinBits},NamedBitList) -> - Constr = get_constraint(C,'SizeConstraint'), - UnusedAndBin1 = {Unused1,Bin1} = - remove_trailing_bin(NamedBitList,UnusedAndBin,lower_bound(Constr)), - case Constr of - 0 -> - []; - V when is_integer(V),V=<16 -> - {Unused2,Bin2} = pad_list(V,UnusedAndBin1), - <<BitVal:V,_:Unused2>> = Bin2, - {bits,V,BitVal}; - V when is_integer(V) -> - [align, pad_list(V, UnusedAndBin1)]; - {Lb,Ub} when is_integer(Lb),is_integer(Ub) -> - [encode_length({Lb,Ub},size(Bin1)*8 - Unused1), - align,UnusedAndBin1]; - {{Fix,Fix},L} when is_integer(Fix),is_list(L) -> - %% X.691 � 15.6, the rest of this paragraph is covered by - %% the last, ie. Sc, clause in this case - case (size(Bin1)*8)-Unused1 of - Size when Size =< Fix, Fix =< 16 -> - {Unused2,Bin2} = pad_list(Fix,UnusedAndBin), - <<BitVal:Fix,_:Unused2>> = Bin2, - [{bits,1,0},{bits,Fix,BitVal}]; - Size when Size =< Fix -> - [{bits,1,0},align, pad_list(Fix, UnusedAndBin1)]; - Size -> - [{bits,1,1},encode_length(undefined,Size), - align,UnusedAndBin1] - end; - no -> - [encode_length(undefined,size(Bin1)*8 - Unused1), - align,UnusedAndBin1]; - Sc -> - [encode_length(Sc,size(Bin1)*8 - Unused1), - align,UnusedAndBin1] - end. - - -remove_trailing_bin([], {Unused,Bin},_) -> - {Unused,Bin}; -remove_trailing_bin(_NamedNumberList,{_Unused,<<>>},C) -> - case C of - Int when is_integer(Int),Int > 0 -> - %% this padding see OTP-4353 - pad_list(Int,{0,<<>>}); - _ -> {0,<<>>} - end; -remove_trailing_bin(NamedNumberList, {_Unused,Bin},C) -> - 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},C); - _ -> - case C of - Int when is_integer(Int),Int > ((size(Bin)*8)-Unused2) -> - %% this padding see OTP-4353 - pad_list(Int,{Unused2,Bin}); - _ -> {Unused2,Bin} - end - 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. - -lower_bound({{Lb,_},_}) when is_integer(Lb) -> - Lb; -lower_bound({Lb,_}) when is_integer(Lb) -> - Lb; -lower_bound(C) -> - C. - -%%%%%%%%%%%%%%% -%% 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 - {Bin,Buffer2} = decode_fragmented_bits(Buffer,V), - case Buffer2 of - {0,_} -> {{0,Bin},Buffer2}; - {U,_} -> {{8-U,Bin},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},L} = Sc when is_list(L), is_integer(Fix), Fix =< 16 -> - %% X.691 �15.6, special case of extension marker - case decode_length(Buffer,Sc) of - {Len,Bytes2} when Len > Fix -> - 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,_} = decode_fragmented_bits(Bytes2,V), - bit_list_or_named(BinBits,V,NamedNumberList); - {{Fix,Fix},L} = Sc when is_list(L), is_integer(Fix), Fix =< 16 -> - %% X.691 �15.6, special case of extension marker - 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 -> %% X.691 �15.6, 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,[]) -> - getbits_as_binary(Len,Buffer); % {{Unused,BinBits},NewBuffer} -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([], _) -> - []. - -%%%%%%%%%%%%%%%%% -%% pad_list(N,BitList) -> PaddedList -%% returns a padded (with trailing {bit,0} elements) list of length N -%% if Bitlist contains more than N significant bits set an exit asn1_error -%% is generated - -pad_list(N,In={Unused,Bin}) -> - pad_list(N, size(Bin)*8 - Unused, In). - -pad_list(N,Size,In={_,_}) when N < Size -> - exit({error,{asn1,{range_error,{bit_string,In}}}}); -pad_list(N,Size,{Unused,Bin}) when N > Size, Unused > 0 -> - pad_list(N,Size+1,{Unused-1,Bin}); -pad_list(N,Size,{_Unused,Bin}) when N > Size -> - pad_list(N,Size+1,{7,<<Bin/binary,0>>}); -pad_list(N,N,In={_,_}) -> - In. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% X.691:16 -%% encode_octet_string(Constraint,ExtensionMarker,Val) -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -encode_octet_string(C,Val) -> - encode_octet_string2(C,Val). - -encode_octet_string2(C,{_Name,Val}) -> - encode_octet_string2(C,Val); -encode_octet_string2(C,Val) -> - case get_constraint(C,'SizeConstraint') of - 0 -> - []; - 1 -> - [V] = Val, - {bits,8,V}; - 2 -> - [V1,V2] = Val, - [{bits,8,V1},{bits,8,V2}]; - Sv when Sv =<65535, Sv == length(Val) -> % fixed length - {octets,Val}; - {Lb,Ub} -> - [encode_length({Lb,Ub},length(Val)),{octets,Val}]; - Sv when is_list(Sv) -> - [encode_length({hd(Sv),lists:max(Sv)},length(Val)),{octets,Val}]; - no -> - [encode_length(undefined,length(Val)),{octets,Val}] - end. - -decode_octet_string(Bytes,Range) -> - decode_octet_string(Bytes,Range,false). - -decode_octet_string(Bytes,C,false) -> - case get_constraint(C,'SizeConstraint') of - 0 -> - {[],Bytes}; - 1 -> - {B1,Bytes2} = getbits(Bytes,8), - {[B1],Bytes2}; - 2 -> - {Bs,Bytes2}= getbits(Bytes,16), - {binary_to_list(<<Bs:16>>),Bytes2}; - {_,0} -> - {[],Bytes}; - Sv when is_integer(Sv), Sv =<65535 -> % fixed length - getoctets_as_list(Bytes,Sv); - Sv when is_integer(Sv) -> % fragmented encoding - Bytes2 = align(Bytes), - decode_fragmented_octets(Bytes2,Sv); - {Lb,Ub} -> - {Len,Bytes2} = decode_length(Bytes,{Lb,Ub}), - getoctets_as_list(Bytes2,Len); - Sv when is_list(Sv) -> - {Len,Bytes2} = decode_length(Bytes,{hd(Sv),lists:max(Sv)}), - getoctets_as_list(Bytes2,Len); - no -> - {Len,Bytes2} = decode_length(Bytes,undefined), - getoctets_as_list(Bytes2,Len) - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% 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)-> - [encode_length(undefined,length(Val)),{octets,Val}]. - -encode_known_multiplier_string(aligned,StringType,C,_Ext,{Name,Val}) when is_atom(Name) -> - encode_known_multiplier_string(aligned,StringType,C,false,Val); - -encode_known_multiplier_string(aligned,StringType,C,_Ext,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 - [align,Result]; - {Ub,Lb} -> - [encode_length({Ub,Lb},length(Val)),align,Result]; - Vl when is_list(Vl) -> - [encode_length({lists:min(Vl),lists:max(Vl)},length(Val)),align,Result]; - no -> - [encode_length(undefined,length(Val)),align,Result] - end. - -decode_restricted_string(Bytes,aligned) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - getoctets_as_list(Bytes2,Len). - -decode_known_multiplier_string(Bytes,aligned,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 - Bytes1 = align(Bytes), - chars_decode(Bytes1,NumBits,StringType,C,Ub); - 0 -> - {[],Bytes}; - Vl when is_list(Vl) -> - {Len,Bytes1} = decode_length(Bytes,{hd(Vl),lists:max(Vl)}), - Bytes2 = align(Bytes1), - chars_decode(Bytes2,NumBits,StringType,C,Len); - no -> - {Len,Bytes1} = decode_length(Bytes,undefined), - Bytes2 = align(Bytes1), - chars_decode(Bytes2,NumBits,StringType,C,Len); - {Lb,Ub}-> - {Len,Bytes1} = decode_length(Bytes,{Lb,Ub}), - Bytes2 = align(Bytes1), - chars_decode(Bytes2,NumBits,StringType,C,Len) - end. - - -encode_NumericString(C,Val) -> - encode_known_multiplier_string(aligned,'NumericString',C,false,Val). -decode_NumericString(Bytes,C) -> - decode_known_multiplier_string(Bytes,aligned,'NumericString',C,false). - -encode_PrintableString(C,Val) -> - encode_known_multiplier_string(aligned,'PrintableString',C,false,Val). -decode_PrintableString(Bytes,C) -> - decode_known_multiplier_string(Bytes,aligned,'PrintableString',C,false). - -encode_VisibleString(C,Val) -> % equivalent with ISO646String - encode_known_multiplier_string(aligned,'VisibleString',C,false,Val). -decode_VisibleString(Bytes,C) -> - decode_known_multiplier_string(Bytes,aligned,'VisibleString',C,false). - -encode_IA5String(C,Val) -> - encode_known_multiplier_string(aligned,'IA5String',C,false,Val). -decode_IA5String(Bytes,C) -> - decode_known_multiplier_string(Bytes,aligned,'IA5String',C,false). - -encode_BMPString(C,Val) -> - encode_known_multiplier_string(aligned,'BMPString',C,false,Val). -decode_BMPString(Bytes,C) -> - decode_known_multiplier_string(Bytes,aligned,'BMPString',C,false). - -encode_UniversalString(C,Val) -> - encode_known_multiplier_string(aligned,'UniversalString',C,false,Val). -decode_UniversalString(Bytes,C) -> - decode_known_multiplier_string(Bytes,aligned,'UniversalString',C,false). - - -%% end of known-multiplier strings for which PER visible constraints are -%% applied - -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(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})]; -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})]; -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*B*C*D)-Min}|chars_encode2(T,NumBits,{Min,Max,notab})]; - [{bits,NumBits,((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min}|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,element((A*B*C*D)-Min,Tab)}|chars_encode2(T,NumBits,{Min,Max,notab})]; - [{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})]; -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),aligned); - no -> - case StringType of - 'IA5String' -> - charbits(128,aligned); % 16#00..16#7F - 'VisibleString' -> - charbits(95,aligned); % 16#20..16#7E - 'PrintableString' -> - charbits(74,aligned); % [$\s,$',$(,$),$+,$,,$-,$.,$/,"0123456789",$:,$=,$?,$A..$Z,$a..$z - 'NumericString' -> - charbits(11,aligned); % $ ,"0123456789" - 'UniversalString' -> - 32; - 'BMPString' -> - 16 - end - end. - -%%Maybe used later -%%get_MaxChar(C,StringType) -> -%% case get_constraint(C,'PermittedAlphabet') of -%% {'SingleValue',Sv} -> -%% lists:nth(length(Sv),Sv); -%% no -> -%% case StringType of -%% 'IA5String' -> -%% 16#7F; % 16#00..16#7F -%% 'VisibleString' -> -%% 16#7E; % 16#20..16#7E -%% 'PrintableString' -> -%% $z; % [$\s,$',$(,$),$+,$,,$-,$.,$/,"0123456789",$:,$=,$?,$A..$Z,$a..$z -%% 'NumericString' -> -%% $9; % $ ,"0123456789" -%% 'UniversalString' -> -%% 16#ffffffff; -%% 'BMPString' -> -%% 16#ffff -%% end -%% end. - -%%Maybe used later -%%get_MinChar(C,StringType) -> -%% case get_constraint(C,'PermittedAlphabet') of -%% {'SingleValue',Sv} -> -%% hd(Sv); -%% no -> -%% case StringType of -%% 'IA5String' -> -%% 16#00; % 16#00..16#7F -%% 'VisibleString' -> -%% 16#20; % 16#20..16#7E -%% 'PrintableString' -> -%% $\s; % [$\s,$',$(,$),$+,$,,$-,$.,$/,"0123456789",$:,$=,$?,$A..$Z,$a..$z -%% 'NumericString' -> -%% $\s; % $ ,"0123456789" -%% 'UniversalString' -> -%% 16#00; -%% 'BMPString' -> -%% 16#00 -%% 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)]. - -%% This very inefficient and should be moved to compiletime -charbits(NumOfChars,aligned) -> - case charbits(NumOfChars) of - 1 -> 1; - 2 -> 2; - B when B =< 4 -> 4; - B when B =< 8 -> 8; - B when B =< 16 -> 16; - B when B =< 32 -> 32 - end. - -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) when NumBits > 8 -> -% {Char,Bytes2} = getbits(Bytes,NumBits), -% Result = case minimum_octets(Char+Min) of -% [NewChar] -> NewChar; -% [C1,C2] -> {0,0,C1,C2}; -% [C1,C2,C3] -> {0,C1,C2,C3}; -% [C1,C2,C3,C4] -> {C1,C2,C3,C4} -% 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)),{octets,Val}]; -encode_UTF8String(Val) -> - Bin = list_to_binary(Val), - encode_UTF8String(Bin). - -decode_UTF8String(Bytes) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), - {list_to_binary(Octs),Bytes3}. - - - % X.691:17 -encode_null(_) -> []. % encodes to nothing -%encode_null({Name,Val}) when is_atom(Name) -> -% encode_null(Val). - -decode_null(Bytes) -> - {'NULL',Bytes}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% 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), % performs a flatten at the same time - [{debug,object_identifier},encode_length(undefined,size(Octets)),{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,Octets}]. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_relative_oid(Val) -> {ROID,Rest} -%% decode_relative_oid({Name,Val}) -> {ROID,Rest} -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,EncVal}]. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_real(Val) -> {REALvalue,Rest} -%% decode_real({Name,Val}) -> {REALvalue,Rest} -decode_real(Bytes) -> - {Len,{0,Bytes2}} = decode_length(Bytes,undefined), - {RealVal,Rest,Len} = ?RT_COMMON:decode_real(Bytes2,Len), - {RealVal,{0,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(L) -> -% case complete1(L) of -% {[],0} -> -% <<0>>; -% {Acc,0} -> -% lists:reverse(Acc); -% {[Hacc|Tacc],Acclen} -> % Acclen >0 -% Rest = 8 - Acclen, -% NewHacc = Hacc bsl Rest, -% lists:reverse([NewHacc|Tacc]) -% end. - - -% complete1(InList) when is_list(InList) -> -% complete1(InList,[]); -% complete1(InList) -> -% complete1([InList],[]). - -% complete1([{debug,_}|T], Acc) -> -% complete1(T,Acc); -% complete1([H|T],Acc) when is_list(H) -> -% {NewH,NewAcclen} = complete1(H,Acc), -% complete1(T,NewH,NewAcclen); - -% complete1([{0,Bin}|T],Acc,0) when is_binary(Bin) -> -% complete1(T,[Bin|Acc],0); -% complete1([{Unused,Bin}|T],Acc,0) when is_integer(Unused),is_binary(Bin) -> -% Size = size(Bin)-1, -% <<Bs:Size/binary,B>> = Bin, -% complete1(T,[(B bsr Unused),Bs|Acc],8-Unused); -% complete1([{Unused,Bin}|T],[Hacc|Tacc],Acclen) when is_integer(Unused),is_binary(Bin) -> -% Rest = 8 - Acclen, -% Used = 8 - Unused, -% case size(Bin) of -% 1 -> -% if -% Rest >= Used -> -% <<B:Used,_:Unused>> = Bin, -% complete1(T,[(Hacc bsl Used) + B|Tacc], -% (Acclen+Used) rem 8); -% true -> -% LeftOver = 8 - Rest - Unused, -% <<Val2:Rest,Val1:LeftOver,_:Unused>> = Bin, -% complete1(T,[Val1,(Hacc bsl Rest) + Val2|Tacc], -% (Acclen+Used) rem 8) -% end; -% N -> -% if -% Rest == Used -> -% N1 = N - 1, -% <<B:Rest,Bs:N1/binary,_:Unused>> = Bin, -% complete1(T,[Bs,(Hacc bsl Rest) + B|Tacc],0); -% Rest > Used -> -% N1 = N - 2, -% N2 = (8 - Rest) + Used, -% <<B1:Rest,Bytes:N1/binary,B2:N2,_:Unused>> = Bin, -% complete1(T,[B2,Bytes,(Hacc bsl Rest) + B1|Tacc], -% (Acclen + Used) rem 8); -% true -> % Rest < Used -% N1 = N - 1, -% N2 = Used - Rest, -% <<B1:Rest,Bytes:N1/binary,B2:N2,_:Unused>> = Bin, -% complete1(T,[B2,Bytes,(Hacc bsl Rest) + B1|Tacc], -% (Acclen + Used) rem 8) -% end -% end; - -% %complete1([{octets,N,Val}|T],Acc,Acclen) when N =< 4 ,is_integer(Val) -> -% % complete1([{octets,<<Val:N/unit:8>>}|T],Acc,Acclen); -% complete1([{octets,N,Val}|T],Acc,Acclen) when N =< 4 ,is_integer(Val) -> -% Newval = case N of -% 1 -> -% Val4 = Val band 16#FF, -% [Val4]; -% 2 -> -% Val3 = (Val bsr 8) band 16#FF, -% Val4 = Val band 16#FF, -% [Val3,Val4]; -% 3 -> -% Val2 = (Val bsr 16) band 16#FF, -% Val3 = (Val bsr 8) band 16#FF, -% Val4 = Val band 16#FF, -% [Val2,Val3,Val4]; -% 4 -> -% Val1 = (Val bsr 24) band 16#FF, -% Val2 = (Val bsr 16) band 16#FF, -% Val3 = (Val bsr 8) band 16#FF, -% Val4 = Val band 16#FF, -% [Val1,Val2,Val3,Val4] -% end, -% complete1([{octets,Newval}|T],Acc,Acclen); - -% complete1([{octets,Bin}|T],Acc,Acclen) when is_binary(Bin) -> -% Rest = 8 - Acclen, -% if -% Rest == 8 -> -% complete1(T,[Bin|Acc],0); -% true -> -% [Hacc|Tacc]=Acc, -% complete1(T,[Bin, Hacc bsl Rest|Tacc],0) -% end; - -% complete1([{octets,Oct}|T],Acc,Acclen) when is_list(Oct) -> -% Rest = 8 - Acclen, -% if -% Rest == 8 -> -% complete1(T,[list_to_binary(Oct)|Acc],0); -% true -> -% [Hacc|Tacc]=Acc, -% complete1(T,[list_to_binary(Oct), Hacc bsl Rest|Tacc],0) -% end; - -% complete1([{bit,Val}|T], Acc, Acclen) -> -% complete1([{bits,1,Val}|T],Acc,Acclen); -% complete1([{octet,Val}|T], Acc, Acclen) -> -% complete1([{octets,1,Val}|T],Acc,Acclen); - -% complete1([{bits,N,Val}|T], Acc, 0) when N =< 8 -> -% complete1(T,[Val|Acc],N); -% complete1([{bits,N,Val}|T], [Hacc|Tacc], Acclen) when N =< 8 -> -% Rest = 8 - Acclen, -% if -% Rest >= N -> -% complete1(T,[(Hacc bsl N) + Val|Tacc],(Acclen+N) rem 8); -% true -> -% Diff = N - Rest, -% NewHacc = (Hacc bsl Rest) + (Val bsr Diff), -% Mask = element(Diff,{1,3,7,15,31,63,127,255}), -% complete1(T,[(Val band Mask),NewHacc|Tacc],(Acclen+N) rem 8) -% end; -% complete1([{bits,N,Val}|T], Acc, Acclen) -> % N > 8 -% complete1([{bits,N-8,Val bsr 8},{bits,8,Val band 255}|T],Acc,Acclen); - -% complete1([align|T],Acc,0) -> -% complete1(T,Acc,0); -% complete1([align|T],[Hacc|Tacc],Acclen) -> -% Rest = 8 - Acclen, -% complete1(T,[Hacc bsl Rest|Tacc],0); -% complete1([{octets,N,Val}|T],Acc,Acclen) when is_list(Val) -> % no security check here -% complete1([{octets,Val}|T],Acc,Acclen); - -% complete1([],Acc,Acclen) -> -% {Acc,Acclen}. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% 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) -> - case complete1(L) of - {[],[]} -> - <<0>>; - {Acc,[]} -> - Acc; - {Acc,Bacc} -> - [Acc|complete_bytes(Bacc)] - end. - -%% this function builds the ugly form of lists [E1|E2] to avoid having to reverse it at the end. -%% this is done because it is efficient and that the result always will be sent on a port or -%% converted by means of list_to_binary/1 -complete1(InList) when is_list(InList) -> - complete1(InList,[],[]); -complete1(InList) -> - complete1([InList],[],[]). - -complete1([],Acc,Bacc) -> - {Acc,Bacc}; -complete1([H|T],Acc,Bacc) when is_list(H) -> - {NewH,NewBacc} = complete1(H,Acc,Bacc), - complete1(T,NewH,NewBacc); - -complete1([{octets,Bin}|T],Acc,[]) -> - complete1(T,[Acc|Bin],[]); - -complete1([{octets,Bin}|T],Acc,Bacc) -> - complete1(T,[Acc|[complete_bytes(Bacc),Bin]],[]); - -complete1([{debug,_}|T], Acc,Bacc) -> - complete1(T,Acc,Bacc); - -complete1([{bits,N,Val}|T],Acc,Bacc) -> - complete1(T,Acc,complete_update_byte(Bacc,Val,N)); - -complete1([{bit,Val}|T],Acc,Bacc) -> - complete1(T,Acc,complete_update_byte(Bacc,Val,1)); - -complete1([align|T],Acc,[]) -> - complete1(T,Acc,[]); -complete1([align|T],Acc,Bacc) -> - complete1(T,[Acc|complete_bytes(Bacc)],[]); -complete1([{0,Bin}|T],Acc,[]) when is_binary(Bin) -> - complete1(T,[Acc|Bin],[]); -complete1([{Unused,Bin}|T],Acc,[]) when is_integer(Unused),is_binary(Bin) -> - Size = size(Bin)-1, - <<Bs:Size/binary,B>> = Bin, - NumBits = 8-Unused, - complete1(T,[Acc|Bs],[[B bsr Unused]|NumBits]); -complete1([{Unused,Bin}|T],Acc,Bacc) when is_integer(Unused),is_binary(Bin) -> - Size = size(Bin)-1, - <<Bs:Size/binary,B>> = Bin, - NumBits = 8 - Unused, - Bf = complete_bytes(Bacc), - complete1(T,[Acc|[Bf,Bs]],[[B bsr Unused]|NumBits]). - - -complete_update_byte([],Val,Len) -> - complete_update_byte([[0]|0],Val,Len); -complete_update_byte([[Byte|Bacc]|NumBits],Val,Len) when NumBits + Len == 8 -> - [[0,((Byte bsl Len) + Val) band 255|Bacc]|0]; -complete_update_byte([[Byte|Bacc]|NumBits],Val,Len) when NumBits + Len > 8 -> - Rem = 8 - NumBits, - Rest = Len - Rem, - complete_update_byte([[0,((Byte bsl Rem) + (Val bsr Rest)) band 255 |Bacc]|0],Val,Rest); -complete_update_byte([[Byte|Bacc]|NumBits],Val,Len) -> - [[((Byte bsl Len) + Val) band 255|Bacc]|NumBits+Len]. - - -complete_bytes([[_Byte|Bacc]|0]) -> - lists:reverse(Bacc); -complete_bytes([[Byte|Bacc]|NumBytes]) -> - lists:reverse([(Byte bsl (8-NumBytes)) band 255|Bacc]); -complete_bytes([]) -> - []. - -% complete_bytes(L) -> -% complete_bytes1(lists:reverse(L),[],[],0,0). - -% complete_bytes1([H={V,B}|T],Acc,ReplyAcc,NumBits,NumFields) when ((NumBits+B) rem 8) == 0 -> -% NewReplyAcc = [complete_bytes2([H|Acc],0)|ReplyAcc], -% complete_bytes1(T,[],NewReplyAcc,0,0); -% complete_bytes1([H={V,B}|T],Acc,ReplyAcc,NumBits,NumFields) when NumFields == 7; (NumBits+B) div 8 > 0 -> -% Rem = (NumBits+B) rem 8, -% NewReplyAcc = [complete_bytes2([{V bsr Rem,B - Rem}|Acc],0)|ReplyAcc], -% complete_bytes1([{V,Rem}|T],[],NewReplyAcc,0,0); -% complete_bytes1([H={V,B}|T],Acc,ReplyAcc,NumBits,NumFields) -> -% complete_bytes1(T,[H|Acc],ReplyAcc,NumBits+B,NumFields+1); -% complete_bytes1([],[],ReplyAcc,_,_) -> -% lists:reverse(ReplyAcc); -% complete_bytes1([],Acc,ReplyAcc,NumBits,_) -> -% PadBits = case NumBits rem 8 of -% 0 -> 0; -% Rem -> 8 - Rem -% end, -% lists:reverse([complete_bytes2(Acc,PadBits)|ReplyAcc]). - - -% complete_bytes2([{V1,B1}],PadBits) -> -% <<V1:B1,0:PadBits>>; -% complete_bytes2([{V2,B2},{V1,B1}],PadBits) -> -% <<V1:B1,V2:B2,0:PadBits>>; -% complete_bytes2([{V3,B3},{V2,B2},{V1,B1}],PadBits) -> -% <<V1:B1,V2:B2,V3:B3,0:PadBits>>; -% complete_bytes2([{V4,B4},{V3,B3},{V2,B2},{V1,B1}],PadBits) -> -% <<V1:B1,V2:B2,V3:B3,V4:B4,0:PadBits>>; -% complete_bytes2([{V5,B5},{V4,B4},{V3,B3},{V2,B2},{V1,B1}],PadBits) -> -% <<V1:B1,V2:B2,V3:B3,V4:B4,V5:B5,0:PadBits>>; -% complete_bytes2([{V6,B6},{V5,B5},{V4,B4},{V3,B3},{V2,B2},{V1,B1}],PadBits) -> -% <<V1:B1,V2:B2,V3:B3,V4:B4,V5:B5,V6:B6,0:PadBits>>; -% complete_bytes2([{V7,B7},{V6,B6},{V5,B5},{V4,B4},{V3,B3},{V2,B2},{V1,B1}],PadBits) -> -% <<V1:B1,V2:B2,V3:B3,V4:B4,V5:B5,V6:B6,V7:B7,0:PadBits>>; -% complete_bytes2([{V8,B8},{V7,B7},{V6,B6},{V5,B5},{V4,B4},{V3,B3},{V2,B2},{V1,B1}],PadBits) -> -% <<V1:B1,V2:B2,V3:B3,V4:B4,V5:B5,V6:B6,V7:B7,V8:B8,0:PadBits>>. - - - - - - diff --git a/lib/asn1/src/asn1rt_per_bin_rt2ct.erl b/lib/asn1/src/asn1rt_per_bin_rt2ct.erl index 1df757a47f..01e1cb23d7 100644 --- a/lib/asn1/src/asn1rt_per_bin_rt2ct.erl +++ b/lib/asn1/src/asn1rt_per_bin_rt2ct.erl @@ -22,7 +22,7 @@ -include("asn1_records.hrl"). --export([dec_fixup/3, cindex/3, list_to_record/2]). +-export([dec_fixup/3]). -export([setchoiceext/1, setext/1, fixoptionals/3, fixextensions/2, getext/1, getextension/2, skipextensions/3, getbit/1, getchoice/3 ]). -export([getoptionals/2, getoptionals2/2, @@ -87,18 +87,6 @@ dec_fixup([H|T],[Hc|Tc],RemBytes,Acc) -> dec_fixup([],_Cnames,RemBytes,Acc) -> {lists:reverse(Acc),RemBytes}. -cindex(Ix,Val,Cname) -> - case element(Ix,Val) of - {Cname,Val2} -> Val2; - X -> X - end. - -%% converts a list to a record if necessary -list_to_record(_,Tuple) when is_tuple(Tuple) -> - Tuple; -list_to_record(Name,List) when is_list(List) -> - list_to_tuple([Name|List]). - %%-------------------------------------------------------- %% setchoiceext(InRootSet) -> [{bit,X}] %% X is set to 1 when InRootSet==false @@ -609,7 +597,7 @@ encode_constrained_number({Lb,Ub},Val) when Val >= Lb, Ub >= Val -> RangeOcts = binary:encode_unsigned(Range - 1), OctsLen = erlang:byte_size(Octs), RangeOctsLen = erlang:byte_size(RangeOcts), - LengthBitsNeeded = asn1rt_per_bin:minimum_bits(RangeOctsLen - 1), + LengthBitsNeeded = minimum_bits(RangeOctsLen - 1), [10,LengthBitsNeeded,OctsLen-1,20,OctsLen,Octs]; true -> exit({not_supported,{integer_range,Range}}) @@ -665,6 +653,16 @@ decode_constrained_number(Buffer,{Lb,_Ub},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 -> diff --git a/lib/asn1/src/asn1rt_uper_bin.erl b/lib/asn1/src/asn1rt_uper_bin.erl index abe178a69e..e1f96416a9 100644 --- a/lib/asn1/src/asn1rt_uper_bin.erl +++ b/lib/asn1/src/asn1rt_uper_bin.erl @@ -25,7 +25,6 @@ %%-compile(export_all). - -export([cindex/3, list_to_record/2]). -export([setext/1, fixoptionals/3, fixextensions/2, getext/1, getextension/2, skipextensions/3, getbit/1, getchoice/3 ]). @@ -65,19 +64,6 @@ -define('64K',65536). -cindex(Ix,Val,Cname) -> - case element(Ix,Val) of - {Cname,Val2} -> Val2; - X -> X - end. - -%% converts a list to a record if necessary -list_to_record(_Name,Tuple) when is_tuple(Tuple) -> - Tuple; -list_to_record(Name,List) when is_list(List) -> - list_to_tuple([Name|List]). - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% setext(true|false) -> CompleteList %% diff --git a/lib/asn1/test/Makefile b/lib/asn1/test/Makefile index 6e6374baf1..1794d6bb71 100644 --- a/lib/asn1/test/Makefile +++ b/lib/asn1/test/Makefile @@ -83,6 +83,7 @@ MODULES= \ testInfObj \ testParameterizedInfObj \ testMergeCompile \ + testMultipleLevels \ testDeepTConstr \ testTimer \ testMegaco \ diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index 79c7bf1476..fd5ea15323 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -21,27 +21,17 @@ -module(asn1_SUITE). -define(only_per(Func), - if Rule == per orelse Rule == per_bin -> Func; - true -> ok + if Rule =:= per -> Func; + true -> ok end). -define(only_ber(Func), - if Rule == ber orelse Rule == ber_bin orelse Rule == ber_bin_v2 -> Func; - true -> ok + if Rule =:= ber -> Func; + true -> ok end). -define(only_uper(Func), case Rule of - uper_bin -> Func; - _ -> ok - end). --define(only_per_nif(Func), - case {Rule, lists:member(optimize, Opts)} of - {per_bin, true} -> Func; - _ -> ok - end). --define(only_ber_nif(Func), - case {Rule, lists:member(nif, Opts)} of - {ber_bin_v2, true} -> Func; - _ -> ok + uper -> Func; + _ -> ok end). -compile(export_all). @@ -55,7 +45,8 @@ suite() -> [{ct_hooks, [ts_install_cth]}]. all() -> - [{group, parallel}, + [{group, compile}, + {group, parallel}, {group, app_test}, {group, appup_test}, @@ -76,16 +67,14 @@ groups() -> {ber, parallel([]), [ber_choiceinseq, % Uses 'SOpttest' - {group, [], [ber_optional, - ber_optional_keyed_list]}]}, + ber_optional]}, {app_test, [], [{asn1_app_test, all}]}, {appup_test, [], [{asn1_appup_test, all}]}, {parallel, parallel([]), - [{group, compile}, - {group, ber}, + [{group, ber}, % Uses 'P-Record', 'Constraints', 'MEDIA-GATEWAY-CONTROL'... {group, [], [parse, test_driver_load, @@ -116,6 +105,7 @@ groups() -> testChoTypeRefPrim, testChoTypeRefSeq, testChoTypeRefSet, + testMultipleLevels, testDef, testOpt, testSeqDefault, @@ -203,13 +193,8 @@ groups() -> {performance, [], [testTimer_ber, - testTimer_ber_bin, - testTimer_ber_bin_opt, - testTimer_ber_bin_opt_driver, testTimer_per, - testTimer_per_bin, - testTimer_per_bin_opt, - testTimer_uper_bin, + testTimer_uper, smp]}]. parallel(Options) -> @@ -257,14 +242,8 @@ end_per_testcase(_Func, Config) -> test(Config, TestF) -> test(Config, TestF, [per, - per_bin, - {per_bin, [optimize]}, - uper_bin, - ber, - ber_bin, - ber_bin_v2, - % TODO: {ber_bin_v2, [optimize, nif]} ? - {ber_bin_v2, [nif]}]). + uper, + ber]). test(Config, TestF, Rules) -> Fun = fun(C, R, O) -> @@ -344,10 +323,10 @@ testCompactBitString(Config, Rule, Opts) -> testCompactBitString:compact_bit_string(Rule), ?only_uper(testCompactBitString:bit_string_unnamed(Rule)), ?only_per(testCompactBitString:bit_string_unnamed(Rule)), - ?only_per_nif(testCompactBitString:ticket_7734(Rule)), - ?only_per_nif(asn1_test_lib:compile("Constraints", Config, + ?only_per(testCompactBitString:ticket_7734(Rule)), + ?only_per(asn1_test_lib:compile("Constraints", Config, [Rule, compact_bit_string|Opts])), - ?only_per_nif(testCompactBitString:otp_4869(Rule)). + ?only_per(testCompactBitString:otp_4869(Rule)). testPrimStrings(Config) -> test(Config, fun testPrimStrings/3). testPrimStrings(Config, Rule, Opts) -> @@ -371,10 +350,10 @@ testPrimExternal(Config, Rule, Opts) -> asn1_test_lib:compile_all(["External", "PrimExternal"], Config, [Rule|Opts]), testPrimExternal:external(Rule), - ?only_ber_nif(asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, + ?only_ber(asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, [Rule|Opts])), - ?only_ber_nif(testPrimStrings_cases(Rule)), - ?only_ber_nif(testPrimStrings:more_strings(Rule)). + ?only_ber(testPrimStrings_cases(Rule)), + ?only_ber(testPrimStrings:more_strings(Rule)). testChoPrim(Config) -> test(Config, fun testChoPrim/3). testChoPrim(Config, Rule, Opts) -> @@ -399,7 +378,7 @@ testChoOptional(Config, Rule, Opts) -> testChoOptionalImplicitTag(Config) -> test(Config, fun testChoOptionalImplicitTag/3, - [ber, ber_bin, ber_bin_v2]). + [ber]). testChoOptionalImplicitTag(Config, Rule, Opts) -> %% Only meaningful for ber & co asn1_test_lib:compile("ChoOptionalImplicitTag", Config, [Rule|Opts]), @@ -430,6 +409,11 @@ testChoTypeRefSet(Config, Rule, Opts) -> asn1_test_lib:compile("ChoTypeRefSet", Config, [Rule|Opts]), testChoTypeRefSet:set(Rule). +testMultipleLevels(Config) -> test(Config, fun testMultipleLevels/3). +testMultipleLevels(Config, Rule, Opts) -> + asn1_test_lib:compile("MultipleLevels", Config, [Rule|Opts]), + testMultipleLevels:main(Rule). + testDef(Config) -> test(Config, fun testDef/3). testDef(Config, Rule, Opts) -> asn1_test_lib:compile("Def", Config, [Rule|Opts]), @@ -515,8 +499,7 @@ testSeqOfCho(Config, Rule, Opts) -> testSeqOfCho:main(Rule). testSeqOfIndefinite(Config) -> - test(Config, fun testSeqOfIndefinite/3, - [ber, ber_bin, ber_bin_v2, {ber_bin_v2, [nif]}]). + test(Config, fun testSeqOfIndefinite/3, [ber]). testSeqOfIndefinite(Config, Rule, Opts) -> Files = ["Mvrasn-Constants-1", "Mvrasn-DataTypes-1", "Mvrasn-21-4", "Mvrasn-20-4", "Mvrasn-19-4", "Mvrasn-18-4", "Mvrasn-17-4", @@ -632,13 +615,12 @@ c_syntax(Config) -> "SeqBadComma"]]. c_string(Config) -> - test(Config, fun c_string/3, [per, per_bin, ber, ber_bin, ber_bin_v2]). + test(Config, fun c_string/3, [per, ber]). c_string(Config, Rule, Opts) -> asn1_test_lib:compile("String", Config, [Rule|Opts]). c_implicit_before_choice(Config) -> - test(Config, fun c_implicit_before_choice/3, - [ber, ber_bin, ber_bin_v2]). + test(Config, fun c_implicit_before_choice/3, [ber]). c_implicit_before_choice(Config, Rule, Opts) -> DataDir = ?config(data_dir, Config), CaseDir = ?config(case_dir, Config), @@ -649,12 +631,13 @@ parse(Config) -> [asn1_test_lib:compile(M, Config, [abs]) || M <- test_modules()]. per(Config) -> - test(Config, fun per/3, [per, per_bin, {per_bin, [optimize]}]). + test(Config, fun per/3, [per]). per(Config, Rule, Opts) -> [module_test(M, Config, Rule, Opts) || M <- per_modules()]. ber_other(Config) -> - test(Config, fun ber_other/3, [ber, ber_bin, ber_bin_v2]). + test(Config, fun ber_other/3, [ber]). + ber_other(Config, Rule, Opts) -> [module_test(M, Config, Rule, Opts) || M <- ber_modules()]. @@ -669,12 +652,12 @@ module_test(M, Config, Rule, Opts) -> ber_choiceinseq(Config) -> - test(Config, fun ber_choiceinseq/3, [ber, ber_bin, ber_bin_v2]). + test(Config, fun ber_choiceinseq/3, [ber]). ber_choiceinseq(Config, Rule, Opts) -> asn1_test_lib:compile("ChoiceInSeq", Config, [Rule|Opts]). ber_optional(Config) -> - test(Config, fun ber_optional/3, [ber, ber_bin, ber_bin_v2]). + test(Config, fun ber_optional/3, [ber]). ber_optional(Config, Rule, Opts) -> asn1_test_lib:compile("SOpttest", Config, [Rule|Opts]), V = {'S', {'A', 10, asn1_NOVALUE, asn1_NOVALUE}, @@ -685,21 +668,6 @@ ber_optional(Config, Rule, Opts) -> V2 = asn1_wrapper:decode('SOpttest', 'S', Bytes), V = element(2, V2). -ber_optional_keyed_list(Config) -> - test(Config, fun ber_optional_keyed_list/3, [ber, ber_bin]). -ber_optional_keyed_list(Config, Rule, Opts) -> - asn1_test_lib:compile("SOpttest", Config, [Rule, keyed_list|Opts]), - Vrecord = {'S', {'A', 10, asn1_NOVALUE, asn1_NOVALUE}, - {'B', asn1_NOVALUE, asn1_NOVALUE, asn1_NOVALUE}, - {'C', asn1_NOVALUE, 111, asn1_NOVALUE}}, - V = [{a, [{scriptKey, 10}]}, - {b, []}, - {c, [{callingPartysCategory, 111}]}], - {ok, B} = asn1_wrapper:encode('SOpttest', 'S', V), - Bytes = lists:flatten(B), - V2 = asn1_wrapper:decode('SOpttest', 'S', Bytes), - Vrecord = element(2, V2). - %% records used by test-case default -record('Def1', {bool0, bool1 = asn1_DEFAULT, @@ -734,7 +702,7 @@ value_bad_enum_test(Config) -> end. constructed(Config) -> - test(Config, fun constructed/3, [ber, ber_bin, ber_bin_v2]). + test(Config, fun constructed/3, [ber]). constructed(Config, Rule, Opts) -> asn1_test_lib:compile("Constructed", Config, [Rule|Opts]), {ok, B} = asn1_wrapper:encode('Constructed', 'S', {'S', false}), @@ -745,7 +713,7 @@ constructed(Config, Rule, Opts) -> [136, 1, 10] = lists:flatten(B2). ber_decode_error(Config) -> - test(Config, fun ber_decode_error/3, [ber, ber_bin, ber_bin_v2]). + test(Config, fun ber_decode_error/3, [ber]). ber_decode_error(Config, Rule, Opts) -> asn1_test_lib:compile("Constructed", Config, [Rule|Opts]), ber_decode_error:run(Opts). @@ -758,14 +726,14 @@ h323test(Config, Rule, Opts) -> h323test:run(Rule). per_GeneralString(Config) -> - test(Config, fun per_GeneralString/3, [per, per_bin]). + test(Config, fun per_GeneralString/3, [per]). per_GeneralString(Config, Rule, Opts) -> asn1_test_lib:compile("MULTIMEDIA-SYSTEM-CONTROL", Config, [Rule|Opts]), UI = [109, 64, 1, 57], {ok, _V} = asn1_wrapper:decode('MULTIMEDIA-SYSTEM-CONTROL', 'MultimediaSystemControlMessage', UI). -per_open_type(Config) -> test(Config, fun per_open_type/3, [per, per_bin]). +per_open_type(Config) -> test(Config, fun per_open_type/3, [per]). per_open_type(Config, Rule, Opts) -> asn1_test_lib:compile("OpenType", Config, [Rule|Opts]), {ok, _} = asn1ct:test('OpenType', 'Ot', {'Stype', 10, true}). @@ -778,24 +746,24 @@ testConstraints(Config, Rule, Opts) -> testSeqIndefinite(Config) -> - test(Config, fun testSeqIndefinite/3, [ber, ber_bin, ber_bin_v2, - {ber_bin_v2, [nif]}]). + test(Config, fun testSeqIndefinite/3, [ber]). + testSeqIndefinite(Config, Rule, Opts) -> asn1_test_lib:compile("SeqSetIndefinite", Config, [Rule|Opts]), testSeqIndefinite:main(Rule). testSetIndefinite(Config) -> - test(Config, fun testSetIndefinite/3, [ber, ber_bin, ber_bin_v2, - {ber_bin_v2, [nif]}]). + test(Config, fun testSetIndefinite/3, [ber]). + testSetIndefinite(Config, Rule, Opts) -> asn1_test_lib:compile("SeqSetIndefinite", Config, [Rule|Opts]), testSetIndefinite:main(Rule). testChoiceIndefinite(Config) -> - test(Config, fun testChoiceIndefinite/3, [ber, ber_bin, ber_bin_v2, - {ber_bin_v2, [nif]}]). + test(Config, fun testChoiceIndefinite/3, [ber]). + testChoiceIndefinite(Config, Rule, Opts) -> asn1_test_lib:compile("ChoiceIndef", Config, [Rule|Opts]), testChoiceIndefinite:main(Rule). @@ -857,7 +825,7 @@ testExport(Config) -> end. testImport(Config) -> - test(Config, fun testImport/3, [ber, ber_bin, ber_bin_v2]). + test(Config, fun testImport/3, [ber]). testImport(Config, Rule, Opts) -> {error, _} = asn1ct:compile(filename:join(?config(data_dir, Config), "ImportsFrom"), @@ -906,8 +874,7 @@ duplicate_tags(Config) -> {skip, "Runs in asn1_SUITE only"} end. -rtUI(Config) -> test(Config, fun rtUI/3, [per, per_bin, ber, - ber_bin, ber_bin_v2]). +rtUI(Config) -> test(Config, fun rtUI/3, [per,ber]). rtUI(Config, Rule, Opts) -> asn1_test_lib:compile("Prim", Config, [Rule|Opts]), {ok, _} = asn1rt:info('Prim'). @@ -923,19 +890,19 @@ testINSTANCE_OF(Config, Rule, Opts) -> testINSTANCE_OF:main(Rule). testTCAP(Config) -> - test(Config, fun testTCAP/3, - [ber, ber_bin, ber_bin_v2, {ber_bin_v2, [nif]}]). + test(Config, fun testTCAP/3, [ber]). testTCAP(Config, Rule, Opts) -> testTCAP:compile(Config, [Rule|Opts]), testTCAP:test(Rule, Config), case Rule of - ber_bin_v2 -> testTCAP:compile_asn1config(Config, [Rule, asn1config]), - testTCAP:test_asn1config(); - _ -> ok + ber -> + testTCAP:compile_asn1config(Config, [Rule, asn1config]), + testTCAP:test_asn1config(); + _ -> ok end. testDER(Config) -> - test(Config, fun testDER/3, [ber, ber_bin, ber_bin_v2]). + test(Config, fun testDER/3, [ber]). testDER(Config, Rule, Opts) -> asn1_test_lib:compile("DERSpec", Config, [Rule, der|Opts]), testDER:test(), @@ -945,7 +912,7 @@ testDER(Config, Rule, Opts) -> testSeqSetDefaultVal:main(Rule). specialized_decodes(Config) -> - test(Config, fun specialized_decodes/3, [ber_bin_v2]). + test(Config, fun specialized_decodes/3, [ber]). specialized_decodes(Config, Rule, Opts) -> asn1_test_lib:compile_all(["PartialDecSeq.asn", "PartialDecSeq2.asn", @@ -953,13 +920,12 @@ specialized_decodes(Config, Rule, Opts) -> "PartialDecMyHTTP.asn", "MEDIA-GATEWAY-CONTROL.asn", "P-Record"], - Config, [Rule, optimize, asn1config|Opts]), + Config, [Rule, asn1config|Opts]), test_partial_incomplete_decode:test(Config), test_selective_decode:test(). special_decode_performance(Config) -> - test(Config, fun special_decode_performance/3, - [{ber_bin, [optimize]}, {ber_bin_v2, [optimize, nif]}]). + test(Config, fun special_decode_performance/3, [ber]). special_decode_performance(Config, Rule, Opts) -> Files = ["MEDIA-GATEWAY-CONTROL", "PartialDecSeq"], asn1_test_lib:compile_all(Files, Config, [Rule, asn1config|Opts]), @@ -967,19 +933,19 @@ special_decode_performance(Config, Rule, Opts) -> test_driver_load(Config) -> - test(Config, fun test_driver_load/3, [{per_bin, [optimize]}]). + test(Config, fun test_driver_load/3, [per]). test_driver_load(Config, Rule, Opts) -> asn1_test_lib:compile("P-Record", Config, [Rule|Opts]), test_driver_load:test(5). test_ParamTypeInfObj(Config) -> - asn1_test_lib:compile("IN-CS-1-Datatypes", Config, [ber_bin]). + asn1_test_lib:compile("IN-CS-1-Datatypes", Config, [ber]). test_WS_ParamClass(Config) -> - asn1_test_lib:compile("InformationFramework", Config, [ber_bin]). + asn1_test_lib:compile("InformationFramework", Config, [ber]). test_Defed_ObjectIdentifier(Config) -> - asn1_test_lib:compile("UsefulDefinitions", Config, [ber_bin]). + asn1_test_lib:compile("UsefulDefinitions", Config, [ber]). testSelectionType(Config) -> test(Config, fun testSelectionType/3). testSelectionType(Config, Rule, Opts) -> @@ -987,7 +953,7 @@ testSelectionType(Config, Rule, Opts) -> {ok, _} = testSelectionTypes:test(). testSSLspecs(Config) -> - test(Config, fun testSSLspecs/3, [ber, ber_bin, ber_bin_v2, {ber_bin_v2, [optimize]}]). + test(Config, fun testSSLspecs/3, [ber]). testSSLspecs(Config, Rule, Opts) -> ok = testSSLspecs:compile(Config, [Rule, compact_bit_string, der|Opts]), @@ -1011,12 +977,12 @@ test_undecoded_rest(Config, Rule, Opts) -> ok = test_undecoded_rest:test([], Config), asn1_test_lib:compile("P-Record", Config, [Rule,undec_rest|Opts]), case Rule of - ber_bin_v2 -> ok; + ber -> ok; _ -> test_undecoded_rest:test(undec_rest, Config) end. test_inline(Config) -> - test(Config, fun test_inline/3, [ber, ber_bin, ber_bin_v2]). + test(Config, fun test_inline/3, [ber]). test_inline(Config, Rule, Opts) -> case code:which(asn1ct) of cover_compiled -> @@ -1029,12 +995,11 @@ test_inline(Config, Rule, Opts) -> end. testTcapsystem(Config) -> - test(Config, fun testTcapsystem/3, [ber, ber_bin, ber_bin_v2]). + test(Config, fun testTcapsystem/3, [ber]). testTcapsystem(Config, Rule, Opts) -> testTcapsystem:compile(Config, [Rule|Opts]). -testNBAPsystem(Config) -> test(Config, fun testNBAPsystem/3, - [per, per_bin, {per_bin, [optimize]}]). +testNBAPsystem(Config) -> test(Config, fun testNBAPsystem/3, [per]). testNBAPsystem(Config, Rule, Opts) -> testNBAPsystem:compile(Config, [Rule|Opts]), testNBAPsystem:test(Rule, Config). @@ -1068,20 +1033,19 @@ test_modified_x420(Config) -> testX420() -> [{timetrap,{minutes,90}}]. testX420(Config) -> - test(Config, fun testX420/3, [ber, ber_bin, ber_bin_v2]). + test(Config, fun testX420/3, [ber]). testX420(Config, Rule, Opts) -> testX420:compile(Rule, [der|Opts], Config), ok = testX420:ticket7759(Rule, Config), testX420:compile(Rule, Opts, Config). test_x691(Config) -> - test(Config, fun test_x691/3, - [per, per_bin, uper_bin, {per_bin, [optimize]}]). + test(Config, fun test_x691/3, [per, uper]). test_x691(Config, Rule, Opts) -> Files = ["P-RecordA1", "P-RecordA2", "P-RecordA3"], asn1_test_lib:compile_all(Files, Config, [Rule|Opts]), test_x691:cases(Rule, case Rule of - uper_bin -> unaligned; + uper -> unaligned; _ -> aligned end), asn1_test_lib:ticket_7708(Config, []), @@ -1092,8 +1056,7 @@ ticket_6143(Config) -> testExtensionAdditionGroup(Config) -> %% FIXME problems with automatic tags [ber_bin], [ber_bin, optimize] - test(Config, fun testExtensionAdditionGroup/3, - [per_bin, {per_bin, [optimize]}, uper_bin]). + test(Config, fun testExtensionAdditionGroup/3, [per, uper]). testExtensionAdditionGroup(Config, Rule, Opts) -> asn1_test_lib:compile("Extension-Addition-Group", Config, [Rule|Opts]), asn1_test_lib:compile_erlang("extensionAdditionGroup", Config, @@ -1182,46 +1145,17 @@ timer_compile(Config, Rule, Opts) -> asn1_test_lib:compile_all(["H235-SECURITY-MESSAGES", "H323-MESSAGES"], Config, [Rule|Opts]). -testTimer_ber(suite) -> []; testTimer_ber(Config) -> timer_compile(Config,ber,[]), testTimer:go(Config,ber). -testTimer_ber_bin(suite) -> []; -testTimer_ber_bin(Config) -> - timer_compile(Config,ber_bin,[]), - testTimer:go(Config,ber_bin). - -testTimer_ber_bin_opt(suite) -> []; -testTimer_ber_bin_opt(Config) -> - timer_compile(Config,ber_bin,[optimize]), - testTimer:go(Config,ber_bin). - -testTimer_ber_bin_opt_driver(suite) -> []; -testTimer_ber_bin_opt_driver(Config) -> - timer_compile(Config,ber_bin,[optimize,driver]), - testTimer:go(Config,ber_bin). - -testTimer_per(suite) -> []; testTimer_per(Config) -> timer_compile(Config,per,[]), testTimer:go(Config,per). -testTimer_per_bin(suite) -> []; -testTimer_per_bin(Config) -> - timer_compile(Config,per_bin,[]), - testTimer:go(Config,per_bin). - -testTimer_per_bin_opt(suite) -> []; -testTimer_per_bin_opt(Config) -> - timer_compile(Config,per_bin,[optimize]), - testTimer:go(Config,per_bin). - - -testTimer_uper_bin(suite) -> []; -testTimer_uper_bin(Config) -> - timer_compile(Config,uper_bin,[]), - {comment,_} = testTimer:go(Config,uper_bin). +testTimer_uper(Config) -> + timer_compile(Config,uper,[]), + {comment,_} = testTimer:go(Config,uper). %% Test of multiple-line comment, OTP-8043 testComment(suite) -> []; @@ -1264,11 +1198,11 @@ testName2Number(Config) -> ok. ticket_7407(Config) -> - asn1_test_lib:compile("EUTRA-extract-7407", Config, [uper_bin]), + asn1_test_lib:compile("EUTRA-extract-7407", Config, [uper]), asn1_test_lib:ticket_7407_code(true), asn1_test_lib:compile("EUTRA-extract-7407", Config, - [uper_bin, no_final_padding]), + [uper, no_final_padding]), asn1_test_lib:ticket_7407_code(false). smp(suite) -> []; @@ -1279,7 +1213,7 @@ smp(Config) -> io:format("smp starting ~p workers\n",[NumOfProcs]), Msg = {initiatingMessage, testNBAPsystem:cell_setup_req_msg()}, - ok = testNBAPsystem:compile(Config, [per_bin, optimize]), + ok = testNBAPsystem:compile(Config, [per]), enc_dec(NumOfProcs,Msg,2), @@ -1288,7 +1222,7 @@ smp(Config) -> {Time1,ok} = timer:tc(?MODULE,enc_dec,[NumOfProcs,Msg, N]), {Time1S,ok} = timer:tc(?MODULE,enc_dec,[1, Msg, NumOfProcs * N]), - ok = testNBAPsystem:compile(Config, [ber_bin, optimize, nif]), + ok = testNBAPsystem:compile(Config, [ber]), {Time3,ok} = timer:tc(?MODULE,enc_dec,[NumOfProcs,Msg, N]), {Time3S,ok} = timer:tc(?MODULE,enc_dec,[1, Msg, NumOfProcs * N]), @@ -1309,10 +1243,8 @@ per_performance(Config) -> file:make_dir(NifDir),file:make_dir(ErlDir), Msg = {initiatingMessage, testNBAPsystem:cell_setup_req_msg()}, - ok = testNBAPsystem:compile([{priv_dir,NifDir}|Config], - [per_bin, optimize]), - ok = testNBAPsystem:compile([{priv_dir,ErlDir}|Config], - [per_bin]), + ok = testNBAPsystem:compile([{priv_dir,NifDir}|Config], [per]), + ok = testNBAPsystem:compile([{priv_dir,ErlDir}|Config], [per]), Modules = ['NBAP-CommonDataTypes', 'NBAP-Constants', @@ -1350,7 +1282,7 @@ per_performance(Config) -> ber_performance(Config) -> Msg = {initiatingMessage, testNBAPsystem:cell_setup_req_msg()}, - ok = testNBAPsystem:compile(Config, [ber_bin, optimize, nif]), + ok = testNBAPsystem:compile(Config, [ber]), BerFun = fun() -> @@ -1524,7 +1456,7 @@ pforeach(_Fun,[],[]) -> -record('Iu-ReleaseCommand',{first,second}). ticket7904(Config) -> - asn1_test_lib:compile("RANAPextract1", Config, [per_bin, optimize]), + asn1_test_lib:compile("RANAPextract1", Config, [per]), Val1 = #'InitiatingMessage'{procedureCode=1, criticality=ignore, diff --git a/lib/asn1/test/asn1_SUITE_data/MultipleLevels.asn b/lib/asn1/test/asn1_SUITE_data/MultipleLevels.asn new file mode 100644 index 0000000000..1824e1fa5a --- /dev/null +++ b/lib/asn1/test/asn1_SUITE_data/MultipleLevels.asn @@ -0,0 +1,19 @@ +MultipleLevels DEFINITIONS AUTOMATIC TAGS ::= + +BEGIN + +Top ::= SEQUENCE { + country CountryName, + region Name +} + +CountryName ::= CountryName0 + +CountryName0 ::= Name + +Name ::= CHOICE { + short PrintableString (SIZE (0..10)), + long PrintableString +} + +END diff --git a/lib/asn1/test/asn1_SUITE_data/PartialDecSeq.asn1config b/lib/asn1/test/asn1_SUITE_data/PartialDecSeq.asn1config index 19fa3c990e..d388f6cd02 100644 --- a/lib/asn1/test/asn1_SUITE_data/PartialDecSeq.asn1config +++ b/lib/asn1/test/asn1_SUITE_data/PartialDecSeq.asn1config @@ -17,6 +17,6 @@ {decode_D_incomplete,['D',[{a,undecoded}]]}, {decode_F_fb_exclusive2,['F',[{fb,[{b,parts},{d,[{da,parts}]}]}]]}, {decode_F_fb_exclusive3,['F',[{fb,[{b,parts},{d,[{da,parts},{dc,[{dcc,undecoded}]}]}]}]]}]}}. {module_name,'Seq.asn1'}. -{compile_options,[ber_bin,optimize,debug_info]}. +{compile_options,[ber,debug_info]}. {multifile_compile,['M1.asn','M2.asn']}. diff --git a/lib/asn1/test/asn1_SUITE_data/testobj.erl b/lib/asn1/test/asn1_SUITE_data/testobj.erl index be7ceee7d1..80942f7e38 100644 --- a/lib/asn1/test/asn1_SUITE_data/testobj.erl +++ b/lib/asn1/test/asn1_SUITE_data/testobj.erl @@ -1420,24 +1420,7 @@ wrapper_encode(Module,Type,Value) -> Error end. -wrapper_decode(Module,Type,Bytes) -> - case Module:encoding_rule() of - ber -> - asn1rt:decode(Module,Type,Bytes); - ber_bin when binary(Bytes) -> - asn1rt:decode(Module,Type,Bytes); - ber_bin -> - asn1rt:decode(Module,Type,list_to_binary(Bytes)); - ber_bin_v2 when binary(Bytes) -> - asn1rt:decode(Module,Type,Bytes); - ber_bin_v2 -> - asn1rt:decode(Module,Type,list_to_binary(Bytes)); - per -> - asn1rt:decode(Module,Type,Bytes); - per_bin when binary(Bytes) -> - asn1rt:decode(Module,Type,Bytes); - per_bin -> - asn1rt:decode(Module,Type,list_to_binary(Bytes)); - uper_bin -> - asn1rt:decode(Module,Type,list_to_binary(Bytes)) - end. +wrapper_decode(Module, Type, Bytes) when is_binary(Bytes) -> + asn1rt:decode(Module, Type, Bytes); +wrapper_decode(Module, Type, Bytes) when is_list(Bytes) -> + asn1rt:decode(Module, Type, list_to_binary(Bytes)). diff --git a/lib/asn1/test/asn1_test_lib.erl b/lib/asn1/test/asn1_test_lib.erl index 96c04a9436..fda635d0eb 100644 --- a/lib/asn1/test/asn1_test_lib.erl +++ b/lib/asn1/test/asn1_test_lib.erl @@ -87,14 +87,14 @@ ticket_7407_compile(Config,Option) -> ?line OutDir = ?config(priv_dir,Config), ?line ok = asn1ct:compile(DataDir ++ "EUTRA-extract-7407", - [uper_bin, {outdir,OutDir}]++Option). + [uper, {outdir,OutDir}]++Option). ticket_7708(Config,Option) -> ?line DataDir = ?config(data_dir,Config), ?line OutDir = ?config(priv_dir,Config), ?line ok = asn1ct:compile(DataDir ++ "EUTRA-extract-55", - [uper_bin, {outdir,OutDir}]++Option). + [uper, {outdir,OutDir}]++Option). ticket_7407_code(FinalPadding) -> @@ -154,7 +154,7 @@ ticket_7678(Config, Option) -> ?line OutDir = ?config(priv_dir,Config), ?line ok = asn1ct:compile(DataDir ++ "UPERDefault", - [uper_bin, {outdir,OutDir}]++Option), + [uper, {outdir,OutDir}]++Option), ?line Val = 'UPERDefault':seq(), ?line {ok,<<0,6,0>>} = 'UPERDefault':encode('Seq',Val), @@ -167,12 +167,12 @@ ticket_7763(Config) -> ?line OutDir = ?config(priv_dir,Config), ?line ok = asn1ct:compile(DataDir ++ "EUTRA-extract-55", - [uper_bin, {outdir,OutDir}]), + [uper, {outdir,OutDir}]), Val = {'Seq',15,lists:duplicate(8,0),[0],lists:duplicate(28,0),15,true}, ?line {ok,Bin} = 'EUTRA-extract-55':encode('Seq',Val), ?line ok = asn1ct:compile(DataDir ++ "EUTRA-extract-55", - [uper_bin,compact_bit_string,{outdir,OutDir}]), + [uper,compact_bit_string,{outdir,OutDir}]), CompactVal = {'Seq',15,{0,<<0>>},{7,<<0>>},{4,<<0,0,0,0>>},15,true}, {ok,CompactBin} = 'EUTRA-extract-55':encode('Seq',CompactVal), diff --git a/lib/asn1/test/asn1_wrapper.erl b/lib/asn1/test/asn1_wrapper.erl index d515b99ac2..e764d8b4ca 100644 --- a/lib/asn1/test/asn1_wrapper.erl +++ b/lib/asn1/test/asn1_wrapper.erl @@ -34,41 +34,16 @@ encode(Module,Type,Value) -> Error end. -decode(Module,Type,Bytes) -> - case Module:encoding_rule() of - ber -> - asn1rt:decode(Module,Type,Bytes); - ber_bin when is_binary(Bytes) -> - asn1rt:decode(Module,Type,Bytes); - ber_bin -> - asn1rt:decode(Module,Type,list_to_binary(Bytes)); - ber_bin_v2 when is_binary(Bytes) -> - asn1rt:decode(Module,Type,Bytes); - ber_bin_v2 -> - asn1rt:decode(Module,Type,list_to_binary(Bytes)); - per -> - asn1rt:decode(Module,Type,Bytes); - per_bin when is_binary(Bytes) -> - asn1rt:decode(Module,Type,Bytes); - per_bin -> - asn1rt:decode(Module,Type,list_to_binary(Bytes)); - uper_bin when is_binary(Bytes) -> - asn1rt:decode(Module,Type,Bytes); - uper_bin -> - asn1rt:decode(Module,Type,list_to_binary(Bytes)) - end. +decode(Module, Type, Bytes) when is_binary(Bytes) -> + asn1rt:decode(Module, Type, Bytes); +decode(Module, Type, Bytes) when is_list(Bytes) -> + asn1rt:decode(Module, Type, list_to_binary(Bytes)). erule(ber) -> ber; -erule(ber_bin) -> - ber; -erule(ber_bin_v2) -> - ber; erule(per) -> per; -erule(per_bin) -> - per; -erule(uper_bin) -> +erule(uper) -> per. diff --git a/lib/asn1/test/h323test.erl b/lib/asn1/test/h323test.erl index b7a7d6e4df..426ae16994 100644 --- a/lib/asn1/test/h323test.erl +++ b/lib/asn1/test/h323test.erl @@ -22,7 +22,6 @@ -export([run/1]). -include_lib("test_server/include/test_server.hrl"). -run(per_bin) -> run(); run(per) -> run(); run(_Rules) -> ok. diff --git a/lib/asn1/test/testChoiceIndefinite.erl b/lib/asn1/test/testChoiceIndefinite.erl index 630efcf27a..b5832c985a 100644 --- a/lib/asn1/test/testChoiceIndefinite.erl +++ b/lib/asn1/test/testChoiceIndefinite.erl @@ -23,12 +23,7 @@ -include_lib("test_server/include/test_server.hrl"). -main(per_bin) -> ok; main(per) -> ok; -main(ber_bin_v2) -> - main(ber); -main(ber_bin) -> - main(ber); main(ber) -> %% Test case related to OTP-4358 %% normal encoding diff --git a/lib/asn1/test/testCompactBitString.erl b/lib/asn1/test/testCompactBitString.erl index 9563a31bf3..db102a3bda 100644 --- a/lib/asn1/test/testCompactBitString.erl +++ b/lib/asn1/test/testCompactBitString.erl @@ -233,7 +233,7 @@ compact_bit_string(Rules) -> ok. -ticket_7734(per_bin) -> +ticket_7734(per) -> ?line BS = {0,list_to_binary(lists:duplicate(128,0))}, ?line {ok,BSEnc} = asn1_wrapper:encode('PrimStrings','BS1024',BS), ?line {ok,BS} = asn1_wrapper:decode('PrimStrings','BS1024',BSEnc). @@ -251,7 +251,7 @@ bit_string_unnamed(Rules) -> lists:flatten(Bytes1)) end. -otp_4869(per_bin) -> +otp_4869(per) -> ?line Val1={'IP',[0],{0,<<62,235,90,50,0,0,0,0,0,0,0,0,0,0,0,0>>},asn1_NOVALUE}, ?line Val2 = {'IP',[0],[0,0,1,1,1,1,1,0,1,1,1,0,1,0,1,1,0,1,0,1,1,0,1,0,0,0,1,1,0,0,1,0] ++ lists:duplicate(128 - 32,0),asn1_NOVALUE}, diff --git a/lib/asn1/test/testEnumExt.erl b/lib/asn1/test/testEnumExt.erl index c97116413a..bb975a1d13 100644 --- a/lib/asn1/test/testEnumExt.erl +++ b/lib/asn1/test/testEnumExt.erl @@ -23,8 +23,8 @@ -include_lib("test_server/include/test_server.hrl"). -main(Rules) when Rules == per; Rules == per_bin; Rules == uper_bin -> - io:format("main(~p)~n",[Rules]), +main(Rule) when Rule =:= per; Rule =:= uper -> + io:format("main(~p)~n",[Rule]), B32=[32],B64=[64], %% ENUMERATED with extensionmark (value is in root set) ?line {ok,B32} = asn1_wrapper:encode('EnumExt','Ext',red), @@ -42,10 +42,6 @@ main(Rules) when Rules == per; Rules == per_bin; Rules == uper_bin -> ?line {ok,red} = asn1_wrapper:decode('EnumExt','Noext',B64), ok; -main(ber_bin_v2) -> - main(ber); -main(ber_bin) -> - main(ber); main(ber) -> io:format("main(ber)~n",[]), %% ENUMERATED with extensionmark (value is in root set) diff --git a/lib/asn1/test/testINSTANCE_OF.erl b/lib/asn1/test/testINSTANCE_OF.erl index 5986a00ec5..ce411beb92 100644 --- a/lib/asn1/test/testINSTANCE_OF.erl +++ b/lib/asn1/test/testINSTANCE_OF.erl @@ -26,7 +26,7 @@ main(Erule) -> ?line {ok,Integer} = asn1_wrapper:encode('INSTANCEOF','Int',3), - Int = wrap(Erule,Integer), + Int = list_to_binary(Integer), ValotherName = {otherName,{'INSTANCE OF',{2,4},Int}}, VallastName1 = {lastName,{'GeneralName_lastName',{2,4},12}}, VallastName2 = {lastName,{'GeneralName_lastName',{2,3,4}, @@ -61,18 +61,3 @@ test_encdec(_Erule,{lastName,{'GeneralName_lastName',{2,3,4}, ok; test_encdec(Erule,Res) -> {error,{Erule,Res}}. - -wrap(ber,Int) when is_list(Int) -> - binary_to_list(list_to_binary(Int)); -wrap(per,Int) when is_list(Int) -> - binary_to_list(list_to_binary(Int)); -wrap(ber_bin,Int) when is_list(Int) -> - list_to_binary(Int); -wrap(ber_bin_v2,Int) when is_list(Int) -> - list_to_binary(Int); -wrap(per_bin,Int) when is_list(Int) -> - list_to_binary(Int); -wrap(uper_bin,Int) when is_list(Int) -> - list_to_binary(Int); -wrap(_,Int) -> - Int. diff --git a/lib/asn1/test/testInfObjectClass.erl b/lib/asn1/test/testInfObjectClass.erl index e639066246..98408502c6 100644 --- a/lib/asn1/test/testInfObjectClass.erl +++ b/lib/asn1/test/testInfObjectClass.erl @@ -37,15 +37,12 @@ main(Rule) -> {component,'ArgumentType'}, {value,_},_}}} = asn1_wrapper:encode('InfClass','Seq', {'Seq',12,13,1}), - Bytes2 = - if - Rule==per;Rule==per_bin -> - [1,12,1,11,1,1]; - Rule == uper_bin -> - <<1,12,1,11,1,1>>; - true -> - [48,9,2,1,12,2,1,11,2,1,1] - end, + Bytes2 = case Rule of + ber -> + <<48,9,2,1,12,2,1,11,2,1,1>>; + _ -> + <<1,12,1,11,1,1>> + end, ?line {error,{asn1,{'Type not compatible with table constraint', {{component,_}, {value,_B},_}}}} = diff --git a/lib/asn1/test/testMergeCompile.erl b/lib/asn1/test/testMergeCompile.erl index 31aa3518f6..d63df28c31 100644 --- a/lib/asn1/test/testMergeCompile.erl +++ b/lib/asn1/test/testMergeCompile.erl @@ -43,17 +43,11 @@ main(Erule) -> ?line EncVal = case Erule of per -> - [1,100]; - per_bin -> <<1,100>>; - uper_bin -> + uper -> <<1,100>>; ber -> - [2,1,1]; - ber_bin -> - <<2,1,1>>; - ber_bin_v2 -> - <<2,1,1>> + [2,1,1] end, ?line PEVal2 = [{dummy,1,ignore,EncVal},{dummy,2,reject,EncVal}], ?line Val2 = @@ -76,7 +70,7 @@ main(Erule) -> mvrasn(Erule) -> case Erule of - Ber when Ber == ber;Ber == ber_bin -> + ber -> ?line ok = test(isd), ?line ok = test(isd2), ?line ok = test(dsd), diff --git a/lib/asn1/test/testMultipleLevels.erl b/lib/asn1/test/testMultipleLevels.erl new file mode 100644 index 0000000000..ff6d023440 --- /dev/null +++ b/lib/asn1/test/testMultipleLevels.erl @@ -0,0 +1,27 @@ +%% +%% %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(testMultipleLevels). +-export([main/1]). + +main(_) -> + Data = {'Top',{short,"abc"},{long,"a long string follows here"}}, + {ok,B} = 'MultipleLevels':encode('Top', Data), + {ok,Data} = 'MultipleLevels':decode('Top', iolist_to_binary(B)). diff --git a/lib/asn1/test/testParameterizedInfObj.erl b/lib/asn1/test/testParameterizedInfObj.erl index 68faf08a61..6f53595132 100644 --- a/lib/asn1/test/testParameterizedInfObj.erl +++ b/lib/asn1/test/testParameterizedInfObj.erl @@ -98,7 +98,7 @@ ranap(_Erule) -> ok. -open_type(uper_bin,Val) when is_list(Val) -> +open_type(uper,Val) when is_list(Val) -> list_to_binary(Val); open_type(_,Val) -> Val. diff --git a/lib/asn1/test/testSSLspecs.erl b/lib/asn1/test/testSSLspecs.erl index 51ef134e5f..45c5da50f0 100644 --- a/lib/asn1/test/testSSLspecs.erl +++ b/lib/asn1/test/testSSLspecs.erl @@ -42,11 +42,11 @@ compile(Config, Options) -> asn1_test_lib:compile_all(["PKIX1Explicit93", "PKIX1Implicit93"], Config, NewOptions). -compile_inline(Config, Rule) when Rule == ber_bin; Rule == ber_bin_v2 -> +compile_inline(Config, ber=Rule) -> DataDir = ?config(data_dir, Config), CaseDir = ?config(case_dir, Config), Options = [{i, CaseDir}, {i, DataDir}, Rule, - der, compact_bit_string, optimize, asn1config, inline], + 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) -> @@ -73,7 +73,7 @@ remove_db_file_inline(Dir) -> ?line ok = remove_db_file(Dir ++ "PKIX1Explicit88.asn1db"), ?line ok = remove_db_file(Dir ++ "PKIX1Implicit88.asn1db"). -run(BER) when BER==ber_bin;BER==ber_bin_v2 -> +run(ber) -> run1(1); run(_) -> ok. @@ -100,20 +100,20 @@ transform1(ATAV) -> ?line {ok, ATAVEnc} = 'PKIX1Explicit88':encode('AttributeTypeAndValue', ATAV), ?line {ok, _ATAVDec} = 'SSL-PKIX':decode('AttributeTypeAndValue', - list_to_binary(ATAVEnc)). + ATAVEnc). transform2(ATAV) -> ?line {ok, ATAVEnc} = 'PKIX1Explicit88':encode('AttributeTypeAndValue', ATAV), ?line {ok, _ATAVDec} = 'PKIX1Explicit88':decode('AttributeTypeAndValue', - list_to_binary(ATAVEnc)). + ATAVEnc). transform4(ATAV) -> ?line {ok, ATAVEnc} = 'PKIX1Explicit88':encode('Attribute', ATAV), ?line {ok, _ATAVDec} = 'PKIX1Explicit88':decode('Attribute', - list_to_binary(ATAVEnc)). + ATAVEnc). ex(1) -> @@ -146,7 +146,7 @@ ex(7) -> {1,2,840,113549,1,9,1}, [[19,5,111,116,112,67,65]]}. -run_inline(Rule) when Rule==ber_bin;Rule==ber_bin_v2 -> +run_inline(ber) -> Cert = cert(), ?line {ok,{'CertificatePKIX1Explicit88',{Type,UnDec},_,_}} = 'OTP-PKIX':decode_TBSCert_exclusive(Cert), ?line {ok,_} = 'OTP-PKIX':decode_part(Type,UnDec), diff --git a/lib/asn1/test/testSeqIndefinite.erl b/lib/asn1/test/testSeqIndefinite.erl index 25742474bb..c7b8aba523 100644 --- a/lib/asn1/test/testSeqIndefinite.erl +++ b/lib/asn1/test/testSeqIndefinite.erl @@ -23,13 +23,7 @@ -include_lib("test_server/include/test_server.hrl"). - -main(per_bin) -> ok; main(per) -> ok; -main(ber_bin_v2) -> - main(ber); -main(ber_bin) -> - main(ber); main(ber) -> %% normal encoding diff --git a/lib/asn1/test/testSeqOf.erl b/lib/asn1/test/testSeqOf.erl index 0c0bbc3e66..1aa1eab26d 100644 --- a/lib/asn1/test/testSeqOf.erl +++ b/lib/asn1/test/testSeqOf.erl @@ -198,19 +198,10 @@ main(Rules) -> ?line {ok,Bytes51} = asn1_wrapper:encode('SeqOf','SeqEmp',#'SeqEmp'{seq1 = [#'Empty'{}]}), ?line {ok,{'SeqEmp',[{'Empty'}]}} = asn1_wrapper:decode('SeqOf','SeqEmp',lists:flatten(Bytes51)), - - case Rules of - ber -> - ?line {ok,Bytes52} = asn1_wrapper:encode('SeqOfEnum','SeqOfEnum', - {'SeqOfEnum',[{'Enum',a},{'Enum',b}]}), - ?line {ok,[a,b]} = asn1_wrapper:decode('SeqOfEnum','SeqOfEnum', - lists:flatten(Bytes52)); - _ -> ok - end, %% tests of OTP-4590 case Rules of - PER when PER == per; PER == per_bin -> + per -> DayNames = ["Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"], ?line {ok,Bytes60} = asn1_wrapper:encode('XSeqOf','DayNames2',DayNames), ?line {ok,Bytes60} = asn1_wrapper:encode('XSeqOf','DayNames4',DayNames), diff --git a/lib/asn1/test/testSetIndefinite.erl b/lib/asn1/test/testSetIndefinite.erl index d8e2b6a9cf..73006da62b 100644 --- a/lib/asn1/test/testSetIndefinite.erl +++ b/lib/asn1/test/testSetIndefinite.erl @@ -24,12 +24,7 @@ -include_lib("test_server/include/test_server.hrl"). -main(per_bin) -> ok; main(per) -> ok; -main(ber_bin_v2) -> - main(ber); -main(ber_bin) -> - main(ber); main(ber) -> %% normal encoding diff --git a/lib/asn1/test/testSetOptional.erl b/lib/asn1/test/testSetOptional.erl index 4692941524..cef90bc843 100644 --- a/lib/asn1/test/testSetOptional.erl +++ b/lib/asn1/test/testSetOptional.erl @@ -181,7 +181,7 @@ main(_Rules) -> ok. -ticket_7533(Ber) when Ber == ber; Ber == ber_bin -> +ticket_7533(Ber) when Ber == ber -> Val = #'SetOpt1'{bool1 = true,int1=12,set1=#'SetIn'{boolIn=false,intIn=13}}, ?line {ok,B} = asn1_wrapper:encode('SetOptional','SetOpt1',Val), ?line {ok,Val} = asn1_wrapper:decode('SetOptional','SetOpt1',B), diff --git a/lib/asn1/test/testTCAP.erl b/lib/asn1/test/testTCAP.erl index 878ce7c070..b723995e40 100644 --- a/lib/asn1/test/testTCAP.erl +++ b/lib/asn1/test/testTCAP.erl @@ -37,7 +37,7 @@ compile_asn1config(Config, Options) -> asn1_test_lib:compile_all(Files, Config, Options), asn1_test_lib:compile_erlang("TCAPPackage_msg", Config, []). -test(Erule,_Config) when Erule==ber;Erule==ber_bin;Erule==ber_bin_v2 -> +test(ber=Erule,_Config) -> % ?line OutDir = ?config(priv_dir,Config), %% testing OTP-4798, open type encoded with indefinite length ?line {ok,_Res} = asn1_wrapper:decode('TCAPMessages-simple','MessageType', val_OTP_4798(Erule)), @@ -81,7 +81,7 @@ test_asn1config() -> ?line Val2 = 'TCAPPackage_msg':val('TransactionPDU'), ?line {ok,B2} = 'TCAPPackage':encode('TransactionPDU',Val2), - ?line {ok,ExMsg2}='TCAPPackage':decode_TransactionPDU(list_to_binary(B2)), + {ok,ExMsg2}='TCAPPackage':decode_TransactionPDU(B2), ?line {_,_,_,{Key2,ExVal2}}=ExMsg2, ?line {ok,_Parts2}='TCAPPackage':decode_part(Key2,ExVal2), diff --git a/lib/asn1/test/testTimer.erl b/lib/asn1/test/testTimer.erl index 2d3b777558..cd7ceb5630 100644 --- a/lib/asn1/test/testTimer.erl +++ b/lib/asn1/test/testTimer.erl @@ -133,23 +133,7 @@ go(Config,Enc) -> Module = 'H323-MESSAGES', Type = 'H323-UserInformation', Value = val(), -%% ok = asn1ct:compile(HelpModule,[Enc]), - -%% ok = asn1ct:compile(Module,[Enc]), - ?line {ok,B} = asn1rt:encode(Module,Type,Value), - Bytes = case Enc of - ber_bin -> - list_to_binary(B); - per_bin when is_list(B) -> - list_to_binary(B); - per_bin -> - B; - uper_bin -> - B; - _ -> - %%lists:flatten(B) - list_to_binary(B) - end, + {ok,Bytes} = asn1rt:encode(Module,Type,Value), CompileOptions = compile_options(), @@ -181,35 +165,18 @@ encode(N, Module,Type,Value) -> decode(0, _Module,_Type,_Value,_Erule) -> done; decode(N, Module,Type,Value,Erule) -> - case Erule of - ber -> - ?line {ok,_B} = asn1rt:decode(Module,Type,binary_to_list(Value)); - per -> - ?line {ok,_B} = asn1rt:decode(Module,Type,binary_to_list(Value)); - _ -> - ?line {ok,_B} = asn1rt:decode(Module,Type,Value) - end, + {ok,_B} = asn1rt:decode(Module,Type,Value), decode(N-1, Module,Type,Value,Erule). compile_options() -> - ?line {ok,Info} = asn1rt:info('H323-MESSAGES'), - case lists:keysearch(options,1,Info) of - {_,{_,Opts}} -> - Opts2 = - case lists:member(ber_bin_v2,Opts) of - true -> - [ber_bin,optimize] ++ lists:delete(optimize,Opts); - _ -> - Opts - end, - Opts3 = [X||X <- Opts2, - (X == ber orelse - X == ber_bin orelse - X == per orelse - X == per_bin orelse - X == optimize orelse - X == driver)], - lists:flatten(io_lib:format("~p",[Opts3])); + {ok,Info} = asn1rt:info('H323-MESSAGES'), + case lists:keyfind(options, 1, Info) of + {_,Opts0} -> + Opts1 = [X || X <- Opts0, + (X =:= ber orelse + X =:= per orelse + X =:= uper)], + lists:flatten(io_lib:format("~p", [Opts1])); _ -> "[]" end. diff --git a/lib/asn1/test/testTypeValueNotation.erl b/lib/asn1/test/testTypeValueNotation.erl index cd5223ef23..59f7385f08 100644 --- a/lib/asn1/test/testTypeValueNotation.erl +++ b/lib/asn1/test/testTypeValueNotation.erl @@ -21,11 +21,9 @@ -export([main/2]). --include_lib("test_server/include/test_server.hrl"). - -record('Seq', {octstr, int, bool, enum, bitstr, null, oid, vstr}). -main(Rule, Option) -> +main(_Rule, _Option) -> Value1 = #'Seq'{octstr = [1, 2, 3, 4], int = 12, bool = true, @@ -34,28 +32,5 @@ main(Rule, Option) -> null = 'NULL', oid = {1, 2, 55}, vstr = "Hello World"}, - Value2 = #'Seq'{octstr = {'OctStr', [1, 2, 3, 4]}, - int = {'Int', 12}, - bool = {'Bool', true}, - enum = {'Enum', a}, - bitstr = {'BitStr', [1, 0, 1, 0]}, - null = {'Null', 'NULL'}, - oid = {'OId', {1, 2, 55}}, - vstr = {'VStr', "Hello World"}}, - main(Rule, Option, Value1, Value2). - -%% Value2 will fail for ber_bin_v2, per_bin with nifs (optimize) and uper_bin -main(ber_bin_v2, _, Value1, Value2) -> encode_fail(Value1, Value2); -main(per_bin, [optimize], Value1, Value2) -> encode_fail(Value1, Value2); -main(uper_bin, [], Value1, Value2) -> encode_fail(Value1, Value2); -main(_, _, Value1, Value2) -> encode_normal(Value1, Value2). - -encode_normal(Value1, Value2) -> - {ok, Bytes} = asn1_wrapper:encode('SeqTypeRefPrim', 'Seq', Value1), - {ok, Bytes} = asn1_wrapper:encode('SeqTypeRefPrim', 'Seq', Value2), - {ok, Value1} = asn1_wrapper:decode('SeqTypeRefPrim', 'Seq', Bytes). - -encode_fail(Value1, Value2) -> - {ok, Bytes} = asn1_wrapper:encode('SeqTypeRefPrim', 'Seq', Value1), - {error, _Reason} = asn1_wrapper:encode('SeqTypeRefPrim', 'Seq', Value2), - {ok, Value1} = asn1_wrapper:decode('SeqTypeRefPrim', 'Seq', Bytes). + {ok, Bytes} = asn1_wrapper:encode('SeqTypeRefPrim', 'Seq', Value1), + {ok, Value1} = asn1_wrapper:decode('SeqTypeRefPrim', 'Seq', Bytes). diff --git a/lib/asn1/test/testX420.erl b/lib/asn1/test/testX420.erl index abdbbfe536..52b20a2c70 100644 --- a/lib/asn1/test/testX420.erl +++ b/lib/asn1/test/testX420.erl @@ -34,7 +34,7 @@ compile(Erule, Options, Config) -> compile_loop(_Erule, [], _Options, _Config) -> ok; compile_loop(Erule, [Spec|Specs], Options, Config) - when Erule == ber; Erule == ber_bin; Erule == ber_bin_v2; Erule == per -> + when Erule =:= ber; Erule =:= per -> CaseDir = ?config(case_dir, Config), asn1_test_lib:compile(filename:join([x420, Spec]), Config, [Erule, {i, CaseDir}]), diff --git a/lib/asn1/test/test_compile_options.erl b/lib/asn1/test/test_compile_options.erl index 4e732308d8..b973c5fbcc 100644 --- a/lib/asn1/test/test_compile_options.erl +++ b/lib/asn1/test/test_compile_options.erl @@ -92,7 +92,8 @@ noobj(Config) -> file:delete(filename:join([OutDir,'P-Record.beam'])), file:delete(filename:join([OutDir,'p_record.erl'])), file:delete(filename:join([OutDir,'p_record.beam'])), - ?line ok=asn1ct:compile(filename:join([DataDir,"p_record.set.asn"]),[asn1config,ber_bin,optimize,noobj,{outdir,OutDir}]), + ok = asn1ct:compile(filename:join([DataDir,"p_record.set.asn"]), + [asn1config,ber,noobj,{outdir,OutDir}]), %% ?line false = code:is_loaded('P-Record'), %% ?line false = code:is_loaded('p_record'), ?line {error,enoent} = diff --git a/lib/asn1/test/test_inline.erl b/lib/asn1/test/test_inline.erl index 62625572e3..e03ad739f9 100644 --- a/lib/asn1/test/test_inline.erl +++ b/lib/asn1/test/test_inline.erl @@ -41,16 +41,16 @@ inline1(Config, Rule, Opt) -> asn1_test_lib:compile("P-Record", Config, [{inline, 'inlined_P_Record'}|Opt]), test_inline1(), - ok=remove_inlined_files2(CaseDir, ber_bin_v2), + ok=remove_inlined_files2(CaseDir, ber), case Rule of - ber_bin_v2 -> + ber -> asn1_test_lib:compile("P-Record", Config, - [ber_bin, inline, asn1config, optimize|Opt]), + [ber, inline, asn1config|Opt]), test_inline2(Rule, 'P-Record'), remove_inlined_files3(CaseDir, Rule), asn1_test_lib:compile("p_record.set.asn", Config, - [ber_bin, inline, asn1config, optimize|Opt]), + [ber, inline, asn1config|Opt]), test_inline2(Rule, 'p_record'), remove_inlined_files4(CaseDir, Rule); _ -> @@ -71,12 +71,12 @@ test_inline1() -> ?line {ok,_}=asn1_wrapper:decode('inlined_P_Record', 'PersonnelRecord',Bytes). -test_inline2(ber_bin_v2,Mod) -> +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), - ?line {ok,_} = Mod:sel_dec(list_to_binary(Bytes)); + {ok,_} = Mod:sel_dec(Bytes); test_inline2(_,_) -> ok. @@ -243,7 +243,7 @@ remove_inlined_files2(Dir,Rule) -> ?line ok=file:delete(X) end,[TargetErl,TargetBeam]), ok. -remove_inlined_files3(Dir,ber_bin_v2) -> +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"]), @@ -255,7 +255,7 @@ remove_inlined_files3(Dir,ber_bin_v2) -> remove_inlined_files3(_,_) -> ok. -remove_inlined_files4(Dir,ber_bin_v2) -> +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"]), diff --git a/lib/asn1/test/test_special_decode_performance.erl b/lib/asn1/test/test_special_decode_performance.erl index 4ac0ff2b27..dd56d29b28 100644 --- a/lib/asn1/test/test_special_decode_performance.erl +++ b/lib/asn1/test/test_special_decode_performance.erl @@ -33,7 +33,7 @@ go(all) -> go(N,Mod) -> ?line Val = val(Mod), ?line {ok,B} = Mod:encode(element(1,Val),Val), - ?line go(Mod,list_to_binary(B),N). + ?line go(Mod,B,N). go(Mod,Bin,N) -> ?line FsS = get_selective_funcs(Mod), |