aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/appmon/vsn.mk18
-rw-r--r--lib/asn1/src/asn1.appup.src108
-rw-r--r--lib/asn1/src/asn1_records.hrl13
-rw-r--r--lib/asn1/src/asn1ct_check.erl272
-rw-r--r--lib/asn1/src/asn1ct_constructed_ber.erl41
-rw-r--r--lib/asn1/src/asn1ct_constructed_per.erl308
-rw-r--r--lib/asn1/src/asn1ct_gen.erl37
-rw-r--r--lib/asn1/src/asn1ct_parser2.erl527
-rw-r--r--lib/asn1/src/asn1ct_tok.erl184
-rw-r--r--lib/asn1/test/Makefile29
-rw-r--r--lib/asn1/test/asn1_SUITE.erl.src19
-rw-r--r--lib/asn1/test/asn1_SUITE_data/AA2.asn1dbbin5224 -> 5910 bytes
-rw-r--r--lib/asn1/test/asn1_SUITE_data/Extension-Addition-Group.asn66
-rw-r--r--lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl43
-rw-r--r--lib/compiler/src/compile.erl4
-rw-r--r--lib/crypto/c_src/crypto.c2
-rw-r--r--lib/crypto/test/crypto_SUITE.erl19
-rw-r--r--lib/docbuilder/src/docb_edoc_xml_cb.erl27
-rw-r--r--lib/erl_docgen/priv/xsl/db_html.xsl4
-rw-r--r--lib/erl_docgen/vsn.mk21
-rw-r--r--lib/et/vsn.mk18
-rw-r--r--lib/inets/vsn.mk19
-rw-r--r--lib/jinterface/vsn.mk18
-rw-r--r--lib/kernel/vsn.mk19
-rw-r--r--lib/megaco/vsn.mk19
-rw-r--r--lib/public_key/src/public_key.erl18
-rw-r--r--lib/public_key/test/public_key_SUITE.erl5
-rw-r--r--lib/reltool/vsn.mk18
-rw-r--r--lib/snmp/vsn.mk19
-rw-r--r--lib/ssl/src/ssl_certificate.erl47
-rw-r--r--lib/ssl/src/ssl_connection.erl113
-rw-r--r--lib/ssl/src/ssl_handshake.erl102
-rw-r--r--lib/ssl/test/erl_make_certs.erl51
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl87
-rw-r--r--lib/ssl/test/ssl_packet_SUITE.erl40
-rw-r--r--lib/ssl/test/ssl_test_lib.erl19
-rw-r--r--lib/ssl/test/ssl_to_openssl_SUITE.erl24
-rw-r--r--lib/ssl/vsn.mk19
-rw-r--r--lib/stdlib/doc/src/ets.xml107
-rw-r--r--lib/stdlib/src/ms_transform.erl193
-rw-r--r--lib/stdlib/test/ets_SUITE.erl75
-rw-r--r--lib/stdlib/test/ms_transform_SUITE.erl101
-rw-r--r--lib/stdlib/vsn.mk19
-rw-r--r--lib/tools/vsn.mk18
-rw-r--r--lib/tv/vsn.mk19
-rw-r--r--lib/xmerl/src/xmerl_dtd.erl0
-rw-r--r--lib/xmerl/vsn.mk19
47 files changed, 1730 insertions, 1218 deletions
diff --git a/lib/appmon/vsn.mk b/lib/appmon/vsn.mk
index cfcb5d3eb6..0675a4eb8b 100644
--- a/lib/appmon/vsn.mk
+++ b/lib/appmon/vsn.mk
@@ -1,19 +1 @@
-#
-# %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%
-
APPMON_VSN = 2.1.12
diff --git a/lib/asn1/src/asn1.appup.src b/lib/asn1/src/asn1.appup.src
index 753d308684..2d11eddfbf 100644
--- a/lib/asn1/src/asn1.appup.src
+++ b/lib/asn1/src/asn1.appup.src
@@ -1,111 +1,9 @@
{"%VSN%",
- [
- {"1.6.8",
- [
- {load_module, asn1rt, soft_purge, soft_purge, []},
- {load_module, asn1rt_per_bin, soft_purge, soft_purge, []},
- {load_module, asn1rt_per_bin_rt2ct, soft_purge, soft_purge, []},
- {load_module, asn1rt_uper_bin, soft_purge, soft_purge, []},
- {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []},
- {load_module, asn1rt_ber_bin_v2, soft_purge, soft_purge, []},
- {load_module, asn1rt_check, soft_purge, soft_purge, []},
- {load_module, asn1rt_driver_handler, soft_purge, soft_purge, []},
- {apply, {asn1rt_driver_handler,unload_driver,[]}}
- ]
- },
- {"1.6.8.1",
- [
- {load_module, asn1rt, soft_purge, soft_purge, []},
- {load_module, asn1rt_per_bin, soft_purge, soft_purge, []},
- {load_module, asn1rt_per_bin_rt2ct, soft_purge, soft_purge, []},
- {load_module, asn1rt_uper_bin, soft_purge, soft_purge, []},
- {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []},
- {load_module, asn1rt_ber_bin_v2, soft_purge, soft_purge, []},
- {load_module, asn1rt_check, soft_purge, soft_purge, []},
- {load_module, asn1rt_driver_handler, soft_purge, soft_purge, []},
- {apply, {asn1rt_driver_handler,unload_driver,[]}}
- ]
- },
- {"1.6.9",
- [
- {load_module, asn1rt, soft_purge, soft_purge, []},
- {load_module, asn1rt_per_bin, soft_purge, soft_purge, []},
- {load_module, asn1rt_per_bin_rt2ct, soft_purge, soft_purge, []},
- {load_module, asn1rt_uper_bin, soft_purge, soft_purge, []},
- {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []},
- {load_module, asn1rt_ber_bin_v2, soft_purge, soft_purge, []},
- {load_module, asn1rt_check, soft_purge, soft_purge, []},
- {load_module, asn1rt_driver_handler, soft_purge, soft_purge, []},
- {apply, {asn1rt_driver_handler,unload_driver,[]}}
- ]
- },
- {"1.6.10",
- [
- {load_module, asn1rt, soft_purge, soft_purge, []},
- {load_module, asn1rt_per_bin, soft_purge, soft_purge, []},
- {load_module, asn1rt_per_bin_rt2ct, soft_purge, soft_purge, []},
- {load_module, asn1rt_uper_bin, soft_purge, soft_purge, []},
- {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []},
- {load_module, asn1rt_ber_bin_v2, soft_purge, soft_purge, []},
- {load_module, asn1rt_check, soft_purge, soft_purge, []},
- {load_module, asn1rt_driver_handler, soft_purge, soft_purge, []},
- {apply, {asn1rt_driver_handler,unload_driver,[]}}
- ]
- }
+% This version does not change anything of the runtime modules
+% Only changes in compile time modules and thus no need for upgrade on target
+[
],
[
- {"1.6.8",
- [
- {load_module, asn1rt, soft_purge, soft_purge, []},
- {load_module, asn1rt_per_bin, soft_purge, soft_purge, []},
- {load_module, asn1rt_per_bin_rt2ct, soft_purge, soft_purge, []},
- {load_module, asn1rt_uper_bin, soft_purge, soft_purge, []},
- {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []},
- {load_module, asn1rt_ber_bin_v2, soft_purge, soft_purge, []},
- {load_module, asn1rt_check, soft_purge, soft_purge, []},
- {load_module, asn1rt_driver_handler, soft_purge, soft_purge, []},
- {apply, {asn1rt_driver_handler,unload_driver,[]}}
- ]
- },
- {"1.6.8.1",
- [
- {load_module, asn1rt, soft_purge, soft_purge, []},
- {load_module, asn1rt_per_bin, soft_purge, soft_purge, []},
- {load_module, asn1rt_per_bin_rt2ct, soft_purge, soft_purge, []},
- {load_module, asn1rt_uper_bin, soft_purge, soft_purge, []},
- {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []},
- {load_module, asn1rt_ber_bin_v2, soft_purge, soft_purge, []},
- {load_module, asn1rt_check, soft_purge, soft_purge, []},
- {load_module, asn1rt_driver_handler, soft_purge, soft_purge, []},
- {apply, {asn1rt_driver_handler,unload_driver,[]}}
- ]
- },
- {"1.6.9",
- [
- {load_module, asn1rt, soft_purge, soft_purge, []},
- {load_module, asn1rt_per_bin, soft_purge, soft_purge, []},
- {load_module, asn1rt_per_bin_rt2ct, soft_purge, soft_purge, []},
- {load_module, asn1rt_uper_bin, soft_purge, soft_purge, []},
- {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []},
- {load_module, asn1rt_ber_bin_v2, soft_purge, soft_purge, []},
- {load_module, asn1rt_check, soft_purge, soft_purge, []},
- {load_module, asn1rt_driver_handler, soft_purge, soft_purge, []},
- {apply, {asn1rt_driver_handler,unload_driver,[]}}
- ]
- },
- {"1.6.10",
- [
- {load_module, asn1rt, soft_purge, soft_purge, []},
- {load_module, asn1rt_per_bin, soft_purge, soft_purge, []},
- {load_module, asn1rt_per_bin_rt2ct, soft_purge, soft_purge, []},
- {load_module, asn1rt_uper_bin, soft_purge, soft_purge, []},
- {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []},
- {load_module, asn1rt_ber_bin_v2, soft_purge, soft_purge, []},
- {load_module, asn1rt_check, soft_purge, soft_purge, []},
- {load_module, asn1rt_driver_handler, soft_purge, soft_purge, []},
- {apply, {asn1rt_driver_handler,unload_driver,[]}}
- ]
- }
]}.
diff --git a/lib/asn1/src/asn1_records.hrl b/lib/asn1/src/asn1_records.hrl
index 8a428b744c..59a9acb7e7 100644
--- a/lib/asn1/src/asn1_records.hrl
+++ b/lib/asn1/src/asn1_records.hrl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
-%%
+%%
+%% 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%
%%
%%
@@ -36,7 +36,8 @@
-record(module,{pos,name,defid,tagdefault='EXPLICIT',exports={exports,[]},imports={imports,[]}, extensiondefault=empty,typeorval}).
--record('SEQUENCE',{pname=false,tablecinf=false,components=[]}).
+-record('ExtensionAdditionGroup',{number}).
+-record('SEQUENCE',{pname=false,tablecinf=false,extaddgroup,components=[]}).
-record('SET',{pname=false,sorted=false,tablecinf=false,components=[]}).
-record('ComponentType',{pos,name,typespec,prop,tags,textual_order}).
-record('ObjectClassFieldType',{classname,class,fieldname,type}).
diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl
index 54a5c7e727..1c9f2c759a 100644
--- a/lib/asn1/src/asn1ct_check.erl
+++ b/lib/asn1/src/asn1ct_check.erl
@@ -3227,7 +3227,7 @@ check_ptype(_S,_PTDef,Ts) when is_record(Ts,objectclass) ->
% check_type(S,Type,ObjSpec={{objectclassname,_},_}) ->
-% check_class(S,ObjSpec);
+ % check_class(S,ObjSpec);
check_type(_S,Type,Ts) when is_record(Type,typedef),
(Type#typedef.checked==true) ->
Ts;
@@ -3357,6 +3357,7 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) ->
merge_tags(Tag,?TAG_PRIMITIVE(?N_INTEGER))};
'REAL' ->
check_real(S,Constr),
+
TempNewDef#newt{tag=merge_tags(Tag,?TAG_PRIMITIVE(?N_REAL))};
{'BIT STRING',NamedNumberList} ->
NewL = check_bitstring(S,NamedNumberList,Constr),
@@ -5522,24 +5523,9 @@ check_sequence(S,Type,Comps) ->
Components2 = maybe_automatic_tags(S,Components),
%% check the table constraints from here. The outermost type
%% is Type, the innermost is Comps (the list of components)
- NewComps =
- case check_each_component(S,Type,Components2) of
- NewComponents when is_list(NewComponents) ->
- check_unique_sequence_tags(S,NewComponents),
- NewComponents;
- Ret = {NewComponents,NewEcomps} ->
- TagComps = NewComponents ++
- [Comp#'ComponentType'{prop='OPTIONAL'}|| Comp <- NewEcomps],
- %% extension components are like optionals when it comes to tagging
- check_unique_sequence_tags(S,TagComps),
- Ret;
- Ret = {Root1,NewE,Root2} ->
- TagComps = Root1 ++ [Comp#'ComponentType'{prop='OPTIONAL'}|| Comp <- NewE]++Root2,
- %% This is not correct handling if Extension
- %% contains ExtensionAdditionGroups
- check_unique_sequence_tags(S,TagComps),
- Ret
- end,
+ NewComps = check_each_component2(S,Type,Components2),
+ check_unique_sequence_tags(S,NewComps),
+
%% CRelInf is the "leading attribute" information
%% necessary for code generating of the look up in the
%% object set table,
@@ -5553,12 +5539,45 @@ check_sequence(S,Type,Comps) ->
%% the involved class removed, as the class of the object
%% set.
CompListWithTblInf = get_tableconstraint_info(S,Type,NewComps2),
-
- {CRelInf,CompListWithTblInf};
+ %% If encoding rule is in the PER family the Root Components
+ %% after the second extension mark should be encoded before
+ %% all extensions i.e together with the first Root components
+
+ NewComps3 = textual_order(CompListWithTblInf),
+ CompListTuple =
+ complist_as_tuple(is_erule_per(S#state.erule),NewComps3),
+ {CRelInf,CompListTuple};
Dupl ->
- throw({error,{asn1,{duplicate_components,Dupl}}})
+ throw({error,{asn1,{duplicate_components,Dupl}}})
end.
+complist_as_tuple(Per,CompList) ->
+ complist_as_tuple(Per,CompList,[],[],[],root).
+
+complist_as_tuple(Per,[#'EXTENSIONMARK'{}|T],Acc,Ext,Acc2,root) ->
+ complist_as_tuple(Per,T,Acc,Ext,Acc2,ext);
+complist_as_tuple(Per,[#'EXTENSIONMARK'{}|T],Acc,Ext,Acc2,ext) ->
+ complist_as_tuple(Per,T,Acc,Ext,Acc2,root2);
+complist_as_tuple(_Per,[#'EXTENSIONMARK'{}|_T],_Acc,_Ext,_Acc2,root2) ->
+ throw({error,{asn1,{too_many_extension_marks}}});
+complist_as_tuple(Per,[C|T],Acc,Ext,Acc2,root) ->
+ complist_as_tuple(Per,T,[C|Acc],Ext,Acc2,root);
+complist_as_tuple(Per,[C|T],Acc,Ext,Acc2,ext) ->
+ complist_as_tuple(Per,T,Acc,[C|Ext],Acc2,ext);
+complist_as_tuple(Per,[C|T],Acc,Ext,Acc2,root2) ->
+ complist_as_tuple(Per,T,Acc,Ext,[C|Acc2],root2);
+complist_as_tuple(_Per,[],Acc,_Ext,_Acc2,root) ->
+ lists:reverse(Acc);
+complist_as_tuple(_Per,[],Acc,Ext,_Acc2,ext) ->
+ {lists:reverse(Acc),lists:reverse(Ext)};
+%%complist_as_tuple(_Per = true,[],Acc,Ext,Acc2,root2) ->
+%% {lists:reverse(Acc)++lists:reverse(Acc2),lists:reverse(Ext)};
+complist_as_tuple(_Per,[],Acc,Ext,Acc2,root2) ->
+ {lists:reverse(Acc),lists:reverse(Ext),lists:reverse(Acc2)}.
+
+is_erule_per(Erule) ->
+ lists:member(Erule,[per,per_bin,uper_bin]).
+
expand_components(S, [{'COMPONENTS OF',Type}|T]) ->
CompList = expand_components2(S,get_referenced_type(S,Type#type.def)),
expand_components(S,CompList) ++ expand_components(S,T);
@@ -5601,13 +5620,26 @@ take_only_rootset([#'EXTENSIONMARK'{}|_T])->
take_only_rootset([H|T]) ->
[H|take_only_rootset(T)].
-check_unique_sequence_tags(S,[#'ComponentType'{prop=mandatory}|Rest]) ->
- check_unique_sequence_tags(S,Rest);
-check_unique_sequence_tags(S,[C|Rest]) when is_record(C,'ComponentType') ->
+check_unique_sequence_tags(S,CompList) ->
+ TagComps = case complist_as_tuple(false,CompList) of
+ {R1,Ext,R2} ->
+ R1 ++ [C#'ComponentType'{prop='OPTIONAL'}||
+ C = #'ComponentType'{} <- Ext]++R2;
+ {R1,Ext} ->
+ R1 ++ [C#'ComponentType'{prop='OPTIONAL'}||
+ C = #'ComponentType'{} <- Ext];
+ _ ->
+ CompList
+ end,
+ check_unique_sequence_tags0(S,TagComps).
+
+check_unique_sequence_tags0(S,[#'ComponentType'{prop=mandatory}|Rest]) ->
+ check_unique_sequence_tags0(S,Rest);
+check_unique_sequence_tags0(S,[C=#'ComponentType'{}|Rest]) ->
check_unique_sequence_tags1(S,Rest,[C]);% optional or default
-check_unique_sequence_tags(S,[_ExtensionMarker|Rest]) ->
- check_unique_sequence_tags(S,Rest);
-check_unique_sequence_tags(_S,[]) ->
+check_unique_sequence_tags0(S,[_ExtensionMarker|Rest]) ->
+ check_unique_sequence_tags0(S,Rest);
+check_unique_sequence_tags0(_S,[]) ->
true.
check_unique_sequence_tags1(S,[C|Rest],Acc) when is_record(C,'ComponentType') ->
@@ -5807,8 +5839,10 @@ get_least_tag(TagList) ->
%% adds the textual order to the components to keep right order of
%% components in the asn1-value.
textual_order(Cs) ->
- Fun = fun(C,Index) ->
- {C#'ComponentType'{textual_order=Index},Index+1}
+ Fun = fun(C=#'ComponentType'{},Index) ->
+ {C#'ComponentType'{textual_order=Index},Index+1};
+ (Other,Index) ->
+ {Other,Index}
end,
{NewCs,_} = textual_order(Cs,Fun,1),
NewCs.
@@ -5879,7 +5913,6 @@ check_selectiontype2(S,Name,TypeDef) ->
error({type,Msg,S})
end.
-
check_restrictedstring(_S,_Def,_Constr) ->
ok.
@@ -5899,16 +5932,16 @@ check_choice(S,Type,Components) when is_list(Components) ->
[] ->
%% sort_canonical(Components),
Components2 = maybe_automatic_tags(S,Components),
- %NewComps =
- case check_each_alternative(S,Type,Components2) of
- {NewComponents,NewEcomps} ->
- check_unique_tags(S,NewComponents ++ NewEcomps),
- {NewComponents,NewEcomps};
- NewComponents ->
- check_unique_tags(S,NewComponents),
- NewComponents
- end;
-
+ NewComps = check_each_alternative2(S,Type,Components2),
+ %% ExtensionAdditionGroup markers i.e '[[' ']]' are not
+ %% significant for encoding/decoding a choice
+ %% therefore we remove them here
+ NewComps2 = lists:filter(fun(#'ExtensionAdditionGroup'{}) -> false;
+ ('ExtensionAdditionGroupEnd') -> false;
+ (_) -> true
+ end,NewComps),
+ check_unique_tags(S,NewComps2),
+ complist_as_tuple(is_erule_per(S#state.erule),NewComps2);
Dupl ->
throw({error,{asn1,{duplicate_choice_alternatives,Dupl}}})
end;
@@ -6036,12 +6069,17 @@ check_unique2([_|T],Pos,Acc) ->
check_unique2([],_,Acc) ->
lists:reverse(Acc).
-check_each_component(S,Type,Components) ->
- check_each_component(S,Type,Components,[],[],[],root1).
-check_each_component(S = #state{abscomppath=Path,recordtopname=TopName},Type,
- [C|Ct],Acc,Extacc,Acc2,Ext) when is_record(C,'ComponentType') ->
- #'ComponentType'{name=Cname,typespec=Ts,prop=Prop} = C,
+%% Replaces check_each_component and does the same work except that
+%% it keeps the complist as a flat list and does not create a tuple with root and
+%% extensions separated
+check_each_component2(S,Type,Components) ->
+ check_each_component2(S,Type,Components,[]).
+
+check_each_component2(S = #state{abscomppath=Path,recordtopname=TopName},
+ Type,
+ [C = #'ComponentType'{name=Cname,typespec=Ts,prop=Prop}|Ct],
+ Acc) ->
NewAbsCPath =
case Ts#type.def of
#'Externaltypereference'{} -> [];
@@ -6058,75 +6096,48 @@ check_each_component(S = #state{abscomppath=Path,recordtopname=TopName},Type,
DefaultValue -> {'DEFAULT',DefaultValue}
end,
NewC = C#'ComponentType'{typespec=CheckedTs,prop=NewProp,tags=NewTags},
- case Ext of
- root1 ->
- check_each_component(S,Type,Ct,[NewC|Acc],Extacc,Acc2,Ext);
- ext ->
- check_each_component(S,Type,Ct,Acc,[NewC|Extacc],Acc2,Ext);
- root2 ->
- check_each_component(S,Type,Ct,Acc,Extacc,[NewC|Acc2],Ext)
- end;
-check_each_component(S,Type,[_|Ct],Acc,Extacc,Acc2,root1) -> % skip 'EXTENSIONMARK'
- check_each_component(S,Type,Ct,Acc,Extacc,Acc2,ext);
-check_each_component(S,Type,[_|Ct],Acc,Extacc,Acc2,ext) -> % skip 'EXTENSIONMARK'
- check_each_component(S,Type,Ct,Acc,Extacc,Acc2,root2);
-check_each_component(_S,_,[_C|_Ct],_,_,_,root2) -> % 'EXTENSIONMARK'
- throw({error,{asn1,{too_many_extension_marks}}});
-check_each_component(_S,_,[],Acc,Extacc,_,ext) ->
- {lists:reverse(Acc),lists:reverse(Extacc)};
-check_each_component(_S,_,[],Acc1,ExtAcc,Acc2,root2) ->
- {lists:reverse(Acc1),lists:reverse(ExtAcc),lists:reverse(Acc2)};
-check_each_component(_S,_,[],Acc,_,_,root1) ->
+ check_each_component2(S,Type,Ct,[NewC|Acc]);
+
+check_each_component2(S,Type,[OtherMarker|Ct],Acc) ->
+ %% let 'EXTENSIONMARK' and 'ExtensionAdditionGroup' markers pass through as is
+ check_each_component2(S,Type,Ct,[OtherMarker|Acc]);
+check_each_component2(_S,_,[],Acc) ->
lists:reverse(Acc).
-%% check_each_alternative(S,Type,{Rlist,ExtList}) ->
+
+%% check_each_alternative2(S,Type,{Rlist,ExtList}) ->
%% {check_each_alternative(S,Type,Rlist),
%% check_each_alternative(S,Type,ExtList)};
-check_each_alternative(S,Type,[C|Ct]) ->
- check_each_alternative(S,Type,[C|Ct],[],[],noext).
+check_each_alternative2(S,Type,[C|Ct]) ->
+ check_each_alternative2(S,Type,[C|Ct],[]).
-check_each_alternative(S=#state{abscomppath=Path,recordtopname=TopName},Type,[C|Ct],
- Acc,Extacc,Ext) when is_record(C,'ComponentType') ->
- #'ComponentType'{name=Cname,typespec=Ts,prop=_Prop} = C,
+check_each_alternative2(S=#state{abscomppath=Path,recordtopname=TopName},
+ Type,
+ [C = #'ComponentType'{name=Cname,typespec=Ts}|Ct],
+ Acc) ->
NewAbsCPath =
case Ts#type.def of
#'Externaltypereference'{} -> [];
_ -> [Cname|Path]
end,
- NewState =
- S#state{abscomppath=NewAbsCPath,recordtopname=[Cname|TopName]},
- CheckedTs = check_type(NewState,Type,Ts),
+ CheckedTs = check_type(S#state{abscomppath=NewAbsCPath,
+ recordtopname=[Cname|TopName]},Type,Ts),
NewTags = get_taglist(S,CheckedTs),
+
NewC = C#'ComponentType'{typespec=CheckedTs,tags=NewTags},
- case Ext of
- noext ->
- check_each_alternative(S,Type,Ct,[NewC|Acc],Extacc,Ext);
- ext ->
- check_each_alternative(S,Type,Ct,Acc,[NewC|Extacc],Ext)
- end;
+ check_each_alternative2(S,Type,Ct,[NewC|Acc]);
-check_each_alternative(S,Type,[_|Ct],Acc,Extacc,noext) -> % skip 'EXTENSIONMARK'
- check_each_alternative(S,Type,Ct,Acc,Extacc,ext);
-check_each_alternative(_S,_,[_C|_Ct],_,_,ext) -> % skip 'EXTENSIONMARK'
- throw({error,{asn1,{too_many_extension_marks}}});
-check_each_alternative(_S,_,[],Acc,Extacc,ext) ->
- {lists:reverse(Acc),lists:reverse(Extacc)};
-check_each_alternative(_S,_,[],Acc,_,noext) ->
+check_each_alternative2(S,Type,[OtherMarker|Ct],Acc) ->
+ %% let 'EXTENSIONMARK' and 'ExtensionAdditionGroup' markers pass through as is
+ check_each_alternative2(S,Type,Ct,[OtherMarker|Acc]);
+check_each_alternative2(_S,_,[],Acc) ->
lists:reverse(Acc).
+
%% componentrelation_leadingattr/2 searches the structure for table
%% constraints, if any is found componentrelation_leadingattr/5 is
%% called.
componentrelation_leadingattr(S,CompList) ->
- Cs =
- case CompList of
- {Comp1, EComps, Comp2} ->
- Comp1++EComps++Comp2;
- {Components,EComponents} when is_list(Components) ->
- Components ++ EComponents;
- CompList when is_list(CompList) ->
- CompList
- end,
%% get_simple_table_if_used/2 should find out whether there are any
%% component relation constraints in the entire tree of Cs1 that
@@ -6135,12 +6146,22 @@ componentrelation_leadingattr(S,CompList) ->
%% componentrelation_leadingattr/6. The step when the leading
%% attribute and the syntax tree is modified to support the code
%% generating.
- case get_simple_table_if_used(S,Cs) of
+ case get_simple_table_if_used(S,CompList) of
[] -> {false,CompList};
- STList ->
- componentrelation_leadingattr(S,Cs,Cs,STList,[],[])
+ _ ->
+ componentrelation_leadingattr(S,CompList,CompList,[],[])
end.
+
+%%FIXME expand_ExtAddGroups([C#'ExtensionAdditionGroup'{components=ExtAdds}|T],
+%% CurrPos,PosAcc,CompAcc) ->
+%% expand_ExtAddGroups(T,CurrPos+ L = lenght(ExtAdds),[{CurrPos,L}|PosAcc],ExtAdds++CompAcc);
+%% expand_ExtAddGroups([C|T],CurrPos,PosAcc,CompAcc) ->
+%% expand_ExtAddGroups(T,CurrPos+ 1,PosAcc,[C|CompAcc]);
+%% expand_ExtAddGroups([],_CurrPos,PosAcc,CompAcc) ->
+%% {lists:reverse(PosAcc),lists:reverse(CompAcc)}.
+
+
%% componentrelation_leadingattr/6 when all components are searched
%% the new modified components are returned together with the "leading
%% attribute" information, which later is stored in the tablecinf
@@ -6150,11 +6171,12 @@ componentrelation_leadingattr(S,CompList) ->
%% is used in code generating phase too, to recognice the proper
%% components for "open type" encoding and to propagate the result of
%% the object set lookup when needed.
-componentrelation_leadingattr(_,[],_CompList,_,[],NewCompList) ->
+componentrelation_leadingattr(_,[],_CompList,[],NewCompList) ->
{false,lists:reverse(NewCompList)};
-componentrelation_leadingattr(_,[],_CompList,_,LeadingAttr,NewCompList) ->
+componentrelation_leadingattr(_,[],_CompList,LeadingAttr,NewCompList) ->
{lists:last(LeadingAttr),lists:reverse(NewCompList)}; %send all info in Ts later
-componentrelation_leadingattr(S,[C|Cs],CompList,STList,Acc,CompAcc) ->
+
+componentrelation_leadingattr(S,[C= #'ComponentType'{}|Cs],CompList,Acc,CompAcc) ->
{LAAcc,NewC} =
case catch componentrelation1(S,C#'ComponentType'.typespec,
[C#'ComponentType'.name]) of
@@ -6205,7 +6227,7 @@ componentrelation_leadingattr(S,[C|Cs],CompList,STList,Acc,CompAcc) ->
%% no constraint was found
{[],C}
end,
- componentrelation_leadingattr(S,Cs,CompList,STList,LAAcc++Acc,
+ componentrelation_leadingattr(S,Cs,CompList,LAAcc++Acc,
[NewC|CompAcc]).
object_set_mod_name(_S,ObjSet) when is_atom(ObjSet) ->
@@ -6228,11 +6250,9 @@ object_set_mod_name(S,#'Externaltypereference'{module=M,type=T}) ->
%% generation of the look up functionality in the object set table are
%% returned.
get_simple_table_if_used(S,Cs) ->
- CNames = lists:map(fun(#'ComponentType'{name=Name}) -> Name;
- (_) -> [] %% in case of extension marks
- end,
- Cs),
- RefedSimpleTable=any_component_relation(S,Cs,CNames,[],[]),
+ CNames = [Name||#'ComponentType'{name=Name}<-Cs],
+ JustComponents = [C || C = #'ComponentType'{}<-Cs],
+ RefedSimpleTable=any_component_relation(S,JustComponents,CNames,[],[]),
get_simple_table_info(S,Cs,remove_doubles(RefedSimpleTable)).
remove_doubles(L) ->
@@ -6336,9 +6356,7 @@ simple_table_info(S,Type,_) ->
%% beginning of the search. CNames holds the names of all components
%% of the start level, this info is used if an outermost at-notation
%% is found to check the validity of the at-list.
-any_component_relation(S,[C|Cs],CNames,NamePath,Acc) ->
- CName = C#'ComponentType'.name,
- Type = C#'ComponentType'.typespec,
+any_component_relation(S,[#'ComponentType'{name=CName,typespec=Type}|Cs],CNames,NamePath,Acc) ->
CRelPath =
case constraint_member(componentrelation,Type#type.constraint) of
%% [{componentrelation,_,AtNotation}] ->
@@ -6358,9 +6376,9 @@ any_component_relation(S,[C|Cs],CNames,NamePath,Acc) ->
case {Type#type.inlined,
asn1ct_gen:type(asn1ct_gen:get_inner(Type#type.def))} of
{no,{constructed,bif}} ->
+
{InnerCs,NewNamePath} =
case get_components(Type#type.def) of
- {IC1,_IC2} -> {IC1 ++ IC1,[CName|NamePath]};
T when is_record(T,type) -> {T,NamePath};
IC -> {IC,[CName|NamePath]}
end,
@@ -6384,11 +6402,7 @@ any_component_relation(S,Type,CNames,NamePath,Acc) when is_record(Type,type) ->
case {Type#type.inlined,
asn1ct_gen:type(asn1ct_gen:get_inner(Type#type.def))} of
{no,{constructed,bif}} ->
- InnerCs =
- case get_components(Type#type.def) of
- {IC1,_IC2} -> IC1 ++ IC1;
- IC -> IC
- end,
+ InnerCs = get_components(Type#type.def),
any_component_relation(S,InnerCs,CNames,NamePath,[]);
_ ->
[]
@@ -6456,11 +6470,11 @@ get_components(Def) ->
get_components(any,Def).
get_components(_,#'SEQUENCE'{components=Cs}) ->
- Cs;
+ tuple2complist(Cs);
get_components(_,#'SET'{components=Cs}) ->
- Cs;
+ tuple2complist(Cs);
get_components(_,{'CHOICE',Cs}) ->
- Cs;
+ tuple2complist(Cs);
%do not step in inlined structures
get_components(any,{'SEQUENCE OF',T = #type{def=_Def,inlined=no}}) ->
% get_components(any,Def);
@@ -6471,6 +6485,13 @@ get_components(any,{'SET OF',T = #type{def=_Def,inlined=no}}) ->
get_components(_,_) ->
[].
+tuple2complist({R,E}) ->
+ R ++ E;
+tuple2complist({R1,E,R2}) ->
+ R1 ++ E ++ R2;
+tuple2complist(List) when is_list(List) ->
+ List.
+
get_choice_components(_S,{'CHOICE',Components}) when is_list(Components)->
Components;
get_choice_components(_S,{'CHOICE',{C1,C2}}) when is_list(C1),is_list(C2) ->
@@ -6731,8 +6752,7 @@ get_tableconstraint_info(S,Type,CheckedTs) ->
get_tableconstraint_info(_S,_Type,[],Acc) ->
lists:reverse(Acc);
-get_tableconstraint_info(S,Type,[C|Cs],Acc) ->
- CheckedTs = C#'ComponentType'.typespec,
+get_tableconstraint_info(S,Type,[C=#'ComponentType'{typespec=CheckedTs}|Cs],Acc) ->
AccComp =
case CheckedTs#type.def of
%% ObjectClassFieldType
@@ -6768,7 +6788,9 @@ get_tableconstraint_info(S,Type,[C|Cs],Acc) ->
_ ->
C
end,
- get_tableconstraint_info(S,Type,Cs,[AccComp|Acc]).
+ get_tableconstraint_info(S,Type,Cs,[AccComp|Acc]);
+get_tableconstraint_info(S,Type,[C|Cs],Acc) ->
+ get_tableconstraint_info(S,Type,Cs,[C|Acc]).
get_referenced_fieldname([{_,FirstFieldname}]) ->
{FirstFieldname,[]};
@@ -6850,7 +6872,9 @@ get_taglist(S,Type) when is_record(Type,type) ->
[asn1ct_gen:def_to_tag(Tag)]
end;
get_taglist(S,{'CHOICE',{Rc,Ec}}) ->
- get_taglist(S,{'CHOICE',Rc ++ Ec});
+ get_taglist1(S,Rc ++ Ec);
+get_taglist(S,{'CHOICE',{R1,E,R2}}) ->
+ get_taglist1(S,R1 ++ E ++ R2);
get_taglist(S,{'CHOICE',Components}) ->
get_taglist1(S,Components);
%% ObjectClassFieldType OTP-4390
diff --git a/lib/asn1/src/asn1ct_constructed_ber.erl b/lib/asn1/src/asn1ct_constructed_ber.erl
index 51a241ffbd..77b78dcac7 100644
--- a/lib/asn1/src/asn1ct_constructed_ber.erl
+++ b/lib/asn1/src/asn1ct_constructed_ber.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
-%%
+%%
+%% 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%
%%
%%
@@ -71,13 +71,15 @@ gen_encode_sequence(Erules,Typename,D) when is_record(D,type) ->
ok
end,
- {SeqOrSet,TableConsInfo,CompList} =
+ {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;
@@ -189,7 +191,11 @@ gen_encode_sequence(Erules,Typename,D) when is_record(D,type) ->
gen_decode_sequence(Erules,Typename,D) when is_record(D,type) ->
asn1ct_name:start(),
asn1ct_name:new(tag),
- #'SEQUENCE'{tablecinf=TableConsInfo,components=CList} = D#type.def,
+ #'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};
@@ -369,7 +375,10 @@ gen_decode_set(Erules,Typename,D) when is_record(D,type) ->
asn1ct_name:clear(),
asn1ct_name:new(term),
asn1ct_name:new(tag),
- #'SET'{components=TCompList} = D#type.def,
+ #'SET'{components=TCompList0} = D#type.def,
+
+ %% filter away extensionAdditiongroup markers
+ TCompList = filter_complist(TCompList0),
Ext = extensible(TCompList),
ToOptional = fun(mandatory) ->
'OPTIONAL';
@@ -1473,6 +1482,22 @@ 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 = "%%-------------------------------------------------",
diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl
index 2a1c0ebc6b..df430c4f88 100644
--- a/lib/asn1/src/asn1ct_constructed_per.erl
+++ b/lib/asn1/src/asn1ct_constructed_per.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
-%%
+%%
+%% 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%
%%
%%
@@ -46,13 +46,24 @@ gen_encode_constructed(Erule,Typename,D) when is_record(D,type) ->
asn1ct_name:start(),
asn1ct_name:new(term),
asn1ct_name:new(bytes),
- {CompList,TableConsInfo} =
+ {ExtAddGroup,TmpCompList,TableConsInfo} =
case D#type.def of
- #'SEQUENCE'{tablecinf=TCI,components=CL} ->
- {CL,TCI};
+ #'SEQUENCE'{tablecinf=TCI,components=CL,extaddgroup=ExtAddGroup0} ->
+ {ExtAddGroup0,CL,TCI};
#'SET'{tablecinf=TCI,components=CL} ->
- {CL,TCI}
+ {undefined,CL,TCI}
end,
+
+ CompList = case ExtAddGroup of
+ undefined ->
+ TmpCompList;
+ _ when is_integer(ExtAddGroup) ->
+ %% This is a fake SEQUENCE representing an ExtensionAdditionGroup
+ %% Reset the textual order so we get the right
+ %% index of the components
+ [Comp#'ComponentType'{textual_order=undefined}||
+ Comp<-TmpCompList]
+ end,
case Typename of
['EXTERNAL'] ->
emit({{var,asn1ct_name:next(val)},
@@ -78,7 +89,7 @@ gen_encode_constructed(Erule,Typename,D) when is_record(D,type) ->
",",{var,asn1ct_name:curr(val)},"),",nl})
end,
asn1ct_name:new(val),
- Ext = extensible(CompList),
+ Ext = extensible_enc(CompList),
case Ext of
{ext,_,NumExt} when NumExt > 0 ->
emit(["Extensions = ?RT_PER:fixextensions(",{asis,Ext},
@@ -188,9 +199,10 @@ gen_decode_constructed(Erules,Typename,D) when is_record(D,type) ->
#'SEQUENCE'{tablecinf=TCI,components=CL} ->
{add_textual_order(CL),TCI};
#'SET'{tablecinf=TCI,components=CL} ->
- {add_textual_order(CL),TCI}
+%% {add_textual_order(CL),TCI}
+ {CL,TCI} % the textual order is already taken care of
end,
- Ext = extensible(CompList),
+ Ext = extensible_dec(CompList),
MaybeComma1 = case Ext of
{ext,_Pos,_NumExt} ->
gen_dec_extension_value("Bytes"),
@@ -243,8 +255,9 @@ gen_decode_constructed(Erules,Typename,D) when is_record(D,type) ->
{false,false,false}
end
end,
+ NewCompList = wrap_compList(CompList),
{AccTerm,AccBytes} =
- gen_dec_components_call(Erules,Typename,CompList,MaybeComma2,DecObjInf,Ext,length(Optionals)),
+ gen_dec_components_call(Erules,Typename,NewCompList,MaybeComma2,DecObjInf,Ext,length(Optionals)),
case asn1ct_name:all(term) of
[] -> emit(MaybeComma2); % no components at all
_ -> emit({com,nl})
@@ -284,7 +297,10 @@ gen_decode_constructed(Erules,Typename,D) when is_record(D,type) ->
emit(" {ASN11994Format,");
_ ->
emit(["{{'",RecordName,"'"]),
- mkvlist(textual_order(CompList,asn1ct_name:all(term))),
+ %% CompList is used here because we don't want
+ %% ExtensionAdditionGroups to be wrapped in SEQUENCES when
+ %% we are ordering the fields according to textual order
+ mkvlist(textual_order(to_encoding_order(CompList),asn1ct_name:all(term))),
emit("},")
end,
emit({{var,asn1ct_name:curr(bytes)},"}"}),
@@ -293,17 +309,12 @@ gen_decode_constructed(Erules,Typename,D) when is_record(D,type) ->
textual_order([#'ComponentType'{textual_order=undefined}|_],TermList) ->
TermList;
textual_order(CompList,TermList) when is_list(CompList) ->
- TermTuple = list_to_tuple(TermList), %% ['Term1','Term2',...'TermN']
- %% OrderList is ordered by canonical order of tags
- TmpTuple = TermTuple,
- OrderList = [Ix||#'ComponentType'{textual_order=Ix} <- CompList],
- Fun = fun(X,{Tpl,Ix}) ->
-
- {setelement(X,Tpl,element(Ix,TermTuple)),Ix+1}
- end,
- {Ret,_} = lists:foldl(Fun,{TmpTuple,1},OrderList),
-%% io:format("TermTuple: ~p~nOrderList: ~p~nRet: ~p~n",[TermTuple,OrderList,tuple_to_list(Ret)]),
- tuple_to_list(Ret);
+ OrderList = [Ix||#'ComponentType'{textual_order=Ix} <- CompList],
+ [Term||{_,Term}<-
+ lists:sort(lists:zip(OrderList,
+ lists:sublist(TermList,length(OrderList))))];
+ %% sublist is just because Termlist can sometimes be longer than
+ %% OrderList, which it really shouldn't
textual_order({Root,Ext},TermList) ->
textual_order(Root ++ Ext,TermList);
textual_order({Root1,Ext,Root2},TermList) ->
@@ -379,7 +390,7 @@ emit_opt_or_mand_check(Val,Term) ->
gen_encode_choice(Erule,Typename,D) when is_record(D,type) ->
{'CHOICE',CompList} = D#type.def,
emit({"[",nl}),
- Ext = extensible(CompList),
+ Ext = extensible_enc(CompList),
gen_enc_choice(Erule,Typename,CompList,Ext),
emit({nl,"].",nl}).
@@ -388,7 +399,7 @@ gen_decode_choice(Erules,Typename,D) when is_record(D,type) ->
asn1ct_name:clear(),
asn1ct_name:new(bytes),
{'CHOICE',CompList} = D#type.def,
- Ext = extensible(CompList),
+ Ext = extensible_enc(CompList),
gen_dec_choice(Erules,Typename,CompList,Ext),
emit({".",nl}).
@@ -558,12 +569,32 @@ mkvlist2([H|T]) ->
mkvlist2([]) ->
true.
-extensible(CompList) when is_list(CompList) ->
+
+extensible_dec(CompList) when is_list(CompList) ->
+ noext;
+extensible_dec({RootList,ExtList}) ->
+ {ext,length(RootList)+1,ext_length(ExtList)};
+extensible_dec({Rl1,Ext,Rl2}) ->
+ {ext,length(Rl1)+length(Rl2)+1,ext_length(Ext)}.
+
+extensible_enc(CompList) when is_list(CompList) ->
noext;
-extensible({RootList,ExtList}) ->
- {ext,length(RootList)+1,length(ExtList)};
-extensible({Rl1,Ext,_Rl2}) ->
- {ext,length(Rl1)+1,length(Ext)}.
+extensible_enc({RootList,ExtList}) ->
+ {ext,length(RootList)+1,ext_length(ExtList)};
+extensible_enc({Rl1,Ext,_Rl2}) ->
+ {ext,length(Rl1)+1,ext_length(Ext)}.
+
+ext_length(ExtList) -> ext_length(ExtList,normal,0).
+ext_length([{'ExtensionAdditionGroup',_Num}|T],_,Acc)->
+ ext_length(T,group,Acc);
+ext_length(['ExtensionAdditionGroupEnd'|T],group,Acc) ->
+ ext_length(T,normal,Acc+1);
+ext_length([#'ComponentType'{}|T],State=group,Acc) ->
+ ext_length(T,State,Acc);
+ext_length([#'ComponentType'{}|T],State=normal,Acc) ->
+ ext_length(T,State,Acc+1);
+ext_length([],_,Acc) ->
+ Acc.
gen_dec_extension_value(_) ->
emit({"{Ext,",{next,bytes},"} = ?RT_PER:getext(",{curr,bytes},")"}),
@@ -574,7 +605,11 @@ gen_dec_extension_value(_) ->
%% there are optional components, start with 2 because first element
%% is the record name
-optionals({L1,_Ext,L2}) -> optionals(L1++L2,[],2);
+optionals({L1,Ext,L2}) ->
+ Opt1 = optionals(L1,[],2),
+ ExtComps = length([C||C = #'ComponentType'{}<-Ext]),
+ Opt2 = optionals(L2,[],2+length(L1)+ExtComps),
+ Opt1 ++ Opt2;
optionals({L,_Ext}) -> optionals(L,[],2);
optionals(L) -> optionals(L,[],2).
@@ -617,6 +652,13 @@ get_optionality_pos(TextPos,OptTable) ->
no_num
end.
+to_encoding_order(Cs) when is_list(Cs) ->
+ Cs;
+to_encoding_order(Cs = {_Root,_Ext}) ->
+ Cs;
+to_encoding_order({R1,Ext,R2}) ->
+ {R1++R2,Ext}.
+
add_textual_order(Cs) when is_list(Cs) ->
{NewCs,_} = add_textual_order1(Cs,1),
NewCs;
@@ -629,26 +671,20 @@ add_textual_order({R1,Ext,R2}) ->
{NewExt,Num2} = add_textual_order1(Ext,Num1),
{NewR2,_} = add_textual_order1(R2,Num2),
{NewR1,NewExt,NewR2}.
-add_textual_order1(Cs=[#'ComponentType'{textual_order=Int}|_],I)
- when is_integer(Int) ->
- {Cs,I};
+%%add_textual_order1(Cs=[#'ComponentType'{textual_order=Int}|_],I)
+%% when is_integer(Int) ->
+%% {Cs,I};
add_textual_order1(Cs,NumIn) ->
- lists:mapfoldl(fun(C,Num) ->
+ lists:mapfoldl(fun(C=#'ComponentType'{},Num) ->
{C#'ComponentType'{textual_order=Num},
- Num+1}
+ Num+1};
+ (OtherMarker,Num) ->
+ {OtherMarker,Num}
end,
NumIn,Cs).
gen_enc_components_call(Erule,TopType,{Root1,ExtList,Root2},MaybeComma,DynamicEnc,Ext) ->
- Rpos = gen_enc_components_call1(Erule,TopType,Root1,1,MaybeComma,DynamicEnc,noext),
- case Ext of
- {ext,_,ExtNum} when ExtNum > 0 ->
- emit([nl,
- ",Extensions",nl]);
- _ -> true
- end,
- Rpos2 = gen_enc_components_call1(Erule,TopType,ExtList,Rpos,MaybeComma,DynamicEnc,Ext),
- gen_enc_components_call1(Erule,TopType,Root2,Rpos2,MaybeComma,DynamicEnc,noext);
+ gen_enc_components_call(Erule,TopType,{Root1++Root2,ExtList},MaybeComma,DynamicEnc,Ext);
gen_enc_components_call(Erule,TopType,{CompList,ExtList},MaybeComma,DynamicEnc,Ext) ->
%% The type has extensionmarker
Rpos = gen_enc_components_call1(Erule,TopType,CompList,1,MaybeComma,DynamicEnc,noext),
@@ -659,7 +695,8 @@ gen_enc_components_call(Erule,TopType,{CompList,ExtList},MaybeComma,DynamicEnc,E
_ -> true
end,
%handle extensions
- gen_enc_components_call1(Erule,TopType,ExtList,Rpos,MaybeComma,DynamicEnc,Ext);
+ NewExtList = wrap_extensionAdditionGroups(ExtList),
+ gen_enc_components_call1(Erule,TopType,NewExtList,Rpos,MaybeComma,DynamicEnc,Ext);
gen_enc_components_call(Erule,TopType, CompList, MaybeComma, DynamicEnc, Ext) ->
%% The type has no extensionmarker
gen_enc_components_call1(Erule,TopType,CompList,1,MaybeComma,DynamicEnc,Ext).
@@ -719,6 +756,26 @@ gen_enc_component_default(Erule,TopType,Cname,Type,Pos,DynamicEnc,Ext,DefaultVal
NextElement = asn1ct_gen:mk_var(asn1ct_name:curr(tmpval)),
gen_enc_line(Erule,TopType,Cname,Type,NextElement, Pos,DynamicEnc,Ext),
emit({nl,"end"}).
+
+gen_enc_component_optional(Erule,TopType,Cname,
+ Type=#type{def=#'SEQUENCE'{
+ extaddgroup=Number,
+ components=ExtGroupCompList}},
+ Pos,DynamicEnc,Ext) when is_integer(Number) ->
+ emit({nl,"begin",nl}),
+
+ asn1ct_name:new(tmpval),
+ ExtAddGroupTypeName = asn1ct_gen:list2name([Cname|TopType]),
+ emit({{curr,tmpval}," = {'",ExtAddGroupTypeName,"', "}),
+ ExtNames = [ExtName||#'ComponentType'{name=ExtName}<-ExtGroupCompList],
+ Elements = make_elements(Pos+1,"Val1",ExtNames),
+ emit({Elements,"},"}),
+ InnerType = asn1ct_gen:get_inner(Type#type.def),
+ emit({nl,"%% attribute number ",Pos," with type ",
+ InnerType,nl}),
+ NextElement = asn1ct_gen:mk_var(asn1ct_name:curr(tmpval)),
+ 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,"Val1",Cname),
emit({"case ",Element," of",nl}),
@@ -834,29 +891,7 @@ gen_enc_line(Erule,TopType,Cname,Type,Element, _Pos,DynamicEnc,Ext) ->
_ -> true
end.
gen_dec_components_call(Erule,TopType,{Root1,ExtList,Root2},MaybeComma,DecInfObj,Ext,NumberOfOptionals) ->
- %% The type has extensionmarker
- OptTable = create_optionality_table(Root1 ++ Root2),
- {Rpos,AccTerm,AccBytes} =
- gen_dec_components_call1(Erule,TopType, Root1, 1, OptTable,
- MaybeComma,DecInfObj, noext,[],[],
- NumberOfOptionals),
- emit([",",nl,"{Extensions,",{next,bytes},"} = "]),
- emit(["?RT_PER:getextension(Ext,",{curr,bytes},"),",nl]),
- asn1ct_name:new(bytes),
- {Epos,AccTermE,AccBytesE} =
- gen_dec_components_call1(Erule,TopType,ExtList,Rpos, OptTable, "",
- DecInfObj,Ext,[],[],NumberOfOptionals),
- case ExtList of
- [] -> true;
- _ -> emit([",",nl])
- end,
- emit([{next,bytes},"= ?RT_PER:skipextensions(",{curr,bytes},",",
- length(ExtList)+1,",Extensions),",nl]),
- asn1ct_name:new(bytes),
- {_RPos2,AccTerm2,AccBytes2} =
- gen_dec_components_call1(Erule,TopType,Root2,Epos,OptTable,
- "",DecInfObj,noext,[],[],NumberOfOptionals),
- {AccTerm++AccTermE++AccTerm2,AccBytes++AccBytesE++AccBytes2};
+ gen_dec_components_call(Erule,TopType,{Root1++Root2,ExtList},MaybeComma,DecInfObj,Ext,NumberOfOptionals);
gen_dec_components_call(Erule,TopType,{CompList,ExtList},MaybeComma,
DecInfObj,Ext,NumberOfOptionals) ->
%% The type has extensionmarker
@@ -868,8 +903,9 @@ gen_dec_components_call(Erule,TopType,{CompList,ExtList},MaybeComma,
emit([",",nl,"{Extensions,",{next,bytes},"} = "]),
emit(["?RT_PER:getextension(Ext,",{curr,bytes},"),",nl]),
asn1ct_name:new(bytes),
+ NewExtList = wrap_extensionAdditionGroups(ExtList),
{_Epos,AccTermE,AccBytesE} =
- gen_dec_components_call1(Erule,TopType,ExtList,Rpos, OptTable,
+ gen_dec_components_call1(Erule,TopType,NewExtList,Rpos, OptTable,
"",DecInfObj,Ext,[],[],NumberOfOptionals),
case ExtList of
[] -> true;
@@ -942,8 +978,18 @@ gen_dec_components_call1(Erule,TopType,
asn1ct_name:new(tmpterm),
emit({"{",{curr,tmpterm},", ",{next,bytes},"} = "});
_ ->
- asn1ct_name:new(term),
- emit({"{",{curr,term},",",{next,bytes},"} = "})
+ case Type of
+ #type{def=#'SEQUENCE'{
+ extaddgroup=Number1,
+ components=ExtGroupCompList1}} when is_integer(Number1)->
+ emit({"{{_,"}),
+ emit_extaddgroupTerms(term,ExtGroupCompList1),
+ emit({"}"});
+ _ ->
+ asn1ct_name:new(term),
+ emit({"{",{curr,term}})
+ end,
+ emit({",",{next,bytes},"} = "})
end,
case {Ext,Prop,is_optimized(Erule)} of
@@ -967,11 +1013,24 @@ gen_dec_components_call1(Erule,TopType,
{noext,mandatory} -> true; % generate nothing
{noext,_} ->
emit([";",nl,"0 ->"]),
- gen_dec_component_no_val(TopType,Cname,Type,Prop,Tpos,Ext),
+ emit(["{"]),
+ gen_dec_component_no_val(Ext,Prop),
+ emit({",",{curr,bytes},"}",nl}),
emit([nl,"end"]);
_ ->
emit([";",nl,"_ ->",nl]),
- gen_dec_component_no_val(TopType,Cname,Type,Prop,Tpos,Ext),
+ emit(["{"]),
+ case Type of
+ #type{def=#'SEQUENCE'{
+ extaddgroup=Number2,
+ components=ExtGroupCompList2}} when is_integer(Number2)->
+ emit({"{extAddGroup,"}),
+ gen_dec_extaddGroup_no_val(Ext,ExtGroupCompList2),
+ emit({"}"});
+ _ ->
+ gen_dec_component_no_val(Ext,Prop)
+ end,
+ emit({",",{curr,bytes},"}",nl}),
emit([nl,"end"])
end,
asn1ct_name:new(bytes),
@@ -988,13 +1047,22 @@ gen_dec_components_call1(Erule,TopType,
gen_dec_components_call1(_,_TopType,[],Pos,_OptTable,_,_,_,AccTerm,AccBytes,_NumberOfOptionals) ->
{Pos,AccTerm,AccBytes}.
-
-gen_dec_component_no_val(_,_,_,{'DEFAULT',DefVal},_,_) ->
- emit(["{",{asis,DefVal},",",{curr,bytes},"}",nl]);
-gen_dec_component_no_val(_,_,_,'OPTIONAL',_,_) ->
- emit({"{asn1_NOVALUE,",{curr,bytes},"}",nl});
-gen_dec_component_no_val(_,_,_,mandatory,_,{ext,_,_}) ->
- emit({"{asn1_NOVALUE,",{curr,bytes},"}",nl}).
+gen_dec_extaddGroup_no_val(Ext,[#'ComponentType'{prop=Prop}])->
+ gen_dec_component_no_val(Ext,Prop),
+ ok;
+gen_dec_extaddGroup_no_val(Ext,[#'ComponentType'{prop=Prop}|Rest])->
+ gen_dec_component_no_val(Ext,Prop),
+ emit({","}),
+ gen_dec_extaddGroup_no_val(Ext,Rest);
+gen_dec_extaddGroup_no_val(_, []) ->
+ ok.
+
+gen_dec_component_no_val(_,{'DEFAULT',DefVal}) ->
+ emit([{asis,DefVal}]);
+gen_dec_component_no_val(_,'OPTIONAL') ->
+ emit({"asn1_NOVALUE"});
+gen_dec_component_no_val({ext,_,_},mandatory) ->
+ emit({"asn1_NOVALUE"}).
gen_dec_line(Erule,TopType,Cname,Type,Pos,DecInfObj,Ext,Prop) ->
@@ -1192,6 +1260,14 @@ gen_enc_choice_tag({C1,C2},_,_) ->
N2 = get_name_list(C2),
emit(["?RT_PER:set_choice(element(1,Val),",
{asis,{N1,N2}},", ",{asis,{length(N1),length(N2)}},")"]);
+
+gen_enc_choice_tag({C1,C2,C3},_,_) ->
+ N1 = get_name_list(C1),
+ N2 = get_name_list(C2),
+ N3 = get_name_list(C3),
+ Root = N1 ++ N3,
+ emit(["?RT_PER:set_choice(element(1,Val),",
+ {asis,{Root,N2}},", ",{asis,{length(Root),length(N2)}},")"]);
gen_enc_choice_tag(C,_,_) ->
N = get_name_list(C),
emit(["?RT_PER:set_choice(element(1,Val),",
@@ -1208,6 +1284,8 @@ get_name_list([], Acc) ->
gen_enc_choice2(Erule,TopType, {L1,L2}, Ext) ->
gen_enc_choice2(Erule,TopType, L1 ++ L2, 0, Ext);
+gen_enc_choice2(Erule,TopType, {L1,L2,L3}, Ext) ->
+ gen_enc_choice2(Erule,TopType, L1 ++ L3 ++ L2, 0, Ext);
gen_enc_choice2(Erule,TopType, L, Ext) ->
gen_enc_choice2(Erule,TopType, L, 0, Ext).
@@ -1279,6 +1357,9 @@ gen_dec_choice1(Erule,TopType,CompList,noext) ->
gen_dec_choice1(Erule,TopType,{RootList,ExtList},Ext) ->
NewList = RootList ++ ExtList,
gen_dec_choice1(Erule,TopType, NewList, Ext);
+gen_dec_choice1(Erule,TopType,{RootList,ExtList,RootList2},Ext) ->
+ NewList = RootList ++ RootList2 ++ ExtList,
+ gen_dec_choice1(Erule,TopType, NewList, Ext);
gen_dec_choice1(Erule,TopType,CompList,{ext,ExtPos,ExtNum}) ->
emit({"{Choice,",{curr,bytes},
"} = ?RT_PER:getchoice(",{prev,bytes},",",
@@ -1347,6 +1428,18 @@ gen_encode_prim_wrapper(CtgenMod,Erule,Cont,DoTag,Value) ->
CtgenMod:gen_encode_prim(Erule,Cont,DoTag,Value).
% erase(component_type).
+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+1,Val,[],[Element|Acc]);
+make_elements(I,Val,[ExtCname|Rest],Acc)->
+ Element = make_element(I,Val,ExtCname),
+ 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 ->
@@ -1355,6 +1448,55 @@ make_element(I,Val,Cname) ->
io_lib:format("element(~w,~s)",[I,Val])
end.
+emit_extaddgroupTerms(VarSeries,[_]) ->
+ asn1ct_name:new(VarSeries),
+ emit({curr,VarSeries}),
+ ok;
+emit_extaddgroupTerms(VarSeries,[_|Rest]) ->
+ asn1ct_name:new(VarSeries),
+ emit({{curr,VarSeries},","}),
+ emit_extaddgroupTerms(VarSeries,Rest);
+emit_extaddgroupTerms(_,[]) ->
+ ok.
+wrap_compList({Root1,Ext,Root2}) ->
+ {Root1,wrap_extensionAdditionGroups(Ext),Root2};
+wrap_compList({Root1,Ext}) ->
+ {Root1,wrap_extensionAdditionGroups(Ext)};
+wrap_compList(CompList) ->
+ CompList.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Will convert all componentTypes following 'ExtensionAdditionGroup'
+%% up to the matching 'ExtensionAdditionGroupEnd' into one componentType
+%% of type SEQUENCE with the componentTypes as components
+%%
+wrap_extensionAdditionGroups(ExtCompList) ->
+ wrap_extensionAdditionGroups(ExtCompList,[],0).
+
+wrap_extensionAdditionGroups([{'ExtensionAdditionGroup',_Number}|Rest],Acc,0) ->
+ {ExtGroupCompList=
+ [#'ComponentType'{textual_order=TextPos}|_],
+ ['ExtensionAdditionGroupEnd'|Rest2]} =
+ lists:splitwith(fun(#'ComponentType'{}) -> true;
+ (_) -> false
+ end,
+ Rest),
+ wrap_extensionAdditionGroups(Rest2,
+ [#'ComponentType'{
+ name='ExtAddGroup', % FIXME: handles ony one ExtAddGroup
+ typespec=#type{def=#'SEQUENCE'{
+ extaddgroup=1,% FIXME: handles only one
+ components=ExtGroupCompList}},
+ textual_order = TextPos,
+ prop='OPTIONAL'}|Acc],length(ExtGroupCompList)-1);
+wrap_extensionAdditionGroups([H=#'ComponentType'{textual_order=Tord}|T],Acc,ExtAddGroupDiff) when is_integer(Tord) ->
+ wrap_extensionAdditionGroups(T,[H#'ComponentType'{
+ textual_order=Tord - ExtAddGroupDiff}|Acc],ExtAddGroupDiff);
+wrap_extensionAdditionGroups([H|T],Acc,ExtAddGroupDiff) ->
+ wrap_extensionAdditionGroups(T,[H|Acc],ExtAddGroupDiff);
+wrap_extensionAdditionGroups([],Acc,_) ->
+ lists:reverse(Acc).
+
+
tuple_notation_allowed() ->
Options = get(encoding_options),
not (lists:member(optimize,Options) orelse lists:member(uper_bin,Options)).
diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl
index eab5fb4a2a..6b511a66da 100644
--- a/lib/asn1/src/asn1ct_gen.erl
+++ b/lib/asn1/src/asn1ct_gen.erl
@@ -536,14 +536,34 @@ gen_part_decode_funcs({primitive,bif},_TypeName,
gen_part_decode_funcs(WhatKind,_TypeName,{_,Directive,_,_}) ->
throw({error,{asn1,{"Not implemented yet",WhatKind," partial incomplete directive:",Directive}}}).
+
+extaddgroup2sequence(ExtList) ->
+ extaddgroup2sequence(ExtList,[]).
+
+extaddgroup2sequence([{'ExtensionAdditionGroup',Number0}|T],Acc) ->
+ Number = case Number0 of undefined -> 1; _ -> Number0 end,
+ {ExtGroupComps,['ExtensionAdditionGroupEnd'|T2]} =
+ lists:splitwith(fun(Elem) -> is_record(Elem,'ComponentType') end,T),
+ extaddgroup2sequence(T2,[#'ComponentType'{
+ name='ExtAddGroup',
+ typespec=#type{def=#'SEQUENCE'{
+ extaddgroup=Number,
+ components=ExtGroupComps}},
+ prop='OPTIONAL'}|Acc]);
+extaddgroup2sequence([C|T],Acc) ->
+ extaddgroup2sequence(T,[C|Acc]);
+extaddgroup2sequence([],Acc) ->
+ lists:reverse(Acc).
+
+
gen_types(Erules,Tname,{RootL1,ExtList,RootL2})
when is_list(RootL1), is_list(RootL2) ->
gen_types(Erules,Tname,RootL1),
- gen_types(Erules,Tname,ExtList),
+ gen_types(Erules,Tname,extaddgroup2sequence(ExtList)),
gen_types(Erules,Tname,RootL2);
gen_types(Erules,Tname,{RootList,ExtList}) when is_list(RootList) ->
gen_types(Erules,Tname,RootList),
- gen_types(Erules,Tname,ExtList);
+ gen_types(Erules,Tname,extaddgroup2sequence(ExtList));
gen_types(Erules,Tname,[{'EXTENSIONMARK',_,_}|Rest]) ->
gen_types(Erules,Tname,Rest);
gen_types(Erules,Tname,[ComponentType|Rest]) ->
@@ -1543,19 +1563,18 @@ gen_record2(Name,SeqOrSet,Comps) ->
gen_record2(_Name,_SeqOrSet,[],_Com,_Extension) ->
true;
-gen_record2(Name,SeqOrSet,[{'EXTENSIONMARK',_,_}|T],Com,Extension) ->
- gen_record2(Name,SeqOrSet,T,Com,Extension);
-gen_record2(_Name,_SeqOrSet,[H],Com,Extension) ->
- #'ComponentType'{name=Cname} = H,
+gen_record2(_Name,_SeqOrSet,[H = #'ComponentType'{name=Cname}],Com,Extension) ->
emit(Com),
emit({asis,Cname}),
gen_record_default(H, Extension);
-gen_record2(Name,SeqOrSet,[H|T],Com, Extension) ->
- #'ComponentType'{name=Cname} = H,
+gen_record2(Name,SeqOrSet,[H = #'ComponentType'{name=Cname}|T],Com, Extension) ->
emit(Com),
emit({asis,Cname}),
gen_record_default(H, Extension),
- gen_record2(Name,SeqOrSet,T,", ", Extension).
+ gen_record2(Name,SeqOrSet,T,", ", Extension);
+gen_record2(Name,SeqOrSet,[_|T],Com,Extension) ->
+ %% skip EXTENSIONMARK, ExtensionAdditionGroup and other markers
+ gen_record2(Name,SeqOrSet,T,Com,Extension).
gen_record_default(#'ComponentType'{prop='OPTIONAL'}, _)->
emit(" = asn1_NOVALUE");
diff --git a/lib/asn1/src/asn1ct_parser2.erl b/lib/asn1/src/asn1ct_parser2.erl
index 46d7ad6fdb..224a535e87 100644
--- a/lib/asn1/src/asn1ct_parser2.erl
+++ b/lib/asn1/src/asn1ct_parser2.erl
@@ -417,10 +417,22 @@ parse_BuiltinType([{'CHARACTER',_},{'STRING',_}|Rest]) ->
{#type{def='CHARACTER STRING'},Rest};
parse_BuiltinType([{'CHOICE',_},{'{',_}|Rest]) ->
- {AlternativeTypeLists,Rest2} = parse_AlternativeTypeLists(Rest,get(extensiondefault)),
+ {AlternativeTypeLists,Rest2} = parse_AlternativeTypeLists(Rest),
+ AlternativeTypeLists1 =
+ lists:filter(fun(#'ExtensionAdditionGroup'{}) -> false;
+ ('ExtensionAdditionGroupEnd') -> false;
+ (_) -> true
+ end,AlternativeTypeLists),
case Rest2 of
[{'}',_}|Rest3] ->
- {#type{def={'CHOICE',AlternativeTypeLists}},Rest3};
+ AlternativeTypeLists2 =
+ case {[Ext||Ext = #'EXTENSIONMARK'{} <- AlternativeTypeLists1],
+ get(extensiondefault)} of
+ {[],'IMPLIED'} -> AlternativeTypeLists1 ++ [#'EXTENSIONMARK'{}];
+ _ -> AlternativeTypeLists1
+ end,
+
+ {#type{def={'CHOICE',AlternativeTypeLists2}},Rest3};
_ ->
throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module),
[got,get_token(hd(Rest2)),expected,'}']}})
@@ -479,16 +491,19 @@ parse_BuiltinType([{'REAL',_}|Rest]) ->
{#type{def='REAL'},Rest};
parse_BuiltinType([{'RELATIVE-OID',_}|Rest]) ->
{#type{def='RELATIVE-OID'},Rest};
-parse_BuiltinType([{'SEQUENCE',_},{'{',_},{'...',Line},{'}',_}|Rest]) ->
- {#type{def=#'SEQUENCE'{components=[{'EXTENSIONMARK',Line,undefined}]}},
+parse_BuiltinType([{'SEQUENCE',_},{'{',_},{'}',_}|Rest]) ->
+ {#type{def=#'SEQUENCE'{components=[]}},
Rest};
+parse_BuiltinType([{'SEQUENCE',_},{'{',_},{'...',Line},{'}',_}|Rest]) ->
+ {#type{def=#'SEQUENCE'{components=[#'EXTENSIONMARK'{pos = Line}]}},Rest};
parse_BuiltinType([{'SEQUENCE',_},{'{',_},{'...',Line},{'!',_}|Rest]) ->
{ExceptionIdentification,Rest2} = parse_ExceptionIdentification(Rest),
case Rest2 of
[{'}',_}|Rest3] ->
- {#type{def=#'SEQUENCE'{components=[{'EXTENSIONMARK',
- Line,
- ExceptionIdentification}]}},
+ {#type{def=#'SEQUENCE'{
+ components=[#'EXTENSIONMARK'{
+ pos = Line,
+ val = ExceptionIdentification}]}},
Rest3};
_ ->
{ComponentTypeLists,Rest3}=
@@ -537,13 +552,14 @@ parse_BuiltinType([{'SEQUENCE',_},{'OF',_}|Rest]) ->
parse_BuiltinType([{'SET',_},{'{',_},{'...',Line},{'}',_}|Rest]) ->
- {#type{def=#'SET'{components=[{'EXTENSIONMARK',Line,undefined}]}},Rest};
+ {#type{def=#'SET'{components=[#'EXTENSIONMARK'{pos = Line}]}},Rest};
parse_BuiltinType([{'SET',_},{'{',_},{'...',Line},{'!',_}|Rest]) ->
{ExceptionIdentification,Rest2} = parse_ExceptionIdentification(Rest),
case Rest2 of
[{'}',_}|Rest3] ->
{#type{def=#'SET'{components=
- [{'EXTENSIONMARK',Line,ExceptionIdentification}]}},
+ [#'EXTENSIONMARK'{pos = Line,
+ val = ExceptionIdentification}]}},
Rest3};
_ ->
throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module),
@@ -2323,101 +2339,197 @@ to_set(V) when is_list(V) ->
to_set(V) ->
ordsets:from_list([V]).
+parse_AlternativeTypeLists(Tokens) ->
+ parse_AlternativeTypeLists(Tokens,[]).
-parse_AlternativeTypeLists(Tokens,ExtensionDefault) ->
- {AltTypeList,Rest1} = parse_AlternativeTypeList(Tokens),
- {ExtensionAndException,Rest2} =
- case Rest1 of
- [{',',_},{'...',L1},{'!',_}|Rest12] ->
- {_,Rest13} = parse_ExceptionIdentification(Rest12),
- %% Exception info is currently thrown away
- {[#'EXTENSIONMARK'{pos=L1}],Rest13};
- [{',',_},{'...',L1}|Rest12] ->
- {[#'EXTENSIONMARK'{pos=L1}],Rest12};
- _ ->
- {[],Rest1}
- end,
- {AltTypeList2,Rest5} =
- case ExtensionAndException of
- [] ->
- {AltTypeList,Rest2};
- _ ->
- {ExtensionAddition,Rest3} =
- case Rest2 of
- [{',',_}|Rest23] ->
- parse_ExtensionAdditionAlternativeList(Rest23);
- _ ->
- {[],Rest2}
- end,
- {OptionalExtensionMarker,Rest4} =
- case Rest3 of
- [{',',_},{'...',L3}|Rest31] ->
- {[#'EXTENSIONMARK'{pos=L3}],Rest31};
- _ ->
- {[],Rest3}
- end,
- {AltTypeList ++ ExtensionAndException ++
- ExtensionAddition ++ OptionalExtensionMarker, Rest4}
- end,
- AltTypeList3 =
- case [X || X=#'EXTENSIONMARK'{} <- AltTypeList2] of
- [] when ExtensionDefault == 'IMPLIED' ->
- AltTypeList2 ++ [#'EXTENSIONMARK'{}];
- _ ->
- AltTypeList2
- end,
- {AltTypeList3,Rest5}.
-
+parse_AlternativeTypeLists(Tokens = [{identifier,_,_}|_Rest0],Clist) ->
+ {CompList,Rest1} = parse_AlternativeTypeList(Tokens,[]),
+ parse_AlternativeTypeLists(Rest1,Clist++CompList);
+parse_AlternativeTypeLists([{'...',L1},{'!',_}|Rest02],Clist0) ->
+ {_,Rest03} = parse_ExceptionIdentification(Rest02),
+ %% Exception info is currently thrown away
+ parse_AlternativeTypeLists2(Rest03,Clist0++[#'EXTENSIONMARK'{pos=L1}]);
+parse_AlternativeTypeLists([{',',L1},{'...',_},{'!',_}|Rest02],Clist0) when Clist0 =/= []->
+ {_,Rest03} = parse_ExceptionIdentification(Rest02),
+ %% Exception info is currently thrown away
+ parse_AlternativeTypeLists2(Rest03,Clist0++[#'EXTENSIONMARK'{pos=L1}]);
+
+parse_AlternativeTypeLists([{',',_},{'...',L1}|Rest02],Clist0) when Clist0 =/= []->
+ parse_AlternativeTypeLists2(Rest02,Clist0++[#'EXTENSIONMARK'{pos=L1}]);
+parse_AlternativeTypeLists([{'...',L1}|Rest02],Clist0) ->
+ parse_AlternativeTypeLists2(Rest02,Clist0++[#'EXTENSIONMARK'{pos=L1}]);
+parse_AlternativeTypeLists(Tokens = [{'}',_L1}|_Rest02],Clist0) ->
+ {Clist0,Tokens}.
+
+parse_AlternativeTypeLists2(Tokens,Clist) ->
+ {ExtAdd,Rest} = parse_ExtensionAdditionAlternatives(Tokens,Clist),
+ {Clist2,Rest2} = parse_OptionalExtensionMarker(Rest,lists:flatten(ExtAdd)),
+ case Rest2 of
+ [{',',_}|Rest3] ->
+ {CompList,Rest4} = parse_AlternativeTypeList(Rest3,[]),
+ {Clist2 ++ CompList,Rest4};
+ _ ->
+ {Clist2,Rest2}
+ end.
-parse_AlternativeTypeList(Tokens) ->
- parse_AlternativeTypeList(Tokens,[]).
-parse_AlternativeTypeList(Tokens,Acc) ->
- {NamedType,Rest} = parse_NamedType(Tokens),
+
+parse_AlternativeTypeList([{',',_},Id = {identifier,_,_}|Rest],Acc) when Acc =/= [] ->
+ {AlternativeType,Rest2} = parse_NamedType([Id|Rest]),
+ parse_AlternativeTypeList(Rest2,[AlternativeType|Acc]);
+parse_AlternativeTypeList(Tokens = [{'}',_}|_],Acc) ->
+ {lists:reverse(Acc),Tokens};
+parse_AlternativeTypeList(Tokens = [{']',_},{']',_}|_],Acc) ->
+ {lists:reverse(Acc),Tokens};
+parse_AlternativeTypeList(Tokens = [{',',_},{'...',_}|_],Acc) ->
+ {lists:reverse(Acc),Tokens};
+parse_AlternativeTypeList(Tokens,[]) ->
+ {AlternativeType,Rest} = parse_NamedType(Tokens),
+ parse_AlternativeTypeList(Rest,[AlternativeType]);
+parse_AlternativeTypeList(Tokens,_) ->
+ throw({asn1_error,
+ {get_line(hd(Tokens)),get(asn1_module),
+ [got,[get_token(hd(Tokens)),get_token(hd(tl(Tokens)))],
+ expected,['}',', identifier']]}}).
+
+parse_ExtensionAdditionAlternatives(Tokens =[{',',_}|_],Clist) ->
+ {ExtAddList,Rest2} = parse_ExtensionAdditionAlternativesList(Tokens,[]),
+ {Clist++lists:flatten(ExtAddList),Rest2};
+parse_ExtensionAdditionAlternatives(Tokens,Clist) ->
+ %% Empty
+ {Clist,Tokens}.
+
+parse_ExtensionAdditionAlternativesList([{',',_},Id = {identifier,_,_}|Rest],Acc) ->
+ {AlternativeType,Rest2} = parse_NamedType([Id|Rest]),
+ parse_ExtensionAdditionAlternativesList(Rest2,[AlternativeType|Acc]);
+parse_ExtensionAdditionAlternativesList([{',',_},C1 = {'[',_},C2 = {'[',_}|Rest],Acc) ->
+ {ExtAddGroup,Rest2} = parse_ExtensionAdditionAlternativesGroup([C1,C2|Rest],[]),
+ parse_ExtensionAdditionAlternativesList(Rest2,[ExtAddGroup|Acc]);
+parse_ExtensionAdditionAlternativesList(Tokens = [{'}',_}|_],Acc) ->
+ {lists:reverse(Acc),Tokens};
+parse_ExtensionAdditionAlternativesList(Tokens = [{',',_},{'...',_}|_],Acc) ->
+ {lists:reverse(Acc),Tokens};
+parse_ExtensionAdditionAlternativesList(Tokens,_) ->
+ throw({asn1_error,
+ {get_line(hd(Tokens)),get(asn1_module),
+ [got,[get_token(hd(Tokens)),get_token(hd(tl(Tokens)))],
+ expected,['}',', identifier']]}}).
+
+
+parse_ExtensionAdditionAlternativesGroup([ {'[',_},{'[',_},_VsnNr = {number,_,Num},{':',_}|Rest],[]) ->
+ parse_ExtensionAdditionAlternativesGroup2(Rest,Num);
+parse_ExtensionAdditionAlternativesGroup([ {'[',_},{'[',_}|Rest],[]) ->
+ parse_ExtensionAdditionAlternativesGroup2(Rest,undefined);
+parse_ExtensionAdditionAlternativesGroup(Tokens,_) ->
+ throw({asn1_error,
+ {get_line(hd(Tokens)),get(asn1_module),
+ [got,[get_token(hd(Tokens)),get_token(hd(tl(Tokens)))],
+ expected,['[[']]}}).
+
+
+parse_ExtensionAdditionAlternativesGroup2(Tokens,Num) ->
+ {CompTypeList,Rest} = parse_AlternativeTypeList(Tokens,[]),
case Rest of
- [{',',_},Id = {identifier,_,_}|Rest2] ->
- parse_AlternativeTypeList([Id|Rest2],[NamedType|Acc]);
+ [{']',_},{']',_}|Rest2] ->
+ {[{'ExtensionAdditionGroup',Num}|CompTypeList] ++
+ ['ExtensionAdditionGroupEnd'],Rest2};
_ ->
- {lists:reverse([NamedType|Acc]),Rest}
- end.
-
+ throw({asn1_error,{get_line(hd(Rest)),get(asn1_module),
+ [got,get_token(hd(Rest)),expected,[']]']]}})
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% parse_AlternativeTypeLists(Tokens,ExtensionDefault) ->
+%% {AltTypeList,Rest1} = parse_AlternativeTypeList(Tokens),
+%% {ExtensionAndException,Rest2} =
+%% case Rest1 of
+%% [{',',_},{'...',L1},{'!',_}|Rest12] ->
+%% {_,Rest13} = parse_ExceptionIdentification(Rest12),
+%% %% Exception info is currently thrown away
+%% {[#'EXTENSIONMARK'{pos=L1}],Rest13};
+%% [{',',_},{'...',L1}|Rest12] ->
+%% {[#'EXTENSIONMARK'{pos=L1}],Rest12};
+%% _ ->
+%% {[],Rest1}
+%% end,
+%% {AltTypeList2,Rest5} =
+%% case ExtensionAndException of
+%% [] ->
+%% {AltTypeList,Rest2};
+%% _ ->
+%% {ExtensionAddition,Rest3} =
+%% case Rest2 of
+%% [{',',_}|Rest23] ->
+%% parse_ExtensionAdditionAlternativeList(Rest23);
+%% _ ->
+%% {[],Rest2}
+%% end,
+%% {OptionalExtensionMarker,Rest4} =
+%% case Rest3 of
+%% [{',',_},{'...',L3}|Rest31] ->
+%% {[#'EXTENSIONMARK'{pos=L3}],Rest31};
+%% _ ->
+%% {[],Rest3}
+%% end,
+%% {AltTypeList ++ ExtensionAndException ++
+%% ExtensionAddition ++ OptionalExtensionMarker, Rest4}
+%% end,
+%% AltTypeList3 =
+%% case [X || X=#'EXTENSIONMARK'{} <- AltTypeList2] of
+%% [] when ExtensionDefault == 'IMPLIED' ->
+%% AltTypeList2 ++ [#'EXTENSIONMARK'{}];
+%% _ ->
+%% AltTypeList2
+%% end,
+%% {AltTypeList3,Rest5}.
-parse_ExtensionAdditionAlternativeList(Tokens) ->
- parse_ExtensionAdditionAlternativeList(Tokens,[]).
+%% parse_AlternativeTypeList(Tokens) ->
+%% parse_AlternativeTypeList(Tokens,[]).
+
+%% parse_AlternativeTypeList(Tokens,Acc) ->
+%% {NamedType,Rest} = parse_NamedType(Tokens),
+%% case Rest of
+%% [{',',_},Id = {identifier,_,_}|Rest2] ->
+%% parse_AlternativeTypeList([Id|Rest2],[NamedType|Acc]);
+%% _ ->
+%% {lists:reverse([NamedType|Acc]),Rest}
+%% end.
+
-parse_ExtensionAdditionAlternativeList(Tokens,Acc) ->
- {Element,Rest0} =
- case Tokens of
- [{identifier,_,_}|_Rest] ->
- parse_NamedType(Tokens);
- [{'[',_},{'[',_}|_] ->
- parse_ExtensionAdditionAlternatives(Tokens)
- end,
- case Rest0 of
- [{',',_}|Rest01] ->
- parse_ExtensionAdditionAlternativeList(Rest01,[Element|Acc]);
- _ ->
- {lists:reverse([Element|Acc]),Rest0}
- end.
-parse_ExtensionAdditionAlternatives([{'[',_},{'[',_}|Rest]) ->
- parse_ExtensionAdditionAlternatives(Rest,[]);
-parse_ExtensionAdditionAlternatives(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,'[[']}}).
+%% parse_ExtensionAdditionAlternativeList(Tokens) ->
+%% parse_ExtensionAdditionAlternativeList(Tokens,[]).
+
+%% parse_ExtensionAdditionAlternativeList([{'[[',_}|Rest],Acc) ->
+%% parse_ExtensionAdditionAlternativeList(Rest,Acc);
+%% parse_ExtensionAdditionAlternativeList(Tokens = [{identifier,_,_}|_Rest],Acc) ->
+%% {Element,Rest0} = parse_NamedType(Tokens);
+%% case Rest0 of
+%% [{',',_}|Rest01] ->
+%% parse_ExtensionAdditionAlternativeList(Rest01,[Element|Acc]);
+%% _ ->
+%% {lists:reverse([Element|Acc]),Rest0}
+%% end.
-parse_ExtensionAdditionAlternatives([Id = {identifier,_,_}|Rest],Acc) ->
- {NamedType, Rest2} = parse_NamedType([Id|Rest]),
- case Rest2 of
- [{',',_}|Rest21] ->
- parse_ExtensionAdditionAlternatives(Rest21,[NamedType|Acc]);
- [{']',_},{']',_}|Rest21] ->
- {lists:reverse(Acc),Rest21};
- _ ->
- throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module),
- [got,get_token(hd(Rest2)),expected,[',',']]']]}})
- end.
+%% parse_ExtensionAdditionAlternatives([{'[[',_}|Rest]) ->
+%% parse_ExtensionAdditionAlternatives(Rest,[]);
+%% parse_ExtensionAdditionAlternatives(Tokens) ->
+%% throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
+%% [got,get_token(hd(Tokens)),expected,'[[']}}).
+
+%% parse_ExtensionAdditionAlternatives([Id = {identifier,_,_}|Rest],Acc) ->
+%% {NamedType, Rest2} = parse_NamedType([Id|Rest]),
+%% case Rest2 of
+%% [{',',_}|Rest21] ->
+%% parse_ExtensionAdditionAlternatives(Rest21,[NamedType|Acc]);
+%% [{']]',_}|Rest21] ->
+%% {lists:reverse(Acc),Rest21};
+%% _ ->
+%% throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module),
+%% [got,get_token(hd(Rest2)),expected,[',',']]']]}})
+%% end.
parse_NamedType([{identifier,L1,Idname}|Rest]) ->
{Type,Rest2} = parse_Type(Rest),
@@ -2428,144 +2540,123 @@ parse_NamedType(Tokens) ->
parse_ComponentTypeLists(Tokens) ->
-% Resulting tuple {ComponentTypeList,Rest1} is returned
- case Tokens of
- [{identifier,_,_}|_Rest0] ->
- {Clist,Rest01} = parse_ComponentTypeList(Tokens),
- case Rest01 of
- [{',',_}|Rest02] ->
- parse_ComponentTypeLists(Rest02,Clist); % 5 - 13
- _ ->
- {Clist,Rest01}
- end;
- [{'COMPONENTS',_},{'OF',_}|_Rest] ->
- {Clist,Rest01} = parse_ComponentTypeList(Tokens),
- case Rest01 of
- [{',',_}|Rest02] ->
- parse_ComponentTypeLists(Rest02,Clist);
- _ ->
- {Clist,Rest01}
- end;
+ parse_ComponentTypeLists(Tokens,[]).
+
+parse_ComponentTypeLists(Tokens = [{identifier,_,_}|_Rest0],Clist) ->
+ {CompList,Rest1} = parse_ComponentTypeList(Tokens,[]),
+ parse_ComponentTypeLists(Rest1,Clist++CompList);
+parse_ComponentTypeLists(Tokens = [{'COMPONENTS',_},{'OF',_}|_Rest],Clist) ->
+ {CompList,Rest1} = parse_ComponentTypeList(Tokens,[]),
+ parse_ComponentTypeLists(Rest1,Clist++CompList);
+parse_ComponentTypeLists([{'...',L1},{'!',_}|Rest02],Clist0) ->
+ {_,Rest03} = parse_ExceptionIdentification(Rest02),
+ %% Exception info is currently thrown away
+ parse_ComponentTypeLists2(Rest03,Clist0++[#'EXTENSIONMARK'{pos=L1}]);
+parse_ComponentTypeLists([{',',L1},{'...',_},{'!',_}|Rest02],Clist0) when Clist0 =/= []->
+ {_,Rest03} = parse_ExceptionIdentification(Rest02),
+ %% Exception info is currently thrown away
+ parse_ComponentTypeLists2(Rest03,Clist0++[#'EXTENSIONMARK'{pos=L1}]);
+
+ parse_ComponentTypeLists([{',',_},{'...',L1}|Rest02],Clist0) when Clist0 =/= []->
+ parse_ComponentTypeLists2(Rest02,Clist0++[#'EXTENSIONMARK'{pos=L1}]);
+parse_ComponentTypeLists([{'...',L1}|Rest02],Clist0) ->
+ parse_ComponentTypeLists2(Rest02,Clist0++[#'EXTENSIONMARK'{pos=L1}]);
+parse_ComponentTypeLists(Tokens = [{'}',_L1}|_Rest02],Clist0) ->
+ {Clist0,Tokens}.
+
+parse_ComponentTypeLists2(Tokens,Clist) ->
+ {ExtAdd,Rest} = parse_ExtensionAdditions(Tokens,Clist),
+ {Clist2,Rest2} = parse_OptionalExtensionMarker(Rest,lists:flatten(ExtAdd)),
+ case Rest2 of
+ [{',',_}|Rest3] ->
+ {CompList,Rest4} = parse_ComponentTypeList(Rest3,[]),
+ {Clist2 ++ CompList,Rest4};
_ ->
- parse_ComponentTypeLists(Tokens,[])
+ {Clist2,Rest2}
end.
-parse_ComponentTypeLists([{'...',L1},{'!',_}|Rest],Clist1) ->
- {_,Rest2} = parse_ExceptionIdentification(Rest),
- %% Exception info is currently thrown away
- parse_ComponentTypeLists2(Rest2,Clist1++[#'EXTENSIONMARK'{pos=L1}]);
-parse_ComponentTypeLists([{'...',L1}|Rest],Clist1) -> %% first Extensionmark
- parse_ComponentTypeLists2(Rest,Clist1++[#'EXTENSIONMARK'{pos=L1}]);
-parse_ComponentTypeLists(Tokens,Clist1) ->
- {Clist1,Tokens}.
-
-
-parse_ComponentTypeLists2(Tokens,Clist1) ->
- {ExtensionAddition,Rest2} =
- case Tokens of
- [{',',_}|Rest1] ->
- parse_ExtensionAdditionList(Rest1);
- _ ->
- {[],Tokens}
- end,
- {OptionalExtensionMarker,Rest3} =
- case Rest2 of
- [{',',_},{'...',L2}|Rest21] ->
- {[#'EXTENSIONMARK'{pos=L2}],Rest21};
- _ ->
- {[],Rest2}
- end,
- {RootComponentTypeList,Rest4} =
- case Rest3 of
- [{',',_}|Rest31] ->
- parse_ComponentTypeList(Rest31);
- _ ->
- {[],Rest3}
- end,
- {Clist1 ++ ExtensionAddition ++ OptionalExtensionMarker ++ RootComponentTypeList, Rest4}.
-
+parse_OptionalExtensionMarker([{',',_},{'...',L1}|Rest],Clist)->
+ {Clist++[#'EXTENSIONMARK'{pos=L1}],Rest};
+parse_OptionalExtensionMarker(Tokens,Clist) ->
+ {Clist,Tokens}.
-parse_ComponentTypeList(Tokens) ->
- parse_ComponentTypeList(Tokens,[]).
-parse_ComponentTypeList(Tokens,Acc) ->
+parse_ComponentTypeList([{',',_},Id = {identifier,_,_}|Rest],Acc) when Acc =/= [] ->
+ {ComponentType,Rest2} = parse_ComponentType([Id|Rest]),
+ parse_ComponentTypeList(Rest2,[ComponentType|Acc]);
+parse_ComponentTypeList([{',',_},C1={'COMPONENTS',_},C2={'OF',_}|Rest],Acc) when Acc =/= [] ->
+ {ComponentType,Rest2} = parse_ComponentType([C1,C2|Rest]),
+ parse_ComponentTypeList(Rest2,[ComponentType|Acc]);
+parse_ComponentTypeList(Tokens = [{'}',_}|_],Acc) ->
+ {lists:reverse(Acc),Tokens};
+parse_ComponentTypeList(Tokens = [{']',_},{']',_}|_],Acc) ->
+ {lists:reverse(Acc),Tokens};
+parse_ComponentTypeList(Tokens = [{',',_},{'...',_}|_],Acc) ->
+ {lists:reverse(Acc),Tokens};
+parse_ComponentTypeList(Tokens,[]) ->
{ComponentType,Rest} = parse_ComponentType(Tokens),
+ parse_ComponentTypeList(Rest,[ComponentType]);
+parse_ComponentTypeList(Tokens,_) ->
+ throw({asn1_error,
+ {get_line(hd(Tokens)),get(asn1_module),
+ [got,[get_token(hd(Tokens)),get_token(hd(tl(Tokens)))],
+ expected,['}',', identifier']]}}).
+
+parse_ExtensionAdditions(Tokens=[{',',_}|_],Clist) ->
+ {ExtAddList,Rest2} = parse_ExtensionAdditionList(Tokens,[]),
+ {Clist++ExtAddList,Rest2};
+parse_ExtensionAdditions(Tokens,Clist) ->
+ %% Empty
+ {Clist,Tokens}.
+
+parse_ExtensionAdditionList([{',',_},Id = {identifier,_,_}|Rest],Acc) ->
+ {ComponentType,Rest2} = parse_ComponentType([Id|Rest]),
+ parse_ExtensionAdditionList(Rest2,[ComponentType|Acc]);
+parse_ExtensionAdditionList([{',',_},C1={'COMPONENTS',_},C2={'OF',_}|Rest],Acc) ->
+ {ComponentType,Rest2} = parse_ComponentType([C1,C2|Rest]),
+ parse_ExtensionAdditionList(Rest2,[ComponentType|Acc]);
+parse_ExtensionAdditionList([{',',_},C1 = {'[',_},C2 = {'[',_}|Rest],Acc) ->
+ {ExtAddGroup,Rest2} = parse_ExtensionAdditionGroup([C1,C2|Rest],[]),
+ parse_ExtensionAdditionList(Rest2,[ExtAddGroup|Acc]);
+parse_ExtensionAdditionList(Tokens = [{'}',_}|_],Acc) ->
+ {lists:reverse(Acc),Tokens};
+parse_ExtensionAdditionList(Tokens = [{',',_},{'...',_}|_],Acc) ->
+ {lists:reverse(Acc),Tokens};
+parse_ExtensionAdditionList(Tokens,_) ->
+ throw({asn1_error,
+ {get_line(hd(Tokens)),get(asn1_module),
+ [got,[get_token(hd(Tokens)),get_token(hd(tl(Tokens)))],
+ expected,['}',', identifier']]}}).
+
+
+parse_ExtensionAdditionGroup([ {'[',_},{'[',_},_VsnNr = {number,_,Num},{':',_}|Rest],[]) ->
+ parse_ExtensionAdditionGroup2(Rest,Num);
+parse_ExtensionAdditionGroup([ {'[',_},{'[',_}|Rest],[]) ->
+ parse_ExtensionAdditionGroup2(Rest,undefined);
+parse_ExtensionAdditionGroup(Tokens,_) ->
+ throw({asn1_error,
+ {get_line(hd(Tokens)),get(asn1_module),
+ [got,[get_token(hd(Tokens)),get_token(hd(tl(Tokens)))],
+ expected,['[[']]}}).
+
+
+parse_ExtensionAdditionGroup2(Tokens,Num) ->
+ {CompTypeList,Rest} = parse_ComponentTypeList(Tokens,[]),
case Rest of
- [{',',_},Id = {identifier,_,_}|Rest2] ->
- parse_ComponentTypeList([Id|Rest2],[ComponentType|Acc]);
- [{',',_},C1={'COMPONENTS',_},C2={'OF',_}|Rest2] ->
- parse_ComponentTypeList([C1,C2|Rest2],[ComponentType|Acc]);
-% _ ->
-% {lists:reverse([ComponentType|Acc]),Rest}
- [{'}',_}|_] ->
- {lists:reverse([ComponentType|Acc]),Rest};
-% [{',',_},{'...',_},{'}',_}|_] ->
-% {lists:reverse([ComponentType|Acc]),Rest};
- [{',',_},{'...',_}|_] ->%% here comes the dubble ellipse
- {lists:reverse([ComponentType|Acc]),Rest};
+ [{']',_},{']',_}|Rest2] ->
+ {[{'ExtensionAdditionGroup',Num}|CompTypeList] ++
+ ['ExtensionAdditionGroupEnd'],Rest2};
_ ->
- throw({asn1_error,
- {get_line(hd(Tokens)),get(asn1_module),
- [got,[get_token(hd(Rest)),get_token(hd(tl(Rest)))],
- expected,['}',', identifier']]}})
- end.
-
-
-parse_ExtensionAdditionList(Tokens) ->
- parse_ExtensionAdditionList(Tokens,[]).
-
-parse_ExtensionAdditionList(Tokens,Acc) ->
- {Element,Rest0} =
- case Tokens of
- [{identifier,_,_}|_Rest] ->
- parse_ComponentType(Tokens);
- [{'[',_},{'[',_}|_] ->
- parse_ExtensionAdditions(Tokens);
- [{'...',L1}|_Rest] ->
- {#'EXTENSIONMARK'{pos=L1},Tokens};
- _ ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,
- [identifier,'[[']]}})
- end,
- case Rest0 of
- [{',',_}|Rest01] ->
- parse_ExtensionAdditionList(Rest01,[Element|Acc]);
- [{'...',_}|Rest01] ->
- {lists:reverse([Element|Acc]),Rest01};
- _ ->
- {lists:reverse([Element|Acc]),Rest0}
+ throw({asn1_error,{get_line(hd(Rest)),get(asn1_module),
+ [got,get_token(hd(Rest)),expected,[']]']]}})
end.
-parse_ExtensionAdditions([{'[',_},{'[',_}|Rest]) ->
- parse_ExtensionAdditions(Rest,[]);
-parse_ExtensionAdditions(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,'[[']}}).
-
-parse_ExtensionAdditions([_VsnNr = {number,_,_},{':',_}|Rest],Acc) ->
- %% ignor version number for now
- parse_ExtensionAdditions(Rest,Acc);
-parse_ExtensionAdditions([Id = {identifier,_,_}|Rest],Acc) ->
- {ComponentType, Rest2} = parse_ComponentType([Id|Rest]),
- case Rest2 of
- [{',',_}|Rest21] ->
- parse_ExtensionAdditions(Rest21,[ComponentType|Acc]);
- [{']',_},{']',_}|Rest21] ->
- {lists:reverse(Acc),Rest21};
- _ ->
- throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module),
- [got,get_token(hd(Rest2)),expected,[',',']]']]}})
- end;
-parse_ExtensionAdditions(Tokens,_) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,identifier]}}).
parse_ComponentType([{'COMPONENTS',_},{'OF',_}|Rest]) ->
{Type,Rest2} = parse_Type(Rest),
{{'COMPONENTS OF',Type},Rest2};
parse_ComponentType(Tokens) ->
- {NamedType,Rest} = parse_NamedType(Tokens),
+ Result = {NamedType,Rest} = parse_NamedType(Tokens),
case Rest of
[{'OPTIONAL',_}|Rest2] ->
{NamedType#'ComponentType'{prop='OPTIONAL'},Rest2};
@@ -2573,7 +2664,7 @@ parse_ComponentType(Tokens) ->
{Value,Rest21} = parse_Value(Rest2),
{NamedType#'ComponentType'{prop={'DEFAULT',Value}},Rest21};
_ ->
- {NamedType,Rest}
+ Result
end.
diff --git a/lib/asn1/src/asn1ct_tok.erl b/lib/asn1/src/asn1ct_tok.erl
index f0ce31bdb2..85199c65ec 100644
--- a/lib/asn1/src/asn1ct_tok.erl
+++ b/lib/asn1/src/asn1ct_tok.erl
@@ -21,7 +21,7 @@
%% Tokenize ASN.1 code (input to parser generated with yecc)
--export([get_name/2,tokenise/2, file/1]).
+-export([get_name/2,tokenise/4, file/1]).
file(File) ->
@@ -29,12 +29,9 @@ file(File) ->
{error, Reason} ->
{error,{File,file:format_error(Reason)}};
{ok,Stream} ->
- process0(Stream)
+ process(Stream,0,[])
end.
-process0(Stream) ->
- process(Stream,0,[]).
-
process(Stream,Lno,R) ->
process(io:get_line(Stream, ''), Stream,Lno+1,R).
@@ -45,131 +42,128 @@ process(eof, Stream,Lno,R) ->
process(L, Stream,Lno,R) when is_list(L) ->
%%io:format('read:~s',[L]),
- case catch tokenise(L,Lno) of
+ case catch tokenise(Stream,L,Lno,[]) of
{'ERR',Reason} ->
io:format("Tokeniser error on line: ~w ~w~n",[Lno,Reason]),
exit(0);
- {multiline_comment,NestingLevel} ->
- {RestL,Lno2} = process_skip_multiline_comment(Stream,Lno,NestingLevel),
- process(RestL,Stream,Lno2,R);
- T ->
+ {NewLno,T} ->
%%io:format('toks:~w~n',[T]),
- process(Stream,Lno,[T|R])
+ process(Stream,NewLno,[T|R])
end.
-process_skip_multiline_comment(Stream,Lno,NestingLevel) ->
- process_skip_multiline_comment(io:get_line(Stream, ''),
- Stream, Lno + 1, NestingLevel).
-process_skip_multiline_comment(eof,_Stream,Lno,_NestingLevel) ->
- io:format("Tokeniser error on line: ~w, premature end of multiline comment~n",[Lno]),
- exit(0);
-process_skip_multiline_comment(Line,Stream,Lno,NestingLevel) ->
- case catch skip_multiline_comment(Line,NestingLevel) of
- {multiline_comment,NestingLevel2} ->
- process_skip_multiline_comment(Stream,Lno,NestingLevel2);
- T ->
- {T,Lno}
- end.
-
-tokenise([H|T],Lno) when $a =< H , H =< $z ->
+tokenise(Stream,[H|T],Lno,R) when $a =< H , H =< $z ->
{X, T1} = get_name(T, [H]),
- [{identifier,Lno, list_to_atom(X)}|tokenise(T1,Lno)];
+ tokenise(Stream,T1,Lno,[{identifier,Lno, list_to_atom(X)}|R]);
-tokenise([$&,H|T],Lno) when $A =< H , H =< $Z ->
+tokenise(Stream,[$&,H|T],Lno,R) when $A =< H , H =< $Z ->
{Y, T1} = get_name(T, [H]),
X = list_to_atom(Y),
- [{typefieldreference, Lno, X} | tokenise(T1, Lno)];
+ tokenise(Stream,T1,Lno,[{typefieldreference, Lno, X} | R]);
-tokenise([$&,H|T],Lno) when $a =< H , H =< $z ->
+tokenise(Stream,[$&,H|T],Lno,R) when $a =< H , H =< $z ->
{Y, T1} = get_name(T, [H]),
X = list_to_atom(Y),
- [{valuefieldreference, Lno, X} | tokenise(T1, Lno)];
+ tokenise(Stream,T1,Lno,[{valuefieldreference, Lno, X} | R]);
-tokenise([H|T],Lno) when $A =< H , H =< $Z ->
+tokenise(Stream,[H|T],Lno,R) when $A =< H , H =< $Z ->
{Y, T1} = get_name(T, [H]),
X = list_to_atom(Y),
case reserved_word(X) of
true ->
- [{X,Lno}|tokenise(T1,Lno)];
+ tokenise(Stream,T1,Lno,[{X,Lno}|R]);
false ->
- [{typereference,Lno,X}|tokenise(T1,Lno)];
+ tokenise(Stream,T1,Lno,[{typereference,Lno,X}|R]);
rstrtype ->
- [{restrictedcharacterstringtype,Lno,X}|tokenise(T1,Lno)]
+ tokenise(Stream,T1,Lno,[{restrictedcharacterstringtype,Lno,X}|R])
end;
-tokenise([$-,H|T],Lno) when $0 =< H , H =< $9 ->
+tokenise(Stream,[$-,H|T],Lno,R) when $0 =< H , H =< $9 ->
{X, T1} = get_number(T, [H]),
- [{number,Lno,-1 * list_to_integer(X)}|tokenise(T1,Lno)];
+ tokenise(Stream,T1,Lno,[{number,Lno,-1 * list_to_integer(X)}|R]);
-tokenise([H|T],Lno) when $0 =< H , H =< $9 ->
+tokenise(Stream,[H|T],Lno,R) when $0 =< H , H =< $9 ->
{X, T1} = get_number(T, [H]),
- [{number,Lno,list_to_integer(X)}|tokenise(T1,Lno)];
+ tokenise(Stream,T1,Lno,[{number,Lno,list_to_integer(X)}|R]);
-tokenise([$-,$-|T],Lno) ->
- tokenise(skip_comment(T),Lno);
+tokenise(Stream,[$-,$-|T],Lno,R) ->
+ tokenise(Stream,skip_comment(T),Lno,R);
-tokenise([$/,$*|T],Lno) ->
- tokenise(skip_multiline_comment(T,0),Lno);
+tokenise(Stream,[$/,$*|T],Lno,R) ->
+ {NewLno,T1} = skip_multiline_comment(Stream,T,Lno,0),
+ tokenise(Stream,T1,NewLno,R);
-tokenise([$:,$:,$=|T],Lno) ->
- [{'::=',Lno}|tokenise(T,Lno)];
+tokenise(Stream,[$:,$:,$=|T],Lno,R) ->
+ tokenise(Stream,T,Lno,[{'::=',Lno}|R]);
-tokenise([$'|T],Lno) ->
+tokenise(Stream,[$'|T],Lno,R) ->
case catch collect_quoted(T,Lno,[]) of
{'ERR',_} ->
throw({'ERR','bad_quote'});
{Thing, T1} ->
- [Thing|tokenise(T1,Lno)]
+ tokenise(Stream,T1,Lno,[Thing|R])
end;
-tokenise([$"|T],Lno) ->
- collect_string(T,Lno);
+tokenise(Stream,[$"|T],Lno,R) ->
+ {Str,T1} = collect_string(T,Lno),
+ tokenise(Stream,T1,Lno,[Str|R]);
+
+tokenise(Stream,[${|T],Lno,R) ->
+ tokenise(Stream,T,Lno,[{'{',Lno}|R]);
+
+tokenise(Stream,[$}|T],Lno,R) ->
+ tokenise(Stream,T,Lno,[{'}',Lno}|R]);
-tokenise([${|T],Lno) ->
- [{'{',Lno}|tokenise(T,Lno)];
+%% tokenise(Stream,[$],$]|T],Lno,R) ->
+%% tokenise(Stream,T,Lno,[{']]',Lno}|R]);
-tokenise([$}|T],Lno) ->
- [{'}',Lno}|tokenise(T,Lno)];
+%% Even though x.680 specify '[[' and ']]' as lexical items
+%% it does not work to have them as such since the single [ and ] can
+%% be used beside each other in the SYNTAX OF in x.681
+%% the solution chosen here , i.e. to have them as separate lexical items
+%% will not detect the cases where there is white space between them
+%% which would be an error in the use in ExtensionAdditionGroups
-tokenise([$]|T],Lno) ->
- [{']',Lno}|tokenise(T,Lno)];
+%% tokenise(Stream,[$[,$[|T],Lno,R) ->
+%% tokenise(Stream,T,Lno,[{'[[',Lno}|R]);
-tokenise([$[|T],Lno) ->
- [{'[',Lno}|tokenise(T,Lno)];
+tokenise(Stream,[$]|T],Lno,R) ->
+ tokenise(Stream,T,Lno,[{']',Lno}|R]);
-tokenise([$,|T],Lno) ->
- [{',',Lno}|tokenise(T,Lno)];
+tokenise(Stream,[$[|T],Lno,R) ->
+ tokenise(Stream,T,Lno,[{'[',Lno}|R]);
-tokenise([$(|T],Lno) ->
- [{'(',Lno}|tokenise(T,Lno)];
-tokenise([$)|T],Lno) ->
- [{')',Lno}|tokenise(T,Lno)];
+tokenise(Stream,[$,|T],Lno,R) ->
+ tokenise(Stream,T,Lno,[{',',Lno}|R]);
-tokenise([$.,$.,$.|T],Lno) ->
- [{'...',Lno}|tokenise(T,Lno)];
+tokenise(Stream,[$(|T],Lno,R) ->
+ tokenise(Stream,T,Lno,[{'(',Lno}|R]);
+tokenise(Stream,[$)|T],Lno,R) ->
+ tokenise(Stream,T,Lno,[{')',Lno}|R]);
-tokenise([$.,$.|T],Lno) ->
- [{'..',Lno}|tokenise(T,Lno)];
+tokenise(Stream,[$.,$.,$.|T],Lno,R) ->
+ tokenise(Stream,T,Lno,[{'...',Lno}|R]);
-tokenise([$.|T],Lno) ->
- [{'.',Lno}|tokenise(T,Lno)];
-tokenise([$^|T],Lno) ->
- [{'^',Lno}|tokenise(T,Lno)];
-tokenise([$!|T],Lno) ->
- [{'!',Lno}|tokenise(T,Lno)];
-tokenise([$||T],Lno) ->
- [{'|',Lno}|tokenise(T,Lno)];
+tokenise(Stream,[$.,$.|T],Lno,R) ->
+ tokenise(Stream,T,Lno,[{'..',Lno}|R]);
+tokenise(Stream,[$.|T],Lno,R) ->
+ tokenise(Stream,T,Lno,[{'.',Lno}|R]);
+tokenise(Stream,[$^|T],Lno,R) ->
+ tokenise(Stream,T,Lno,[{'^',Lno}|R]);
+tokenise(Stream,[$!|T],Lno,R) ->
+ tokenise(Stream,T,Lno,[{'!',Lno}|R]);
+tokenise(Stream,[$||T],Lno,R) ->
+ tokenise(Stream,T,Lno,[{'|',Lno}|R]);
-tokenise([H|T],Lno) ->
+tokenise(Stream,[H|T],Lno,R) ->
case white_space(H) of
true ->
- tokenise(T,Lno);
+ tokenise(Stream,T,Lno,R);
false ->
- [{list_to_atom([H]),Lno}|tokenise(T,Lno)]
+ tokenise(Stream,T,Lno,[{list_to_atom([H]),Lno}|R])
end;
-tokenise([],_) ->
- [].
+tokenise(_Stream,[],Lno,R) ->
+ {Lno,lists:reverse(R)}.
collect_string(L,Lno) ->
@@ -181,7 +175,7 @@ collect_string([],_,_) ->
collect_string([H|T],Lno,Str) ->
case H of
$" ->
- [{cstring,1,lists:reverse(Str)}|tokenise(T,Lno)];
+ {{cstring,1,lists:reverse(Str)},T};
Ch ->
collect_string(T,Lno,[Ch|Str])
end.
@@ -252,17 +246,23 @@ skip_comment([_|T]) ->
skip_comment(T).
-skip_multiline_comment([],L) ->
- throw({multiline_comment,L});
-skip_multiline_comment([$*,$/|T],0) ->
- T;
-skip_multiline_comment([$*,$/|T],Level) ->
- skip_multiline_comment(T,Level - 1);
-skip_multiline_comment([$/,$*|T],Level) ->
- skip_multiline_comment(T,Level + 1);
-skip_multiline_comment([_|T],Level) ->
- skip_multiline_comment(T,Level).
-
+skip_multiline_comment(Stream,[],Lno,Level) ->
+ case io:get_line(Stream,'') of
+ eof ->
+ io:format("Tokeniser error on line: ~w~n"
+ "premature end of multiline comment~n",[Lno]),
+ exit(0);
+ Line ->
+ skip_multiline_comment(Stream,Line,Lno+1,Level)
+ end;
+skip_multiline_comment(_Stream,[$*,$/|T],Lno,0) ->
+ {Lno,T};
+skip_multiline_comment(Stream,[$*,$/|T],Lno,Level) ->
+ skip_multiline_comment(Stream,T,Lno,Level - 1);
+skip_multiline_comment(Stream,[$/,$*|T],Lno,Level) ->
+ skip_multiline_comment(Stream,T,Lno,Level + 1);
+skip_multiline_comment(Stream,[_|T],Lno,Level) ->
+ skip_multiline_comment(Stream,T,Lno,Level).
collect_quoted([$',$B|T],Lno, L) ->
case check_bin(L) of
diff --git a/lib/asn1/test/Makefile b/lib/asn1/test/Makefile
index 5014eb902b..e8f65ec70b 100644
--- a/lib/asn1/test/Makefile
+++ b/lib/asn1/test/Makefile
@@ -189,27 +189,16 @@ release_spec: opt
release_tests_spec: opt
$(INSTALL_DIR) $(RELSYSDIR)
- $(INSTALL_DATA) asn1.spec $(EMAKEFILE) $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR)
- chmod -f -R u+w $(RELSYSDIR)
- @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -)
+ $(INSTALL_DIR) $(RELSYSDIR)/asn1_SUITE_data
$(INSTALL_DIR) $(RELSYSDIR)/asn1_bin_SUITE_data
- @(cd asn1_SUITE_data; tar cf - *) | (cd $(RELSYSDIR)/asn1_bin_SUITE_data; tar xf -)
$(INSTALL_DIR) $(RELSYSDIR)/asn1_bin_v2_SUITE_data
- @(cd asn1_SUITE_data; tar cf - *) | (cd $(RELSYSDIR)/asn1_bin_v2_SUITE_data; tar xf -)
-
+ $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR)
+ $(INSTALL_DATA) asn1.spec $(INSTALL_PROGS) $(RELSYSDIR)
+ chmod -f -R u+w $(RELSYSDIR)
+ cd asn1_SUITE_data; tar cfh $(RELSYSDIR)/asn1_SUITE_data.tar *
+ cd $(RELSYSDIR)/asn1_SUITE_data; tar xf $(RELSYSDIR)/asn1_SUITE_data.tar
+ cd $(RELSYSDIR)/asn1_bin_SUITE_data; tar xf $(RELSYSDIR)/asn1_SUITE_data.tar
+ cd $(RELSYSDIR)/asn1_bin_v2_SUITE_data; tar xf $(RELSYSDIR)/asn1_SUITE_data.tar
+ rm $(RELSYSDIR)/asn1_SUITE_data.tar
release_docs_spec:
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/asn1/test/asn1_SUITE.erl.src b/lib/asn1/test/asn1_SUITE.erl.src
index ca73d259af..f0228546a5 100644
--- a/lib/asn1/test/asn1_SUITE.erl.src
+++ b/lib/asn1/test/asn1_SUITE.erl.src
@@ -74,6 +74,7 @@ all(suite) -> [compile,parse,default_per,default_ber,default_per_opt,per,
testSeqTypeRefPrim, testSeqTypeRefSeq, testSeqTypeRefSet,
testSeqOf, testSeqOfIndefinite, testSeqOfCho,
testSeqOfExternal, testSetDefault, testSetExtension,
+ testExtensionAdditionGroup,
testSetExternal, testSeqOfTag, testSetOptional, testSetPrim,
testSetTag, testSetTypeRefCho, testSetTypeRefPrim,
testSetTypeRefSeq, testSetTypeRefSet, testSetOf, testSetOfCho,
@@ -95,7 +96,7 @@ all(suite) -> [compile,parse,default_per,default_ber,default_per_opt,per,
testSSLspecs, testNortel,test_undecoded_rest,
test_inline, testTcapsystem, testNBAPsystem,
test_compile_options,testDoubleEllipses, test_modified_x420,
- testX420, test_x691,ticket_6143
+ testX420, test_x691,ticket_6143, testExtensionAdditionGroup
] ++ common() ++ particular().
%all(suite) -> [test_inline,testNBAPsystem,test_compile_options,ticket_6143].
@@ -1036,7 +1037,6 @@ testSetExtension_cases(Rules) ->
?line testSetExtension:main(Rules).
-
testSetExternal(suite) -> [];
testSetExternal(Config) ->
?line true = code:add_patha(?config(priv_dir,Config)),
@@ -2292,6 +2292,21 @@ ticket_6143(suite) -> [];
ticket_6143(Config) ->
?line ok = test_compile_options:ticket_6143(Config).
+testExtensionAdditionGroup(suite) -> [];
+testExtensionAdditionGroup(Config) ->
+ ?line DataDir = ?config(data_dir,Config),
+ ?line PrivDir = ?config(priv_dir,Config),
+ ?line Path = code:get_path(),
+ ?line code:add_patha(PrivDir),
+ DoIt = fun(Erule) ->
+ ?line ok = asn1ct:compile(filename:join(DataDir,"Extension-Addition-Group"),[Erule,{outdir,PrivDir}]),
+ ?line {ok,_M} = compile:file(filename:join(DataDir,"extensionAdditionGroup"),[{i,PrivDir},{outdir,PrivDir},debug_info]),
+ ?line ok = extensionAdditionGroup:run(Erule)
+ end,
+ ?line [DoIt(Rule)|| Rule <- [per_bin,uper_bin,ber_bin]],
+ ?line code:set_path(Path).
+
+
% parse_modules() ->
% ["ImportsFrom"].
diff --git a/lib/asn1/test/asn1_SUITE_data/AA2.asn1db b/lib/asn1/test/asn1_SUITE_data/AA2.asn1db
index 3bf2c1b89d..163dbb032d 100644
--- a/lib/asn1/test/asn1_SUITE_data/AA2.asn1db
+++ b/lib/asn1/test/asn1_SUITE_data/AA2.asn1db
Binary files differ
diff --git a/lib/asn1/test/asn1_SUITE_data/Extension-Addition-Group.asn b/lib/asn1/test/asn1_SUITE_data/Extension-Addition-Group.asn
new file mode 100644
index 0000000000..b985c970ac
--- /dev/null
+++ b/lib/asn1/test/asn1_SUITE_data/Extension-Addition-Group.asn
@@ -0,0 +1,66 @@
+--
+-- %CopyrightBegin%
+--
+-- Copyright Ericsson AB 2001-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%
+
+Extension-Addition-Group DEFINITIONS AUTOMATIC TAGS ::=
+
+BEGIN
+
+-- fetched from ITU-T Rec. X691 (07/2002)
+
+Ax ::= SEQUENCE {
+ a INTEGER (250..253),
+ b BOOLEAN,
+ c CHOICE {
+ d INTEGER,
+ ...,
+
+ [[
+ e BOOLEAN,
+ f IA5String
+ ]],
+ ...
+ },
+ ...,
+ [[
+ g NumericString (SIZE(3)),
+ h BOOLEAN OPTIONAL
+ ]]
+,
+ ...,
+ i BMPString OPTIONAL,
+ j PrintableString OPTIONAL
+
+}
+
+-- valAx Ax ::= { a 253, b TRUE, c e: TRUE, g "123", h TRUE }
+Ax2 ::= SEQUENCE {
+ a INTEGER (250..253),
+ b BOOLEAN,
+ ...,
+ ug NumericString
+
+}
+END
+
+-- The value { a 253, b TRUE, c e: TRUE, g "123", h TRUE }
+-- is encoded in PER as
+-- Hexadecimal view
+-- 9E000180 010291A4
+
+-- is encoded in Unaligned PER as
+-- 9E000600 040A4690
diff --git a/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl b/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl
new file mode 100644
index 0000000000..79e200f561
--- /dev/null
+++ b/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl
@@ -0,0 +1,43 @@
+%%%-------------------------------------------------------------------
+%%% File : extensionAdditionGroup.erl
+%%% Author : Kenneth Lundin
+%%% Description :
+%%%
+%%% Created : 18 May 2010 by kenneth
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-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(extensionAdditionGroup).
+-include("Extension-Addition-Group.hrl").
+
+
+-compile(export_all).
+
+run(Erule) ->
+ Val = #'Ax'{a=253, b = true, c= {e,true}, g="123", h = true},
+ io:format("~p:~p~n",[Erule,Val]),
+ {ok,List}= asn1rt:encode('Extension-Addition-Group','Ax',Val),
+ Enc = iolist_to_binary(List),
+ io:format("~p~n",[Enc]),
+ {ok,Val2} = asn1rt:decode('Extension-Addition-Group','Ax',Enc),
+ io:format("~p~n",[Val2]),
+ case Val2 of
+ Val -> ok;
+ _ -> exit({expected,Val, got, Val2})
+ end.
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index ed7a9144a8..26da3ecad2 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -824,6 +824,10 @@ foldl_transform(St, [T|Ts]) ->
{'EXIT',R} ->
Es = [{St#compile.ifile,[{none,compile,{parse_transform,T,R}}]}],
{error,St#compile{errors=St#compile.errors ++ Es}};
+ {warning, Forms, Ws} ->
+ foldl_transform(
+ St#compile{code=Forms,
+ warnings=St#compile.warnings ++ Ws}, Ts);
Forms ->
foldl_transform(St#compile{code=Forms}, Ts)
end;
diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c
index 68079f06c7..8823bba3b6 100644
--- a/lib/crypto/c_src/crypto.c
+++ b/lib/crypto/c_src/crypto.c
@@ -950,7 +950,7 @@ static ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_N
RC4(rc4_key, data.size, data.data,
enif_make_new_binary(env, data.size, &new_data));
- return enif_make_tuple2(env,argv[0],new_data);
+ return enif_make_tuple2(env,new_state,new_data);
}
static ERL_NIF_TERM rc2_40_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl
index 576949d38d..06b284d50d 100644
--- a/lib/crypto/test/crypto_SUITE.erl
+++ b/lib/crypto/test/crypto_SUITE.erl
@@ -54,6 +54,7 @@
dh/1,
exor_test/1,
rc4_test/1,
+ rc4_stream_test/1,
blowfish_cfb64/1,
smp/1,
cleanup/1]).
@@ -89,6 +90,7 @@ all(suite) ->
dh,
exor_test,
rc4_test,
+ rc4_stream_test,
mod_exp_test,
blowfish_cfb64,
smp],
@@ -979,6 +981,21 @@ rc4_test(Config) when is_list(Config) ->
CT2 = binary_to_list(crypto:rc4_encrypt(K, R2)),
ok.
+rc4_stream_test(doc) ->
+ ["Test rc4 stream encryption ."];
+rc4_stream_test(suite) ->
+ [];
+rc4_stream_test(Config) when is_list(Config) ->
+ CT1 = <<"hej">>,
+ CT2 = <<" p� dig">>,
+ K = "apaapa",
+ State0 = crypto:rc4_set_key(K),
+ {State1, R1} = crypto:rc4_encrypt_with_state(State0, CT1),
+ {_State2, R2} = crypto:rc4_encrypt_with_state(State1, CT2),
+ R = list_to_binary([R1, R2]),
+ <<71,112,14,44,140,33,212,144,155,47>> = R,
+ ok.
+
blowfish_cfb64(doc) -> ["Test Blowfish encrypt/decrypt."];
blowfish_cfb64(suite) -> [];
blowfish_cfb64(Config) when is_list(Config) ->
@@ -1029,7 +1046,7 @@ worker_loop(0, _) ->
worker_loop(N, Config) ->
Funcs = { md5, md5_update, md5_mac, md5_mac_io, sha, sha_update, des_cbc,
aes_cfb, aes_cbc, des_cbc_iter, rand_uniform_test,
- rsa_verify_test, exor_test, rc4_test, mod_exp_test },
+ rsa_verify_test, exor_test, rc4_test, rc4_stream_test, mod_exp_test },
F = element(random:uniform(size(Funcs)),Funcs),
%%io:format("worker ~p calling ~p\n",[self(),F]),
diff --git a/lib/docbuilder/src/docb_edoc_xml_cb.erl b/lib/docbuilder/src/docb_edoc_xml_cb.erl
index f5cfc0fe18..90491bc007 100644
--- a/lib/docbuilder/src/docb_edoc_xml_cb.erl
+++ b/lib/docbuilder/src/docb_edoc_xml_cb.erl
@@ -340,9 +340,7 @@ otp_xmlify_e(#xmlElement{name=code} = E) -> % 4)
[E#xmlElement{content=Content}]
end;
otp_xmlify_e(#xmlElement{name=Tag} = E) % 5a
- when Tag==h1; Tag==h2; Tag==h3; Tag==h4; Tag==h5;
- Tag==center;
- Tag==font ->
+ when Tag==h1; Tag==h2; Tag==h3; Tag==h4; Tag==h5 ->
Content = text_only(E#xmlElement.content),
[E#xmlElement{name=b, content=Content}];
otp_xmlify_e(#xmlElement{name=Tag} = E) % 5b-c)
@@ -354,21 +352,16 @@ otp_xmlify_e(#xmlElement{name=table} = E) -> % 6)
module ->
otp_xmlify_table(E#xmlElement.content);
overview ->
- case get_attrval(border, E) of
- "" -> % implies border="0"
- [{p, otp_xmlify_table(E#xmlElement.content)}];
- "0" ->
- [{p, otp_xmlify_table(E#xmlElement.content)}];
- _Val ->
- Content0 = otp_xmlify_e(E#xmlElement.content),
- Summary = #xmlText{value=get_attrval(summary, E)},
- TCaption = E#xmlElement{name=tcaption,
- attributes=[],
- content=[Summary]},
- Content = Content0 ++ [TCaption],
- [E#xmlElement{attributes=[], content=Content}]
- end
+ Content0 = otp_xmlify_e(E#xmlElement.content),
+ Summary = #xmlText{value=get_attrval(summary, E)},
+ TCaption = E#xmlElement{name=tcaption,
+ attributes=[],
+ content=[Summary]},
+ Content = Content0 ++ [TCaption],
+ [E#xmlElement{attributes=[], content=Content}]
end;
+otp_xmlify_e(#xmlElement{name=tbody} = E) ->
+ otp_xmlify_e(E#xmlElement.content);
otp_xmlify_e(#xmlElement{name=sup} = E) -> % 7)
Text = get_text(E),
[#xmlText{parents = E#xmlElement.parents,
diff --git a/lib/erl_docgen/priv/xsl/db_html.xsl b/lib/erl_docgen/priv/xsl/db_html.xsl
index 5614b02bb7..bba0f97645 100644
--- a/lib/erl_docgen/priv/xsl/db_html.xsl
+++ b/lib/erl_docgen/priv/xsl/db_html.xsl
@@ -1157,6 +1157,7 @@
</xsl:template>
+
<xsl:template match="name">
<xsl:variable name="tmpstring">
@@ -1208,6 +1209,9 @@
</xsl:variable>
<a name="{$fname}-{$arity}"><span class="bold_code"><xsl:value-of select="."/></span></a><br/>
</xsl:when>
+ <xsl:otherwise>
+ <span class="bold_code"><xsl:value-of select="."/></span>
+ </xsl:otherwise>
</xsl:choose>
</xsl:template>
diff --git a/lib/erl_docgen/vsn.mk b/lib/erl_docgen/vsn.mk
index 5b14051034..33d8c1f708 100644
--- a/lib/erl_docgen/vsn.mk
+++ b/lib/erl_docgen/vsn.mk
@@ -1,22 +1 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2009-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%
-#
-
ERL_DOCGEN_VSN = 0.2.1
-
-TICKETS =
diff --git a/lib/et/vsn.mk b/lib/et/vsn.mk
index c3a42af156..04ecb8c82e 100644
--- a/lib/et/vsn.mk
+++ b/lib/et/vsn.mk
@@ -1,19 +1 @@
-# This is an -*-makefile-*- file.
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2002-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%
-
ET_VSN = 1.4
diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk
index ea6f4c9903..b53d47d99c 100644
--- a/lib/inets/vsn.mk
+++ b/lib/inets/vsn.mk
@@ -1,22 +1,3 @@
-#-*-makefile-*- ; force emacs to enter makefile-mode
-
-# %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%
-
APPLICATION = inets
INETS_VSN = 5.4
PRE_VSN =
diff --git a/lib/jinterface/vsn.mk b/lib/jinterface/vsn.mk
index 6b5719d7c5..26613febbf 100644
--- a/lib/jinterface/vsn.mk
+++ b/lib/jinterface/vsn.mk
@@ -1,19 +1 @@
-##
-## %CopyrightBegin%
-##
-## Copyright Ericsson AB 2000-2010. All Rights Reserved.
-##
-## The contents of this file are subject to the Erlang Public License,
-## Version 1.1, (the "License"); you may not use this file except in
-## compliance with the License. You should have received a copy of the
-## Erlang Public License along with this software. If not, it can be
-## retrieved online at http://www.erlang.org/.
-##
-## Software distributed under the License is distributed on an "AS IS"
-## basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
-## the License for the specific language governing rights and limitations
-## under the License.
-##
-## %CopyrightEnd%
-
JINTERFACE_VSN = 1.5.3
diff --git a/lib/kernel/vsn.mk b/lib/kernel/vsn.mk
index 9a191f9aeb..651d082379 100644
--- a/lib/kernel/vsn.mk
+++ b/lib/kernel/vsn.mk
@@ -1,20 +1 @@
-#
-# %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%
-#
-
KERNEL_VSN = 2.14.1
diff --git a/lib/megaco/vsn.mk b/lib/megaco/vsn.mk
index f28c89abbe..73ac5bbc63 100644
--- a/lib/megaco/vsn.mk
+++ b/lib/megaco/vsn.mk
@@ -1,22 +1,3 @@
-#-*-makefile-*- ; force emacs to enter makefile-mode
-
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2001-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%
-
APPLICATION = megaco
MEGACO_VSN = 3.14.1.1
PRE_VSN =
diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl
index 95c3d714d3..f9b992afd3 100644
--- a/lib/public_key/src/public_key.erl
+++ b/lib/public_key/src/public_key.erl
@@ -373,11 +373,9 @@ pkix_verify(DerCert, #'RSAPublicKey'{} = RSAKey)
pkix_is_issuer(Cert, IssuerCert) when is_binary(Cert) ->
OtpCert = pkix_decode_cert(Cert, otp),
pkix_is_issuer(OtpCert, IssuerCert);
-
pkix_is_issuer(Cert, IssuerCert) when is_binary(IssuerCert) ->
OtpIssuerCert = pkix_decode_cert(IssuerCert, otp),
pkix_is_issuer(Cert, OtpIssuerCert);
-
pkix_is_issuer(#'OTPCertificate'{tbsCertificate = TBSCert},
#'OTPCertificate'{tbsCertificate = Candidate}) ->
pubkey_cert:is_issuer(TBSCert#'OTPTBSCertificate'.issuer,
@@ -438,7 +436,7 @@ pkix_normalize_name(Issuer) ->
pubkey_cert:normalize_general_name(Issuer).
%%--------------------------------------------------------------------
--spec pkix_path_validation(der_encoded()| #'OTPCertificate'{},
+-spec pkix_path_validation(der_encoded()| #'OTPCertificate'{} | unknown_ca,
CertChain :: [der_encoded()] ,
Options :: list()) ->
{ok, {PublicKeyInfo :: term(),
@@ -447,10 +445,16 @@ pkix_normalize_name(Issuer) ->
{error, {bad_cert, Reason :: term()}}.
%% Description: Performs a basic path validation according to RFC 5280.
%%--------------------------------------------------------------------
-pkix_path_validation(TrustedCert, CertChain, Options)
- when is_binary(TrustedCert) ->
- OtpCert = pkix_decode_cert(TrustedCert, otp),
- pkix_path_validation(OtpCert, CertChain, Options);
+pkix_path_validation(unknown_ca, [Cert | Chain], Options) ->
+ case proplists:get_value(verify, Options, true) of
+ true ->
+ {error, {bad_cert, unknown_ca}};
+ false ->
+ pkix_path_validation(Cert, Chain, [{acc_errors, [{bad_cert, unknown_ca}]}])
+ end;
+pkix_path_validation(TrustedCert, CertChain, Options) when
+ is_binary(TrustedCert) -> OtpCert = pkix_decode_cert(TrustedCert,
+ otp), pkix_path_validation(OtpCert, CertChain, Options);
pkix_path_validation(#'OTPCertificate'{} = TrustedCert, CertChain, Options)
when is_list(CertChain), is_list(Options) ->
diff --git a/lib/public_key/test/public_key_SUITE.erl b/lib/public_key/test/public_key_SUITE.erl
index f920aa23b7..09235ff460 100644
--- a/lib/public_key/test/public_key_SUITE.erl
+++ b/lib/public_key/test/public_key_SUITE.erl
@@ -374,6 +374,11 @@ pkix_path_validation(Config) when is_list(Config) ->
{ok, {_,_,[E]}} = public_key:pkix_path_validation(Trusted, [Cert1, Cert3,Cert4],
[{verify,false}]),
+
+ {error, {bad_cert,unknown_ca}} = public_key:pkix_path_validation(unknown_ca, [Cert1, Cert3, Cert4], []),
+
+ {ok, {_,_,[{bad_cert,unknown_ca}]}} =
+ public_key:pkix_path_validation(unknown_ca, [Cert1], [{verify, false}]),
ok.
%%--------------------------------------------------------------------
diff --git a/lib/reltool/vsn.mk b/lib/reltool/vsn.mk
index 7bee91d428..9e0bce1d01 100644
--- a/lib/reltool/vsn.mk
+++ b/lib/reltool/vsn.mk
@@ -1,19 +1 @@
-# This is an -*-makefile-*- file.
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2009-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%
-
RELTOOL_VSN = 0.5.4
diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk
index 21b84f0dc6..95103433a4 100644
--- a/lib/snmp/vsn.mk
+++ b/lib/snmp/vsn.mk
@@ -1,22 +1,3 @@
-#-*-makefile-*- ; force emacs to enter makefile-mode
-
-# %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%
-
SNMP_VSN = 4.17.1
PRE_VSN =
APP_VSN = "snmp-$(SNMP_VSN)$(PRE_VSN)"
diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl
index 917e75157b..5026c760bd 100644
--- a/lib/ssl/src/ssl_certificate.erl
+++ b/lib/ssl/src/ssl_certificate.erl
@@ -31,7 +31,7 @@
-include("ssl_debug.hrl").
-include_lib("public_key/include/public_key.hrl").
--export([trusted_cert_and_path/3,
+-export([trusted_cert_and_path/2,
certificate_chain/2,
file_to_certificats/1,
validate_extensions/6,
@@ -47,48 +47,46 @@
%%====================================================================
%%--------------------------------------------------------------------
--spec trusted_cert_and_path([der_cert()], certdb_ref(), boolean()) ->
- {der_cert(), [der_cert()], list()}.
+-spec trusted_cert_and_path([der_cert()], certdb_ref()) ->
+ {der_cert() | unknown_ca, [der_cert()]}.
%%
%% Description: Extracts the root cert (if not presents tries to
%% look it up, if not found {bad_cert, unknown_ca} will be added verification
%% errors. Returns {RootCert, Path, VerifyErrors}
%%--------------------------------------------------------------------
-trusted_cert_and_path(CertChain, CertDbRef, Verify) ->
- [Cert | RestPath] = lists:reverse(CertChain),
+trusted_cert_and_path(CertChain, CertDbRef) ->
+ Path = [Cert | _] = lists:reverse(CertChain),
OtpCert = public_key:pkix_decode_cert(Cert, otp),
- IssuerAnPath =
+ IssuerID =
case public_key:pkix_is_self_signed(OtpCert) of
true ->
{ok, IssuerId} = public_key:pkix_issuer_id(OtpCert, self),
- {IssuerId, RestPath};
- false ->
+ IssuerId;
+ false ->
case public_key:pkix_issuer_id(OtpCert, other) of
{ok, IssuerId} ->
- {IssuerId, [Cert | RestPath]};
+ IssuerId;
{error, issuer_not_found} ->
case find_issuer(OtpCert, no_candidate) of
{ok, IssuerId} ->
- {IssuerId, [Cert | RestPath]};
+ IssuerId;
Other ->
- {Other, RestPath}
+ Other
end
end
end,
- case IssuerAnPath of
- {{error, issuer_not_found}, _ } ->
- %% The root CA was not sent and can not be found, we fail if verify = true
- not_valid(?ALERT_REC(?FATAL, ?UNKNOWN_CA), Verify, {Cert, RestPath});
- {{SerialNr, Issuer}, Path} ->
- case ssl_manager:lookup_trusted_cert(CertDbRef,
- SerialNr, Issuer) of
+ case IssuerID of
+ {error, issuer_not_found} ->
+ %% The root CA was not sent and can not be found.
+ {unknown_ca, Path};
+ {SerialNr, Issuer} ->
+ case ssl_manager:lookup_trusted_cert(CertDbRef, SerialNr, Issuer) of
{ok, {BinCert,_}} ->
- {BinCert, Path, []};
+ {BinCert, Path};
_ ->
- %% Fail if verify = true
- not_valid(?ALERT_REC(?FATAL, ?UNKNOWN_CA),
- Verify, {Cert, RestPath})
+ %% Root CA could not be verified
+ {unknown_ca, Path}
end
end.
@@ -244,11 +242,6 @@ find_issuer(OtpCert, PrevCandidateKey) ->
end
end.
-not_valid(Alert, true, _) ->
- throw(Alert);
-not_valid(_, false, {ErlCert, Path}) ->
- {ErlCert, Path, [{bad_cert, unknown_ca}]}.
-
is_valid_extkey_usage(KeyUse, client) ->
%% Client wants to verify server
is_valid_key_usage(KeyUse,?'id-kp-serverAuth');
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index 76422155a5..dd8f77a0ca 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/ssl_connection.erl
@@ -334,14 +334,12 @@ hello(start, #state{host = Host, port = Port, role = client,
ssl_options = SslOpts,
transport_cb = Transport, socket = Socket,
connection_states = ConnectionStates,
- own_cert = Cert,
renegotiation = {Renegotiation, _}}
= State0) ->
Hello = ssl_handshake:client_hello(Host, Port,
ConnectionStates,
- SslOpts, Cert,
- Renegotiation),
+ SslOpts, Renegotiation),
Version = Hello#client_hello.client_version,
Hashes0 = ssl_handshake:init_hashes(),
@@ -353,7 +351,7 @@ hello(start, #state{host = Host, port = Port, role = client,
session =
#session{session_id = Hello#client_hello.session_id,
is_resumable = false},
- tls_handshake_hashes = Hashes1},
+ tls_handshake_hashes = Hashes1},
{Record, State} = next_record(State1),
next_state(hello, Record, State);
@@ -579,58 +577,61 @@ certify(#client_key_exchange{} = Msg,
%% We expect a certificate here
handle_unexpected_message(Msg, certify_client_key_exchange, State);
-certify(#client_key_exchange{exchange_keys
- = #encrypted_premaster_secret{premaster_secret
- = EncPMS}},
- #state{negotiated_version = Version,
- connection_states = ConnectionStates0,
- session = Session0,
- private_key = Key} = State0) ->
- try ssl_handshake:decrypt_premaster_secret(EncPMS, Key) of
- PremasterSecret ->
- case ssl_handshake:master_secret(Version, PremasterSecret,
- ConnectionStates0, server) of
- {MasterSecret, ConnectionStates} ->
- Session = Session0#session{master_secret = MasterSecret},
- State1 = State0#state{connection_states = ConnectionStates,
- session = Session},
- {Record, State} = next_record(State1),
- next_state(cipher, Record, State);
- #alert{} = Alert ->
- handle_own_alert(Alert, Version,
- certify_client_key_exchange, State0),
- {stop, normal, State0}
- end
+certify(#client_key_exchange{exchange_keys = Keys},
+ State = #state{key_algorithm = KeyAlg, negotiated_version = Version}) ->
+ try
+ certify_client_key_exchange(ssl_handshake:decode_client_key(Keys, KeyAlg, Version), State)
catch
#alert{} = Alert ->
- handle_own_alert(Alert, Version, certify_client_key_exchange,
- State0),
+ handle_own_alert(Alert, Version, certify_client_key_exchange, State),
+ {stop, normal, State}
+ end;
+
+certify(Msg, State) ->
+ handle_unexpected_message(Msg, certify, State).
+
+certify_client_key_exchange(#encrypted_premaster_secret{premaster_secret= EncPMS},
+ #state{negotiated_version = Version,
+ connection_states = ConnectionStates0,
+ session = Session0,
+ private_key = Key} = State0) ->
+ PremasterSecret = ssl_handshake:decrypt_premaster_secret(EncPMS, Key),
+ case ssl_handshake:master_secret(Version, PremasterSecret,
+ ConnectionStates0, server) of
+ {MasterSecret, ConnectionStates} ->
+ Session = Session0#session{master_secret = MasterSecret},
+ State1 = State0#state{connection_states = ConnectionStates,
+ session = Session},
+ {Record, State} = next_record(State1),
+ next_state(cipher, Record, State);
+ #alert{} = Alert ->
+ handle_own_alert(Alert, Version,
+ certify_client_key_exchange, State0),
{stop, normal, State0}
end;
-certify(#client_key_exchange{exchange_keys = #client_diffie_hellman_public{
- dh_public = ClientPublicDhKey}},
- #state{negotiated_version = Version,
- diffie_hellman_params = #'DHParameter'{prime = P,
- base = G},
- diffie_hellman_keys = {_, ServerDhPrivateKey},
- role = Role,
- session = Session,
- connection_states = ConnectionStates0} = State0) ->
-
+certify_client_key_exchange(#client_diffie_hellman_public{dh_public = ClientPublicDhKey},
+ #state{negotiated_version = Version,
+ diffie_hellman_params = #'DHParameter'{prime = P,
+ base = G},
+ diffie_hellman_keys = {_, ServerDhPrivateKey},
+ role = Role,
+ session = Session,
+ connection_states = ConnectionStates0} = State0) ->
+
PMpint = crypto:mpint(P),
GMpint = crypto:mpint(G),
PremasterSecret = crypto:dh_compute_key(mpint_binary(ClientPublicDhKey),
ServerDhPrivateKey,
[PMpint, GMpint]),
-
+
case ssl_handshake:master_secret(Version, PremasterSecret,
ConnectionStates0, Role) of
{MasterSecret, ConnectionStates} ->
State1 = State0#state{session =
- Session#session{master_secret
- = MasterSecret},
- connection_states = ConnectionStates},
+ Session#session{master_secret
+ = MasterSecret},
+ connection_states = ConnectionStates},
{Record, State} = next_record(State1),
next_state(cipher, Record, State);
@@ -638,10 +639,7 @@ certify(#client_key_exchange{exchange_keys = #client_diffie_hellman_public{
handle_own_alert(Alert, Version,
certify_client_key_exchange, State0),
{stop, normal, State0}
- end;
-
-certify(Msg, State) ->
- handle_unexpected_message(Msg, certify, State).
+ end.
%%--------------------------------------------------------------------
-spec cipher(#hello_request{} | #certificate_verify{} | #finished{} | term(),
@@ -701,14 +699,13 @@ connection(#hello_request{}, #state{host = Host, port = Port,
socket = Socket,
ssl_options = SslOpts,
negotiated_version = Version,
- own_cert = Cert,
transport_cb = Transport,
connection_states = ConnectionStates0,
renegotiation = {Renegotiation, _},
tls_handshake_hashes = Hashes0} = State0) ->
- Hello = ssl_handshake:client_hello(Host, Port,
- ConnectionStates0, SslOpts, Cert, Renegotiation),
+ Hello = ssl_handshake:client_hello(Host, Port, ConnectionStates0,
+ SslOpts, Renegotiation),
{BinMsg, ConnectionStates1, Hashes1} =
encode_handshake(Hello, Version, ConnectionStates0, Hashes0),
@@ -1638,8 +1635,6 @@ application_data(Data, #state{user_application = {_Mon, Pid},
true -> <<Buffer0/binary, Data/binary>>
end,
case get_data(SOpts, BytesToRead, Buffer1) of
- {ok, <<>>, Buffer} -> % no reply, we need more data
- next_record(State0#state{user_data_buffer = Buffer});
{ok, ClientData, Buffer} -> % Send data
SocketOpt = deliver_app_data(SOpts, ClientData, Pid, From),
State = State0#state{user_data_buffer = Buffer,
@@ -1655,12 +1650,16 @@ application_data(Data, #state{user_application = {_Mon, Pid},
true -> %% We have more data
application_data(<<>>, State)
end;
+ {more, Buffer} -> % no reply, we need more data
+ next_record(State0#state{user_data_buffer = Buffer});
{error,_Reason} -> %% Invalid packet in packet mode
deliver_packet_error(SOpts, Buffer1, Pid, From),
{stop, normal, State0}
end.
%% Picks ClientData
+get_data(_, _, <<>>) ->
+ {more, <<>>};
get_data(#socket_options{active=Active, packet=Raw}, BytesToRead, Buffer)
when Raw =:= raw; Raw =:= 0 -> %% Raw Mode
if
@@ -1673,13 +1672,13 @@ get_data(#socket_options{active=Active, packet=Raw}, BytesToRead, Buffer)
{ok, Data, Rest};
true ->
%% Passive Mode not enough data
- {ok, <<>>, Buffer}
+ {more, Buffer}
end;
get_data(#socket_options{packet=Type, packet_size=Size}, _, Buffer) ->
PacketOpts = [{packet_size, Size}],
case decode_packet(Type, Buffer, PacketOpts) of
{more, _} ->
- {ok, <<>>, Buffer};
+ {more, Buffer};
Decoded ->
Decoded
end.
@@ -1794,9 +1793,7 @@ next_state(Next, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, State) ->
handle_alerts(Alerts, {next_state, Next, State});
next_state(StateName, #ssl_tls{type = ?HANDSHAKE, fragment = Data},
- State0 = #state{key_algorithm = KeyAlg,
- tls_handshake_buffer = Buf0,
- negotiated_version = Version}) ->
+ State0 = #state{tls_handshake_buffer = Buf0, negotiated_version = Version}) ->
Handle =
fun({#hello_request{} = Packet, _}, {next_state, connection = SName, State}) ->
%% This message should not be included in handshake
@@ -1819,7 +1816,7 @@ next_state(StateName, #ssl_tls{type = ?HANDSHAKE, fragment = Data},
(_, StopState) -> StopState
end,
try
- {Packets, Buf} = ssl_handshake:get_tls_handshake(Data,Buf0, KeyAlg,Version),
+ {Packets, Buf} = ssl_handshake:get_tls_handshake(Data,Buf0),
State = State0#state{tls_packets = Packets, tls_handshake_buffer = Buf},
handle_tls_handshake(Handle, StateName, State)
catch throw:#alert{} = Alert ->
@@ -1831,7 +1828,7 @@ next_state(StateName, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, State
case application_data(Data, State0) of
Stop = {stop,_,_} ->
Stop;
- {Record, State} ->
+ {Record, State} ->
next_state(StateName, Record, State)
end;
next_state(StateName, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = <<1>>} =
diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl
index 3d831eae02..add5147fb4 100644
--- a/lib/ssl/src/ssl_handshake.erl
+++ b/lib/ssl/src/ssl_handshake.erl
@@ -31,13 +31,13 @@
-include("ssl_debug.hrl").
-include_lib("public_key/include/public_key.hrl").
--export([master_secret/4, client_hello/6, server_hello/4, hello/4,
+-export([master_secret/4, client_hello/5, server_hello/4, hello/4,
hello_request/0, certify/7, certificate/3,
client_certificate_verify/6,
certificate_verify/6, certificate_request/2,
key_exchange/2, server_key_exchange_hash/2, finished/4,
verify_connection/5,
- get_tls_handshake/4,
+ get_tls_handshake/2, decode_client_key/3,
server_hello_done/0, sig_alg/1,
encode_handshake/3, init_hashes/0,
update_hashes/2, decrypt_premaster_secret/2]).
@@ -52,13 +52,13 @@
%%====================================================================
%%--------------------------------------------------------------------
-spec client_hello(host(), port_num(), #connection_states{},
- #ssl_options{}, binary(), boolean()) -> #client_hello{}.
+ #ssl_options{}, boolean()) -> #client_hello{}.
%%
%% Description: Creates a client hello message.
%%--------------------------------------------------------------------
client_hello(Host, Port, ConnectionStates, #ssl_options{versions = Versions,
ciphers = UserSuites}
- = SslOpts, Cert, Renegotiation) ->
+ = SslOpts, Renegotiation) ->
Fun = fun(Version) ->
ssl_record:protocol_version(Version)
@@ -203,18 +203,15 @@ certify(#certificate{asn1_certificates = ASN1Certs}, CertDbRef,
end
end,
try
- %% Allow missing root_cert and check that with VerifyFun
- ssl_certificate:trusted_cert_and_path(ASN1Certs, CertDbRef, false) of
- {TrustedErlCert, CertPath, VerifyErrors} ->
+ ssl_certificate:trusted_cert_and_path(ASN1Certs, CertDbRef) of
+ {TrustedErlCert, CertPath} ->
Result = public_key:pkix_path_validation(TrustedErlCert,
CertPath,
[{max_path_length,
MaxPathLen},
{verify, VerifyBool},
{validate_extensions_fun,
- ValidateExtensionFun},
- {acc_errors,
- VerifyErrors}]),
+ ValidateExtensionFun}]),
case Result of
{error, Reason} ->
path_validation_alert(Reason, Verify);
@@ -461,29 +458,36 @@ encode_handshake(Package, Version, KeyAlg) ->
[MsgType, ?uint24(Len), Bin].
%%--------------------------------------------------------------------
--spec get_tls_handshake(binary(), binary() | iolist(), key_algo(), tls_version()) ->
+-spec get_tls_handshake(binary(), binary() | iolist()) ->
{[tls_handshake()], binary()}.
%%
%% Description: Given buffered and new data from ssl_record, collects
%% and returns it as a list of handshake messages, also returns leftover
%% data.
%%--------------------------------------------------------------------
-get_tls_handshake(Data, <<>>, KeyAlg, Version) ->
- get_tls_handshake_aux(Data, KeyAlg, Version, []);
-get_tls_handshake(Data, Buffer, KeyAlg, Version) ->
- get_tls_handshake_aux(list_to_binary([Buffer, Data]),
- KeyAlg, Version, []).
+get_tls_handshake(Data, <<>>) ->
+ get_tls_handshake_aux(Data, []);
+get_tls_handshake(Data, Buffer) ->
+ get_tls_handshake_aux(list_to_binary([Buffer, Data]), []).
+
+%%--------------------------------------------------------------------
+-spec decode_client_key(binary(), key_algo(), tls_version()) ->
+ #encrypted_premaster_secret{} | #client_diffie_hellman_public{}.
+%%
+%% Description: Decode client_key data and return appropriate type
+%%--------------------------------------------------------------------
+decode_client_key(ClientKey, Type, Version) ->
+ dec_client_key(ClientKey, key_exchange_alg(Type), Version).
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
get_tls_handshake_aux(<<?BYTE(Type), ?UINT24(Length),
- Body:Length/binary,Rest/binary>>, KeyAlg,
- Version, Acc) ->
+ Body:Length/binary,Rest/binary>>, Acc) ->
Raw = <<?BYTE(Type), ?UINT24(Length), Body/binary>>,
- H = dec_hs(Type, Body, key_exchange_alg(KeyAlg), Version),
- get_tls_handshake_aux(Rest, KeyAlg, Version, [{H,Raw} | Acc]);
-get_tls_handshake_aux(Data, _KeyAlg, _Version, Acc) ->
+ H = dec_hs(Type, Body),
+ get_tls_handshake_aux(Rest, [{H,Raw} | Acc]);
+get_tls_handshake_aux(Data, Acc) ->
{lists:reverse(Acc), Data}.
verify_bool(verify_peer) ->
@@ -503,6 +507,8 @@ path_validation_alert({bad_cert, unknown_critical_extension}, _) ->
?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE);
path_validation_alert({bad_cert, cert_revoked}, _) ->
?ALERT_REC(?FATAL, ?CERTIFICATE_REVOKED);
+path_validation_alert({bad_cert, unknown_ca}, _) ->
+ ?ALERT_REC(?FATAL, ?UNKNOWN_CA);
path_validation_alert(_, _) ->
?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE).
@@ -729,7 +735,7 @@ master_secret(Version, MasterSecret, #security_parameters{
ServerCipherState, Role)}.
-dec_hs(?HELLO_REQUEST, <<>>, _, _) ->
+dec_hs(?HELLO_REQUEST, <<>>) ->
#hello_request{};
%% Client hello v2.
@@ -739,8 +745,7 @@ dec_hs(?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor),
?UINT16(CSLength), ?UINT16(0),
?UINT16(CDLength),
CipherSuites:CSLength/binary,
- ChallengeData:CDLength/binary>>,
- _, _) ->
+ ChallengeData:CDLength/binary>>) ->
?DBG_HEX(CipherSuites),
?DBG_HEX(CipherSuites),
#client_hello{client_version = {Major, Minor},
@@ -754,8 +759,7 @@ dec_hs(?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary,
?BYTE(SID_length), Session_ID:SID_length/binary,
?UINT16(Cs_length), CipherSuites:Cs_length/binary,
?BYTE(Cm_length), Comp_methods:Cm_length/binary,
- Extensions/binary>>,
- _, _) ->
+ Extensions/binary>>) ->
RenegotiationInfo = proplists:get_value(renegotiation_info, dec_hello_extensions(Extensions),
undefined),
@@ -770,7 +774,7 @@ dec_hs(?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary,
dec_hs(?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary,
?BYTE(SID_length), Session_ID:SID_length/binary,
- Cipher_suite:2/binary, ?BYTE(Comp_method)>>, _, _) ->
+ Cipher_suite:2/binary, ?BYTE(Comp_method)>>) ->
#server_hello{
server_version = {Major,Minor},
random = Random,
@@ -782,7 +786,7 @@ dec_hs(?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary,
dec_hs(?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary,
?BYTE(SID_length), Session_ID:SID_length/binary,
Cipher_suite:2/binary, ?BYTE(Comp_method),
- ?UINT16(ExtLen), Extensions:ExtLen/binary>>, _, _) ->
+ ?UINT16(ExtLen), Extensions:ExtLen/binary>>) ->
RenegotiationInfo = proplists:get_value(renegotiation_info, dec_hello_extensions(Extensions, []),
undefined),
@@ -793,44 +797,42 @@ dec_hs(?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary,
cipher_suite = Cipher_suite,
compression_method = Comp_method,
renegotiation_info = RenegotiationInfo};
-dec_hs(?CERTIFICATE, <<?UINT24(ACLen), ASN1Certs:ACLen/binary>>, _, _) ->
+dec_hs(?CERTIFICATE, <<?UINT24(ACLen), ASN1Certs:ACLen/binary>>) ->
#certificate{asn1_certificates = certs_to_list(ASN1Certs)};
dec_hs(?SERVER_KEY_EXCHANGE, <<?UINT16(PLen), P:PLen/binary,
?UINT16(GLen), G:GLen/binary,
?UINT16(YLen), Y:YLen/binary,
- ?UINT16(Len), Sig:Len/binary>>,
- ?KEY_EXCHANGE_DIFFIE_HELLMAN, _) ->
+ ?UINT16(Len), Sig:Len/binary>>) ->
#server_key_exchange{params = #server_dh_params{dh_p = P,dh_g = G,
dh_y = Y},
signed_params = Sig};
dec_hs(?CERTIFICATE_REQUEST,
<<?BYTE(CertTypesLen), CertTypes:CertTypesLen/binary,
- ?UINT16(CertAuthsLen), CertAuths:CertAuthsLen/binary>>, _, _) ->
+ ?UINT16(CertAuthsLen), CertAuths:CertAuthsLen/binary>>) ->
#certificate_request{certificate_types = CertTypes,
certificate_authorities = CertAuths};
-dec_hs(?SERVER_HELLO_DONE, <<>>, _, _) ->
+dec_hs(?SERVER_HELLO_DONE, <<>>) ->
#server_hello_done{};
-dec_hs(?CERTIFICATE_VERIFY,<<?UINT16(_), Signature/binary>>, _, _)->
+dec_hs(?CERTIFICATE_VERIFY,<<?UINT16(_), Signature/binary>>)->
#certificate_verify{signature = Signature};
-dec_hs(?CLIENT_KEY_EXCHANGE, PKEPMS, ?KEY_EXCHANGE_RSA, {3, 0}) ->
- PreSecret = #encrypted_premaster_secret{premaster_secret = PKEPMS},
- #client_key_exchange{exchange_keys = PreSecret};
-dec_hs(?CLIENT_KEY_EXCHANGE, <<?UINT16(_), PKEPMS/binary>>,
- ?KEY_EXCHANGE_RSA, _) ->
- PreSecret = #encrypted_premaster_secret{premaster_secret = PKEPMS},
- #client_key_exchange{exchange_keys = PreSecret};
-dec_hs(?CLIENT_KEY_EXCHANGE, <<>>, ?KEY_EXCHANGE_DIFFIE_HELLMAN, _) ->
- throw(?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE));
-dec_hs(?CLIENT_KEY_EXCHANGE, <<?UINT16(DH_YLen), DH_Y:DH_YLen/binary>>,
- ?KEY_EXCHANGE_DIFFIE_HELLMAN, _) ->
- #client_key_exchange{exchange_keys =
- #client_diffie_hellman_public{dh_public = DH_Y}};
-dec_hs(?FINISHED, VerifyData, _, _) ->
+dec_hs(?CLIENT_KEY_EXCHANGE, PKEPMS) ->
+ #client_key_exchange{exchange_keys = PKEPMS};
+dec_hs(?FINISHED, VerifyData) ->
#finished{verify_data = VerifyData};
-dec_hs(_, _, _, _) ->
+dec_hs(_, _) ->
throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE)).
+dec_client_key(PKEPMS, ?KEY_EXCHANGE_RSA, {3, 0}) ->
+ #encrypted_premaster_secret{premaster_secret = PKEPMS};
+dec_client_key(<<?UINT16(_), PKEPMS/binary>>, ?KEY_EXCHANGE_RSA, _) ->
+ #encrypted_premaster_secret{premaster_secret = PKEPMS};
+dec_client_key(<<>>, ?KEY_EXCHANGE_DIFFIE_HELLMAN, _) ->
+ throw(?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE));
+dec_client_key(<<?UINT16(DH_YLen), DH_Y:DH_YLen/binary>>,
+ ?KEY_EXCHANGE_DIFFIE_HELLMAN, _) ->
+ #client_diffie_hellman_public{dh_public = DH_Y}.
+
dec_hello_extensions(<<>>) ->
[];
dec_hello_extensions(<<?UINT16(ExtLen), Extensions:ExtLen/binary>>) ->
@@ -1126,7 +1128,7 @@ sig_alg(_) ->
key_exchange_alg(rsa) ->
?KEY_EXCHANGE_RSA;
key_exchange_alg(Alg) when Alg == dhe_rsa; Alg == dhe_dss;
- Alg == dh_dss; Alg == dh_rsa; Alg == dh_anon ->
+ Alg == dh_dss; Alg == dh_rsa ->
?KEY_EXCHANGE_DIFFIE_HELLMAN;
key_exchange_alg(_) ->
?NULL.
diff --git a/lib/ssl/test/erl_make_certs.erl b/lib/ssl/test/erl_make_certs.erl
index c9db0d3851..f8aef55754 100644
--- a/lib/ssl/test/erl_make_certs.erl
+++ b/lib/ssl/test/erl_make_certs.erl
@@ -66,9 +66,9 @@ make_cert(Opts) ->
%% @end
%%--------------------------------------------------------------------
write_pem(Dir, FileName, {Cert, Key = {_,_,not_encrypted}}) when is_binary(Cert) ->
- ok = ssl_test_lib:der_to_pem(filename:join(Dir, FileName ++ ".pem"),
+ ok = der_to_pem(filename:join(Dir, FileName ++ ".pem"),
[{'Certificate', Cert, not_encrypted}]),
- ok = ssl_test_lib:der_to_pem(filename:join(Dir, FileName ++ "_key.pem"), [Key]).
+ ok = der_to_pem(filename:join(Dir, FileName ++ "_key.pem"), [Key]).
%%--------------------------------------------------------------------
%% @doc Creates a rsa key (OBS: for testing only)
@@ -144,34 +144,39 @@ encode_key(Key = #'DSAPrivateKey'{}) ->
make_tbs(SubjectKey, Opts) ->
Version = list_to_atom("v"++integer_to_list(proplists:get_value(version, Opts, 3))),
- {Issuer, IssuerKey} = issuer(Opts, SubjectKey),
+
+ IssuerProp = proplists:get_value(issuer, Opts, true),
+ {Issuer, IssuerKey} = issuer(IssuerProp, Opts, SubjectKey),
{Algo, Parameters} = sign_algorithm(IssuerKey, Opts),
SignAlgo = #'SignatureAlgorithm'{algorithm = Algo,
parameters = Parameters},
-
+ Subject = case IssuerProp of
+ true -> %% Is a Root Ca
+ Issuer;
+ _ ->
+ subject(proplists:get_value(subject, Opts),false)
+ end,
+
{#'OTPTBSCertificate'{serialNumber = trunc(random:uniform()*100000000)*10000 + 1,
signature = SignAlgo,
issuer = Issuer,
validity = validity(Opts),
- subject = subject(proplists:get_value(subject, Opts),false),
+ subject = Subject,
subjectPublicKeyInfo = publickey(SubjectKey),
version = Version,
extensions = extensions(Opts)
}, IssuerKey}.
-issuer(Opts, SubjectKey) ->
- IssuerProp = proplists:get_value(issuer, Opts, true),
- case IssuerProp of
- true -> %% Self signed
- {subject(proplists:get_value(subject, Opts), true), SubjectKey};
- {Issuer, IssuerKey} when is_binary(Issuer) ->
- {issuer_der(Issuer), decode_key(IssuerKey)};
- {File, IssuerKey} when is_list(File) ->
- {ok, [{cert, Cert, _}|_]} = public_key:pem_to_der(File),
- {issuer_der(Cert), decode_key(IssuerKey)}
- end.
+issuer(true, Opts, SubjectKey) ->
+ %% Self signed
+ {subject(proplists:get_value(subject, Opts), true), SubjectKey};
+issuer({Issuer, IssuerKey}, _Opts, _SubjectKey) when is_binary(Issuer) ->
+ {issuer_der(Issuer), decode_key(IssuerKey)};
+issuer({File, IssuerKey}, _Opts, _SubjectKey) when is_list(File) ->
+ {ok, [{cert, Cert, _}|_]} = public_key:pem_to_der(File),
+ {issuer_der(Cert), decode_key(IssuerKey)}.
issuer_der(Issuer) ->
Decoded = public_key:pkix_decode_cert(Issuer, otp),
@@ -179,8 +184,8 @@ issuer_der(Issuer) ->
#'OTPTBSCertificate'{subject=Subject} = Tbs,
Subject.
-subject(undefined, IsCA) ->
- User = if IsCA -> "CA"; true -> os:getenv("USER") end,
+subject(undefined, IsRootCA) ->
+ User = if IsRootCA -> "RootCA"; true -> os:getenv("USER") end,
Opts = [{email, User ++ "@erlang.org"},
{name, User},
{city, "Stockholm"},
@@ -267,7 +272,7 @@ publickey(#'DSAPrivateKey'{p=P, q=Q, g=G, y=Y}) ->
#'OTPSubjectPublicKeyInfo'{algorithm = Algo, subjectPublicKey = Y}.
validity(Opts) ->
- DefFrom0 = date(),
+ DefFrom0 = calendar:gregorian_days_to_date(calendar:date_to_gregorian_days(date())-1),
DefTo0 = calendar:gregorian_days_to_date(calendar:date_to_gregorian_days(date())+7),
{DefFrom, DefTo} = proplists:get_value(validity, Opts, {DefFrom0, DefTo0}),
Format = fun({Y,M,D}) -> lists:flatten(io_lib:format("~w~2..0w~2..0w000000Z",[Y,M,D])) end,
@@ -406,3 +411,11 @@ extended_gcd(A, B) ->
{X, Y} = extended_gcd(B, N),
{Y, X-Y*(A div B)}
end.
+
+pem_to_der(File) ->
+ {ok, PemBin} = file:read_file(File),
+ public_key:pem_decode(PemBin).
+
+der_to_pem(File, Entries) ->
+ PemBin = public_key:pem_encode(Entries),
+ file:write_file(File, PemBin).
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index 53142250e8..d50b34b6ac 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -7,7 +7,7 @@
%% 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/.
+%% retrieved online at http://www.erlang.org/.2
%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
@@ -234,7 +234,8 @@ all(suite) ->
server_no_wrap_sequence_number, extended_key_usage,
validate_extensions_fun, no_authority_key_identifier,
invalid_signature_client, invalid_signature_server, cert_expired,
- client_with_cert_cipher_suites_handshake
+ client_with_cert_cipher_suites_handshake, unknown_server_ca_fail,
+ unknown_server_ca_accept
].
%% Test cases starts here.
@@ -1553,25 +1554,26 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) ->
process_flag(trap_exit, true),
test_server:format("Testing CipherSuite ~p~n", [CipherSuite]),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+
+ ErlangCipherSuite = erlang_cipher_suite(CipherSuite),
+
+ ConnectionInfo = {ok, {Version, ErlangCipherSuite}},
+
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
{from, self()},
- {mfa, {?MODULE, connection_info_result, []}},
+ {mfa, {ssl_test_lib, cipher_result, [ConnectionInfo]}},
{options, ServerOpts}]),
Port = ssl_test_lib:inet_port(Server),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
{from, self()},
- {mfa, {?MODULE, connection_info_result, []}},
+ {mfa, {ssl_test_lib, cipher_result, [ConnectionInfo]}},
{options,
[{ciphers,[CipherSuite]} |
ClientOpts]}]),
-
- ErlangCipherSuite = erlang_cipher_suite(CipherSuite),
-
- ServerMsg = ClientMsg = {ok, {Version, ErlangCipherSuite}},
-
- Result = ssl_test_lib:wait_for_result(Server, ServerMsg,
- Client, ClientMsg),
+
+ Result = ssl_test_lib:wait_for_result(Server, ok, Client, ok),
+
ssl_test_lib:close(Server),
receive
{'EXIT', Server, normal} ->
@@ -2612,12 +2614,13 @@ validate_extensions_fun(Config) when is_list(Config) ->
%%--------------------------------------------------------------------
no_authority_key_identifier(doc) ->
- ["Test cert that does not have authorityKeyIdentifier extension"];
+ ["Test cert that does not have authorityKeyIdentifier extension"
+ " but are present in trusted certs db."];
no_authority_key_identifier(suite) ->
[];
no_authority_key_identifier(Config) when is_list(Config) ->
- ClientOpts = ?config(client_opts, Config),
+ ClientOpts = ?config(client_verification_opts, Config),
ServerOpts = ?config(server_opts, Config),
PrivDir = ?config(priv_dir, Config),
@@ -2675,7 +2678,7 @@ invalid_signature_server(suite) ->
[];
invalid_signature_server(Config) when is_list(Config) ->
- ClientOpts = ?config(client_opts, Config),
+ ClientOpts = ?config(client_verification_opts, Config),
ServerOpts = ?config(server_verification_opts, Config),
PrivDir = ?config(priv_dir, Config),
@@ -2792,7 +2795,7 @@ cert_expired(suite) ->
[];
cert_expired(Config) when is_list(Config) ->
- ClientOpts = ?config(client_opts, Config),
+ ClientOpts = ?config(client_verification_opts, Config),
ServerOpts = ?config(server_verification_opts, Config),
PrivDir = ?config(priv_dir, Config),
@@ -2881,6 +2884,59 @@ client_with_cert_cipher_suites_handshake(Config) when is_list(Config) ->
ssl_test_lib:check_result(Server, ok, Client, ok),
ssl_test_lib:close(Server),
ssl_test_lib:close(Client).
+%%--------------------------------------------------------------------
+unknown_server_ca_fail(doc) ->
+ ["Test that the client fails if the ca is unknown in verify_peer mode"];
+unknown_server_ca_fail(suite) ->
+ [];
+unknown_server_ca_fail(Config) when is_list(Config) ->
+ ClientOpts = ?config(client_opts, Config),
+ ServerOpts = ?config(server_opts, Config),
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+ Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {ssl_test_lib,
+ no_result, []}},
+ {options, ServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server),
+ Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {ssl_test_lib,
+ no_result, []}},
+ {options,
+ [{verify, verify_peer}| ClientOpts]}]),
+
+ ssl_test_lib:check_result(Server, {error,"unknown ca"}, Client, {error, "unknown ca"}),
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close(Client).
+
+%%--------------------------------------------------------------------
+unknown_server_ca_accept(doc) ->
+ ["Test that the client succeds if the ca is unknown in verify_none mode"];
+unknown_server_ca_accept(suite) ->
+ [];
+unknown_server_ca_accept(Config) when is_list(Config) ->
+ ClientOpts = ?config(client_opts, Config),
+ ServerOpts = ?config(server_opts, Config),
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {?MODULE,
+ send_recv_result_active, []}},
+ {options, ServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server),
+ Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE,
+ send_recv_result_active, []}},
+ {options,
+ [{verify, verify_none}| ClientOpts]}]),
+
+ ssl_test_lib:check_result(Server, ok, Client, ok),
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close(Client).
%%--------------------------------------------------------------------
%%% Internal functions
@@ -2907,6 +2963,7 @@ send_recv_result_active_once(Socket) ->
result_ok(_Socket) ->
ok.
+
renegotiate(Socket, Data) ->
test_server:format("Renegotiating ~n", []),
Result = ssl:renegotiate(Socket),
diff --git a/lib/ssl/test/ssl_packet_SUITE.erl b/lib/ssl/test/ssl_packet_SUITE.erl
index 9553241ad4..1e7cde1c25 100644
--- a/lib/ssl/test/ssl_packet_SUITE.erl
+++ b/lib/ssl/test/ssl_packet_SUITE.erl
@@ -2196,21 +2196,29 @@ header_decode_two_bytes_one_sent(Config) when is_list(Config) ->
%%--------------------------------------------------------------------
%% Internal functions
-send_raw(_,_, 0) ->
+send_raw(Socket,_, 0) ->
+ ssl:send(Socket, <<>>),
no_result_msg;
send_raw(Socket, Data, N) ->
ssl:send(Socket, Data),
send_raw(Socket, Data, N-1).
-passive_raw(_, _, 0) ->
+passive_raw(Socket, _, 0) ->
+ {error, timeout} = ssl:recv(Socket, 0, 500),
ok;
passive_raw(Socket, Data, N) ->
Length = length(Data),
{ok, Data} = ssl:recv(Socket, Length),
passive_raw(Socket, Data, N-1).
-passive_recv_packet(_, _, 0) ->
- ok;
+passive_recv_packet(Socket, _, 0) ->
+ case ssl:recv(Socket, 0) of
+ {ok, []} ->
+ {error, timeout} = ssl:recv(Socket, 0, 500),
+ ok;
+ Other ->
+ {other, Other, ssl:session_info(Socket), 0}
+ end;
passive_recv_packet(Socket, Data, N) ->
case ssl:recv(Socket, 0) of
{ok, Data} ->
@@ -2219,7 +2227,8 @@ passive_recv_packet(Socket, Data, N) ->
{other, Other, ssl:session_info(Socket), N}
end.
-send(_,_, 0) ->
+send(Socket,_, 0) ->
+ ssl:send(Socket, <<>>),
no_result_msg;
send(Socket, Data, N) ->
case ssl:send(Socket, [Data]) of
@@ -2233,6 +2242,7 @@ send_incomplete(Socket, Data, N) ->
send_incomplete(Socket, Data, N, <<>>).
send_incomplete(Socket, _Data, 0, Prev) ->
ssl:send(Socket, Prev),
+ ssl:send(Socket, [?uint32(0)]),
no_result_msg;
send_incomplete(Socket, Data, N, Prev) ->
Length = size(Data),
@@ -2261,8 +2271,13 @@ active_once_raw(Socket, Data, N, Acc) ->
end
end.
-active_once_packet(_,_, 0) ->
- ok;
+active_once_packet(Socket,_, 0) ->
+ receive
+ {ssl, Socket, []} ->
+ ok;
+ {ssl, Socket, Other} ->
+ {other, Other, ssl:session_info(Socket), 0}
+ end;
active_once_packet(Socket, Data, N) ->
receive
{ssl, Socket, Data} ->
@@ -2274,7 +2289,7 @@ active_once_packet(Socket, Data, N) ->
active_raw(Socket, Data, N) ->
active_raw(Socket, Data, N, []).
-active_raw(_, _, 0, _) ->
+active_raw(_Socket, _, 0, _) ->
ok;
active_raw(Socket, Data, N, Acc) ->
receive
@@ -2289,8 +2304,13 @@ active_raw(Socket, Data, N, Acc) ->
end
end.
-active_packet(_, _, 0) ->
- ok;
+active_packet(Socket, _, 0) ->
+ receive
+ {ssl, Socket, []} ->
+ ok;
+ Other ->
+ {other, Other, ssl:session_info(Socket), 0}
+ end;
active_packet(Socket, Data, N) ->
receive
{ssl, Socket, Data} ->
diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl
index c7ff015034..ce164f7e4c 100644
--- a/lib/ssl/test/ssl_test_lib.erl
+++ b/lib/ssl/test/ssl_test_lib.erl
@@ -332,7 +332,7 @@ make_dsa_cert(Config) ->
{cacertfile, ServerCaCertFile},
{certfile, ServerCertFile}, {keyfile, ServerKeyFile}]},
{server_dsa_verify_opts, [{ssl_imp, new},{reuseaddr, true},
- {cacertfile, ServerCaCertFile},
+ {cacertfile, ClientCaCertFile},
{certfile, ServerCertFile}, {keyfile, ServerKeyFile},
{verify, verify_peer}]},
{client_dsa_opts, [{ssl_imp, new},{reuseaddr, true},
@@ -623,3 +623,20 @@ pem_to_der(File) ->
der_to_pem(File, Entries) ->
PemBin = public_key:pem_encode(Entries),
file:write_file(File, PemBin).
+
+cipher_result(Socket, Result) ->
+ Result = ssl:connection_info(Socket),
+ test_server:format("Successfull connect: ~p~n", [Result]),
+ %% Importante to send two packets here
+ %% to properly test "cipher state" handling
+ ssl:send(Socket, "Hello\n"),
+ receive
+ {ssl, Socket, "Hello\n"} ->
+ ssl:send(Socket, " world\n"),
+ receive
+ {ssl, Socket, " world\n"} ->
+ ok
+ end;
+ Other ->
+ {unexpected, Other}
+ end.
diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl
index 75cfce0052..7f512f2ab9 100644
--- a/lib/ssl/test/ssl_to_openssl_SUITE.erl
+++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl
@@ -1136,17 +1136,31 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) ->
wait_for_openssl_server(),
+ ConnectionInfo = {ok, {Version, CipherSuite}},
+
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
{from, self()},
- {mfa, {?MODULE, connection_info_result, []}},
+ {mfa, {ssl_test_lib, cipher_result, [ConnectionInfo]}},
{options,
[{ciphers,[CipherSuite]} |
ClientOpts]}]),
-
- ClientMsg = {ok, {Version, CipherSuite}},
-
- Result = ssl_test_lib:wait_for_result(Client, ClientMsg),
+
+ port_command(OpenSslPort, "Hello\n"),
+
+ receive
+ {Port, {data, _}} when is_port(Port) ->
+ ok
+ after 500 ->
+ test_server:format("Time out on openssl port, check that"
+ " the messages Hello and world are received"
+ " during close of port" , []),
+ ok
+ end,
+
+ port_command(OpenSslPort, " world\n"),
+
+ Result = ssl_test_lib:wait_for_result(Client, ok),
close_port(OpenSslPort),
%% Clean close down!
diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk
index 6c40a4529c..709a089892 100644
--- a/lib/ssl/vsn.mk
+++ b/lib/ssl/vsn.mk
@@ -1,20 +1 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1999-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%
-#
-
SSL_VSN = 4.0.1
diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml
index 5df60a92e5..dd4a289c61 100644
--- a/lib/stdlib/doc/src/ets.xml
+++ b/lib/stdlib/doc/src/ets.xml
@@ -1385,6 +1385,28 @@ is_integer(X), is_integer(Y), X + Y < 4711]]></code>
</desc>
</func>
<func>
+ <name>select_count(Tab, MatchSpec) -> NumMatched</name>
+ <fsummary>Match the objects in an ETS table against a match_spec and returns the number of objects for which the match_spec returned 'true'</fsummary>
+ <type>
+ <v>Tab = tid() | atom()</v>
+ <v>Object = tuple()</v>
+ <v>MatchSpec = match_spec()</v>
+ <v>NumMatched = integer()</v>
+ </type>
+ <desc>
+ <p>Matches the objects in the table <c>Tab</c> using a
+ <seealso marker="#match_spec">match_spec</seealso>. If the
+ match_spec returns <c>true</c> for an object, that object
+ considered a match and is counted. For any other result from
+ the match_spec the object is not considered a match and is
+ therefore not counted.</p>
+ <p>The function could be described as a <c>match_delete/2</c>
+ that does not actually delete any elements, but only counts
+ them.</p>
+ <p>The function returns the number of objects matched.</p>
+ </desc>
+ </func>
+ <func>
<name>select_delete(Tab, MatchSpec) -> NumDeleted</name>
<fsummary>Match the objects in an ETS table against a match_spec and deletes objects where the match_spec returns 'true'</fsummary>
<type>
@@ -1411,25 +1433,82 @@ is_integer(X), is_integer(Y), X + Y < 4711]]></code>
</desc>
</func>
<func>
- <name>select_count(Tab, MatchSpec) -> NumMatched</name>
- <fsummary>Match the objects in an ETS table against a match_spec and returns the number of objects for which the match_spec returned 'true'</fsummary>
+ <name>select_reverse(Tab, MatchSpec) -> [Match]</name>
+ <fsummary>Match the objects in an ETS table against a match_spec.</fsummary>
<type>
<v>Tab = tid() | atom()</v>
- <v>Object = tuple()</v>
+ <v>Match = term()</v>
<v>MatchSpec = match_spec()</v>
- <v>NumMatched = integer()</v>
</type>
<desc>
- <p>Matches the objects in the table <c>Tab</c> using a
- <seealso marker="#match_spec">match_spec</seealso>. If the
- match_spec returns <c>true</c> for an object, that object
- considered a match and is counted. For any other result from
- the match_spec the object is not considered a match and is
- therefore not counted.</p>
- <p>The function could be described as a <c>match_delete/2</c>
- that does not actually delete any elements, but only counts
- them.</p>
- <p>The function returns the number of objects matched.</p>
+
+ <p>Works like <c>select/2</c>, but returns the list in reverse
+ order for the <c>ordered_set</c> table type. For all other table
+ types, the return value is identical to that of <c>select/2</c>.</p>
+
+ </desc>
+ </func>
+ <func>
+ <name>select_reverse(Tab, MatchSpec, Limit) -> {[Match],Continuation} | '$end_of_table'</name>
+ <fsummary>Match the objects in an ETS table against a match_spec and returns part of the answers.</fsummary>
+ <type>
+ <v>Tab = tid() | atom()</v>
+ <v>Match = term()</v>
+ <v>MatchSpec = match_spec()</v>
+ <v>Continuation = term()</v>
+ </type>
+ <desc>
+
+ <p>Works like <c>select/3</c>, but for the <c>ordered_set</c>
+ table type, traversing is done starting at the last object in
+ Erlang term order and moves towards the first. For all other
+ table types, the return value is identical to that of
+ <c>select/3</c>.</p>
+
+ <p>Note that this is <em>not</em> equivalent to
+ reversing the result list of a <c>select/3</c> call, as the result list
+ is not only reversed, but also contains the last <c>Limit</c>
+ matching objects in the table, not the first.</p>
+
+ </desc>
+ </func>
+ <func>
+ <name>select_reverse(Continuation) -> {[Match],Continuation} | '$end_of_table'</name>
+ <fsummary>Continue matching objects in an ETS table.</fsummary>
+ <type>
+ <v>Match = term()</v>
+ <v>Continuation = term()</v>
+ </type>
+ <desc>
+
+ <p>Continues a match started with
+ <c>ets:select_reverse/3</c>. If the table is an
+ <c>ordered_set</c>, the traversal of the table will continue
+ towards objects with keys earlier in the Erlang term order. The
+ returned list will also contain objects with keys in reverse
+ order.</p>
+
+ <p>For all other table types, the behaviour is exatly that of <c>select/1</c>.</p>
+ <p>Example:</p>
+ <code>
+1> T = ets:new(x,[ordered_set]).
+2> [ ets:insert(T,{N}) || N &lt;- lists:seq(1,10) ].
+...
+3> {R0,C0} = ets:select_reverse(T,[{'_',[],['$_']}],4).
+...
+4> R0.
+[{10},{9},{8},{7}]
+5> {R1,C1} = ets:select_reverse(C0).
+...
+6> R1.
+[{6},{5},{4},{3}]
+7> {R2,C2} = ets:select_reverse(C1).
+...
+8> R2.
+[{2},{1}]
+9> '$end_of_table' = ets:select_reverse(C2).
+...
+ </code>
</desc>
</func>
<func>
diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl
index 78b1de6e16..a249dea525 100644
--- a/lib/stdlib/src/ms_transform.erl
+++ b/lib/stdlib/src/ms_transform.erl
@@ -43,6 +43,7 @@
-define(ERR_GENREMOTECALL,22).
-define(ERR_GENBINCONSTRUCT,23).
-define(ERR_GENDISALLOWEDOP,24).
+-define(WARN_SHADOW_VAR,50).
-define(ERR_GUARDMATCH,?ERR_GENMATCH+?ERROR_BASE_GUARD).
-define(ERR_BODYMATCH,?ERR_GENMATCH+?ERROR_BASE_BODY).
-define(ERR_GUARDLOCALCALL,?ERR_GENLOCALCALL+?ERROR_BASE_GUARD).
@@ -63,8 +64,13 @@
-define(ERR_BODYDISALLOWEDOP,?ERR_GENDISALLOWEDOP+?ERROR_BASE_BODY).
%%
-%% Called by compiler or ets/dbg:fun2ms when errors occur
+%% Called by compiler or ets/dbg:fun2ms when errors/warnings occur
%%
+format_error({?WARN_SHADOW_VAR,Name}) ->
+ lists:flatten(
+ io_lib:format("variable ~p shadowed in ms_transform fun head",
+ [Name]));
+
format_error(?ERR_NOFUN) ->
"Parameter of ets/dbg:fun2ms/1 is not a literal fun";
format_error(?ERR_ETS_HEAD) ->
@@ -182,7 +188,7 @@ format_error(Else) ->
%%
transform_from_shell(Dialect, Clauses, BoundEnvironment) ->
SaveFilename = setup_filename(),
- case catch ms_clause_list(1,Clauses,Dialect) of
+ case catch ms_clause_list(1,Clauses,Dialect,gb_sets:new()) of
{'EXIT',Reason} ->
cleanup_filename(SaveFilename),
exit(Reason);
@@ -207,6 +213,7 @@ transform_from_shell(Dialect, Clauses, BoundEnvironment) ->
%%
parse_transform(Forms, _Options) ->
SaveFilename = setup_filename(),
+ %io:format("Forms: ~p~n",[Forms]),
case catch forms(Forms) of
{'EXIT',Reason} ->
cleanup_filename(SaveFilename),
@@ -215,12 +222,31 @@ parse_transform(Forms, _Options) ->
{error, [{cleanup_filename(SaveFilename),
[{Line, ?MODULE, R}]}], []};
Else ->
- cleanup_filename(SaveFilename),
+ %io:format("Transformed into: ~p~n",[Else]),
+ case get_warnings() of
+ [] ->
+ cleanup_filename(SaveFilename),
+ Else;
+ WL ->
+ FName = cleanup_filename(SaveFilename) ,
+ WList = [ {FName, [{L, ?MODULE, R}]} || {L,R} <- WL ],
+ {warning, Else, WList}
+ end
+ end.
+
+get_warnings() ->
+ case get(warnings) of
+ undefined ->
+ [];
+ Else ->
Else
end.
+add_warning(Line,R) ->
+ put(warnings,[{Line,R}| get_warnings()]).
+
setup_filename() ->
- {erase(filename),erase(records)}.
+ {erase(filename),erase(records),erase(warnings)}.
put_filename(Name) ->
put(filename,Name).
@@ -235,7 +261,7 @@ get_records() ->
Else ->
Else
end.
-cleanup_filename({Old,OldRec}) ->
+cleanup_filename({Old,OldRec,OldWarnings}) ->
Ret = case erase(filename) of
undefined ->
"TOP_LEVEL";
@@ -248,6 +274,12 @@ cleanup_filename({Old,OldRec}) ->
Rec ->
put(records,Rec)
end,
+ case OldWarnings of
+ undefined ->
+ erase(warnings);
+ Warn ->
+ put(warnings,Warn)
+ end,
case Old of
undefined ->
Ret;
@@ -285,42 +317,77 @@ form({function,Line,Name0,Arity0,Clauses0}) ->
form(AnyOther) ->
AnyOther.
function(Name, Arity, Clauses0) ->
- Clauses1 = clauses(Clauses0),
+ {Clauses1,_} = clauses(Clauses0,gb_sets:new()),
{Name,Arity,Clauses1}.
-clauses([C0|Cs]) ->
- C1 = clause(C0),
- [C1|clauses(Cs)];
-clauses([]) -> [].
-clause({clause,Line,H0,G0,B0}) ->
- B1 = copy(B0),
- {clause,Line,H0,G0,B1}.
+clauses([C0|Cs],Bound) ->
+ {C1,Bound1} = clause(C0,Bound),
+ {C2,Bound2} = clauses(Cs,Bound1),
+ {[C1|C2],Bound2};
+clauses([],Bound) -> {[],Bound}.
+clause({clause,Line,H0,G0,B0},Bound) ->
+ {H1,Bound1} = copy(H0,Bound),
+ {B1,Bound2} = copy(B0,Bound1),
+ {{clause,Line,H1,G0,B1},Bound2}.
copy({call,Line,{remote,_Line2,{atom,_Line3,ets},{atom,_Line4,fun2ms}},
- As0}) ->
- transform_call(ets,Line,As0);
+ As0},Bound) ->
+ {transform_call(ets,Line,As0,Bound),Bound};
copy({call,Line,{remote,_Line2,{record_field,_Line3,
{atom,_Line4,''},{atom,_Line5,ets}},
- {atom,_Line6,fun2ms}}, As0}) ->
+ {atom,_Line6,fun2ms}}, As0},Bound) ->
%% Packages...
- transform_call(ets,Line,As0);
+ {transform_call(ets,Line,As0,Bound),Bound};
copy({call,Line,{remote,_Line2,{atom,_Line3,dbg},{atom,_Line4,fun2ms}},
- As0}) ->
- transform_call(dbg,Line,As0);
-copy(T) when is_tuple(T) ->
- list_to_tuple(copy_list(tuple_to_list(T)));
-copy(L) when is_list(L) ->
- copy_list(L);
-copy(AnyOther) ->
- AnyOther.
+ As0},Bound) ->
+ {transform_call(dbg,Line,As0,Bound),Bound};
+copy({match,Line,A,B},Bound) ->
+ {B1,Bound1} = copy(B,Bound),
+ {A1,Bound2} = copy(A,Bound),
+ {{match,Line,A1,B1},gb_sets:union(Bound1,Bound2)};
+copy({var,_Line,'_'} = VarDef,Bound) ->
+ {VarDef,Bound};
+copy({var,_Line,Name} = VarDef,Bound) ->
+ Bound1 = gb_sets:add(Name,Bound),
+ {VarDef,Bound1};
+copy({'fun',Line,{clauses,Clauses}},Bound) -> % Dont export bindings from funs
+ {NewClauses,_IgnoredBindings} = copy_list(Clauses,Bound),
+ {{'fun',Line,{clauses,NewClauses}},Bound};
+copy({'case',Line,Of,ClausesList},Bound) -> % Dont export bindings from funs
+ {NewOf,NewBind0} = copy(Of,Bound),
+ {NewClausesList,NewBindings} = copy_case_clauses(ClausesList,NewBind0,[]),
+ {{'case',Line,NewOf,NewClausesList},NewBindings};
+copy(T,Bound) when is_tuple(T) ->
+ {L,Bound1} = copy_list(tuple_to_list(T),Bound),
+ {list_to_tuple(L),Bound1};
+copy(L,Bound) when is_list(L) ->
+ copy_list(L,Bound);
+copy(AnyOther,Bound) ->
+ {AnyOther,Bound}.
-copy_list([H|T]) ->
- [copy(H)|copy_list(T)];
-copy_list([]) ->
- [].
+copy_case_clauses([],Bound,AddSets) ->
+ ReallyAdded = gb_sets:intersection(AddSets),
+ {[],gb_sets:union(Bound,ReallyAdded)};
+copy_case_clauses([{clause,Line,Match,Guard,Clauses}|T],Bound,AddSets) ->
+ {NewMatch,MatchBinds} = copy(Match,Bound),
+ {NewGuard,GuardBinds} = copy(Guard,MatchBinds), %% Really no new binds
+ {NewClauses,AllBinds} = copy(Clauses,GuardBinds),
+ %% To limit the setsizes, I subtract what I had before the case clause
+ %% and add it in the end
+ AddedBinds = gb_sets:subtract(AllBinds,Bound),
+ {NewTail,ExportedBindings} =
+ copy_case_clauses(T,Bound,[AddedBinds | AddSets]),
+ {[{clause,Line,NewMatch,NewGuard,NewClauses}|NewTail],ExportedBindings}.
-transform_call(Type,_Line,[{'fun',Line2,{clauses, ClauseList}}]) ->
- ms_clause_list(Line2, ClauseList,Type);
-transform_call(_Type,Line,_NoAbstractFun) ->
+copy_list([H|T],Bound) ->
+ {C1,Bound1} = copy(H,Bound),
+ {C2,Bound2} = copy_list(T,Bound1),
+ {[C1|C2],Bound2};
+copy_list([],Bound) ->
+ {[],Bound}.
+
+transform_call(Type,_Line,[{'fun',Line2,{clauses, ClauseList}}],Bound) ->
+ ms_clause_list(Line2, ClauseList,Type,Bound);
+transform_call(_Type,Line,_NoAbstractFun,_) ->
throw({error,Line,?ERR_NOFUN}).
% Fixup semicolons in guards
@@ -329,18 +396,19 @@ ms_clause_expand({clause, Line, Parameters, Guard = [_,_|_], Body}) ->
ms_clause_expand(_Other) ->
false.
-ms_clause_list(Line,[H|T],Type) ->
+ms_clause_list(Line,[H|T],Type,Bound) ->
case ms_clause_expand(H) of
NewHead when is_list(NewHead) ->
- ms_clause_list(Line,NewHead ++ T, Type);
+ ms_clause_list(Line,NewHead ++ T, Type, Bound);
false ->
- {cons, Line, ms_clause(H,Type), ms_clause_list(Line, T,Type)}
+ {cons, Line, ms_clause(H, Type, Bound),
+ ms_clause_list(Line, T, Type, Bound)}
end;
-ms_clause_list(Line,[],_) ->
+ms_clause_list(Line,[],_,_) ->
{nil,Line}.
-ms_clause({clause, Line, Parameters, Guards, Body},Type) ->
+ms_clause({clause, Line, Parameters, Guards, Body},Type,Bound) ->
check_type(Line,Parameters,Type),
- {MSHead,Bindings} = transform_head(Parameters),
+ {MSHead,Bindings} = transform_head(Parameters,Bound),
MSGuards = transform_guards(Line, Guards, Bindings),
MSBody = transform_body(Line,Body,Bindings),
{tuple, Line, [MSHead,MSGuards,MSBody]}.
@@ -627,29 +695,31 @@ tg(Other,B) ->
Element = io_lib:format("unknown element ~w", [Other]),
throw({error,unknown,{?ERR_GENELEMENT+B#tgd.eb,Element}}).
-transform_head([V]) ->
+transform_head([V],OuterBound) ->
Bind = cre_bind(),
- {NewV,NewBind} = toplevel_head_match(V,Bind),
- th(NewV,NewBind).
+ {NewV,NewBind} = toplevel_head_match(V,Bind,OuterBound),
+ th(NewV,NewBind,OuterBound).
-toplevel_head_match({match,_,{var,_,VName},Expr},B) ->
+toplevel_head_match({match,Line,{var,_,VName},Expr},B,OB) ->
+ warn_var_clash(Line,VName,OB),
{Expr,new_bind({VName,'$_'},B)};
-toplevel_head_match({match,_,Expr,{var,_,VName}},B) ->
+toplevel_head_match({match,Line,Expr,{var,_,VName}},B,OB) ->
+ warn_var_clash(Line,VName,OB),
{Expr,new_bind({VName,'$_'},B)};
-toplevel_head_match(Other,B) ->
+toplevel_head_match(Other,B,_OB) ->
{Other,B}.
-th({record,Line,RName,RFields},B) ->
+th({record,Line,RName,RFields},B,OB) ->
% youch...
RDefs = get_records(),
{KeyList0,NewB} = lists:foldl(fun({record_field,_,{atom,_,Key},Value},
{L,B0}) ->
- {NV,B1} = th(Value,B0),
+ {NV,B1} = th(Value,B0,OB),
{[{Key,NV}|L],B1};
({record_field,_,{var,_,'_'},Value},
{L,B0}) ->
- {NV,B1} = th(Value,B0),
+ {NV,B1} = th(Value,B0,OB),
{[{{default},NV}|L],B1};
(_,_) ->
throw({error,Line,{?ERR_HEADBADREC,
@@ -692,9 +762,9 @@ th({record,Line,RName,RFields},B) ->
_ ->
throw({error,Line,{?ERR_HEADBADREC,RName}})
end;
-th({match,Line,_,_},_) ->
+th({match,Line,_,_},_,_) ->
throw({error,Line,?ERR_HEADMATCH});
-th({atom,Line,A},B) ->
+th({atom,Line,A},B,_OB) ->
case atom_to_list(A) of
[$$|NL] ->
case (catch list_to_integer(NL)) of
@@ -706,10 +776,11 @@ th({atom,Line,A},B) ->
_ ->
{{atom,Line,A},B}
end;
-th({bin_element,_Line0,{var, Line, A},_,_},_) ->
+th({bin_element,_Line0,{var, Line, A},_,_},_,_) ->
throw({error,Line,{?ERR_HEADBINMATCH,A}});
-th({var,Line,Name},B) ->
+th({var,Line,Name},B,OB) ->
+ warn_var_clash(Line,Name,OB),
case lkup_bind(Name,B) of
undefined ->
NewB = new_bind(Name,B),
@@ -717,16 +788,24 @@ th({var,Line,Name},B) ->
Trans ->
{{atom,Line,Trans},B}
end;
-th([H|T],B) ->
- {NH,NB} = th(H,B),
- {NT,NNB} = th(T,NB),
+th([H|T],B,OB) ->
+ {NH,NB} = th(H,B,OB),
+ {NT,NNB} = th(T,NB,OB),
{[NH|NT],NNB};
-th(T,B) when is_tuple(T) ->
- {L,NB} = th(tuple_to_list(T),B),
+th(T,B,OB) when is_tuple(T) ->
+ {L,NB} = th(tuple_to_list(T),B,OB),
{list_to_tuple(L),NB};
-th(Nonstruct,B) ->
+th(Nonstruct,B,_OB) ->
{Nonstruct,B}.
+warn_var_clash(Line,Name,OuterBound) ->
+ case gb_sets:is_member(Name,OuterBound) of
+ true ->
+ add_warning(Line,{?WARN_SHADOW_VAR,Name});
+ _ ->
+ ok
+ end.
+
%% Could be more efficient...
check_multi_field(_, _, [], _) ->
ok;
diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl
index 5d7e558601..7f39dbe21f 100644
--- a/lib/stdlib/test/ets_SUITE.erl
+++ b/lib/stdlib/test/ets_SUITE.erl
@@ -94,6 +94,8 @@
do_heavy_concurrent/1
]).
+-export([t_select_reverse/1]).
+
-include("test_server.hrl").
init_per_testcase(Case, Config) ->
@@ -128,7 +130,7 @@ all(suite) ->
match_heavy, fold, member,
t_delete_object, t_init_table, t_whitebox,
t_delete_all_objects, t_insert_list, t_test_ms,
- t_select_delete, t_ets_dets, memory,
+ t_select_delete, t_ets_dets, memory, t_select_reverse,
t_bucket_disappears,
select_fail,t_insert_new, t_repair_continuation, otp_5340, otp_6338,
otp_6842_select_1000, otp_7665, otp_8732,
@@ -393,7 +395,7 @@ memory(Config) when is_list(Config) ->
?line erts_debug:set_internal_state(available_internal_state, true),
?line ok = chk_normal_tab_struct_size(),
?line L = [T1,T2,T3,T4] = fill_sets_int(1000),
- ?line XRes1 = adjust_xmem(L, {14862,14072,14072,14078}),
+ ?line XRes1 = adjust_xmem(L, {13862,13072,13072,13078}),
?line Res1 = {?S(T1),?S(T2),?S(T3),?S(T4)},
?line lists:foreach(fun(T) ->
Before = ets:info(T,size),
@@ -404,7 +406,7 @@ memory(Config) when is_list(Config) ->
[Key, ets:info(T,type), Before, ets:info(T,size), Objs])
end,
L),
- ?line XRes2 = adjust_xmem(L, {14851,14062,14052,14058}),
+ ?line XRes2 = adjust_xmem(L, {13852,13063,13054,13060}),
?line Res2 = {?S(T1),?S(T2),?S(T3),?S(T4)},
?line lists:foreach(fun(T) ->
Before = ets:info(T,size),
@@ -415,7 +417,7 @@ memory(Config) when is_list(Config) ->
[Key, ets:info(T,type), Before, ets:info(T,size), Objs])
end,
L),
- ?line XRes3 = adjust_xmem(L, {14840,14052,14032,14038}),
+ ?line XRes3 = adjust_xmem(L, {13842,13054,13036,13042}),
?line Res3 = {?S(T1),?S(T2),?S(T3),?S(T4)},
?line lists:foreach(fun(T) ->
?line ets:delete_all_objects(T)
@@ -788,6 +790,67 @@ t_test_ms(Config) when is_list(Config) ->
?line true = (if is_list(String) -> true; true -> false end),
?line verify_etsmem(EtsMem).
+t_select_reverse(doc) ->
+ ["Test the select reverse BIF's"];
+t_select_reverse(suite) ->
+ [];
+t_select_reverse(Config) when is_list(Config) ->
+ ?line Table = ets:new(xxx, [ordered_set]),
+ ?line filltabint(Table,1000),
+ ?line A = lists:reverse(ets:select(Table,[{{'$1', '_'},
+ [{'>',
+ {'rem',
+ '$1', 5},
+ 2}],
+ ['$_']}])),
+ ?line A = ets:select_reverse(Table,[{{'$1', '_'},
+ [{'>',
+ {'rem',
+ '$1', 5},
+ 2}],
+ ['$_']}]),
+ ?line A = reverse_chunked(Table,[{{'$1', '_'},
+ [{'>',
+ {'rem',
+ '$1', 5},
+ 2}],
+ ['$_']}],3),
+ % A set/bag/duplicate_bag should get the same result regardless
+ % of select or select_reverse
+ ?line Table2 = ets:new(xxx, [set]),
+ ?line filltabint(Table2,1000),
+ ?line Table3 = ets:new(xxx, [bag]),
+ ?line filltabint(Table3,1000),
+ ?line Table4 = ets:new(xxx, [duplicate_bag]),
+ ?line filltabint(Table4,1000),
+ ?line lists:map(fun(Tab) ->
+ B = ets:select(Tab,[{{'$1', '_'},
+ [{'>',
+ {'rem',
+ '$1', 5},
+ 2}],
+ ['$_']}]),
+ B = ets:select_reverse(Tab,[{{'$1', '_'},
+ [{'>',
+ {'rem',
+ '$1', 5},
+ 2}],
+ ['$_']}])
+ end,[Table2, Table3, Table4]),
+ ok.
+
+
+
+reverse_chunked(T,MS,N) ->
+ do_reverse_chunked(ets:select_reverse(T,MS,N),[]).
+
+do_reverse_chunked('$end_of_table',Acc) ->
+ lists:reverse(Acc);
+do_reverse_chunked({L,C},Acc) ->
+ NewAcc = lists:reverse(L)++Acc,
+ do_reverse_chunked(ets:select_reverse(C), NewAcc).
+
+
t_select_delete(doc) ->
["Test the ets:select_delete/2 and ets:select_count/2 BIF's"];
t_select_delete(suite) ->
@@ -3942,7 +4005,7 @@ do_lookup_element(Tab, N, M) ->
end.
-heavy_concurrent(Config) ->
+heavy_concurrent(_Config) ->
repeat_for_opts(do_heavy_concurrent).
do_heavy_concurrent(Opts) ->
@@ -3961,7 +4024,7 @@ do_heavy_concurrent(Opts) ->
?line lists:foreach(fun (P) ->
M = erlang:monitor(process, P),
receive
- {'DOWN', Mon, process, P, _} ->
+ {'DOWN', M, process, P, _} ->
ok
end
end,
diff --git a/lib/stdlib/test/ms_transform_SUITE.erl b/lib/stdlib/test/ms_transform_SUITE.erl
index 79a0a9af89..2d90d5b823 100644
--- a/lib/stdlib/test/ms_transform_SUITE.erl
+++ b/lib/stdlib/test/ms_transform_SUITE.erl
@@ -37,6 +37,7 @@
-export([andalso_orelse/1]).
-export([float_1_function/1]).
-export([action_function/1]).
+-export([warnings/1]).
-export([init_per_testcase/2, fin_per_testcase/2]).
init_per_testcase(_Func, Config) ->
@@ -50,8 +51,90 @@ fin_per_testcase(_Func, Config) ->
all(suite) -> [from_shell,basic_ets,basic_dbg,records,record_index,multipass,
bitsyntax, record_defaults, andalso_orelse,
float_1_function, action_function,
+ warnings,
top_match, old_guards, autoimported, semicolon].
+%% This may be subject to change
+-define(WARN_NUMBER_SHADOW,50).
+warnings(suite) ->
+ [];
+warnings(doc) ->
+ ["Check that shadowed variables in fun head generate warning"];
+warnings(Config) when is_list(Config) ->
+ ?line setup(Config),
+ Prog = <<"A=5, "
+ "ets:fun2ms(fun({A,B}) "
+ " when is_integer(A) and (A+5 > B) -> "
+ " A andalso B "
+ " end)">>,
+ ?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'A'}}]}] =
+ compile_ww(Prog),
+ Prog2 = <<"C=5, "
+ "ets:fun2ms(fun({A,B} = C) "
+ " when is_integer(A) and (A+5 > B) -> "
+ " {A andalso B,C} "
+ " end)">>,
+ ?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'C'}}]}] =
+ compile_ww(Prog2),
+ Rec3 = <<"-record(a,{a,b,c,d=foppa}).">>,
+ Prog3 = <<"A=3,C=5, "
+ "ets:fun2ms(fun(#a{a = A, b = B} = C) "
+ " when is_integer(A) and (A+5 > B) -> "
+ " {A andalso B,C} "
+ " end)">>,
+ ?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'A'}},
+ {_,ms_transform,{?WARN_NUMBER_SHADOW,'C'}}]}] =
+ compile_ww(Rec3,Prog3),
+ Rec4 = <<"-record(a,{a,b,c,d=foppa}).">>,
+ Prog4 = <<"A=3,C=5, "
+ "F = fun(B) -> B*3 end,"
+ "erlang:display(F(A)),"
+ "ets:fun2ms(fun(#a{a = A, b = B} = C) "
+ " when is_integer(A) and (A+5 > B) -> "
+ " {A andalso B,C} "
+ " end)">>,
+ ?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'A'}},
+ {_,ms_transform,{?WARN_NUMBER_SHADOW,'C'}}]}] =
+ compile_ww(Rec4,Prog4),
+ Rec5 = <<"-record(a,{a,b,c,d=foppa}).">>,
+ Prog5 = <<"A=3,C=5, "
+ "F = fun(B) -> B*3 end,"
+ "erlang:display(F(A)),"
+ "B = ets:fun2ms(fun(#a{a = A, b = B} = C) "
+ " when is_integer(A) and (A+5 > B) -> "
+ " {A andalso B,C} "
+ " end)">>,
+ ?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'A'}},
+ {_,ms_transform,{?WARN_NUMBER_SHADOW,'C'}}]}] =
+ compile_ww(Rec5,Prog5),
+ Prog6 = <<" X=bar, "
+ " A = case X of"
+ " foo ->"
+ " foo;"
+ " Y ->"
+ " ets:fun2ms(fun(Y) ->" % This is a warning
+ " 3*Y"
+ " end)"
+ " end,"
+ " ets:fun2ms(fun(Y) ->" % Y out of "scope" here, so no warning
+ " {3*Y,A}"
+ " end)">>,
+ ?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'Y'}}]}] =
+ compile_ww(Prog6),
+ Prog7 = <<" X=bar, "
+ " A = case X of"
+ " foo ->"
+ " Y = foo;"
+ " Y ->"
+ " bar"
+ " end,"
+ " ets:fun2ms(fun(Y) ->" % Y exported from case and safe, so warn
+ " {3*Y,A}"
+ " end)">>,
+ ?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'Y'}}]}] =
+ compile_ww(Prog7),
+ ok.
+
andalso_orelse(suite) ->
[];
andalso_orelse(doc) ->
@@ -721,6 +804,24 @@ compile_and_run(Records,Expr) ->
code:load_binary(tmp,FN,Bin),
tmp:tmp().
+compile_ww(Expr) ->
+ compile_ww(<<>>,Expr).
+compile_ww(Records,Expr) ->
+ Prog = <<
+ "-module(tmp).\n",
+ "-include_lib(\"stdlib/include/ms_transform.hrl\").\n",
+ "-export([tmp/0]).\n",
+ Records/binary,"\n",
+ "tmp() ->\n",
+ Expr/binary,".\n">>,
+ FN=temp_name(),
+ file:write_file(FN,Prog),
+ {ok,Forms} = epp:parse_file(FN,"",""),
+ {ok,tmp,_Bin,Wlist} = compile:forms(Forms,[return_warnings,
+ nowarn_unused_vars,
+ nowarn_unused_record]),
+ Wlist.
+
do_eval(String) ->
{done,{ok,T,_},[]} = erl_scan:tokens(
[],
diff --git a/lib/stdlib/vsn.mk b/lib/stdlib/vsn.mk
index 02ea6d9d68..1757d35160 100644
--- a/lib/stdlib/vsn.mk
+++ b/lib/stdlib/vsn.mk
@@ -1,20 +1 @@
-#
-# %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%
-#
-
STDLIB_VSN = 1.17.1
diff --git a/lib/tools/vsn.mk b/lib/tools/vsn.mk
index abe9a804f0..7a6f8c92a2 100644
--- a/lib/tools/vsn.mk
+++ b/lib/tools/vsn.mk
@@ -1,19 +1 @@
-# This is an -*-makefile-*- file.
-# %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%
-
TOOLS_VSN = 2.6.6
diff --git a/lib/tv/vsn.mk b/lib/tv/vsn.mk
index 93973489bc..d344c676a3 100644
--- a/lib/tv/vsn.mk
+++ b/lib/tv/vsn.mk
@@ -1,20 +1 @@
-#
-# %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%
-#
-
TV_VSN = 2.1.4.5
diff --git a/lib/xmerl/src/xmerl_dtd.erl b/lib/xmerl/src/xmerl_dtd.erl
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/xmerl/src/xmerl_dtd.erl
+++ /dev/null
diff --git a/lib/xmerl/vsn.mk b/lib/xmerl/vsn.mk
index 2239604b59..03d16ad6fe 100644
--- a/lib/xmerl/vsn.mk
+++ b/lib/xmerl/vsn.mk
@@ -1,20 +1 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2003-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%
-#
-
XMERL_VSN = 1.2.5