diff options
Diffstat (limited to 'lib')
392 files changed, 15266 insertions, 12937 deletions
diff --git a/lib/Makefile b/lib/Makefile index 432d98e854..ec26a01dc6 100644 --- a/lib/Makefile +++ b/lib/Makefile @@ -19,20 +19,32 @@ include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk -ERTS_SUB_DIRECTORIES = stdlib sasl kernel compiler -OTHER_SUB_DIRECTORIES = tools test_server common_test runtime_tools \ + +# These have to be built first +ERTS_APPLICATIONS = stdlib sasl kernel compiler + +# Then these have to be build +ERLANG_APPLICATIONS = tools test_server common_test runtime_tools \ inets xmerl edoc erl_docgen + +# These are only build if -a is given to otp_build or make is used directly +ALL_ERLANG_APPLICATIONS = snmp otp_mibs appmon erl_interface asn1 jinterface \ + wx debugger reltool gs \ + ic mnesia crypto orber os_mon parsetools syntax_tools \ + pman public_key ssl toolbar tv observer odbc diameter \ + cosTransactions cosEvent cosTime cosNotification \ + cosProperty cosFileTransfer cosEventDomain et megaco webtool \ + eunit ssh typer percept eldap dialyzer hipe + ifdef BUILD_ALL - OTHER_SUB_DIRECTORIES += \ - snmp otp_mibs appmon erl_interface asn1 jinterface \ - wx debugger reltool gs \ - ic mnesia crypto orber os_mon parsetools syntax_tools \ - pman public_key ssl toolbar tv observer odbc diameter \ - cosTransactions cosEvent cosTime cosNotification \ - cosProperty cosFileTransfer cosEventDomain et megaco webtool \ - eunit ssh typer percept eldap dialyzer hipe - EXTRA_FILE := $(wildcard EXTRA-APPLICATIONS) - EXTRA_APPLICATIONS := $(if $(EXTRA_FILE),$(shell cat $(EXTRA_FILE))) + ERLANG_APPLICATIONS += $(ALL_ERLANG_APPLICATIONS) + +# We use whildcard */ to figure out if there are any other applications +# in here. + EXPECTED_APPLICATIONS := $(ERTS_APPLICATIONS) $(ERLANG_APPLICATIONS) \ + autom4te.cache + EXTRA_APPLICATIONS += $(filter-out $(EXPECTED_APPLICATIONS),\ + $(subst /,,$(wildcard */))) endif ifdef BUILD_STATIC_LIBS @@ -48,13 +60,18 @@ else ifdef TERTIARY_BOOTSTRAP SUB_DIRECTORIES = snmp sasl jinterface ic syntax_tools wx else # Not bootstrap build - SUB_DIRECTORIES = $(ERTS_SUB_DIRECTORIES) \ - $(OTHER_SUB_DIRECTORIES) \ + SUB_DIRECTORIES = $(ERTS_APPLICATIONS) \ + $(ERLANG_APPLICATIONS) \ $(EXTRA_APPLICATIONS) endif endif endif endif +# Any applications listed in SKIP-APPLICATIONS should be skipped +SKIP_FILE := $(wildcard SKIP-APPLICATIONS) +SKIP_APPLICATIONS := $(if $(SKIP_FILE),$(shell cat $(SKIP_FILE))) +SUB_DIRECTORIES := $(filter-out $(SKIP_APPLICATIONS),$(SUB_DIRECTORIES)) + # ---------------------------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk diff --git a/lib/asn1/doc/src/asn1ct.xml b/lib/asn1/doc/src/asn1ct.xml index b020643149..ada2aace87 100644 --- a/lib/asn1/doc/src/asn1ct.xml +++ b/lib/asn1/doc/src/asn1ct.xml @@ -66,7 +66,7 @@ <v>Option = ber | per | uper | der | compact_bit_string | legacy_bit_string | noobj | {n2n, EnumTypeName} |{outdir, Dir} | {i, IncludeDir} | - asn1config | undec_rest | + asn1config | undec_rest | no_ok_wrapper | {macro_name_prefix, Prefix} | {record_name_prefix, Prefix} | verbose | warnings_as_errors</v> <v>OldOption = ber | per</v> <v>Reason = term()</v> @@ -238,6 +238,13 @@ File3.asn </pre> list or a binary. Earlier versions of the compiler ignored those following bytes.</p> </item> + <tag><c>no_ok_wrapper</c></tag> + <item> + <p>If this option is given, the generated <c>encode/2</c> + and <c>decode/2</c> functions will not wrap a successful + return value in an <c>{ok,...}</c> tuple. If any error + occurs, there will be an exception.</p> + </item> <tag><c>{macro_name_prefix, Prefix}</c></tag> <item> <p>All macro names generated by the compiler are prefixed with @@ -356,11 +363,11 @@ File3.asn </pre> </item> </list> - <p>Schematically the following happens for each type in the module: + <p>Schematically the following happens for each type in the module:</p> <code type="none"> {ok, Value} = asn1ct:value(Module, Type), {ok, Bytes} = asn1ct:encode(Module, Type, Value), -{ok, Value} = asn1ct:decode(Module, Type, Bytes).</code></p> +{ok, Value} = asn1ct:decode(Module, Type, Bytes).</code> <p>The <c>test</c> functions utilizes the <c>*.asn1db</c> files for all included modules. If they are located in a different diff --git a/lib/asn1/doc/src/notes.xml b/lib/asn1/doc/src/notes.xml index f3c1ef862c..69e97019df 100644 --- a/lib/asn1/doc/src/notes.xml +++ b/lib/asn1/doc/src/notes.xml @@ -31,6 +31,44 @@ <p>This document describes the changes made to the asn1 application.</p> +<section><title>Asn1 2.0.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Open types greater than 16383 bytes will now be correctly + encoded and decoded.</p> + <p> + Own Id: OTP-11262 Aux Id: seq12386, OTP-11223 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p>For the PER and UPER formats, code generation + especially for encoding has been improved.</p> + <p>When encoding BIT STRINGs, values longer than the + maximum size for the BIT STRING type would be truncated + silently - they now cause an exception.</p> + <p>Open types greater than 16383 bytes will now be + correctly encoded and decoded.</p> + <p>IMPORTANT NOTE: For ASN.1 specifications that depend + on each other, such as the S1AP-* specifications, it is + important to recompile all specifications (compiling some + with this version of the compiler and some with an older + version will not work).</p> + <p> + Own Id: OTP-11300</p> + </item> + </list> + </section> + +</section> + <section><title>Asn1 2.0.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/asn1/src/Makefile b/lib/asn1/src/Makefile index 33cd3cc4c3..500f4a1358 100644 --- a/lib/asn1/src/Makefile +++ b/lib/asn1/src/Makefile @@ -43,9 +43,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/asn1-$(VSN) EBIN = ../ebin -EVAL_CT_MODULES = asn1ct_eval_ext \ - asn1ct_eval_per \ - asn1ct_eval_uper +EVAL_CT_MODULES = asn1ct_eval_ext CT_MODULES= \ asn1ct \ @@ -55,7 +53,6 @@ CT_MODULES= \ asn1ct_func \ asn1ct_gen \ asn1ct_gen_per \ - asn1ct_gen_per_rt2ct \ asn1ct_name \ asn1ct_constructed_per \ asn1ct_constructed_ber_bin_v2 \ @@ -138,7 +135,7 @@ $(EBIN)/asn1ct_func.$(EMULATOR): asn1ct_func.erl asn1ct_eval_%.erl: asn1ct_eval_%.funcs $(gen_verbose)erl -pa $(EBIN) -noshell -noinput \ - -run prepare_templates gen_asn1ct_eval $< >$@ + -run prepare_templates gen_asn1ct_eval $< $(APP_TARGET): $(APP_SRC) ../vsn.mk $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ @@ -183,7 +180,7 @@ RT_TEMPLATES_TARGET = $(RT_TEMPLATES:%=%.$(EMULATOR)) asn1ct_rtt.erl: prepare_templates.$(EMULATOR) $(RT_TEMPLATES_TARGET) $(gen_verbose)erl -noshell -noinput -run prepare_templates gen_asn1ct_rtt \ - $(RT_TEMPLATES_TARGET) >asn1ct_rtt.erl + $(RT_TEMPLATES_TARGET) prepare_templates.$(EMULATOR): prepare_templates.erl $(V_ERLC) prepare_templates.erl diff --git a/lib/asn1/src/asn1_db.erl b/lib/asn1/src/asn1_db.erl index 869b36ddbd..48d9dd16d7 100644 --- a/lib/asn1/src/asn1_db.erl +++ b/lib/asn1/src/asn1_db.erl @@ -19,25 +19,37 @@ %% -module(asn1_db). --export([dbstart/1,dbnew/1,dbsave/2,dbput/3,dbget/2]). +-export([dbstart/1,dbnew/2,dbload/1,dbload/3,dbsave/2,dbput/3,dbget/2]). -export([dbstop/0]). -record(state, {parent, monitor, includes, table}). %% Interface -dbstart(Includes) -> +dbstart(Includes0) -> + Includes = case Includes0 of + [] -> ["."]; + [_|_] -> Includes0 + end, Parent = self(), undefined = get(?MODULE), %Assertion. put(?MODULE, spawn_link(fun() -> init(Parent, Includes) end)), ok. -dbnew(Module) -> req({new, Module}). +dbload(Module, Erule, Mtime) -> + req({load, Module, Erule, Mtime}). + +dbload(Module) -> + req({load, Module, any, {{0,0,0},{0,0,0}}}). + +dbnew(Module, Erule) -> req({new, Module, Erule}). dbsave(OutFile, Module) -> cast({save, OutFile, Module}). dbput(Module, K, V) -> cast({set, Module, K, V}). dbget(Module, K) -> req({get, Module, K}). dbstop() -> Resp = req(stop), erase(?MODULE), Resp. %% Internal functions +-define(MAGIC_KEY, '__version_and_erule__'). + req(Request) -> DbPid = get(?MODULE), Ref = erlang:monitor(process,DbPid), @@ -71,47 +83,57 @@ loop(#state{parent = Parent, monitor = MRef, table = Table, ets:insert(Modtab, {K2, V}), loop(State); {From, {get, Mod, K2}} -> - Result = case ets:lookup(Table, Mod) of - [] -> opentab(Table, Mod, Includes); - [{_, Modtab}] -> {ok, Modtab} - end, - case Result of - {ok, Newtab} -> reply(From, lookup(Newtab, K2)); - _Error -> reply(From, undefined) + %% XXX If there is no information for Mod, get_table/3 + %% will attempt to load information from an .asn1db + %% file, without comparing its timestamp against the + %% source file. This is known to happen when check_* + %% functions for DER are generated, but it could possibly + %% happen in other circumstances. Ideally, this issue should + %% be rectified in some way, perhaps by ensuring that + %% the module has been loaded (using dbload/4) prior + %% to calling dbget/2. + case get_table(Table, Mod, Includes) of + {ok,Tab} -> reply(From, lookup(Tab, K2)); + error -> reply(From, undefined) end, loop(State); {save, OutFile, Mod} -> [{_,Mtab}] = ets:lookup(Table, Mod), ok = ets:tab2file(Mtab, OutFile), loop(State); - {From, {new, Mod}} -> + {From, {new, Mod, Erule}} -> [] = ets:lookup(Table, Mod), %Assertion. ModTableId = ets:new(list_to_atom(lists:concat(["asn1_",Mod])), []), ets:insert(Table, {Mod, ModTableId}), + ets:insert(ModTableId, {?MAGIC_KEY, info(Erule)}), reply(From, ok), loop(State); + {From, {load, Mod, Erule, Mtime}} -> + case ets:member(Table, Mod) of + true -> + reply(From, ok); + false -> + case load_table(Mod, Erule, Mtime, Includes) of + {ok, ModTableId} -> + ets:insert(Table, {Mod, ModTableId}), + reply(From, ok); + error -> + reply(From, error) + end + end, + loop(State); {From, stop} -> reply(From, stopped); %% Nothing to store {'DOWN', MRef, process, Parent, Reason} -> exit(Reason) end. -opentab(Tab, Mod, []) -> - opentab(Tab, Mod, ["."]); -opentab(Tab, Mod, Includes) -> - Base = lists:concat([Mod, ".asn1db"]), - opentab2(Tab, Base, Mod, Includes, ok). - -opentab2(_Tab, _Base, _Mod, [], Error) -> - Error; -opentab2(Tab, Base, Mod, [Ih|It], _Error) -> - File = filename:join(Ih, Base), - case ets:file2tab(File) of - {ok, Modtab} -> - ets:insert(Tab, {Mod, Modtab}), - {ok, Modtab}; - NewErr -> - opentab2(Tab, Base, Mod, It, NewErr) +get_table(Table, Mod, Includes) -> + case ets:lookup(Table, Mod) of + [{Mod,Tab}] -> + {ok,Tab}; + [] -> + load_table(Mod, any, {{0,0,0},{0,0,0}}, Includes) end. lookup(Tab, K) -> @@ -119,3 +141,43 @@ lookup(Tab, K) -> [] -> undefined; [{K,V}] -> V end. + +info(Erule) -> + {asn1ct:vsn(),Erule}. + +load_table(Mod, Erule, Mtime, Includes) -> + Base = lists:concat([Mod, ".asn1db"]), + case path_find(Includes, Mtime, Base) of + error -> + error; + {ok,ModTab} when Erule =:= any -> + {ok,ModTab}; + {ok,ModTab} -> + Vsn = asn1ct:vsn(), + case ets:lookup(ModTab, ?MAGIC_KEY) of + [{_,{Vsn,Erule}}] -> + %% Correct version and encoding rule. + {ok,ModTab}; + _ -> + %% Missing key or wrong version/encoding rule. + ets:delete(ModTab), + error + end + end. + +path_find([H|T], Mtime, Base) -> + File = filename:join(H, Base), + case filelib:last_modified(File) of + 0 -> + path_find(T, Mtime, Base); + DbMtime when DbMtime >= Mtime -> + case ets:file2tab(File) of + {ok,_}=Ret -> + Ret; + _ -> + path_find(T, Mtime, Base) + end; + _ -> + path_find(T, Mtime, Base) + end; +path_find([], _, _) -> error. diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index 8e71a5697c..f2ccf5f212 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -893,17 +893,23 @@ parse_and_save(Module,S) -> Options = S#state.options, SourceDir = S#state.sourcedir, Includes = [I || {i,I} <- Options], + Erule = S#state.erule, case get_input_file(Module, [SourceDir|Includes]) of %% search for asn1 source {file,SuffixedASN1source} -> - case dbfile_uptodate(SuffixedASN1source,Options) of - false -> - parse_and_save1(S, SuffixedASN1source, Options); - _ -> ok + Mtime = filelib:last_modified(SuffixedASN1source), + case asn1_db:dbload(Module, Erule, Mtime) of + ok -> ok; + error -> parse_and_save1(S, SuffixedASN1source, Options) end; Err -> - warning("could not do a consistency check of the ~p file: no asn1 source file was found.~n", - [lists:concat([Module,".asn1db"])],Options), + case asn1_db:dbload(Module) of + ok -> + warning("could not do a consistency check of the ~p file: no asn1 source file was found.~n", + [lists:concat([Module,".asn1db"])],Options); + error -> + ok + end, {error,{asn1,input_file_error,Err}} end. @@ -929,48 +935,6 @@ get_input_file(Module,[I|Includes]) -> get_input_file(Module,Includes) end. -dbfile_uptodate(File,Options) -> - EncodingRule = get_rule(Options), - Ext = filename:extension(File), - Base = filename:basename(File,Ext), - DbFile = outfile(Base,"asn1db",Options), - case file:read_file_info(DbFile) of - {error,enoent} -> - false; - {ok,FileInfoDb} -> - %% file exists, check date and finally encodingrule - {ok,FileInfoAsn} = file:read_file_info(File), - case FileInfoDb#file_info.mtime < FileInfoAsn#file_info.mtime of - true -> - %% date of asn1 spec newer than db file - false; - _ -> - %% date ok,check that same erule was used - Obase = case lists:keysearch(outdir, 1, Options) of - {value, {outdir, Odir}} -> - Odir; - _NotFound -> "" - end, - BeamFileName = outfile(Base,"beam",Options), - case file:read_file_info(BeamFileName) of - {ok,_} -> - code:add_path(Obase), - BeamFile = list_to_atom(Base), - BeamInfo = (catch BeamFile:info()), - case catch lists:keysearch(options,1,BeamInfo) of - {value,{options,OldOptions}} -> - case get_rule(OldOptions) of - EncodingRule -> true; - _ -> false - end; - _ -> false - end; - _ -> false - end - end - end. - - input_file_type(Name,I) -> case input_file_type(Name) of {error,_} -> input_file_type2(filename:basename(Name),I); @@ -1374,10 +1338,11 @@ get_value(Module, Type) -> end. check(Module, Includes) -> - case asn1_db:dbget(Module,'MODULE') of - undefined -> - {error, {file_not_found, lists:concat([Module, ".asn1db"])}}; - M -> + case asn1_db:dbload(Module) of + error -> + {error,asn1db_missing_or_out_of_date}; + ok -> + M = asn1_db:dbget(Module, 'MODULE'), TypeOrVal = M#module.typeorval, State = #state{mname = M#module.name, module = M#module{typeorval=[]}, diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index f94550b0a4..04227fd23b 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -1557,21 +1557,32 @@ check_objectdefn(S,Def,CDef) when is_record(CDef,classdef) -> exit({error,{objectdefn,Other}}) end. -check_defaultfields(S,Fields,ClassFields) -> - check_defaultfields(S,Fields,ClassFields,[]). +check_defaultfields(S, Fields, ClassFields) -> + Present = ordsets:from_list([F || {F,_} <- Fields]), + Mandatory0 = get_mandatory_class_fields(ClassFields), + Mandatory = ordsets:from_list(Mandatory0), + All = ordsets:from_list([element(2, F) || F <- ClassFields]), + #state{type=T,tname=Obj} = S, + case ordsets:subtract(Present, All) of + [] -> + ok; + [_|_]=Invalid -> + throw(asn1_error(S, T, {invalid_fields,Invalid,Obj})) + end, + case ordsets:subtract(Mandatory, Present) of + [] -> + check_defaultfields_1(S, Fields, ClassFields, []); + [_|_]=Missing -> + throw(asn1_error(S, T, {missing_mandatory_fields,Missing,Obj})) + end. -check_defaultfields(_S,[],_ClassFields,Acc) -> +check_defaultfields_1(_S, [], _ClassFields, Acc) -> {object,defaultsyntax,lists:reverse(Acc)}; -check_defaultfields(S,[{FName,Spec}|Fields],ClassFields,Acc) -> - case lists:keysearch(FName,2,ClassFields) of - {value,CField} -> - {NewField,RestFields} = - convert_to_defaultfield(S,FName,[Spec|Fields],CField), - check_defaultfields(S,RestFields,ClassFields,[NewField|Acc]); - _ -> - throw({error,{asn1,{'unvalid field in object',FName}}}) - end. -%% {object,defaultsyntax,Fields}. +check_defaultfields_1(S, [{FName,Spec}|Fields], ClassFields, Acc) -> + CField = lists:keyfind(FName, 2, ClassFields), + {NewField,RestFields} = + convert_to_defaultfield(S, FName, [Spec|Fields], CField), + check_defaultfields_1(S, RestFields, ClassFields, [NewField|Acc]). convert_definedsyntax(_S,[],[],_ClassFields,Acc) -> lists:reverse(Acc); @@ -1587,6 +1598,23 @@ convert_definedsyntax(S,Fields,WithSyntax,ClassFields,Acc) -> [MatchedField|Acc]) end. +get_mandatory_class_fields([{fixedtypevaluefield,Name,_,_,'MANDATORY'}|T]) -> + [Name|get_mandatory_class_fields(T)]; +get_mandatory_class_fields([{objectfield,Name,_,_,'MANDATORY'}|T]) -> + [Name|get_mandatory_class_fields(T)]; +get_mandatory_class_fields([{objectsetfield,Name,_,'MANDATORY'}|T]) -> + [Name|get_mandatory_class_fields(T)]; +get_mandatory_class_fields([{typefield,Name,'MANDATORY'}|T]) -> + [Name|get_mandatory_class_fields(T)]; +get_mandatory_class_fields([{variabletypevaluefield,Name,_,'MANDATORY'}|T]) -> + [Name|get_mandatory_class_fields(T)]; +get_mandatory_class_fields([{variabletypevaluesetfield, + Name,_,'MANDATORY'}|T]) -> + [Name|get_mandatory_class_fields(T)]; +get_mandatory_class_fields([_|T]) -> + get_mandatory_class_fields(T); +get_mandatory_class_fields([]) -> []. + match_field(S,Fields,WithSyntax,ClassFields) -> match_field(S,Fields,WithSyntax,ClassFields,[]). @@ -2506,89 +2534,54 @@ normalize_integer(S,Int=#'Externalvaluereference'{value=Name},Type) -> normalize_integer(_,Int,_) -> exit({'Unknown INTEGER value',Int}). -normalize_bitstring(S,Value,Type)-> - %% There are four different Erlang formats of BIT STRING: - %% 1 - a list of ones and zeros. - %% 2 - a list of atoms. - %% 3 - as an integer, for instance in hexadecimal form. - %% 4 - as a tuple {Unused, Binary} where Unused is an integer - %% and tells how many bits of Binary are unused. - %% - %% normalize_bitstring/3 transforms Value according to: - %% A to 3, - %% B to 1, - %% C to 1 or 3 - %% D to 2, - %% Value can be on format: - %% A - {hstring, String}, where String is a hexadecimal string. - %% B - {bstring, String}, where String is a string on bit format - %% C - #'Externalvaluereference'{value=V}, where V is a defined value - %% D - list of #'Externalvaluereference', where each value component - %% is an identifier corresponing to NamedBits in Type. - %% E - list of ones and zeros, if Value already is normalized. +%% normalize_bitstring(S, Value, Type) -> bitstring() +%% Convert a literal value for a BIT STRING to an Erlang bit string. +%% +normalize_bitstring(S, Value, Type)-> case Value of {hstring,String} when is_list(String) -> - hstring_to_int(String); + hstring_to_bitstring(String); {bstring,String} when is_list(String) -> - bstring_to_bitlist(String); - Rec when is_record(Rec,'Externalvaluereference') -> - get_normalized_value(S,Value,Type, - fun normalize_bitstring/3,[]); + bstring_to_bitstring(String); + #'Externalvaluereference'{} -> + get_normalized_value(S, Value, Type, + fun normalize_bitstring/3, []); RecList when is_list(RecList) -> - case Type of - NBL when is_list(NBL) -> - F = fun(#'Externalvaluereference'{value=Name}) -> - case lists:keysearch(Name,1,NBL) of - {value,{Name,_}} -> - Name; - Other -> - throw({error,Other}) - end; - (I) when I =:= 1; I =:= 0 -> - I; - (Other) -> - throw({error,Other}) - end, - case catch lists:map(F,RecList) of - {error,Reason} -> - asn1ct:warning("default value not " - "compatible with type definition ~p~n", - [Reason],S, - "default value not " - "compatible with type definition"), - Value; - NewList -> - NewList - end; - _ -> + F = fun(#'Externalvaluereference'{value=Name}) -> + case lists:keymember(Name, 1, Type) of + true -> Name; + false -> throw({error,false}) + end; + (Name) when is_atom(Name) -> + %% Already normalized. + Name; + (Other) -> + throw({error,Other}) + end, + try + lists:map(F, RecList) + catch + throw:{error,Reason} -> asn1ct:warning("default value not " "compatible with type definition ~p~n", - [RecList],S, + [Reason],S, "default value not " "compatible with type definition"), Value end; - {Name,String} when is_atom(Name) -> - normalize_bitstring(S,String,Type); - Other -> - asn1ct:warning("illegal default value ~p~n",[Other],S, - "illegal default value"), - Value + Bs when is_bitstring(Bs) -> + %% Already normalized. + Bs end. -hstring_to_int(L) when is_list(L) -> - hstring_to_int(L,0). -hstring_to_int([H|T],Acc) when H >= $A, H =< $F -> - hstring_to_int(T,(Acc bsl 4) + (H - $A + 10) ) ; -hstring_to_int([H|T],Acc) when H >= $0, H =< $9 -> - hstring_to_int(T,(Acc bsl 4) + (H - $0)); -hstring_to_int([],Acc) -> - Acc. +hstring_to_bitstring(L) -> + << <<(hex_to_int(D)):4>> || D <- L >>. -bstring_to_bitlist([H|T]) when H == $0; H == $1 -> - [H - $0 | bstring_to_bitlist(T)]; -bstring_to_bitlist([]) -> - []. +bstring_to_bitstring(L) -> + << <<(D-$0):1>> || D <- L >>. + +hex_to_int(D) when $0 =< D, D =< $9 -> D - $0; +hex_to_int(D) when $A =< D, D =< $F -> D - ($A - 10). %% normalize_octetstring/1 changes representation of input Value to a %% list of octets. @@ -6798,7 +6791,7 @@ merge_tags2([], Acc) -> storeindb(S,M) when is_record(M,module) -> TVlist = M#module.typeorval, NewM = M#module{typeorval=findtypes_and_values(TVlist)}, - asn1_db:dbnew(NewM#module.name), + asn1_db:dbnew(NewM#module.name, S#state.erule), asn1_db:dbput(NewM#module.name,'MODULE', NewM), Res = storeindb(#state{mname=NewM#module.name}, TVlist, []), include_default_class(S,NewM#module.name), @@ -6867,11 +6860,22 @@ asn1_error(#state{mname=Where}, Item, Error) -> format_error({already_defined,Name,PrevLine}) -> io_lib:format("the name ~p has already been defined at line ~p", [Name,PrevLine]); +format_error({invalid_fields,Fields,Obj}) -> + io_lib:format("invalid ~s in ~p", [format_fields(Fields),Obj]); +format_error({missing_mandatory_fields,Fields,Obj}) -> + io_lib:format("missing mandatory ~s in ~p", + [format_fields(Fields),Obj]); format_error({undefined,Name}) -> io_lib:format("'~s' is referenced, but is not defined", [Name]); format_error(Other) -> io_lib:format("~p", [Other]). +format_fields([F]) -> + io_lib:format("field &~s", [F]); +format_fields([H|T]) -> + [io_lib:format("fields &~s", [H])| + [io_lib:format(", &~s", [F]) || F <- T]]. + error({_,{structured_error,_,_,_}=SE,_}) -> SE; error({export,Msg,#state{mname=Mname,type=Ref,tname=Typename}}) -> diff --git a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl index 761faa53c5..a38da8bcc2 100644 --- a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl @@ -122,8 +122,8 @@ gen_encode_sequence(Erules,Typename,D) when is_record(D,type) -> asn1ct_gen:un_hyphen_var(lists:concat(['Obj', AttrN])), emit([ObjectEncode," = ",nl, - " ",{asis,ObjSetMod},":'getenc_",ObjSetName, - "'(",{asis,UniqueFieldName},", ",nl]), + " ",{asis,ObjSetMod},":'getenc_",ObjSetName, + "'("]), ValueMatch = value_match(ValueIndex, lists:concat(["Cindex",N])), emit([indent(35),ValueMatch,"),",nl]), @@ -198,7 +198,7 @@ gen_decode_sequence(Erules,Typename,D) when is_record(D,type) -> asn1ct_name:new(tlv), asn1ct_name:new(v), - {DecObjInf,UniqueFName,ValueIndex} = + {DecObjInf,ValueIndex} = case TableConsInfo of #simpletableattributes{objectsetname=ObjectSetRef, c_name=AttrN, @@ -217,12 +217,12 @@ gen_decode_sequence(Erules,Typename,D) when is_record(D,type) -> %% relation from a component to another components %% subtype component {{AttrN,{deep,ObjectSetRef,UniqueFieldName,ValIndex}}, - UniqueFieldName,ValIndex}; + ValIndex}; false -> - {{AttrN,ObjectSetRef},UniqueFieldName,ValIndex} + {{AttrN,ObjectSetRef},ValIndex} end; _ -> - {false,false,false} + {false,false} end, RecordName = lists:concat([get_record_name_prefix(), asn1ct_gen:list2rname(Typename)]), @@ -246,7 +246,7 @@ gen_decode_sequence(Erules,Typename,D) when is_record(D,type) -> {ObjSetMod,ObjSetName} = ObjSetRef, emit([DecObj," =",nl, " ",{asis,ObjSetMod},":'getdec_",ObjSetName,"'(", - {asis,UniqueFName},", ",ValueMatch,"),",nl]), + ValueMatch,"),",nl]), gen_dec_postponed_decs(DecObj,PostponedDecArgs) end, demit(["Result = "]), %dbg @@ -357,7 +357,7 @@ gen_decode_set(Erules,Typename,D) when is_record(D,type) -> asn1ct_name:new(v), - {DecObjInf,UniqueFName,ValueIndex} = + {DecObjInf,ValueIndex} = case TableConsInfo of %% {ObjectSetRef,AttrN,_N,UniqueFieldName} ->%% N is index of attribute that determines constraint #simpletableattributes{objectsetname=ObjectSetRef, @@ -378,12 +378,12 @@ gen_decode_set(Erules,Typename,D) when is_record(D,type) -> %% relation from a component to another components %% subtype component {{AttrN,{deep,ObjectSetRef,UniqueFieldName,ValIndex}}, - UniqueFieldName,ValIndex}; + ValIndex}; false -> - {{AttrN,ObjectSetRef},UniqueFieldName,ValIndex} + {{AttrN,ObjectSetRef},ValIndex} end; _ -> - {false,false,false} + {false,false} end, case CompList of @@ -425,7 +425,7 @@ gen_decode_set(Erules,Typename,D) when is_record(D,type) -> {ObjSetMod,ObjSetName} = ObjSetRef, emit([DecObj," =",nl, " ",{asis,ObjSetMod},":'getdec_",ObjSetName,"'(", - {asis,UniqueFName},", ",ValueMatch,"),",nl]), + ValueMatch,"),",nl]), gen_dec_postponed_decs(DecObj,PostponedDecArgs) end, demit(["Result = "]), %dbg @@ -577,6 +577,8 @@ gen_decode_choice(Erules,Typename,D) when is_record(D,type) -> gen_enc_sequence_call(Erules,TopType,[#'ComponentType'{name=Cname,typespec=Type,prop=Prop,textual_order=Order}|Rest],Pos,Ext,EncObj) -> asn1ct_name:new(encBytes), asn1ct_name:new(encLen), + asn1ct_name:new(tmpBytes), + asn1ct_name:new(tmpLen), CindexPos = case Order of undefined -> @@ -706,8 +708,6 @@ emit_term_tlv('OPTIONAL',InnerType,DecObjInf) -> emit_term_tlv(opt_or_def,InnerType,DecObjInf); emit_term_tlv(Prop,{typefield,_},DecObjInf) -> emit_term_tlv(Prop,type_or_object_field,DecObjInf); -emit_term_tlv(Prop,{objectfield,_,_},DecObjInf) -> - emit_term_tlv(Prop,type_or_object_field,DecObjInf); emit_term_tlv(opt_or_def,type_or_object_field,NotFalse) when NotFalse /= false -> asn1ct_name:new(tmpterm), @@ -789,6 +789,7 @@ gen_enc_choice2(Erules,TopType,[H1|T]) when is_record(H1,'ComponentType') -> componentrelation)} of {#'ObjectClassFieldType'{},{componentrelation,_,_}} -> asn1ct_name:new(tmpBytes), + asn1ct_name:new(tmpLen), asn1ct_name:new(encBytes), asn1ct_name:new(encLen), Emit = ["{",{curr,tmpBytes},", _} = "], @@ -929,7 +930,6 @@ gen_enc_line(Erules,TopType,Cname, when is_list(Element) -> case asn1ct_gen:get_constraint(C,componentrelation) of {componentrelation,_,_} -> - asn1ct_name:new(tmpBytes), gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand, ["{",{curr,tmpBytes},",_} = "],EncObj); _ -> @@ -991,12 +991,8 @@ gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,Assign,EncObj) {call,ber,encode_open_type, [{curr,tmpBytes},{asis,Tag}]},nl]); _ -> - emit(["{",{next,tmpBytes},",",{curr,tmpLen}, - "} = ", - {call,ber,encode_open_type, - [{curr,tmpBytes},{asis,Tag}]},com,nl]), - emit(IndDeep), - emit(["{",{next,tmpBytes},", ",{curr,tmpLen},"}"]) + emit([{call,ber,encode_open_type, + [{curr,tmpBytes},{asis,Tag}]}]) end; Err -> throw({asn1,{'internal error',Err}}) @@ -1159,7 +1155,8 @@ gen_dec_line(Erules,TopType,Cname,CTags,Type,OptOrMand,DecObjInf) -> emit([indent(4),"_ ->",nl]), case OptOrMand of - {'DEFAULT', Def} -> + {'DEFAULT', Def0} -> + Def = asn1ct_gen:conform_value(Type, Def0), emit([indent(8),"{",{asis,Def},",",{prev,tlv},"}",nl]); 'OPTIONAL' -> emit([indent(8),"{ asn1_NOVALUE, ",{prev,tlv},"}",nl]) @@ -1213,22 +1210,18 @@ gen_dec_call({typefield,_},_,_,Cname,Type,BytesVar,Tag,_,_,_DecObjInf,OptOrMandC (Type#type.def)#'ObjectClassFieldType'.fieldname, [{Cname,RefedFieldName,asn1ct_gen:mk_var(asn1ct_name:curr(term)), asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),Tag,OptOrMandComp}]; -gen_dec_call({objectfield,PrimFieldName,PFNList},_,_,Cname,_,BytesVar,Tag,_,_,_,OptOrMandComp) -> - call(decode_open_type, [BytesVar,{asis,Tag}]), - [{Cname,{PrimFieldName,PFNList},asn1ct_gen:mk_var(asn1ct_name:curr(term)), - asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),Tag,OptOrMandComp}]; gen_dec_call(InnerType,Erules,TopType,Cname,Type,BytesVar,Tag,PrimOptOrMand, OptOrMand,DecObjInf,_) -> WhatKind = asn1ct_gen:type(InnerType), gen_dec_call1(WhatKind,InnerType,Erules,TopType,Cname,Type,BytesVar,Tag, PrimOptOrMand,OptOrMand), case DecObjInf of - {Cname,{_,OSet,UniqueFName,ValIndex}} -> + {Cname,{_,OSet,_UniqueFName,ValIndex}} -> Term = asn1ct_gen:mk_var(asn1ct_name:curr(term)), ValueMatch = value_match(ValIndex,Term), {ObjSetMod,ObjSetName} = OSet, emit([",",nl,"ObjFun = ",{asis,ObjSetMod},":'getdec_",ObjSetName, - "'(",{asis,UniqueFName},", ",ValueMatch,")"]); + "'(",ValueMatch,")"]); _ -> ok end, diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl index d279e9697f..4672f7edd3 100644 --- a/lib/asn1/src/asn1ct_constructed_per.erl +++ b/lib/asn1/src/asn1ct_constructed_per.erl @@ -43,10 +43,13 @@ gen_encode_set(Erules,TypeName,D) -> gen_encode_sequence(Erules,TypeName,D) -> gen_encode_constructed(Erules,TypeName,D). -gen_encode_constructed(Erule,Typename,D) when is_record(D,type) -> +gen_encode_constructed(Erule, Typename, #type{}=D) -> asn1ct_name:start(), - asn1ct_name:new(term), - asn1ct_name:new(bytes), + Imm = gen_encode_constructed_imm(Erule, Typename, D), + asn1ct_imm:enc_cg(Imm, is_aligned(Erule)), + emit([".",nl]). + +gen_encode_constructed_imm(Erule, Typename, #type{}=D) -> {ExtAddGroup,TmpCompList,TableConsInfo} = case D#type.def of #'SEQUENCE'{tablecinf=TCI,components=CL,extaddgroup=ExtAddGroup0} -> @@ -65,74 +68,36 @@ gen_encode_constructed(Erule,Typename,D) when is_record(D,type) -> [Comp#'ComponentType'{textual_order=undefined}|| Comp<-TmpCompList] end, - case Typename of - ['EXTERNAL'] -> - emit([{next,val}," = ", - {call,ext,transform_to_EXTERNAL1990, - [{curr,val}]},com,nl]), - asn1ct_name:new(val); - _ -> - ok - end, - case {Optionals = optionals(to_textual_order(CompList)),CompList, - is_optimized(Erule)} of - {[],EmptyCL,_} when EmptyCL == {[],[],[]};EmptyCL == {[],[]};EmptyCL == [] -> - ok; - {[],_,_} -> - emit([{next,val}," = ",{curr,val},",",nl]); - {_,_,true} -> - gen_fixoptionals(Optionals), - FixOpts = param_map(fun(Var) -> - {var,Var} - end,asn1ct_name:all(fixopt)), - emit({"{",{next,val},",Opt} = {",{curr,val},",[",FixOpts,"]},",nl}); - {_,_,false} -> - asn1ct_func:need({Erule,fixoptionals,3}), - Fixoptcall = ",Opt} = fixoptionals(", - emit({"{",{next,val},Fixoptcall, - {asis,Optionals},",",length(Optionals), - ",",{curr,val},"),",nl}) - end, - asn1ct_name:new(val), + ExternalImm = + case Typename of + ['EXTERNAL'] -> + Next = asn1ct_gen:mk_var(asn1ct_name:next(val)), + Curr = asn1ct_gen:mk_var(asn1ct_name:curr(val)), + asn1ct_name:new(val), + [{call,ext,transform_to_EXTERNAL1990,[{var,Curr}],{var,Next}}]; + _ -> + [] + end, + Aligned = is_aligned(Erule), + Value0 = asn1ct_gen:mk_var(asn1ct_name:curr(val)), + Optionals = optionals(to_textual_order(CompList)), + ImmOptionals = [asn1ct_imm:per_enc_optional(Value0, Opt, Aligned) || + Opt <- Optionals], Ext = extensible_enc(CompList), - case Ext of - {ext,_,NumExt} when NumExt > 0 -> - case extgroup_pos_and_length(CompList) of - {extgrouppos,[]} -> % no extenstionAdditionGroup - ok; - {extgrouppos,ExtGroupPosLenList} -> - ExtGroupFun = - fun({ExtActualGroupPos,ExtGroupVirtualPos,ExtGroupLen}) -> - Elements = - make_elements(ExtGroupVirtualPos+1, - "Val1", - lists:seq(1,ExtGroupLen)), - emit([ - {next,val}," = case [X || X <- [",Elements, - "],X =/= asn1_NOVALUE] of",nl, - "[] -> setelement(", - {asis,ExtActualGroupPos+1},",", - {curr,val},",", - "asn1_NOVALUE);",nl, - "_ -> setelement(",{asis,ExtActualGroupPos+1},",", - {curr,val},",", - "{extaddgroup,", Elements,"})",nl, - "end,",nl]), - asn1ct_name:new(val) - end, - lists:foreach(ExtGroupFun,ExtGroupPosLenList) - end, - asn1ct_name:new(tmpval), - emit(["Extensions = ", - {call,Erule,fixextensions,[{asis,Ext},{curr,val}]}, - com,nl]); - _ -> true - end, - EncObj = + ExtImm = case Ext of + {ext,ExtPos,NumExt} when NumExt > 0 -> + gen_encode_extaddgroup(CompList), + Value = asn1ct_gen:mk_var(asn1ct_name:curr(val)), + asn1ct_imm:per_enc_extensions(Value, ExtPos, + NumExt, Aligned); + _ -> + [] + end, + {EncObj,ObjSetImm} = case TableConsInfo of #simpletableattributes{usedclassfield=Used, uniqueclassfield=Unique} when Used /= Unique -> - false; + {false,[]}; %% ObjectSet, name of the object set in constraints %% %%{ObjectSet,AttrN,N,UniqueFieldName} -> %% N is index of attribute that determines constraint @@ -152,13 +117,10 @@ gen_encode_constructed(Erule,Typename,D) when is_record(D,type) -> asn1ct_gen:un_hyphen_var(lists:concat(['Obj',AttrN])), El = make_element(N+1, asn1ct_gen:mk_var(asn1ct_name:curr(val))), ValueMatch = value_match(ValueIndex, El), - emit([ObjectEncode," =",nl, - " ",{asis,Module},":'getenc_",ObjSetName,"'(", - {asis,UniqueFieldName},", ",nl, - " ",ValueMatch,"),",nl]), - {AttrN,ObjectEncode}; + ObjSetImm0 = [{assign,{var,ObjectEncode},ValueMatch}], + {{AttrN,ObjectEncode},ObjSetImm0}; false -> - false + {false,[]} end; _ -> case D#type.tablecinf of @@ -166,34 +128,52 @@ gen_encode_constructed(Erule,Typename,D) when is_record(D,type) -> %% when the simpletableattributes was at an outer %% level and the objfun has been passed through the %% function call - {"got objfun through args","ObjFun"}; + {{"got objfun through args","ObjFun"},[]}; _ -> - false + {false,[]} end end, - emit({"[",nl}), - MaybeComma1 = + ImmSetExt = case Ext of - {ext,_Pos,NumExt2} when NumExt2 > 0 -> - call(Erule, setext, ["Extensions =/= []"]), - ", "; - {ext,_Pos,_} -> - call(Erule, setext, ["false"]), - ", "; - _ -> - "" - end, - MaybeComma2 = - case optionals(CompList) of - [] -> MaybeComma1; - _ -> - emit(MaybeComma1), - emit("Opt"), - {",",nl} + {ext,_Pos,NumExt2} when NumExt2 > 0 -> + asn1ct_imm:per_enc_extension_bit('Extensions', Aligned); + {ext,_Pos,_} -> + asn1ct_imm:per_enc_extension_bit([], Aligned); + _ -> + [] end, - gen_enc_components_call(Erule,Typename,CompList,MaybeComma2,EncObj,Ext), - emit({"].",nl}). + ImmBody = gen_enc_components_call(Erule, Typename, CompList, EncObj, Ext), + ExternalImm ++ ExtImm ++ ObjSetImm ++ + asn1ct_imm:enc_append([ImmSetExt] ++ ImmOptionals ++ ImmBody). + +gen_encode_extaddgroup(CompList) -> + case extgroup_pos_and_length(CompList) of + {extgrouppos,[]} -> + ok; + {extgrouppos,ExtGroupPosLenList} -> + _ = [do_gen_encode_extaddgroup(G) || G <- ExtGroupPosLenList], + ok + end. +do_gen_encode_extaddgroup({ActualGroupPos,GroupVirtualPos,GroupLen}) -> + Val = asn1ct_gen:mk_var(asn1ct_name:curr(val)), + Elements = make_elements(GroupVirtualPos+1, + Val, + lists:seq(1, GroupLen)), + Expr = any_non_value(GroupVirtualPos+1, Val, GroupLen, ""), + emit([{next,val}," = case ",Expr," of",nl, + "false -> setelement(",{asis,ActualGroupPos+1},", ", + {curr,val},", asn1_NOVALUE);",nl, + "true -> setelement(",{asis,ActualGroupPos+1},", ", + {curr,val},", {extaddgroup,", Elements,"})",nl, + "end,",nl]), + asn1ct_name:new(val). + +any_non_value(_, _, 0, _) -> + []; +any_non_value(Pos, Val, N, Sep) -> + Sep ++ [make_element(Pos, Val)," =/= asn1_NOVALUE"] ++ + any_non_value(Pos+1, Val, N-1, [" orelse",nl]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% generate decode function for SEQUENCE and SET @@ -328,28 +308,29 @@ gen_dec_constructed_imm(Erule, Typename, #type{}=D) -> EmitComp = gen_dec_components_call(Erule, Typename, CompList, DecObjInf, Ext, length(Optionals)), EmitRest = fun({AccTerm,AccBytes}) -> - gen_dec_constructed_imm_2(Typename, CompList, + gen_dec_constructed_imm_2(Erule, Typename, + CompList, ObjSetInfo, AccTerm, AccBytes) end, [EmitExt,EmitOpt|EmitComp++[{safe,EmitRest}]]. -gen_dec_constructed_imm_2(Typename, CompList, +gen_dec_constructed_imm_2(Erule, Typename, CompList, ObjSetInfo, AccTerm, AccBytes) -> - {_,UniqueFName,ValueIndex} = ObjSetInfo, + {_,_UniqueFName,ValueIndex} = ObjSetInfo, case {AccTerm,AccBytes} of {[],[]} -> ok; {_,[]} -> ok; {[{ObjSet,LeadingAttr,Term}],ListOfOpenTypes} -> - DecObj = asn1ct_gen:un_hyphen_var(lists:concat(['DecObj',LeadingAttr,Term])), - ValueMatch = value_match(ValueIndex,Term), - {ObjSetMod,ObjSetName} = ObjSet, - emit([DecObj," =",nl, - " ",{asis,ObjSetMod},":'getdec_",ObjSetName,"'(", - {asis,UniqueFName},", ",ValueMatch,"),",nl]), - gen_dec_listofopentypes(DecObj,ListOfOpenTypes,false) + ValueMatch = value_match(ValueIndex, Term), + _ = [begin + gen_dec_open_type(Erule, ValueMatch, ObjSet, + LeadingAttr, T), + emit([com,nl]) + end || T <- ListOfOpenTypes], + ok end, %% we don't return named lists any more Cnames = mkcnamelist(CompList), demit({"Result = "}), %dbg @@ -423,67 +404,143 @@ to_textual_order(Cs) when is_list(Cs) -> to_textual_order(Cs) -> Cs. -gen_dec_listofopentypes(_,[],_) -> - emit(nl); -gen_dec_listofopentypes(DecObj,[{_Cname,{FirstPFN,PFNList},Term,TmpTerm,Prop}|Rest],_Update) -> - - asn1ct_name:new(tmpterm), - asn1ct_name:new(reason), - - emit([Term," = ",nl]), +gen_dec_open_type(Erule, Val, {Xmod,Xtype}, LeadingAttr, + {_,{Name,RestFieldNames},Term,TmpTerm,Prop}) -> + #typedef{typespec=ObjSet0} = asn1_db:dbget(Xmod, Xtype), + #'ObjectSet'{class=Class,set=ObjSet1} = ObjSet0, + #'Externaltypereference'{module=ClMod,type=ClType} = Class, + #classdef{typespec=ClassDef} = asn1_db:dbget(ClMod, ClType), + #objectclass{fields=ClassFields} = ClassDef, + Extensible = lists:member('EXTENSIONMARK', ObjSet1), + ObjSet2 = [{Key,fix_object_code(Name, Code, ClassFields)} || + {_,Key,Code} <- ObjSet1], + ObjSet = lists:sort([P || {_,B}=P <- ObjSet2, B =/= none]), + Key = erlang:md5(term_to_binary({decode,ObjSet,RestFieldNames, + Prop,Extensible})), + Typename = [Name,ClType], + Gen = fun(_Fd, N) -> + dec_objset_optional(N, Prop), + dec_objset(Erule, N, ObjSet, RestFieldNames, Typename), + dec_objset_default(N, Name, LeadingAttr, Extensible) + end, + Prefix = lists:concat(["dec_os_",Name]), + F = asn1ct_func:call_gen(Prefix, Key, Gen), + emit([Term," = ",{asis,F},"(",TmpTerm,", ",Val,")"]). + +dec_objset_optional(N, {'DEFAULT',Val}) -> + dec_objset_optional_1(N, Val), + dec_objset_optional_1(N, asn1_DEFAULT); +dec_objset_optional(N, 'OPTIONAL') -> + dec_objset_optional_1(N, asn1_NOVALUE); +dec_objset_optional(_N, mandatory) -> ok. + +dec_objset_optional_1(N, Val) -> + emit([{asis,N},"(",{asis,Val},", _Id) ->",nl, + {asis,Val},";",nl]). + +dec_objset(_Erule, _N, [], _, _) -> + ok; +dec_objset(Erule, N, [Obj|Objs], RestFields, Cl) -> + dec_objset_1(Erule, N, Obj, RestFields, Cl), + emit([";",nl]), + dec_objset(Erule, N, Objs, RestFields, Cl). + +dec_objset_default(N, C, LeadingAttr, false) -> + emit([{asis,N},"(Bytes, Id) ->",nl, + "exit({'Type not compatible with table constraint'," + "{{component,",{asis,C},"}," + "{value,Bytes}," + "{unique_name_and_value,",{asis,LeadingAttr},",Id}}}).",nl,nl]); +dec_objset_default(N, _, _, true) -> + emit([{asis,N},"(Bytes, Id) ->",nl, + "Bytes.",nl,nl]). + +dec_objset_1(Erule, N, {Id,Obj}, RestFields, Typename) -> + emit([{asis,N},"(Bytes, ",{asis,Id},") ->",nl]), + dec_objset_2(Erule, Obj, RestFields, Typename). + +dec_objset_2(Erule, Obj, RestFields0, Typename) -> + case Obj of + #typedef{name={primitive,bif},typespec=Type} -> + Imm = asn1ct_gen_per:gen_dec_imm(Erule, Type), + {Term,_} = asn1ct_imm:dec_slim_cg(Imm, 'Bytes'), + emit([com,nl,Term]); + #typedef{name={constructed,bif},typespec=Def} -> + InnerType = asn1ct_gen:get_inner(Def#type.def), + case InnerType of + 'CHOICE' -> + asn1ct_name:start(), + asn1ct_name:new(bytes), + {'CHOICE',CompList} = Def#type.def, + Ext = extensible_enc(CompList), + emit(["{Result,_} = begin",nl]), + gen_dec_choice(Erule, Typename, CompList, Ext), + emit([nl, + "end",com,nl, + "Result"]); + 'SET' -> + Imm0 = gen_dec_constructed_imm(Erule, Typename, Def), + Imm = opt_imm(Imm0), + asn1ct_name:start(), + emit(["{Result,_} = begin",nl]), + emit_gen_dec_imm(Imm), + emit([nl, + "end",com,nl, + "Result"]); + 'SET OF' -> + asn1ct_name:start(), + do_gen_decode_sof(Erule, Typename, 'SET OF', + Def, false); + 'SEQUENCE' -> + Imm0 = gen_dec_constructed_imm(Erule, Typename, Def), + Imm = opt_imm(Imm0), + asn1ct_name:start(), + emit(["{Result,_} = begin",nl]), + emit_gen_dec_imm(Imm), + emit([nl, + "end",com,nl, + "Result"]); + 'SEQUENCE OF' -> + asn1ct_name:start(), + do_gen_decode_sof(Erule, Typename, 'SEQUENCE OF', + Def, false) + end; + #typedef{name=Type} -> + emit(["{Result,_} = ",{asis,enc_func("dec_", Type)},"(Bytes),",nl, + "Result"]); + #'Externaltypereference'{module=Mod,type=Type} -> + emit("{Term,_} = "), + Func = enc_func("dec_", Type), + case get(currmod) of + Mod -> + emit([{asis,Func},"(Bytes)"]); + _ -> + emit([{asis,Mod},":",{asis,Func},"(Bytes)"]) + end, + emit([com,nl, + "Term"]); + #'Externalvaluereference'{module=Mod,value=Value} -> + case asn1_db:dbget(Mod, Value) of + #typedef{typespec=#'Object'{def=Def}} -> + {object,_,Fields} = Def, + [NextField|RestFields] = RestFields0, + {NextField,Typedef} = lists:keyfind(NextField, 1, Fields), + dec_objset_2(Erule, Typedef, RestFields, Typename) + end + end. - N = case Prop of - mandatory -> 0; - 'OPTIONAL' -> - emit_opt_or_mand_check(asn1_NOVALUE,TmpTerm), - 6; - {'DEFAULT',Val} -> - emit_opt_or_mand_check(Val,TmpTerm), - 6 - end, +gen_encode_choice(Erule, TopType, D) -> + asn1ct_name:start(), + Imm = gen_encode_choice_imm(Erule, TopType, D), + asn1ct_imm:enc_cg(Imm, is_aligned(Erule)), + emit([".",nl]). - emit([indent(N+3),"case (catch ",DecObj,"(", - {asis,FirstPFN},", ",TmpTerm,", telltype,",{asis,PFNList},")) of",nl]), - emit([indent(N+6),"{'EXIT', ",{curr,reason},"} ->",nl]), - emit([indent(N+9),"exit({'Type not compatible with table constraint',", - {curr,reason},"});",nl]), - emit([indent(N+6),"{",{curr,tmpterm},",_} ->",nl]), - emit([indent(N+9),{curr,tmpterm},nl]), - - case Prop of - mandatory -> - emit([indent(N+3),"end,",nl]); - _ -> - emit([indent(N+3),"end",nl, - indent(3),"end,",nl]) - end, - gen_dec_listofopentypes(DecObj,Rest,true). - - -emit_opt_or_mand_check(Val,Term) -> - emit([indent(3),"case ",Term," of",nl, - indent(6),{asis,Val}," ->",{asis,Val},";",nl, - indent(6),"_ ->",nl]). - -%% ENCODE GENERATOR FOR THE CHOICE TYPE ******* -%% assume Val = {Alternative,AltType} -%% generate -%%[ -%% ?RT_PER:set_choice(element(1,Val),Altnum,Altlist,ext), -%%case element(1,Val) of -%% alt1 -> -%% encode_alt1(element(2,Val)); -%% alt2 -> -%% encode_alt2(element(2,Val)) -%%end -%%]. - -gen_encode_choice(Erule,Typename,D) when is_record(D,type) -> - {'CHOICE',CompList} = D#type.def, - emit({"[",nl}), +gen_encode_choice_imm(Erule, TopType, #type{def={'CHOICE',CompList}}) -> Ext = extensible_enc(CompList), - gen_enc_choice(Erule,Typename,CompList,Ext), - emit({nl,"].",nl}). + Aligned = is_aligned(Erule), + Cs = gen_enc_choice(Erule, TopType, CompList, Ext), + [{assign,{expr,"{ChoiceTag,ChoiceVal}"},"Val"}| + asn1ct_imm:per_enc_choice('ChoiceTag', Cs, Aligned)]. gen_decode_choice(Erules,Typename,D) when is_record(D,type) -> asn1ct_name:start(), @@ -496,72 +553,48 @@ gen_decode_choice(Erules,Typename,D) when is_record(D,type) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Encode generator for SEQUENCE OF type - -gen_encode_sof(Erule,Typename,SeqOrSetOf,D) when is_record(D,type) -> +gen_encode_sof(Erule, Typename, SeqOrSetOf, D) -> asn1ct_name:start(), - {_SeqOrSetOf,ComponentType} = D#type.def, - emit({"[",nl}), - SizeConstraint = asn1ct_imm:effective_constraint(bitstring, - D#type.constraint), - ObjFun = - case D#type.tablecinf of - [{objfun,_}|_R] -> - ", ObjFun"; - _-> - "" - end, - gen_encode_length(Erule, SizeConstraint), - emit({indent(3),"'enc_",asn1ct_gen:list2name(Typename), - "_components'(Val",ObjFun,", [])"}), - emit({nl,"].",nl}), - gen_encode_sof_components(Erule, Typename, SeqOrSetOf, ComponentType). - - -%% Logic copied from asn1_per_bin_rt2ct:encode_constrained_number -gen_encode_length(per, {Lb,Ub}) when Ub =< 65535, Lb >= 0 -> - Range = Ub - Lb + 1, - V2 = ["(length(Val) - ",Lb,")"], - Encode = if - Range == 1 -> - "[]"; - Range == 2 -> - {"[",V2,"]"}; - Range =< 4 -> - {"[10,2,",V2,"]"}; - Range =< 8 -> - {"[10,3,",V2,"]"}; - Range =< 16 -> - {"[10,4,",V2,"]"}; - Range =< 32 -> - {"[10,5,",V2,"]"}; - Range =< 64 -> - {"[10,6,",V2,"]"}; - Range =< 128 -> - {"[10,7,",V2,"]"}; - Range =< 255 -> - {"[10,8,",V2,"]"}; - Range =< 256 -> - {"[20,1,",V2,"]"}; - Range =< 65536 -> - {"[20,2,<<",V2,":16>>]"}; - true -> - {call,per,encode_length, - [{asis,{Lb,Ub}},"length(Val)"]} - end, - emit({nl,Encode,",",nl}); -gen_encode_length(Erules, SizeConstraint) -> - emit([nl,indent(3), - case SizeConstraint of - no -> - {call,Erules,encode_length,["length(Val)"]}; - _ -> - {call,Erules,encode_length, - [{asis,SizeConstraint},"length(Val)"]} - end, - com,nl]). + Imm = gen_encode_sof_imm(Erule, Typename, SeqOrSetOf, D), + asn1ct_imm:enc_cg(Imm, is_aligned(Erule)), + emit([".",nl,nl]). -gen_decode_sof(Erules,Typename,SeqOrSetOf,D) when is_record(D,type) -> +gen_encode_sof_imm(Erule, Typename, SeqOrSetOf, #type{}=D) -> + {_SeqOrSetOf,ComponentType} = D#type.def, + Aligned = is_aligned(Erule), + Constructed_Suffix = + asn1ct_gen:constructed_suffix(SeqOrSetOf, + ComponentType#type.def), + Conttype = asn1ct_gen:get_inner(ComponentType#type.def), + Currmod = get(currmod), + Imm0 = case asn1ct_gen:type(Conttype) of + {primitive,bif} -> + asn1ct_gen_per:gen_encode_prim_imm('Comp', ComponentType, Aligned); + {constructed,bif} -> + TypeName = [Constructed_Suffix|Typename], + Enc = enc_func(asn1ct_gen:list2name(TypeName)), + ObjArg = case D#type.tablecinf of + [{objfun,_}|_] -> [{var,"ObjFun"}]; + _ -> [] + end, + [{apply,Enc,[{var,"Comp"}|ObjArg]}]; + #'Externaltypereference'{module=Currmod,type=Ename} -> + [{apply,enc_func(Ename),[{var,"Comp"}]}]; + #'Externaltypereference'{module=EMod,type=Ename} -> + [{apply,{EMod,enc_func(Ename)},[{var,"Comp"}]}]; + 'ASN1_OPEN_TYPE' -> + asn1ct_gen_per:gen_encode_prim_imm('Comp', + #type{def='ASN1_OPEN_TYPE'}, + Aligned) + end, + asn1ct_imm:per_enc_sof('Val', D#type.constraint, 'Comp', Imm0, Aligned). + +gen_decode_sof(Erules, Typename, SeqOrSetOf, #type{}=D) -> asn1ct_name:start(), + do_gen_decode_sof(Erules, Typename, SeqOrSetOf, D, true), + emit([".",nl,nl]). + +do_gen_decode_sof(Erules, Typename, SeqOrSetOf, D, NeedRest) -> {_SeqOrSetOf,ComponentType} = D#type.def, SizeConstraint = asn1ct_imm:effective_constraint(bitstring, D#type.constraint), @@ -573,10 +606,16 @@ gen_decode_sof(Erules,Typename,SeqOrSetOf,D) when is_record(D,type) -> "" end, {Num,Buf} = gen_decode_length(SizeConstraint, Erules), + Key = erlang:md5(term_to_binary({Typename,SeqOrSetOf, + ComponentType,NeedRest})), + Gen = fun(_Fd, Name) -> + gen_decode_sof_components(Erules, Name, + Typename, SeqOrSetOf, + ComponentType, NeedRest) + end, + F = asn1ct_func:call_gen("dec_components", Key, Gen), emit([",",nl, - "'dec_",asn1ct_gen:list2name(Typename), - "_components'(",Num,", ",Buf,ObjFun,", []).",nl,nl]), - gen_decode_sof_components(Erules, Typename, SeqOrSetOf, ComponentType). + {asis,F},"(",Num,", ",Buf,ObjFun,", [])"]). is_aligned(per) -> true; is_aligned(uper) -> false. @@ -586,7 +625,7 @@ gen_decode_length(Constraint, Erule) -> Imm = asn1ct_imm:per_dec_length(Constraint, true, is_aligned(Erule)), asn1ct_imm:dec_slim_cg(Imm, "Bytes"). -gen_encode_sof_components(Erule,Typename,SeqOrSetOf,Cont) -> +gen_decode_sof_components(Erule, Name, Typename, SeqOrSetOf, Cont, NeedRest) -> {ObjFun,ObjFun_Var} = case Cont#type.tablecinf of [{objfun,_}|_R] -> @@ -594,76 +633,38 @@ gen_encode_sof_components(Erule,Typename,SeqOrSetOf,Cont) -> _ -> {"",""} end, - emit({"'enc_",asn1ct_gen:list2name(Typename),"_components'([]", - ObjFun_Var,", Acc) -> lists:reverse(Acc);",nl,nl}), - emit({"'enc_",asn1ct_gen:list2name(Typename),"_components'([H|T]", - ObjFun,", Acc) ->",nl}), - emit({"'enc_",asn1ct_gen:list2name(Typename),"_components'(T"}), - emit({ObjFun,", ["}), - %% the component encoder - Constructed_Suffix = asn1ct_gen:constructed_suffix(SeqOrSetOf, - Cont#type.def), - - Conttype = asn1ct_gen:get_inner(Cont#type.def), - Currmod = get(currmod), - case asn1ct_gen:type(Conttype) of - {primitive,bif} -> - asn1ct_gen_per:gen_encode_prim(Erule, Cont, "H"); - {constructed,bif} -> - NewTypename = [Constructed_Suffix|Typename], - emit({"'enc_",asn1ct_gen:list2name(NewTypename),"'(H", - ObjFun,")",nl,nl}); - #'Externaltypereference'{module=Currmod,type=Ename} -> - emit({"'enc_",Ename,"'(H)",nl,nl}); - #'Externaltypereference'{module=EMod,type=EType} -> - emit({"'",EMod,"':'enc_",EType,"'(H)",nl,nl}); - 'ASN1_OPEN_TYPE' -> - asn1ct_gen_per:gen_encode_prim(Erule, - #type{def='ASN1_OPEN_TYPE'}, - "H"); - _ -> - emit({"'enc_",Conttype,"'(H)",nl,nl}) + case NeedRest of + false -> + emit([{asis,Name},"(0, _Bytes",ObjFun_Var,", Acc) ->",nl, + "lists:reverse(Acc);",nl]); + true -> + emit([{asis,Name},"(0, Bytes",ObjFun_Var,", Acc) ->",nl, + "{lists:reverse(Acc),Bytes};",nl]) end, - emit({" | Acc]).",nl}). - -gen_decode_sof_components(Erule,Typename,SeqOrSetOf,Cont) -> - {ObjFun,ObjFun_Var} = - case Cont#type.tablecinf of - [{objfun,_}|_R] -> - {", ObjFun",", _"}; - _ -> - {"",""} - end, - emit({"'dec_",asn1ct_gen:list2name(Typename), - "_components'(0, Bytes",ObjFun_Var,", Acc) ->",nl, - indent(3),"{lists:reverse(Acc), Bytes};",nl}), - emit({"'dec_",asn1ct_gen:list2name(Typename), - "_components'(Num, Bytes",ObjFun,", Acc) ->",nl}), - emit({indent(3),"{Term,Remain} = "}), + emit([{asis,Name},"(Num, Bytes",ObjFun,", Acc) ->",nl, + "{Term,Remain} = "]), Constructed_Suffix = asn1ct_gen:constructed_suffix(SeqOrSetOf, Cont#type.def), Conttype = asn1ct_gen:get_inner(Cont#type.def), - Ctgenmod = asn1ct_gen:ct_gen_module(Erule), case asn1ct_gen:type(Conttype) of {primitive,bif} -> - Ctgenmod:gen_dec_prim(Erule,Cont,"Bytes"), + asn1ct_gen_per:gen_dec_prim(Erule, Cont, "Bytes"), emit({com,nl}); {constructed,bif} -> NewTypename = [Constructed_Suffix|Typename], emit({"'dec_",asn1ct_gen:list2name(NewTypename), - "'(Bytes, telltype",ObjFun,"),",nl}); + "'(Bytes",ObjFun,"),",nl}); #'Externaltypereference'{}=Etype -> asn1ct_gen_per:gen_dec_external(Etype, "Bytes"), emit([com,nl]); 'ASN1_OPEN_TYPE' -> - Ctgenmod:gen_dec_prim(Erule,#type{def='ASN1_OPEN_TYPE'}, - "Bytes"), + asn1ct_gen_per:gen_dec_prim(Erule, #type{def='ASN1_OPEN_TYPE'}, + "Bytes"), emit({com,nl}); _ -> - emit({"'dec_",Conttype,"'(Bytes,telltype),",nl}) + emit({"'dec_",Conttype,"'(Bytes),",nl}) end, - emit({indent(3),"'dec_",asn1ct_gen:list2name(Typename), - "_components'(Num-1, Remain",ObjFun,", [Term|Acc]).",nl}). + emit([{asis,Name},"(Num-1, Remain",ObjFun,", [Term|Acc]).",nl]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -754,27 +755,6 @@ gen_dec_optionals(Optionals) -> end, {imm,Imm0,E}. -gen_fixoptionals([{Pos,Def}|R]) -> - asn1ct_name:new(fixopt), - emit({{curr,fixopt}," = case element(",{asis,Pos},",",{curr,val},") of",nl, - "asn1_DEFAULT -> 0;",nl, - {asis,Def}," -> 0;",nl, - "_ -> 1",nl, - "end,",nl}), - gen_fixoptionals(R); -gen_fixoptionals([Pos|R]) -> - gen_fixoptionals([{Pos,asn1_NOVALUE}|R]); -gen_fixoptionals([]) -> - ok. - - -param_map(Fun, [H]) -> - [Fun(H)]; -param_map(Fun, [H|T]) -> - [Fun(H),","|param_map(Fun,T)]. - - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Produce a list with positions (in the Value record) where %% there are optional components, start with 2 because first element @@ -788,15 +768,15 @@ optionals({L1,Ext,L2}) -> optionals({L,_Ext}) -> optionals(L,[],2); optionals(L) -> optionals(L,[],2). -optionals([{'EXTENSIONMARK',_,_}|Rest],Acc,Pos) -> - optionals(Rest,Acc,Pos); % optionals in extension are currently not handled -optionals([#'ComponentType'{prop='OPTIONAL'}|Rest],Acc,Pos) -> - optionals(Rest,[Pos|Acc],Pos+1); -optionals([#'ComponentType'{prop={'DEFAULT',Val}}|Rest],Acc,Pos) -> - optionals(Rest,[{Pos,Val}|Acc],Pos+1); -optionals([#'ComponentType'{}|Rest],Acc,Pos) -> - optionals(Rest,Acc,Pos+1); -optionals([],Acc,_) -> +optionals([#'ComponentType'{prop='OPTIONAL'}|Rest], Acc, Pos) -> + optionals(Rest, [Pos|Acc], Pos+1); +optionals([#'ComponentType'{typespec=T,prop={'DEFAULT',Val}}|Rest], + Acc, Pos) -> + Vals = def_values(T, Val), + optionals(Rest, [{Pos,Vals}|Acc], Pos+1); +optionals([#'ComponentType'{}|Rest], Acc, Pos) -> + optionals(Rest, Acc, Pos+1); +optionals([], Acc, _) -> lists:reverse(Acc). %%%%%%%%%%%%%%%%%%%%%% @@ -858,33 +838,32 @@ add_textual_order1(Cs,NumIn) -> end, NumIn,Cs). -gen_enc_components_call(Erule,TopType,{Root,ExtList},MaybeComma,DynamicEnc,Ext) -> - gen_enc_components_call(Erule,TopType,{Root,ExtList,[]},MaybeComma,DynamicEnc,Ext); -gen_enc_components_call(Erule,TopType,CL={Root,ExtList,Root2},MaybeComma,DynamicEnc,Ext) -> +gen_enc_components_call(Erule,TopType,{Root,ExtList}, DynamicEnc,Ext) -> + gen_enc_components_call(Erule,TopType,{Root,ExtList,[]}, DynamicEnc,Ext); +gen_enc_components_call(Erule,TopType,CL={Root,ExtList,Root2}, DynamicEnc,Ext) -> %% The type has extensionmarker - Rpos = gen_enc_components_call1(Erule,TopType,Root++Root2,1,MaybeComma,DynamicEnc,noext), - case Ext of - {ext,_,ExtNum} when ExtNum > 0 -> - emit([nl, - ",Extensions",nl]); - - _ -> true - end, + {Imm0,Rpos} = gen_enc_components_call1(Erule,TopType,Root++Root2,1, DynamicEnc,noext,[]), + ExtImm = case Ext of + {ext,_,ExtNum} when ExtNum > 0 -> + [{var,"Extensions"}]; + _ -> + [] + end, %handle extensions {extgrouppos,ExtGroupPosLen} = extgroup_pos_and_length(CL), NewExtList = wrap_extensionAdditionGroups(ExtList,ExtGroupPosLen), - gen_enc_components_call1(Erule,TopType,NewExtList,Rpos,MaybeComma,DynamicEnc,Ext); -gen_enc_components_call(Erule,TopType, CompList, MaybeComma, DynamicEnc, Ext) -> + {Imm1,_} = gen_enc_components_call1(Erule,TopType,NewExtList,Rpos,DynamicEnc,Ext,[]), + Imm0 ++ [ExtImm|Imm1]; +gen_enc_components_call(Erule,TopType, CompList, DynamicEnc, Ext) -> %% The type has no extensionmarker - gen_enc_components_call1(Erule,TopType,CompList,1,MaybeComma,DynamicEnc,Ext). + {Imm,_} = gen_enc_components_call1(Erule,TopType,CompList,1,DynamicEnc,Ext,[]), + Imm. gen_enc_components_call1(Erule,TopType, [C=#'ComponentType'{name=Cname,typespec=Type,prop=Prop}|Rest], Tpos, - MaybeComma, DynamicEnc, Ext) -> + DynamicEnc, Ext, Acc) -> - put(component_type,{true,C}), - %% information necessary in asn1ct_gen_per_rt2ct:gen_encode_prim TermNo = case C#'ComponentType'.textual_order of undefined -> @@ -892,90 +871,81 @@ gen_enc_components_call1(Erule,TopType, CanonicalNum -> CanonicalNum end, - emit(MaybeComma), - case Prop of - 'OPTIONAL' -> - gen_enc_component_optional(Erule,TopType,Cname,Type,TermNo,DynamicEnc,Ext); - {'DEFAULT',DefVal} -> - gen_enc_component_default(Erule,TopType,Cname,Type,TermNo,DynamicEnc,Ext,DefVal); + Element0 = make_element(TermNo+1, asn1ct_gen:mk_var(asn1ct_name:curr(val))), + {Imm0,Element} = asn1ct_imm:enc_bind_var(Element0), + Imm1 = gen_enc_line_imm(Erule, TopType, Cname, Type, Element, DynamicEnc, Ext), + Category = case {Prop,Ext} of + {'OPTIONAL',_} -> + optional; + {{'DEFAULT',DefVal},_} -> + {default,DefVal}; + {_,{ext,ExtPos,_}} when Tpos >= ExtPos -> + optional; + {_,_} -> + mandatory + end, + Imm2 = case Category of + mandatory -> + Imm1; + optional -> + asn1ct_imm:enc_absent(Element, [asn1_NOVALUE], Imm1); + {default,Def} -> + DefValues = def_values(Type, Def), + asn1ct_imm:enc_absent(Element, DefValues, Imm1) + end, + Imm = case Imm2 of + [] -> []; + _ -> Imm0 ++ Imm2 + end, + gen_enc_components_call1(Erule, TopType, Rest, Tpos+1, DynamicEnc, Ext, [Imm|Acc]); +gen_enc_components_call1(_Erule,_TopType,[],Pos,_,_, Acc) -> + ImmList = lists:reverse(Acc), + {ImmList,Pos}. + +def_values(#type{def=#'Externaltypereference'{module=Mod,type=Type}}, Def) -> + #typedef{typespec=T} = asn1_db:dbget(Mod, Type), + def_values(T, Def); +def_values(#type{def={'BIT STRING',[]}}, Bs) when is_bitstring(Bs) -> + ListBs = [B || <<B:1>> <= Bs], + IntBs = lists:foldl(fun(B, A) -> + (A bsl 1) bor B + end, 0, lists:reverse(ListBs)), + Sz = bit_size(Bs), + Compact = case 8 - Sz rem 8 of + 8 -> + {0,Bs}; + Unused -> + {Unused,<<Bs:Sz/bits,0:Unused>>} + end, + [asn1_DEFAULT,Bs,Compact,ListBs,IntBs]; +def_values(#type{def={'BIT STRING',[_|_]=Ns}}, List) when is_list(List) -> + Bs = asn1ct_gen:named_bitstring_value(List, Ns), + ListBs = [B || <<B:1>> <= Bs], + IntBs = lists:foldl(fun(B, A) -> + (A bsl 1) bor B + end, 0, lists:reverse(ListBs)), + Args = [List,Bs,ListBs,IntBs], + {call,per_common,is_default_bitstring,Args}; +def_values(#type{def={'INTEGER',Ns}}, Def) -> + [asn1_DEFAULT,Def|case lists:keyfind(Def, 2, Ns) of + false -> []; + {Val,Def} -> [Val] + end]; +def_values(_, Def) -> + [asn1_DEFAULT,Def]. + +gen_enc_line_imm(Erule, TopType, Cname, Type, Element, DynamicEnc, Ext) -> + Imm0 = gen_enc_line_imm_1(Erule, TopType, Cname, Type, + Element, DynamicEnc), + Aligned = is_aligned(Erule), + case Ext of + {ext,_Ep2,_} -> + asn1ct_imm:per_enc_open_type(Imm0, Aligned); _ -> - case Ext of - {ext,ExtPos,_} when Tpos >= ExtPos -> - gen_enc_component_optional(Erule,TopType,Cname,Type,TermNo,DynamicEnc,Ext); - _ -> - gen_enc_component_mandatory(Erule,TopType,Cname,Type,TermNo,DynamicEnc,Ext) - end - end, - - erase(component_type), + Imm0 + end. - case Rest of - [] -> - Tpos+1; - _ -> - emit({com,nl}), - gen_enc_components_call1(Erule,TopType,Rest,Tpos+1,"",DynamicEnc,Ext) - end; -gen_enc_components_call1(_Erule,_TopType,[],Pos,_,_,_) -> - Pos. - -gen_enc_component_default(Erule,TopType,Cname,Type,Pos,DynamicEnc,Ext,DefaultVal) -> - Element = make_element(Pos+1,asn1ct_gen:mk_var(asn1ct_name:curr(val))), - emit({"case ",Element," of",nl}), -% emit({"asn1_DEFAULT -> [];",nl}), - emit({"DFLT when DFLT == asn1_DEFAULT; DFLT == ",{asis,DefaultVal}," -> [];",nl}), - - asn1ct_name:new(tmpval), - emit({{curr,tmpval}," ->",nl}), - 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=#type{def=#'SEQUENCE'{ - extaddgroup=Number, - components=_ExtGroupCompList}}, - Pos,DynamicEnc,Ext) when is_integer(Number) -> - - Element = make_element(Pos+1,asn1ct_gen:mk_var(asn1ct_name:curr(val))), - emit({"case ",Element," of",nl}), - - emit({"asn1_NOVALUE -> [];",nl}), - asn1ct_name:new(tmpval), - emit({{curr,tmpval}," ->",nl}), - 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,asn1ct_gen:mk_var(asn1ct_name:curr(val))), - emit({"case ",Element," of",nl}), - - emit({"asn1_NOVALUE -> [];",nl}), - asn1ct_name:new(tmpval), - emit({{curr,tmpval}," ->",nl}), - 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_mandatory(Erule,TopType,Cname,Type,Pos,DynamicEnc,Ext) -> - InnerType = asn1ct_gen:get_inner(Type#type.def), - emit({nl,"%% attribute number ",Pos," with type ", - InnerType,nl}), - gen_enc_line(Erule,TopType,Cname,Type,[],Pos,DynamicEnc,Ext). - -gen_enc_line(Erule,TopType, Cname, Type, [], Pos,DynamicEnc,Ext) -> - Element = make_element(Pos+1,asn1ct_gen:mk_var(asn1ct_name:curr(val))), - gen_enc_line(Erule,TopType,Cname,Type,Element, Pos,DynamicEnc,Ext); -gen_enc_line(Erule,TopType,Cname,Type,Element, _Pos,DynamicEnc,Ext) -> +gen_enc_line_imm_1(Erule, TopType, Cname, Type, Element, DynamicEnc) -> Atype = case Type of #type{def=#'ObjectClassFieldType'{type=InnerType}} -> @@ -983,81 +953,157 @@ gen_enc_line(Erule,TopType,Cname,Type,Element, _Pos,DynamicEnc,Ext) -> _ -> asn1ct_gen:get_inner(Type#type.def) end, - - case Ext of - {ext,_Ep1,_} -> - asn1ct_func:need({Erule,encode_open_type,1}), - asn1ct_func:need({Erule,complete,1}), - emit(["encode_open_type(complete("]); - _ -> true - end, - + Aligned = is_aligned(Erule), case Atype of {typefield,_} -> - case DynamicEnc of - {_LeadingAttrName,Fun} -> - case (Type#type.def)#'ObjectClassFieldType'.fieldname of - {Name,RestFieldNames} when is_atom(Name) -> - asn1ct_func:need({Erule,complete,1}), - asn1ct_func:need({Erule,encode_open_type,1}), - emit({"encode_open_type(complete(",nl}), - emit({" ",Fun,"(",{asis,Name},", ", - Element,", ",{asis,RestFieldNames},")))"}); - Other -> - throw({asn1,{'internal error',Other}}) - end - end; - {objectfield,PrimFieldName1,PFNList} -> - case DynamicEnc of - {_LeadingAttrName,Fun} -> - asn1ct_func:need({Erule,complete,1}), - asn1ct_func:need({Erule,encode_open_type,1}), - emit({"encode_open_type(" - "complete(",nl}), - emit({" ",Fun,"(",{asis,PrimFieldName1}, - ", ",Element,", ",{asis,PFNList},")))"}) + {_LeadingAttrName,Fun} = DynamicEnc, + case (Type#type.def)#'ObjectClassFieldType'.fieldname of + {Name,RestFieldNames} when is_atom(Name) -> + Imm = enc_var_type_call(Erule, Name, RestFieldNames, + Type, Fun, Element), + asn1ct_imm:per_enc_open_type(Imm, Aligned) end; _ -> CurrMod = get(currmod), case asn1ct_gen:type(Atype) of - #'Externaltypereference'{module=Mod,type=EType} when - (CurrMod==Mod) -> - emit({"'enc_",EType,"'(",Element,")"}); + #'Externaltypereference'{module=CurrMod,type=EType} -> + [{apply,enc_func(EType),[{expr,Element}]}]; #'Externaltypereference'{module=Mod,type=EType} -> - emit({"'",Mod,"':'enc_", - EType,"'(",Element,")"}); + [{apply,{Mod,enc_func(EType)},[{expr,Element}]}]; {primitive,bif} -> - asn1ct_gen_per:gen_encode_prim(Erule, Type, Element); + asn1ct_gen_per:gen_encode_prim_imm(Element, Type, Aligned); 'ASN1_OPEN_TYPE' -> case Type#type.def of #'ObjectClassFieldType'{type=OpenType} -> - asn1ct_gen_per:gen_encode_prim(Erule, - #type{def=OpenType}, - Element); + asn1ct_gen_per:gen_encode_prim_imm(Element, + #type{def=OpenType}, + Aligned); _ -> - asn1ct_gen_per:gen_encode_prim(Erule, Type, - Element) + asn1ct_gen_per:gen_encode_prim_imm(Element, + Type, + Aligned) end; {constructed,bif} -> NewTypename = [Cname|TopType], + Enc = enc_func(asn1ct_gen:list2name(NewTypename)), case {Type#type.tablecinf,DynamicEnc} of {[{objfun,_}|_R],{_,EncFun}} -> - emit({"'enc_", - asn1ct_gen:list2name(NewTypename), - "'(",Element,", ",EncFun,")"}); + [{apply,Enc,[{expr,Element},{var,EncFun}]}]; _ -> - emit({"'enc_", - asn1ct_gen:list2name(NewTypename), - "'(",Element,")"}) + [{apply,Enc,[{expr,Element}]}] end end - end, - case Ext of - {ext,_Ep2,_} -> - emit("))"); - _ -> true end. +enc_func(Type) -> + enc_func("enc_", Type). + +enc_func(Prefix, Name) -> + list_to_atom(lists:concat([Prefix,Name])). + +enc_var_type_call(Erule, Name, RestFieldNames, + #type{tablecinf=TCI}, Fun, Val) -> + [{objfun,#'Externaltypereference'{module=Xmod,type=Xtype}}] = TCI, + #typedef{typespec=ObjSet0} = asn1_db:dbget(Xmod, Xtype), + #'ObjectSet'{class=Class,set=ObjSet1} = ObjSet0, + #'Externaltypereference'{module=ClMod,type=ClType} = Class, + #classdef{typespec=ClassDef} = asn1_db:dbget(ClMod, ClType), + #objectclass{fields=ClassFields} = ClassDef, + Extensible = lists:member('EXTENSIONMARK', ObjSet1), + ObjSet2 = [{Key,fix_object_code(Name, Code, ClassFields)} || + {_,Key,Code} <- ObjSet1], + ObjSet = lists:sort([P || {_,B}=P <- ObjSet2, B =/= none]), + Key = erlang:md5(term_to_binary({encode,ObjSet,RestFieldNames,Extensible})), + Gen = fun(_Fd, N) -> + enc_objset(Erule, Name, N, ObjSet, + RestFieldNames, Extensible) + end, + Prefix = lists:concat(["enc_os_",Name]), + F = asn1ct_func:call_gen(Prefix, Key, Gen), + [{apply,F,[{var,atom_to_list(Val)},{var,Fun}]}]. + +fix_object_code(Name, [{Name,B}|_], _ClassFields) -> + B; +fix_object_code(Name, [_|T], ClassFields) -> + fix_object_code(Name, T, ClassFields); +fix_object_code(Name, [], ClassFields) -> + case lists:keyfind(Name, 2, ClassFields) of + {typefield,Name,'OPTIONAL'} -> + none; + {objectfield,Name,_,_,'OPTIONAL'} -> + none; + {typefield,Name,{'DEFAULT',#type{}=Type}} -> + InnerType = asn1ct_gen:get_inner(Type#type.def), + case asn1ct_gen:type(InnerType) of + {primitive,bif} -> + #typedef{name={primitive,bif},typespec=Type}; + {constructed,bif} -> + #typedef{name={constructed,bif},typespec=Type} + end + end. + + +enc_objset(Erule, Component, Name, ObjSet, RestFieldNames, Extensible) -> + asn1ct_name:start(), + Aligned = is_aligned(Erule), + E = {error, + fun() -> + emit(["exit({'Type not compatible with table constraint'," + "{component,",{asis,Component},"}," + "{value,Val}," + "{unique_name_and_value,'_'}})",nl]) + end}, + Imm = [{'cond', + [[{eq,{var,"Id"},Key}| + enc_obj(Erule, Obj, RestFieldNames, Aligned)] || + {Key,Obj} <- ObjSet] ++ + [['_',case Extensible of + false -> E; + true -> {put_bits,{var,"Val"},binary,[1]} + end]]}], + emit([{asis,Name},"(Val, Id) ->",nl]), + asn1ct_imm:enc_cg(Imm, Aligned), + emit([".",nl]). + +enc_obj(Erule, Obj, RestFieldNames0, Aligned) -> + case Obj of + #typedef{name={primitive,bif},typespec=Def} -> + asn1ct_gen_per:gen_encode_prim_imm('Val', Def, Aligned); + #typedef{name={constructed,bif},typespec=Def} -> + InnerType = asn1ct_gen:get_inner(Def#type.def), + case InnerType of + 'CHOICE' -> + gen_encode_choice_imm(Erule, name, Def); + 'SET' -> + gen_encode_constructed_imm(Erule, name, Def); + 'SET OF' -> + gen_encode_sof_imm(Erule, name, InnerType, Def); + 'SEQUENCE' -> + gen_encode_constructed_imm(Erule, name, Def); + 'SEQUENCE OF' -> + gen_encode_sof_imm(Erule, name, InnerType, Def) + end; + #typedef{name=Type} -> + [{apply,enc_func(Type),[{var,"Val"}]}]; + #'Externalvaluereference'{module=Mod,value=Value} -> + case asn1_db:dbget(Mod, Value) of + #typedef{typespec=#'Object'{def=Def}} -> + {object,_,Fields} = Def, + [NextField|RestFieldNames] = RestFieldNames0, + {NextField,Typedef} = lists:keyfind(NextField, 1, Fields), + enc_obj(Erule, Typedef, RestFieldNames, Aligned) + end; + #'Externaltypereference'{module=Mod,type=Type} -> + Func = enc_func(Type), + case get(currmod) of + Mod -> + [{apply,Func,[{var,"Val"}]}]; + _ -> + [{apply,{Mod,Func},[{var,"Val"}]}] + end + end. + + gen_dec_components_call(Erule, TopType, {Root,ExtList}, DecInfObj, Ext, NumberOfOptionals) -> gen_dec_components_call(Erule,TopType,{Root,ExtList,[]}, @@ -1163,14 +1209,6 @@ gen_dec_comp_call(Comp, Erule, TopType, Tpos, OptTable, DecInfObj, emit(["{",{curr,tmpterm},", ",{next,bytes},"} = "]), St end; - %%{objectfield,_,_} when Ext == noext, Prop == mandatory -> - {{objectfield,_,_},true} -> - fun(St) -> - asn1ct_name:new(term), - asn1ct_name:new(tmpterm), - emit(["{",{curr,tmpterm},", ",{next,bytes},"} = "]), - St - end; _ -> case Type of #type{def=#'SEQUENCE'{ @@ -1204,7 +1242,8 @@ gen_dec_comp_call(Comp, Erule, TopType, Tpos, OptTable, DecInfObj, comp_call_pre_post(noext, mandatory, _, _, _, _, _, _) -> {[],[]}; -comp_call_pre_post(noext, Prop, _, _, TextPos, OptTable, NumOptionals, Ext) -> +comp_call_pre_post(noext, Prop, _, Type, TextPos, + OptTable, NumOptionals, Ext) -> %% OPTIONAL or DEFAULT OptPos = get_optionality_pos(TextPos, OptTable), Element = case NumOptionals - OptPos of @@ -1222,7 +1261,7 @@ comp_call_pre_post(noext, Prop, _, _, TextPos, OptTable, NumOptionals, Ext) -> emit([";",nl, "0 ->",nl, "{"]), - gen_dec_component_no_val(Ext, Prop), + gen_dec_component_no_val(Ext, Type, Prop), emit([",",{curr,bytes},"}",nl, "end"]), St @@ -1244,10 +1283,10 @@ comp_call_pre_post({ext,_,_}, Prop, Pos, Type, _, _, _, Ext) -> components=ExtGroupCompList2}} when is_integer(Number2)-> emit("{extAddGroup,"), - gen_dec_extaddGroup_no_val(Ext, ExtGroupCompList2), + gen_dec_extaddGroup_no_val(Ext, Type, ExtGroupCompList2), emit("}"); _ -> - gen_dec_component_no_val(Ext, Prop) + gen_dec_component_no_val(Ext, Type, Prop) end, emit([",",{curr,bytes},"}",nl, "end"]), @@ -1262,21 +1301,22 @@ is_mandatory_predef_tab_c(_, _, {"got objfun through args","ObjFun"}) -> is_mandatory_predef_tab_c(_,_,_) -> true. -gen_dec_extaddGroup_no_val(Ext,[#'ComponentType'{prop=Prop}])-> - gen_dec_component_no_val(Ext,Prop), +gen_dec_extaddGroup_no_val(Ext, Type, [#'ComponentType'{prop=Prop}])-> + gen_dec_component_no_val(Ext, Type, 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(_, []) -> +gen_dec_extaddGroup_no_val(Ext, Type, [#'ComponentType'{prop=Prop}|Rest])-> + gen_dec_component_no_val(Ext, Type, Prop), + emit(","), + gen_dec_extaddGroup_no_val(Ext, Type, Rest); +gen_dec_extaddGroup_no_val(_, _, []) -> ok. -gen_dec_component_no_val(_,{'DEFAULT',DefVal}) -> +gen_dec_component_no_val(_, Type, {'DEFAULT',DefVal0}) -> + DefVal = asn1ct_gen:conform_value(Type, DefVal0), emit([{asis,DefVal}]); -gen_dec_component_no_val(_,'OPTIONAL') -> +gen_dec_component_no_val(_, _, 'OPTIONAL') -> emit({"asn1_NOVALUE"}); -gen_dec_component_no_val({ext,_,_},mandatory) -> +gen_dec_component_no_val({ext,_,_}, _, mandatory) -> emit({"asn1_NOVALUE"}). @@ -1350,25 +1390,19 @@ gen_dec_line_special(Erule, {typefield,_}, _TopType, Comp, false -> % This is in a choice with typefield components {Name,RestFieldNames} = (Type#type.def)#'ObjectClassFieldType'.fieldname, - - asn1ct_name:new(reason), Imm = asn1ct_imm:per_dec_open_type(is_aligned(Erule)), BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)), {TmpTerm,TempBuf} = asn1ct_imm:dec_slim_cg(Imm, BytesVar), + emit([com,nl]), + #type{tablecinf=[{objfun, + #'Externaltypereference'{module=Xmod, + type=Xtype}}]} = + Type, + gen_dec_open_type(Erule, "ObjFun", {Xmod,Xtype}, + '_', {'_',{Name,RestFieldNames}, + 'Result',TmpTerm,mandatory}), emit([com,nl, - {next,bytes}," = ",TempBuf,com,nl, - indent(2),"case (catch ObjFun(", - {asis,Name},",",TmpTerm,",telltype,", - {asis,RestFieldNames},")) of", nl]), - emit([indent(4),"{'EXIT',",{curr,reason},"} ->",nl]), - emit([indent(6),"exit({'Type not ", - "compatible with table constraint', ", - {curr,reason},"});",nl]), - asn1ct_name:new(tmpterm), - emit([indent(4),"{",{curr,tmpterm},", _} ->",nl]), - emit([indent(6),"{",{asis,Cname},", {",{curr,tmpterm},", ", - {next,bytes},"}}",nl]), - emit([indent(2),"end"]), + "{",{asis,Cname},",{Result,",TempBuf,"}}"]), {[],PrevSt}; {"got objfun through args","ObjFun"} -> %% this is when the generated code gots the @@ -1388,27 +1422,22 @@ gen_dec_line_special(Erule, {typefield,_}, _TopType, Comp, BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)), asn1ct_imm:dec_code_gen(Imm, BytesVar), emit([com,nl]), + #type{tablecinf=[{objfun, + #'Externaltypereference'{module=Xmod, + type=Xtype}}]} = + Type, + Term = asn1ct_gen:mk_var(asn1ct_name:curr(term)), + TmpTerm = asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)), if Prop =:= mandatory -> - emit([{curr,term}," =",nl," "]); - true -> - emit([" {"]) - end, - emit(["case (catch ObjFun(",{asis,Name},",", - {curr,tmpterm},",telltype,", - {asis,RestFieldNames},")) of", nl]), - emit([" {'EXIT',",{curr,reason},"} ->",nl]), - emit([indent(6),"exit({'Type not ", - "compatible with table constraint', ", - {curr,reason},"});",nl]), - asn1ct_name:new(tmpterm), - emit([indent(4),"{",{curr,tmpterm},", _} ->",nl]), - emit([indent(6),{curr,tmpterm},nl]), - emit([indent(2),"end"]), - if - Prop =:= mandatory -> - ok; + gen_dec_open_type(Erule, "ObjFun", {Xmod,Xtype}, + '_', {'_',{Name,RestFieldNames}, + Term,TmpTerm,Prop}); true -> + emit([" {"]), + gen_dec_open_type(Erule, "ObjFun", {Xmod,Xtype}, + '_', {'_',{Name,RestFieldNames}, + '_',TmpTerm,Prop}), emit([",",nl,{curr,tmpbytes},"}"]) end, {[],PrevSt}; @@ -1425,19 +1454,6 @@ gen_dec_line_special(Erule, {typefield,_}, _TopType, Comp, Prop}],PrevSt} end end; -gen_dec_line_special(Erule, {objectfield,PrimFieldName1,PFNList}, _TopType, - Comp, _DecInfObj) -> - fun({_BytesVar,PrevSt}) -> - Imm = asn1ct_imm:per_dec_open_type(is_aligned(Erule)), - BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)), - asn1ct_imm:dec_code_gen(Imm, BytesVar), - #'ComponentType'{name=Cname,prop=Prop} = Comp, - SaveBytes = [{Cname,{PrimFieldName1,PFNList}, - asn1ct_gen:mk_var(asn1ct_name:curr(term)), - asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)), - Prop}], - {SaveBytes,PrevSt} - end; gen_dec_line_special(Erule, Atype, TopType, Comp, DecInfObj) -> case gen_dec_line_other(Erule, Atype, TopType, Comp) of Fun when is_function(Fun, 1) -> @@ -1458,14 +1474,11 @@ gen_dec_line_special(Erule, Atype, TopType, Comp, DecInfObj) -> gen_dec_line_dec_inf(Comp, DecInfObj) -> #'ComponentType'{name=Cname} = Comp, case DecInfObj of - {Cname,{_,OSet,UniqueFName,ValIndex}} -> + {Cname,{_,_OSet,_UniqueFName,ValIndex}} -> Term = asn1ct_gen:mk_var(asn1ct_name:curr(term)), ValueMatch = value_match(ValIndex,Term), - {ObjSetMod,ObjSetName} = OSet, emit([",",nl, - "ObjFun = ",{asis,ObjSetMod}, - ":'getdec_",ObjSetName,"'(", - {asis,UniqueFName},", ",ValueMatch,")"]); + "ObjFun = ",ValueMatch]); _ -> ok end. @@ -1492,63 +1505,35 @@ gen_dec_line_other(Erule, Atype, TopType, Comp) -> [{objfun,_}|_R] -> fun(BytesVar) -> emit({"'dec_",asn1ct_gen:list2name(NewTypename), - "'(",BytesVar,", telltype, ObjFun)"}) + "'(",BytesVar,", ObjFun)"}) end; _ -> fun(BytesVar) -> emit({"'dec_",asn1ct_gen:list2name(NewTypename), - "'(",BytesVar,", telltype)"}) + "'(",BytesVar,")"}) end end end. -gen_enc_choice(Erule,TopType,CompList,Ext) -> - gen_enc_choice_tag(Erule, CompList, [], Ext), - emit({com,nl}), - emit({"case element(1,Val) of",nl}), - gen_enc_choice2(Erule,TopType, CompList, Ext), - emit({nl,"end"}). - -gen_enc_choice_tag(Erule, {C1,C2}, _, _) -> - N1 = get_name_list(C1), - N2 = get_name_list(C2), - call(Erule,set_choice, - ["element(1, Val)", - {asis,{N1,N2}}, - {asis,{length(N1),length(N2)}}]); -gen_enc_choice_tag(Erule, {C1,C2,C3}, _, _) -> - N1 = get_name_list(C1), - N2 = get_name_list(C2), - N3 = get_name_list(C3), - Root = N1 ++ N3, - call(Erule,set_choice, - ["element(1, Val)", - {asis,{Root,N2}}, - {asis,{length(Root),length(N2)}}]); -gen_enc_choice_tag(Erule, C, _, _) -> - N = get_name_list(C), - call(Erule,set_choice, - ["element(1, Val)", - {asis,N},{asis,length(N)}]). - -get_name_list(L) -> - get_name_list(L,[]). - -get_name_list([#'ComponentType'{name=Name}|T], Acc) -> - get_name_list(T,[Name|Acc]); -get_name_list([], Acc) -> - lists:reverse(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). +gen_enc_choice(Erule, TopType, {Root,Exts}, Ext) -> + Constr = choice_constraint(Root), + gen_enc_choices(Root, Erule, TopType, 0, Constr, Ext) ++ + gen_enc_choices(Exts, Erule, TopType, 0, ext, Ext); +gen_enc_choice(Erule, TopType, {Root,Exts,[]}, Ext) -> + gen_enc_choice(Erule, TopType, {Root,Exts}, Ext); +gen_enc_choice(Erule, TopType, Root, Ext) when is_list(Root) -> + Constr = choice_constraint(Root), + gen_enc_choices(Root, Erule, TopType, 0, Constr, Ext). + +choice_constraint(L) -> + case length(L) of + 0 -> [{'SingleValue',0}]; + Len -> [{'ValueRange',{0,Len-1}}] + end. -gen_enc_choice2(Erule, TopType, [H|T], Pos, Sep0, Ext) -> +gen_enc_choices([H|T], Erule, TopType, Pos, Constr, Ext) -> #'ComponentType'{name=Cname,typespec=Type} = H, + Aligned = is_aligned(Erule), EncObj = case asn1ct_gen:get_constraint(Type#type.constraint, componentrelation) of @@ -1562,16 +1547,25 @@ gen_enc_choice2(Erule, TopType, [H|T], Pos, Sep0, Ext) -> _ -> {no_attr,"ObjFun"} end, - emit([Sep0,{asis,Cname}," ->",nl]), - DoExt = case Ext of - {ext,ExtPos,_} when Pos + 1 < ExtPos -> noext; - _ -> Ext + DoExt = case Constr of + ext -> Ext; + _ -> noext end, - gen_enc_line(Erule, TopType, Cname, Type, "element(2, Val)", - Pos+1, EncObj, DoExt), - Sep = [";",nl], - gen_enc_choice2(Erule, TopType, T, Pos+1, Sep, Ext); -gen_enc_choice2(_, _, [], _, _, _) -> ok. + Tag = case {Ext,Constr} of + {noext,_} -> + asn1ct_imm:per_enc_integer(Pos, Constr, Aligned); + {{ext,_,_},ext} -> + [{put_bits,1,1,[1]}| + asn1ct_imm:per_enc_small_number(Pos, Aligned)]; + {{ext,_,_},_} -> + [{put_bits,0,1,[1]}| + asn1ct_imm:per_enc_integer(Pos, Constr, Aligned)] + end, + Body = gen_enc_line_imm(Erule, TopType, Cname, Type, 'ChoiceVal', + EncObj, DoExt), + Imm = Tag ++ Body, + [{Cname,Imm}|gen_enc_choices(T, Erule, TopType, Pos+1, Constr, Ext)]; +gen_enc_choices([], _, _, _, _, _) -> []. %% Generate the code for CHOICE. If the CHOICE is extensible, %% the structure of the generated code is as follows: @@ -1704,9 +1698,6 @@ gen_dec_choice2(Erule, TopType, [H0|T], Pos, Sep0, Pre) -> gen_dec_choice2(Erule, TopType, T, Pos+1, Sep, Pre); gen_dec_choice2(_, _, [], _, _, _) -> ok. -indent(N) -> - lists:duplicate(N,32). % 32 = space - make_elements(I,Val,ExtCnames) -> make_elements(I,Val,ExtCnames,[]). @@ -1720,7 +1711,7 @@ make_elements(_I,_,[],Acc) -> lists:reverse(Acc). make_element(I, Val) -> - io_lib:format("element(~w,~s)", [I,Val]). + lists:flatten(io_lib:format("element(~w, ~s)", [I,Val])). emit_extaddgroupTerms(VarSeries,[_]) -> asn1ct_name:new(VarSeries), @@ -1787,6 +1778,3 @@ value_match1(Value,[],Acc,Depth) -> Acc ++ Value ++ lists:concat(lists:duplicate(Depth,")")); value_match1(Value,[{VI,_}|VIs],Acc,Depth) -> value_match1(Value,VIs,Acc++lists:concat(["element(",VI,","]),Depth+1). - -is_optimized(per) -> true; -is_optimized(uper) -> false. diff --git a/lib/asn1/src/asn1ct_eval_per.funcs b/lib/asn1/src/asn1ct_eval_per.funcs deleted file mode 100644 index a1ea5cd043..0000000000 --- a/lib/asn1/src/asn1ct_eval_per.funcs +++ /dev/null @@ -1,2 +0,0 @@ -{per,encode_constrained_number,2}. -{per,encode_small_number,1}. diff --git a/lib/asn1/src/asn1ct_eval_uper.funcs b/lib/asn1/src/asn1ct_eval_uper.funcs deleted file mode 100644 index 884a486f40..0000000000 --- a/lib/asn1/src/asn1ct_eval_uper.funcs +++ /dev/null @@ -1,2 +0,0 @@ -{uper,encode_constrained_number,2}. -{uper,encode_small_number,1}. diff --git a/lib/asn1/src/asn1ct_func.erl b/lib/asn1/src/asn1ct_func.erl index ab0dbcce8f..dbadedb683 100644 --- a/lib/asn1/src/asn1ct_func.erl +++ b/lib/asn1/src/asn1ct_func.erl @@ -19,7 +19,7 @@ %% -module(asn1ct_func). --export([start_link/0,need/1,call/3,generate/1]). +-export([start_link/0,need/1,call/3,call_gen/3,call_gen/4,generate/1]). -export([init/1,handle_call/3,handle_cast/2,terminate/2]). start_link() -> @@ -28,15 +28,33 @@ start_link() -> ok. call(M, F, Args) -> - MFA = {M,F,length(Args)}, + A = length(Args), + MFA = {M,F,A}, need(MFA), - asn1ct_gen:emit([F,"(",call_args(Args, ""),")"]). + case M of + binary -> + asn1ct_gen:emit(["binary:",F,"(",call_args(Args, ""),")"]); + _ -> + asn1ct_gen:emit([F,"(",call_args(Args, ""),")"]) + end. +need({binary,_,_}) -> + ok; +need({erlang,_,_}) -> + ok; need(MFA) -> asn1ct_rtt:assert_defined(MFA), cast({need,MFA}). +call_gen(Prefix, Key, Gen, Args) when is_function(Gen, 2) -> + F = req({gen_func,Prefix,Key,Gen}), + asn1ct_gen:emit([F,"(",call_args(Args, ""),")"]). + +call_gen(Prefix, Key, Gen) when is_function(Gen, 2) -> + req({gen_func,Prefix,Key,Gen}). + generate(Fd) -> + do_generate(Fd), Used0 = req(get_used), erase(?MODULE), Used = sofs:set(Used0, [mfa]), @@ -53,10 +71,13 @@ cast(Req) -> %%% Internal functions. --record(st, {used}). +-record(st, {used, %Used functions + gen, %Dynamically generated functions + gc=1 %Counter for generated functions + }). init([]) -> - St = #st{used=gb_sets:empty()}, + St = #st{used=gb_sets:empty(),gen=gb_trees:empty()}, {ok,St}. handle_cast({need,MFA}, #st{used=Used0}=St) -> @@ -69,7 +90,20 @@ handle_cast({need,MFA}, #st{used=Used0}=St) -> end. handle_call(get_used, _From, #st{used=Used}=St) -> - {stop,normal,gb_sets:to_list(Used),St}. + {stop,normal,gb_sets:to_list(Used),St}; +handle_call(get_gen, _From, #st{gen=G0}=St) -> + {L,G} = do_get_gen(gb_trees:to_list(G0), [], []), + {reply,L,St#st{gen=gb_trees:from_orddict(G)}}; +handle_call({gen_func,Prefix,Key,GenFun}, _From, #st{gen=G0,gc=Gc0}=St) -> + case gb_trees:lookup(Key, G0) of + none -> + Name = list_to_atom(Prefix ++ integer_to_list(Gc0)), + Gc = Gc0 + 1, + G = gb_trees:insert(Key, {Name,GenFun}, G0), + {reply,Name,St#st{gen=G,gc=Gc}}; + {value,{Name,_}} -> + {reply,Name,St} + end. terminate(_, _) -> ok. @@ -98,3 +132,22 @@ update_worklist([H|T], Used, Ws) -> update_worklist(T, Used, Ws) end; update_worklist([], _, Ws) -> Ws. + +do_get_gen([{_,{_,done}}=Keep|T], Gacc, Kacc) -> + do_get_gen(T, Gacc, [Keep|Kacc]); +do_get_gen([{K,{Name,_}=V}|T], Gacc, Kacc) -> + do_get_gen(T, [V|Gacc], [{K,{Name,done}}|Kacc]); +do_get_gen([], Gacc, Kacc) -> + {lists:sort(Gacc),lists:reverse(Kacc)}. + +do_generate(Fd) -> + case req(get_gen) of + [] -> + ok; + [_|_]=Gen -> + _ = [begin + ok = file:write(Fd, "\n"), + GenFun(Fd, Name) + end || {Name,GenFun} <- Gen], + do_generate(Fd) + end. diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index 9095e145a3..30d337635b 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -33,7 +33,9 @@ insert_once/2, ct_gen_module/1, index2suffix/1, - get_record_name_prefix/0]). + get_record_name_prefix/0, + conform_value/2, + named_bitstring_value/2]). -export([pgen/5, mk_var/1, un_hyphen_var/1]). @@ -85,6 +87,8 @@ pgen_module(OutFile,Erules,Module, "%%%",nl]), asn1ct_func:generate(Fid), file:close(Fid), + _ = erase(gen_file_out), + _ = erase(outfile), asn1ct:verbose("--~p--~n",[{generated,ErlFile}],Options). @@ -798,7 +802,12 @@ pgen_exports(Erules,_Module,{Types,Values,_,_,Objects,ObjectSets}) -> gen_exports1(Types,"enc_",1) end, emit({"-export([",nl}), - gen_exports1(Types,"dec_",2) + case Erules of + ber -> + gen_exports1(Types, "dec_", 2); + _ -> + gen_exports1(Types, "dec_", 1) + end end, case [X || {n2n,X} <- get(encoding_options)] of [] -> ok; @@ -819,10 +828,7 @@ pgen_exports(Erules,_Module,{Types,Values,_,_,Objects,ObjectSets}) -> _ -> case erule(Erules) of per -> - emit({"-export([",nl}), - gen_exports1(Objects,"enc_",3), - emit({"-export([",nl}), - gen_exports1(Objects,"dec_",4); + ok; ber -> emit({"-export([",nl}), gen_exports1(Objects,"enc_",3), @@ -833,10 +839,15 @@ pgen_exports(Erules,_Module,{Types,Values,_,_,Objects,ObjectSets}) -> case ObjectSets of [] -> ok; _ -> - emit({"-export([",nl}), - gen_exports1(ObjectSets,"getenc_",2), - emit({"-export([",nl}), - gen_exports1(ObjectSets,"getdec_",2) + case erule(Erules) of + per -> + ok; + ber -> + emit({"-export([",nl}), + gen_exports1(ObjectSets, "getenc_",1), + emit({"-export([",nl}), + gen_exports1(ObjectSets, "getdec_",1) + end end, emit({"-export([info/0]).",nl}), gen_partial_inc_decode_exports(), @@ -900,41 +911,45 @@ pgen_dispatcher(Erules,_Module,{[],_Values,_,_,_Objects,_ObjectSets}) -> pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> emit(["-export([encode/2,decode/2]).",nl,nl]), gen_info_functions(Erules), - NoFinalPadding = lists:member(no_final_padding,get(encoding_options)), - {Call,BytesAsBinary} = - case Erules of - per -> - asn1ct_func:need({Erules,complete,1}), - {["complete(encode_disp(Type, Data))"],"Bytes"}; - ber -> - {"encode_disp(Type,Data)","iolist_to_binary(Bytes)"}; - uper when NoFinalPadding == true -> - asn1ct_func:need({Erules,complete_NFP,1}), - {"complete_NFP(encode_disp(Type, Data))","Bytes"}; - uper -> - asn1ct_func:need({Erules,complete,1}), - {["complete(encode_disp(Type, Data))"],"Bytes"} - end, - emit(["encode(Type,Data) ->",nl, - "case catch ",Call," of",nl, - " {'EXIT',{error,Reason}} ->",nl, - " {error,Reason};",nl, - " {'EXIT',Reason} ->",nl, - " {error,{asn1,Reason}};",nl, - " {Bytes,_Len} ->",nl, - " {ok,",BytesAsBinary,"};",nl, - " Bytes ->",nl, - " {ok,",BytesAsBinary,"}",nl, - "end.",nl,nl]), - - Return_rest = lists:member(undec_rest,get(encoding_options)), + + Options = get(encoding_options), + NoFinalPadding = lists:member(no_final_padding, Options), + NoOkWrapper = proplists:get_bool(no_ok_wrapper, Options), + + Call = case Erules of + per -> + asn1ct_func:need({Erules,complete,1}), + "complete(encode_disp(Type, Data))"; + ber -> + "iolist_to_binary(element(1, encode_disp(Type, Data)))"; + uper when NoFinalPadding == true -> + asn1ct_func:need({Erules,complete_NFP,1}), + "complete_NFP(encode_disp(Type, Data))"; + uper -> + asn1ct_func:need({Erules,complete,1}), + "complete(encode_disp(Type, Data))" + end, + + emit(["encode(Type, Data) ->",nl]), + case NoOkWrapper of + true -> + emit([" ",Call,"."]); + false -> + emit(["try ",Call," of",nl, + " Bytes ->",nl, + " {ok,Bytes}",nl, + try_catch()]) + end, + emit([nl,nl]), + + Return_rest = proplists:get_bool(undec_rest, Options), Data = case {Erules,Return_rest} of {ber,true} -> "Data0"; _ -> "Data" end, emit(["decode(Type,",Data,") ->",nl]), - DecAnonymous = + DecWrap = case {Erules,Return_rest} of {ber,false} -> asn1ct_func:need({ber,ber_decode_nif,1}), @@ -946,49 +961,26 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> _ -> "Data" end, - DecWrap = case Erules of - ber -> - DecAnonymous; - _ -> "Data" - end, - - emit(["case catch decode_disp(Type,",DecWrap,") of",nl, - " {'EXIT',{error,Reason}} ->",nl, - " {error,Reason};",nl, - " {'EXIT',Reason} ->",nl, - " {error,{asn1,Reason}};",nl]), - case {Erules,Return_rest} of - {ber,false} -> - emit([" Result ->",nl, - " {ok,Result}",nl]); - {ber,true} -> - emit([" Result ->",nl, - " {ok,Result,Rest}",nl]); - {_,false} -> - emit([" {X,_Rest} ->",nl, - " {ok,X};",nl, - " {X,_Rest,_Len} ->",nl, - " {ok,X}",nl]); - {per,true} -> - emit([" {X,{_,Rest}} ->",nl, - " {ok,X,Rest};",nl, - " {X,{_,Rest},_Len} ->",nl, - " {ok,X,Rest};",nl, - " {X,Rest} ->",nl, - " {ok,X,Rest};",nl, - " {X,Rest,_Len} ->",nl, - " {ok,X,Rest}",nl]); - {uper,true} -> - emit([" {X,{_,Rest}} ->",nl, - " {ok,X,Rest};",nl, - " {X,{_,Rest},_Len} ->",nl, - " {ok,X,Rest};",nl, - " {X,Rest} ->",nl, - " {ok,X,Rest};",nl, - " {X,Rest,_Len} ->",nl, - " {ok,X,Rest}",nl]) + emit([case NoOkWrapper of + false -> "try"; + true -> "case" + end, " decode_disp(Type, ",DecWrap,") of",nl]), + case erule(Erules) of + ber -> + emit([" Result ->",nl]); + per -> + emit([" {Result,Rest} ->",nl]) + end, + case Return_rest of + false -> result_line(NoOkWrapper, ["Result"]); + true -> result_line(NoOkWrapper, ["Result","Rest"]) + end, + case NoOkWrapper of + false -> + emit([nl,try_catch(),nl,nl]); + true -> + emit([nl,"end.",nl,nl]) end, - emit(["end.",nl,nl]), gen_decode_partial_incomplete(Erules), @@ -999,10 +991,32 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> gen_partial_inc_dispatcher(); _PerOrPer_bin -> gen_dispatcher(Types,"encode_disp","enc_",""), - gen_dispatcher(Types,"decode_disp","dec_",",mandatory") + gen_dispatcher(Types,"decode_disp","dec_","") end, - emit([nl]), - emit({nl,nl}). + emit([nl,nl]). + +result_line(NoOkWrapper, Items) -> + S = [" "|case NoOkWrapper of + false -> result_line_1(["ok"|Items]); + true -> result_line_1(Items) + end], + emit(lists:flatten(S)). + +result_line_1([SingleItem]) -> + SingleItem; +result_line_1(Items) -> + ["{",string:join(Items, ","),"}"]. + +try_catch() -> + [" catch",nl, + " Class:Exception when Class =:= error; Class =:= exit ->",nl, + " case Exception of",nl, + " {error,Reason}=Error ->",nl, + " Error;",nl, + " Reason ->",nl, + " {error,{asn1,Reason}}",nl, + " end",nl, + "end."]. gen_info_functions(Erules) -> emit(["encoding_rule() -> ", @@ -1473,8 +1487,14 @@ gen_prim_check_call(PrimType, Default, Element, Type) -> end, check_call(check_int, [Default,Element,{asis,NNL}]); 'BIT STRING' -> - {_,NBL} = Type#type.def, - check_call(check_bitstring, [Default,Element,{asis,NBL}]); + case Type#type.def of + {_,[]} -> + check_call(check_bitstring, + [Default,Element]); + {_,[_|_]=NBL} -> + check_call(check_named_bitstring, + [Default,Element,{asis,NBL}]) + end; 'OCTET STRING' -> check_call(check_octetstring, [Default,Element]); 'NULL' -> @@ -1628,9 +1648,33 @@ unify_if_string(PrimType) -> Other -> Other end. - - - +conform_value(#type{def={'BIT STRING',[]}}, Bs) -> + case asn1ct:get_bit_string_format() of + compact when is_binary(Bs) -> + {0,Bs}; + compact when is_bitstring(Bs) -> + Sz = bit_size(Bs), + Unused = 8 - bit_size(Bs), + {Unused,<<Bs:Sz/bits,0:Unused>>}; + legacy -> + [B || <<B:1>> <= Bs]; + bitstring when is_bitstring(Bs) -> + Bs + end; +conform_value(_, Value) -> Value. + +named_bitstring_value(List, Names) -> + Int = lists:foldl(fun(N, A) -> + {N,Pos} = lists:keyfind(N, 1, Names), + A bor (1 bsl Pos) + end, 0, List), + named_bitstring_value_1(<<>>, Int). + +named_bitstring_value_1(Bs, 0) -> + Bs; +named_bitstring_value_1(Bs, Int) -> + B = Int band 1, + named_bitstring_value_1(<<Bs/bitstring,B:1>>, Int bsr 1). get_inner(A) when is_atom(A) -> A; get_inner(Ext) when is_record(Ext,'Externaltypereference') -> Ext; diff --git a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl index 8ab49aec2c..de81259fcb 100644 --- a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl @@ -196,8 +196,16 @@ gen_encode_prim(_Erules, #type{}=D, DoTag, Value) -> emit(["case ",Value," of",nl]), emit_enc_enumerated_cases(NamedNumberList,DoTag); 'REAL' -> - emit([{call,ber,encode_tags, - [DoTag,{call,real_common,ber_encode_real,[Value]}]}]); + asn1ct_name:new(realval), + asn1ct_name:new(realsize), + emit(["begin",nl, + {curr,realval}," = ", + {call,real_common,ber_encode_real,[Value]},com,nl, + {curr,realsize}," = ", + {call,erlang,byte_size,[{curr,realval}]},com,nl, + {call,ber,encode_tags, + [DoTag,{curr,realval},{curr,realsize}]},nl, + "end"]); {'BIT STRING',NamedNumberList} -> call(encode_bit_string, [{asis,BitStringConstraint},Value, @@ -637,9 +645,6 @@ gen_encode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest], % ", Val, RestPrimFieldName) ->",nl]), MaybeConstr= case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> %% this case is illegal - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); {false,'OPTIONAL'} -> EmitFuncClause("Val"), emit([" {Val,0}"]), @@ -672,9 +677,6 @@ gen_encode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest], % emit(["'enc_",ObjName,"'(",{asis,Name}, % ", Val,[H|T]) ->",nl]), case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); {false,'OPTIONAL'} -> EmitFuncClause("_,_"), emit([" exit({error,{'use of missing field in object', ",{asis,Name}, @@ -807,9 +809,6 @@ gen_decode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest], % ", Bytes, RestPrimFieldName) ->",nl]), MaybeConstr= case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> %% this case is illegal - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); {false,'OPTIONAL'} -> EmitFuncClause(" Bytes"), emit([" Bytes"]), @@ -844,9 +843,6 @@ gen_decode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest], % ", Bytes,[H|T]) ->",nl]), % emit_tlv_format("Bytes"), case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); {false,'OPTIONAL'} -> EmitFuncClause("_,_"), emit([" exit({error,{'illegal use of missing field in object', ",{asis,Name}, @@ -1072,8 +1068,7 @@ gen_objset_enc(_,_,{unique,undefined},_,_,_,_,_) -> gen_objset_enc(Erules, ObjSetName, UniqueName, [{ObjName,Val,Fields}|T], ClName, ClFields, NthObj,Acc)-> - emit(["'getenc_",ObjSetName,"'(",{asis,UniqueName},",",{asis,Val}, - ") ->",nl]), + emit(["'getenc_",ObjSetName,"'(",{asis,Val},") ->",nl]), CurrMod = get(currmod), {InternalFunc,NewNthObj}= case ObjName of @@ -1095,7 +1090,7 @@ gen_objset_enc(Erules, ObjSetName, UniqueName, %% See X.681 Annex E for the following case gen_objset_enc(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, _ClFields,_NthObj,Acc) -> - emit({"'getenc_",ObjSetName,"'(_, _) ->",nl}), + emit(["'getenc_",ObjSetName,"'(_) ->",nl]), emit({indent(3),"fun(_, Val, _RestPrimFieldName) ->",nl}), emit({indent(6),"Len = case Val of",nl,indent(9), "Bin when is_binary(Bin) -> byte_size(Bin);",nl,indent(9), @@ -1113,7 +1108,7 @@ emit_ext_fun(EncDec,ModuleName,Name) -> Name,"'(T,V,O) end"]). emit_default_getenc(ObjSetName,UniqueName) -> - emit(["'getenc_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]), + emit(["'getenc_",ObjSetName,"'(ErrV) ->",nl]), emit([indent(3),"fun(C,V,_) -> exit({'Type not compatible with table constraint',{component,C},{value,V}, {unique_name_and_value,",{asis,UniqueName},", ErrV}}) end"]). %% gen_inlined_enc_funs for each object iterates over all fields of a @@ -1240,8 +1235,7 @@ gen_objset_dec(_,_,{unique,undefined},_,_,_,_) -> ok; gen_objset_dec(Erules, ObjSName, UniqueName, [{ObjName,Val,Fields}|T], ClName, ClFields, NthObj)-> - emit(["'getdec_",ObjSName,"'(",{asis,UniqueName},",", - {asis,Val},") ->",nl]), + emit(["'getdec_",ObjSName,"'(",{asis,Val},") ->",nl]), CurrMod = get(currmod), NewNthObj= case ObjName of @@ -1262,7 +1256,7 @@ gen_objset_dec(Erules, ObjSName, UniqueName, [{ObjName,Val,Fields}|T], ClFields, NewNthObj); gen_objset_dec(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, _ClFields,_NthObj) -> - emit(["'getdec_",ObjSetName,"'(_, _) ->",nl]), + emit(["'getdec_",ObjSetName,"'(_) ->",nl]), emit([indent(2),"fun(_,Bytes, _RestPrimFieldName) ->",nl]), emit([indent(4),"case Bytes of",nl, @@ -1279,7 +1273,7 @@ gen_objset_dec(_, ObjSetName, UniqueName, [], _, _, _) -> ok. emit_default_getdec(ObjSetName,UniqueName) -> - emit(["'getdec_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]), + emit(["'getdec_",ObjSetName,"'(ErrV) ->",nl]), emit([indent(2), "fun(C,V,_) -> exit({{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},", ErrV}}) end"]). gen_inlined_dec_funs(Fields, ClFields, ObjSetName, NthObj) -> diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl index 69d9d51bf1..8b999ddbf0 100644 --- a/lib/asn1/src/asn1ct_gen_per.erl +++ b/lib/asn1/src/asn1ct_gen_per.erl @@ -26,7 +26,7 @@ %-compile(export_all). -export([gen_dec_imm/2]). --export([gen_dec_prim/3,gen_encode_prim/3]). +-export([gen_dec_prim/3,gen_encode_prim_imm/3]). -export([gen_obj_code/3,gen_objectset_code/2]). -export([gen_decode/2, gen_decode/3]). -export([gen_encode/2, gen_encode/3]). @@ -102,832 +102,106 @@ gen_encode_prim(Erules, D) -> Value = asn1ct_gen:mk_var(asn1ct_name:curr(val)), gen_encode_prim(Erules, D, Value). -gen_encode_prim(Erules, #type{def={'ENUMERATED',{N1,N2}}}, Value) -> - NewList = [{0,X} || {X,_} <- N1] ++ ['EXT_MARK'] ++ - [{1,X} || {X,_} <- N2], - NewC = {0,length(N1)-1}, - emit(["case ",Value," of",nl]), - emit_enc_enumerated_cases(Erules, NewC, NewList, 0); -gen_encode_prim(Erules, #type{def={'ENUMERATED',NNL}}, Value) -> - NewList = [X || {X,_} <- NNL], - NewC = {0,length(NewList)-1}, - emit(["case ",Value," of",nl]), - emit_enc_enumerated_cases(Erules, NewC, NewList, 0); -gen_encode_prim(per=Erules, D, Value) -> - asn1ct_gen_per_rt2ct:gen_encode_prim(Erules, D, Value); gen_encode_prim(Erules, #type{}=D, Value) -> - Constraint = D#type.constraint, - SizeConstr = asn1ct_imm:effective_constraint(bitstring, Constraint), - Pa = case lists:keyfind('PermittedAlphabet', 1, Constraint) of - false -> no; - {_,Pa0} -> Pa0 - end, - case D#type.def of + Aligned = case Erules of + uper -> false; + per -> true + end, + Imm = gen_encode_prim_imm(Value, D, Aligned), + asn1ct_imm:enc_cg(Imm, Aligned). + +gen_encode_prim_imm(Val, #type{def=Type0,constraint=Constraint}, Aligned) -> + case simplify_type(Type0) of + k_m_string -> + Type = case Type0 of + 'GeneralizedTime' -> 'VisibleString'; + 'UTCTime' -> 'VisibleString'; + _ -> Type0 + end, + asn1ct_imm:per_enc_k_m_string(Val, Type, Constraint, Aligned); + restricted_string -> + ToBinary = {erlang,iolist_to_binary}, + asn1ct_imm:per_enc_restricted_string(Val, ToBinary, Aligned); + {'ENUMERATED',NNL} -> + asn1ct_imm:per_enc_enumerated(Val, NNL, Aligned); 'INTEGER' -> - Args = [{asis,asn1ct_imm:effective_constraint(integer,Constraint)}, - Value], - call(Erules, encode_integer, Args); - {'INTEGER',NamedNumberList} -> - Args = [{asis,asn1ct_imm:effective_constraint(integer,Constraint)}, - Value,{asis,NamedNumberList}], - call(Erules, encode_integer, Args); + asn1ct_imm:per_enc_integer(Val, Constraint, Aligned); + {'INTEGER',NNL} -> + asn1ct_imm:per_enc_integer(Val, NNL, Constraint, Aligned); 'REAL' -> - emit_enc_real(Erules, Value); - - {'BIT STRING',NamedNumberList} -> - call(Erules, encode_bit_string, - [{asis,SizeConstr},Value, - {asis,NamedNumberList}]); + ToBinary = {real_common,encode_real}, + asn1ct_imm:per_enc_restricted_string(Val, ToBinary, Aligned); + {'BIT STRING',NNL} -> + asn1ct_imm:per_enc_bit_string(Val, NNL, Constraint, Aligned); 'NULL' -> - emit("[]"); + asn1ct_imm:per_enc_null(Val, Aligned); 'OBJECT IDENTIFIER' -> - call(Erules, encode_object_identifier, [Value]); + ToBinary = {per_common,encode_oid}, + asn1ct_imm:per_enc_restricted_string(Val, ToBinary, Aligned); 'RELATIVE-OID' -> - call(Erules, encode_relative_oid, [Value]); - 'ObjectDescriptor' -> - call(Erules, encode_ObjectDescriptor, - [{asis,Constraint},Value]); + ToBinary = {per_common,encode_relative_oid}, + asn1ct_imm:per_enc_restricted_string(Val, ToBinary, Aligned); 'BOOLEAN' -> - call(Erules, encode_boolean, [Value]); + asn1ct_imm:per_enc_boolean(Val, Aligned); 'OCTET STRING' -> - case SizeConstr of - 0 -> - emit("[]"); - no -> - call(Erules, encode_octet_string, [Value]); - C -> - call(Erules, encode_octet_string, [{asis,C},Value]) - end; - 'NumericString' -> - call(Erules, encode_NumericString, [{asis,SizeConstr}, - {asis,Pa},Value]); - TString when TString == 'TeletexString'; - TString == 'T61String' -> - call(Erules, encode_TeletexString, [{asis,Constraint},Value]); - 'VideotexString' -> - call(Erules, encode_VideotexString, [{asis,Constraint},Value]); - 'UTCTime' -> - call(Erules, encode_VisibleString, [{asis,SizeConstr}, - {asis,Pa},Value]); - 'GeneralizedTime' -> - call(Erules, encode_VisibleString, [{asis,SizeConstr}, - {asis,Pa},Value]); - 'GraphicString' -> - call(Erules, encode_GraphicString, [{asis,Constraint},Value]); - 'VisibleString' -> - call(Erules, encode_VisibleString, [{asis,SizeConstr}, - {asis,Pa},Value]); - 'GeneralString' -> - call(Erules, encode_GeneralString, [{asis,Constraint},Value]); - 'PrintableString' -> - call(Erules, encode_PrintableString, [{asis,SizeConstr}, - {asis,Pa},Value]); - 'IA5String' -> - call(Erules, encode_IA5String, [{asis,SizeConstr}, - {asis,Pa},Value]); - 'BMPString' -> - call(Erules, encode_BMPString, [{asis,SizeConstr}, - {asis,Pa},Value]); - 'UniversalString' -> - call(Erules, encode_UniversalString, [{asis,SizeConstr}, - {asis,Pa},Value]); - 'UTF8String' -> - call(Erules, encode_UTF8String, [Value]); + asn1ct_imm:per_enc_octet_string(Val, Constraint, Aligned); 'ASN1_OPEN_TYPE' -> - NewValue = case Constraint of - [#'Externaltypereference'{type=Tname}] -> - asn1ct_func:need({Erules,complete,1}), - io_lib:format( - "complete(enc_~s(~s))",[Tname,Value]); - [#type{def=#'Externaltypereference'{type=Tname}}] -> - asn1ct_func:need({Erules,complete,1}), - io_lib:format( - "complete(enc_~s(~s))", - [Tname,Value]); - _ -> - io_lib:format("iolist_to_binary(~s)", - [Value]) - end, - call(Erules, encode_open_type, [NewValue]) - end. - -emit_enc_real(Erules, Real) -> - asn1ct_name:new(tmpval), - asn1ct_name:new(tmplen), - emit(["begin",nl, - "{",{curr,tmpval},com,{curr,tmplen},"} = ", - {call,real_common,encode_real,[Real]},com,nl, - "[",{call,Erules,encode_length,[{curr,tmplen}]},",", - {curr,tmpval},"]",nl, - "end"]). - -emit_enc_enumerated_cases(Erules, C, ['EXT_MARK'|T], _Count) -> - %% Reset enumeration counter. - emit_enc_enumerated_cases(Erules, C, T, 0); -emit_enc_enumerated_cases(Erules, C, [H|T], Count) -> - emit_enc_enumerated_case(Erules, C, H, Count), - emit([";",nl]), - emit_enc_enumerated_cases(Erules, C, T, Count+1); -emit_enc_enumerated_cases(_Erules, _, [], _Count) -> - emit(["EnumVal -> " - "exit({error,{asn1,{enumerated_not_in_range, EnumVal}}})",nl, - "end"]). - -emit_enc_enumerated_case(Erules, C, {0,EnumName}, Count) -> - %% ENUMERATED with extensionmark; the value lies within then extension root - Enc = enc_ext_and_val(Erules, 0, encode_constrained_number, [C,Count]), - emit(["'",EnumName,"' -> ",{asis,Enc}]); -emit_enc_enumerated_case(Erules, _C, {1,EnumName}, Count) -> - %% ENUMERATED with extensionmark; the value is higher than extension root - Enc = enc_ext_and_val(Erules, 1, encode_small_number, [Count]), - emit(["'",EnumName,"' -> ",{asis,Enc}]); -emit_enc_enumerated_case(Erules, C, EnumName, Count) -> - %% ENUMERATED without extension - EvalMod = eval_module(Erules), - emit(["'",EnumName,"' -> ", - {asis,EvalMod:encode_constrained_number(C, Count)}]). - -enc_ext_and_val(per, E, F, Args) -> - [E|apply(asn1ct_eval_per, F, Args)]; -enc_ext_and_val(uper, E, F, Args) -> - Bs = list_to_bitstring([apply(asn1ct_eval_uper, F, Args)]), - <<E:1,Bs/bitstring>>. - - -%% Object code generating for encoding and decoding -%% ------------------------------------------------ - -gen_obj_code(Erules,_Module,Obj) when is_record(Obj,typedef) -> - ObjName = Obj#typedef.name, - Def = Obj#typedef.typespec, - #'Externaltypereference'{module=Mod,type=ClassName} = - Def#'Object'.classname, - Class = asn1_db:dbget(Mod,ClassName), - {object,_,Fields} = Def#'Object'.def, - emit({nl,nl,nl,"%%================================"}), - emit({nl,"%% ",ObjName}), - emit({nl,"%%================================",nl}), - EncConstructed = - gen_encode_objectfields(Erules, ClassName,get_class_fields(Class), - ObjName,Fields,[]), - emit(nl), - gen_encode_constr_type(Erules,EncConstructed), - emit(nl), - DecConstructed = - gen_decode_objectfields(Erules, ClassName, get_class_fields(Class), - ObjName, Fields, []), - emit(nl), - gen_decode_constr_type(Erules,DecConstructed), - emit(nl). - - -gen_encode_objectfields(Erule, ClassName, - [{typefield,Name,OptOrMand}|Rest], - ObjName, ObjectFields, ConstrAcc) -> - EmitFuncClause = - fun(V) -> - emit(["'enc_",ObjName,"'(",{asis,Name}, - ",",V,",_RestPrimFieldName) ->",nl]) - end, -% emit(["'enc_",ObjName,"'(",{asis,Name}, -% ", Val, _RestPrimFieldName) ->",nl]), - MaybeConstr = - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> %% this case is illegal - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause("Val"), - case Erule of - uper -> - emit(" Val"); - per -> - emit([" if",nl, - " is_list(Val) ->",nl, - " NewVal = list_to_binary(Val),",nl, - " [20,byte_size(NewVal),NewVal];",nl, - " is_binary(Val) ->",nl, - " [20,byte_size(Val),Val]",nl, - " end"]) - end, - []; - {false,{'DEFAULT',DefaultType}} -> - EmitFuncClause("Val"), - gen_encode_default_call(Erule, ClassName, Name, DefaultType); - {{Name,TypeSpec},_} -> - %% A specified field owerwrites any 'DEFAULT' or - %% 'OPTIONAL' field in the class - EmitFuncClause("Val"), - gen_encode_field_call(Erule, ObjName, Name, TypeSpec) - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_encode_objectfields(Erule,ClassName,Rest,ObjName,ObjectFields, - MaybeConstr++ConstrAcc); -gen_encode_objectfields(Erule,ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest], - ObjName,ObjectFields,ConstrAcc) -> - CurrentMod = get(currmod), - EmitFuncClause = - fun(Attrs) -> - emit(["'enc_",ObjName,"'(",{asis,Name}, - ",",Attrs,") ->",nl]) - end, -% emit(["'enc_",ObjName,"'(",{asis,Name}, -% ", Val,[H|T]) ->",nl]), - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause("_,_"), - emit([" exit({error,{'use of missing field in object', ",{asis,Name}, - "}})"]); - {false,{'DEFAULT',_DefaultObject}} -> - exit({error,{asn1,{"not implemented yet",Name}}}); - {{Name,#'Externalvaluereference'{module=CurrentMod, - value=TypeName}},_} -> - EmitFuncClause(" Val, [H|T]"), - emit({indent(3),"'enc_",TypeName,"'(H, Val, T)"}); - {{Name,#'Externalvaluereference'{module=M,value=TypeName}},_} -> - EmitFuncClause(" Val, [H|T]"), - emit({indent(3),"'",M,"':'enc_",TypeName,"'(H, Val, T)"}); - {{Name,TypeSpec},_} -> - EmitFuncClause("Val,[H|T]"), - case TypeSpec#typedef.name of - {ExtMod,TypeName} -> - emit({indent(3),"'",ExtMod,"':'enc_",TypeName, - "'(H, Val, T)"}); - TypeName -> - emit({indent(3),"'enc_",TypeName,"'(H, Val, T)"}) + case Constraint of + [#'Externaltypereference'{type=Tname}] -> + EncFunc = enc_func(Tname), + Imm = [{apply,EncFunc,[{expr,Val}]}], + asn1ct_imm:per_enc_open_type(Imm, Aligned); + [] -> + Imm = [{call,erlang,iolist_to_binary,[{expr,Val}]}], + asn1ct_imm:per_enc_open_type(Imm, Aligned) end - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_encode_objectfields(Erule,ClassName,Rest,ObjName,ObjectFields,ConstrAcc); -gen_encode_objectfields(Erule,ClassName,[_C|Cs],O,OF,Acc) -> - gen_encode_objectfields(Erule,ClassName,Cs,O,OF,Acc); -gen_encode_objectfields(_, _,[],_,_,Acc) -> - Acc. - - -gen_encode_constr_type(Erules,[TypeDef|Rest]) when is_record(TypeDef,typedef) -> - case is_already_generated(enc,TypeDef#typedef.name) of - true -> ok; - _ -> -%% FuncName = list_to_atom(lists:concat(["enc_",TypeDef#typedef.name])), - FuncName = asn1ct_gen:list2rname(TypeDef#typedef.name ++ [enc]), - emit(["'",FuncName,"'(Val) ->",nl]), - Def = TypeDef#typedef.typespec, - InnerType = asn1ct_gen:get_inner(Def#type.def), - asn1ct_gen:gen_encode_constructed(Erules,TypeDef#typedef.name, - InnerType,Def), - gen_encode_constr_type(Erules,Rest) - end; -gen_encode_constr_type(_,[]) -> - ok. - -gen_encode_field_call(_Erules, _ObjName, _FieldName, - #'Externaltypereference'{module=M,type=T}) -> - CurrentMod = get(currmod), - if - M == CurrentMod -> - emit({" 'enc_",T,"'(Val)"}), - []; - true -> - emit({" '",M,"':'enc_",T,"'(Val)"}), - [] - end; -gen_encode_field_call(Erules, ObjName, FieldName, Type) -> - Def = Type#typedef.typespec, - case Type#typedef.name of - {primitive,bif} -> - gen_encode_prim(Erules, Def, "Val"), - []; - {constructed,bif} -> - emit({" 'enc_",ObjName,'_',FieldName, - "'(Val)"}), -%% [Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}]; - [Type#typedef{name=[FieldName,ObjName]}]; - {ExtMod,TypeName} -> - emit({" '",ExtMod,"':'enc_",TypeName, - "'(Val)"}), - []; - TypeName -> - emit({" 'enc_",TypeName,"'(Val)"}), - [] end. -gen_encode_default_call(Erules, ClassName, FieldName, Type) -> - CurrentMod = get(currmod), - InnerType = asn1ct_gen:get_inner(Type#type.def), - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> -%% asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,Type); - emit([" 'enc_",ClassName,'_',FieldName,"'(Val)"]), -%% [#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])), - [#typedef{name=[FieldName,ClassName], - typespec=Type}]; - {primitive,bif} -> - gen_encode_prim(Erules, Type, "Val"), - []; - #'Externaltypereference'{module=CurrentMod,type=Etype} -> - emit([" 'enc_",Etype,"'(Val)",nl]), - []; - #'Externaltypereference'{module=Emod,type=Etype} -> - emit([" '",Emod,"':'enc_",Etype,"'(Val)",nl]), - [] - end. - - -gen_decode_objectfields(Erules, ClassName, - [{typefield,Name,OptOrMand}|Rest], - ObjName, ObjectFields, ConstrAcc) -> - EmitFuncClause = - fun(Bytes) -> - emit(["'dec_",ObjName,"'(",{asis,Name},",",Bytes, - ",_,_RestPrimFieldName) ->",nl]) - end, - MaybeConstr= - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> %% this case is illegal - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause("Bytes"), - emit([" {Bytes,[]}"]), - []; - {false,{'DEFAULT',DefaultType}} -> - EmitFuncClause("Bytes"), - gen_decode_default_call(Erules, ClassName, Name, "Bytes", - DefaultType); - {{Name,TypeSpec},_} -> - %% A specified field owerwrites any 'DEFAULT' or - %% 'OPTIONAL' field in the class - EmitFuncClause("Bytes"), - gen_decode_field_call(Erules, ObjName, Name, "Bytes", TypeSpec) - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_decode_objectfields(Erules, ClassName, Rest, ObjName, - ObjectFields, MaybeConstr++ConstrAcc); -gen_decode_objectfields(Erules, ClassName, - [{objectfield,Name,_,_,OptOrMand}|Rest], - ObjName, ObjectFields, ConstrAcc) -> - CurrentMod = get(currmod), - EmitFuncClause = - fun(Attrs) -> - emit(["'dec_",ObjName,"'(",{asis,Name}, - ",",Attrs,") ->",nl]) - end, -% emit(["'dec_",ObjName,"'(",{asis,Name}, -% ", Bytes,_,[H|T]) ->",nl]), - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause("_,_,_"), - emit([" exit({error,{'illegal use of missing field in object', ",{asis,Name}, - "}})"]); - {false,{'DEFAULT',_DefaultObject}} -> - exit({error,{asn1,{"not implemented yet",Name}}}); - {{Name,#'Externalvaluereference'{module=CurrentMod, - value=TypeName}},_} -> - EmitFuncClause("Bytes,_,[H|T]"), - emit({indent(3),"'dec_",TypeName,"'(H, Bytes, telltype, T)"}); - {{Name,#'Externalvaluereference'{module=M,value=TypeName}},_} -> - EmitFuncClause("Bytes,_,[H|T]"), - emit({indent(3),"'",M,"':'dec_",TypeName, - "'(H, Bytes, telltype, T)"}); - {{Name,TypeSpec},_} -> - EmitFuncClause("Bytes,_,[H|T]"), - case TypeSpec#typedef.name of - {ExtMod,TypeName} -> - emit({indent(3),"'",ExtMod,"':'dec_",TypeName, - "'(H, Bytes, telltype, T)"}); - TypeName -> - emit({indent(3),"'dec_",TypeName,"'(H, Bytes, telltype, T)"}) - end - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_decode_objectfields(Erules, ClassName, Rest, ObjName, - ObjectFields, ConstrAcc); -gen_decode_objectfields(Erules, CN, [_C|Cs], O, OF, CAcc) -> - gen_decode_objectfields(Erules, CN, Cs, O, OF, CAcc); -gen_decode_objectfields(_, _, [], _, _, CAcc) -> - CAcc. - - - -gen_decode_field_call(_Erules, _ObjName, _FieldName, Bytes, - #'Externaltypereference'{}=Etype) -> - emit(" "), - gen_dec_external(Etype, Bytes), - []; -gen_decode_field_call(Erules, ObjName, FieldName, Bytes, Type) -> - Def = Type#typedef.typespec, - case Type#typedef.name of - {primitive,bif} -> - gen_dec_prim(Erules, Def, Bytes), - []; - {constructed,bif} -> - emit({" 'dec_",ObjName,'_',FieldName, - "'(",Bytes,",telltype)"}), -%% [Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}]; - [Type#typedef{name=[FieldName,ObjName]}]; - {ExtMod,TypeName} -> - emit({" '",ExtMod,"':'dec_",TypeName, - "'(",Bytes,", telltype)"}), - []; - TypeName -> - emit({" 'dec_",TypeName,"'(",Bytes,", telltype)"}), - [] - end. - -gen_decode_default_call(Erules, ClassName, FieldName, Bytes, Type) -> - InnerType = asn1ct_gen:get_inner(Type#type.def), - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> - emit([" 'dec_",ClassName,'_',FieldName,"'(",Bytes,", telltype)"]), -%% [#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])), - [#typedef{name=[FieldName,ClassName], - typespec=Type}]; - {primitive,bif} -> - gen_dec_prim(Erules, Type, Bytes), - []; - #'Externaltypereference'{}=Etype -> - asn1ct_gen_per:gen_dec_external(Etype, Bytes), - [] +dec_func(Tname) -> + list_to_atom(lists:concat(["dec_",Tname])). + +enc_func(Tname) -> + list_to_atom(lists:concat(["enc_",Tname])). + +simplify_type(Type) -> + case Type of + 'BMPString' -> k_m_string; + 'IA5String' -> k_m_string; + 'NumericString' -> k_m_string; + 'PrintableString' -> k_m_string; + 'VisibleString' -> k_m_string; + 'UniversalString' -> k_m_string; + 'GeneralizedTime' -> k_m_string; + 'UTCTime' -> k_m_string; + 'TeletexString' -> restricted_string; + 'T61String' -> restricted_string; + 'VideotexString' -> restricted_string; + 'GraphicString' -> restricted_string; + 'GeneralString' -> restricted_string; + 'UTF8String' -> restricted_string; + 'ObjectDescriptor' -> restricted_string; + Other -> Other end. +%% Object code generating for encoding and decoding +%% ------------------------------------------------ -gen_decode_constr_type(Erules,[TypeDef|Rest]) when is_record(TypeDef,typedef) -> - case is_already_generated(dec,TypeDef#typedef.name) of - true -> ok; - _ -> - gen_decode(Erules,TypeDef#typedef{name=asn1ct_gen:list2rname(TypeDef#typedef.name)}) - end, - gen_decode_constr_type(Erules,Rest); -gen_decode_constr_type(_,[]) -> +gen_obj_code(_Erules, _Module, #typedef{}) -> ok. - -more_genfields([]) -> - false; -more_genfields([Field|Fields]) -> - case element(1,Field) of - typefield -> - true; - objectfield -> - true; - _ -> - more_genfields(Fields) - end. - %% Object Set code generating for encoding and decoding %% ---------------------------------------------------- -gen_objectset_code(Erules,ObjSet) -> - ObjSetName = ObjSet#typedef.name, - Def = ObjSet#typedef.typespec, -%% {ClassName,ClassDef} = Def#'ObjectSet'.class, - #'Externaltypereference'{module=ClassModule, - type=ClassName} = Def#'ObjectSet'.class, - ClassDef = asn1_db:dbget(ClassModule,ClassName), - UniqueFName = Def#'ObjectSet'.uniquefname, - Set = Def#'ObjectSet'.set, - emit({nl,nl,nl,"%%================================"}), - emit({nl,"%% ",ObjSetName}), - emit({nl,"%%================================",nl}), - case ClassName of - {_Module,ExtClassName} -> - gen_objset_code(Erules,ObjSetName,UniqueFName,Set, - ExtClassName,ClassDef); - _ -> - gen_objset_code(Erules,ObjSetName,UniqueFName,Set, - ClassName,ClassDef) - end, - emit(nl). - -gen_objset_code(Erules,ObjSetName,UniqueFName,Set,ClassName,ClassDef)-> - ClassFields = (ClassDef#classdef.typespec)#objectclass.fields, - InternalFuncs= - gen_objset_enc(Erules,ObjSetName,UniqueFName,Set,ClassName,ClassFields,1,[]), - gen_objset_dec(Erules, ObjSetName,UniqueFName,Set,ClassName,ClassFields,1), - gen_internal_funcs(Erules,InternalFuncs). - -%% gen_objset_enc iterates over the objects of the object set -gen_objset_enc(_,_,{unique,undefined},_,_,_,_,_) -> - %% There is no unique field in the class of this object set - %% don't bother about the constraint - []; -gen_objset_enc(Erule, ObjSetName, UniqueName, [{ObjName,Val,Fields}|T], - ClName, ClFields, NthObj, Acc)-> - emit(["'getenc_",ObjSetName,"'(",{asis,UniqueName},",",{asis,Val}, - ") ->",nl]), - CurrMod = get(currmod), - {InternalFunc,NewNthObj}= - case ObjName of - {no_mod,no_name} -> - gen_inlined_enc_funs(Erule, Fields, ClFields, - ObjSetName, NthObj); - {CurrMod,Name} -> - emit({" fun 'enc_",Name,"'/3"}), - {[],0}; - {ModName,Name} -> - emit_ext_encfun(ModName,Name), - {[],0}; - _Other -> - emit({" fun 'enc_",ObjName,"'/3"}), - {[],0} - end, - emit({";",nl}), - gen_objset_enc(Erule, ObjSetName, UniqueName, T, ClName, ClFields, - NewNthObj, InternalFunc ++ Acc); -gen_objset_enc(uper, ObjSetName, _UniqueName, ['EXTENSIONMARK'], - _ClName, _ClFields, _NthObj, Acc) -> - emit({"'getenc_",ObjSetName,"'(_, _) ->",nl}), - emit({indent(3),"fun(_, Val, _) ->",nl}), - emit([indent(6),"Val",nl, - indent(3),"end.",nl,nl]), - Acc; -gen_objset_enc(per, ObjSetName, _UniqueName, ['EXTENSIONMARK'], - _ClName, _ClFields, _NthObj, Acc) -> - emit(["'getenc_",ObjSetName,"'(_, _) ->",nl, - indent(3),"fun(_, Val, _) ->",nl, - indent(6),"BinVal = if",nl, - indent(9),"is_list(Val) -> list_to_binary(Val);",nl, - indent(9),"true -> Val",nl, - indent(6),"end,",nl, - indent(6),"Size = byte_size(BinVal),",nl, - indent(6),"if",nl, - indent(9),"Size < 256 ->",nl, - indent(12),"[20,Size,BinVal];",nl, - indent(9),"true ->",nl, - indent(12),"[21,<<Size:16>>,Val]",nl, - indent(6),"end",nl, - indent(3),"end.",nl,nl]), - Acc; -gen_objset_enc(_, ObjSetName, UniqueName, [], _, _, _, Acc) -> - emit_default_getenc(ObjSetName, UniqueName), - emit([".",nl,nl]), - Acc. - -emit_ext_encfun(ModuleName,Name) -> - emit([indent(4),"fun(T,V,O) -> '",ModuleName,"':'enc_", - Name,"'(T,V,O) end"]). - -emit_default_getenc(ObjSetName,UniqueName) -> - emit(["'getenc_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]), - emit([indent(4),"fun(C,V,_) -> exit({'Type not compatible with table constraint',{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},",ErrV}}) end"]). - - -%% gen_inlined_enc_funs for each object iterates over all fields of a -%% class, and for each typefield it checks if the object has that -%% field and emits the proper code. -gen_inlined_enc_funs(Erule, Fields, [{typefield,_,_}|_]=T, - ObjSetName, NthObj) -> - emit([indent(3),"fun(Type, Val, _) ->",nl, - indent(6),"case Type of",nl]), - gen_inlined_enc_funs1(Erule, Fields, T, ObjSetName, [], NthObj, []); -gen_inlined_enc_funs(Erule,Fields,[_H|Rest],ObjSetName,NthObj) -> - gen_inlined_enc_funs(Erule,Fields,Rest,ObjSetName,NthObj); -gen_inlined_enc_funs(_,_,[],_,NthObj) -> - {[],NthObj}. - -gen_inlined_enc_funs1(Erule, Fields, [{typefield,Name,_}|Rest], ObjSetName, - Sep0, NthObj, Acc0) -> - emit(Sep0), - Sep = [";",nl], - CurrentMod = get(currmod), - InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]), - {Acc,NAdd} = - case lists:keyfind(Name, 1, Fields) of - {_,#type{}=Type} -> - {Ret,N} = emit_inner_of_fun(Erule, Type, InternalDefFunName), - {Ret++Acc0,N}; - {_,#typedef{}=Type} -> - emit([indent(9),{asis,Name}," ->",nl]), - {Ret,N} = emit_inner_of_fun(Erule, Type, InternalDefFunName), - {Ret++Acc0,N}; - {_,#'Externaltypereference'{module=CurrentMod,type=T}} -> - emit([indent(9),{asis,Name}," ->",nl, - indent(12),"'enc_",T,"'(Val)"]), - {Acc0,0}; - {_,#'Externaltypereference'{module=M,type=T}} -> - emit([indent(9),{asis,Name}," ->",nl, - indent(12),"'",M,"'",":'enc_",T,"'(Val)"]), - {Acc0,0}; - false when Erule =:= uper -> - emit([indent(9),{asis,Name}," ->",nl, - indent(12),"Val",nl]), - {Acc0,0}; - false when Erule =:= per -> - emit([indent(9),{asis,Name}," ->",nl, - indent(12),"Size = case Val of",nl, - indent(15),"B when is_binary(B) -> size(B);",nl, - indent(15),"_ -> length(Val)",nl, - indent(12),"end,",nl, - indent(12),"if",nl, - indent(15),"Size < 256 -> [20,Size,Val];",nl, - indent(15),"true -> [21,<<Size:16>>,Val]",nl, - indent(12),"end"]), - {Acc0,0} - end, - gen_inlined_enc_funs1(Erule, Fields, Rest, ObjSetName, Sep, - NthObj+NAdd, Acc); -gen_inlined_enc_funs1(Erule, Fields, [_|T], ObjSetName, Sep, NthObj, Acc)-> - gen_inlined_enc_funs1(Erule, Fields, T, ObjSetName, Sep, NthObj, Acc); -gen_inlined_enc_funs1(_, _, [], _, _, NthObj, Acc) -> - emit([nl,indent(6),"end",nl, - indent(3),"end"]), - {Acc,NthObj}. - -emit_inner_of_fun(Erule, #typedef{name={ExtMod,Name},typespec=Type}=TDef, - InternalDefFunName) -> - case {ExtMod,Name} of - {primitive,bif} -> - emit(indent(12)), - gen_encode_prim(Erule, Type, "Val"), - {[],0}; - {constructed,bif} -> - emit([indent(12),"'enc_", - InternalDefFunName,"'(Val)"]), - {[TDef#typedef{name=InternalDefFunName}],1}; - _ -> - emit({indent(12),"'",ExtMod,"':'enc_",Name,"'(Val)"}), - {[],0} - end; -emit_inner_of_fun(_Erule, #typedef{name=Name}, _) -> - emit({indent(12),"'enc_",Name,"'(Val)"}), - {[],0}; -emit_inner_of_fun(Erule, #type{}=Type, _) -> - CurrMod = get(currmod), - case Type#type.def of - Def when is_atom(Def) -> - emit({indent(9),Def," ->",nl,indent(12)}), - gen_encode_prim(Erule, Type, "Val"); - #'Externaltypereference'{module=CurrMod,type=T} -> - emit({indent(9),T," ->",nl,indent(12),"'enc_",T,"'(Val)"}); - #'Externaltypereference'{module=ExtMod,type=T} -> - emit({indent(9),T," ->",nl,indent(12),ExtMod,":'enc_", - T,"'(Val)"}) - end, - {[],0}. - -indent(N) -> - lists:duplicate(N,32). % 32 = space - - -gen_objset_dec(_, _, {unique,undefined}, _, _, _, _) -> - %% There is no unique field in the class of this object set - %% don't bother about the constraint - ok; -gen_objset_dec(Erule, ObjSName, UniqueName, [{ObjName,Val,Fields}|T], ClName, - ClFields, NthObj)-> - emit({"'getdec_",ObjSName,"'(",{asis,UniqueName},",",{asis,Val}, - ") ->",nl}), - CurrMod = get(currmod), - NewNthObj= - case ObjName of - {no_mod,no_name} -> - gen_inlined_dec_funs(Erule, Fields, ClFields, - ObjSName, NthObj); - {CurrMod,Name} -> - emit([" fun 'dec_",Name,"'/4"]), - NthObj; - {ModName,Name} -> - emit_ext_decfun(ModName,Name), - NthObj; - _Other -> - emit({" fun 'dec_",ObjName,"'/4"}), - NthObj - end, - emit({";",nl}), - gen_objset_dec(Erule, ObjSName, UniqueName, T, ClName, ClFields, NewNthObj); -gen_objset_dec(_Erule, ObjSetName, _UniqueName, ['EXTENSIONMARK'], - _ClName, _ClFields, _NthObj) -> - emit({"'getdec_",ObjSetName,"'(_, _) ->",nl}), - emit({indent(3),"fun(Attr1, Bytes, _,_) ->",nl}), - emit({indent(6),"{Bytes,Attr1}",nl}), - emit({indent(3),"end.",nl,nl}), - ok; -gen_objset_dec(_Erule, ObjSetName, UniqueName, [], _, _, _) -> - emit_default_getdec(ObjSetName, UniqueName), - emit([".",nl,nl]), +gen_objectset_code(_Erules, _ObjSet) -> ok. -emit_ext_decfun(ModuleName,Name) -> - emit([indent(3),"fun(T,V,O1,O2) -> '",ModuleName,"':'dec_", - Name,"'(T,V,O1,O2) end"]). - -emit_default_getdec(ObjSetName,UniqueName) -> - emit(["'getdec_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]), - emit([indent(2), "fun(C,V,_,_) -> exit({{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},",ErrV}}) end"]). - - -gen_inlined_dec_funs(Erule, Fields, List, ObjSetName, NthObj0) -> - emit([indent(3),"fun(Type, Val, _, _) ->",nl, - indent(6),"case Type of",nl]), - NthObj = gen_inlined_dec_funs1(Erule, Fields, List, - ObjSetName, "", NthObj0), - emit([nl,indent(6),"end",nl, - indent(3),"end"]), - NthObj. - -gen_inlined_dec_funs1(Erule, Fields, [{typefield,Name,_}|Rest], - ObjSetName, Sep0, NthObj) -> - InternalDefFunName = [NthObj,Name,ObjSetName], - emit(Sep0), - Sep = [";",nl], - N = case lists:keyfind(Name, 1, Fields) of - {_,#type{}=Type} -> - emit_inner_of_decfun(Erule, Type, InternalDefFunName); - {_,#typedef{}=Type} -> - emit([indent(9),{asis,Name}," ->",nl]), - emit_inner_of_decfun(Erule, Type, InternalDefFunName); - {_,#'Externaltypereference'{}=Etype} -> - emit([indent(9),{asis,Name}," ->",nl, - indent(12)]), - gen_dec_external(Etype, "Val"), - 0; - false -> - emit([indent(9),{asis,Name}," -> {Val,Type}"]), - 0 - end, - gen_inlined_dec_funs1(Erule, Fields, Rest, ObjSetName, Sep, NthObj+N); -gen_inlined_dec_funs1(Erule, Fields, [_|Rest], ObjSetName, Sep, NthObj) -> - gen_inlined_dec_funs1(Erule, Fields, Rest, ObjSetName, Sep, NthObj); -gen_inlined_dec_funs1(_, _, [], _, _, NthObj) -> NthObj. - -emit_inner_of_decfun(Erule, #typedef{name={ExtName,Name},typespec=Type}, - InternalDefFunName) -> - case {ExtName,Name} of - {primitive,bif} -> - emit(indent(12)), - gen_dec_prim(Erule, Type, "Val"), - 0; - {constructed,bif} -> - emit({indent(12),"'dec_", - asn1ct_gen:list2name(InternalDefFunName),"'(Val)"}), - 1; - _ -> - emit({indent(12),"'",ExtName,"':'dec_",Name,"'(Val, telltype)"}), - 0 - end; -emit_inner_of_decfun(_Erule, #typedef{name=Name}, _) -> - emit({indent(12),"'dec_",Name,"'(Val, telltype)"}), - 0; -emit_inner_of_decfun(Erule, #type{}=Type, _) -> - CurrMod = get(currmod), - case Type#type.def of - Def when is_atom(Def) -> - emit({indent(9),Def," ->",nl,indent(12)}), - gen_dec_prim(Erule, Type, "Val"); - #'Externaltypereference'{module=CurrMod,type=T} -> - emit({indent(9),T," ->",nl,indent(12),"'dec_",T,"'(Val)"}); - #'Externaltypereference'{module=ExtMod,type=T} -> - emit({indent(9),T," ->",nl,indent(12),ExtMod,":'dec_", - T,"'(Val)"}) - end, - 0. - - -gen_internal_funcs(_,[]) -> - ok; -gen_internal_funcs(Erules,[TypeDef|Rest]) -> - gen_encode_user(Erules,TypeDef), - emit([nl,nl,"'dec_",TypeDef#typedef.name,"'(Bytes) ->",nl]), - gen_decode_user(Erules,TypeDef), - gen_internal_funcs(Erules,Rest). - - - %% DECODING ***************************** %%*************************************** -gen_decode(Erules,Type) when is_record(Type,typedef) -> - D = Type, - emit({nl,nl}), - emit({"'dec_",Type#typedef.name,"'(Bytes,_) ->",nl}), +gen_decode(Erules, #typedef{}=Type) -> + DecFunc = dec_func(Type#typedef.name), + emit([nl,nl,{asis,DecFunc},"(Bytes) ->",nl]), dbdec(Type#typedef.name), - gen_decode_user(Erules,D). + gen_decode_user(Erules, Type). gen_decode(Erules,Tname,#'ComponentType'{name=Cname,typespec=Type}) -> NewTname = [Cname|Tname], @@ -944,8 +218,9 @@ gen_decode(Erules,Typename,Type) when is_record(Type,type) -> _ -> "" end, - emit({nl,"'dec_",asn1ct_gen:list2name(Typename), - "'(Bytes,_",ObjFun,") ->",nl}), + emit([nl, + {asis,dec_func(asn1ct_gen:list2name(Typename))}, + "(Bytes",ObjFun,") ->",nl]), dbdec(Typename), asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,Type); _ -> @@ -982,8 +257,8 @@ gen_dec_external(Ext, BytesVar) -> #'Externaltypereference'{module=Mod,type=Type} = Ext, emit([case CurrMod of Mod -> []; - _ -> ["'",Mod,"':"] - end,"'dec_",Type,"'(",BytesVar,",telltype)"]). + _ -> [{asis,Mod},":"] + end,{asis,dec_func(Type)},"(",BytesVar,")"]). gen_dec_imm(Erule, #type{def=Name,constraint=C}) -> Aligned = case Erule of @@ -1103,35 +378,6 @@ gen_dec_prim(Erule, Type, BytesVar) -> Imm = gen_dec_imm(Erule, Type), asn1ct_imm:dec_code_gen(Imm, BytesVar). -is_already_generated(Operation,Name) -> - case get(class_default_type) of - undefined -> - put(class_default_type,[{Operation,Name}]), - false; - GeneratedList -> - case lists:member({Operation,Name},GeneratedList) of - true -> - true; - false -> - put(class_default_type,[{Operation,Name}|GeneratedList]), - false - end - end. - -get_class_fields(#classdef{typespec=ObjClass}) -> - ObjClass#objectclass.fields; -get_class_fields(#objectclass{fields=Fields}) -> - Fields; -get_class_fields(_) -> - []. - - -get_object_field(Name,ObjectFields) -> - case lists:keysearch(Name,1,ObjectFields) of - {value,Field} -> Field; - false -> false - end. - %% For PER the ExtensionAdditionGroup notation has significance for the encoding and decoding %% the components within the ExtensionAdditionGroup is treated in a similar way as if they @@ -1170,11 +416,8 @@ imm_dec_open_type_1(Type, Aligned) -> asn1ct_name:new(tmpval), emit(["begin",nl, "{",{curr,tmpval},",_} = ", - "dec_",Type,"(",OpenType,", mandatory),",nl, + {asis,dec_func(Type)},"(",OpenType,"),",nl, "{",{curr,tmpval},com,Buf,"}",nl, "end"]) end, {call,D,asn1ct_imm:per_dec_open_type(Aligned)}. - -eval_module(per) -> asn1ct_eval_per; -eval_module(uper) -> asn1ct_eval_uper. diff --git a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl deleted file mode 100644 index 012d54e7a1..0000000000 --- a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl +++ /dev/null @@ -1,461 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2013. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% -%% --module(asn1ct_gen_per_rt2ct). - -%% Handle encoding of primitives for aligned PER. - --include("asn1_records.hrl"). - --export([gen_encode_prim/3]). - --import(asn1ct_gen, [emit/1,demit/1]). --import(asn1ct_func, [call/3]). - -gen_encode_prim(Erules, #type{}=D, Value) -> - Constraint = D#type.constraint, - case D#type.def of - 'INTEGER' -> - EffectiveConstr = effective_constraint(integer,Constraint), - emit([" %%INTEGER with effective constraint: ", - {asis,EffectiveConstr},nl]), - emit_enc_integer(Erules,EffectiveConstr,Value); - {'INTEGER',NamedNumberList} -> - EffectiveConstr = effective_constraint(integer,Constraint), - %% maybe an emit_enc_NNL_integer - emit([" %%INTEGER with effective constraint: ", - {asis,EffectiveConstr},nl]), - emit_enc_integer_NNL(Erules,EffectiveConstr,Value,NamedNumberList); - 'REAL' -> - emit_enc_real(Erules, Value); - - {'BIT STRING',NamedNumberList} -> - EffectiveC = effective_constraint(bitstring,Constraint), - case EffectiveC of - 0 -> - emit({"[]"}); - _ -> - call(Erules, encode_bit_string, - [{asis,EffectiveC},Value, - {asis,NamedNumberList}]) - end; - 'NULL' -> - emit("[]"); - 'OBJECT IDENTIFIER' -> - call(Erules, encode_object_identifier, [Value]); - 'RELATIVE-OID' -> - call(Erules, encode_relative_oid, [Value]); - 'ObjectDescriptor' -> - call(Erules, encode_ObjectDescriptor, - [{asis,Constraint},Value]); - 'BOOLEAN' -> - emit({"case ",Value," of",nl, - " true -> [1];",nl, - " false -> [0];",nl, - " _ -> exit({error,{asn1,{encode_boolean,",Value,"}}})",nl, - "end"}); - 'OCTET STRING' -> - emit_enc_octet_string(Erules,Constraint,Value); - - 'NumericString' -> - emit_enc_known_multiplier_string('NumericString',Constraint,Value); - TString when TString == 'TeletexString'; - TString == 'T61String' -> - call(Erules, encode_TeletexString, [{asis,Constraint},Value]); - 'VideotexString' -> - call(Erules, encode_VideotexString, [{asis,Constraint},Value]); - 'UTCTime' -> - emit_enc_known_multiplier_string('VisibleString',Constraint,Value); - 'GeneralizedTime' -> - emit_enc_known_multiplier_string('VisibleString',Constraint,Value); - 'GraphicString' -> - call(Erules, encode_GraphicString, [{asis,Constraint},Value]); - 'VisibleString' -> - emit_enc_known_multiplier_string('VisibleString',Constraint,Value); - 'GeneralString' -> - call(Erules, encode_GeneralString, [{asis,Constraint},Value]); - 'PrintableString' -> - emit_enc_known_multiplier_string('PrintableString',Constraint,Value); - 'IA5String' -> - emit_enc_known_multiplier_string('IA5String',Constraint,Value); - 'BMPString' -> - emit_enc_known_multiplier_string('BMPString',Constraint,Value); - 'UniversalString' -> - emit_enc_known_multiplier_string('UniversalString',Constraint,Value); - 'UTF8String' -> - call(Erules, encode_UTF8String, [Value]); - 'ASN1_OPEN_TYPE' -> - NewValue = case Constraint of - [#'Externaltypereference'{type=Tname}] -> - asn1ct_func:need({Erules,complete,1}), - io_lib:format( - "complete(enc_~s(~s))",[Tname,Value]); - [#type{def=#'Externaltypereference'{type=Tname}}] -> - asn1ct_func:need({Erules,complete,1}), - io_lib:format( - "complete(enc_~s(~s))", - [Tname,Value]); - _ -> - io_lib:format("iolist_to_binary(~s)", - [Value]) - end, - call(Erules, encode_open_type, [NewValue]) - end. - -emit_enc_real(Erules, Real) -> - asn1ct_name:new(tmpval), - asn1ct_name:new(tmplen), - emit(["begin",nl, - "{",{curr,tmpval},com,{curr,tmplen},"} = ", - {call,real_common,encode_real,[Real]},com,nl, - "[",{call,Erules,encode_length,[{curr,tmplen}]},",",nl, - {call,Erules,octets_to_complete, - [{curr,tmplen},{curr,tmpval}]},"]",nl, - "end"]). - -emit_enc_known_multiplier_string(StringType,C,Value) -> - SizeC = effective_constraint(bitstring, C), - PAlphabC = get_constraint(C,'PermittedAlphabet'), - case {StringType,PAlphabC} of - {'UniversalString',{_,_}} -> - exit({error,{asn1,{'not implemented',"UniversalString with " - "PermittedAlphabet constraint"}}}); - {'BMPString',{_,_}} -> - exit({error,{asn1,{'not implemented',"BMPString with " - "PermittedAlphabet constraint"}}}); - _ -> ok - end, - NumBits = get_NumBits(C,StringType), - CharOutTab = get_CharOutTab(C,StringType), - %% NunBits and CharOutTab for chars_encode - emit_enc_k_m_string(SizeC, NumBits, CharOutTab, Value). - -emit_enc_k_m_string(0, _NumBits, _CharOutTab, _Value) -> - emit({"[]"}); -emit_enc_k_m_string(SizeC, NumBits, CharOutTab, Value) -> - call(per, encode_known_multiplier_string, - [{asis,SizeC},NumBits,{asis,CharOutTab},Value]). - - -%% copied from run time module - -get_CharOutTab(C, StringType) -> - case get_constraint(C,'PermittedAlphabet') of - {'SingleValue',Sv} -> - get_CharTab2(C, StringType, hd(Sv), lists:max(Sv), Sv); - no -> - case StringType of - 'IA5String' -> - {0,16#7F,notab}; - 'VisibleString' -> - get_CharTab2(C, StringType, 16#20, 16#7F, notab); - 'PrintableString' -> - Chars = lists:sort( - " '()+,-./0123456789:=?ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"), - get_CharTab2(C, StringType, hd(Chars), - lists:max(Chars), Chars); - 'NumericString' -> - get_CharTab2(C, StringType, 16#20, $9, " 0123456789"); - 'UniversalString' -> - {0,16#FFFFFFFF,notab}; - 'BMPString' -> - {0,16#FFFF,notab} - end - end. - -get_CharTab2(C, StringType, Min, Max, Chars) -> - BitValMax = (1 bsl get_NumBits(C,StringType))-1, - if - Max =< BitValMax -> - {0,Max,notab}; - true -> - {Min,Max,create_char_tab(Min,Chars)} - end. - -create_char_tab(Min,L) -> - list_to_tuple(create_char_tab(Min,L,0)). -create_char_tab(Min,[Min|T],V) -> - [V|create_char_tab(Min+1,T,V+1)]; -create_char_tab(_Min,[],_V) -> - []; -create_char_tab(Min,L,V) -> - [false|create_char_tab(Min+1,L,V)]. - -get_NumBits(C,StringType) -> - case get_constraint(C,'PermittedAlphabet') of - {'SingleValue',Sv} -> - charbits(length(Sv),aligned); - no -> - case StringType of - 'IA5String' -> - charbits(128,aligned); % 16#00..16#7F - 'VisibleString' -> - charbits(95,aligned); % 16#20..16#7E - 'PrintableString' -> - charbits(74,aligned); % [$\s,$',$(,$),$+,$,,$-,$.,$/,"0123456789",$:,$=,$?,$A..$Z,$a..$z - 'NumericString' -> - charbits(11,aligned); % $ ,"0123456789" - 'UniversalString' -> - 32; - 'BMPString' -> - 16 - end - end. - -charbits(NumOfChars,aligned) -> - case charbits(NumOfChars) of - 1 -> 1; - 2 -> 2; - B when B =< 4 -> 4; - B when B =< 8 -> 8; - B when B =< 16 -> 16; - B when B =< 32 -> 32 - end. - -charbits(NumOfChars) when NumOfChars =< 2 -> 1; -charbits(NumOfChars) when NumOfChars =< 4 -> 2; -charbits(NumOfChars) when NumOfChars =< 8 -> 3; -charbits(NumOfChars) when NumOfChars =< 16 -> 4; -charbits(NumOfChars) when NumOfChars =< 32 -> 5; -charbits(NumOfChars) when NumOfChars =< 64 -> 6; -charbits(NumOfChars) when NumOfChars =< 128 -> 7; -charbits(NumOfChars) when NumOfChars =< 256 -> 8; -charbits(NumOfChars) when NumOfChars =< 512 -> 9; -charbits(NumOfChars) when NumOfChars =< 1024 -> 10; -charbits(NumOfChars) when NumOfChars =< 2048 -> 11; -charbits(NumOfChars) when NumOfChars =< 4096 -> 12; -charbits(NumOfChars) when NumOfChars =< 8192 -> 13; -charbits(NumOfChars) when NumOfChars =< 16384 -> 14; -charbits(NumOfChars) when NumOfChars =< 32768 -> 15; -charbits(NumOfChars) when NumOfChars =< 65536 -> 16; -charbits(NumOfChars) when is_integer(NumOfChars) -> - 16 + charbits1(NumOfChars bsr 16). - -charbits1(0) -> - 0; -charbits1(NumOfChars) -> - 1 + charbits1(NumOfChars bsr 1). - -%% copied from run time module - -emit_enc_octet_string(Erules, Constraint, Value) -> - case effective_constraint(bitstring, Constraint) of - 0 -> - emit({" []"}); - 1 -> - asn1ct_name:new(tmpval), - emit({" begin",nl}), - emit({" [",{curr,tmpval},"] = ",Value,",",nl}), - emit([" [[10,8],",{curr,tmpval},"]",nl]), - emit(" end"); - 2 -> - asn1ct_name:new(tmpval), - emit([" begin",nl, - " ",{curr,tmpval}," = ",Value,",",nl, - " case length(",{curr,tmpval},") of",nl, - " 2 ->",nl, - " [[45,16,2]|",{curr,tmpval},"];",nl, - " _ ->",nl, - " exit({error,{value_out_of_bounds,", - {curr,tmpval},"}})",nl, - " end",nl, - " end"]); - Sv when is_integer(Sv), Sv < 256 -> - asn1ct_name:new(tmpval), - asn1ct_name:new(tmplen), - emit([" begin",nl, - " ",{curr,tmpval}," = ",Value,",",nl, - " case length(",{curr,tmpval},") of",nl, - " ",Sv,"=",{curr,tmplen}," ->",nl, - " [20,",{curr,tmplen},"|",{curr,tmpval},"];",nl, - " _ ->",nl, - " exit({error,{value_out_of_bounds,", - {curr,tmpval},"}})",nl, - " end",nl, - " end"]); - Sv when is_integer(Sv),Sv =< 65535 -> - asn1ct_name:new(tmpval), - asn1ct_name:new(tmplen), - emit([" begin",nl, - " ",{curr,tmpval}," = ",Value,",",nl, - " case length(",{curr,tmpval},") of",nl, - " ",Sv,"=",{curr,tmplen}," ->",nl, - " [<<21,",{curr,tmplen},":16>>|",Value,"];",nl, - " _ ->",nl, - " exit({error,{value_out_of_bounds,", - {curr,tmpval},"}})",nl, - " end",nl, - " end"]); - C -> - call(Erules, encode_octet_string, - [{asis,C},Value]) - end. - -emit_enc_integer_case(Value) -> - case get(component_type) of - {true,#'ComponentType'{prop=Prop}} -> - emit({" begin",nl}), - case Prop of - Opt when Opt=='OPTIONAL'; - is_tuple(Opt),element(1,Opt)=='DEFAULT' -> - emit({" case ",Value," of",nl}), - ok; - _ -> - emit({" ",{curr,tmpval},"=",Value,",",nl}), - emit({" case ",{curr,tmpval}," of",nl}), - asn1ct_name:new(tmpval) - end; -% asn1ct_name:new(tmpval); - _ -> - emit({" case ",Value," of ",nl}) - end. -emit_enc_integer_end_case() -> - case get(component_type) of - {true,_} -> - emit({nl," end"}); % end of begin ... end - _ -> ok - end. - - -emit_enc_integer_NNL(Erules,C,Value,NNL) -> - EncVal = enc_integer_NNL_cases(Value,NNL), - emit_enc_integer(Erules,C,EncVal). - -enc_integer_NNL_cases(Value,NNL) -> - asn1ct_name:new(tmpval), - TmpVal = asn1ct_gen:mk_var(asn1ct_name:curr(tmpval)), - Cases=enc_integer_NNL_cases1(NNL), - lists:flatten(io_lib:format("(case ~s of "++Cases++ - "~s when is_atom(~s)->exit({error,{asn1,{namednumber,~s}}});_->~s end)",[Value,TmpVal,TmpVal,TmpVal,Value])). - -enc_integer_NNL_cases1([{NNo,No}|Rest]) -> - io_lib:format("~w->~w;",[NNo,No])++enc_integer_NNL_cases1(Rest); -enc_integer_NNL_cases1([]) -> - "". - -emit_enc_integer(_Erule,[{'SingleValue',Int}],Value) -> - asn1ct_name:new(tmpval), - emit_enc_integer_case(Value),% emit([" case ",Value," of",nl]), - emit([" ",Int," -> [];",nl]), - emit([" ",{curr,tmpval}," ->",nl]), - emit([" exit({error,{value_out_of_bounds,",{curr,tmpval},"}})", - nl," end",nl]), - emit_enc_integer_end_case(); - -emit_enc_integer(_Erule,[{_,{Lb,Ub},_Range,{bits,NoBs}}],Value) -> % Range =< 255 - asn1ct_name:new(tmpval), - emit_enc_integer_case(Value), - emit([" ",{curr,tmpval}," when ",{curr,tmpval},"=<",Ub,",", - {curr,tmpval},">=",Lb," ->",nl]), - emit([" [10,",NoBs,",",{curr,tmpval},"- ",Lb,"];",nl]), - emit([" ",{curr,tmpval}," ->",nl]), - emit([" exit({error,{value_out_of_bounds,", - {curr,tmpval},"}})",nl," end",nl]), - emit_enc_integer_end_case(); - -emit_enc_integer(_Erule,[{_,{Lb,Ub},Range,_}],Value) when Range =< 256 -> - asn1ct_name:new(tmpval), - emit_enc_integer_case(Value), - emit([" ",{curr,tmpval}," when ",{curr,tmpval},"=<",Ub,",", - {curr,tmpval},">=",Lb," ->",nl]), - emit([" [20,1,",{curr,tmpval},"- ",Lb,"];",nl]), - emit([" ",{curr,tmpval}," ->",nl]), - emit([" exit({error,{value_out_of_bounds,",{curr,tmpval},"}})", - nl," end",nl]), - emit_enc_integer_end_case(); - -emit_enc_integer(_Erule,[{_,{Lb,Ub},Range,_}],Value) when Range =< 65536 -> - asn1ct_name:new(tmpval), - emit_enc_integer_case(Value), - emit([" ",{curr,tmpval}," when ",{curr,tmpval},"=<",Ub,",", - {curr,tmpval},">=",Lb," ->",nl]), - emit([" [20,2,<<(",{curr,tmpval},"- ",Lb,"):16>>];",nl]), - emit([" ",{curr,tmpval}," ->",nl]), - emit([" exit({error,{value_out_of_bounds,",{curr,tmpval},"}})", - nl," end",nl]), - emit_enc_integer_end_case(); - -emit_enc_integer(Erule, [{'ValueRange',{Lb,Ub}=VR}], Value) - when is_integer(Lb), is_integer(Ub) -> - call(Erule, encode_constrained_number, [{asis,VR},Value]); - -emit_enc_integer(Erule, C, Value) -> - call(Erule, encode_integer, [{asis,C},Value]). - - -get_constraint([{Key,V}],Key) -> - V; -get_constraint([],_) -> - no; -get_constraint(C,Key) -> - case lists:keysearch(Key,1,C) of - false -> - no; - {value,{_,V}} -> - V - end. - -%% effective_constraint(Type,C) -%% Type = atom() -%% C = [C1,...] -%% C1 = {'SingleValue',SV} | {'ValueRange',VR} | {atom(),term()} -%% SV = integer() | [integer(),...] -%% VR = {Lb,Ub} -%% Lb = 'MIN' | integer() -%% Ub = 'MAX' | integer() -%% Returns a single value if C only has a single value constraint, and no -%% value range constraints, that constrains to a single value, otherwise -%% returns a value range that has the lower bound set to the lowest value -%% of all single values and lower bound values in C and the upper bound to -%% the greatest value. -effective_constraint(integer,[C={{_,_},_}|_Rest]) -> % extension - [C]; %% [C|effective_constraint(integer,Rest)]; XXX what is possible ??? -effective_constraint(integer,C) -> - pre_encode(integer, asn1ct_imm:effective_constraint(integer, C)); -effective_constraint(bitstring,C) -> - asn1ct_imm:effective_constraint(bitstring, C). - -pre_encode(integer,[]) -> - []; -pre_encode(integer,C=[{'SingleValue',_}]) -> - C; -pre_encode(integer,C=[{'ValueRange',VR={Lb,Ub}}]) when is_integer(Lb),is_integer(Ub)-> - Range = Ub-Lb+1, - if - Range =< 255 -> - NoBits = no_bits(Range), - [{'ValueRange',VR,Range,{bits,NoBits}}]; - Range =< 256 -> - [{'ValueRange',VR,Range,{octets,1}}]; - Range =< 65536 -> - [{'ValueRange',VR,Range,{octets,2}}]; - true -> - C - end; -pre_encode(integer,C) -> - C. - -no_bits(2) -> 1; -no_bits(N) when N=<4 -> 2; -no_bits(N) when N=<8 -> 3; -no_bits(N) when N=<16 -> 4; -no_bits(N) when N=<32 -> 5; -no_bits(N) when N=<64 -> 6; -no_bits(N) when N=<128 -> 7; -no_bits(N) when N=<255 -> 8. diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl index bf362db843..20785cda8c 100644 --- a/lib/asn1/src/asn1ct_imm.erl +++ b/lib/asn1/src/asn1ct_imm.erl @@ -26,6 +26,18 @@ per_dec_octet_string/2,per_dec_open_type/1,per_dec_real/1, per_dec_restricted_string/1]). -export([per_dec_constrained/3,per_dec_normally_small_number/1]). +-export([per_enc_bit_string/4,per_enc_boolean/2, + per_enc_choice/3,per_enc_enumerated/3, + per_enc_integer/3,per_enc_integer/4, + per_enc_null/2, + per_enc_k_m_string/4,per_enc_octet_string/3, + per_enc_open_type/2, + per_enc_restricted_string/3, + per_enc_small_number/2]). +-export([per_enc_extension_bit/2,per_enc_extensions/4,per_enc_optional/3]). +-export([per_enc_sof/5]). +-export([enc_absent/3,enc_append/1,enc_bind_var/1]). +-export([enc_cg/2]). -export([optimize_alignment/1,optimize_alignment/2, dec_slim_cg/2,dec_code_gen/2]). -export([effective_constraint/2]). @@ -115,29 +127,18 @@ per_dec_named_integer(Constraint, NamedList0, Aligned) -> per_dec_k_m_string(StringType, Constraint, Aligned) -> SzConstr = effective_constraint(bitstring, Constraint), N = string_num_bits(StringType, Constraint, Aligned), - %% X.691 (07/2002) 27.5.7 says if the upper bound times the number - %% of bits is greater than or equal to 16, then the bit field should - %% be aligned. - Imm = dec_string(SzConstr, N, Aligned, fun(_, Ub) -> Ub >= 16 end), + Imm = dec_string(SzConstr, N, Aligned, k_m_string), Chars = char_tab(Constraint, StringType, N), convert_string(N, Chars, Imm). per_dec_octet_string(Constraint, Aligned) -> - dec_string(Constraint, 8, Aligned, - %% Aligned unless the size is fixed and =< 16. - fun(Sv, Sv) -> Sv > 16; - (_, _) -> true - end). + dec_string(Constraint, 8, Aligned, 'OCTET STRING'). per_dec_raw_bitstring(Constraint, Aligned) -> - dec_string(Constraint, 1, Aligned, - fun(Sv, Sv) -> Sv > 16; - (_, _) -> true - end). + dec_string(Constraint, 1, Aligned, 'BIT STRING'). per_dec_open_type(Aligned) -> - {get_bits,decode_unconstrained_length(true, Aligned), - [8,binary,{align,Aligned}]}. + dec_string(no, 8, Aligned, open_type). per_dec_real(Aligned) -> Dec = fun(V, Buf) -> @@ -152,26 +153,298 @@ per_dec_restricted_string(Aligned) -> DecLen = decode_unconstrained_length(true, Aligned), {get_bits,DecLen,[8,binary]}. +%%% +%%% Encoding. +%%% + +per_enc_bit_string(Val0, [], Constraint0, Aligned) -> + {B,[Val,Bs,Bits]} = mk_vars(Val0, [bs,bits]), + Constraint = effective_constraint(bitstring, Constraint0), + ExtraArgs = case constr_min_size(Constraint) of + no -> []; + Lb -> [Lb] + end, + B ++ [{call,per_common,to_bitstring,[Val|ExtraArgs],Bs}, + {call,erlang,bit_size,[Bs],Bits}| + per_enc_length(Bs, 1, Bits, Constraint, Aligned, 'BIT STRING')]; +per_enc_bit_string(Val0, NNL0, Constraint0, Aligned) -> + {B,[Val,Bs,Bits,Positions]} = mk_vars(Val0, [bs,bits,positions]), + NNL = lists:keysort(2, NNL0), + Constraint = effective_constraint(bitstring, Constraint0), + ExtraArgs = case constr_min_size(Constraint) of + no -> []; + Lb -> [Lb] + end, + B ++ [{'try', + [bit_string_name2pos_fun(NNL, Val)], + {Positions, + [{call,per_common,bitstring_from_positions, + [Positions|ExtraArgs]}]}, + [{call,per_common,to_named_bitstring,[Val|ExtraArgs]}],Bs}, + {call,erlang,bit_size,[Bs],Bits}| + per_enc_length(Bs, 1, Bits, Constraint, Aligned, 'BIT STRING')]. + +per_enc_boolean(Val0, _Aligned) -> + {B,[Val]} = mk_vars(Val0, []), + B++build_cond([[{eq,Val,false},{put_bits,0,1,[1]}], + [{eq,Val,true},{put_bits,1,1,[1]}]]). + +per_enc_choice(Val0, Cs0, _Aligned) -> + {B,[Val]} = mk_vars(Val0, []), + Cs = [[{eq,Val,Tag}|opt_choice(Imm)] || {Tag,Imm} <- Cs0], + B++build_cond(Cs). + +per_enc_enumerated(Val0, {Root,Ext}, Aligned) -> + {B,[Val]} = mk_vars(Val0, []), + Constr = enumerated_constraint(Root), + RootCs = per_enc_enumerated_root(Root, [{put_bits,0,1,[1]}], + Val, Constr, Aligned), + ExtCs = per_enc_enumerated_ext(Ext, Val, Aligned), + B++[{'cond',RootCs++ExtCs++enumerated_error(Val)}]; +per_enc_enumerated(Val0, Root, Aligned) -> + {B,[Val]} = mk_vars(Val0, []), + Constr = enumerated_constraint(Root), + Cs = per_enc_enumerated_root(Root, [], Val, Constr, Aligned), + B++[{'cond',Cs++enumerated_error(Val)}]. + +enumerated_error(Val) -> + [['_',{error,Val}]]. + +per_enc_integer(Val0, Constraint0, Aligned) -> + {B,[Val]} = mk_vars(Val0, []), + Constraint = effective_constraint(integer, Constraint0), + B ++ per_enc_integer_1(Val, Constraint, Aligned). + +per_enc_integer(Val0, NNL, Constraint0, Aligned) -> + {B,[Val]} = mk_vars(Val0, []), + Constraint = effective_constraint(integer, Constraint0), + Cs = [[{eq,Val,N}|per_enc_integer_1(V, Constraint, Aligned)] || + {N,V} <- NNL], + case per_enc_integer_1(Val, Constraint, Aligned) of + [{'cond',IntCs}] -> + B ++ [{'cond',Cs++IntCs}]; + Other -> + B ++ [{'cond',Cs++[['_'|Other]]}] + end. + +per_enc_null(_Val, _Aligned) -> + []. + +per_enc_k_m_string(Val0, StringType, Constraint, Aligned) -> + {B,[Val,Bin,Len]} = mk_vars(Val0, [bin,len]), + SzConstraint = effective_constraint(bitstring, Constraint), + Unit = string_num_bits(StringType, Constraint, Aligned), + Chars0 = char_tab(Constraint, StringType, Unit), + Args = case enc_char_tab(Chars0) of + notab -> [Val,Unit]; + Chars -> [Val,Unit,Chars] + end, + Enc = case Unit of + 16 -> + {call,per_common,encode_chars_16bit,[Val],Bin}; + 32 -> + {call,per_common,encode_big_chars,[Val],Bin}; + 8 -> + {call,erlang,list_to_binary,[Val],Bin}; + _ -> + {call,per_common,encode_chars,Args,Bin} + end, + case Unit of + 8 -> + B ++ [Enc,{call,erlang,byte_size,[Bin],Len}]; + _ -> + B ++ [{call,erlang,length,[Val],Len},Enc] + end ++ per_enc_length(Bin, Unit, Len, SzConstraint, Aligned, k_m_string). + +per_enc_open_type([], Aligned) -> + [{put_bits,1,8,unit(1, Aligned)},{put_bits,0,8,[1]}]; +per_enc_open_type([{'cond', + [['_', + {put_bits,0,0,_}, + {call,per_common,encode_unconstrained_number,_}=Call]]}], + Aligned) -> + %% We KNOW that encode_unconstrained_number/1 will return an IO list; + %% therefore the call to complete/1 can be replaced with a cheaper + %% call to iolist_to_binary/1. + {Dst,Imm} = per_enc_open_type_output([Call], []), + ToBin = {erlang,iolist_to_binary}, + Imm ++ per_enc_open_type(Dst, ToBin, Aligned); +per_enc_open_type([{call,erlang,iolist_to_binary,Args}], Aligned) -> + {_,[_,Bin,Len]} = mk_vars('dummy', [bin,len]), + [{call,erlang,iolist_to_binary,Args,Bin}, + {call,erlang,byte_size,[Bin],Len}|per_enc_length(Bin, 8, Len, Aligned)]; +per_enc_open_type(Imm0, Aligned) -> + try + {Prefix,Imm1} = split_off_nonbuilding(Imm0), + Prefix ++ enc_open_type(Imm1, Aligned) + catch + throw:impossible -> + {Dst,Imm} = per_enc_open_type_output(Imm0, []), + ToBin = {enc_mod(Aligned),complete}, + Imm ++ per_enc_open_type(Dst, ToBin, Aligned) + end. + +per_enc_octet_string(Val0, Constraint0, Aligned) -> + {B,[Val,Bin,Len]} = mk_vars(Val0, [bin,len]), + Constraint = effective_constraint(bitstring, Constraint0), + B ++ [{call,erlang,iolist_to_binary,[Val],Bin}, + {call,erlang,byte_size,[Bin],Len}| + per_enc_length(Bin, 8, Len, Constraint, Aligned, 'OCTET STRING')]. + +per_enc_restricted_string(Val0, {M,F}, Aligned) -> + {B,[Val,Bin,Len]} = mk_vars(Val0, [bin,len]), + B ++ [{call,M,F,[Val],Bin}, + {call,erlang,byte_size,[Bin],Len}| + per_enc_length(Bin, 8, Len, Aligned)]. + +per_enc_small_number(Val, Aligned) -> + build_cond([[{lt,Val,64},{put_bits,Val,7,[1]}], + ['_',{put_bits,1,1,[1]}| + per_enc_unsigned(Val, Aligned)]]). + +per_enc_extension_bit(Val0, _Aligned) -> + {B,[Val]} = mk_vars(Val0, []), + B++build_cond([[{eq,Val,[]},{put_bits,0,1,[1]}], + ['_',{put_bits,1,1,[1]}]]). + +per_enc_extensions(Val0, Pos0, NumBits, Aligned) when NumBits > 0 -> + Pos = Pos0 + 1, + {B,[Val,Bitmap]} = mk_vars(Val0, [bitmap]), + Length = per_enc_small_length(NumBits, Aligned), + PutBits = case NumBits of + 1 -> [{put_bits,1,1,[1]}]; + _ -> [{put_bits,Bitmap,NumBits,[1]}] + end, + B++[{call,per_common,extension_bitmap,[Val,Pos,Pos+NumBits],Bitmap}, + {'cond',[[{eq,Bitmap,0}], + ['_'|Length ++ PutBits]],{var,"Extensions"}}]. + +per_enc_optional(Val0, {Pos,DefVals}, _Aligned) when is_integer(Pos), + is_list(DefVals) -> + Val1 = lists:concat(["element(",Pos,", ",Val0,")"]), + {B,[Val]} = mk_vars(Val1, []), + Zero = {put_bits,0,1,[1]}, + One = {put_bits,1,1,[1]}, + B++[{'cond', + [[{eq,Val,DefVal},Zero] || DefVal <- DefVals] ++ [['_',One]]}]; +per_enc_optional(Val0, {Pos,{call,M,F,A}}, _Aligned) when is_integer(Pos) -> + Val1 = lists:concat(["element(",Pos,", ",Val0,")"]), + {B,[Val,Tmp]} = mk_vars(Val1, [tmp]), + Zero = {put_bits,0,1,[1]}, + One = {put_bits,1,1,[1]}, + B++[{call,M,F,[Val|A],Tmp}, + {'cond', + [[{eq,Tmp,true},Zero],['_',One]]}]; +per_enc_optional(Val0, Pos, _Aligned) when is_integer(Pos) -> + Val1 = lists:concat(["element(",Pos,", ",Val0,")"]), + {B,[Val]} = mk_vars(Val1, []), + Zero = {put_bits,0,1,[1]}, + One = {put_bits,1,1,[1]}, + B++[{'cond',[[{eq,Val,asn1_NOVALUE},Zero], + ['_',One]]}]. + +per_enc_sof(Val0, Constraint, ElementVar, ElementImm, Aligned) -> + {B,[Val,Len]} = mk_vars(Val0, [len]), + SzConstraint = effective_constraint(bitstring, Constraint), + LenImm = enc_length(Len, SzConstraint, Aligned), + Lc0 = [{lc,ElementImm,{var,atom_to_list(ElementVar)},Val}], + Lc = opt_lc(Lc0, LenImm), + PreBlock = B ++ [{call,erlang,length,[Val],Len}], + case LenImm of + [{'cond',[[C|Action]]}] -> + PreBlock ++ [{'cond',[[C|Action++Lc]]}]; + [{sub,_,_,_}=Sub,{'cond',[[C|Action]]}] -> + PreBlock ++ + [Sub,{'cond',[[C|Action++Lc]]}]; + EncLen -> + PreBlock ++ EncLen ++ Lc + end. + +enc_absent(Val0, {call,M,F,A}, Body) -> + {B,[Var,Tmp]} = mk_vars(Val0, [tmp]), + B++[{call,M,F,[Var|A],Tmp}, + {'cond', + [[{eq,Tmp,true}],['_'|Body]]}]; +enc_absent(Val0, AbsVals, Body) when is_list(AbsVals) -> + {B,[Var]} = mk_vars(Val0, []), + Cs = [[{eq,Var,Aval}] || Aval <- AbsVals] ++ [['_'|Body]], + B++build_cond(Cs). + +enc_append([[]|T]) -> + enc_append(T); +enc_append([[{put_bits,_,_,_}|_]=Pb|[Imm|T]=T0]) -> + case opt_choice(Pb++Imm) of + [{put_bits,_,_,_}|_] -> + [{block,Pb}|enc_append(T0)]; + Opt -> + enc_append([Opt|T]) + end; +enc_append([Imm0|[Imm1|T]=T0]) -> + try combine_imms(Imm0, Imm1) of + Imm -> + enc_append([Imm|T]) + catch + throw:impossible -> + [{block,Imm0}|enc_append(T0)] + end; +enc_append([H|T]) -> + [{block,H}|enc_append(T)]; +enc_append([]) -> []. + +enc_bind_var(Val) -> + {B,[{var,Var}]} = mk_vars(Val, []), + {B,list_to_atom(Var)}. + +enc_cg(Imm0, false) -> + Imm1 = enc_cse(Imm0), + Imm = enc_pre_cg(Imm1), + enc_cg(Imm); +enc_cg(Imm0, true) -> + Imm1 = enc_cse(Imm0), + Imm2 = enc_hoist_align(Imm1), + Imm3 = enc_opt_al(Imm2), + Imm4 = per_fixup(Imm3), + Imm = enc_pre_cg(Imm4), + enc_cg(Imm). %%% %%% Local functions. %%% -dec_string(Sv, U, Aligned0, AF) when is_integer(Sv) -> +%% is_aligned(StringType, LowerBound, UpperBound) -> boolean() +%% StringType = 'OCTET STRING' | 'BIT STRING' | k_m_string +%% LowerBound = UpperBound = number of bits +%% Determine whether a string should be aligned in PER. + +is_aligned(T, Lb, Ub) when T =:= 'OCTET STRING'; T =:= 'BIT STRING' -> + %% OCTET STRINGs and BIT STRINGs are aligned to a byte boundary + %% unless the size is fixed and less than or equal to 16 bits. + Lb =/= Ub orelse Lb > 16; +is_aligned(k_m_string, _Lb, Ub) -> + %% X.691 (07/2002) 27.5.7 says if the upper bound times the number + %% of bits is greater than or equal to 16, then the bit field should + %% be aligned. + Ub >= 16. + +%%% +%%% Generating the intermediate format format for decoding. +%%% + +dec_string(Sv, U, Aligned0, T) when is_integer(Sv) -> Bits = U*Sv, - Aligned = Aligned0 andalso AF(Bits, Bits), + Aligned = Aligned0 andalso is_aligned(T, Bits, Bits), {get_bits,Sv,[U,binary,{align,Aligned}]}; -dec_string({{Sv,Sv},[]}, U, Aligned, AF) -> - bit_case(dec_string(Sv, U, Aligned, AF), - dec_string(no, U, Aligned, AF)); -dec_string({{_,_}=C,[]}, U, Aligned, AF) -> - bit_case(dec_string(C, U, Aligned, AF), - dec_string(no, U, Aligned, AF)); -dec_string({Lb,Ub}, U, Aligned0, AF) -> +dec_string({{Sv,Sv},[]}, U, Aligned, T) -> + bit_case(dec_string(Sv, U, Aligned, T), + dec_string(no, U, Aligned, T)); +dec_string({{_,_}=C,[]}, U, Aligned, T) -> + bit_case(dec_string(C, U, Aligned, T), + dec_string(no, U, Aligned, T)); +dec_string({Lb,Ub}, U, Aligned0, T) -> Len = per_dec_constrained(Lb, Ub, Aligned0), - Aligned = Aligned0 andalso AF(Lb*U, Ub*U), + Aligned = Aligned0 andalso is_aligned(T, Lb*U, Ub*U), {get_bits,Len,[U,binary,{align,Aligned}]}; -dec_string(_, U, Aligned, _AF) -> +dec_string(_, U, Aligned, _T) -> Al = [{align,Aligned}], DecRest = fun(V, Buf) -> asn1ct_func:call(per_common, @@ -692,6 +965,1183 @@ mk_dest(I) when is_integer(I) -> integer_to_list(I); mk_dest(S) -> S. +%%% +%%% Constructing the intermediate format for encoding. +%%% + +split_off_nonbuilding(Imm) -> + lists:splitwith(fun is_nonbuilding/1, Imm). + +is_nonbuilding({apply,_,_,_}) -> true; +is_nonbuilding({assign,_,_}) -> true; +is_nonbuilding({call,_,_,_,_}) -> true; +is_nonbuilding({'cond',_,_}) -> true; +is_nonbuilding({lc,_,_,_,_}) -> true; +is_nonbuilding({sub,_,_,_}) -> true; +is_nonbuilding({'try',_,_,_,_}) -> true; +is_nonbuilding(_) -> false. + +mk_vars(Input0, Temps) -> + asn1ct_name:new(enc), + Curr = asn1ct_name:curr(enc), + [H|T] = atom_to_list(Curr), + Base = [H - ($a - $A)|T ++ "@"], + if + is_atom(Input0) -> + Input = {var,atom_to_list(Input0)}, + {[],[Input|mk_vars_1(Base, Temps)]}; + is_integer(Input0) -> + {[],[Input0|mk_vars_1(Base, Temps)]}; + Input0 =:= [] -> + {[],[Input0|mk_vars_1(Base, Temps)]}; + true -> + Input = mk_var(Base, input), + {[{assign,Input,Input0}],[Input|mk_vars_1(Base, Temps)]} + end. + +mk_vars_1(Base, Vars) -> + [mk_var(Base, V) || V <- Vars]. + +mk_var(Base, V) -> + {var,Base ++ atom_to_list(V)}. + +per_enc_integer_1(Val, [], Aligned) -> + [{'cond',[['_'|per_enc_unconstrained(Val, Aligned)]]}]; +per_enc_integer_1(Val, [{{'SingleValue',[_|_]=Svs}=Constr,[]}], Aligned) -> + %% An extensible constraint such as (1|17, ...). + %% + %% A subtle detail is that the extension root as described in the + %% ASN.1 spec should be used to determine whether a particular value + %% belongs to the extension root (as opposed to the effective + %% constraint, which will be used for the actual encoding). + %% + %% So for the example above, only the integers 1 and 17 should be + %% encoded as root values (extension bit = 0). + + [{'ValueRange',{Lb,Ub}}] = effective_constraint(integer, [Constr]), + Root = [begin + {[],_,Put} = per_enc_constrained(Sv, Lb, Ub, Aligned), + [{eq,Val,Sv},{put_bits,0,1,[1]}|Put] + end || Sv <- Svs], + Cs = Root ++ [['_',{put_bits,1,1,[1]}| + per_enc_unconstrained(Val, Aligned)]], + build_cond(Cs); +per_enc_integer_1(Val0, [{{_,_}=Constr,[]}], Aligned) -> + {Prefix,Check,Action} = per_enc_integer_2(Val0, Constr, Aligned), + Prefix++build_cond([[Check,{put_bits,0,1,[1]}|Action], + ['_',{put_bits,1,1,[1]}| + per_enc_unconstrained(Val0, Aligned)]]); +per_enc_integer_1(Val0, [Constr], Aligned) -> + {Prefix,Check,Action} = per_enc_integer_2(Val0, Constr, Aligned), + Prefix++build_cond([[Check|Action], + ['_',{error,Val0}]]). + +per_enc_integer_2(Val, {'SingleValue',Sv}, Aligned) when is_integer(Sv) -> + per_enc_constrained(Val, Sv, Sv, Aligned); +per_enc_integer_2(Val0, {'ValueRange',{Lb,'MAX'}}, Aligned) + when is_integer(Lb) -> + {Prefix,Val} = sub_lb(Val0, Lb), + {Prefix,{ge,Val,0},per_enc_unsigned(Val, Aligned)}; +per_enc_integer_2(Val, {'ValueRange',{Lb,Ub}}, Aligned) + when is_integer(Lb), is_integer(Ub) -> + per_enc_constrained(Val, Lb, Ub, Aligned). + +per_enc_constrained(Val, Sv, Sv, _Aligned) -> + {[],{eq,Val,Sv},[]}; +per_enc_constrained(Val0, Lb, Ub, false) -> + {Prefix,Val} = sub_lb(Val0, Lb), + Range = Ub - Lb + 1, + NumBits = uper_num_bits(Range), + Check = {ult,Val,Range}, + Put = [{put_bits,Val,NumBits,[1]}], + {Prefix,Check,Put}; +per_enc_constrained(Val0, Lb, Ub, true) -> + {Prefix,Val} = sub_lb(Val0, Lb), + Range = Ub - Lb + 1, + if + Range < 256 -> + NumBits = per_num_bits(Range), + Check = {ult,Val,Range}, + Put = [{put_bits,Val,NumBits,[1]}], + {Prefix,Check,Put}; + Range =:= 256 -> + NumBits = 8, + Check = {ult,Val,Range}, + Put = [{put_bits,Val,NumBits,[1,align]}], + {Prefix,Check,Put}; + Range =< 65536 -> + Check = {ult,Val,Range}, + Put = [{put_bits,Val,16,[1,align]}], + {Prefix,Check,Put}; + true -> + {var,VarBase} = Val, + Bin = {var,VarBase++"@bin"}, + BinSize0 = {var,VarBase++"@bin_size0"}, + BinSize = {var,VarBase++"@bin_size"}, + Check = {ult,Val,Range}, + RangeOctsLen = byte_size(binary:encode_unsigned(Range - 1)), + BitsNeeded = per_num_bits(RangeOctsLen), + Enc = [{call,binary,encode_unsigned,[Val],Bin}, + {call,erlang,byte_size,[Bin],BinSize0}, + {sub,BinSize0,1,BinSize}, + {'cond',[['_', + {put_bits,BinSize,BitsNeeded,[1]}, + {put_bits,Bin,binary,[8,align]}]]}], + {Prefix,Check,Enc} + end. + +per_enc_unconstrained(Val, Aligned) -> + case Aligned of + false -> []; + true -> [{put_bits,0,0,[1,align]}] + end ++ [{call,per_common,encode_unconstrained_number,[Val]}]. + +per_enc_unsigned(Val, Aligned) -> + case is_integer(Val) of + false -> + {var,VarBase} = Val, + Bin = {var,VarBase++"@bin"}, + BinSize = {var,VarBase++"@bin_size"}, + [{call,binary,encode_unsigned,[Val],Bin}, + {call,erlang,byte_size,[Bin],BinSize}| + per_enc_length(Bin, 8, BinSize, Aligned)]; + true -> + Bin = binary:encode_unsigned(Val), + Len = byte_size(Bin), + per_enc_length(Bin, 8, Len, Aligned) + end. + +%% Encode a length field without any constraint. +per_enc_length(Bin, Unit, Len, Aligned) -> + U = unit(1, Aligned), + PutBits = put_bits_binary(Bin, Unit, Aligned), + EncFragmented = {call,per_common,encode_fragmented,[Bin,Unit]}, + Al = case Aligned of + false -> []; + true -> [{put_bits,0,0,[1,align]}] + end, + build_cond([[{lt,Len,128}, + {put_bits,Len,8,U},PutBits], + [{lt,Len,16384}, + {put_bits,2,2,U},{put_bits,Len,14,[1]},PutBits], + ['_'|Al++[EncFragmented]]]). + +per_enc_length(Bin, Unit, Len, no, Aligned, _Type) -> + per_enc_length(Bin, Unit, Len, Aligned); +per_enc_length(Bin, Unit, Len, {{Lb,Ub},[]}, Aligned, Type) -> + {Prefix,Check,PutLen} = per_enc_constrained(Len, Lb, Ub, Aligned), + NoExt = {put_bits,0,1,[1]}, + U = unit(Unit, Aligned, Type, Lb*Unit, Ub*Unit), + PutBits = [{put_bits,Bin,binary,U}], + [{'cond',ExtConds0}] = per_enc_length(Bin, Unit, Len, Aligned), + Ext = {put_bits,1,1,[1]}, + ExtConds = prepend_to_cond(ExtConds0, Ext), + build_length_cond(Prefix, [[Check,NoExt|PutLen++PutBits]|ExtConds]); +per_enc_length(Bin, Unit, Len, {Lb,Ub}, Aligned, Type) + when is_integer(Lb) -> + {Prefix,Check,PutLen} = per_enc_constrained(Len, Lb, Ub, Aligned), + U = unit(Unit, Aligned, Type, Lb*Unit, Ub*Unit), + PutBits = [{put_bits,Bin,binary,U}], + build_length_cond(Prefix, [[Check|PutLen++PutBits]]); +per_enc_length(Bin, Unit, Len, Sv, Aligned, Type) when is_integer(Sv) -> + NumBits = Sv*Unit, + U = unit(Unit, Aligned, Type, NumBits, NumBits), + Pb = {put_bits,Bin,binary,U}, + [{'cond',[[{eq,Len,Sv},Pb]]}]. + +enc_length(Len, no, Aligned) -> + U = unit(1, Aligned), + build_cond([[{lt,Len,128}, + {put_bits,Len,8,U}], + [{lt,Len,16384}, + {put_bits,2,2,U},{put_bits,Len,14,[1]}]]); +enc_length(Len, {{Lb,Ub},[]}, Aligned) -> + {Prefix,Check,PutLen} = per_enc_constrained(Len, Lb, Ub, Aligned), + NoExt = {put_bits,0,1,[1]}, + [{'cond',ExtConds0}] = enc_length(Len, no, Aligned), + Ext = {put_bits,1,1,[1]}, + ExtConds = prepend_to_cond(ExtConds0, Ext), + build_length_cond(Prefix, [[Check,NoExt|PutLen]|ExtConds]); +enc_length(Len, {Lb,Ub}, Aligned) when is_integer(Lb) -> + {Prefix,Check,PutLen} = per_enc_constrained(Len, Lb, Ub, Aligned), + build_length_cond(Prefix, [[Check|PutLen]]); +enc_length(Len, Sv, _Aligned) when is_integer(Sv) -> + [{'cond',[[{eq,Len,Sv}]]}]. + +put_bits_binary(Bin, _Unit, Aligned) when is_binary(Bin) -> + Sz = byte_size(Bin), + <<Int:Sz/unit:8>> = Bin, + {put_bits,Int,8*Sz,unit(1, Aligned)}; +put_bits_binary(Bin, Unit, Aligned) -> + {put_bits,Bin,binary,unit(Unit, Aligned)}. + +sub_lb(Val, 0) -> + {[],Val}; +sub_lb({var,Var}=Val0, Lb) -> + Val = {var,Var++"@sub"}, + {[{sub,Val0,Lb,Val}],Val}; +sub_lb(Val, Lb) when is_integer(Val) -> + {[],Val-Lb}. + +build_length_cond([{sub,Var0,Base,Var}]=Prefix, Cs) -> + %% Non-zero lower bound, such as: SIZE (50..200, ...) + Prefix++[{'cond',opt_length_nzlb(Cs, {Var0,Var,Base}, 0)}]; +build_length_cond([], Cs) -> + %% Zero lower bound, such as: SIZE (0..200, ...) + [{'cond',opt_length_zlb(Cs, 0)}]. + +opt_length_zlb([[{ult,Var,Val}|Actions]|T], Ub) -> + %% Since the SIZE constraint is zero-based, Var + %% must be greater than zero, and we can use + %% the slightly cheaper signed less than operator. + opt_length_zlb([[{lt,Var,Val}|Actions]|T], Ub); +opt_length_zlb([[{lt,_,Val}|_]=H|T], Ub) -> + if + Val =< Ub -> + %% A previous test has already matched. + opt_length_zlb(T, Ub); + true -> + [H|opt_length_zlb(T, max(Ub, Val))] + end; +opt_length_zlb([H|T], Ub) -> + [H|opt_length_zlb(T, Ub)]; +opt_length_zlb([], _) -> []. + +opt_length_nzlb([[{ult,Var,Val}|_]=H|T], {_,Var,Base}=St, _Ub) -> + [H|opt_length_nzlb(T, St, Base+Val)]; +opt_length_nzlb([[{lt,Var0,Val}|_]=H|T], {Var0,_,_}=St, Ub) -> + if + Val =< Ub -> + %% A previous test has already matched. + opt_length_nzlb(T, St, Ub); + true -> + [H|opt_length_nzlb(T, St, Val)] + end; +opt_length_nzlb([H|T], St, Ub) -> + [H|opt_length_nzlb(T, St, Ub)]; +opt_length_nzlb([], _, _) -> []. + +build_cond(Conds0) -> + case eval_cond(Conds0, gb_sets:empty()) of + [['_'|Actions]] -> + Actions; + Conds -> + [{'cond',Conds}] + end. + +eval_cond([['_',{'cond',Cs}]], Seen) -> + eval_cond(Cs, Seen); +eval_cond([[Cond|Actions]=H|T], Seen0) -> + case gb_sets:is_element(Cond, Seen0) of + false -> + Seen = gb_sets:insert(Cond, Seen0), + case eval_cond_1(Cond) of + false -> + eval_cond(T, Seen); + true -> + [['_'|Actions]]; + maybe -> + [H|eval_cond(T, Seen)] + end; + true -> + eval_cond(T, Seen0) + end; +eval_cond([], _) -> []. + +eval_cond_1({ult,I,N}) when is_integer(I), is_integer(N) -> + 0 =< I andalso I < N; +eval_cond_1({eq,[],[]}) -> + true; +eval_cond_1({eq,I,N}) when is_integer(I), is_integer(N) -> + I =:= N; +eval_cond_1({lt,I,N}) when is_integer(I), is_integer(N) -> + I < N; +eval_cond_1(_) -> maybe. + +prepend_to_cond([H|T], Code) -> + [prepend_to_cond_1(H, Code)|prepend_to_cond(T, Code)]; +prepend_to_cond([], _) -> []. + +prepend_to_cond_1([Check|T], Code) -> + [Check,Code|T]. + +enc_char_tab(notab) -> + notab; +enc_char_tab(Tab0) -> + Tab = tuple_to_list(Tab0), + First = hd(Tab), + {First-1,list_to_tuple(enc_char_tab_1(Tab, First, 0))}. + +enc_char_tab_1([H|T], H, I) -> + [I|enc_char_tab_1(T, H+1, I+1)]; +enc_char_tab_1([_|_]=T, H, I) -> + [ill|enc_char_tab_1(T, H+1, I)]; +enc_char_tab_1([], _, _) -> []. + +enumerated_constraint([_]) -> + [{'SingleValue',0}]; +enumerated_constraint(Root) -> + [{'ValueRange',{0,length(Root)-1}}]. + +per_enc_enumerated_root(NNL, Prefix, Val, Constr, Aligned) -> + per_enc_enumerated_root_1(NNL, Prefix, Val, Constr, Aligned, 0). + +per_enc_enumerated_root_1([{H,_}|T], Prefix, Val, Constr, Aligned, N) -> + [[{eq,Val,H}|Prefix++per_enc_integer_1(N, Constr, Aligned)]| + per_enc_enumerated_root_1(T, Prefix, Val, Constr, Aligned, N+1)]; +per_enc_enumerated_root_1([], _, _, _, _, _) -> []. + +per_enc_enumerated_ext(NNL, Val, Aligned) -> + per_enc_enumerated_ext_1(NNL, Val, Aligned, 0). + +per_enc_enumerated_ext_1([{H,_}|T], Val, Aligned, N) -> + [[{eq,Val,H},{put_bits,1,1,[1]}|per_enc_small_number(N, Aligned)]| + per_enc_enumerated_ext_1(T, Val, Aligned, N+1)]; +per_enc_enumerated_ext_1([], _, _, _) -> []. + +per_enc_small_length(Val0, Aligned) -> + {Sub,Val} = sub_lb(Val0, 1), + U = unit(1, Aligned), + Sub ++ build_cond([[{lt,Val,64},{put_bits,Val,7,[1]}], + [{lt,Val0,128},{put_bits,1,1,[1]}, + {put_bits,Val0,8,U}], + ['_',{put_bits,1,1,[1]}, + {put_bits,2,2,U},{put_bits,Val0,14,[1]}]]). + +constr_min_size(no) -> no; +constr_min_size({{Lb,_},[]}) when is_integer(Lb) -> Lb; +constr_min_size({Lb,_}) when is_integer(Lb) -> Lb; +constr_min_size(Sv) when is_integer(Sv) -> Sv. + +enc_mod(false) -> uper; +enc_mod(true) -> per. + +unit(U, false) -> [U]; +unit(U, true) -> [U,align]. + +unit(U, Aligned, Type, Lb, Ub) -> + case Aligned andalso is_aligned(Type, Lb, Ub) of + true -> [U,align]; + false -> [U] + end. + +opt_choice(Imm) -> + {Pb,T0} = lists:splitwith(fun({put_bits,V,_,_}) when is_integer(V) -> + true; + (_) -> + false + end, Imm), + try + {Prefix,T} = split_off_nonbuilding(T0), + Prefix ++ opt_choice_1(T, Pb) + catch + throw:impossible -> + Imm + end. + +opt_choice_1([{'cond',Cs0}], Pb) -> + case Cs0 of + [[C|Act]] -> + [{'cond',[[C|Pb++Act]]}]; + [[C|Act],['_',{error,_}]=Error] -> + [{'cond',[[C|Pb++Act],Error]}]; + _ -> + [{'cond',opt_choice_2(Cs0, Pb)}] + end; +opt_choice_1(_, _) -> throw(impossible). + +opt_choice_2([[C|[{put_bits,_,_,_}|_]=Act]|T], Pb) -> + [[C|Pb++Act]|opt_choice_2(T, Pb)]; +opt_choice_2([[_,{error,_}]=H|T], Pb) -> + [H|opt_choice_2(T, Pb)]; +opt_choice_2([_|_], _) -> + throw(impossible); +opt_choice_2([], _) -> []. + + +%%% +%%% Helper functions for code generation of open types. +%%% + +per_enc_open_type(Val0, {ToBinMod,ToBinFunc}, Aligned) -> + {B,[Val,Len,Bin]} = mk_vars(Val0, [len,bin]), + B ++ [{call,ToBinMod,ToBinFunc,[Val],Bin}, + {call,erlang,byte_size,[Bin],Len}| + per_enc_length(Bin, 8, Len, Aligned)]. + +enc_open_type([{'cond',Cs}], Aligned) -> + [{'cond',[[C|enc_open_type_1(Act, Aligned)] || [C|Act] <- Cs]}]; +enc_open_type(_, _) -> + throw(impossible). + +enc_open_type_1([{error,_}]=Imm, _) -> + Imm; +enc_open_type_1(Imm, Aligned) -> + NumBits = num_bits(Imm, 0), + Pad = case 8 - (NumBits rem 8) of + 8 -> []; + Pad0 -> [{put_bits,0,Pad0,[1]}] + end, + NumBytes = (NumBits+7) div 8, + enc_length(NumBytes, no, Aligned) ++ Imm ++ Pad. + +num_bits([{put_bits,_,N,[U|_]}|T], Sum) when is_integer(N) -> + num_bits(T, Sum+N*U); +num_bits([_|_], _) -> + throw(impossible); +num_bits([], Sum) -> Sum. + +per_enc_open_type_output([{apply,F,A}], Acc) -> + Dst = output_var(), + {Dst,lists:reverse(Acc, [{apply,F,A,{var,atom_to_list(Dst)}}])}; +per_enc_open_type_output([{call,M,F,A}], Acc) -> + Dst = output_var(), + {Dst,lists:reverse(Acc, [{call,M,F,A,{var,atom_to_list(Dst)}}])}; +per_enc_open_type_output([{'cond',Cs}], Acc) -> + Dst = output_var(), + {Dst,lists:reverse(Acc, [{'cond',Cs,{var,atom_to_list(Dst)}}])}; +per_enc_open_type_output([H|T], Acc) -> + per_enc_open_type_output(T, [H|Acc]). + +output_var() -> + asn1ct_name:new(enc), + Curr = asn1ct_name:curr(enc), + [H|T] = atom_to_list(Curr), + list_to_atom([H - ($a - $A)|T ++ "@output"]). + + +%%% +%%% Optimize list comprehensions (SEQUENCE OF/SET OF). +%%% + +opt_lc([{lc,[{call,erlang,iolist_to_binary,[Var],Bin}, + {call,erlang,byte_size,[Bin],LenVar}, + {'cond',[[{eq,LenVar,Len},{put_bits,Bin,_,[_|Align]}]]}], + Var,Val}]=Lc, LenImm) -> + %% Given a sequence of a fixed length string, such as + %% SEQUENCE OF OCTET STRING (SIZE (4)), attempt to rewrite to + %% a list comprehension that just checks the size, followed by + %% a conversion to binary: + %% + %% _ = [if length(Comp) =:= 4; byte_size(Comp) =:= 4 -> [] end || + %% Comp <- Sof], + %% [align|iolist_to_binary(Sof)] + + CheckImm = [{'cond',[[{eq,{expr,"length("++mk_val(Var)++")"},Len}], + [{eq,{expr,"byte_size("++mk_val(Var)++")"},Len}]]}], + Al = case Align of + [] -> + []; + [align] -> + [{put_bits,0,0,[1|Align]}] + end, + case Al =:= [] orelse + is_end_aligned(LenImm) orelse + lb_is_nonzero(LenImm) of + false -> + %% Not possible because an empty SEQUENCE OF would be + %% improperly aligned. Example: + %% + %% SEQUENCE (SIZE (0..3)) OF ... + + Lc; + true -> + %% Examples: + %% + %% SEQUENCE (SIZE (1..4)) OF ... + %% (OK because there must be at least one element) + %% + %% SEQUENCE OF ... + %% (OK because the length field will force alignment) + %% + Al ++ [{lc,CheckImm,Var,Val,{var,"_"}}, + {call,erlang,iolist_to_binary,[Val]}] + end; +opt_lc([{lc,ElementImm0,V,L}]=Lc, LenImm) -> + %% Attempt to hoist the alignment, putting after the length + %% and before the list comprehension: + %% + %% [Length, + %% align, + %% [Encode(Comp) || Comp <- Sof]] + %% + + case enc_opt_al_1(ElementImm0, 0) of + {ElementImm,0} -> + case is_end_aligned(LenImm) orelse + (is_beginning_aligned(ElementImm0) andalso + lb_is_nonzero(LenImm)) of + false -> + %% Examples: + %% + %% SEQUENCE (SIZE (0..3)) OF OCTET STRING + %% (An empty SEQUENCE OF would be improperly aligned) + %% + %% SEQUENCE (SIZE (1..3)) OF OCTET STRING (SIZE (0..4)) + %% (There would be an improper alignment before the + %% first element) + + Lc; + true -> + %% Examples: + %% + %% SEQUENCE OF INTEGER + %% SEQUENCE (SIZE (1..4)) OF INTEGER + %% SEQUENCE (SIZE (1..4)) OF INTEGER (0..256) + + [{put_bits,0,0,[1,align]},{lc,ElementImm,V,L}] + end; + _ -> + %% Unknown alignment, no alignment, or not aligned at the end. + %% Examples: + %% + %% SEQUENCE OF SomeConstructedType + %% SEQUENCE OF INTEGER (0..15) + + Lc + end. + +is_beginning_aligned([{'cond',Cs}]) -> + lists:all(fun([_|Act]) -> is_beginning_aligned(Act) end, Cs); +is_beginning_aligned([{error,_}|_]) -> true; +is_beginning_aligned([{put_bits,_,_,U}|_]) -> + case U of + [_,align] -> true; + [_] -> false + end; +is_beginning_aligned(Imm0) -> + case split_off_nonbuilding(Imm0) of + {[],_} -> false; + {[_|_],Imm} -> is_beginning_aligned(Imm) + end. + +is_end_aligned(Imm) -> + case enc_opt_al_1(Imm, unknown) of + {_,0} -> true; + {_,_} -> false + end. + +lb_is_nonzero([{sub,_,_,_}|_]) -> true; +lb_is_nonzero(_) -> false. + +%%% +%%% Attempt to combine two chunks of intermediate code. +%%% + +combine_imms(ImmA0, ImmB0) -> + {Prefix0,ImmA} = split_off_nonbuilding(ImmA0), + {Prefix1,ImmB} = split_off_nonbuilding(ImmB0), + Prefix = Prefix0 ++ Prefix1, + Combined = do_combine(ImmA ++ ImmB, 3.0), + Prefix ++ Combined. + +do_combine([{error,_}=Imm|_], _Budget) -> + [Imm]; +do_combine([{'cond',Cs0}|T], Budget0) -> + Budget = debit(Budget0, num_clauses(Cs0, 0)), + Cs = [[C|do_combine(Act++T, Budget)] || [C|Act] <- Cs0], + [{'cond',Cs}]; +do_combine([{put_bits,V,_,_}|_]=L, Budget) when is_integer(V) -> + {Pb,T} = collect_put_bits(L), + do_combine_put_bits(Pb, T,Budget); +do_combine(_, _) -> + throw(impossible). + +do_combine_put_bits(Pb, [], _Budget) -> + Pb; +do_combine_put_bits(Pb, [{'cond',Cs0}|T], Budget) -> + Cs = [case Act of + [{error,_}] -> + [C|Act]; + _ -> + [C|do_combine(Pb++Act, Budget)] + end || [C|Act] <- Cs0], + do_combine([{'cond',Cs}|T], Budget); +do_combine_put_bits(_, _, _) -> + throw(impossible). + +debit(Budget0, Alternatives) -> + case Budget0 - log2(Alternatives) of + Budget when Budget > 0.0 -> + Budget; + _ -> + throw(impossible) + end. + +num_clauses([[_,{error,_}]|T], N) -> + num_clauses(T, N); +num_clauses([_|T], N) -> + num_clauses(T, N+1); +num_clauses([], N) -> N. + +log2(N) -> + math:log(N) / math:log(2.0). + +collect_put_bits(Imm) -> + lists:splitwith(fun({put_bits,V,_,_}) when is_integer(V) -> true; + (_) -> false + end, Imm). + +%%% +%%% Simple common subexpression elimination to avoid fetching +%%% the same element twice. +%%% + +enc_cse([{assign,{var,V},E}=H|T]) -> + [H|enc_cse_1(T, E, V)]; +enc_cse(Imm) -> Imm. + +enc_cse_1([{assign,Dst,E}|T], E, V) -> + [{assign,Dst,V}|enc_cse_1(T, E, V)]; +enc_cse_1([{block,Bl}|T], E, V) -> + [{block,enc_cse_1(Bl, E, V)}|enc_cse_1(T, E, V)]; +enc_cse_1([H|T], E, V) -> + [H|enc_cse_1(T, E, V)]; +enc_cse_1([], _, _) -> []. + + +%%% +%%% Pre-process the intermediate code to simplify code generation. +%%% + +enc_pre_cg(Imm) -> + enc_pre_cg_1(Imm, outside_list, in_seq). + +enc_pre_cg_1([], _StL, _StB) -> + nil; +enc_pre_cg_1([H], StL, StB) -> + enc_pre_cg_2(H, StL, StB); +enc_pre_cg_1([H0|T0], StL, StB) -> + case is_nonbuilding(H0) of + true -> + H = enc_pre_cg_nonbuilding(H0, StL), + Seq = {seq,H,enc_pre_cg_1(T0, StL, in_seq)}, + case StB of + outside_seq -> {block,Seq}; + in_seq -> Seq + end; + false -> + H = enc_pre_cg_2(H0, in_head, outside_seq), + T = enc_pre_cg_1(T0, in_tail, outside_seq), + enc_make_cons(H, T) + end. + +enc_pre_cg_2(align, StL, _StB) -> + case StL of + in_head -> align; + in_tail -> {cons,align,nil} + end; +enc_pre_cg_2({apply,_,_}=Imm, _, _) -> + Imm; +enc_pre_cg_2({block,Bl0}, StL, StB) -> + enc_pre_cg_1(Bl0, StL, StB); +enc_pre_cg_2({call,_,_,_}=Imm, _, _) -> + Imm; +enc_pre_cg_2({call_gen,_,_,_,_}=Imm, _, _) -> + Imm; +enc_pre_cg_2({'cond',Cs0}, StL, _StB) -> + Cs = [{C,enc_pre_cg_1(Act, StL, outside_seq)} || [C|Act] <- Cs0], + {'cond',Cs}; +enc_pre_cg_2({error,_}=E, _, _) -> + E; +enc_pre_cg_2({lc,B0,V,L}, StL, _StB) -> + B = enc_pre_cg_1(B0, StL, outside_seq), + {lc,B,V,L}; +enc_pre_cg_2({put_bits,V,8,[1]}, StL, _StB) -> + case StL of + in_head -> {integer,V}; + in_tail -> {cons,{integer,V},nil}; + outside_list -> {cons,{integer,V},nil} + end; +enc_pre_cg_2({put_bits,V,binary,_}, _StL, _StB) -> + V; +enc_pre_cg_2({put_bits,_,_,[_]}=PutBits, _StL, _StB) -> + {binary,[PutBits]}; +enc_pre_cg_2({var,_}=Imm, _, _) -> Imm. + +enc_make_cons({binary,H}, {binary,T}) -> + {binary,H++T}; +enc_make_cons({binary,H0}, {cons,{binary,H1},T}) -> + {cons,{binary,H0++H1},T}; +enc_make_cons({integer,Int}, {binary,T}) -> + {binary,[{put_bits,Int,8,[1]}|T]}; +enc_make_cons(H, T) -> + {cons,H,T}. + +enc_pre_cg_nonbuilding({'cond',Cs0,Dst}, StL) -> + Cs = [{C,enc_pre_cg_1(Act, StL, outside_seq)} || [C|Act] <- Cs0], + {'cond',Cs,Dst}; +enc_pre_cg_nonbuilding({lc,B0,Var,List,Dst}, StL) -> + B = enc_pre_cg_1(B0, StL, outside_seq), + {lc,B,Var,List,Dst}; +enc_pre_cg_nonbuilding({'try',Try0,{P,Succ0},Else0,Dst}, StL) -> + Try = enc_pre_cg_1(Try0, StL, outside_seq), + Succ = enc_pre_cg_1(Succ0, StL, outside_seq), + Else = enc_pre_cg_1(Else0, StL, outside_seq), + {'try',Try,{P,Succ},Else,Dst}; +enc_pre_cg_nonbuilding(Imm, _) -> Imm. + + +%%% +%%% Code generation for encoding. +%%% + +enc_cg({cons,_,_}=Cons) -> + enc_cg_cons(Cons); +enc_cg({block,Imm}) -> + emit(["begin",nl]), + enc_cg(Imm), + emit([nl, + "end"]); +enc_cg({seq,First,Then}) -> + enc_cg(First), + emit([com,nl]), + enc_cg(Then); +enc_cg(align) -> + emit(align); +enc_cg({apply,F0,As0}) -> + As = enc_call_args(As0, ""), + case F0 of + {M,F} -> + emit([{asis,M},":",{asis,F},"(",As,")"]); + F when is_atom(F) -> + emit([{asis,F},"(",As,")"]) + end; +enc_cg({apply,F0,As0,Dst}) -> + As = enc_call_args(As0, ""), + emit([mk_val(Dst)," = "]), + case F0 of + {M,F} -> + emit([{asis,M},":",{asis,F},"(",As,")"]); + F when is_atom(F) -> + emit([{asis,F},"(",As,")"]) + end; +enc_cg({assign,Dst0,Expr}) -> + Dst = mk_val(Dst0), + emit([Dst," = ",Expr]); +enc_cg({binary,PutBits}) -> + emit(["<<",enc_cg_put_bits(PutBits, ""),">>"]); +enc_cg({call,M,F,As0}) -> + As = [mk_val(A) || A <- As0], + asn1ct_func:call(M, F, As); +enc_cg({call,M,F,As0,Dst}) -> + As = [mk_val(A) || A <- As0], + emit([mk_val(Dst)," = "]), + asn1ct_func:call(M, F, As); +enc_cg({call_gen,Prefix,Key,Gen,As0}) -> + As = [mk_val(A) || A <- As0], + asn1ct_func:call_gen(Prefix, Key, Gen, As); +enc_cg({'cond',Cs}) -> + enc_cg_cond(Cs); +enc_cg({'cond',Cs,Dst0}) -> + Dst = mk_val(Dst0), + emit([Dst," = "]), + enc_cg_cond(Cs); +enc_cg({error,Error}) when is_function(Error, 0) -> + Error(); +enc_cg({error,Var0}) -> + Var = mk_val(Var0), + emit(["exit({error,{asn1,{illegal_value,",Var,"}}})"]); +enc_cg({integer,Int}) -> + emit(mk_val(Int)); +enc_cg({lc,Body,Var,List}) -> + emit("["), + enc_cg(Body), + emit([" || ",mk_val(Var)," <- ",mk_val(List),"]"]); +enc_cg({lc,Body,Var,List,Dst}) -> + emit([mk_val(Dst)," = ["]), + enc_cg(Body), + emit([" || ",mk_val(Var)," <- ",mk_val(List),"]"]); +enc_cg(nil) -> + emit("[]"); +enc_cg({sub,Src0,Int,Dst0}) -> + Src = mk_val(Src0), + Dst = mk_val(Dst0), + emit([Dst," = ",Src," - ",Int]); +enc_cg({'try',Try,{P,Succ},Else,Dst}) -> + emit([mk_val(Dst)," = try "]), + enc_cg(Try), + emit([" of",nl, + mk_val(P)," ->",nl]), + enc_cg(Succ), + emit([nl, + "catch throw:invalid ->",nl]), + enc_cg(Else), + emit([nl, + "end"]); +enc_cg({var,V}) -> + emit(V). + +enc_cg_cons(Cons) -> + emit("["), + enc_cg_cons_1(Cons), + emit("]"). + +enc_cg_cons_1({cons,H,{cons,_,_}=T}) -> + enc_cg(H), + emit([com,nl]), + enc_cg_cons_1(T); +enc_cg_cons_1({cons,H,nil}) -> + enc_cg(H); +enc_cg_cons_1({cons,H,T}) -> + enc_cg(H), + emit("|"), + enc_cg(T). + +enc_call_args([A|As], Sep) -> + [Sep,mk_val(A)|enc_call_args(As, ", ")]; +enc_call_args([], _) -> []. + +enc_cg_cond([{'_',Action}]) -> + enc_cg(Action); +enc_cg_cond(Cs) -> + emit("if "), + enc_cg_cond(Cs, ""), + emit([nl, + "end"]). + +enc_cg_cond([C|Cs], Sep) -> + emit(Sep), + enc_cg_cond_1(C), + enc_cg_cond(Cs, [";",nl]); +enc_cg_cond([], _) -> ok. + +enc_cg_cond_1({Cond,Action}) -> + enc_cond_term(Cond), + emit([" ->",nl]), + enc_cg(Action). + +enc_cond_term('_') -> + emit("true"); +enc_cond_term({ult,Var0,Int}) -> + Var = mk_val(Var0), + N = uper_num_bits(Int), + case 1 bsl N of + Int -> + emit([Var," bsr ",N," =:= 0"]); + _ -> + emit(["0 =< ",Var,", ",Var," < ",Int]) + end; +enc_cond_term({eq,Var0,Term}) -> + Var = mk_val(Var0), + emit([Var," =:= ",{asis,Term}]); +enc_cond_term({ge,Var0,Int}) -> + Var = mk_val(Var0), + emit([Var," >= ",Int]); +enc_cond_term({lt,Var0,Int}) -> + Var = mk_val(Var0), + emit([Var," < ",Int]). + +enc_cg_put_bits([{put_bits,Val0,N,[1]}|T], Sep) -> + Val = mk_val(Val0), + [[Sep,Val,":",integer_to_list(N)]|enc_cg_put_bits(T, ",")]; +enc_cg_put_bits([], _) -> []. + +mk_val({var,Str}) -> Str; +mk_val({expr,Str}) -> Str; +mk_val(Int) when is_integer(Int) -> integer_to_list(Int); +mk_val(Other) -> {asis,Other}. + +%%% +%%% Generate a function that maps a name of a bit position +%%% to the bit position. +%%% + +bit_string_name2pos_fun(NNL, Src) -> + {call_gen,"bit_string_name2pos_",NNL, + fun(Fd, Name) -> gen_name2pos(Fd, Name, NNL) end,[Src]}. + +gen_name2pos(Fd, Name, Names) -> + Cs0 = gen_name2pos_cs(Names, Name), + Cs = Cs0 ++ [bit_clause(Name),nil_clause(),invalid_clause()], + F = {function,1,Name,1,Cs}, + file:write(Fd, [erl_pp:function(F)]). + +gen_name2pos_cs([{K,V}|T], Name) -> + P = [{cons,0,{atom,0,K},{var,0,'T'}}], + B = [{cons,0,{integer,0,V},{call,0,{atom,0,Name},[{var,0,'T'}]}}], + [{clause,0,P,[],B}|gen_name2pos_cs(T, Name)]; +gen_name2pos_cs([], _) -> []. + +bit_clause(Name) -> + VarT = {var,0,'T'}, + VarPos = {var,0,'Pos'}, + P = [{cons,0,{tuple,0,[{atom,0,bit},VarPos]},VarT}], + G = [[{call,0,{atom,0,is_integer},[VarPos]}]], + B = [{cons,0,VarPos,{call,0,{atom,0,Name},[VarT]}}], + {clause,0,P,G,B}. + +nil_clause() -> + P = B = [{nil,0}], + {clause,0,P,[],B}. + +invalid_clause() -> + P = [{var,0,'_'}], + B = [{call,0,{atom,0,throw},[{atom,0,invalid}]}], + {clause,0,P,[],B}. + +%%% +%%% Hoist alignment to reduce the number of list elements in +%%% encode. Fewer lists elements means faster traversal in +%%% complete/{2,3}. +%%% +%%% For example, the following data sequence: +%%% +%%% [align,<<1:1,0:1>>,[align,<<Len:16>>|Data]] +%%% +%%% can be rewritten to: +%%% +%%% [align,<<1:1,0:1,0:6>>,[<<Len:16>>|Data]] +%%% +%%% The change from the literal <<1:1,0:1>> to <<1:1,0:1,0:6>> +%%% comes for free, and we have eliminated one element of the +%%% sub list. +%%% +%%% We must be careful not to rewrite: +%%% +%%% [<<1:1,0:1>>,[align,<<Len:16>>|Data]] +%%% +%%% to: +%%% +%%% [[<<1:1,0:1>>,align],[<<Len:16>>|Data]] +%%% +%%% because even though [<<1:0,0:1>>,align] is a literal and does +%%% not add any additional construction cost, there is one more +%%% sub list that needs to be traversed. +%%% + +enc_hoist_align(Imm0) -> + Imm = enc_hoist_align_reverse(Imm0, []), + enc_hoist_align(Imm, false, []). + +enc_hoist_align_reverse([H|T], Acc) -> + case enc_opt_al_1([H], 0) of + {[H],_} -> + enc_hoist_align_reverse(T, [H|Acc]); + {_,_} -> + lists:reverse(T, [H,stop|Acc]) + end; +enc_hoist_align_reverse([], Acc) -> Acc. + +enc_hoist_align([stop|T], _Aligned, Acc) -> + lists:reverse(T, Acc); +enc_hoist_align([{block,Bl0}|T], Aligned, Acc) -> + Bl = case Aligned of + false -> Bl0; + true -> enc_hoist_block(Bl0) + end, + case is_beginning_aligned(Bl) of + false -> + enc_hoist_align(T, false, [{block,Bl}|Acc]); + true -> + enc_hoist_align(T, true, [{put_bits,0,0,[1,align]}, + {block,Bl}|Acc]) + end; +enc_hoist_align([H|T], _, Acc) -> + enc_hoist_align(T, false, [H|Acc]); +enc_hoist_align([], _, Acc) -> Acc. + +enc_hoist_block(Bl) -> + try + enc_hoist_block_1(lists:reverse(Bl)) + catch + throw:impossible -> + Bl + end. + +enc_hoist_block_1([{'cond',Cs0}|T]) -> + Cs = [[C|enc_hoist_block_2(Act)] || [C|Act] <- Cs0], + H = {'cond',Cs}, + lists:reverse(T, [H]); +enc_hoist_block_1(_) -> + throw(impossible). + +enc_hoist_block_2([{'cond',_}|_]=L) -> + enc_hoist_block(L); +enc_hoist_block_2([{error,_}]=L) -> + L; +enc_hoist_block_2([]) -> + [{put_bits,0,0,[1,align]}]; +enc_hoist_block_2(L) -> + case lists:last(L) of + {put_bits,_,_,_} -> + L ++ [{put_bits,0,0,[1,align]}]; + _ -> + throw(impossible) + end. + +%%% +%%% Optimize alignment for encoding. +%%% + +enc_opt_al(Imm0) -> + {Imm,_} = enc_opt_al_1(Imm0, unknown), + Imm. + +enc_opt_al_1([{'cond',Cs0,Dst},{call,per,complete,[Dst],Bin}|T0], Al0) -> + {Cs1,{M,F}} = enc_opt_al_prepare_cond(Cs0), + {Cs,_} = enc_opt_al_cond(Cs1, 0), + {T,Al} = enc_opt_al_1([{call,M,F,[Dst],Bin}|T0], Al0), + {[{'cond',Cs,Dst}|T],Al}; +enc_opt_al_1([H0|T0], Al0) -> + {H,Al1} = enc_opt_al(H0, Al0), + {T,Al} = enc_opt_al_1(T0, Al1), + {H++T,Al}; +enc_opt_al_1([], Al) -> {[],Al}. + +enc_opt_al({apply,_,_,_}=Imm, Al) -> + {[Imm],Al}; +enc_opt_al({assign,_,_}=Imm, Al) -> + {[Imm],Al}; +enc_opt_al({block,Bl0}, Al0) -> + {Bl,Al} = enc_opt_al_1(Bl0, Al0), + {[{block,Bl}],Al}; +enc_opt_al({call,erlang,iolist_to_binary,[_]}=Imm, Al) -> + {[Imm],Al}; +enc_opt_al({call,per_common,encode_fragmented,[_,U]}=Call, Al) -> + case U rem 8 of + 0 -> {[Call],Al}; + _ -> {[Call],unknown} + end; +enc_opt_al({call,per_common,encode_unconstrained_number,[_]}=Call, _) -> + {[Call],0}; +enc_opt_al({call,_,_,_,_}=Call, Al) -> + {[Call],Al}; +enc_opt_al({'cond',Cs0}, Al0) -> + {Cs,Al} = enc_opt_al_cond(Cs0, Al0), + {[{'cond',Cs}],Al}; +enc_opt_al({error,_}=Imm, Al) -> + {[Imm],Al}; +enc_opt_al({put_bits,V,N,[U,align]}, Al0) when Al0 rem 8 =:= 0 -> + Al = if + is_integer(N) -> N*U; + N =:= binary, U rem 8 =:= 0 -> 0; + true -> unknown + end, + {[{put_bits,V,N,[U]}],Al}; +enc_opt_al({put_bits,V,binary,[U,align]}, Al0) when is_integer(Al0) -> + N = 8 - (Al0 rem 8), + Al = case U rem 8 of + 0 -> 0; + _ -> unknown + end, + {[{put_bits,0,N,[1]},{put_bits,V,binary,[U]}],Al}; +enc_opt_al({put_bits,V,N0,[U,align]}, Al0) when is_integer(N0), is_integer(Al0) -> + N = N0 + (8 - Al0 rem 8), + Al = N0*U, + {[{put_bits,V,N,[1]}],Al}; +enc_opt_al({put_bits,_,N,[U,align]}=PutBits, _) when is_integer(N) -> + {[PutBits],N*U}; +enc_opt_al({put_bits,_,binary,[U,align]}=PutBits, _) when U rem 8 =:= 0 -> + {[PutBits],0}; +enc_opt_al({put_bits,_,N,[U]}=PutBits, Al) when is_integer(N), is_integer(Al) -> + {[PutBits],Al+N*U}; +enc_opt_al({put_bits,_,binary,[U]}=PutBits, Al) when U rem 8 =:= 0 -> + {[PutBits],Al}; +enc_opt_al({sub,_,_,_}=Imm, Al) -> + {[Imm],Al}; +enc_opt_al(Imm, _) -> + {[Imm],unknown}. + +enc_opt_al_cond(Cs0, Al0) -> + enc_opt_al_cond_1(Cs0, Al0, [], []). + +enc_opt_al_cond_1([['_',{error,_}]=C|Cs], Al, CAcc, AAcc) -> + enc_opt_al_cond_1(Cs, Al, [C|CAcc], AAcc); +enc_opt_al_cond_1([[C|Act0]|Cs0], Al0, CAcc, AAcc) -> + {Act,Al1} = enc_opt_al_1(Act0, Al0), + Al = if + Al1 =:= unknown -> Al1; + true -> Al1 rem 8 + end, + enc_opt_al_cond_1(Cs0, Al0, [[C|Act]|CAcc], [Al|AAcc]); +enc_opt_al_cond_1([], _, CAcc, AAcc) -> + Al = case lists:usort(AAcc) of + [] -> unknown; + [Al0] -> Al0; + [_|_] -> unknown + end, + {lists:reverse(CAcc),Al}. + +enc_opt_al_prepare_cond(Cs0) -> + try enc_opt_al_prepare_cond_1(Cs0) of + Cs -> + {Cs,{erlang,iolist_to_binary}} + catch + throw:impossible -> + {Cs0,{per,complete}} + end. + +enc_opt_al_prepare_cond_1(Cs) -> + [[C|enc_opt_al_prepare_cond_2(Act)] || [C|Act] <- Cs]. + +enc_opt_al_prepare_cond_2([{put_bits,_,binary,[U|_]}|_]) when U rem 8 =/= 0 -> + throw(impossible); +enc_opt_al_prepare_cond_2([{put_bits,_,_,_}=H|T]) -> + [H|enc_opt_al_prepare_cond_2(T)]; +enc_opt_al_prepare_cond_2([{call,per_common,encode_fragmented,_}=H|T]) -> + [H|enc_opt_al_prepare_cond_2(T)]; +enc_opt_al_prepare_cond_2([_|_]) -> + throw(impossible); +enc_opt_al_prepare_cond_2([]) -> + [{put_bits,0,0,[1,align]}]. + + +%%% +%%% For the aligned PER format, fix up the intermediate format +%%% before code generation. Code generation will be somewhat +%%% easier if 'align' appear as a separate instruction. +%%% + +per_fixup([{apply,_,_}=H|T]) -> + [H|per_fixup(T)]; +per_fixup([{apply,_,_,_}=H|T]) -> + [H|per_fixup(T)]; +per_fixup([{block,Block}|T]) -> + [{block,per_fixup(Block)}|per_fixup(T)]; +per_fixup([{'assign',_,_}=H|T]) -> + [H|per_fixup(T)]; +per_fixup([{'cond',Cs0}|T]) -> + Cs = [[C|per_fixup(Act)] || [C|Act] <- Cs0], + [{'cond',Cs}|per_fixup(T)]; +per_fixup([{'cond',Cs0,Dst}|T]) -> + Cs = [[C|per_fixup(Act)] || [C|Act] <- Cs0], + [{'cond',Cs,Dst}|per_fixup(T)]; +per_fixup([{call,_,_,_}=H|T]) -> + [H|per_fixup(T)]; +per_fixup([{call,_,_,_,_}=H|T]) -> + [H|per_fixup(T)]; +per_fixup([{call_gen,_,_,_,_}=H|T]) -> + [H|per_fixup(T)]; +per_fixup([{error,_}=H|T]) -> + [H|per_fixup(T)]; +per_fixup([{lc,B,V,L}|T]) -> + [{lc,per_fixup(B),V,L}|per_fixup(T)]; +per_fixup([{lc,B,V,L,Dst}|T]) -> + [{lc,per_fixup(B),V,L,Dst}|per_fixup(T)]; +per_fixup([{sub,_,_,_}=H|T]) -> + [H|per_fixup(T)]; +per_fixup([{'try',Try0,{P,Succ0},Else0,Dst}|T]) -> + Try = per_fixup(Try0), + Succ = per_fixup(Succ0), + Else = per_fixup(Else0), + [{'try',Try,{P,Succ},Else,Dst}|per_fixup(T)]; +per_fixup([{put_bits,_,_,_}|_]=L) -> + fixup_put_bits(L); +per_fixup([{var,_}=H|T]) -> + [H|per_fixup(T)]; +per_fixup([]) -> []. + +fixup_put_bits([{put_bits,0,0,[_,align]}|T]) -> + [align|fixup_put_bits(T)]; +fixup_put_bits([{put_bits,0,0,_}|T]) -> + fixup_put_bits(T); +fixup_put_bits([{put_bits,V,N,[U,align]}|T]) -> + [align,{put_bits,V,N,[U]}|fixup_put_bits(T)]; +fixup_put_bits([{put_bits,_,_,_}=H|T]) -> + [H|fixup_put_bits(T)]; +fixup_put_bits(Other) -> per_fixup(Other). + %% effective_constraint(Type,C) %% Type = atom() %% C = [C1,...] diff --git a/lib/asn1/src/asn1ct_parser2.erl b/lib/asn1/src/asn1ct_parser2.erl index 1abccc8626..283616b157 100644 --- a/lib/asn1/src/asn1ct_parser2.erl +++ b/lib/asn1/src/asn1ct_parser2.erl @@ -38,6 +38,7 @@ parse(Tokens) -> {error,{Reason,hd(Tokens)}}; {ModuleDefinition,Rest1} -> {Types,Rest2} = parse_AssignmentList(Rest1), + clean_process_dictionary(), case Rest2 of [{'END',_}|_Rest3] -> {ok,ModuleDefinition#module{typeorval = Types}}; @@ -48,6 +49,13 @@ parse(Tokens) -> end end. +clean_process_dictionary() -> + Mod = erase(asn1_module), + _ = erase({Mod,imports}), + _ = erase(tagdefault), + _ = erase(extensiondefault), + ok. + parse_ModuleDefinition([{typereference,L1,ModuleIdentifier}|Rest0]) -> put(asn1_module,ModuleIdentifier), {_DefinitiveIdentifier,Rest02} = diff --git a/lib/asn1/src/asn1ct_value.erl b/lib/asn1/src/asn1ct_value.erl index ecdfa3f645..862b3c4ea5 100644 --- a/lib/asn1/src/asn1ct_value.erl +++ b/lib/asn1/src/asn1ct_value.erl @@ -32,11 +32,11 @@ from_type(M,Typename) -> - case asn1_db:dbget(M,Typename) of - undefined -> + case asn1_db:dbload(M) of + error -> {error,{not_found,{M,Typename}}}; - Tdef when is_record(Tdef,typedef) -> - Type = Tdef#typedef.typespec, + ok -> + #typedef{typespec=Type} = asn1_db:dbget(M, Typename), from_type(M,[Typename],Type); Vdef when is_record(Vdef,valuedef) -> from_value(Vdef); @@ -167,17 +167,16 @@ from_type_prim(M, D) -> case D#type.def of 'INTEGER' -> i_random(C); - {'INTEGER',NamedNumberList} -> - NN = [X||{X,_} <- NamedNumberList], - case NN of + {'INTEGER',[_|_]=NNL} -> + case C of [] -> - i_random(C); + {N,_} = lists:nth(random(length(NNL)), NNL), + N; _ -> - case C of - [] -> - lists:nth(random(length(NN)),NN); - _ -> - lists:nth((fun(0)->1;(X)->X end(i_random(C))),NN) + V = i_random(C), + case lists:keyfind(V, 2, NNL) of + false -> V; + {N,V} -> N end end; Enum when is_tuple(Enum),element(1,Enum)=='ENUMERATED' -> diff --git a/lib/asn1/src/asn1rtt_ber.erl b/lib/asn1/src/asn1rtt_ber.erl index b5429fe324..583ff790b7 100644 --- a/lib/asn1/src/asn1rtt_ber.erl +++ b/lib/asn1/src/asn1rtt_ber.erl @@ -22,8 +22,7 @@ %% encoding / decoding of BER -export([ber_decode_nif/1,ber_decode_erlang/1,match_tags/2,ber_encode/1]). --export([encode_tags/2, - encode_tags/3, +-export([encode_tags/3, skip_ExtensionAdditions/2]). -export([encode_boolean/2,decode_boolean/2, encode_integer/2,encode_integer/3, diff --git a/lib/asn1/src/asn1rtt_check.erl b/lib/asn1/src/asn1rtt_check.erl index e78b65a8fb..be4f9c8bff 100644 --- a/lib/asn1/src/asn1rtt_check.erl +++ b/lib/asn1/src/asn1rtt_check.erl @@ -20,7 +20,7 @@ -export([check_bool/2, check_int/3, - check_bitstring/3, + check_bitstring/2,check_named_bitstring/3, check_octetstring/2, check_null/2, check_objectidentifier/2, @@ -50,31 +50,54 @@ check_int(DefValue, Value, NNL) when is_atom(Value) -> check_int(DefaultValue, _Value, _) -> throw({error,DefaultValue}). -%% Two equal lists or integers -check_bitstring(_, asn1_DEFAULT, _) -> +%% check_bitstring(Default, UserBitstring) -> true|false +%% Default = bitstring() +%% UserBitstring = integeger() | list(0|1) | {Unused,binary()} | bitstring() +check_bitstring(_, asn1_DEFAULT) -> true; -check_bitstring(V, V, _) -> - true; -%% Default value as a list of 1 and 0 and user value as an integer -check_bitstring(L=[H|T], Int, _) when is_integer(Int), is_integer(H) -> - case bit_list_to_int(L, length(T)) of - Int -> true; - _ -> throw({error,L,Int}) +check_bitstring(DefVal, {Unused,Binary}) -> + %% User value in compact format. + Sz = bit_size(Binary) - Unused, + <<Val:Sz/bitstring,_:Unused>> = Binary, + check_bitstring(DefVal, Val); +check_bitstring(DefVal, Val) when is_bitstring(Val) -> + case Val =:= DefVal of + false -> throw(error); + true -> true end; -%% Default value as an integer, val as list -check_bitstring(Int, Val, NBL) when is_integer(Int), is_list(Val) -> - BL = int_to_bit_list(Int, [], length(Val)), - check_bitstring(BL, Val, NBL); +check_bitstring(Def, Val) when is_list(Val) -> + check_bitstring_list(Def, Val); +check_bitstring(Def, Val) when is_integer(Val) -> + check_bitstring_integer(Def, Val). + +check_bitstring_list(<<H:1,T1/bitstring>>, [H|T2]) -> + check_bitstring_list(T1, T2); +check_bitstring_list(<<>>, []) -> + true; +check_bitstring_list(_, _) -> + throw(error). + +check_bitstring_integer(<<H:1,T1/bitstring>>, Int) when H =:= Int band 1 -> + check_bitstring_integer(T1, Int bsr 1); +check_bitstring_integer(<<>>, 0) -> + true; +check_bitstring_integer(_, _) -> + throw(error). + +check_named_bitstring(_, asn1_DEFAULT, _) -> + true; +check_named_bitstring(V, V, _) -> + true; %% Default value and user value as lists of ones and zeros -check_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL=[_H|_T]) when is_integer(H1), is_integer(H2) -> +check_named_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL=[_H|_T]) when is_integer(H1), is_integer(H2) -> L2new = remove_trailing_zeros(L2), - check_bitstring(L1, L2new, NBL); + check_named_bitstring(L1, L2new, NBL); %% Default value as a list of 1 and 0 and user value as a list of atoms -check_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL) when is_integer(H1), is_atom(H2) -> +check_named_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL) when is_integer(H1), is_atom(H2) -> L3 = bit_list_to_nbl(L1, NBL, 0, []), - check_bitstring(L3, L2, NBL); + check_named_bitstring(L3, L2, NBL); %% Both default value and user value as a list of atoms -check_bitstring(L1=[H1|T1], L2=[H2|_T2], _) +check_named_bitstring(L1=[H1|T1], L2=[H2|_T2], _) when is_atom(H1), is_atom(H2), length(L1) =:= length(L2) -> case lists:member(H1, L2) of true -> @@ -82,27 +105,29 @@ check_bitstring(L1=[H1|T1], L2=[H2|_T2], _) false -> throw({error,L2}) end; %% Default value as a list of atoms and user value as a list of 1 and 0 -check_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL) when is_atom(H1), is_integer(H2) -> +check_named_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL) when is_atom(H1), is_integer(H2) -> L3 = bit_list_to_nbl(L2, NBL, 0, []), - check_bitstring(L1, L3, NBL); + check_named_bitstring(L1, L3, NBL); %% User value in compact format -check_bitstring(DefVal,CBS={_,_}, NBL) -> +check_named_bitstring(DefVal,CBS={_,_}, NBL) -> NewVal = cbs_to_bit_list(CBS), - check_bitstring(DefVal, NewVal, NBL); -check_bitstring(DV, V, _) -> + check_named_bitstring(DefVal, NewVal, NBL); +%% User value as a binary +check_named_bitstring(DefVal, CBS, NBL) when is_binary(CBS) -> + NewVal = cbs_to_bit_list({0,CBS}), + check_named_bitstring(DefVal, NewVal, NBL); +%% User value as a bitstring +check_named_bitstring(DefVal, CBS, NBL) when is_bitstring(CBS) -> + BitSize = bit_size(CBS), + Unused = 8 - (BitSize band 7), + NewVal = cbs_to_bit_list({Unused,<<CBS:BitSize/bits,0:Unused>>}), + check_named_bitstring(DefVal, NewVal, NBL); +check_named_bitstring(DV, V, _) -> throw({error,DV,V}). - -bit_list_to_int([0|Bs], ShL)-> - bit_list_to_int(Bs, ShL-1) + 0; -bit_list_to_int([1|Bs], ShL) -> - bit_list_to_int(Bs, ShL-1) + (1 bsl ShL); -bit_list_to_int([], _) -> - 0. - int_to_bit_list(0, Acc, 0) -> Acc; -int_to_bit_list(Int, Acc, Len) -> +int_to_bit_list(Int, Acc, Len) when Len > 0 -> int_to_bit_list(Int bsr 1, [Int band 1|Acc], Len - 1). bit_list_to_nbl([0|T], NBL, Pos, Acc) -> diff --git a/lib/asn1/src/asn1rtt_per.erl b/lib/asn1/src/asn1rtt_per.erl index 9f4b7500d8..672c84593c 100644 --- a/lib/asn1/src/asn1rtt_per.erl +++ b/lib/asn1/src/asn1rtt_per.erl @@ -18,62 +18,7 @@ %% -module(asn1rtt_per). --export([setext/1, fixextensions/2, - skipextensions/3, - set_choice/3,encode_integer/2, - encode_small_number/1, - encode_constrained_number/2, - encode_length/1, - encode_length/2, - encode_bit_string/3, - encode_object_identifier/1, - encode_relative_oid/1, - complete/1, - encode_open_type/1, - encode_GeneralString/2, - encode_GraphicString/2, - encode_TeletexString/2, - encode_VideotexString/2, - encode_ObjectDescriptor/2, - encode_UTF8String/1, - encode_octet_string/2, - encode_known_multiplier_string/4, - octets_to_complete/2]). - --define('16K',16384). --define('32K',32768). --define('64K',65536). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% setext(true|false) -> CompleteList -%% - -setext(false) -> - [0]; -setext(true) -> - [1]. - -fixextensions({ext,ExtPos,ExtNum},Val) -> - case fixextensions(ExtPos,ExtNum+ExtPos,Val,0) of - 0 -> []; - ExtBits -> - [encode_small_length(ExtNum)|pre_complete_bits(ExtNum,ExtBits)] - end. - -fixextensions(Pos,MaxPos,_,Acc) when Pos >= MaxPos -> - Acc; -fixextensions(Pos,ExtPos,Val,Acc) -> - Bit = case catch(element(Pos+1,Val)) of - asn1_NOVALUE -> - 0; - asn1_NOEXTVALUE -> - 0; - {'EXIT',_} -> - 0; - _ -> - 1 - end, - fixextensions(Pos+1,ExtPos,Val,(Acc bsl 1)+Bit). +-export([skipextensions/3,complete/1]). skipextensions(Bytes0, Nr, ExtensionBitstr) when is_bitstring(ExtensionBitstr) -> Prev = Nr - 1, @@ -95,270 +40,6 @@ align(BitStr) when is_bitstring(BitStr) -> <<_:AlignBits,Rest/binary>> = BitStr, Rest. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% set_choice(Alt,Choices,Altnum) -> ListofBitSettings -%% Alt = atom() -%% Altnum = integer() | {integer(),integer()}% number of alternatives -%% Choices = [atom()] | {[atom()],[atom()]} -%% When Choices is a tuple the first list is the Rootset and the -%% second is the Extensions and then Altnum must also be a tuple with the -%% lengths of the 2 lists -%% -set_choice(Alt,{L1,L2},{Len1,_Len2}) -> - case set_choice_tag(Alt,L1) of - N when is_integer(N), Len1 > 1 -> - [0, % the value is in the root set - encode_constrained_number({0,Len1-1},N)]; - N when is_integer(N) -> - [0]; % no encoding if only 0 or 1 alternative - false -> - [1, % extension value - case set_choice_tag(Alt, L2) of - N2 when is_integer(N2) -> - encode_small_number(N2); - false -> - unknown_choice_alt - end] - end; -set_choice(Alt, L, Len) -> - case set_choice_tag(Alt, L) of - N when is_integer(N), Len > 1 -> - encode_constrained_number({0,Len-1},N); - N when is_integer(N) -> - []; % no encoding if only 0 or 1 alternative - false -> - [unknown_choice_alt] - end. - -set_choice_tag(Alt,Choices) -> - set_choice_tag(Alt,Choices,0). - -set_choice_tag(Alt,[Alt|_Rest],Tag) -> - Tag; -set_choice_tag(Alt,[_H|Rest],Tag) -> - set_choice_tag(Alt,Rest,Tag+1); -set_choice_tag(_Alt,[],_Tag) -> - false. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_open_type(Constraint, Value) -> CompleteList -%% Value = list of bytes of an already encoded value (the list must be flat) -%% | binary -%% Contraint = not used in this version -%% -encode_open_type(Val) -> - case byte_size(Val) of - Size when Size > 255 -> - [encode_length(Size),21,<<Size:16>>,Val]; % octets implies align - Size -> - [encode_length(Size),20,Size,Val] - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_integer(Constraint, Value) -> CompleteList -%% -encode_integer([{Rc,_Ec}],Val) when is_tuple(Rc) -> - try - [0|encode_integer([Rc], Val)] - catch - _:{error,{asn1,_}} -> - [1|encode_unconstrained_number(Val)] - end; -encode_integer([], Val) -> - encode_unconstrained_number(Val); -%% The constraint is the effective constraint, and in this case is a number -encode_integer([{'SingleValue',V}], V) -> - []; -encode_integer([{'ValueRange',{Lb,Ub}=VR,Range,PreEnc}],Val) - when Val >= Lb, Ub >= Val -> - %% this case when NamedNumberList - encode_constrained_number(VR, Range, PreEnc, Val); -encode_integer([{'ValueRange',{Lb,'MAX'}}], Val) when Lb =< Val -> - encode_semi_constrained_number(Lb, Val); -encode_integer([{'ValueRange',{'MIN',_}}], Val) -> - encode_unconstrained_number(Val); -encode_integer([{'ValueRange',VR={_Lb,_Ub}}], Val) -> - encode_constrained_number(VR, Val); -encode_integer(_,Val) -> - exit({error,{asn1,{illegal_value,Val}}}). - - -%% X.691:10.6 Encoding of a normally small non-negative whole number -%% Use this for encoding of CHOICE index if there is an extension marker in -%% the CHOICE -encode_small_number(Val) when Val < 64 -> - [10,7,Val]; -encode_small_number(Val) -> - [1|encode_semi_constrained_number(0, Val)]. - -%% X.691:10.7 Encoding of a semi-constrained whole number -encode_semi_constrained_number(Lb, Val) -> - Val2 = Val - Lb, - Oct = eint_positive(Val2), - Len = length(Oct), - if - Len < 128 -> - [20,Len+1,Len|Oct]; - Len < 256 -> - [encode_length(Len),20,Len|Oct]; - true -> - [encode_length(Len),21,<<Len:16>>|Oct] - end. - -encode_constrained_number({Lb,_Ub},_Range,{bits,N},Val) -> - Val2 = Val-Lb, - [10,N,Val2]; -encode_constrained_number({Lb,_Ub},_Range,{octets,N},Val) when N < 256-> - %% N is 8 or 16 (1 or 2 octets) - Val2 = Val-Lb, - [20,N,Val2]; -encode_constrained_number({Lb,_Ub},_Range,{octets,N},Val) -> % N>255 - %% N is 8 or 16 (1 or 2 octets) - Val2 = Val-Lb, - [21,<<N:16>>,Val2]; -encode_constrained_number({Lb,_Ub},Range,_,Val) -> - Val2 = Val-Lb, - if - Range =< 16#1000000 -> % max 3 octets - Octs = eint_positive(Val2), - L = length(Octs), - [encode_length({1,3},L),[20,L,Octs]]; - Range =< 16#100000000 -> % max 4 octets - Octs = eint_positive(Val2), - L = length(Octs), - [encode_length({1,4},L),[20,L,Octs]]; - Range =< 16#10000000000 -> % max 5 octets - Octs = eint_positive(Val2), - L = length(Octs), - [encode_length({1,5},L),[20,L,Octs]]; - true -> - exit({not_supported,{integer_range,Range}}) - end. - -encode_constrained_number({Lb,Ub}, Val) when Val >= Lb, Ub >= Val -> - Range = Ub - Lb + 1, - Val2 = Val - Lb, - if - Range == 1 -> []; - Range == 2 -> - [Val2]; - Range =< 4 -> - [10,2,Val2]; - Range =< 8 -> - [10,3,Val2]; - Range =< 16 -> - [10,4,Val2]; - Range =< 32 -> - [10,5,Val2]; - Range =< 64 -> - [10,6,Val2]; - Range =< 128 -> - [10,7,Val2]; - Range =< 255 -> - [10,8,Val2]; - Range =< 256 -> - [20,1,Val2]; - Range =< 65536 -> - [20,2,<<Val2:16>>]; - Range =< (1 bsl (255*8)) -> - Octs = binary:encode_unsigned(Val2), - RangeOcts = binary:encode_unsigned(Range - 1), - OctsLen = byte_size(Octs), - RangeOctsLen = byte_size(RangeOcts), - LengthBitsNeeded = minimum_bits(RangeOctsLen - 1), - [10,LengthBitsNeeded,OctsLen-1,20,OctsLen,Octs]; - true -> - exit({not_supported,{integer_range,Range}}) - end; -encode_constrained_number({_,_},Val) -> - exit({error,{asn1,{illegal_value,Val}}}). - -%% For some reason the minimum bits needed in the length field in -%% the encoding of constrained whole numbers must always be at least 2? -minimum_bits(N) when N < 4 -> 2; -minimum_bits(N) when N < 8 -> 3; -minimum_bits(N) when N < 16 -> 4; -minimum_bits(N) when N < 32 -> 5; -minimum_bits(N) when N < 64 -> 6; -minimum_bits(N) when N < 128 -> 7; -minimum_bits(_N) -> 8. - -%% X.691:10.8 Encoding of an unconstrained whole number - -encode_unconstrained_number(Val) -> - Oct = if - Val >= 0 -> - eint(Val, []); - true -> - enint(Val, []) - end, - Len = length(Oct), - if - Len < 128 -> - [20,Len + 1,Len|Oct]; - Len < 256 -> - [20,Len + 2,<<2:2,Len:14>>|Oct]; - true -> - [encode_length(Len),21,<<Len:16>>|Oct] - end. - -%% used for positive Values which don't need a sign bit -%% returns a list -eint_positive(Val) -> - case eint(Val,[]) of - [0,B1|T] -> - [B1|T]; - T -> - T - end. - - -eint(0, [B|Acc]) when B < 128 -> - [B|Acc]; -eint(N, Acc) -> - eint(N bsr 8, [N band 16#ff| Acc]). - -enint(-1, [B1|T]) when B1 > 127 -> - [B1|T]; -enint(N, Acc) -> - enint(N bsr 8, [N band 16#ff|Acc]). - -%% X.691:10.9 Encoding of a length determinant -%%encode_small_length(undefined,Len) -> % null means no UpperBound -%% encode_small_number(Len). - -%% X.691:10.9.3.5 -%% X.691:10.9.3.7 -encode_length(Len) -> % unconstrained - if - Len < 128 -> - [20,1,Len]; - Len < 16384 -> - <<20,2,2:2,Len:14>>; - true -> % should be able to endode length >= 16384 i.e. fragmented length - exit({error,{asn1,{encode_length,{nyi,above_16k}}}}) - end. - -encode_length({C,[]}, Len) -> - case C of - {Lb,Ub}=Vr when Lb =< Len, Len =< Ub -> - [0|encode_constrained_number(Vr, Len)]; - _ -> - [1|encode_length(Len)] - end; -encode_length(Len, Len) -> - []; -encode_length(Vr, Len) -> - encode_constrained_number(Vr, Len). - -%% X.691 10.9.3.4 (only used for length of bitmap that prefixes extension -%% additions in a sequence or set -encode_small_length(Len) when Len =< 64 -> - [10,7,Len-1]; -encode_small_length(Len) -> - [1,encode_length(Len)]. - - decode_length(Buffer) -> % un-constrained case align(Buffer) of <<0:1,Oct:7,Rest/binary>> -> @@ -370,511 +51,70 @@ decode_length(Buffer) -> % un-constrained exit({error,{asn1,{decode_length,{nyi,above_16k}}}}) end. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% bitstring NamedBitList -%% Val can be of: -%% - [identifiers] where only named identifers are set to one, -%% the Constraint must then have some information of the -%% bitlength. -%% - [list of ones and zeroes] all bits -%% - integer value representing the bitlist -%% C is constraint Len, only valid when identifiers - - -%% when the value is a list of {Unused,BinBits}, where -%% Unused = integer(), -%% BinBits = binary(). - -encode_bit_string(C, Bits, NamedBitList) when is_bitstring(Bits) -> - PadLen = (8 - (bit_size(Bits) band 7)) band 7, - Compact = {PadLen,<<Bits/bitstring,0:PadLen>>}, - encode_bin_bit_string(C, Compact, NamedBitList); -encode_bit_string(C, {Unused,BinBits}=Bin, NamedBitList) - when is_integer(Unused), is_binary(BinBits) -> - encode_bin_bit_string(C,Bin,NamedBitList); - -%% when the value is a list of named bits - -encode_bit_string(C, LoNB=[FirstVal | _RestVal], NamedBitList) when is_atom(FirstVal) -> - ToSetPos = get_all_bitposes(LoNB, NamedBitList, []), - BitList = make_and_set_list(ToSetPos,0), - encode_bit_string(C,BitList,NamedBitList);% consider the constraint - -encode_bit_string(C, BL=[{bit,_} | _RestVal], NamedBitList) -> - ToSetPos = get_all_bitposes(BL, NamedBitList, []), - BitList = make_and_set_list(ToSetPos,0), - encode_bit_string(C,BitList,NamedBitList); - -%% when the value is a list of ones and zeroes -encode_bit_string(Int, BitListValue, _) - when is_list(BitListValue),is_integer(Int),Int =< 16 -> - %% The type is constrained by a single value size constraint - %% range_check(Int,length(BitListValue)), - [40,Int,length(BitListValue),BitListValue]; -encode_bit_string(Int, BitListValue, _) - when is_list(BitListValue),is_integer(Int), Int =< 255 -> - %% The type is constrained by a single value size constraint - %% range_check(Int,length(BitListValue)), - [2,40,Int,length(BitListValue),BitListValue]; -encode_bit_string(Int, BitListValue, _) - when is_list(BitListValue),is_integer(Int), Int < ?'64K' -> - {Code,DesiredLength,Length} = - case length(BitListValue) of - B1 when B1 > Int -> - exit({error,{'BIT_STRING_length_greater_than_SIZE', - Int,BitListValue}}); - B1 when B1 =< 255,Int =< 255 -> - {40,Int,B1}; - B1 when B1 =< 255 -> - {42,<<Int:16>>,B1}; - B1 -> - {43,<<Int:16>>,<<B1:16>>} - end, - %% The type is constrained by a single value size constraint - [2,Code,DesiredLength,Length,BitListValue]; -encode_bit_string(no, BitListValue,[]) - when is_list(BitListValue) -> - [encode_length(length(BitListValue)), - 2|BitListValue]; -encode_bit_string({{Fix,Fix},Ext}, BitListValue,[]) - when is_integer(Fix), is_list(Ext) -> - case length(BitListValue) of - Len when Len =< Fix -> - [0|encode_bit_string(Fix, BitListValue, [])]; - _ -> - [1|encode_bit_string(no, BitListValue, [])] - end; -encode_bit_string(C, BitListValue,[]) - when is_list(BitListValue) -> - [encode_length(C, length(BitListValue)), - 2|BitListValue]; -encode_bit_string(no, BitListValue,_NamedBitList) - when is_list(BitListValue) -> - %% this case with an unconstrained BIT STRING can be made more efficient - %% if the complete driver can take a special code so the length field - %% is encoded there. - NewBitLVal = lists:reverse(lists:dropwhile(fun(0)->true;(1)->false end, - lists:reverse(BitListValue))), - [encode_length(length(NewBitLVal)),2|NewBitLVal]; -encode_bit_string({{Fix,Fix},Ext}, BitListValue, NamedBitList) - when is_integer(Fix), is_list(Ext) -> - case length(BitListValue) of - Len when Len =< Fix -> - [0|encode_bit_string(Fix, BitListValue, NamedBitList)]; - _ -> - [1|encode_bit_string(no, BitListValue, NamedBitList)] - end; -encode_bit_string(C, BitListValue, _NamedBitList) - when is_list(BitListValue) -> % C = {_,'MAX'} - NewBitLVal = bit_string_trailing_zeros(BitListValue, C), - [encode_length(C, length(NewBitLVal)),2|NewBitLVal]; - - -%% when the value is an integer -encode_bit_string(C, IntegerVal, NamedBitList) when is_integer(IntegerVal)-> - BitList = int_to_bitlist(IntegerVal), - encode_bit_string(C,BitList,NamedBitList). - -bit_string_trailing_zeros(BitList,C) when is_integer(C) -> - bit_string_trailing_zeros1(BitList,C,C); -bit_string_trailing_zeros(BitList,{Lb,Ub}) when is_integer(Lb) -> - bit_string_trailing_zeros1(BitList,Lb,Ub); -bit_string_trailing_zeros(BitList,{{Lb,Ub},_}) when is_integer(Lb) -> - bit_string_trailing_zeros1(BitList,Lb,Ub); -bit_string_trailing_zeros(BitList,_) -> - BitList. - -bit_string_trailing_zeros1(BitList,Lb,Ub) -> - case length(BitList) of - Lb -> BitList; - B when B < Lb -> BitList++lists:duplicate(Lb-B, 0); - D -> F = fun(L,LB,LB,_,_)->lists:reverse(L); - ([0|R],L1,LB,UB,Fun)->Fun(R,L1-1,LB,UB,Fun); - (L,L1,_,UB,_)when L1 =< UB -> lists:reverse(L); - (_,_L1,_,_,_) ->exit({error,{list_length_BIT_STRING, - BitList}}) end, - F(lists:reverse(BitList),D,Lb,Ub,F) - end. - -%% encode_bin_bit_string/3, when value is a tuple of Unused and BinBits. -%% Unused = integer(),i.e. number unused bits in least sign. byte of -%% BinBits = binary(). -encode_bin_bit_string(C, {Unused,BinBits}, _NamedBitList) - when is_integer(C),C=<16 -> - range_check(C, bit_size(BinBits) - Unused), - [45,C,byte_size(BinBits),BinBits]; -encode_bin_bit_string(C, {Unused,BinBits}, _NamedBitList) - when is_integer(C), C =< 255 -> - range_check(C, bit_size(BinBits) - Unused), - [2,45,C,byte_size(BinBits),BinBits]; -encode_bin_bit_string(C, {Unused,BinBits}, _NamedBitList) - when is_integer(C), C =< 65535 -> - range_check(C, bit_size(BinBits) - Unused), - case byte_size(BinBits) of - Size when Size =< 255 -> - [2,46,<<C:16>>,Size,BinBits]; - Size -> - [2,47,<<C:16>>,<<Size:16>>,BinBits] - end; -encode_bin_bit_string(C,UnusedAndBin={_,_},NamedBitList) -> - {Unused1,Bin1} = - %% removes all trailing bits if NamedBitList is not empty - remove_trailing_bin(NamedBitList,UnusedAndBin), - case C of - {Lb,Ub} when is_integer(Lb),is_integer(Ub) -> - Size = byte_size(Bin1), - [encode_length({Lb,Ub}, Size*8 - Unused1), - 2,octets_unused_to_complete(Unused1,Size,Bin1)]; - no -> - Size = byte_size(Bin1), - [encode_length(Size*8 - Unused1), - 2|octets_unused_to_complete(Unused1, Size, Bin1)]; - {{Fix,Fix},Ext} when is_integer(Fix),is_list(Ext) -> - case byte_size(Bin1)*8 - Unused1 of - Size when Size =< Fix -> - [0|encode_bin_bit_string(Fix,UnusedAndBin,NamedBitList)]; - _Size -> - [1|encode_bin_bit_string(no,UnusedAndBin,NamedBitList)] - end; - Sc -> - Size = byte_size(Bin1), - [encode_length(Sc, Size*8 - Unused1), - 2|octets_unused_to_complete(Unused1,Size,Bin1)] - end. - -range_check(C,C) when is_integer(C) -> - ok; -range_check(C1,C2) when is_integer(C1) -> - exit({error,{asn1,{bit_string_out_of_range,{C1,C2}}}}). - -remove_trailing_bin([], {Unused,Bin}) -> - {Unused,Bin}; -remove_trailing_bin(_NamedNumberList,{_Unused,<<>>}) -> - {0,<<>>}; -remove_trailing_bin(NamedNumberList, {_Unused,Bin}) -> - Size = byte_size(Bin)-1, - <<Bfront:Size/binary, LastByte:8>> = Bin, - %% clear the Unused bits to be sure - Unused1 = trailingZeroesInNibble(LastByte band 15), - Unused2 = - case Unused1 of - 4 -> - 4 + trailingZeroesInNibble(LastByte bsr 4); - _ -> Unused1 - end, - case Unused2 of - 8 -> - remove_trailing_bin(NamedNumberList,{0,Bfront}); - _ -> - {Unused2,Bin} - end. - - -trailingZeroesInNibble(0) -> - 4; -trailingZeroesInNibble(1) -> - 0; -trailingZeroesInNibble(2) -> - 1; -trailingZeroesInNibble(3) -> - 0; -trailingZeroesInNibble(4) -> - 2; -trailingZeroesInNibble(5) -> - 0; -trailingZeroesInNibble(6) -> - 1; -trailingZeroesInNibble(7) -> - 0; -trailingZeroesInNibble(8) -> - 3; -trailingZeroesInNibble(9) -> - 0; -trailingZeroesInNibble(10) -> - 1; -trailingZeroesInNibble(11) -> - 0; -trailingZeroesInNibble(12) -> %#1100 - 2; -trailingZeroesInNibble(13) -> - 0; -trailingZeroesInNibble(14) -> - 1; -trailingZeroesInNibble(15) -> - 0. - - -%%%%%%%%%%%%%%% -%% - -int_to_bitlist(Int) when is_integer(Int), Int > 0 -> - [Int band 1 | int_to_bitlist(Int bsr 1)]; -int_to_bitlist(0) -> - []. - - -%%%%%%%%%%%%%%%%%% -%% get_all_bitposes([list of named bits to set], named_bit_db, []) -> -%% [sorted_list_of_bitpositions_to_set] - -get_all_bitposes([{bit,ValPos}|Rest], NamedBitList, Ack) -> - get_all_bitposes(Rest, NamedBitList, [ValPos | Ack ]); - -get_all_bitposes([Val | Rest], NamedBitList, Ack) -> - case lists:keyfind(Val, 1, NamedBitList) of - {_ValName, ValPos} -> - get_all_bitposes(Rest, NamedBitList, [ValPos | Ack]); - false -> - exit({error,{asn1, {bitstring_namedbit, Val}}}) - end; -get_all_bitposes([], _NamedBitList, Ack) -> - lists:sort(Ack). - -%%%%%%%%%%%%%%%%%% -%% make_and_set_list([list of positions to set to 1])-> -%% returns list with all in SetPos set. -%% in positioning in list the first element is 0, the second 1 etc.., but -%% - -make_and_set_list([XPos|SetPos], XPos) -> - [1 | make_and_set_list(SetPos, XPos + 1)]; -make_and_set_list([Pos|SetPos], XPos) -> - [0 | make_and_set_list([Pos | SetPos], XPos + 1)]; -make_and_set_list([], _) -> - []. - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% X.691:16 -%% encode_octet_string(Constraint, Val) -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -encode_octet_string({{Sv,Sv},Ext}=SZ, Val) when is_list(Ext), Sv =< 2 -> - Len = length(Val), - try - case encode_length(SZ, Len) of - [0|_]=EncLen -> - [EncLen,45,Sv*8,Sv,Val]; - [_|_]=EncLen -> - [EncLen|octets_to_complete(Len, Val)] - end - catch - exit:{error,{asn1,{encode_length,_}}} -> - encode_fragmented_octet_string(Val) - end; -encode_octet_string({_,_}=SZ, Val) -> - Len = length(Val), - try - [encode_length(SZ, Len),2|octets_to_complete(Len, Val)] - catch - exit:{error,{asn1,{encode_length,_}}} -> - encode_fragmented_octet_string(Val) - end; -encode_octet_string(Sv, Val) when is_integer(Sv) -> - encode_fragmented_octet_string(Val); -encode_octet_string(no, Val) -> - Len = length(Val), - try - [encode_length(Len),2|octets_to_complete(Len, Val)] - catch - exit:{error,{asn1,{encode_length,_}}} -> - encode_fragmented_octet_string(Val) - end. - -encode_fragmented_octet_string(Val) -> - Bin = iolist_to_binary(Val), - efos_1(Bin). - -efos_1(<<B1:16#C000/binary,B2:16#4000/binary,T/binary>>) -> - [20,1,<<3:2,4:6>>, - octets_to_complete(16#C000, B1), - octets_to_complete(16#4000, B2)|efos_1(T)]; -efos_1(<<B:16#C000/binary,T/binary>>) -> - [20,1,<<3:2,3:6>>,octets_to_complete(16#C000, B)|efos_1(T)]; -efos_1(<<B:16#8000/binary,T/binary>>) -> - [20,1,<<3:2,2:6>>,octets_to_complete(16#8000, B)|efos_1(T)]; -efos_1(<<B:16#4000/binary,T/binary>>) -> - [20,1,<<3:2,1:6>>,octets_to_complete(16#4000, B)|efos_1(T)]; -efos_1(<<>>) -> - [20,1,0]; -efos_1(<<B/bitstring>>) -> - Len = byte_size(B), - [encode_length(Len)|octets_to_complete(Len, B)]. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Restricted char string types -%% (NumericString, PrintableString,VisibleString,IA5String,BMPString,UniversalString) -%% X.691:26 and X.680:34-36 - -encode_restricted_string(Val) when is_list(Val)-> - Len = length(Val), - [encode_length(Len)|octets_to_complete(Len, Val)]. - -encode_known_multiplier_string(SizeC, NumBits, CharOutTab, Val) -> - Result = chars_encode2(Val, NumBits, CharOutTab), - case SizeC of - Ub when is_integer(Ub), Ub*NumBits < 16 -> - Result; - Ub when is_integer(Ub) -> - [2,Result]; - {{_,Ub},Ext}=SZ when is_list(Ext) -> - Len = length(Val), - case encode_length(SZ, Len) of - [0|_]=EncLen when Ub*NumBits < 16 -> - [EncLen,45,Len*NumBits,Len,Val]; - [_|_]=EncLen -> - [EncLen,2|Result] - end; - {_,Ub}=Range -> - [encode_length(Range, length(Val))| - if - Ub*NumBits < 16 -> Result; - true -> [2|Result] - end]; - no -> - [encode_length(length(Val)),2,Result] - end. - -encode_GeneralString(_C,Val) -> - encode_restricted_string(Val). - -encode_GraphicString(_C,Val) -> - encode_restricted_string(Val). - -encode_ObjectDescriptor(_C,Val) -> - encode_restricted_string(Val). - -encode_TeletexString(_C,Val) -> % equivalent with T61String - encode_restricted_string(Val). - -encode_VideotexString(_C,Val) -> - encode_restricted_string(Val). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% chars_encode(C,StringType,Value) -> ValueList -%% -%% encodes chars according to the per rules taking the constraint -%% PermittedAlphabet into account. -%% -%% This function only encodes the value part and NOT the length. - -chars_encode2([H|T],NumBits,T1={Min,Max,notab}) when H =< Max, H >= Min -> - [pre_complete_bits(NumBits,H-Min)|chars_encode2(T,NumBits,T1)]; -chars_encode2([H|T],NumBits,T1={Min,Max,Tab}) when H =< Max, H >= Min -> - [pre_complete_bits(NumBits,exit_if_false(H,element(H-Min+1,Tab)))| - chars_encode2(T,NumBits,T1)]; -chars_encode2([{A,B,C,D}|T],NumBits,T1={Min,_Max,notab}) -> - %% no value range check here (ought to be, but very expensive) - [pre_complete_bits(NumBits, - ((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min)| - chars_encode2(T,NumBits,T1)]; -chars_encode2([H={A,B,C,D}|T],NumBits,{Min,Max,Tab}) -> - %% no value range check here (ought to be, but very expensive) - [pre_complete_bits(NumBits,exit_if_false(H,element(((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min,Tab)))|chars_encode2(T,NumBits,{Min,Max,notab})]; -chars_encode2([H|_T],_NumBits,{_Min,_Max,_Tab}) -> - exit({error,{asn1,{illegal_char_value,H}}}); -chars_encode2([],_,_) -> - []. - -exit_if_false(V,false)-> - exit({error,{asn1,{"illegal value according to Permitted alphabet constraint",V}}}); -exit_if_false(_,V) ->V. - -pre_complete_bits(NumBits,Val) when NumBits =< 8 -> - [10,NumBits,Val]; -pre_complete_bits(NumBits,Val) when NumBits =< 16 -> - [10,NumBits-8,Val bsr 8,10,8,(Val band 255)]; -pre_complete_bits(NumBits,Val) when NumBits =< 2040 -> % 255 * 8 - Unused = (8 - (NumBits rem 8)) rem 8, - Len = NumBits + Unused, - [30,Unused,Len div 8,<<(Val bsl Unused):Len>>]. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_UTF8String(Val) -> CompleteList -%% Val -> <<utf8encoded binary>> -%% CompleteList -> [apropriate codes and values for driver complete] -%% -encode_UTF8String(Val) when is_binary(Val) -> - Sz = byte_size(Val), - [encode_length(Sz),octets_to_complete(Sz, Val)]; -encode_UTF8String(Val) -> - encode_UTF8String(list_to_binary(Val)). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_object_identifier(Val) -> CompleteList -%% encode_object_identifier({Name,Val}) -> CompleteList -%% Val -> {Int1,Int2,...,IntN} % N >= 2 -%% Name -> atom() -%% Int1 -> integer(0..2) -%% Int2 -> integer(0..39) when Int1 (0..1) else integer() -%% Int3-N -> integer() -%% CompleteList -> [{bits,8,Val}|{octets,Ol}|align|...] -%% -encode_object_identifier(Val) -> - OctetList = e_object_identifier(Val), - Octets = list_to_binary(OctetList), - Sz = byte_size(Octets), - [encode_length(Sz), - octets_to_complete(Sz, Octets)]. - -e_object_identifier({'OBJECT IDENTIFIER',V}) -> - e_object_identifier(V); -e_object_identifier(V) when is_tuple(V) -> - e_object_identifier(tuple_to_list(V)); - -%% E1 = 0|1|2 and (E2 < 40 when E1 = 0|1) -e_object_identifier([E1,E2|Tail]) when E1 >= 0, E1 < 2, E2 < 40 ; E1==2 -> - Head = 40*E1 + E2, % weird - e_object_elements([Head|Tail],[]); -e_object_identifier(Oid=[_,_|_Tail]) -> - exit({error,{asn1,{'illegal_value',Oid}}}). - -e_object_elements([],Acc) -> - lists:reverse(Acc); -e_object_elements([H|T],Acc) -> - e_object_elements(T,[e_object_element(H)|Acc]). - -e_object_element(Num) when Num < 128 -> - [Num]; -e_object_element(Num) -> - [e_o_e(Num bsr 7)|[Num band 2#1111111]]. -e_o_e(Num) when Num < 128 -> - Num bor 2#10000000; -e_o_e(Num) -> - [e_o_e(Num bsr 7)|[(Num band 2#1111111) bor 2#10000000]]. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_relative_oid(Val) -> CompleteList -%% encode_relative_oid({Name,Val}) -> CompleteList -encode_relative_oid(Val) when is_tuple(Val) -> - encode_relative_oid(tuple_to_list(Val)); -encode_relative_oid(Val) when is_list(Val) -> - Octets = list_to_binary([e_object_element(X)||X <- Val]), - Sz = byte_size(Octets), - [encode_length(Sz)|octets_to_complete(Sz, Octets)]. - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% complete(InList) -> ByteList %% Takes a coded list with bits and bytes and converts it to a list of bytes %% Should be applied as the last step at encode of a complete ASN.1 type %% -complete(L) -> - case asn1rt_nif:encode_per_complete(L) of +complete(L0) -> + L = complete(L0, []), + case list_to_bitstring(L) of <<>> -> <<0>>; Bin -> Bin end. -octets_to_complete(Len,Val) when Len < 256 -> - [20,Len,Val]; -octets_to_complete(Len,Val) -> - [21,<<Len:16>>,Val]. - -octets_unused_to_complete(Unused,Len,Val) when Len < 256 -> - [30,Unused,Len,Val]; -octets_unused_to_complete(Unused,Len,Val) -> - [31,Unused,<<Len:16>>,Val]. +complete([], []) -> + []; +complete([], [H|More]) -> + complete(H, More); +complete([align|T], More) -> + complete(T, More); +complete([[]|T], More) -> + complete(T, More); +complete([[_|_]=H], More) -> + complete(H, More); +complete([[_|_]=H|T], More) -> + complete(H, [T|More]); +complete([H|T], More) when is_integer(H); is_binary(H) -> + [H|complete(T, More)]; +complete([H|T], More) -> + [H|complete(T, bit_size(H), More)]; +complete(Bin, More) when is_binary(Bin) -> + [Bin|complete([], More)]; +complete(Bin, More) -> + [Bin|complete([], bit_size(Bin), More)]. + +complete([], Bits, []) -> + case Bits band 7 of + 0 -> []; + N -> [<<0:(8-N)>>] + end; +complete([], Bits, [H|More]) -> + complete(H, Bits, More); +complete([align|T], Bits, More) -> + case Bits band 7 of + 0 -> complete(T, More); + 1 -> [<<0:7>>|complete(T, More)]; + 2 -> [<<0:6>>|complete(T, More)]; + 3 -> [<<0:5>>|complete(T, More)]; + 4 -> [<<0:4>>|complete(T, More)]; + 5 -> [<<0:3>>|complete(T, More)]; + 6 -> [<<0:2>>|complete(T, More)]; + 7 -> [<<0:1>>|complete(T, More)] + end; +complete([[]|T], Bits, More) -> + complete(T, Bits, More); +complete([[_|_]=H], Bits, More) -> + complete(H, Bits, More); +complete([[_|_]=H|T], Bits, More) -> + complete(H, Bits, [T|More]); +complete([H|T], Bits, More) when is_integer(H); + is_binary(H) -> + [H|complete(T, Bits, More)]; +complete([H|T], Bits, More) -> + [H|complete(T, Bits+bit_size(H), More)]; +complete(Bin, Bits, More) when is_binary(Bin) -> + [Bin|complete([], Bits, More)]; +complete(Bin, Bits, More) -> + [Bin|complete([], Bits+bit_size(Bin), More)]. diff --git a/lib/asn1/src/asn1rtt_per_common.erl b/lib/asn1/src/asn1rtt_per_common.erl index e7edc2b65f..3309e6a4ca 100644 --- a/lib/asn1/src/asn1rtt_per_common.erl +++ b/lib/asn1/src/asn1rtt_per_common.erl @@ -28,7 +28,17 @@ decode_chars/2,decode_chars/3, decode_chars_16bit/1, decode_big_chars/2, - decode_oid/1,decode_relative_oid/1]). + decode_oid/1,decode_relative_oid/1, + encode_chars/2,encode_chars/3, + encode_chars_16bit/1,encode_big_chars/1, + encode_fragmented/2, + encode_oid/1,encode_relative_oid/1, + encode_unconstrained_number/1, + bitstring_from_positions/1,bitstring_from_positions/2, + to_bitstring/1,to_bitstring/2, + to_named_bitstring/1,to_named_bitstring/2, + is_default_bitstring/5, + extension_bitmap/3]). -define('16K',16384). @@ -90,6 +100,212 @@ decode_oid(Octets) -> decode_relative_oid(Octets) -> list_to_tuple(dec_subidentifiers(Octets, 0, [])). +encode_chars(Val, NumBits) -> + << <<C:NumBits>> || C <- Val >>. + +encode_chars(Val, NumBits, {Lb,Tab}) -> + << <<(enc_char(C, Lb, Tab)):NumBits>> || C <- Val >>. + +encode_chars_16bit(Val) -> + L = [case C of + {0,0,A,B} -> [A,B]; + C when is_integer(C) -> [0,C] + end || C <- Val], + iolist_to_binary(L). + +encode_big_chars(Val) -> + L = [case C of + {_,_,_,_} -> tuple_to_list(C); + C when is_integer(C) -> [<<0,0,0>>,C] + end || C <- Val], + iolist_to_binary(L). + +encode_fragmented(Bin, Unit) -> + encode_fragmented_1(Bin, Unit, 4). + +encode_oid(Val) when is_tuple(Val) -> + encode_oid(tuple_to_list(Val)); +encode_oid(Val) -> + iolist_to_binary(e_object_identifier(Val)). + +encode_relative_oid(Val) when is_tuple(Val) -> + encode_relative_oid(tuple_to_list(Val)); +encode_relative_oid(Val) when is_list(Val) -> + list_to_binary([e_object_element(X)||X <- Val]). + +encode_unconstrained_number(Val) when Val >= 0 -> + if + Val < 16#80 -> + [1,Val]; + Val < 16#100 -> + [<<2,0>>,Val]; + true -> + case binary:encode_unsigned(Val) of + <<0:1,_/bitstring>>=Bin -> + case byte_size(Bin) of + Sz when Sz < 128 -> + [Sz,Bin]; + Sz when Sz < 16384 -> + [<<2:2,Sz:14>>,Bin] + end; + <<1:1,_/bitstring>>=Bin -> + case byte_size(Bin)+1 of + Sz when Sz < 128 -> + [Sz,0,Bin]; + Sz when Sz < 16384 -> + [<<2:2,Sz:14,0:8>>,Bin] + end + end + end; +encode_unconstrained_number(Val) -> + Oct = enint(Val, []), + Len = length(Oct), + if + Len < 128 -> + [Len|Oct]; + Len < 16384 -> + [<<2:2,Len:14>>|Oct] + end. + +%% bitstring_from_positions([Position]) -> BitString +%% Given an unsorted list of bit positions (0..MAX), construct +%% a BIT STRING. The rightmost bit will always be a one. + +bitstring_from_positions([]) -> <<>>; +bitstring_from_positions([_|_]=L0) -> + L1 = lists:sort(L0), + L = diff(L1, -1), + << <<1:(N+0)>> || N <- L >>. + +%% bitstring_from_positions([Position], Lb) -> BitString +%% Given an unsorted list of bit positions (0..MAX) and a lower bound +%% for the number of bits, construct BIT STRING (zero-padded on the +%% right side if needed). + +bitstring_from_positions(L0, Lb) -> + L1 = lists:sort(L0), + L = diff(L1, -1, Lb-1), + << <<B:(N+0)>> || {B,N} <- L >>. + +%% to_bitstring(Val) -> BitString +%% Val = BitString | {Unused,Binary} | [OneOrZero] | Integer +%% Given one of the possible representations for a BIT STRING, +%% return a bitstring (without adding or removing any zero bits +%% at the right end). + +to_bitstring({0,Bs}) when is_binary(Bs) -> + Bs; +to_bitstring({Unused,Bs0}) when is_binary(Bs0) -> + Sz = bit_size(Bs0) - Unused, + <<Bs:Sz/bits,_/bits>> = Bs0, + Bs; +to_bitstring(Bs) when is_bitstring(Bs) -> + Bs; +to_bitstring(Int) when is_integer(Int), Int >= 0 -> + L = int_to_bitlist(Int), + << <<B:1>> || B <- L >>; +to_bitstring(L) when is_list(L) -> + << <<B:1>> || B <- L >>. + +%% to_bitstring(Val, Lb) -> BitString +%% Val = BitString | {Unused,Binary} | [OneOrZero] | Integer +%% Lb = Integer +%% Given one of the possible representations for a BIT STRING +%% and the lower bound for the number of bits, +%% return a bitstring at least Lb bits long (padded with zeroes +%% if needed). + +to_bitstring({0,Bs}, Lb) when is_binary(Bs) -> + case bit_size(Bs) of + Sz when Sz < Lb -> + <<Bs/bits,0:(Lb-Sz)>>; + _ -> + Bs + end; +to_bitstring({Unused,Bs0}, Lb) when is_binary(Bs0) -> + Sz = bit_size(Bs0) - Unused, + if + Sz < Lb -> + <<Bs0:Sz/bits,0:(Lb-Sz)>>; + true -> + <<Bs:Sz/bits,_/bits>> = Bs0, + Bs + end; +to_bitstring(Bs, Lb) when is_bitstring(Bs) -> + adjust_size(Bs, Lb); +to_bitstring(Int, Lb) when is_integer(Int), Int >= 0 -> + L = int_to_bitlist(Int), + Bs = << <<B:1>> || B <- L >>, + adjust_size(Bs, Lb); +to_bitstring(L, Lb) when is_list(L) -> + Bs = << <<B:1>> || B <- L >>, + adjust_size(Bs, Lb). + +%% to_named_bitstring(Val) -> BitString +%% Val = BitString | {Unused,Binary} | [OneOrZero] | Integer +%% Given one of the possible representations for a BIT STRING, +%% return a bitstring where any trailing zeroes have been stripped. + +to_named_bitstring(Val) -> + Bs = to_bitstring(Val), + bs_drop_trailing_zeroes(Bs). + +%% to_named_bitstring(Val, Lb) -> BitString +%% Val = BitString | {Unused,Binary} | [OneOrZero] | Integer +%% Lb = Integer +%% Given one of the possible representations for a BIT STRING +%% and the lower bound for the number of bits, +%% return a bitstring that is at least Lb bits long. There will +%% be zeroes at the right only if needed to reach the lower bound +%% for the number of bits. + +to_named_bitstring({0,Bs}, Lb) when is_binary(Bs) -> + adjust_trailing_zeroes(Bs, Lb); +to_named_bitstring({Unused,Bs0}, Lb) when is_binary(Bs0) -> + Sz = bit_size(Bs0) - Unused, + <<Bs:Sz/bits,_/bits>> = Bs0, + adjust_trailing_zeroes(Bs, Lb); +to_named_bitstring(Bs, Lb) when is_bitstring(Bs) -> + adjust_trailing_zeroes(Bs, Lb); +to_named_bitstring(Val, Lb) -> + %% Obsolete representations: list or integer. Optimize + %% for correctness, not speed. + adjust_trailing_zeroes(to_bitstring(Val), Lb). + +is_default_bitstring(asn1_DEFAULT, _, _, _, _) -> + true; +is_default_bitstring({Unused,Bin}, V0, V1, V2, V3) when is_integer(Unused) -> + %% Convert compact bitstring to a bitstring. + Sz = bit_size(Bin) - Unused, + <<Bs:Sz/bitstring,_:Unused>> = Bin, + is_default_bitstring(Bs, V0, V1, V2, V3); +is_default_bitstring(Named, Named, _, _, _) -> + true; +is_default_bitstring(Bs, _, Bs, _, _) -> + true; +is_default_bitstring(List, _, _, List, _) -> + true; +is_default_bitstring(Int, _, _, _, Int) -> + true; +is_default_bitstring(Val, _, Def, _, _) when is_bitstring(Val) -> + Sz = bit_size(Def), + case Val of + <<Def:Sz/bitstring,T/bitstring>> -> + NumZeroes = bit_size(T), + case T of + <<0:NumZeroes>> -> true; + _ -> false + end; + _ -> + false + end; +is_default_bitstring(Val, _, _, List, _) when is_list(Val) -> + is_default_bitstring_list(List, Val); +is_default_bitstring(_, _, _, _, _) -> false. + +extension_bitmap(Val, Pos, Limit) -> + extension_bitmap(Val, Pos, Limit, 0). + %%% %%% Internal functions. %%% @@ -124,3 +340,159 @@ dec_subidentifiers([H|T], Av, Al) -> dec_subidentifiers(T, 0, [(Av bsl 7) bor H|Al]); dec_subidentifiers([], _Av, Al) -> lists:reverse(Al). + +enc_char(C0, Lb, Tab) -> + try element(C0-Lb, Tab) of + ill -> + illegal_char_error(); + C -> + C + catch + error:badarg -> + illegal_char_error() + end. + +illegal_char_error() -> + error({error,{asn1,"value forbidden by FROM constraint"}}). + +encode_fragmented_1(Bin, Unit, N) -> + SegSz = Unit * N * ?'16K', + case Bin of + <<B:SegSz/bitstring,T/bitstring>> -> + [<<3:2,N:6>>,B|encode_fragmented_1(T, Unit, N)]; + _ when N > 1 -> + encode_fragmented_1(Bin, Unit, N-1); + _ -> + case bit_size(Bin) div Unit of + Len when Len < 128 -> + [Len,Bin]; + Len when Len < 16384 -> + [<<2:2,Len:14>>,Bin] + end + end. + +%% E1 = 0|1|2 and (E2 < 40 when E1 = 0|1) +e_object_identifier([E1,E2|Tail]) when E1 >= 0, E1 < 2, E2 < 40; E1 =:= 2 -> + Head = 40*E1 + E2, + e_object_elements([Head|Tail], []); +e_object_identifier([_,_|_Tail]=Oid) -> + exit({error,{asn1,{'illegal_value',Oid}}}). + +e_object_elements([], Acc) -> + lists:reverse(Acc); +e_object_elements([H|T], Acc) -> + e_object_elements(T, [e_object_element(H)|Acc]). + +e_object_element(Num) when Num < 128 -> + [Num]; +e_object_element(Num) -> + [e_o_e(Num bsr 7)|[Num band 2#1111111]]. + +e_o_e(Num) when Num < 128 -> + Num bor 2#10000000; +e_o_e(Num) -> + [e_o_e(Num bsr 7)|[(Num band 2#1111111) bor 2#10000000]]. + +enint(-1, [B1|T]) when B1 > 127 -> + [B1|T]; +enint(N, Acc) -> + enint(N bsr 8, [N band 16#ff|Acc]). + +diff([H|T], Prev) -> + [H-Prev|diff(T, H)]; +diff([], _) -> []. + +diff([H|T], Prev, Last) -> + [{1,H-Prev}|diff(T, H, Last)]; +diff([], Prev, Last) when Last >= Prev -> + [{0,Last-Prev}]; +diff([], _, _) -> []. + +int_to_bitlist(0) -> []; +int_to_bitlist(Int) -> [Int band 1|int_to_bitlist(Int bsr 1)]. + +adjust_size(Bs, Lb) -> + case bit_size(Bs) of + Sz when Sz < Lb -> + <<Bs:Sz/bits,0:(Lb-Sz)>>; + _ -> + Bs + end. + +adjust_trailing_zeroes(Bs0, Lb) -> + case bit_size(Bs0) of + Sz when Sz < Lb -> + %% Too short - pad with zeroes. + <<Bs0:Sz/bits,0:(Lb-Sz)>>; + Lb -> + %% Exactly the right size - nothing to do. + Bs0; + _ -> + %% Longer than the lower bound - drop trailing zeroes. + <<_:Lb/bits,Tail/bits>> = Bs0, + Sz = Lb + bit_size(bs_drop_trailing_zeroes(Tail)), + <<Bs:Sz/bits,_/bits>> = Bs0, + Bs + end. + +bs_drop_trailing_zeroes(Bs) -> + bs_drop_trailing_zeroes(Bs, bit_size(Bs)). + +bs_drop_trailing_zeroes(Bs0, Sz0) when Sz0 < 8 -> + <<Byte:Sz0>> = Bs0, + Sz = Sz0 - ntz(Byte), + <<Bs:Sz/bits,_/bits>> = Bs0, + Bs; +bs_drop_trailing_zeroes(Bs0, Sz0) -> + Sz1 = Sz0 - 8, + <<Bs1:Sz1/bits,Byte:8>> = Bs0, + case ntz(Byte) of + 8 -> + bs_drop_trailing_zeroes(Bs1, Sz1); + Ntz -> + Sz = Sz0 - Ntz, + <<Bs:Sz/bits,_:Ntz/bits>> = Bs0, + Bs + end. + +%% ntz(Byte) -> Number of trailing zeroes. +ntz(Byte) -> + %% The table was calculated like this: + %% NTZ = fun (B, N, NTZ) when B band 1 =:= 0 -> NTZ(B bsr 1, N+1, NTZ); (_, N, _) -> N end. + %% io:format("~w\n", [list_to_tuple([NTZ(B+256, 0, NTZ) || B <- lists:seq(0, 255)])]). + T = {8,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0, + 4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0, + 5,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0, + 4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0, + 6,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0, + 4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0, + 5,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0, + 4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0, + 7,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0, + 4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0, + 5,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0, + 4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0, + 6,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0, + 4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0, + 5,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0, + 4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0}, + element(Byte+1, T). + +is_default_bitstring_list([H|Def], [H|Val]) -> + is_default_bitstring_list(Def, Val); +is_default_bitstring_list([], []) -> + true; +is_default_bitstring_list([], [_|_]=Val) -> + lists:all(fun(0) -> true; + (_) -> false + end, Val); +is_default_bitstring_list(_, _) -> false. + +extension_bitmap(_Val, Pos, Limit, Acc) when Pos >= Limit -> + Acc; +extension_bitmap(Val, Pos, Limit, Acc) -> + Bit = case element(Pos, Val) of + asn1_NOVALUE -> 0; + _ -> 1 + end, + extension_bitmap(Val, Pos+1, Limit, (Acc bsl 1) bor Bit). diff --git a/lib/asn1/src/asn1rtt_real_common.erl b/lib/asn1/src/asn1rtt_real_common.erl index 22a1f4c4dd..12ca165ecd 100644 --- a/lib/asn1/src/asn1rtt_real_common.erl +++ b/lib/asn1/src/asn1rtt_real_common.erl @@ -105,8 +105,7 @@ encode_real(_C, {Mantissa, Base, Exponent}) when Base =:= 2 -> true -> list_to_binary(real_mininum_octets(-(Man))) % signbit keeps track of sign end, %% ok = io:format("LenMask: ~w EOctets: ~w~nFirstOctet: ~w OctMantissa: ~w OctExpLen: ~w~n", [LenMask, EOctets, FirstOctet, OctMantissa, OctExpLen]), - Bin = <<FirstOctet/binary, EOctets/binary, OctMantissa/binary>>, - {Bin, size(Bin)}; + <<FirstOctet/binary, EOctets/binary, OctMantissa/binary>>; encode_real(C, {Mantissa,Base,Exponent}) when Base =:= 10, is_integer(Mantissa), is_integer(Exponent) -> %% always encode as NR3 due to DER on the format @@ -176,8 +175,7 @@ encode_real_as_string(_C, Mantissa, Exponent) end, ManBin = list_to_binary(TruncMant), NR3 = 3, - {<<NR3,ManBin/binary,$.,ExpBin/binary>>, - 2 + byte_size(ManBin) + byte_size(ExpBin)}. + <<NR3,ManBin/binary,$.,ExpBin/binary>>. remove_trailing_zeros(IntStr) -> case lists:dropwhile(fun($0)-> true; diff --git a/lib/asn1/src/asn1rtt_uper.erl b/lib/asn1/src/asn1rtt_uper.erl index a5035c6660..68a89c70e1 100644 --- a/lib/asn1/src/asn1rtt_uper.erl +++ b/lib/asn1/src/asn1rtt_uper.erl @@ -19,95 +19,8 @@ %% -module(asn1rtt_uper). --export([setext/1, fixoptionals/3, - fixextensions/2, - skipextensions/3]). --export([set_choice/3, encode_integer/2, encode_integer/3]). --export([encode_small_number/1, encode_constrained_number/2, - encode_boolean/1, - encode_length/1, encode_length/2, - encode_bit_string/3]). --export([encode_octet_string/1,encode_octet_string/2, - encode_relative_oid/1, - encode_object_identifier/1, - complete/1, complete_NFP/1]). - - -export([encode_open_type/1]). - - -export([encode_UniversalString/3, - encode_PrintableString/3, - encode_GeneralString/2, - encode_GraphicString/2, - encode_TeletexString/2, - encode_VideotexString/2, - encode_VisibleString/3, - encode_UTF8String/1, - encode_BMPString/3, - encode_IA5String/3, - encode_NumericString/3, - encode_ObjectDescriptor/2 - ]). - --define('16K',16384). --define('32K',32768). --define('64K',65536). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% setext(true|false) -> CompleteList -%% - -setext(false) -> - <<0:1>>; -setext(true) -> - <<1:1>>. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% This is the new fixoptionals/3 which is used by the new generates -%% -fixoptionals(OptList,OptLength,Val) when is_tuple(Val) -> - Bits = fixoptionals(OptList,Val,0), - {Val,<<Bits:OptLength>>}; - -fixoptionals([],_Val,Acc) -> - %% Optbits - Acc; -fixoptionals([{Pos,DefVal}|Ot],Val,Acc) -> - case element(Pos,Val) of - asn1_DEFAULT -> fixoptionals(Ot,Val,Acc bsl 1); - DefVal -> fixoptionals(Ot,Val,Acc bsl 1); - _ -> fixoptionals(Ot,Val,(Acc bsl 1) + 1) - end; -fixoptionals([Pos|Ot],Val,Acc) -> - case element(Pos,Val) of - asn1_NOVALUE -> fixoptionals(Ot,Val,Acc bsl 1); - asn1_DEFAULT -> fixoptionals(Ot,Val,Acc bsl 1); - _ -> fixoptionals(Ot,Val,(Acc bsl 1) + 1) - end. - - -fixextensions({ext,ExtPos,ExtNum},Val) -> - case fixextensions(ExtPos,ExtNum+ExtPos,Val,0) of - 0 -> []; - ExtBits -> - [encode_small_length(ExtNum),<<ExtBits:ExtNum>>] - end. - -fixextensions(Pos,MaxPos,_,Acc) when Pos >= MaxPos -> - Acc; -fixextensions(Pos,ExtPos,Val,Acc) -> - Bit = case catch(element(Pos+1,Val)) of - asn1_NOVALUE -> - 0; - asn1_NOEXTVALUE -> - 0; - {'EXIT',_} -> - 0; - _ -> - 1 - end, - fixextensions(Pos+1,ExtPos,Val,(Acc bsl 1)+Bit). +-export([skipextensions/3]). +-export([complete/1, complete_NFP/1]). skipextensions(Bytes0, Nr, ExtensionBitstr) when is_bitstring(ExtensionBitstr) -> Prev = Nr - 1, @@ -122,249 +35,6 @@ skipextensions(Bytes0, Nr, ExtensionBitstr) when is_bitstring(ExtensionBitstr) - Bytes0 end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% set_choice(Alt,Choices,Altnum) -> ListofBitSettings -%% Alt = atom() -%% Altnum = integer() | {integer(),integer()}% number of alternatives -%% Choices = [atom()] | {[atom()],[atom()]} -%% When Choices is a tuple the first list is the Rootset and the -%% second is the Extensions and then Altnum must also be a tuple with the -%% lengths of the 2 lists -%% -set_choice(Alt, {L1,L2}, {Len1,_Len2}) -> - case set_choice_tag(Alt, L1) of - N when is_integer(N), Len1 > 1 -> - [<<0:1>>, % the value is in the root set - encode_integer([{'ValueRange',{0,Len1-1}}],N)]; - N when is_integer(N) -> - <<0:1>>; % no encoding if only 0 or 1 alternative - false -> - [<<1:1>>, % extension value - case set_choice_tag(Alt,L2) of - N2 when is_integer(N2) -> - encode_small_number(N2); - false -> - unknown_choice_alt - end] - end; -set_choice(Alt,L,Len) -> - case set_choice_tag(Alt,L) of - N when is_integer(N), Len > 1 -> - encode_integer([{'ValueRange',{0,Len-1}}],N); - N when is_integer(N) -> - []; % no encoding if only 0 or 1 alternative - false -> - [unknown_choice_alt] - end. - -set_choice_tag(Alt,Choices) -> - set_choice_tag(Alt,Choices,0). - -set_choice_tag(Alt,[Alt|_Rest],Tag) -> - Tag; -set_choice_tag(Alt,[_H|Rest],Tag) -> - set_choice_tag(Alt,Rest,Tag+1); -set_choice_tag(_Alt,[],_Tag) -> - false. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_open_type(Constraint, Value) -> CompleteList -%% Value = list of bytes of an already encoded value (the list must be flat) -%% | binary -%% Contraint = not used in this version -%% -encode_open_type(Val) -> - [encode_length(byte_size(Val)),Val]. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_integer(Constraint,Value,NamedNumberList) -> CompleteList -%% encode_integer(Constraint,Value) -> CompleteList -%% encode_integer(Constraint,{Name,Value}) -> CompleteList -%% -%% -encode_integer(C, V, NamedNumberList) when is_atom(V) -> - case lists:keyfind(V, 1, NamedNumberList) of - {_,NewV} -> - encode_integer(C, NewV); - false -> - exit({error,{asn1,{namednumber,V}}}) - end; -encode_integer(C, V, _NamedNumberList) when is_integer(V) -> - encode_integer(C, V). - -encode_integer([{Rc,_Ec}],Val) when is_tuple(Rc) -> - try - [<<0:1>>,encode_integer([Rc], Val)] - catch - _:{error,{asn1,_}} -> - [<<1:1>>,encode_unconstrained_number(Val)] - end; -encode_integer(C, Val) when is_list(C) -> - case get_constraint(C, 'SingleValue') of - no -> - encode_integer1(C,Val); - V when is_integer(V), V =:= Val -> - []; % a type restricted to a single value encodes to nothing - V when is_list(V) -> - case lists:member(Val,V) of - true -> - encode_integer1(C,Val); - _ -> - exit({error,{asn1,{illegal_value,Val}}}) - end; - _ -> - exit({error,{asn1,{illegal_value,Val}}}) - end. - -encode_integer1(C, Val) -> - case VR = get_constraint(C, 'ValueRange') of - no -> - encode_unconstrained_number(Val); - {Lb,'MAX'} when Lb =< Val -> - encode_semi_constrained_number(Lb, Val); - %% positive with range - {Lb,Ub} when Val >= Lb, Ub >= Val -> - encode_constrained_number(VR,Val); - _ -> - exit({error,{asn1,{illegal_value,VR,Val}}}) - end. - -%% X.691:10.6 Encoding of a normally small non-negative whole number -%% Use this for encoding of CHOICE index if there is an extension marker in -%% the CHOICE -encode_small_number(Val) when Val < 64 -> - <<Val:7>>; -encode_small_number(Val) -> - [<<1:1>>|encode_semi_constrained_number(0, Val)]. - -%% X.691:10.7 Encoding of a semi-constrained whole number -encode_semi_constrained_number(Lb, Val) -> - %% encoding in minimum number of octets preceeded by a length - Val2 = Val - Lb, - Bin = eint_bin_positive(Val2), - Size = byte_size(Bin), - if - Size < 128 -> - [<<Size>>,Bin]; - Size < 16384 -> - [<<2:2,Size:14>>,Bin]; - true -> - [encode_length(Size),Bin] - end. - -encode_constrained_number({Lb,Ub}, Val) when Val >= Lb, Ub >= Val -> - Range = Ub - Lb + 1, - Val2 = Val - Lb, - NumBits = num_bits(Range), - <<Val2:NumBits>>; -encode_constrained_number(Range,Val) -> - exit({error,{asn1,{integer_range,Range,value,Val}}}). - -%% X.691:10.8 Encoding of an unconstrained whole number - -encode_unconstrained_number(Val) when Val >= 0 -> - Oct = eint_bin_2Cs(Val), - Len = byte_size(Oct), - if - Len < 128 -> - [<<Len>>,Oct]; % equiv with encode_length(undefined,Len) but faster - Len < 16384 -> - [<<2:2,Len:14>>,Oct]; - true -> - [encode_length(Len),<<Len:16>>,Oct] - end; -encode_unconstrained_number(Val) -> % negative - Oct = enint(Val,[]), - Len = byte_size(Oct), - if - Len < 128 -> - [<<Len>>,Oct]; % equiv with encode_length(undefined,Len) but faster - Len < 16384 -> - [<<2:2,Len:14>>,Oct]; - true -> - [encode_length(Len),Oct] - end. - - -eint_bin_2Cs(Int) -> - case eint_bin_positive(Int) of - <<B,_/binary>> = Bin when B > 16#7f -> - <<0,Bin/binary>>; - Bin -> Bin - end. - -%% returns the integer as a binary -eint_bin_positive(Val) when Val < 16#100 -> - <<Val>>; -eint_bin_positive(Val) when Val < 16#10000 -> - <<Val:16>>; -eint_bin_positive(Val) when Val < 16#1000000 -> - <<Val:24>>; -eint_bin_positive(Val) when Val < 16#100000000 -> - <<Val:32>>; -eint_bin_positive(Val) -> - list_to_binary([eint_bin_positive2(Val bsr 32),<<Val:32>>]). - -eint_bin_positive2(Val) when Val < 16#100 -> - <<Val>>; -eint_bin_positive2(Val) when Val < 16#10000 -> - <<Val:16>>; -eint_bin_positive2(Val) when Val < 16#1000000 -> - <<Val:24>>; -eint_bin_positive2(Val) when Val < 16#100000000 -> - <<Val:32>>; -eint_bin_positive2(Val) -> - [eint_bin_positive2(Val bsr 32),<<Val:32>>]. - - - - -enint(-1, [B1|T]) when B1 > 127 -> - list_to_binary([B1|T]); -enint(N, Acc) -> - enint(N bsr 8, [N band 16#ff|Acc]). - - -%% X.691:10.9 Encoding of a length determinant -%%encode_small_length(undefined,Len) -> % null means no UpperBound -%% encode_small_number(Len). - -%% X.691:10.9.3.5 -%% X.691:10.9.3.7 -encode_length(Len) -> % un-constrained - if - Len < 128 -> - <<Len>>; - Len < 16384 -> - <<2:2,Len:14>>; - true -> % should be able to endode length >= 16384 - error({error,{asn1,{encode_length,{nyi,above_16k}}}}) - end. - -encode_length({C,[]}, Len) -> - case C of - {Lb,Ub}=Vr when Lb =< Len, Len =< Ub -> - [<<0:1>>|encode_constrained_number(Vr, Len)]; - _ -> - [<<1:1>>|encode_length(Len)] - end; -encode_length(Len, Len) -> - []; -encode_length(Vr, Len) -> - encode_constrained_number(Vr, Len). - - -%% X.691 10.9.3.4 (only used for length of bitmap that prefixes extension -%% additions in a sequence or set -encode_small_length(Len) when Len =< 64 -> - <<(Len-1):7>>; -encode_small_length(Len) -> - [<<1:1>>,encode_length(Len)]. - - %% un-constrained decode_length(<<0:1,Oct:7,Rest/bitstring>>) -> {Oct,Rest}; @@ -373,575 +43,20 @@ decode_length(<<2:2,Val:14,Rest/bitstring>>) -> decode_length(<<3:2,_:14,_Rest/bitstring>>) -> exit({error,{asn1,{decode_length,{nyi,above_16k}}}}). - % X.691:11 -encode_boolean(true) -> - <<1:1>>; -encode_boolean(false) -> - <<0:1>>; -encode_boolean(Val) -> - exit({error,{asn1,{encode_boolean,Val}}}). - - -%%============================================================================ -%%============================================================================ -%% Bitstring value, ITU_T X.690 Chapter 8.5 -%%============================================================================ -%%============================================================================ - -%%============================================================================ -%% encode bitstring value -%%============================================================================ - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% bitstring NamedBitList -%% Val can be of: -%% - [identifiers] where only named identifers are set to one, -%% the Constraint must then have some information of the -%% bitlength. -%% - [list of ones and zeroes] all bits -%% - integer value representing the bitlist -%% C is constraint Len, only valid when identifiers are present - - -%% when the value is a list of {Unused,BinBits}, where -%% Unused = integer(), -%% BinBits = binary(). - -encode_bit_string(C, Bits, NamedBitList) when is_bitstring(Bits) -> - PadLen = (8 - (bit_size(Bits) band 7)) band 7, - Compact = {PadLen,<<Bits/bitstring,0:PadLen>>}, - encode_bit_string(C, Compact, NamedBitList); -encode_bit_string(C, {Unused,BinBits}=Bin, NamedBitList) - when is_integer(Unused), is_binary(BinBits) -> - encode_bin_bit_string(C, Bin, NamedBitList); - -encode_bit_string(C, BitListVal, NamedBitList) -> - encode_bit_string1(C, BitListVal, NamedBitList). - -%% when the value is a list of named bits -encode_bit_string1(C, [FirstVal|_RestVal]=LoNB, NamedBitList) - when is_atom(FirstVal) -> - ToSetPos = get_all_bitposes(LoNB, NamedBitList, []), - BitList = make_and_set_list(ToSetPos, 0), - encode_bit_string1(C, BitList, NamedBitList); -encode_bit_string1(C, [{bit,_No}|_RestVal]=BL, NamedBitList) -> - ToSetPos = get_all_bitposes(BL, NamedBitList, []), - BitList = make_and_set_list(ToSetPos, 0), - encode_bit_string1(C, BitList, NamedBitList); -%% when the value is a list of ones and zeroes -encode_bit_string1(Int, BitListValue, _) - when is_list(BitListValue), is_integer(Int) -> - %% The type is constrained by a single value size constraint - bit_list2bitstr(Int, BitListValue); -encode_bit_string1(no, BitListValue, []) - when is_list(BitListValue) -> - Len = length(BitListValue), - [encode_length(Len),bit_list2bitstr(Len,BitListValue)]; -encode_bit_string1(C, BitListValue,[]) - when is_list(BitListValue) -> - Len = length(BitListValue), - [encode_length(C, Len),bit_list2bitstr(Len,BitListValue)]; -encode_bit_string1(no, BitListValue,_NamedBitList) - when is_list(BitListValue) -> - NewBitLVal = lists:reverse(lists:dropwhile(fun(0)->true;(1)->false end, - lists:reverse(BitListValue))), - Len = length(NewBitLVal), - [encode_length(Len),bit_list2bitstr(Len,NewBitLVal)]; -encode_bit_string1(C, BitListValue, _NamedBitList) - when is_list(BitListValue) ->% C = {_,'MAX'} - NewBitStr = bitstr_trailing_zeros(BitListValue, C), - [encode_length(C, bit_size(NewBitStr)),NewBitStr]; - - -%% when the value is an integer -encode_bit_string1(C, IntegerVal, NamedBitList) when is_integer(IntegerVal)-> - BitList = int_to_bitlist(IntegerVal), - encode_bit_string1(C, BitList, NamedBitList). - -bit_list2bitstr(Len,BitListValue) -> - case length(BitListValue) of - Len -> - << <<B:1>> || B <- BitListValue>>; - L when L > Len -> % truncate - <<(<< <<B:1>> || B <- BitListValue>>):Len/bitstring>>; - L -> % Len > L -> pad - <<(<< <<B:1>> || B <- BitListValue>>)/bitstring,0:(Len-L)>> - end. - -adjust_trailing_zeros(Len, Bin) when Len =:= bit_size(Bin) -> - Bin; -adjust_trailing_zeros(Len, Bin) when Len > bit_size(Bin) -> - <<Bin/bitstring,0:(Len-bit_size(Bin))>>; -adjust_trailing_zeros(Len,Bin) -> - <<Bin:Len/bitstring>>. - -bitstr_trailing_zeros(BitList, C) when is_integer(C) -> - bitstr_trailing_zeros1(BitList, C, C); -bitstr_trailing_zeros(BitList, {Lb,Ub}) when is_integer(Lb) -> - bitstr_trailing_zeros1(BitList,Lb,Ub); -bitstr_trailing_zeros(BitList, {{Lb,Ub},_}) when is_integer(Lb) -> - bitstr_trailing_zeros1(BitList, Lb, Ub); -bitstr_trailing_zeros(BitList, _) -> - bit_list2bitstr(length(BitList), BitList). - -bitstr_trailing_zeros1(BitList, Lb, Ub) -> - case length(BitList) of - Lb -> bit_list2bitstr(Lb, BitList); - B when B < Lb -> bit_list2bitstr(Lb, BitList); - D -> F = fun(L,LB,LB,_,_)->bit_list2bitstr(LB,lists:reverse(L)); - ([0|R],L1,LB,UB,Fun)->Fun(R,L1-1,LB,UB,Fun); - (L,L1,_,UB,_)when L1 =< UB -> - bit_list2bitstr(L1,lists:reverse(L)); - (_,_L1,_,_,_) ->exit({error,{list_length_BIT_STRING, - BitList}}) end, - F(lists:reverse(BitList),D,Lb,Ub,F) - end. - -%% encode_bin_bit_string/3, when value is a tuple of Unused and BinBits. -%% Unused = integer(),i.e. number unused bits in least sign. byte of -%% BinBits = binary(). -encode_bin_bit_string(C, {_,BinBits}, _NamedBitList) - when is_integer(C), C =< 16 -> - adjust_trailing_zeros(C, BinBits); -encode_bin_bit_string(C, {_Unused,BinBits}, _NamedBitList) - when is_integer(C) -> - adjust_trailing_zeros(C, BinBits); -encode_bin_bit_string(C, {_,_}=UnusedAndBin, NamedBitList) -> - %% removes all trailing bits if NamedBitList is not empty - BitStr = remove_trailing_bin(NamedBitList, UnusedAndBin), - case C of - {Lb,Ub} when is_integer(Lb),is_integer(Ub) -> - [encode_length({Lb,Ub},bit_size(BitStr)),BitStr]; - no -> - [encode_length(bit_size(BitStr)),BitStr]; - Sc -> - [encode_length(Sc,bit_size(BitStr)),BitStr] - end. - - -remove_trailing_bin([], {Unused,Bin}) -> - BS = bit_size(Bin)-Unused, - <<BitStr:BS/bitstring,_:Unused>> = Bin, - BitStr; -remove_trailing_bin(_NamedNumberList, {_Unused,<<>>}) -> - <<>>; -remove_trailing_bin(NamedNumberList, {_Unused,Bin}) -> - Size = byte_size(Bin)-1, - <<Bfront:Size/binary, LastByte:8>> = Bin, - - %% clear the Unused bits to be sure - Unused1 = trailingZeroesInNibble(LastByte band 15), - Unused2 = - case Unused1 of - 4 -> - 4 + trailingZeroesInNibble(LastByte bsr 4); - _ -> Unused1 - end, - case Unused2 of - 8 -> - remove_trailing_bin(NamedNumberList,{0,Bfront}); - _ -> - BS = bit_size(Bin) - Unused2, - <<BitStr:BS/bitstring,_:Unused2>> = Bin, - BitStr - end. - -trailingZeroesInNibble(0) -> - 4; -trailingZeroesInNibble(1) -> - 0; -trailingZeroesInNibble(2) -> - 1; -trailingZeroesInNibble(3) -> - 0; -trailingZeroesInNibble(4) -> - 2; -trailingZeroesInNibble(5) -> - 0; -trailingZeroesInNibble(6) -> - 1; -trailingZeroesInNibble(7) -> - 0; -trailingZeroesInNibble(8) -> - 3; -trailingZeroesInNibble(9) -> - 0; -trailingZeroesInNibble(10) -> - 1; -trailingZeroesInNibble(11) -> - 0; -trailingZeroesInNibble(12) -> %#1100 - 2; -trailingZeroesInNibble(13) -> - 0; -trailingZeroesInNibble(14) -> - 1; -trailingZeroesInNibble(15) -> - 0. - - -%%%%%%%%%%%%%%% -%% - -int_to_bitlist(Int) when is_integer(Int), Int > 0 -> - [Int band 1 | int_to_bitlist(Int bsr 1)]; -int_to_bitlist(0) -> - []. - - -%%%%%%%%%%%%%%%%%% -%% get_all_bitposes([list of named bits to set], named_bit_db, []) -> -%% [sorted_list_of_bitpositions_to_set] - -get_all_bitposes([{bit,ValPos}|Rest], NamedBitList, Ack) -> - get_all_bitposes(Rest, NamedBitList, [ValPos | Ack ]); - -get_all_bitposes([Val | Rest], NamedBitList, Ack) -> - case lists:keyfind(Val, 1, NamedBitList) of - {_ValName, ValPos} -> - get_all_bitposes(Rest, NamedBitList, [ValPos | Ack]); - false -> - exit({error,{asn1, {bitstring_namedbit, Val}}}) - end; -get_all_bitposes([], _NamedBitList, Ack) -> - lists:sort(Ack). - -%%%%%%%%%%%%%%%%%% -%% make_and_set_list([list of positions to set to 1])-> -%% returns list with all in SetPos set. -%% in positioning in list the first element is 0, the second 1 etc.., but -%% - -make_and_set_list([XPos|SetPos], XPos) -> - [1 | make_and_set_list(SetPos, XPos + 1)]; -make_and_set_list([Pos|SetPos], XPos) -> - [0 | make_and_set_list([Pos | SetPos], XPos + 1)]; -make_and_set_list([], _) -> - []. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% X.691:16 -%% encode_octet_string(Val) -%% encode_octet_string(Constraint, Val) -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -encode_octet_string(Val) -> - try - [encode_length(length(Val)),list_to_binary(Val)] - catch - error:{error,{asn1,{encode_length,_}}} -> - encode_fragmented_octet_string(Val) - end. - -encode_octet_string(C, Val) -> - case C of - {_,_}=VR -> - try - [encode_length(VR, length(Val)),list_to_binary(Val)] - catch - error:{error,{asn1,{encode_length,_}}} -> - encode_fragmented_octet_string(Val) - end; - Sv when is_integer(Sv), Sv =:= length(Val) -> % fixed length - list_to_binary(Val) - end. - - -encode_fragmented_octet_string(Val) -> - Bin = list_to_binary(Val), - efos_1(Bin). - -efos_1(<<B:16#10000/binary,T/binary>>) -> - [<<3:2,4:6>>,B|efos_1(T)]; -efos_1(<<B:16#C000/binary,T/binary>>) -> - [<<3:2,3:6>>,B|efos_1(T)]; -efos_1(<<B:16#8000/binary,T/binary>>) -> - [<<3:2,2:6>>,B|efos_1(T)]; -efos_1(<<B:16#4000/binary,T/binary>>) -> - [<<3:2,1:6>>,B|efos_1(T)]; -efos_1(<<B/bitstring>>) -> - Len = byte_size(B), - [encode_length(Len),B]. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Restricted char string types -%% (NumericString, PrintableString,VisibleString,IA5String,BMPString,UniversalString) -%% X.691:26 and X.680:34-36 -%%encode_restricted_string('BMPString',Constraints,Extension,Val) - - -encode_restricted_string(Val) when is_list(Val)-> - [encode_length(length(Val)),list_to_binary(Val)]. - -encode_known_multiplier_string(StringType, C, Pa, Val) -> - Result = chars_encode(Pa, StringType, Val), - case C of - Ub when is_integer(Ub) -> - Result; - {_,_}=Range -> - [encode_length(Range, length(Val)),Result]; - no -> - [encode_length(length(Val)),Result] - end. - -encode_NumericString(C, Pa, Val) -> - encode_known_multiplier_string('NumericString', C, Pa, Val). - -encode_PrintableString(C, Pa, Val) -> - encode_known_multiplier_string('PrintableString', C, Pa, Val). - -encode_VisibleString(C, Pa, Val) -> % equivalent with ISO646String - encode_known_multiplier_string('VisibleString', C, Pa, Val). - -encode_IA5String(C, Pa, Val) -> - encode_known_multiplier_string('IA5String', C, Pa, Val). - -encode_BMPString(C, Pa, Val) -> - encode_known_multiplier_string('BMPString', C, Pa, Val). - -encode_UniversalString(C, Pa, Val) -> - encode_known_multiplier_string('UniversalString', C, Pa, Val). - - -%% end of known-multiplier strings for which PER visible constraints are -%% applied - -encode_GeneralString(_C,Val) -> - encode_restricted_string(Val). - -encode_GraphicString(_C,Val) -> - encode_restricted_string(Val). - -encode_ObjectDescriptor(_C,Val) -> - encode_restricted_string(Val). - -encode_TeletexString(_C,Val) -> % equivalent with T61String - encode_restricted_string(Val). - -encode_VideotexString(_C,Val) -> - encode_restricted_string(Val). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% chars_encode(C,StringType,Value) -> ValueList -%% -%% encodes chars according to the per rules taking the constraint PermittedAlphabet -%% into account. -%% This function does only encode the value part and NOT the length - -chars_encode(Pa, StringType, Value) -> - case {StringType,Pa} of - {'UniversalString',{_,_Sv}} -> - exit({error,{asn1,{'not implemented',"UniversalString with PermittedAlphabet constraint"}}}); - {'BMPString',{_,_Sv}} -> - exit({error,{asn1,{'not implemented',"BMPString with PermittedAlphabet constraint"}}}); - _ -> - {NumBits,CharOutTab} = {get_NumBits(Pa, StringType), - get_CharOutTab(Pa, StringType)}, - chars_encode2(Value,NumBits,CharOutTab) - end. - -chars_encode2([H|T],NumBits,{Min,Max,notab}) when H =< Max, H >= Min -> - [<<(H-Min):NumBits>>|chars_encode2(T,NumBits,{Min,Max,notab})]; -chars_encode2([H|T],NumBits,{Min,Max,Tab}) when H =< Max, H >= Min -> - Ch = exit_if_false(H,element(H-Min+1,Tab)), - [<<Ch:NumBits>>|chars_encode2(T,NumBits,{Min,Max,Tab})]; -chars_encode2([{A,B,C,D}|T],NumBits,{Min,Max,notab}) -> - %% no value range check here (ought to be, but very expensive) - Ch = ((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min, - [<<Ch:NumBits>>|chars_encode2(T,NumBits,{Min,Max,notab})]; -chars_encode2([{A,B,C,D}|T],NumBits,{Min,Max,Tab}) -> - %% no value range check here (ought to be, but very expensive) - Ch = exit_if_false({A,B,C,D},element(((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min,Tab)), - [<<Ch:NumBits>>|chars_encode2(T,NumBits,{Min,Max,notab})]; -chars_encode2([H|_T],_,{_,_,_}) -> - exit({error,{asn1,{illegal_char_value,H}}}); -chars_encode2([],_,_) -> - []. - -exit_if_false(V,false)-> - exit({error,{asn1,{"illegal value according to Permitted alphabet constraint",V}}}); -exit_if_false(_,V) ->V. - - -get_NumBits(Pa, StringType) -> - case Pa of - {'SingleValue',Sv} -> - charbits(length(Sv)); - no -> - case StringType of - 'IA5String' -> - charbits(128); % 16#00..16#7F - 'VisibleString' -> - charbits(95); % 16#20..16#7E - 'PrintableString' -> - charbits(74); % [$\s,$',$(,$),$+,$,,$-,$.,$/,"0123456789",$:,$=,$?,$A..$Z,$a..$z - 'NumericString' -> - charbits(11); % $ ,"0123456789" - 'UniversalString' -> - 32; - 'BMPString' -> - 16 - end - end. - -get_CharOutTab(Pa, StringType) -> - case Pa of - {'SingleValue',Sv} -> - get_CharTab2(Pa, StringType, hd(Sv), lists:max(Sv), Sv); - no -> - case StringType of - 'IA5String' -> - {0,16#7F,notab}; - 'VisibleString' -> - get_CharTab2(Pa, StringType, 16#20, 16#7F, notab); - 'PrintableString' -> - Chars = lists:sort( - " '()+,-./0123456789:=?ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"), - get_CharTab2(Pa, StringType, hd(Chars), - lists:max(Chars), Chars); - 'NumericString' -> - get_CharTab2(Pa, StringType, 16#20, $9, " 0123456789"); - 'UniversalString' -> - {0,16#FFFFFFFF,notab}; - 'BMPString' -> - {0,16#FFFF,notab} - end - end. - -get_CharTab2(C,StringType,Min,Max,Chars) -> - BitValMax = (1 bsl get_NumBits(C,StringType))-1, - if - Max =< BitValMax -> - {0,Max,notab}; - true -> - {Min,Max,create_char_tab(Min,Chars)} - end. - -create_char_tab(Min,L) -> - list_to_tuple(create_char_tab(Min,L,0)). -create_char_tab(Min,[Min|T],V) -> - [V|create_char_tab(Min+1,T,V+1)]; -create_char_tab(_Min,[],_V) -> - []; -create_char_tab(Min,L,V) -> - [false|create_char_tab(Min+1,L,V)]. - -%% See Table 20.3 in Dubuisson -charbits(NumOfChars) when NumOfChars =< 2 -> 1; -charbits(NumOfChars) when NumOfChars =< 4 -> 2; -charbits(NumOfChars) when NumOfChars =< 8 -> 3; -charbits(NumOfChars) when NumOfChars =< 16 -> 4; -charbits(NumOfChars) when NumOfChars =< 32 -> 5; -charbits(NumOfChars) when NumOfChars =< 64 -> 6; -charbits(NumOfChars) when NumOfChars =< 128 -> 7; -charbits(NumOfChars) when NumOfChars =< 256 -> 8; -charbits(NumOfChars) when NumOfChars =< 512 -> 9; -charbits(NumOfChars) when NumOfChars =< 1024 -> 10; -charbits(NumOfChars) when NumOfChars =< 2048 -> 11; -charbits(NumOfChars) when NumOfChars =< 4096 -> 12; -charbits(NumOfChars) when NumOfChars =< 8192 -> 13; -charbits(NumOfChars) when NumOfChars =< 16384 -> 14; -charbits(NumOfChars) when NumOfChars =< 32768 -> 15; -charbits(NumOfChars) when NumOfChars =< 65536 -> 16; -charbits(NumOfChars) when is_integer(NumOfChars) -> - 16 + charbits1(NumOfChars bsr 16). - -charbits1(0) -> - 0; -charbits1(NumOfChars) -> - 1 + charbits1(NumOfChars bsr 1). - - -%% UTF8String -encode_UTF8String(Val) when is_binary(Val) -> - [encode_length(byte_size(Val)),Val]; -encode_UTF8String(Val) -> - Bin = list_to_binary(Val), - encode_UTF8String(Bin). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_object_identifier(Val) -> CompleteList -%% encode_object_identifier({Name,Val}) -> CompleteList -%% Val -> {Int1,Int2,...,IntN} % N >= 2 -%% Name -> atom() -%% Int1 -> integer(0..2) -%% Int2 -> integer(0..39) when Int1 (0..1) else integer() -%% Int3-N -> integer() -%% CompleteList -> [binary()|bitstring()|list()] -%% -encode_object_identifier(Val) -> - OctetList = e_object_identifier(Val), - Octets = list_to_binary(OctetList), % performs a flatten at the same time - [encode_length(byte_size(Octets)),Octets]. - -%% This code is copied from asn1_encode.erl (BER) and corrected and modified - -e_object_identifier({'OBJECT IDENTIFIER',V}) -> - e_object_identifier(V); -e_object_identifier(V) when is_tuple(V) -> - e_object_identifier(tuple_to_list(V)); - -%% E1 = 0|1|2 and (E2 < 40 when E1 = 0|1) -e_object_identifier([E1,E2|Tail]) when E1 >= 0, E1 < 2, E2 < 40 ; E1==2 -> - Head = 40*E1 + E2, % weird - e_object_elements([Head|Tail],[]); -e_object_identifier(Oid=[_,_|_Tail]) -> - exit({error,{asn1,{'illegal_value',Oid}}}). - -e_object_elements([],Acc) -> - lists:reverse(Acc); -e_object_elements([H|T],Acc) -> - e_object_elements(T,[e_object_element(H)|Acc]). - -e_object_element(Num) when Num < 128 -> - [Num]; -e_object_element(Num) -> - [e_o_e(Num bsr 7)|[Num band 2#1111111]]. -e_o_e(Num) when Num < 128 -> - Num bor 2#10000000; -e_o_e(Num) -> - [e_o_e(Num bsr 7)|[(Num band 2#1111111) bor 2#10000000]]. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_relative_oid(Val) -> CompleteList -%% encode_relative_oid({Name,Val}) -> CompleteList -encode_relative_oid(Val) when is_tuple(Val) -> - encode_relative_oid(tuple_to_list(Val)); -encode_relative_oid(Val) when is_list(Val) -> - Octets = list_to_binary([e_object_element(X)||X <- Val]), - [encode_length(byte_size(Octets)),Octets]. - - -get_constraint([{Key,V}],Key) -> - V; -get_constraint([],_Key) -> - no; -get_constraint(C,Key) -> - case lists:keyfind(Key, 1, C) of - false -> - no; - {_,V} -> - V - end. - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% complete(InList) -> ByteList %% Takes a coded list with bits and bytes and converts it to a list of bytes %% Should be applied as the last step at encode of a complete ASN.1 type %% complete(InList) when is_list(InList) -> - case complete1(InList) of + case list_to_bitstring(InList) of <<>> -> <<0>>; Res -> - case bit_size(Res) band 7 of + Sz = bit_size(Res), + case Sz band 7 of 0 -> Res; - Bits -> <<Res/bitstring,0:(8-Bits)>> + Bits -> <<Res:Sz/bitstring,0:(8-Bits)>> end end; complete(Bin) when is_binary(Bin) -> @@ -950,24 +65,12 @@ complete(Bin) when is_binary(Bin) -> _ -> Bin end; complete(InList) when is_bitstring(InList) -> - PadLen = 8 - (bit_size(InList) band 7), - <<InList/bitstring,0:PadLen>>. - -complete1(L) when is_list(L) -> - list_to_bitstring(L). + Sz = bit_size(InList), + PadLen = 8 - (Sz band 7), + <<InList:Sz/bitstring,0:PadLen>>. %% Special version of complete that does not align the completed message. complete_NFP(InList) when is_list(InList) -> list_to_bitstring(InList); complete_NFP(InList) when is_bitstring(InList) -> InList. - -%% unaligned helpers - -%% 10.5.6 NOTE: If "range" satisfies the inequality 2^m < "range" =< -%% 2^(m+1) then the number of bits = m + 1 - -num_bits(N) -> num_bits(N, 1, 0). - -num_bits(N,T,B) when N =< T -> B; -num_bits(N,T,B) -> num_bits(N, T bsl 1, B+1). diff --git a/lib/asn1/src/prepare_templates.erl b/lib/asn1/src/prepare_templates.erl index 83155b2e52..ccd15548d8 100644 --- a/lib/asn1/src/prepare_templates.erl +++ b/lib/asn1/src/prepare_templates.erl @@ -21,69 +21,77 @@ -export([gen_asn1ct_rtt/1,gen_asn1ct_eval/1]). gen_asn1ct_rtt(Ms) -> - io:format("%% Generated by ~s. DO NOT EDIT THIS FILE.\n" + {ok,Fd} = file:open("asn1ct_rtt.erl", [write]), + io:format(Fd, + "%% Generated by ~s. DO NOT EDIT THIS FILE.\n" "%%\n" "%% Input files:\n", [?MODULE]), - [io:put_chars(["%% ",M,$\n]) || M <- Ms], - io:nl(), - io:put_chars("-module(asn1ct_rtt).\n" + [io:put_chars(Fd, ["%% ",M,$\n]) || M <- Ms], + io:nl(Fd), + io:put_chars(Fd, + "-module(asn1ct_rtt).\n" "-export([assert_defined/1,dependencies/1,code/0]).\n" "\n"), Forms = lists:sort(lists:append([abstract(M) || M <- Ms])), Exp = lists:sort(exports(Forms)), - defined(Exp), - io:nl(), + defined(Fd, Exp), + io:nl(Fd), Calls = calls(Forms), R = sofs:relation(Calls), Fam0 = sofs:relation_to_family(R), Fam = sofs:to_external(Fam0), - dependencies(Fam), - io:nl(), + dependencies(Fd, Fam), + io:nl(Fd), Funcs = [begin Bin = list_to_binary([$\n|erl_pp:function(Func)]), {{M,F,A},Bin} end || {M,{function,_,F,A,_}=Func} <- Forms], - io:format("code() ->\n~p.\n\n", [Funcs]), + io:format(Fd, "code() ->\n~p.\n\n", [Funcs]), + ok = file:close(Fd), halt(0). gen_asn1ct_eval([File]) -> + Output = filename:rootname(File, ".funcs") ++ ".erl", + {ok,Fd} = file:open(Output, [write]), {ok,Funcs} = file:consult(File), asn1ct_func:start_link(), [asn1ct_func:need(MFA) || MFA <- Funcs], - io:format("%% Generated by ~s. DO NOT EDIT THIS FILE.\n" + io:format(Fd, + "%% Generated by ~s. DO NOT EDIT THIS FILE.\n" "%%\n" "%% Input file: ~s\n\n", [?MODULE,File]), - io:format("-module(~s).\n", [filename:rootname(File)]), - gen_asn1ct_eval_exp(Funcs), - asn1ct_func:generate(group_leader()), + io:format(Fd, "-module(~s).\n", [filename:rootname(File)]), + gen_asn1ct_eval_exp(Fd, Funcs), + asn1ct_func:generate(Fd), + ok = file:close(Fd), halt(0). -gen_asn1ct_eval_exp(Funcs) -> - io:put_chars("-export(["), - gen_asn1ct_eval_exp_1(Funcs, ""), - io:put_chars("]).\n"). +gen_asn1ct_eval_exp(Fd, Funcs) -> + io:put_chars(Fd, "-export(["), + gen_asn1ct_eval_exp_1(Fd, Funcs, ""), + io:put_chars(Fd, "]).\n"). -gen_asn1ct_eval_exp_1([{_,F,A}|T], Sep) -> - io:put_chars(Sep), - io:format("~p/~p", [F,A]), - gen_asn1ct_eval_exp_1(T, ",\n"); -gen_asn1ct_eval_exp_1([], _) -> ok. +gen_asn1ct_eval_exp_1(Fd, [{_,F,A}|T], Sep) -> + io:put_chars(Fd, Sep), + io:format(Fd, "~p/~p", [F,A]), + gen_asn1ct_eval_exp_1(Fd, T, ",\n"); +gen_asn1ct_eval_exp_1(_, [], _) -> ok. -defined([H|T]) -> - io:format("assert_defined(~p) -> ok", [H]), +defined(Fd, [H|T]) -> + io:format(Fd, "assert_defined(~p) -> ok", [H]), case T of [] -> - io:put_chars(".\n"); + io:put_chars(Fd, ".\n"); [_|_] -> - io:put_chars(";\n"), - defined(T) + io:put_chars(Fd, ";\n"), + defined(Fd, T) end. -dependencies([{K,V}|T]) -> - io:format("dependencies(~p) ->\n~p;\n", [K,V]), - dependencies(T); -dependencies([]) -> - io:put_chars("dependencies(_) -> [].\n"). +dependencies(Fd, [{K,V}|T]) -> + io:format(Fd, "dependencies(~p) ->\n~p;\n", [K,V]), + dependencies(Fd, T); +dependencies(Fd, []) -> + io:put_chars(Fd, "dependencies(_) -> [].\n"). abstract(File) -> {ok,{M0,[{abstract_code,Abstract}]}} = diff --git a/lib/asn1/test/Makefile b/lib/asn1/test/Makefile index 15b97df972..b1b08aa9f9 100644 --- a/lib/asn1/test/Makefile +++ b/lib/asn1/test/Makefile @@ -26,7 +26,6 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk MODULES= \ h323test \ - choice_extension \ ber_decode_error \ testPrim \ testPrimStrings \ @@ -36,7 +35,6 @@ MODULES= \ testChoExtension \ testChoExternal \ testChoOptional \ - testChoOptionalImplicitTag \ testChoRecursive \ testChoTypeRefCho \ testChoTypeRefPrim \ @@ -51,12 +49,12 @@ MODULES= \ testSeqOptional \ testSeq2738 \ testSeqPrim \ + testSeqSetIndefinite \ testSeqTag \ testSeqTypeRefCho \ testSeqTypeRefPrim \ testSeqTypeRefSeq \ testSeqTypeRefSet \ - testSeqIndefinite \ testSeqOf \ testSeqOfIndefinite \ testSeqOfCho \ @@ -72,7 +70,6 @@ MODULES= \ testSetTypeRefPrim \ testSetTypeRefSeq \ testSetTypeRefSet \ - testSetIndefinite \ testChoiceIndefinite \ testSetOf \ testSetOfCho \ @@ -82,6 +79,7 @@ MODULES= \ testInfObjectClass \ testInfObj \ testParameterizedInfObj \ + testFragmented \ testMergeCompile \ testMultipleLevels \ testDeepTConstr \ @@ -99,7 +97,6 @@ MODULES= \ test_special_decode_performance \ testTCAP \ testSSLspecs \ - test_driver_load \ testSelectionTypes \ test_undecoded_rest \ testTcapsystem \ @@ -113,12 +110,9 @@ MODULES= \ asn1_test_lib \ asn1_app_test \ asn1_appup_test \ - asn1_wrapper \ asn1_SUITE \ error_SUITE -SUITE= asn1_SUITE.erl - ERL_FILES= $(MODULES:%=%.erl) HRL_FILES= External.hrl @@ -143,7 +137,7 @@ EBIN = . $(EMAKEFILE): $(ERL_FILES) $(HRL_FILES) $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) $(ERL_FILES) >$(EMAKEFILE) -tests debug opt: $(SUITE) $(SUITE_BIN) $(SUITE_BIN_V2) $(EMAKEFILE) +tests debug opt: $(EMAKEFILE) clean: rm -f core @@ -160,7 +154,7 @@ release_spec: opt release_tests_spec: opt $(INSTALL_DIR) "$(RELSYSDIR)" $(INSTALL_DIR) "$(RELSYSDIR)/asn1_SUITE_data" - $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) "$(RELSYSDIR)" + $(INSTALL_DATA) $(EMAKEFILE) $(ERL_FILES) $(HRL_FILES) "$(RELSYSDIR)" $(INSTALL_DATA) asn1.spec asn1.cover $(INSTALL_PROGS) "$(RELSYSDIR)" chmod -R u+w "$(RELSYSDIR)" cd asn1_SUITE_data; tar cfh "$(RELSYSDIR)/asn1_SUITE_data.tar" * diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index f00b23a8b2..83bd66a631 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -67,10 +67,10 @@ groups() -> {parallel, parallel([]), [cover, + xref, {group, ber}, % Uses 'P-Record', 'Constraints', 'MEDIA-GATEWAY-CONTROL'... {group, [], [parse, - test_driver_load, test_undecoded_rest, specialized_decodes, special_decode_performance, @@ -83,38 +83,24 @@ groups() -> {group, [], [testPrim, rtUI, testPrimStrings, - testInvokeMod, per, ber_other, der, - h323test, - per_GeneralString]}, + h323test]}, testChoPrim, testChoExtension, testChoOptional, - testChoOptionalImplicitTag, testChoRecursive, testChoTypeRefCho, testChoTypeRefPrim, testChoTypeRefSeq, testChoTypeRefSet, testMultipleLevels, - testDef, testOpt, testSeqDefault, % Uses 'External' - {group, [], [testChoExternal, - testPrimExternal, - testSeqExtension, - testSeqExternal, - testSeqOfExternal, - testSeqOfTag, - testSeqTag, - testSetExtension, - testSetExternal, - testSetOfExternal, - testSetOfTag, - testSetTag]}, + {group, [], [testExternal, + testSeqExtension]}, testSeqOptional, testSeqPrim, testSeqTypeRefCho, @@ -143,21 +129,20 @@ groups() -> % Uses 'Constructed' {group, [], [constructed, ber_decode_error]}, - % Uses 'SeqSetIndefinite' - {group, [], [testSeqIndefinite, - testSetIndefinite]}, + testSeqSetIndefinite, testChoiceIndefinite, per_open_type, testInfObjectClass, testParameterizedInfObj, + testFragmented, testMergeCompile, testobj, testDeepTConstr, testExport, testImport, - % Uses 'ParamBasic' - {group, [], [testParamBasic, - testDER]}, + testParamBasic, + testDER, + testDEFAULT, testMvrasn6, testContextSwitchingTypes, testOpenTypeImplicitTag, @@ -186,8 +171,7 @@ groups() -> {performance, [], [testTimer_ber, testTimer_per, - testTimer_uper, - smp]}]. + testTimer_uper]}]. parallel(Options) -> case erlang:system_info(smp_support) andalso @@ -284,13 +268,6 @@ replace_path(PathA, PathB) -> join(Rule, Opts) -> string:join([atom_to_list(Rule)|lists:map(fun atom_to_list/1, Opts)], "_"). -case_dir([], _Dir) -> - exit(no_case_dir); -case_dir([{case_dir, _}|Config], Dir) -> - [{case_dir, Dir}|Config]; -case_dir([C|Config], Opt) -> - [C|case_dir(Config, Opt)]. - %%------------------------------------------------------------------------------ %% Test cases %%------------------------------------------------------------------------------ @@ -319,7 +296,15 @@ cover(_) -> testPrim(Config) -> test(Config, fun testPrim/3). testPrim(Config, Rule, Opts) -> - asn1_test_lib:compile_all(["Prim", "Real"], Config, [Rule|Opts]), + Files = ["Prim","Real"], + asn1_test_lib:compile_all(Files, Config, [Rule|Opts]), + do_test_prim(Rule, false), + asn1_test_lib:compile_all(Files, Config, [no_ok_wrapper,Rule|Opts]), + do_test_prim(Rule, true). + +do_test_prim(Rule, NoOkWrapper) -> + io:format("No ok wrapper: ~p\n", [NoOkWrapper]), + put(no_ok_wrapper, NoOkWrapper), testPrim:bool(Rule), testPrim:int(Rule), testPrim:enum(Rule), @@ -340,37 +325,57 @@ testCompactBitString(Config, Rule, Opts) -> [Rule, compact_bit_string|Opts]), testCompactBitString:otp_4869(Rule). -testPrimStrings(Config) -> test(Config, fun testPrimStrings/3). +testPrimStrings(Config) -> + test(Config, fun testPrimStrings/3, [ber,{ber,[der]},per,uper]). testPrimStrings(Config, Rule, Opts) -> asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, [Rule|Opts]), - testPrimStrings_cases(Rule), + testPrimStrings_cases(Rule, Opts), asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, [legacy_bit_string,Rule|Opts]), - testPrimStrings:bit_string(Rule), + testPrimStrings:bit_string(Rule, Opts), asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, [compact_bit_string,Rule|Opts]), - testPrimStrings:bit_string(Rule), + testPrimStrings:bit_string(Rule, Opts), testPrimStrings:more_strings(Rule). -testPrimStrings_cases(Rule) -> - testPrimStrings:bit_string(Rule), +testPrimStrings_cases(Rule, Opts) -> + testPrimStrings:bit_string(Rule, Opts), testPrimStrings:octet_string(Rule), testPrimStrings:numeric_string(Rule), testPrimStrings:other_strings(Rule), testPrimStrings:universal_string(Rule), testPrimStrings:bmp_string(Rule), testPrimStrings:times(Rule), - testPrimStrings:utf8_string(Rule). + testPrimStrings:utf8_string(Rule), + testPrimStrings:fragmented(Rule). -testPrimExternal(Config) -> test(Config, fun testPrimExternal/3). -testPrimExternal(Config, Rule, Opts) -> - asn1_test_lib:compile_all(["External", "PrimExternal"], Config, - [Rule|Opts]), +testExternal(Config) -> test(Config, fun testExternal/3). +testExternal(Config, Rule, Opts) -> + asn1_test_lib:compile_all(["External", + "ChoExternal", + "PrimExternal", + "SeqExternal", + "SeqOfExternal", + "SeqOfTag", + "SeqTag", + "SetExtension", + "SetExternal", + "SetOfExternal", + "SetOfTag", + "SetTag"], + Config, [Rule|Opts]), + testChoExternal:external(Rule), testPrimExternal:external(Rule), - asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, - [Rule|Opts]), - testPrimStrings_cases(Rule), - testPrimStrings:more_strings(Rule). + testSeqExternal:main(Rule), + testSeqOfExternal:main(Rule), + testSeqOfTag:main(Rule), + testSeqTag:main(Rule), + testSetExtension:main(Rule), + testSetExternal:main(Rule), + testSetOfExternal:main(Rule), + testSetOfTag:main(Rule), + testSetTag:main(Rule). + testChoPrim(Config) -> test(Config, fun testChoPrim/3). testChoPrim(Config, Rule, Opts) -> @@ -383,23 +388,11 @@ testChoExtension(Config, Rule, Opts) -> asn1_test_lib:compile("ChoExtension", Config, [Rule|Opts]), testChoExtension:extension(Rule). -testChoExternal(Config) -> test(Config, fun testChoExternal/3). -testChoExternal(Config, Rule, Opts) -> - asn1_test_lib:compile_all(["External", "ChoExternal"], Config, [Rule|Opts]), - testChoExternal:external(Rule). - testChoOptional(Config) -> test(Config, fun testChoOptional/3). testChoOptional(Config, Rule, Opts) -> - asn1_test_lib:compile("ChoOptional", Config, [Rule|Opts]), - testChoOptional:optional(Rule). - -testChoOptionalImplicitTag(Config) -> - test(Config, fun testChoOptionalImplicitTag/3, - [ber]). -testChoOptionalImplicitTag(Config, Rule, Opts) -> - %% Only meaningful for ber & co - asn1_test_lib:compile("ChoOptionalImplicitTag", Config, [Rule|Opts]), - testChoOptionalImplicitTag:optional(Rule). + asn1_test_lib:compile_all(["ChoOptional", + "ChoOptionalImplicitTag"], Config, [Rule|Opts]), + testChoOptional:run(). testChoRecursive(Config) -> test(Config, fun testChoRecursive/3). testChoRecursive(Config, Rule, Opts) -> @@ -436,6 +429,13 @@ testDef(Config, Rule, Opts) -> asn1_test_lib:compile("Def", Config, [Rule|Opts]), testDef:main(Rule). +testDEFAULT(Config) -> + test(Config, fun testDEFAULT/3, [ber,{ber,[der]},per,uper]). +testDEFAULT(Config, Rule, Opts) -> + asn1_test_lib:compile_all(["Def","Default"], Config, [Rule|Opts]), + testDef:main(Rule), + testSeqSetDefaultVal:main(Rule, Opts). + testOpt(Config) -> test(Config, fun testOpt/3). testOpt(Config, Rule, Opts) -> asn1_test_lib:compile("Opt", Config, [Rule|Opts]), @@ -452,7 +452,7 @@ testSeqDefault(Config, Rule, Opts) -> asn1_test_lib:compile("SeqDefault", Config, [Rule|Opts]), testSeqDefault:main(Rule). -testSeqExtension(Config) -> test(Config, fun testSeqExtension/3). +testSeqExtension(Config) -> test(Config, fun testSeqExtension/3, [ber,uper]). testSeqExtension(Config, Rule, Opts) -> asn1_test_lib:compile_all(["External", "SeqExtension", @@ -462,11 +462,6 @@ testSeqExtension(Config, Rule, Opts) -> DataDir = ?config(data_dir, Config), testSeqExtension:main(Rule, DataDir, [Rule|Opts]). -testSeqExternal(Config) -> test(Config, fun testSeqExternal/3). -testSeqExternal(Config, Rule, Opts) -> - asn1_test_lib:compile_all(["External", "SeqExternal"], Config, [Rule|Opts]), - testSeqExternal:main(Rule). - testSeqOptional(Config) -> test(Config, fun testSeqOptional/3). testSeqOptional(Config, Rule, Opts) -> asn1_test_lib:compile("SeqOptional", Config, [Rule|Opts]), @@ -483,11 +478,6 @@ testSeq2738(Config, Rule, Opts) -> asn1_test_lib:compile("Seq2738", Config, [Rule|Opts]), testSeq2738:main(Rule). -testSeqTag(Config) -> test(Config, fun testSeqTag/3). -testSeqTag(Config, Rule, Opts) -> - asn1_test_lib:compile_all(["External", "SeqTag"], Config, [Rule|Opts]), - testSeqTag:main(Rule). - testSeqTypeRefCho(Config) -> test(Config, fun testSeqTypeRefCho/3). testSeqTypeRefCho(Config, Rule, Opts) -> asn1_test_lib:compile("SeqTypeRefCho", Config, [Rule|Opts]), @@ -528,38 +518,17 @@ testSeqOfIndefinite(Config, Rule, Opts) -> asn1_test_lib:compile_all(Files, Config, [Rule|Opts]), testSeqOfIndefinite:main(). -testSeqOfExternal(Config) -> test(Config, fun testSeqOfExternal/3). -testSeqOfExternal(Config, Rule, Opts) -> - asn1_test_lib:compile_all(["External", "SeqOfExternal"], Config, - [Rule|Opts]), - testSeqOfExternal:main(Rule). - -testSeqOfTag(Config) -> test(Config, fun testSeqOfTag/3). -testSeqOfTag(Config, Rule, Opts) -> - asn1_test_lib:compile_all(["External", "SeqOfTag"], Config, [Rule|Opts]), - testSeqOfTag:main(Rule). - testSetDefault(Config) -> test(Config, fun testSetDefault/3). testSetDefault(Config, Rule, Opts) -> asn1_test_lib:compile("SetDefault", Config, [Rule|Opts]), testSetDefault:main(Rule). -testParamBasic(Config) -> test(Config, fun testParamBasic/3). +testParamBasic(Config) -> + test(Config, fun testParamBasic/3, [ber,{ber,[der]},per,uper]). testParamBasic(Config, Rule, Opts) -> asn1_test_lib:compile("ParamBasic", Config, [Rule|Opts]), testParamBasic:main(Rule). -testSetExtension(Config) -> test(Config, fun testSetExtension/3). -testSetExtension(Config, Rule, Opts) -> - asn1_test_lib:compile_all(["External", "SetExtension"], Config, - [Rule|Opts]), - testSetExtension:main(Rule). - -testSetExternal(Config) -> test(Config, fun testSetExternal/3). -testSetExternal(Config, Rule, Opts) -> - asn1_test_lib:compile_all(["External", "SetExternal"], Config, [Rule|Opts]), - testSetExternal:main(Rule). - testSetOptional(Config) -> test(Config, fun testSetOptional/3). testSetOptional(Config, Rule, Opts) -> asn1_test_lib:compile("SetOptional", Config, [Rule|Opts]), @@ -571,11 +540,6 @@ testSetPrim(Config, Rule, Opts) -> asn1_test_lib:compile("SetPrim", Config, [Rule|Opts]), testSetPrim:main(Rule). -testSetTag(Config) -> test(Config, fun testSetTag/3). -testSetTag(Config, Rule, Opts) -> - asn1_test_lib:compile_all(["External", "SetTag"], Config, [Rule|Opts]), - testSetTag:main(Rule). - testSetTypeRefCho(Config) -> test(Config, fun testSetTypeRefCho/3). testSetTypeRefCho(Config, Rule, Opts) -> asn1_test_lib:compile("SetTypeRefCho", Config, [Rule|Opts]), @@ -606,17 +570,6 @@ testSetOfCho(Config, Rule, Opts) -> asn1_test_lib:compile("SetOfCho", Config, [Rule|Opts]), testSetOfCho:main(Rule). -testSetOfExternal(Config) -> test(Config, fun testSetOfExternal/3). -testSetOfExternal(Config, Rule, Opts) -> - asn1_test_lib:compile_all(["External", "SetOfExternal"], Config, - [Rule|Opts]), - testSetOfExternal:main(Rule). - -testSetOfTag(Config) -> test(Config, fun testSetOfTag/3). -testSetOfTag(Config, Rule, Opts) -> - asn1_test_lib:compile_all(["External", "SetOfTag"], Config, [Rule|Opts]), - testSetOfTag:main(Rule). - c_syntax(Config) -> DataDir = ?config(data_dir, Config), [{error, _} = asn1ct:compile(filename:join(DataDir, F)) @@ -714,10 +667,7 @@ ber_optional(Config, Rule, Opts) -> V = {'S', {'A', 10, asn1_NOVALUE, asn1_NOVALUE}, {'B', asn1_NOVALUE, asn1_NOVALUE, asn1_NOVALUE}, {'C', asn1_NOVALUE, 111, asn1_NOVALUE}}, - {ok, B} = asn1_wrapper:encode('SOpttest', 'S', V), - Bytes = lists:flatten(B), - V2 = asn1_wrapper:decode('SOpttest', 'S', Bytes), - V = element(2, V2). + asn1_test_lib:roundtrip('SOpttest', 'S', V). %% records used by test-case default -record('Def1', {bool0, @@ -728,14 +678,16 @@ ber_optional(Config, Rule, Opts) -> default(Config) -> test(Config, fun default/3). default(Config, Rule, Opts) -> asn1_test_lib:compile("Def", Config, [Rule|Opts]), - {ok, Bytes1} = asn1_wrapper:encode('Def', 'Def1', #'Def1'{bool0 = true}), - {ok, {'Def1', true, false, false, false}} = - asn1_wrapper:decode('Def', 'Def1', lists:flatten(Bytes1)), - - {ok, Bytes2} = asn1_wrapper:encode('Def', 'Def1', #'Def1'{bool0 = true, - bool2 = false}), - {ok, {'Def1', true, false, false, false}} = - asn1_wrapper:decode('Def', 'Def1', lists:flatten(Bytes2)). + asn1_test_lib:roundtrip('Def', + 'Def1', + #'Def1'{bool0=true}, + #'Def1'{bool0=true,bool1=false, + bool2=false,bool3=false}), + asn1_test_lib:roundtrip('Def', + 'Def1', + #'Def1'{bool0=true,bool2=false}, + #'Def1'{bool0=true,bool1=false, + bool2=false,bool3=false}). value_test(Config) -> test(Config, fun value_test/3). value_test(Config, Rule, Opts) -> @@ -747,12 +699,13 @@ constructed(Config) -> test(Config, fun constructed/3, [ber]). constructed(Config, Rule, Opts) -> asn1_test_lib:compile("Constructed", Config, [Rule|Opts]), - {ok, B} = asn1_wrapper:encode('Constructed', 'S', {'S', false}), - [40, 3, 1, 1, 0] = lists:flatten(B), - {ok, B1} = asn1_wrapper:encode('Constructed', 'S2', {'S2', false}), - [40, 5, 48, 3, 1, 1, 0] = lists:flatten(B1), - {ok, B2} = asn1_wrapper:encode('Constructed', 'I', 10), - [136, 1, 10] = lists:flatten(B2). + <<40,3,1,1,0>> = + asn1_test_lib:roundtrip_enc('Constructed', 'S', {'S',false}), + <<40,5,48,3,1,1,0>> = + asn1_test_lib:roundtrip_enc('Constructed', 'S2', {'S2',false}), + <<136,1,10>> = + asn1_test_lib:roundtrip_enc('Constructed', 'I', 10), + ok. ber_decode_error(Config) -> test(Config, fun ber_decode_error/3, [ber]). @@ -767,14 +720,6 @@ h323test(Config, Rule, Opts) -> asn1_test_lib:compile_all(Files, Config, [Rule|Opts]), h323test:run(Rule). -per_GeneralString(Config) -> - test(Config, fun per_GeneralString/3, [per]). -per_GeneralString(Config, Rule, Opts) -> - asn1_test_lib:compile("MULTIMEDIA-SYSTEM-CONTROL", Config, [Rule|Opts]), - UI = [109, 64, 1, 57], - {ok, _V} = asn1_wrapper:decode('MULTIMEDIA-SYSTEM-CONTROL', - 'MultimediaSystemControlMessage', UI). - per_open_type(Config) -> test(Config, fun per_open_type/3, [per]). per_open_type(Config, Rule, Opts) -> asn1_test_lib:compile("OpenType", Config, [Rule|Opts]), @@ -784,24 +729,17 @@ testConstraints(Config) -> test(Config, fun testConstraints/3). testConstraints(Config, Rule, Opts) -> asn1_test_lib:compile("Constraints", Config, [Rule|Opts]), asn1_test_lib:compile("LargeConstraints", Config, [Rule|Opts]), - testConstraints:int_constraints(Rule). - - -testSeqIndefinite(Config) -> - test(Config, fun testSeqIndefinite/3, [ber]). - -testSeqIndefinite(Config, Rule, Opts) -> - asn1_test_lib:compile("SeqSetIndefinite", Config, [Rule|Opts]), - testSeqIndefinite:main(Rule). - - -testSetIndefinite(Config) -> - test(Config, fun testSetIndefinite/3, [ber]). + testConstraints:int_constraints(Rule), + case Rule of + ber -> ok; + _ -> testConstraints:refed_NNL_name(Rule) + end. -testSetIndefinite(Config, Rule, Opts) -> +testSeqSetIndefinite(Config) -> + test(Config, fun testSeqSetIndefinite/3, [ber]). +testSeqSetIndefinite(Config, Rule, Opts) -> asn1_test_lib:compile("SeqSetIndefinite", Config, [Rule|Opts]), - testSetIndefinite:main(Rule). - + testSeqSetIndefinite:main(). testChoiceIndefinite(Config) -> test(Config, fun testChoiceIndefinite/3, [ber]). @@ -830,6 +768,12 @@ testParameterizedInfObj(Config, Rule, Opts) -> asn1_test_lib:compile_all(Files, Config, [Rule|Opts]), testParameterizedInfObj:main(Config, Rule). +testFragmented(Config) -> + test(Config, fun testFragmented/3). +testFragmented(Config, Rule, Opts) -> + asn1_test_lib:compile("Fragmented", Config, [Rule|Opts]), + testFragmented:main(Rule). + testMergeCompile(Config) -> test(Config, fun testMergeCompile/3). testMergeCompile(Config, Rule, Opts) -> Files = ["MS.set.asn", "RANAPSET.set.asn1", "Mvrasn4.set.asn", @@ -851,11 +795,6 @@ testDeepTConstr(Config, Rule, Opts) -> [Rule|Opts]), testDeepTConstr:main(Rule). -testInvokeMod(Config) -> test(Config, fun testInvokeMod/3). -testInvokeMod(Config, Rule, Opts) -> - asn1_test_lib:compile("PrimStrings", Config, [Rule|Opts]), - {ok, _Result2} = 'PrimStrings':encode('Bs1', [1, 0, 1, 0]). - testExport(Config) -> {error, _} = asn1ct:compile(filename:join(?config(data_dir, Config), @@ -911,7 +850,10 @@ duplicate_tags(Config) -> rtUI(Config) -> test(Config, fun rtUI/3). rtUI(Config, Rule, Opts) -> asn1_test_lib:compile("Prim", Config, [Rule|Opts]), - {ok, _} = asn1rt:info('Prim'). + {ok, _} = asn1rt:info('Prim'), + Rule = 'Prim':encoding_rule(), + io:format("Default BIT STRING format: ~p\n", + ['Prim':bit_string_format()]). testROSE(Config) -> test(Config, fun testROSE/3). testROSE(Config, Rule, Opts) -> @@ -939,11 +881,7 @@ testDER(Config) -> test(Config, fun testDER/3, [ber]). testDER(Config, Rule, Opts) -> asn1_test_lib:compile("DERSpec", Config, [Rule, der|Opts]), - testDER:test(), - asn1_test_lib:compile("ParamBasic", Config, [Rule, der|Opts]), - testParamBasic:main(der), - asn1_test_lib:compile("Default", Config, [Rule, der|Opts]), - testSeqSetDefaultVal:main(Rule). + testDER:test(). specialized_decodes(Config) -> test(Config, fun specialized_decodes/3, [ber]). @@ -965,13 +903,6 @@ special_decode_performance(Config, Rule, Opts) -> asn1_test_lib:compile_all(Files, Config, [Rule, asn1config|Opts]), test_special_decode_performance:go(all). - -test_driver_load(Config) -> - test(Config, fun test_driver_load/3, [per]). -test_driver_load(Config, Rule, Opts) -> - asn1_test_lib:compile("P-Record", Config, [Rule|Opts]), - test_driver_load:test(5). - test_ParamTypeInfObj(Config) -> asn1_test_lib:compile("IN-CS-1-Datatypes", Config, [ber]). @@ -989,7 +920,7 @@ test_Defed_ObjectIdentifier(Config, Rule, Opts) -> testSelectionType(Config) -> test(Config, fun testSelectionType/3). testSelectionType(Config, Rule, Opts) -> asn1_test_lib:compile("SelectionType", Config, [Rule|Opts]), - {ok, _} = testSelectionTypes:test(). + testSelectionTypes:test(). testSSLspecs(Config) -> test(Config, fun testSSLspecs/3, [ber]). @@ -1006,10 +937,14 @@ testNortel(Config, Rule, Opts) -> test_undecoded_rest(Config) -> test(Config, fun test_undecoded_rest/3). test_undecoded_rest(Config, Rule, Opts) -> + do_test_undecoded_rest(Config, Rule, Opts), + do_test_undecoded_rest(Config, Rule, [no_ok_wrapper|Opts]), + do_test_undecoded_rest(Config, Rule, [undec_rest|Opts]), + do_test_undecoded_rest(Config, Rule, [no_ok_wrapper,undec_rest|Opts]). + +do_test_undecoded_rest(Config, Rule, Opts) -> asn1_test_lib:compile("P-Record", Config, [Rule|Opts]), - ok = test_undecoded_rest:test([], Config), - asn1_test_lib:compile("P-Record", Config, [Rule,undec_rest|Opts]), - test_undecoded_rest:test(undec_rest, Config). + test_undecoded_rest:test(Opts, Config). testTcapsystem(Config) -> test(Config, fun testTcapsystem/3). @@ -1029,7 +964,20 @@ testS1AP(Config, Rule, Opts) -> "S1AP-IEs", "S1AP-PDU-Contents", "S1AP-PDU-Descriptions"], - asn1_test_lib:compile_all(S1AP, Config, [Rule|Opts]). + asn1_test_lib:compile_all(S1AP, Config, [Rule|Opts]), + + %% OTP-7876. + case Rule of + per -> + Enc = <<0,2,64,49,0,0,5,0,0,0,4,128,106,56,197,0,8,0,3,64,2,134,0, + 100,64,8,0,66,240,153,0,7,192,16,0,67,64,6,0,66,240,153,70, + 1,0,107,64,5,0,0,0,0,0>>, + {ok,{initiatingMessage,_}} = 'S1AP-PDU-Descriptions':decode('S1AP-PDU', Enc); + uper -> + ok; + ber -> + ok + end. test_compile_options(Config) -> ok = test_compile_options:wrong_path(Config), @@ -1061,24 +1009,38 @@ testX420(Config) -> "sparc-sun-solaris2.10" -> {skip,"Too slow for an old Sparc"}; _ -> - test(Config, fun testX420/3, [ber]) + Rule = ber, + testX420:compile(Rule, [der], Config), + ok = testX420:ticket7759(Rule, Config) end. -testX420(Config, Rule, Opts) -> - testX420:compile(Rule, [der|Opts], Config), - ok = testX420:ticket7759(Rule, Config), - testX420:compile(Rule, Opts, Config). test_x691(Config) -> test(Config, fun test_x691/3, [per, uper]). test_x691(Config, Rule, Opts) -> Files = ["P-RecordA1", "P-RecordA2", "P-RecordA3"], asn1_test_lib:compile_all(Files, Config, [Rule|Opts]), - test_x691:cases(Rule, case Rule of - uper -> unaligned; - _ -> aligned - end), - asn1_test_lib:ticket_7708(Config, []), - asn1_test_lib:ticket_7763(Config). + test_x691:cases(Rule), + + %% OTP-7708. + asn1_test_lib:compile("EUTRA-extract-55", Config, [Rule|Opts]), + + %% OTP-7763. + Val = {'Seq',15,lists:duplicate(8, 0),[0],lists:duplicate(28, 0),15,true}, + CompactVal = {'Seq',15,{0,<<0>>},{7,<<0>>},{4,<<0,0,0,0>>},15,true}, + {ok,Bin} = 'EUTRA-extract-55':encode('Seq', Val), + {ok,Bin} = 'EUTRA-extract-55':encode('Seq', CompactVal), + + %% OTP-7678. + asn1_test_lib:compile("UPERDefault", Config, [Rule|Opts]), + DefVal = 'UPERDefault':seq(), + {ok,DefBin} = 'UPERDefault':encode('Seq', DefVal), + {ok,DefVal} = 'UPERDefault':decode('Seq', DefBin), + case Rule of + uper -> <<0,6,0>> = DefBin; + _ -> ok + end, + + ok. ticket_6143(Config) -> ok = test_compile_options:ticket_6143(Config). @@ -1186,9 +1148,7 @@ testTimer_uper(Config) -> testComment(suite) -> []; testComment(Config) -> asn1_test_lib:compile("Comment", Config, []), - {ok,Enc} = asn1_wrapper:encode('Comment','Seq',{'Seq',12,true}), - {ok,{'Seq',12,true}} = asn1_wrapper:decode('Comment','Seq',Enc), - ok. + asn1_test_lib:roundtrip('Comment', 'Seq', {'Seq',12,true}). testName2Number(suite) -> []; testName2Number(Config) -> @@ -1224,76 +1184,67 @@ testName2Number(Config) -> ticket_7407(Config) -> asn1_test_lib:compile("EUTRA-extract-7407", Config, [uper]), - asn1_test_lib:ticket_7407_code(true), - - asn1_test_lib:compile("EUTRA-extract-7407", Config, - [uper, no_final_padding]), - asn1_test_lib:ticket_7407_code(false). - -smp(suite) -> []; -smp(Config) -> - case erlang:system_info(smp_support) of - true -> - NumOfProcs = erlang:system_info(schedulers), - io:format("smp starting ~p workers\n",[NumOfProcs]), - - Msg = {initiatingMessage, testNBAPsystem:cell_setup_req_msg()}, - ok = testNBAPsystem:compile(Config, [per]), - - enc_dec(NumOfProcs,Msg,2), - - N = 10000, - - {Time1,ok} = timer:tc(?MODULE,enc_dec,[NumOfProcs,Msg, N]), - {Time1S,ok} = timer:tc(?MODULE,enc_dec,[1, Msg, NumOfProcs * N]), - - ok = testNBAPsystem:compile(Config, [ber]), - {Time3,ok} = timer:tc(?MODULE,enc_dec,[NumOfProcs,Msg, N]), - - {Time3S,ok} = timer:tc(?MODULE,enc_dec,[1, Msg, NumOfProcs * N]), - - {comment,lists:flatten( - io_lib:format( - "Encode/decode time parallell with ~p cores: ~p [microsecs]~n" - "Encode/decode time sequential: ~p [microsecs]", - [NumOfProcs,Time1+Time3,Time1S+Time3S]))}; - false -> - {skipped,"No smp support"} - end. - -enc_dec(1, Msg, N) -> - worker_loop(N, Msg); -enc_dec(NumOfProcs,Msg, N) -> - pforeach(fun(_) -> - worker_loop(N, Msg) - end, [I || I <- lists:seq(1,NumOfProcs)]). - -worker_loop(0, _Msg) -> - ok; -worker_loop(N, Msg) -> - {ok,B}=asn1_wrapper:encode('NBAP-PDU-Discriptions', - 'NBAP-PDU', - Msg), - {ok,_Msg}=asn1_wrapper:decode('NBAP-PDU-Discriptions', - 'NBAP-PDU', - B), - worker_loop(N - 1, Msg). - - -pforeach(Fun, List) -> - pforeach(Fun, List, []). -pforeach(Fun, [], [{Pid,Ref}|Pids]) -> - receive - {'DOWN', Ref, process, Pid, normal} -> - pforeach(Fun, [], Pids) - end; -pforeach(Fun, [H|T], Pids) -> - Pid = spawn(fun() -> Fun(H) end), - Ref = erlang:monitor(process, Pid), - pforeach(Fun, T, [{Pid, Ref}|Pids]); -pforeach(_Fun,[],[]) -> + ticket_7407_code(true), + asn1_test_lib:compile("EUTRA-extract-7407", Config, [uper,no_final_padding]), + ticket_7407_code(false). + +ticket_7407_code(FinalPadding) -> + Msg1 = {Type1,_} = eutra1(msg), + {ok,B1} = 'EUTRA-extract-7407':encode(Type1, Msg1), + B1 = eutra1(result, FinalPadding), + + Msg2 = {Type2,_} = eutra2(msg), + {ok,B2} = 'EUTRA-extract-7407':encode(Type2, Msg2), + B2 = eutra2(result, FinalPadding), ok. +eutra1(msg) -> + {'BCCH-BCH-Message', + {'MasterInformationBlock',[0,1,0,1],[1,0,1,0], + {'PHICH-Configuration',short,ffs},[1,0,1,0,0,0,0,0]}}. + +eutra1(result, true) -> + <<90,80,0>>; +eutra1(result, false) -> + <<90,80,0:1>>. + +eutra2(msg) -> + {'BCCH-DL-SCH-Message', + {c1, + {systemInformation1, + {'SystemInformationBlockType1', + {'SystemInformationBlockType1_cellAccessRelatedInformation', + [{'SystemInformationBlockType1_cellAccessRelatedInformation_plmn-IdentityList_SEQOF', + {'PLMN-Identity'},true}, + {'SystemInformationBlockType1_cellAccessRelatedInformation_plmn-IdentityList_SEQOF', + {'PLMN-Identity'},false}, + {'SystemInformationBlockType1_cellAccessRelatedInformation_plmn-IdentityList_SEQOF', + {'PLMN-Identity'},true}], + {'TrackingAreaCode'}, + {'CellIdentity'}, + false, + true, + true, + true + }, + {'SystemInformationBlockType1_cellSelectionInfo',-50}, + 24, + [{'SystemInformationBlockType1_schedulinInformation_SEQOF', + {'SystemInformationBlockType1_schedulinInformation_SEQOF_si-MessageType'}, + ms320, + {'SystemInformationBlockType1_schedulinInformation_SEQOF_sib-MappingInfo'}}], + 0 + } + } + } + }. + +eutra2(result, true) -> +%% 55 5C A5 E0 + <<85,92,165,224>>; +eutra2(result, false) -> + <<85,92,165,14:4>>. + -record('InitiatingMessage',{procedureCode,criticality,value}). -record('Iu-ReleaseCommand',{first,second}). @@ -1308,3 +1259,17 @@ ticket7904(Config) -> {ok,_} = 'RANAPextract1':encode('InitiatingMessage', Val1), {ok,_} = 'RANAPextract1':encode('InitiatingMessage', Val1). + +xref(_Config) -> + xref:start(s), + xref:set_default(s, [{verbose,false},{warnings,false},{builtins,true}]), + Test = filename:dirname(code:which(?MODULE)), + {ok,_PMs} = xref:add_directory(s, Test), + UnusedExports = "X - XU - asn1_appup_test - asn1_app_test - \".*_SUITE\" : Mod", + case xref:q(s, UnusedExports) of + {ok,[]} -> + ok; + {ok,[_|_]=Res} -> + io:format("Exported, but unused: ~p\n", [Res]), + ?t:fail() + end. diff --git a/lib/asn1/test/asn1_SUITE_data/Constraints.py b/lib/asn1/test/asn1_SUITE_data/Constraints.py index e4bc987e4c..581ec2f467 100644 --- a/lib/asn1/test/asn1_SUITE_data/Constraints.py +++ b/lib/asn1/test/asn1_SUITE_data/Constraints.py @@ -17,6 +17,11 @@ NegSemiConstrained ::= INTEGER (-128..MAX) SemiConstrainedExt ::= INTEGER (42..MAX, ...) NegSemiConstrainedExt ::= INTEGER (-128..MAX, ...) +-- Union of single values +Sv1 ::= INTEGER (2|3|17) +Sv2 ::= INTEGER (2|3|17, ...) +Sv3 ::= INTEGER {a(2),b(3),z(17)} (2|3|17, ...) + -- Other constraints FixedSize ::= OCTET STRING (SIZE(10)) FixedSize2 ::= OCTET STRING (SIZE(10|20)) diff --git a/lib/asn1/test/asn1_SUITE_data/Default.asn b/lib/asn1/test/asn1_SUITE_data/Default.asn index 6604953c1f..168ce50bb2 100644 --- a/lib/asn1/test/asn1_SUITE_data/Default.asn +++ b/lib/asn1/test/asn1_SUITE_data/Default.asn @@ -21,7 +21,8 @@ SeqBS ::= SEQUENCE { a BIT STRING DEFAULT '1010110'B, b BIT STRING DEFAULT 'A8A'H, c BIT STRING {first(0),second(1),third(2)} DEFAULT {second}, - d BIT STRING DEFAULT onelist + d BIT STRING DEFAULT onelist, + e BIT STRING DEFAULT '01011010'B } SetBS ::= SET { diff --git a/lib/asn1/test/asn1_SUITE_data/Fragmented.asn1 b/lib/asn1/test/asn1_SUITE_data/Fragmented.asn1 new file mode 100644 index 0000000000..bfc939737f --- /dev/null +++ b/lib/asn1/test/asn1_SUITE_data/Fragmented.asn1 @@ -0,0 +1,24 @@ +Fragmented DEFINITIONS AUTOMATIC TAGS ::= +BEGIN + +FUNCTION ::= CLASS { + &code INTEGER UNIQUE, + &b BOOLEAN, + &ArgumentType +} + +SS ::= SEQUENCE OF OCTET STRING + +val1 FUNCTION ::= { + &code 1, &b FALSE, &ArgumentType SS +} + +ObjSet FUNCTION ::= { val1 } + +PDU ::= SEQUENCE { + code FUNCTION.&code ({ObjSet}), + b FUNCTION.&b ({ObjSet}{@code}), + arg FUNCTION.&ArgumentType ({ObjSet}{@code}) +} + +END diff --git a/lib/asn1/test/asn1_SUITE_data/InfObj.asn b/lib/asn1/test/asn1_SUITE_data/InfObj.asn index 53e5043cb7..880e81c3b1 100644 --- a/lib/asn1/test/asn1_SUITE_data/InfObj.asn +++ b/lib/asn1/test/asn1_SUITE_data/InfObj.asn @@ -202,7 +202,11 @@ constructed2 CONSTRUCTED-DEFAULT ::= { &id 2, &ok false } ConstructedDefaultSet CONSTRUCTED-DEFAULT ::= { constructed1 | constructed2 | - { &id 3, &Type BOOLEAN } + { &id 3, &Type BOOLEAN } | + { &id 4, &Type SET { a INTEGER, b BIT STRING } } | + { &id 5, &Type CHOICE { i INTEGER, b BIT STRING } } | + { &id 6, &Type SEQUENCE OF INTEGER (1..16) } | + { &id 7, &Type SET OF INTEGER (1..64) } } ConstructedPdu ::= SEQUENCE { @@ -210,6 +214,47 @@ ConstructedPdu ::= SEQUENCE { content CONSTRUCTED-DEFAULT.&Type ({ConstructedDefaultSet}{@id}) } +ConstructedSet ::= SET { + id [0] CONSTRUCTED-DEFAULT.&id ({ConstructedDefaultSet}), + content [1] CONSTRUCTED-DEFAULT.&Type ({ConstructedDefaultSet}{@id}) +} + +-- Test OPTIONAL and DEFAULT + +OptionalInSeq ::= SEQUENCE { + id CONSTRUCTED-DEFAULT.&id ({ConstructedDefaultSet}), + content CONSTRUCTED-DEFAULT.&Type ({ConstructedDefaultSet}{@id}) OPTIONAL +} + +DefaultInSeq ::= SEQUENCE { + id CONSTRUCTED-DEFAULT.&id ({ConstructedDefaultSet}), + content CONSTRUCTED-DEFAULT.&Type ({ConstructedDefaultSet}{@id}) + DEFAULT BOOLEAN:TRUE +} + +-- Test more than one optional typefield table constraint in a SEQUENCE. + +MULTIPLE-OPTIONALS ::= CLASS { + &id INTEGER UNIQUE, + &T1, + &T2, + &T3 +} + +multiple-optionals-1 MULTIPLE-OPTIONALS ::= + {&id 1, &T1 INTEGER, &T2 BOOLEAN, &T3 OCTET STRING} + +Multiple-Optionals-Set MULTIPLE-OPTIONALS ::= { + multiple-optionals-1 +} + +Multiple-Optionals ::= SEQUENCE { + id MULTIPLE-OPTIONALS.&id ({Multiple-Optionals-Set}), + t1 [0] MULTIPLE-OPTIONALS.&T1 ({Multiple-Optionals-Set}{@id}) OPTIONAL, + t2 [1] MULTIPLE-OPTIONALS.&T2 ({Multiple-Optionals-Set}{@id}) OPTIONAL, + t3 [2] MULTIPLE-OPTIONALS.&T3 ({Multiple-Optionals-Set}{@id}) OPTIONAL +} + END diff --git a/lib/asn1/test/asn1_SUITE_data/Param.asn1 b/lib/asn1/test/asn1_SUITE_data/Param.asn1 index b2987a7885..4eff0da781 100644 --- a/lib/asn1/test/asn1_SUITE_data/Param.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/Param.asn1 @@ -88,6 +88,28 @@ POS2 {CONFIG-DATA:obj} ::= OCTET STRING (SIZE(obj.&minLevel .. obj.&maxLevel)) OS2 ::= POS2 {config-data} +-- +-- Test a CLASS without the user-friendly syntax. +-- + +CL ::= CLASS { + &code INTEGER UNIQUE, + &Data +} + +P{T} ::= CHOICE { a INTEGER, b T } + +o1 CL ::= { + &code 42, + &Data P{BOOLEAN} +} + +SetCL CL ::= { o1 } + +Scl ::= SEQUENCE { + code CL.&code ({SetCL}), + data CL.&Data ({SetCL}{@code}) +} END diff --git a/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 b/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 index 08e7f94ab6..a5b4c8a53d 100644 --- a/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 @@ -46,7 +46,13 @@ BS256 ::= BIT STRING (SIZE (256)) BS1024 ::= BIT STRING (SIZE (1024)) - + BsDef1 ::= SEQUENCE { + s BIT STRING DEFAULT '101111'B + } + + BsDef2 ::= SEQUENCE { + s BIT STRING DEFAULT 'DEADBEEF'H + } Os ::= OCTET STRING OsCon ::= [60] OCTET STRING diff --git a/lib/asn1/test/asn1_SUITE_data/SeqOf.asn1 b/lib/asn1/test/asn1_SUITE_data/SeqOf.asn1 index 888dbe5dd7..670f827f5e 100644 --- a/lib/asn1/test/asn1_SUITE_data/SeqOf.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/SeqOf.asn1 @@ -31,7 +31,43 @@ Seq4 ::= SEQUENCE seq43 [43] SEQUENCE OF SeqIn DEFAULT {} } +Seq5 ::= SEQUENCE { + b BOOLEAN, + s SEQUENCE SIZE (0..3) OF OCTET STRING (SIZE (0..3)), + -- If 's' is empty, 'magic' should not be aligned. + magic INTEGER (0..127) +} + +Seq6 ::= SEQUENCE { + a SEQUENCE OF INTEGER (0..7), + b SEQUENCE (SIZE (0..7)) OF INTEGER (0..7), + -- 'magic' should never be aligned. + magic INTEGER (0..127) +} +Seq7 ::= SEQUENCE { + a SEQUENCE OF INTEGER (1..512), + b SEQUENCE (SIZE (0..255)) OF INTEGER (1..512), + i INTEGER +} + +Seq8 ::= SEQUENCE { + sof SEQUENCE (SIZE (0..3)) OF OCTET STRING (SIZE (3)), + -- Not aligned here if the size of 'sof' is zero. + i INTEGER (0..127) +} + +Seq9 ::= SEQUENCE { + b BOOLEAN, + s SEQUENCE SIZE (0..3) OF OCTET STRING (SIZE (0..3)), + magic INTEGER (0..127) +} + +Seq10 ::= SEQUENCE { + b BOOLEAN, + s SEQUENCE SIZE (1..3) OF OCTET STRING (SIZE (0..3)), + magic INTEGER (0..127) +} SeqIn ::= SEQUENCE { @@ -50,9 +86,6 @@ SeqCho ::= SEQUENCE OF CHOICE {bool BOOLEAN, SeqOfInt ::= SEQUENCE OF INTEGER - - - SeqEmp ::= SEQUENCE { seq1 SEQUENCE OF Empty DEFAULT {} diff --git a/lib/asn1/test/asn1_SUITE_data/TConstr.asn1 b/lib/asn1/test/asn1_SUITE_data/TConstr.asn1 index e2e0a11dc4..b2b2de2f56 100644 --- a/lib/asn1/test/asn1_SUITE_data/TConstr.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/TConstr.asn1 @@ -58,6 +58,40 @@ Deeper ::= SEQUENCE { b SEQUENCE {ba INTEGER, bb MYCLASS.&Type ({ObjectSet}{@a.s.ab})} } +Seq3 ::= SEQUENCE { + a SEQUENCE { + aa INTEGER, + ab MYCLASS.&id ({ObjectSet}) + }, + -- Multiple references from the same SEQUENCE... + b SEQUENCE { + ba MYCLASS.&Type ({ObjectSet}{@a.ab}), + bb MYCLASS.&Result ({ObjectSet}{@a.ab}), + -- ... and references from multiple SEQUENCEs... + bc SEQUENCE { + bca MYCLASS.&Result ({ObjectSet}{@a.ab}), + bcb MYCLASS.&Type ({ObjectSet}{@a.ab}) + } + } +} + +Seq3-Opt ::= SEQUENCE { + a SEQUENCE { + aa INTEGER, + ab MYCLASS.&id ({ObjectSet}) + }, + -- Multiple references from the same SEQUENCE... + b SEQUENCE { + ba MYCLASS.&Type ({ObjectSet}{@a.ab}) OPTIONAL, + bb MYCLASS.&Result ({ObjectSet}{@a.ab}) OPTIONAL, + -- ... and references from multiple SEQUENCEs... + bc SEQUENCE { + bca MYCLASS.&Result ({ObjectSet}{@a.ab}), + bcb MYCLASS.&Type ({ObjectSet}{@a.ab}) + } OPTIONAL + } +} + -- following from Peter's definitions diff --git a/lib/asn1/test/asn1_SUITE_data/UPERDefault.asn b/lib/asn1/test/asn1_SUITE_data/UPERDefault.asn new file mode 100644 index 0000000000..7b81a0e09f --- /dev/null +++ b/lib/asn1/test/asn1_SUITE_data/UPERDefault.asn @@ -0,0 +1,18 @@ +UPERDefault DEFINITIONS AUTOMATIC TAGS ::= + +BEGIN + +-- OTP-7681 +Int ::= INTEGER (0..32767) + +Seq ::= SEQUENCE { + a Int, + b INTEGER (-27..27) DEFAULT 0, -- OTP-7678 + c INTEGER OPTIONAL +} + +seq Seq ::= +{a 12, + b 0} + +END
\ No newline at end of file diff --git a/lib/asn1/test/asn1_test_lib.erl b/lib/asn1/test/asn1_test_lib.erl index 60b2b2b42e..417380159e 100644 --- a/lib/asn1/test/asn1_test_lib.erl +++ b/lib/asn1/test/asn1_test_lib.erl @@ -19,13 +19,9 @@ %% -module(asn1_test_lib). --export([compile/3]). --export([compile_all/3]). --export([compile_erlang/3]). --export([hex_to_bin/1]). - --export([ticket_7407_compile/2,ticket_7407_code/1, ticket_7678/2, - ticket_7708/2, ticket_7763/1, ticket_7876/3]). +-export([compile/3,compile_all/3,compile_erlang/3, + hex_to_bin/1, + roundtrip/3,roundtrip/4,roundtrip_enc/3,roundtrip_enc/4]). -include_lib("test_server/include/test_server.hrl"). @@ -40,15 +36,7 @@ compile_all(Files, Config, Options) -> compile_file(File, Options) -> try - ok = asn1ct:compile(File, [warnings_as_errors|Options]), - case should_load(File, Options) of - false -> - ok; - {module, Module} -> - code:purge(Module), - {module, Module} = code:load_file(Module), - code:purge(Module) - end + ok = asn1ct:compile(File, [warnings_as_errors|Options]) catch Class:Reason -> ct:print("Failed to compile ~s\n", [File]), @@ -65,153 +53,26 @@ compile_erlang(Mod, Config, Options) -> hex_to_bin(S) -> << <<(hex2num(C)):4>> || C <- S, C =/= $\s >>. -%%% -%%% Internal functions. -%%% +roundtrip(Mod, Type, Value) -> + roundtrip(Mod, Type, Value, Value). -should_load(File, Options) -> - case lists:member(abs, Options) of - true -> - false; - false -> - {module,list_to_atom(strip_extension(filename:basename(File)))} - end. +roundtrip(Mod, Type, Value, ExpectedValue) -> + {ok,Encoded} = Mod:encode(Type, Value), + {ok,ExpectedValue} = Mod:decode(Type, Encoded), + ok. -strip_extension(File) -> - strip_extension(File, filename:extension(File)). +roundtrip_enc(Mod, Type, Value) -> + roundtrip_enc(Mod, Type, Value, Value). -strip_extension(File, "") -> - File; -strip_extension(File, Ext) when Ext == ".asn"; Ext == ".set"; Ext == ".asn1"-> - strip_extension(filename:rootname(File)); -strip_extension(File, _Ext) -> - File. +roundtrip_enc(Mod, Type, Value, ExpectedValue) -> + {ok,Encoded} = Mod:encode(Type, Value), + {ok,ExpectedValue} = Mod:decode(Type, Encoded), + Encoded. + +%%% +%%% Internal functions. +%%% hex2num(C) when $0 =< C, C =< $9 -> C - $0; hex2num(C) when $A =< C, C =< $F -> C - $A + 10; hex2num(C) when $a =< C, C =< $f -> C - $a + 10. - -ticket_7407_compile(Config,Option) -> - - ?line DataDir = ?config(data_dir,Config), - ?line OutDir = ?config(priv_dir,Config), - - ?line ok = asn1ct:compile(DataDir ++ "EUTRA-extract-7407", - [uper, {outdir,OutDir}]++Option). - -ticket_7708(Config,Option) -> - ?line DataDir = ?config(data_dir,Config), - ?line OutDir = ?config(priv_dir,Config), - - ?line ok = asn1ct:compile(DataDir ++ "EUTRA-extract-55", - [uper, {outdir,OutDir}]++Option). - - -ticket_7407_code(FinalPadding) -> - Msg1 = {Type1,_} = eutra1(msg), - ?line {ok,B1} = 'EUTRA-extract-7407':encode(Type1,Msg1), - ?line B1 = eutra1(result,FinalPadding), - - Msg2 = {Type2,_} = eutra2(msg), - ?line {ok,B2} = 'EUTRA-extract-7407':encode(Type2,Msg2), - ?line B2 = eutra2(result,FinalPadding), - ok. - -eutra1(msg) -> - {'BCCH-BCH-Message',{'MasterInformationBlock',[0,1,0,1],[1,0,1,0],{'PHICH-Configuration',short,ffs},[1,0,1,0,0,0,0,0]}}. -eutra1(result,true) -> - <<90,80,0>>; -eutra1(result,false) -> - <<90,80,0:1>>. - -eutra2(msg) -> - {'BCCH-DL-SCH-Message', - {c1, - {systemInformation1, - {'SystemInformationBlockType1', - {'SystemInformationBlockType1_cellAccessRelatedInformation', - [{'SystemInformationBlockType1_cellAccessRelatedInformation_plmn-IdentityList_SEQOF',{'PLMN-Identity'},true}, - {'SystemInformationBlockType1_cellAccessRelatedInformation_plmn-IdentityList_SEQOF',{'PLMN-Identity'},false}, - {'SystemInformationBlockType1_cellAccessRelatedInformation_plmn-IdentityList_SEQOF',{'PLMN-Identity'},true}], - {'TrackingAreaCode'}, - {'CellIdentity'}, - false, - true, - true, - true - }, - {'SystemInformationBlockType1_cellSelectionInfo',-50}, - 24, - [{'SystemInformationBlockType1_schedulinInformation_SEQOF', - {'SystemInformationBlockType1_schedulinInformation_SEQOF_si-MessageType'}, - ms320, - {'SystemInformationBlockType1_schedulinInformation_SEQOF_sib-MappingInfo'}}], - 0 - } - } - } - }. -eutra2(result,true) -> -%% 55 5C A5 E0 - <<85,92,165,224>>; -eutra2(result,false) -> - <<85,92,165,14:4>>. - - - -ticket_7678(Config, Option) -> - ?line DataDir = ?config(data_dir,Config), - ?line OutDir = ?config(priv_dir,Config), - - ?line ok = asn1ct:compile(DataDir ++ "UPERDefault", - [uper, {outdir,OutDir}]++Option), - - ?line Val = 'UPERDefault':seq(), - ?line {ok,<<0,6,0>>} = 'UPERDefault':encode('Seq',Val), - ?line {ok,Val} = 'UPERDefault':decode('Seq',<<0,6,0>>), - ok. - - -ticket_7763(Config) -> - ?line DataDir = ?config(data_dir,Config), - ?line OutDir = ?config(priv_dir,Config), - - ?line ok = asn1ct:compile(DataDir ++ "EUTRA-extract-55", - [uper, {outdir,OutDir}]), - Val = {'Seq',15,lists:duplicate(8,0),[0],lists:duplicate(28,0),15,true}, - ?line {ok,Bin} = 'EUTRA-extract-55':encode('Seq',Val), - - ?line ok = asn1ct:compile(DataDir ++ "EUTRA-extract-55", - [uper,compact_bit_string,{outdir,OutDir}]), - CompactVal = {'Seq',15,{0,<<0>>},{7,<<0>>},{4,<<0,0,0,0>>},15,true}, - {ok,CompactBin} = 'EUTRA-extract-55':encode('Seq',CompactVal), - - ?line Bin = CompactBin, - - io:format("CompactBin:~n~p~nBin:~n~p~nCompactBin == Bin is ~p~n",[CompactBin,Bin,CompactBin == Bin]). - - -ticket_7876(Config,Erule,Options) -> - ?line DataDir = ?config(data_dir,Config), - ?line OutDir = ?config(priv_dir,Config), - - ?line ok = asn1ct:compile(DataDir ++ "S1AP-CommonDataTypes", - [Erule,{outdir,OutDir}|Options]), - ?line ok = asn1ct:compile(DataDir ++ "S1AP-Constants", - [Erule,{outdir,OutDir}|Options]), -?line ok = asn1ct:compile(DataDir ++ "S1AP-Containers", - [Erule,{outdir,OutDir}|Options]), -?line ok = asn1ct:compile(DataDir ++ "S1AP-IEs", - [Erule,{outdir,OutDir}|Options]), -?line ok = asn1ct:compile(DataDir ++ "S1AP-PDU-Contents", - [Erule,{outdir,OutDir}|Options]), -?line ok = asn1ct:compile(DataDir ++ "S1AP-PDU-Descriptions", - [Erule,{outdir,OutDir}|Options]), - - ticket_7876_encdec(Erule), - ok. - -ticket_7876_encdec(per) -> - ?line {ok,{initiatingMessage,_}} = 'S1AP-PDU-Descriptions':decode('S1AP-PDU', [0,2,64,49,0,0,5,0,0,0,4,128,106,56,197,0,8,0,3,64,2,134,0,100,64,8,0,66,240,153,0,7,192,16,0,67,64,6,0,66,240,153,70,1,0,107,64,5,0,0,0,0,0]); -ticket_7876_encdec(_) -> - ?line {ok,{initiatingMessage,_}} = 'S1AP-PDU-Descriptions':decode('S1AP-PDU', <<0,2,64,49,0,0,5,0,0,0,4,128,106,56,197,0,8,0,3,64,2,134,0,100,64,8,0,66,240,153,0,7,192,16,0,67,64,6,0,66,240,153,70,1,0,107,64,5,0,0,0,0,0>>). diff --git a/lib/asn1/test/asn1_wrapper.erl b/lib/asn1/test/asn1_wrapper.erl deleted file mode 100644 index ac194fe38b..0000000000 --- a/lib/asn1/test/asn1_wrapper.erl +++ /dev/null @@ -1,49 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% -%% --module(asn1_wrapper). --author('kenneth@bilbo'). - --compile(export_all). -%%-export([Function/Arity, ...]). - - -encode(Module,Type,Value) -> - case asn1rt:encode(Module,Type,Value) of - {ok,X} when is_binary(X) -> - {ok, binary_to_list(X)}; - {ok,X} -> - {ok, binary_to_list(list_to_binary(X))}; - Error -> - Error - end. - -decode(Module, Type, Bytes) when is_binary(Bytes) -> - asn1rt:decode(Module, Type, Bytes); -decode(Module, Type, Bytes) when is_list(Bytes) -> - asn1rt:decode(Module, Type, list_to_binary(Bytes)). - -erule(ber) -> - ber; -erule(per) -> - per; -erule(uper) -> - per. - - diff --git a/lib/asn1/test/ber_decode_error.erl b/lib/asn1/test/ber_decode_error.erl index 1c4b4c6894..8be92292ee 100644 --- a/lib/asn1/test/ber_decode_error.erl +++ b/lib/asn1/test/ber_decode_error.erl @@ -22,15 +22,15 @@ -export([run/1]). run([]) -> - {ok,B} = asn1_wrapper:encode('Constructed','S3',{'S3',17}), - [T,L|V] = lists:flatten(B), - Bytes = [T,L+3|V] ++ [2,1,3], - case asn1_wrapper:decode('Constructed','S3',Bytes) of + {ok,B} = 'Constructed':encode('S3', {'S3',17}), + [T,L|V] = binary_to_list(B), + Bytes = list_to_binary([T,L+3|V] ++ [2,1,3]), + case 'Constructed':decode('S3', Bytes) of {error,{asn1,{unexpected,_}}} -> ok end, %% Unexpected bytes must be accepted if there is an extensionmark - {ok,{'S3ext',17}} = asn1_wrapper:decode('Constructed','S3ext',Bytes), + {ok,{'S3ext',17}} = 'Constructed':decode('S3ext', Bytes), %% Truncated tag. {error,{asn1,{invalid_tag,_}}} = diff --git a/lib/asn1/test/choice_extension.erl b/lib/asn1/test/choice_extension.erl deleted file mode 100644 index 85e0936ebf..0000000000 --- a/lib/asn1/test/choice_extension.erl +++ /dev/null @@ -1,37 +0,0 @@ -%% -%% %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% -%% -%% --module(choice_extension). - --export([run/0, compile/3]). - --include_lib("test_server/include/test_server.hrl"). - -compile(Config,Rules,Options) -> - - ?line DataDir = ?config(data_dir,Config), - ?line OutDir = ?config(priv_dir,Config), - ?line true = code:add_patha(?config(priv_dir,Config)), - ?line ok = asn1ct:compile(DataDir ++ "ChoExtension",[Rules,{outdir,OutDir}]++Options). - -run() -> - Val = {str,"abc"}, - ?line {ok,B} = asn1_wrapper:encode('ChoExtension','ChoExt4',Val), - ?line {ok,Val} = asn1_wrapper:decode('ChoExtension','ChoExt4',lists:flatten(B)), - ok. diff --git a/lib/asn1/test/error_SUITE.erl b/lib/asn1/test/error_SUITE.erl index a94a6d95a0..6451f81c01 100644 --- a/lib/asn1/test/error_SUITE.erl +++ b/lib/asn1/test/error_SUITE.erl @@ -19,7 +19,7 @@ -module(error_SUITE). -export([suite/0,all/0,groups/0, - already_defined/1,enumerated/1]). + already_defined/1,enumerated/1,objects/1]). -include_lib("test_server/include/test_server.hrl"). @@ -30,7 +30,8 @@ all() -> groups() -> [{p,parallel(),[already_defined, - enumerated]}]. + enumerated, + objects]}]. parallel() -> case erlang:system_info(schedulers) > 1 of @@ -95,6 +96,48 @@ enumerated(Config) -> } = run(P, Config), ok. +objects(Config) -> + M = 'Objects', + P = {M, + <<"Objects DEFINITIONS AUTOMATIC TAGS ::= BEGIN\n" + " obj1 CL ::= { &wrong 42 }\n" + " obj2 CL ::= { &wrong 1, &Wrong INTEGER }\n" + " obj3 CL ::= { &Data OCTET STRING }\n" + " obj4 SMALL ::= { &code 42 }\n" + " InvalidSet CL ::= { obj1 }\n" + + " CL ::= CLASS {\n" + " &code INTEGER UNIQUE,\n" + " &enum ENUMERATED { a, b, c},\n" + " &Data,\n" + " &object CL,\n" + " &Set CL,\n" + " &vartypevalue &Data,\n" + " &VarTypeValue &Data\n" + " }\n" + + " SMALL ::= CLASS {\n" + " &code INTEGER UNIQUE,\n" + " &i INTEGER\n" + " }\n" + "END\n">>}, + {error, + [ + {structured_error,{M,2},asn1ct_check, + {invalid_fields,[wrong],obj1}}, + {structured_error,{M,3},asn1ct_check, + {invalid_fields,['Wrong',wrong],obj2}}, + {structured_error,{M,4},asn1ct_check, + {missing_mandatory_fields,['Set','VarTypeValue',code, + enum,object,vartypevalue],obj3}}, + {structured_error,{M,5},asn1ct_check, + {missing_mandatory_fields,[i],obj4}}, + {structured_error,{M,6},asn1ct_check, + {invalid_fields,[wrong],'InvalidSet'}} + ] + } = run(P, Config), + ok. + run({Mod,Spec}, Config) -> diff --git a/lib/asn1/test/h323test.erl b/lib/asn1/test/h323test.erl index 426ae16994..3baaa994ea 100644 --- a/lib/asn1/test/h323test.erl +++ b/lib/asn1/test/h323test.erl @@ -26,44 +26,62 @@ run(per) -> run(); run(_Rules) -> ok. run() -> - alerting(), - connect(), + roundtrip('H323-UserInformation', alerting_val(), alerting_enc()), + roundtrip('H323-UserInformation', connect_val(), connect_enc()), + general_string(), ok. -dec_alerting() -> - Cs = "0380060008914a0002020120110000000000000000000000000000000000", - ByteList = hexstr2bytes(Cs), - asn1_wrapper:decode('H323-MESSAGES','H323-UserInformation',ByteList). +alerting_val() -> + {'H323-UserInformation', + {'H323-UU-PDU', + {alerting, + {'Alerting-UUIE', + {0,0,8,2250,0,2}, + {'EndpointType',asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE, + asn1_NOVALUE,asn1_NOVALUE, + {'TerminalInfo',asn1_NOVALUE}, + false,false}, + asn1_NOVALUE, + {'CallIdentifier',[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]}, + asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}}, + asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}, + asn1_NOVALUE}. -enc_alerting(V) -> - asn1_wrapper:encode('H323-MESSAGES','H323-UserInformation',V). +alerting_enc() -> + "0380060008914a0002020120110000000000000000000000000000000000". -alerting() -> - {ok,V} = dec_alerting(), - {ok,B} = enc_alerting(V), - ByteList = lists:flatten(B), - {ok,V} = asn1_wrapper:decode('H323-MESSAGES','H323-UserInformation',ByteList). +connect_val() -> + {'H323-UserInformation', + {'H323-UU-PDU', + {connect, + {'Connect-UUIE', + {0,0,8,2250,0,2}, + {ipAddress, + {'TransportAddress_ipAddress',[136,225,41,58],1187}}, + {'EndpointType',asn1_NOVALUE, + {'VendorIdentifier', + {'H221NonStandard',181,0,21324}, + [77,105,99,114,111,115,111,102,116,174,32,78,101,116, + 77,101,100,116,105,110,103,174,0], + [51,46,48,0]}, + asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE, + {'TerminalInfo',asn1_NOVALUE}, + false,false}, + [22,137,237,197,191,35,211,17,140,45,0,192,79,75,28,208], + {'CallIdentifier',[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]}, + asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}}, + asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}, + asn1_NOVALUE}. +connect_enc() -> + "02c0060008914a00020088e1293a04a322c0b500534c164d6963726f736f6674ae204e65744d656474696e67ae0003332e3000001689edc5bf23d3118c2d00c04f4b1cd00900110000000000000000000000000000000000". -dec_connect() -> - Cs = "02c0060008914a00020088e1293a04a322c0b500534c164d6963726f736f6674ae204e65744d656474696e67ae0003332e3000001689edc5bf23d3118c2d00c04f4b1cd00900110000000000000000000000000000000000", - ByteList = hexstr2bytes(Cs), - asn1_wrapper:decode('H323-MESSAGES','H323-UserInformation',ByteList). +general_string() -> + Type = 'MultimediaSystemControlMessage', + UI = <<109,64,1,57>>, + {ok, _V} = 'MULTIMEDIA-SYSTEM-CONTROL':decode(Type, UI). -enc_connect(V) -> - asn1_wrapper:encode('H323-MESSAGES','H323-UserInformation',V). - -connect() -> - {ok,V} = dec_connect(), - {ok,B} = enc_connect(V), - ByteList = lists:flatten(B), - {ok,V} = asn1_wrapper:decode('H323-MESSAGES','H323-UserInformation',ByteList). - -hexstr2bytes([D1,D2|T]) -> - [dig2num(D1)*16+dig2num(D2)|hexstr2bytes(T)]; -hexstr2bytes([]) -> - []. - -dig2num(D) when D >= $0, D =< $9 -> D - $0; -dig2num(D) when D >= $a, D =< $f -> 10 + D - $a; -dig2num(D) when D >= $A, D =< $F -> 10 + D - $A. +roundtrip(T, V, HexString) -> + Enc = asn1_test_lib:hex_to_bin(HexString), + Enc = asn1_test_lib:roundtrip_enc('H323-MESSAGES', T, V), + ok. diff --git a/lib/asn1/test/pem_performance.erl b/lib/asn1/test/pem_performance.erl deleted file mode 100644 index 87b8cbd61d..0000000000 --- a/lib/asn1/test/pem_performance.erl +++ /dev/null @@ -1,37 +0,0 @@ -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2012. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% - --module([cert_pem/0]). --module([dsa_pem/0]). - -cert_pem() -> - 'OTP-PUB-KEY':decode('Certificate',<<48,130,3,184,48,130,3,33,160,3,2,1,2,2,1,1,48,13,6,9,42,134,72,134,247,13,1,1,5,5,0,48,129,131,49,14,48,12,6,3,85,4,3,19,5,111,116,112,67,65,49,19,48,17,6,3,85,4,11,19,10,69,114,108,97,110,103,32,79,84,80,49,20,48,18,6,3,85,4,10,19,11,69,114,105,99,115,115,111,110,32,65,66,49,11,48,9,6,3,85,4,6,19,2,83,69,49,18,48,16,6,3,85,4,7,19,9,83,116,111,99,107,104,111,108,109,49,37,48,35,6,9,42,134,72,134,247,13,1,9,1,22,22,112,101,116,101,114,64,101,114,105,120,46,101,114,105,99,115,115,111,110,46,115,101,48,30,23,13,48,56,48,49,48,57,48,56,50,57,51,48,90,23,13,49,55,49,49,49,55,48,56,50,57,51,48,90,48,129,132,49,15,48,13,6,3,85,4,3,19,6,99,108,105,101,110,116,49,19,48,17,6,3,85,4,11,19,10,69,114,108,97,110,103,32,79,84,80,49,20,48,18,6,3,85,4,10,19,11,69,114,105,99,115,115,111,110,32,65,66,49,11,48,9,6,3,85,4,6,19,2,83,69,49,18,48,16,6,3,85,4,7,19,9,83,116,111,99,107,104,111,108,109,49,37,48,35,6,9,42,134,72,134,247,13,1,9,1,22,22,112,101,116,101,114,64,101,114,105,120,46,101,114,105,99,115,115,111,110,46,115,101,48,129,159,48,13,6,9,42,134,72,134,247,13,1,1,1,5,0,3,129,141,0,48,129,137,2,129,129,0,245,56,68,254,220,239,193,190,63,221,182,60,67,77,121,163,214,136,137,183,139,8,166,30,100,27,45,17,126,58,15,173,151,218,75,224,148,14,22,164,10,100,186,183,104,175,197,97,96,182,146,150,106,129,140,100,194,106,90,62,133,233,155,46,155,33,101,220,83,193,182,232,240,99,253,249,114,8,159,172,143,77,179,132,229,205,29,110,185,233,224,52,25,149,249,100,80,229,199,125,23,106,146,233,159,26,13,8,161,206,221,43,240,149,42,45,194,190,85,6,235,152,220,219,160,32,144,67,2,3,1,0,1,163,130,1,55,48,130,1,51,48,9,6,3,85,29,19,4,2,48,0,48,11,6,3,85,29,15,4,4,3,2,5,224,48,29,6,3,85,29,14,4,22,4,20,26,59,44,5,72,211,158,214,23,34,30,241,125,27,123,115,93,163,231,120,48,129,179,6,3,85,29,35,4,129,171,48,129,168,128,20,6,171,128,52,58,164,184,118,178,189,157,46,40,229,109,145,222,125,1,155,161,129,140,164,129,137,48,129,134,49,17,48,15,6,3,85,4,3,19,8,101,114,108,97,110,103,67,65,49,19,48,17,6,3,85,4,11,19,10,69,114,108,97,110,103,32,79,84,80,49,20,48,18,6,3,85,4,10,19,11,69,114,105,99,115,115,111,110,32,65,66,49,18,48,16,6,3,85,4,7,19,9,83,116,111,99,107,104,111,108,109,49,11,48,9,6,3,85,4,6,19,2,83,69,49,37,48,35,6,9,42,134,72,134,247,13,1,9,1,22,22,112,101,116,101,114,64,101,114,105,120,46,101,114,105,99,115,115,111,110,46,115,101,130,1,1,48,33,6,3,85,29,17,4,26,48,24,129,22,112,101,116,101,114,64,101,114,105,120,46,101,114,105,99,115,115,111,110,46,115,101,48,33,6,3,85,29,18,4,26,48,24,129,22,112,101,116,101,114,64,101,114,105,120,46,101,114,105,99,115,115,111,110,46,115,101,48,13,6,9,42,134,72,134,247,13,1,1,5,5,0,3,129,129,0,93,11,112,227,121,15,121,179,247,135,110,216,17,197,84,18,149,166,147,142,190,178,0,209,190,0,142,233,144,100,194,205,220,182,73,204,108,42,95,23,48,63,4,120,239,42,194,25,184,35,117,107,96,229,18,45,76,122,125,40,171,210,132,50,146,178,160,55,17,35,255,208,114,30,47,55,185,154,155,165,204,180,14,143,20,234,6,234,201,225,72,235,5,87,61,255,250,23,217,1,144,246,98,221,223,102,49,168,177,13,70,241,26,27,254,251,217,14,244,18,242,197,151,50,186,214,15,42>>). - -dsa_pem() -> - 'OTP-PUB-KEY':decode('DSAPrivateKey',<<48,130,1,187,2,1,0,2,129,129,0,183,179,230,217,37,99,144,157,21,228,204,162,207,61,246,144,58,139,139,184,184,43,108,206,0,115,173,208,100,233,201,121,21,90,179,119,53,140,25,52,34,202,121,211,164,107,43,56,68,162,159,51,244,232,138,126,164,109,121,89,237,142,57,28,32,188,44,67,253,111,121,104,40,141,211,255,140,118,37,234,150,201,155,160,16,17,51,59,26,249,41,129,16,211,119,128,95,254,182,235,132,0,92,206,93,77,106,217,201,132,203,4,75,201,246,204,216,162,1,84,79,211,10,21,152,195,103,145,2,21,0,213,30,184,86,247,16,247,69,192,241,35,138,84,57,140,3,71,65,206,233,2,129,129,0,148,179,24,63,74,91,128,25,96,29,5,78,223,246,175,0,121,86,54,178,42,231,98,241,147,180,157,60,149,160,50,243,227,76,175,89,234,203,252,242,76,108,9,204,157,182,59,206,227,127,99,215,42,156,194,78,116,25,7,62,243,169,45,5,101,179,247,127,199,144,135,103,23,42,154,125,231,248,154,101,175,155,101,42,232,41,80,41,47,128,208,11,31,106,63,12,202,207,135,80,200,136,250,171,31,118,52,91,200,138,112,111,179,23,214,123,21,118,194,179,0,185,217,52,197,182,236,13,2,129,128,124,66,0,111,121,139,142,209,95,136,95,237,177,150,248,252,49,135,117,100,155,232,138,244,132,89,40,5,70,125,202,96,78,239,76,37,125,149,82,64,107,54,227,73,25,180,227,41,0,234,73,47,80,242,242,129,250,61,68,62,39,38,156,193,146,40,241,247,106,215,223,202,194,110,130,62,186,90,18,28,196,174,99,47,193,61,130,100,150,25,248,115,164,231,153,99,46,69,66,139,33,187,51,49,35,219,234,29,44,172,166,247,42,16,177,187,9,162,81,243,33,26,100,46,78,57,203,135,2,20,89,128,159,14,187,249,182,172,15,88,162,110,211,71,179,209,29,125,217,38>>), - 'OTP-PUB-KEY':decode('SubjectPublicKeyInfo',<<48,130,1,183,48,130,1,44,6,7,42,134,72,206,56,4,1,48,130,1,31,2,129,129,0,183,179,230,217,37,99,144,157,21,228,204,162,207,61,246,144,58,139,139,184,184,43,108,206,0,115,173,208,100,233,201,121,21,90,179,119,53,140,25,52,34,202,121,211,164,107,43,56,68,162,159,51,244,232,138,126,164,109,121,89,237,142,57,28,32,188,44,67,253,111,121,104,40,141,211,255,140,118,37,234,150,201,155,160,16,17,51,59,26,249,41,129,16,211,119,128,95,254,182,235,132,0,92,206,93,77,106,217,201,132,203,4,75,201,246,204,216,162,1,84,79,211,10,21,152,195,103,145,2,21,0,213,30,184,86,247,16,247,69,192,241,35,138,84,57,140,3,71,65,206,233,2,129,129,0,148,179,24,63,74,91,128,25,96,29,5,78,223,246,175,0,121,86,54,178,42,231,98,241,147,180,157,60,149,160,50,243,227,76,175,89,234,203,252,242,76,108,9,204,157,182,59,206,227,127,99,215,42,156,194,78,116,25,7,62,243,169,45,5,101,179,247,127,199,144,135,103,23,42,154,125,231,248,154,101,175,155,101,42,232,41,80,41,47,128,208,11,31,106,63,12,202,207,135,80,200,136,250,171,31,118,52,91,200,138,112,111,179,23,214,123,21,118,194,179,0,185,217,52,197,182,236,13,3,129,132,0,2,129,128,124,66,0,111,121,139,142,209,95,136,95,237,177,150,248,252,49,135,117,100,155,232,138,244,132,89,40,5,70,125,202,96,78,239,76,37,125,149,82,64,107,54,227,73,25,180,227,41,0,234,73,47,80,242,242,129,250,61,68,62,39,38,156,193,146,40,241,247,106,215,223,202,194,110,130,62,186,90,18,28,196,174,99,47,193,61,130,100,150,25,248,115,164,231,153,99,46,69,66,139,33,187,51,49,35,219,234,29,44,172,166,247,42,16,177,187,9,162,81,243,33,26,100,46,78,57,203,135>>), - 'OTP-PUB-KEY':decode('DSAParams',<<48,130,1,31,2,129,129,0,183,179,230,217,37,99,144,157,21,228,204,162,207,61,246,144,58,139,139,184,184,43,108,206,0,115,173,208,100,233,201,121,21,90,179,119,53,140,25,52,34,202,121,211,164,107,43,56,68,162,159,51,244,232,138,126,164,109,121,89,237,142,57,28,32,188,44,67,253,111,121,104,40,141,211,255,140,118,37,234,150,201,155,160,16,17,51,59,26,249,41,129,16,211,119,128,95,254,182,235,132,0,92,206,93,77,106,217,201,132,203,4,75,201,246,204,216,162,1,84,79,211,10,21,152,195,103,145,2,21,0,213,30,184,86,247,16,247,69,192,241,35,138,84,57,140,3,71,65,206,233,2,129,129,0,148,179,24,63,74,91,128,25,96,29,5,78,223,246,175,0,121,86,54,178,42,231,98,241,147,180,157,60,149,160,50,243,227,76,175,89,234,203,252,242,76,108,9,204,157,182,59,206,227,127,99,215,42,156,194,78,116,25,7,62,243,169,45,5,101,179,247,127,199,144,135,103,23,42,154,125,231,248,154,101,175,155,101,42,232,41,80,41,47,128,208,11,31,106,63,12,202,207,135,80,200,136,250,171,31,118,52,91,200,138,112,111,179,23,214,123,21,118,194,179,0,185,217,52,197,182,236,13>>), - 'OTP-PUB-KEY':decode('DSAPublicKey',<<2,129,128,124,66,0,111,121,139,142,209,95,136,95,237,177,150,248,252,49,135,117,100,155,232,138,244,132,89,40,5,70,125,202,96,78,239,76,37,125,149,82,64,107,54,227,73,25,180,227,41,0,234,73,47,80,242,242,129,250,61,68,62,39,38,156,193,146,40,241,247,106,215,223,202,194,110,130,62,186,90,18,28,196,174,99,47,193,61,130,100,150,25,248,115,164,231,153,99,46,69,66,139,33,187,51,49,35,219,234,29,44,172,166,247,42,16,177,187,9,162,81,243,33,26,100,46,78,57,203,135>>), - 'OTP-PUB-KEY':encode('DSAParams',{params,{'Dss-Parms',129000451850199666185842362389296595317127259539517666765336291347244303954511451744518587442120964433734460998523119938005801396466878889993179871123036311260456172022864663021425348874648247531097042575063545128239655736096045972718934778583429973433661785691086624069991876932064334822608460064613803976593,1216700114794736143432235288305776850295620488937,104420402274523493329542694749036577763086597934731674202966304958550599470165597750883637440049774107540742087494301536297571301945349213110548764383811017178451900599240379681904765817950545426764751538502808499880604633364255316249231153053427235538288687666086821781456733226598288985591031656134573747213}}), - 'OTP-PUB-KEY':encode( - 'SubjectPublicKeyInfo', - {'SubjectPublicKeyInfo', - {'AlgorithmIdentifier', - {1,2,840,10040,4,1}, - <<48,130,1,31,2,129,129,0,183,179,230,217,37,99,144,157,21,228,204,162,207,61,246,144,58,139,139,184,184,43,108,206,0,115,173,208,100,233,201,121,21,90,179,119,53,140,25,52,34,202,121,211,164,107,43,56,68,162,159,51,244,232,138,126,164,109,121,89,237,142,57,28,32,188,44,67,253,111,121,104,40,141,211,255,140,118,37,234,150,201,155,160,16,17,51,59,26,249,41,129,16,211,119,128,95,254,182,235,132,0,92,206,93,77,106,217,201,132,203,4,75,201,246,204,216,162,1,84,79,211,10,21,152,195,103,145,2,21,0,213,30,184,86,247,16,247,69,192,241,35,138,84,57,140,3,71,65,206,233,2,129,129,0,148,179,24,63,74,91,128,25,96,29,5,78,223,246,175,0,121,86,54,178,42,231,98,241,147,180,157,60,149,160,50,243,227,76,175,89,234,203,252,242,76,108,9,204,157,182,59,206,227,127,99,215,42,156,194,78,116,25,7,62,243,169,45,5,101,179,247,127,199,144,135,103,23,42,154,125,231,248,154,101,175,155,101,42,232,41,80,41,47,128,208,11,31,106,63,12,202,207,135,80,200,136,250,171,31,118,52,91,200,138,112,111,179,23,214,123,21,118,194,179,0,185,217,52,197,182,236,13>>}, - {0, - <<2,129,128,124,66,0,111,121,139,142,209,95,136,95,237,177,150,248,252,49,135,117,100,155,232,138,244,132,89,40,5,70,125,202,96,78,239,76,37,125,149,82,64,107,54,227,73,25,180,227,41,0,234,73,47,80,242,242,129,250,61,68,62,39,38,156,193,146,40,241,247,106,215,223,202,194,110,130,62,186,90,18,28,196,174,99,47,193,61,130,100,150,25,248,115,164,231,153,99,46,69,66,139,33,187,51,49,35,219,234,29,44,172,166,247,42,16,177,187,9,162,81,243,33,26,100,46,78,57,203,135>>}}). diff --git a/lib/asn1/test/testChoExtension.erl b/lib/asn1/test/testChoExtension.erl index c6a07646c2..e54cbe825b 100644 --- a/lib/asn1/test/testChoExtension.erl +++ b/lib/asn1/test/testChoExtension.erl @@ -31,10 +31,7 @@ extension(_Rules) -> %% A trick to encode with another compatible CHOICE type to test reception %% extension alternative - {ok,Bytes2x} = asn1_wrapper:encode('ChoExtension','ChoExt1x',{str,"abc"}), - {ok,Val2x} = - asn1_wrapper:decode('ChoExtension','ChoExt1',lists:flatten(Bytes2x)), - io:format("Choice extension alternative = ~p~n",[Val2x]), + roundtrip('ChoExt1x', {str,"abc"}), roundtrip('ChoExt2', {bool,true}), roundtrip('ChoExt2', {int,33}), @@ -51,6 +48,4 @@ extension(_Rules) -> roundtrip(Type, Value) -> - {ok,Encoded} = 'ChoExtension':encode(Type, Value), - {ok,Value} = 'ChoExtension':decode(Type, Encoded), - ok. + asn1_test_lib:roundtrip('ChoExtension', Type, Value). diff --git a/lib/asn1/test/testChoExternal.erl b/lib/asn1/test/testChoExternal.erl index 5fdee48add..12abdbb2bc 100644 --- a/lib/asn1/test/testChoExternal.erl +++ b/lib/asn1/test/testChoExternal.erl @@ -18,25 +18,11 @@ %% %% -module(testChoExternal). - - --export([compile/3]). -export([external/1]). -include_lib("test_server/include/test_server.hrl"). -include("External.hrl"). - - -compile(Config, Rules, Optimize) -> - DataDir = ?config(data_dir, Config), - CaseDir = ?config(case_dir, Config), - true = code:add_patha(CaseDir), - ok = asn1ct:compile(DataDir ++ "ChoExternal", - [Rules, {outdir, CaseDir}] ++ Optimize). - - - external(_Rules) -> roundtrip('ChoXCho', {boolCho,true}), roundtrip('ChoXCho', {intCho,77}), @@ -59,6 +45,4 @@ external(_Rules) -> ok. roundtrip(Type, Value) -> - {ok,Encoded} = 'ChoExternal':encode(Type, Value), - {ok,Value} = 'ChoExternal':decode(Type, Encoded), - ok. + asn1_test_lib:roundtrip('ChoExternal', Type, Value). diff --git a/lib/asn1/test/testChoOptional.erl b/lib/asn1/test/testChoOptional.erl index cbb8134e51..f5e77cb721 100644 --- a/lib/asn1/test/testChoOptional.erl +++ b/lib/asn1/test/testChoOptional.erl @@ -18,83 +18,30 @@ %% %% -module(testChoOptional). +-export([run/0]). --export([optional/1]). +-record('Seq1', {bool, int = asn1_NOVALUE, cho = asn1_NOVALUE}). +-record('Seq2', {int = asn1_NOVALUE, cho = asn1_NOVALUE, bool}). +-record('Seq3', {cho = asn1_NOVALUE, int = asn1_NOVALUE, bool}). -%-include("ChoOptional.hrl"). --include_lib("test_server/include/test_server.hrl"). --include("External.hrl"). +run() -> + roundtrip('Seq1', #'Seq1'{bool=true,int=asn1_NOVALUE,cho=asn1_NOVALUE}), + roundtrip('Seq1', #'Seq1'{bool=true,int=233,cho=asn1_NOVALUE}), + roundtrip('Seq1', #'Seq1'{bool=true,int=asn1_NOVALUE,cho={vsCho,"Vs Str"}}), + roundtrip('Seq1', #'Seq1'{bool=true,int=asn1_NOVALUE,cho={ocStrCho,"Oct Str"}}), + roundtrip('Seq2', #'Seq2'{int=asn1_NOVALUE,cho=asn1_NOVALUE,bool=true}), + roundtrip('Seq2', #'Seq2'{int=233,cho=asn1_NOVALUE,bool=true}), + roundtrip('Seq2', #'Seq2'{int=asn1_NOVALUE,cho={vsCho,"Vs Str"},bool=true}), + roundtrip('Seq2', #'Seq2'{int=asn1_NOVALUE,cho={ocStrCho,"Oct Str"},bool=true}), + roundtrip('Seq3', #'Seq3'{cho=asn1_NOVALUE,int=asn1_NOVALUE,bool=true}), + roundtrip('Seq3', #'Seq3'{cho=asn1_NOVALUE,int=233,bool=true}), + roundtrip('Seq3', #'Seq3'{cho={vsCho,"Vs Str"},int=asn1_NOVALUE,bool=true}), + roundtrip('Seq3', #'Seq3'{cho={ocStrCho,"Oct Str"},int=asn1_NOVALUE,bool=true}), + ok. --record('Seq1',{bool, int = asn1_NOVALUE, cho = asn1_NOVALUE}). --record('Seq2',{int = asn1_NOVALUE, cho = asn1_NOVALUE, bool}). --record('Seq3',{cho = asn1_NOVALUE, int = asn1_NOVALUE, bool}). +roundtrip(Type, Value) -> + roundtrip('ChoOptional', Type, Value), + roundtrip('ChoOptionalImplicitTag', Type, Value). -optional(_Rules) -> - - ?line {ok,Bytes11} = asn1_wrapper:encode('ChoOptional','Seq1',#'Seq1'{bool = true}), - ?line {ok,{'Seq1',true,asn1_NOVALUE,asn1_NOVALUE}} = - asn1_wrapper:decode('ChoOptional','Seq1',lists:flatten(Bytes11)), - - ?line {ok,Bytes12} = asn1_wrapper:encode('ChoOptional','Seq1',#'Seq1'{bool = true, - int = 233}), - ?line {ok,{'Seq1',true,233,asn1_NOVALUE}} = - asn1_wrapper:decode('ChoOptional','Seq1',lists:flatten(Bytes12)), - - ?line {ok,Bytes13} = asn1_wrapper:encode('ChoOptional','Seq1',#'Seq1'{bool = true, - cho = {vsCho,"Vs Str"}}), - ?line {ok,{'Seq1',true,asn1_NOVALUE,{vsCho,"Vs Str"}}} = - asn1_wrapper:decode('ChoOptional','Seq1',lists:flatten(Bytes13)), - - ?line {ok,Bytes14} = - asn1_wrapper:encode('ChoOptional','Seq1',#'Seq1'{bool = true, - cho = {ocStrCho,"Oct Str"}}), - ?line {ok,{'Seq1',true,asn1_NOVALUE,{ocStrCho,"Oct Str"}}} = - asn1_wrapper:decode('ChoOptional','Seq1',lists:flatten(Bytes14)), - - - - ?line {ok,Bytes21} = asn1_wrapper:encode('ChoOptional','Seq2',#'Seq2'{bool = true}), - ?line {ok,{'Seq2',asn1_NOVALUE,asn1_NOVALUE,true}} = - asn1_wrapper:decode('ChoOptional','Seq2',lists:flatten(Bytes21)), - - ?line {ok,Bytes22} = asn1_wrapper:encode('ChoOptional','Seq2',#'Seq2'{bool = true, - int = 233}), - ?line {ok,{'Seq2',233,asn1_NOVALUE,true}} = - asn1_wrapper:decode('ChoOptional','Seq2',lists:flatten(Bytes22)), - - ?line {ok,Bytes23} = asn1_wrapper:encode('ChoOptional','Seq2',#'Seq2'{bool = true, - cho = {vsCho,"Vs Str"}}), - ?line {ok,{'Seq2',asn1_NOVALUE,{vsCho,"Vs Str"},true}} = - asn1_wrapper:decode('ChoOptional','Seq2',lists:flatten(Bytes23)), - - ?line {ok,Bytes24} = - asn1_wrapper:encode('ChoOptional','Seq2',#'Seq2'{bool = true, - cho = {ocStrCho,"Oct Str"}}), - ?line {ok,{'Seq2',asn1_NOVALUE,{ocStrCho,"Oct Str"},true}} = - asn1_wrapper:decode('ChoOptional','Seq2',lists:flatten(Bytes24)), - - - - ?line {ok,Bytes31} = asn1_wrapper:encode('ChoOptional','Seq3',#'Seq3'{bool = true}), - ?line {ok,{'Seq3',asn1_NOVALUE,asn1_NOVALUE,true}} = - asn1_wrapper:decode('ChoOptional','Seq3',lists:flatten(Bytes31)), - - ?line {ok,Bytes32} = asn1_wrapper:encode('ChoOptional','Seq3',#'Seq3'{bool = true, - int = 233}), - ?line {ok,{'Seq3',asn1_NOVALUE,233,true}} = - asn1_wrapper:decode('ChoOptional','Seq3',lists:flatten(Bytes32)), - - ?line {ok,Bytes33} = asn1_wrapper:encode('ChoOptional','Seq3',#'Seq3'{bool = true, - cho = {vsCho,"Vs Str"}}), - ?line {ok,{'Seq3',{vsCho,"Vs Str"},asn1_NOVALUE,true}} = - asn1_wrapper:decode('ChoOptional','Seq3',lists:flatten(Bytes33)), - - ?line {ok,Bytes34} = - asn1_wrapper:encode('ChoOptional','Seq3',#'Seq3'{bool = true, - cho = {ocStrCho,"Oct Str"}}), - ?line {ok,{'Seq3',{ocStrCho,"Oct Str"},asn1_NOVALUE,true}} = - asn1_wrapper:decode('ChoOptional','Seq3',lists:flatten(Bytes34)), - - - - ok. +roundtrip(Mod, Type, Value) -> + asn1_test_lib:roundtrip(Mod, Type, Value). diff --git a/lib/asn1/test/testChoOptionalImplicitTag.erl b/lib/asn1/test/testChoOptionalImplicitTag.erl deleted file mode 100644 index efe335cabd..0000000000 --- a/lib/asn1/test/testChoOptionalImplicitTag.erl +++ /dev/null @@ -1,101 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% 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(testChoOptionalImplicitTag). - - --export([optional/1]). - -%-include("ChoOptional.hrl"). --include_lib("test_server/include/test_server.hrl"). --include("External.hrl"). - --record('Seq1',{bool, int = asn1_NOVALUE, cho = asn1_NOVALUE}). --record('Seq2',{int = asn1_NOVALUE, cho = asn1_NOVALUE, bool}). --record('Seq3',{cho = asn1_NOVALUE, int = asn1_NOVALUE, bool}). - -optional(_Rules) -> - - ?line {ok,Bytes11} = asn1_wrapper:encode('ChoOptionalImplicitTag','Seq1',#'Seq1'{bool = true}), - ?line {ok,{'Seq1',true,asn1_NOVALUE,asn1_NOVALUE}} = - asn1_wrapper:decode('ChoOptionalImplicitTag','Seq1',lists:flatten(Bytes11)), - - ?line {ok,Bytes12} = asn1_wrapper:encode('ChoOptionalImplicitTag','Seq1',#'Seq1'{bool = true, - int = 233}), - ?line {ok,{'Seq1',true,233,asn1_NOVALUE}} = - asn1_wrapper:decode('ChoOptionalImplicitTag','Seq1',lists:flatten(Bytes12)), - - ?line {ok,Bytes13} = asn1_wrapper:encode('ChoOptionalImplicitTag','Seq1',#'Seq1'{bool = true, - cho = {vsCho,"Vs Str"}}), - ?line {ok,{'Seq1',true,asn1_NOVALUE,{vsCho,"Vs Str"}}} = - asn1_wrapper:decode('ChoOptionalImplicitTag','Seq1',lists:flatten(Bytes13)), - - ?line {ok,Bytes14} = - asn1_wrapper:encode('ChoOptionalImplicitTag','Seq1',#'Seq1'{bool = true, - cho = {ocStrCho,"Oct Str"}}), - ?line {ok,{'Seq1',true,asn1_NOVALUE,{ocStrCho,"Oct Str"}}} = - asn1_wrapper:decode('ChoOptionalImplicitTag','Seq1',lists:flatten(Bytes14)), - - - - ?line {ok,Bytes21} = asn1_wrapper:encode('ChoOptionalImplicitTag','Seq2',#'Seq2'{bool = true}), - ?line {ok,{'Seq2',asn1_NOVALUE,asn1_NOVALUE,true}} = - asn1_wrapper:decode('ChoOptionalImplicitTag','Seq2',lists:flatten(Bytes21)), - - ?line {ok,Bytes22} = asn1_wrapper:encode('ChoOptionalImplicitTag','Seq2',#'Seq2'{bool = true, - int = 233}), - ?line {ok,{'Seq2',233,asn1_NOVALUE,true}} = - asn1_wrapper:decode('ChoOptionalImplicitTag','Seq2',lists:flatten(Bytes22)), - - ?line {ok,Bytes23} = asn1_wrapper:encode('ChoOptionalImplicitTag','Seq2',#'Seq2'{bool = true, - cho = {vsCho,"Vs Str"}}), - ?line {ok,{'Seq2',asn1_NOVALUE,{vsCho,"Vs Str"},true}} = - asn1_wrapper:decode('ChoOptionalImplicitTag','Seq2',lists:flatten(Bytes23)), - - ?line {ok,Bytes24} = - asn1_wrapper:encode('ChoOptionalImplicitTag','Seq2',#'Seq2'{bool = true, - cho = {ocStrCho,"Oct Str"}}), - ?line {ok,{'Seq2',asn1_NOVALUE,{ocStrCho,"Oct Str"},true}} = - asn1_wrapper:decode('ChoOptionalImplicitTag','Seq2',lists:flatten(Bytes24)), - - - - ?line {ok,Bytes31} = asn1_wrapper:encode('ChoOptionalImplicitTag','Seq3',#'Seq3'{bool = true}), - ?line {ok,{'Seq3',asn1_NOVALUE,asn1_NOVALUE,true}} = - asn1_wrapper:decode('ChoOptionalImplicitTag','Seq3',lists:flatten(Bytes31)), - - ?line {ok,Bytes32} = asn1_wrapper:encode('ChoOptionalImplicitTag','Seq3',#'Seq3'{bool = true, - int = 233}), - ?line {ok,{'Seq3',asn1_NOVALUE,233,true}} = - asn1_wrapper:decode('ChoOptionalImplicitTag','Seq3',lists:flatten(Bytes32)), - - ?line {ok,Bytes33} = asn1_wrapper:encode('ChoOptionalImplicitTag','Seq3',#'Seq3'{bool = true, - cho = {vsCho,"Vs Str"}}), - ?line {ok,{'Seq3',{vsCho,"Vs Str"},asn1_NOVALUE,true}} = - asn1_wrapper:decode('ChoOptionalImplicitTag','Seq3',lists:flatten(Bytes33)), - - ?line {ok,Bytes34} = - asn1_wrapper:encode('ChoOptionalImplicitTag','Seq3',#'Seq3'{bool = true, - cho = {ocStrCho,"Oct Str"}}), - ?line {ok,{'Seq3',{ocStrCho,"Oct Str"},asn1_NOVALUE,true}} = - asn1_wrapper:decode('ChoOptionalImplicitTag','Seq3',lists:flatten(Bytes34)), - - - - ok. diff --git a/lib/asn1/test/testChoPrim.erl b/lib/asn1/test/testChoPrim.erl index 936a38f76c..4665de6989 100644 --- a/lib/asn1/test/testChoPrim.erl +++ b/lib/asn1/test/testChoPrim.erl @@ -25,80 +25,44 @@ -include_lib("test_server/include/test_server.hrl"). bool(Rules) -> - - ?line {ok,Bytes11} = asn1_wrapper:encode('ChoPrim','ChoCon',{bool0,true}), - ?line {ok,{bool0,true}} = asn1_wrapper:decode('ChoPrim','ChoCon',lists:flatten(Bytes11)), - - ?line {ok,Bytes12} = asn1_wrapper:encode('ChoPrim','ChoCon',{bool1,true}), - ?line {ok,{bool1,true}} = asn1_wrapper:decode('ChoPrim','ChoCon',lists:flatten(Bytes12)), - - ?line {ok,Bytes13} = asn1_wrapper:encode('ChoPrim','ChoCon',{int2,233}), - ?line {ok,{int2,233}} = asn1_wrapper:decode('ChoPrim','ChoCon',lists:flatten(Bytes13)), - - ?line case asn1_wrapper:erule(Rules) of - ber -> - ?line {error,{asn1,{invalid_choice_type,wrong}}} = - case catch asn1_wrapper:encode('ChoPrim','ChoCon',{wrong,233}) of - X1 -> X1 end, - ?line {error,{asn1,{invalid_choice_tag,_WrongTag}}} = - case catch asn1_wrapper:decode('ChoPrim','ChoCon',[131,2,0,233]) of - X2 -> X2 end, - ok; - - per -> - ok - end, - + roundtrip('ChoCon', {bool0,true}), + roundtrip('ChoCon', {bool1,true}), + roundtrip('ChoCon', {int2,233}), + case Rules of + ber -> + {error,{asn1,{invalid_choice_type,wrong}}} = + (catch 'ChoPrim':encode('ChoCon', {wrong,233})), + {error,{asn1,{invalid_choice_tag,_WrongTag}}} = + (catch 'ChoPrim':decode('ChoCon', <<131,2,0,233>>)); + per -> + ok; + uper -> + ok + end, ok. - - int(Rules) -> - - ?line {ok,Bytes21} = asn1_wrapper:encode('ChoPrim','ChoExp',{int10,1}), - ?line {ok,{int10,first}} = asn1_wrapper:decode('ChoPrim','ChoExp',lists:flatten(Bytes21)), - - ?line {ok,Bytes22} = asn1_wrapper:encode('ChoPrim','ChoExp',{int10,first}), - ?line {ok,{int10,first}} = asn1_wrapper:decode('ChoPrim','ChoExp',lists:flatten(Bytes22)), - - ?line {ok,Bytes23} = asn1_wrapper:encode('ChoPrim','ChoExp',{int10,last}), - ?line {ok,{int10,last}} = asn1_wrapper:decode('ChoPrim','ChoExp',lists:flatten(Bytes23)), - - ?line {ok,Bytes24} = asn1_wrapper:encode('ChoPrim','ChoExp',{bool11,true}), - ?line {ok,{bool11,true}} = asn1_wrapper:decode('ChoPrim','ChoExp',lists:flatten(Bytes24)), - - - ?line {ok,Bytes26} = asn1_wrapper:encode('ChoPrim','ChoExp',{enum12,one}), - ?line {ok,{enum12,one}} = asn1_wrapper:decode('ChoPrim','ChoExp',lists:flatten(Bytes26)), - - ?line {ok,Bytes25} = asn1_wrapper:encode('ChoPrim','ChoExp',{bool11,true}), - ?line {ok,{bool11,true}} = - asn1_wrapper:decode('ChoPrim','ChoExp',lists:flatten(Bytes25)), - - ?line {error,{asn1,_}} = - case catch asn1_wrapper:encode('ChoPrim','ChoExp',{enum12,four}) of - X3 -> X3 end, - - ?line {error,{asn1,_}} = - case catch asn1_wrapper:encode('ChoPrim','ChoExp',{wrong,233}) of - X4 -> io:format("error reason = ~p~n",[X4]), X4 end, - - ?line case asn1_wrapper:erule(Rules) of - ber -> - ?line {error,{asn1,_}} = - case catch asn1_wrapper:decode('ChoPrim','ChoExp',[107,3,2,1,1]) of - X5 -> X5 end, - ok; - - per -> - ok - end, + roundtrip('ChoExp', {int10,1}, {int10,first}), + roundtrip('ChoExp', {int10,first}), + roundtrip('ChoExp', {int10,last}), + roundtrip('ChoExp', {bool11,true}), + roundtrip('ChoExp', {enum12,one}), + roundtrip('ChoExp', {bool11,true}), + + {error,{asn1,_}} = (catch 'ChoPrim':encode('ChoExp', {enum12,four})), + {error,{asn1,_}} = (catch 'ChoPrim':encode('ChoExp', {wrong,233})), + case Rules of + ber -> + {error,{asn1,_}} = (catch 'ChoPrim':decode('ChoExp', <<107,3,2,1,1>>)); + per -> + ok; + uper -> + ok + end, ok. +roundtrip(Type, Value) -> + roundtrip(Type, Value, Value). - - - - - - +roundtrip(Type, Value, ExpectedValue) -> + asn1_test_lib:roundtrip('ChoPrim', Type, Value, ExpectedValue). diff --git a/lib/asn1/test/testChoRecursive.erl b/lib/asn1/test/testChoRecursive.erl index ee26d124a9..593b845949 100644 --- a/lib/asn1/test/testChoRecursive.erl +++ b/lib/asn1/test/testChoRecursive.erl @@ -43,6 +43,4 @@ recursive(_Rules) -> ok. roundtrip(Type, Value) -> - {ok,Encoded} = 'ChoRecursive':encode(Type, Value), - {ok,Value} = 'ChoRecursive':decode(Type, Encoded), - ok. + asn1_test_lib:roundtrip('ChoRecursive', Type, Value). diff --git a/lib/asn1/test/testChoTypeRefCho.erl b/lib/asn1/test/testChoTypeRefCho.erl index 9bd732f462..cd2672add0 100644 --- a/lib/asn1/test/testChoTypeRefCho.erl +++ b/lib/asn1/test/testChoTypeRefCho.erl @@ -24,43 +24,15 @@ -include_lib("test_server/include/test_server.hrl"). choice(_Rules) -> - - ?line {ok,Bytes11} = asn1_wrapper:encode('ChoTypeRefCho','ChoTRcho',{choCho,{choInt,88}}), - ?line {ok,{choCho,{choInt,88}}} = - asn1_wrapper:decode('ChoTypeRefCho','ChoTRcho',lists:flatten(Bytes11)), - - ?line {ok,Bytes12} = asn1_wrapper:encode('ChoTypeRefCho','ChoTRcho',{choChoE,{choInt,88}}), - ?line {ok,{choChoE,{choInt,88}}} = - asn1_wrapper:decode('ChoTypeRefCho','ChoTRcho',lists:flatten(Bytes12)), - - ?line {ok,Bytes13} = asn1_wrapper:encode('ChoTypeRefCho','ChoTRcho',{'choCho-E',{choInt,88}}), - ?line {ok,{'choCho-E',{choInt,88}}} = - asn1_wrapper:decode('ChoTypeRefCho','ChoTRcho',lists:flatten(Bytes13)), - - ?line {ok,Bytes14} = asn1_wrapper:encode('ChoTypeRefCho','ChoTRcho',{'choChoE-E',{choInt,88}}), - ?line {ok,{'choChoE-E',{choInt,88}}} = - asn1_wrapper:decode('ChoTypeRefCho','ChoTRcho',lists:flatten(Bytes14)), - - - - ?line {ok,Bytes21} = asn1_wrapper:encode('ChoTypeRefCho','ChoChoInline',{bool1,true}), - ?line {ok,{bool1,true}} = - asn1_wrapper:decode('ChoTypeRefCho','ChoChoInline',lists:flatten(Bytes21)), - - ?line {ok,Bytes22} = asn1_wrapper:encode('ChoTypeRefCho','ChoChoInline',{'choCho',{bool,true}}), - ?line {ok,{'choCho',{bool,true}}} = - asn1_wrapper:decode('ChoTypeRefCho','ChoChoInline',lists:flatten(Bytes22)), - - ?line {ok,Bytes23} = asn1_wrapper:encode('ChoTypeRefCho','ChoChoInline',{'choCho',{octStr,"kk"}}), - ?line {ok,{'choCho',{octStr,"kk"}}} = - asn1_wrapper:decode('ChoTypeRefCho','ChoChoInline',lists:flatten(Bytes23)), - - ?line {ok,Bytes24} = asn1_wrapper:encode('ChoTypeRefCho','ChoChoInline',{'choCho',{int,55}}), - ?line {ok,{'choCho',{int,55}}} = - asn1_wrapper:decode('ChoTypeRefCho','ChoChoInline',lists:flatten(Bytes24)), - - - - - + roundtrip('ChoTRcho', {choCho,{choInt,88}}), + roundtrip('ChoTRcho', {choChoE,{choInt,88}}), + roundtrip('ChoTRcho', {'choCho-E',{choInt,88}}), + roundtrip('ChoTRcho', {'choChoE-E',{choInt,88}}), + roundtrip('ChoChoInline', {bool1,true}), + roundtrip('ChoChoInline', {choCho,{bool,true}}), + roundtrip('ChoChoInline', {choCho,{octStr,"kk"}}), + roundtrip('ChoChoInline', {choCho,{int,55}}), ok. + +roundtrip(Type, Value) -> + asn1_test_lib:roundtrip('ChoTypeRefCho', Type, Value). diff --git a/lib/asn1/test/testChoTypeRefPrim.erl b/lib/asn1/test/testChoTypeRefPrim.erl index edef6192fe..8a2bc7bd8e 100644 --- a/lib/asn1/test/testChoTypeRefPrim.erl +++ b/lib/asn1/test/testChoTypeRefPrim.erl @@ -24,60 +24,20 @@ -include_lib("test_server/include/test_server.hrl"). prim(_Rules) -> - - ?line {ok,Bytes11} = asn1_wrapper:encode('ChoTypeRefPrim','ChoTR',{bool,true}), - ?line {ok,{bool,true}} = asn1_wrapper:decode('ChoTypeRefPrim','ChoTR',lists:flatten(Bytes11)), - - ?line {ok,Bytes12} = - asn1_wrapper:encode('ChoTypeRefPrim','ChoTR',{octStr,[11,12,13,14,15,16,17]}), - ?line {ok,{octStr,[11,12,13,14,15,16,17]}} = - asn1_wrapper:decode('ChoTypeRefPrim','ChoTR',lists:flatten(Bytes12)), - - ?line {ok,Bytes13} = asn1_wrapper:encode('ChoTypeRefPrim','ChoTR',{int,233}), - ?line {ok,{int,233}} = asn1_wrapper:decode('ChoTypeRefPrim','ChoTR',lists:flatten(Bytes13)), - - ?line {ok,Bytes14} = - asn1_wrapper:encode('ChoTypeRefPrim','ChoTR',{octStr,"Stringing in the rain"}), - ?line {ok,{octStr,"Stringing in the rain"}} = - asn1_wrapper:decode('ChoTypeRefPrim','ChoTR',lists:flatten(Bytes14)), - - - - ?line {ok,Bytes21} = asn1_wrapper:encode('ChoTypeRefPrim','ChoTR2',{'octStr',"A string"}), - ?line {ok,{'octStr',"A string"}} = - asn1_wrapper:decode('ChoTypeRefPrim','ChoTR2',lists:flatten(Bytes21)), - - ?line {ok,Bytes22} = asn1_wrapper:encode('ChoTypeRefPrim','ChoTR2',{'octStrI',"A string"}), - ?line {ok,{'octStrI',"A string"}} = - asn1_wrapper:decode('ChoTypeRefPrim','ChoTR2',lists:flatten(Bytes22)), - - ?line {ok,Bytes23} = asn1_wrapper:encode('ChoTypeRefPrim','ChoTR2',{'octStrE',"A string"}), - ?line {ok,{'octStrE',"A string"}} = - asn1_wrapper:decode('ChoTypeRefPrim','ChoTR2',lists:flatten(Bytes23)), - - ?line {ok,Bytes24} = asn1_wrapper:encode('ChoTypeRefPrim','ChoTR2',{'octStr-I',"A string"}), - ?line {ok,{'octStr-I',"A string"}} = - asn1_wrapper:decode('ChoTypeRefPrim','ChoTR2',lists:flatten(Bytes24)), - - ?line {ok,Bytes25} = asn1_wrapper:encode('ChoTypeRefPrim','ChoTR2',{'octStrI-I',"A string"}), - ?line {ok,{'octStrI-I',"A string"}} = - asn1_wrapper:decode('ChoTypeRefPrim','ChoTR2',lists:flatten(Bytes25)), - - ?line {ok,Bytes26} = asn1_wrapper:encode('ChoTypeRefPrim','ChoTR2',{'octStrE-I',"A string"}), - ?line {ok,{'octStrE-I',"A string"}} = - asn1_wrapper:decode('ChoTypeRefPrim','ChoTR2',lists:flatten(Bytes26)), - - ?line {ok,Bytes27} = asn1_wrapper:encode('ChoTypeRefPrim','ChoTR2',{'octStr-E',"A string"}), - ?line {ok,{'octStr-E',"A string"}} = - asn1_wrapper:decode('ChoTypeRefPrim','ChoTR2',lists:flatten(Bytes27)), - - ?line {ok,Bytes28} = asn1_wrapper:encode('ChoTypeRefPrim','ChoTR2',{'octStrI-E',"A string"}), - ?line {ok,{'octStrI-E',"A string"}} = - asn1_wrapper:decode('ChoTypeRefPrim','ChoTR2',lists:flatten(Bytes28)), - - ?line {ok,Bytes29} = asn1_wrapper:encode('ChoTypeRefPrim','ChoTR2',{'octStrE-E',"A string"}), - ?line {ok,{'octStrE-E',"A string"}} = - asn1_wrapper:decode('ChoTypeRefPrim','ChoTR2',lists:flatten(Bytes29)), - - + roundtrip('ChoTR', {bool,true}), + roundtrip('ChoTR', {octStr,[11,12,13,14,15,16,17]}), + roundtrip('ChoTR', {int,233}), + roundtrip('ChoTR', {octStr,"Stringing in the rain"}), + roundtrip('ChoTR2', {octStr,"A string"}), + roundtrip('ChoTR2', {octStrI,"A string"}), + roundtrip('ChoTR2', {octStrE,"A string"}), + roundtrip('ChoTR2', {'octStr-I',"A string"}), + roundtrip('ChoTR2', {'octStrI-I',"A string"}), + roundtrip('ChoTR2', {'octStrE-I',"A string"}), + roundtrip('ChoTR2', {'octStr-E',"A string"}), + roundtrip('ChoTR2', {'octStrI-E',"A string"}), + roundtrip('ChoTR2', {'octStrE-E',"A string"}), ok. + +roundtrip(Type, Value) -> + asn1_test_lib:roundtrip('ChoTypeRefPrim', Type, Value). diff --git a/lib/asn1/test/testChoTypeRefSeq.erl b/lib/asn1/test/testChoTypeRefSeq.erl index bf2b66c73e..86c22619aa 100644 --- a/lib/asn1/test/testChoTypeRefSeq.erl +++ b/lib/asn1/test/testChoTypeRefSeq.erl @@ -23,82 +23,21 @@ -include_lib("test_server/include/test_server.hrl"). --record('ChoSeq',{seqInt, seqOs}). --record('ChoSeqImp',{seqInt, seqOs}). --record('ChoSeqExp',{seqInt, seqOs}). +-record('ChoSeq', {seqInt, seqOs}). +-record('ChoSeqImp', {seqInt, seqOs}). +-record('ChoSeqExp', {seqInt, seqOs}). seq(_Rules) -> - - ?line {ok,Bytes1} = - asn1_wrapper:encode('ChoTypeRefSeq','ChoTRseq', - {choSeq,#'ChoSeq'{seqInt = 88, - seqOs = "A string"}}), - ?line {ok,{choSeq,{'ChoSeq',88,"A string"}}} = - asn1_wrapper:decode('ChoTypeRefSeq','ChoTRseq',lists:flatten(Bytes1)), - - - ?line {ok,Bytes2} = - asn1_wrapper:encode('ChoTypeRefSeq','ChoTRseq', - {choSeqI,#'ChoSeq'{seqInt = 88, - seqOs = "A string"}}), - ?line {ok,{choSeqI,{'ChoSeq',88,"A string"}}} = - asn1_wrapper:decode('ChoTypeRefSeq','ChoTRseq',lists:flatten(Bytes2)), - - - ?line {ok,Bytes3} = - asn1_wrapper:encode('ChoTypeRefSeq','ChoTRseq', - {choSeqE,#'ChoSeq'{seqInt = 88, - seqOs = "A string"}}), - ?line {ok,{choSeqE,{'ChoSeq',88,"A string"}}} = - asn1_wrapper:decode('ChoTypeRefSeq','ChoTRseq',lists:flatten(Bytes3)), - - - ?line {ok,Bytes4} = - asn1_wrapper:encode('ChoTypeRefSeq','ChoTRseq', - {'choSeq-I',#'ChoSeqImp'{seqInt = 88, - seqOs = "A string"}}), - ?line {ok,{'choSeq-I',{'ChoSeqImp',88,"A string"}}} = - asn1_wrapper:decode('ChoTypeRefSeq','ChoTRseq',lists:flatten(Bytes4)), - - - ?line {ok,Bytes5} = - asn1_wrapper:encode('ChoTypeRefSeq','ChoTRseq', - {'choSeqI-I',#'ChoSeqImp'{seqInt = 88, - seqOs = "A string"}}), - ?line {ok,{'choSeqI-I',{'ChoSeqImp',88,"A string"}}} = - asn1_wrapper:decode('ChoTypeRefSeq','ChoTRseq',lists:flatten(Bytes5)), - - - ?line {ok,Bytes6} = - asn1_wrapper:encode('ChoTypeRefSeq','ChoTRseq', - {'choSeqE-I',#'ChoSeqImp'{seqInt = 88, - seqOs = "A string"}}), - ?line {ok,{'choSeqE-I',{'ChoSeqImp',88,"A string"}}} = - asn1_wrapper:decode('ChoTypeRefSeq','ChoTRseq',lists:flatten(Bytes6)), - - - ?line {ok,Bytes7} = - asn1_wrapper:encode('ChoTypeRefSeq','ChoTRseq', - {'choSeq-E',#'ChoSeqExp'{seqInt = 88, - seqOs = "A string"}}), - ?line {ok,{'choSeq-E',{'ChoSeqExp',88,"A string"}}} = - asn1_wrapper:decode('ChoTypeRefSeq','ChoTRseq',lists:flatten(Bytes7)), - - - ?line {ok,Bytes8} = - asn1_wrapper:encode('ChoTypeRefSeq','ChoTRseq', - {'choSeqI-E',#'ChoSeqExp'{seqInt = 88, - seqOs = "A string"}}), - ?line {ok,{'choSeqI-E',{'ChoSeqExp',88,"A string"}}} = - asn1_wrapper:decode('ChoTypeRefSeq','ChoTRseq',lists:flatten(Bytes8)), - - - ?line {ok,Bytes9} = - asn1_wrapper:encode('ChoTypeRefSeq','ChoTRseq', - {'choSeqE-E',#'ChoSeqExp'{seqInt = 88, - seqOs = "A string"}}), - ?line {ok,{'choSeqE-E',{'ChoSeqExp',88,"A string"}}} = - asn1_wrapper:decode('ChoTypeRefSeq','ChoTRseq',lists:flatten(Bytes9)), - - + roundtrip('ChoTRseq', {choSeq,#'ChoSeq'{seqInt=88,seqOs="A string"}}), + roundtrip('ChoTRseq', {choSeqI,#'ChoSeq'{seqInt=88,seqOs="A string"}}), + roundtrip('ChoTRseq', {choSeqE,#'ChoSeq'{seqInt=88,seqOs="A string"}}), + roundtrip('ChoTRseq', {'choSeq-I',#'ChoSeqImp'{seqInt=88,seqOs="A string"}}), + roundtrip('ChoTRseq', {'choSeqI-I',#'ChoSeqImp'{seqInt=88,seqOs="A string"}}), + roundtrip('ChoTRseq', {'choSeqE-I',#'ChoSeqImp'{seqInt=88,seqOs="A string"}}), + roundtrip('ChoTRseq', {'choSeq-E',#'ChoSeqExp'{seqInt=88,seqOs="A string"}}), + roundtrip('ChoTRseq', {'choSeqI-E',#'ChoSeqExp'{seqInt=88,seqOs="A string"}}), + roundtrip('ChoTRseq', {'choSeqE-E',#'ChoSeqExp'{seqInt=88,seqOs="A string"}}), ok. + +roundtrip(Type, Value) -> + asn1_test_lib:roundtrip('ChoTypeRefSeq', Type, Value). diff --git a/lib/asn1/test/testChoTypeRefSet.erl b/lib/asn1/test/testChoTypeRefSet.erl index 8a3e8bdbb0..fd3d75cbcb 100644 --- a/lib/asn1/test/testChoTypeRefSet.erl +++ b/lib/asn1/test/testChoTypeRefSet.erl @@ -23,83 +23,21 @@ -include_lib("test_server/include/test_server.hrl"). --record('ChoSet',{setInt, setOs}). --record('ChoSetImp',{setInt, setOs}). --record('ChoSetExp',{setInt, setOs}). +-record('ChoSet', {setInt, setOs}). +-record('ChoSetImp', {setInt, setOs}). +-record('ChoSetExp', {setInt, setOs}). set(_Rules) -> - - ?line {ok,Bytes1} = - asn1_wrapper:encode('ChoTypeRefSet','ChoTRset', - {choSet,#'ChoSet'{setInt = 88, - setOs = "A string"}}), - ?line {ok,{choSet,{'ChoSet',88,"A string"}}} = - asn1_wrapper:decode('ChoTypeRefSet','ChoTRset',lists:flatten(Bytes1)), - - - ?line {ok,Bytes2} = - asn1_wrapper:encode('ChoTypeRefSet','ChoTRset', - {choSetI,#'ChoSet'{setInt = 88, - setOs = "A string"}}), - ?line {ok,{choSetI,{'ChoSet',88,"A string"}}} = - asn1_wrapper:decode('ChoTypeRefSet','ChoTRset',lists:flatten(Bytes2)), - - - ?line {ok,Bytes3} = - asn1_wrapper:encode('ChoTypeRefSet','ChoTRset', - {choSetE,#'ChoSet'{setInt = 88, - setOs = "A string"}}), - ?line {ok,{choSetE,{'ChoSet',88,"A string"}}} = - asn1_wrapper:decode('ChoTypeRefSet','ChoTRset',lists:flatten(Bytes3)), - - - ?line {ok,Bytes4} = - asn1_wrapper:encode('ChoTypeRefSet','ChoTRset', - {'choSet-I',#'ChoSetImp'{setInt = 88, - setOs = "A string"}}), - ?line {ok,{'choSet-I',{'ChoSetImp',88,"A string"}}} = - asn1_wrapper:decode('ChoTypeRefSet','ChoTRset',lists:flatten(Bytes4)), - - - ?line {ok,Bytes5} = - asn1_wrapper:encode('ChoTypeRefSet','ChoTRset', - {'choSetI-I',#'ChoSetImp'{setInt = 88, - setOs = "A string"}}), - ?line {ok,{'choSetI-I',{'ChoSetImp',88,"A string"}}} = - asn1_wrapper:decode('ChoTypeRefSet','ChoTRset',lists:flatten(Bytes5)), - - - ?line {ok,Bytes6} = - asn1_wrapper:encode('ChoTypeRefSet','ChoTRset', - {'choSetE-I',#'ChoSetImp'{setInt = 88, - setOs = "A string"}}), - ?line {ok,{'choSetE-I',{'ChoSetImp',88,"A string"}}} = - asn1_wrapper:decode('ChoTypeRefSet','ChoTRset',lists:flatten(Bytes6)), - - - ?line {ok,Bytes7} = - asn1_wrapper:encode('ChoTypeRefSet','ChoTRset', - {'choSet-E',#'ChoSetExp'{setInt = 88, - setOs = "A string"}}), - ?line {ok,{'choSet-E',{'ChoSetExp',88,"A string"}}} = - asn1_wrapper:decode('ChoTypeRefSet','ChoTRset',lists:flatten(Bytes7)), - - - ?line {ok,Bytes8} = - asn1_wrapper:encode('ChoTypeRefSet','ChoTRset', - {'choSetI-E',#'ChoSetExp'{setInt = 88, - setOs = "A string"}}), - ?line {ok,{'choSetI-E',{'ChoSetExp',88,"A string"}}} = - asn1_wrapper:decode('ChoTypeRefSet','ChoTRset',lists:flatten(Bytes8)), - - - ?line {ok,Bytes9} = - asn1_wrapper:encode('ChoTypeRefSet','ChoTRset', - {'choSetE-E',#'ChoSetExp'{setInt = 88, - setOs = "A string"}}), - ?line {ok,{'choSetE-E',{'ChoSetExp',88,"A string"}}} = - asn1_wrapper:decode('ChoTypeRefSet','ChoTRset',lists:flatten(Bytes9)), - - - + roundtrip('ChoTRset', {choSet,#'ChoSet'{setInt=88,setOs="A string"}}), + roundtrip('ChoTRset', {choSetI,#'ChoSet'{setInt=88,setOs="A string"}}), + roundtrip('ChoTRset', {choSetE,#'ChoSet'{setInt=88,setOs="A string"}}), + roundtrip('ChoTRset', {'choSet-I',#'ChoSetImp'{setInt=88,setOs="A string"}}), + roundtrip('ChoTRset', {'choSetI-I',#'ChoSetImp'{setInt=88,setOs="A string"}}), + roundtrip('ChoTRset', {'choSetE-I',#'ChoSetImp'{setInt=88,setOs="A string"}}), + roundtrip('ChoTRset', {'choSet-E',#'ChoSetExp'{setInt=88,setOs="A string"}}), + roundtrip('ChoTRset', {'choSetI-E',#'ChoSetExp'{setInt=88,setOs="A string"}}), + roundtrip('ChoTRset', {'choSetE-E',#'ChoSetExp'{setInt=88,setOs="A string"}}), ok. + +roundtrip(Type, Value) -> + asn1_test_lib:roundtrip('ChoTypeRefSet', Type, Value). diff --git a/lib/asn1/test/testChoiceIndefinite.erl b/lib/asn1/test/testChoiceIndefinite.erl index b5832c985a..87910cf6ec 100644 --- a/lib/asn1/test/testChoiceIndefinite.erl +++ b/lib/asn1/test/testChoiceIndefinite.erl @@ -32,6 +32,6 @@ main(ber) -> Bi = [48,128,160,128,128,1,11,0,0,129,1,12,0,0], %% the value which is encoded V = {'Seq',{ca,11},12}, - ?line {ok,V} = asn1_wrapper:decode('ChoiceIndef','Seq',B), - ?line {ok,V} = asn1_wrapper:decode('ChoiceIndef','Seq',Bi), + {ok,V} = 'ChoiceIndef':decode('Seq', B), + {ok,V} = 'ChoiceIndef':decode('Seq', Bi), ok. diff --git a/lib/asn1/test/testConstraints.erl b/lib/asn1/test/testConstraints.erl index 03a09492af..34fbbcf6cc 100644 --- a/lib/asn1/test/testConstraints.erl +++ b/lib/asn1/test/testConstraints.erl @@ -122,6 +122,42 @@ int_constraints(Rules) -> range_error(Rules, 'X1', 21), %%========================================================== + %% Union of single values + %% Sv1 ::= INTEGER (2|3|17) + %% Sv2 ::= INTEGER (2|3|17, ...) + %% Sv3 ::= INTEGER {a(2),b(3),z(17)} (2|3|17, ...) + %%========================================================== + + range_error(Rules, 'Sv1', 1), + range_error(Rules, 'Sv1', 18), + roundtrip('Sv1', 2), + roundtrip('Sv1', 3), + roundtrip('Sv1', 7), + + %% Encoded as root + v_roundtrip(Rules, 'Sv2', 2), + v_roundtrip(Rules, 'Sv2', 3), + v_roundtrip(Rules, 'Sv2', 17), + + %% Encoded as extension + v_roundtrip(Rules, 'Sv2', 1), + v_roundtrip(Rules, 'Sv2', 4), + v_roundtrip(Rules, 'Sv2', 18), + + %% Encoded as root + v_roundtrip(Rules, 'Sv3', a), + v_roundtrip(Rules, 'Sv3', b), + v_roundtrip(Rules, 'Sv3', z), + v_roundtrip(Rules, 'Sv3', 2, a), + v_roundtrip(Rules, 'Sv3', 3, b), + v_roundtrip(Rules, 'Sv3', 17, z), + + %% Encoded as extension + v_roundtrip(Rules, 'Sv3', 1), + v_roundtrip(Rules, 'Sv3', 4), + v_roundtrip(Rules, 'Sv3', 18), + + %%========================================================== %% SemiConstrained %%========================================================== @@ -197,33 +233,54 @@ v(per, 'SemiConstrainedExt', 42+128) -> "000180"; v(uper, 'SemiConstrainedExt', 42+128) -> "00C000"; v(ber, 'NegSemiConstrainedExt', 0) -> "020100"; v(per, 'NegSemiConstrainedExt', 0) -> "000180"; -v(uper, 'NegSemiConstrainedExt', 0) -> "00C000". +v(uper, 'NegSemiConstrainedExt', 0) -> "00C000"; +v(ber, 'Sv2', 1) -> "020101"; +v(per, 'Sv2', 1) -> "800101"; +v(uper, 'Sv2', 1) -> "808080"; +v(ber, 'Sv2', 2) -> "020102"; +v(per, 'Sv2', 2) -> "00"; +v(uper, 'Sv2', 2) -> "00"; +v(ber, 'Sv2', 3) -> "020103"; +v(per, 'Sv2', 3) -> "08"; +v(uper, 'Sv2', 3) -> "08"; +v(ber, 'Sv2', 4) -> "020104"; +v(per, 'Sv2', 4) -> "800104"; +v(uper, 'Sv2', 4) -> "808200"; +v(ber, 'Sv2', 17) -> "020111"; +v(per, 'Sv2', 17) -> "78"; +v(uper, 'Sv2', 17) -> "78"; +v(ber, 'Sv2', 18) -> "020112"; +v(per, 'Sv2', 18) -> "800112"; +v(uper, 'Sv2', 18) -> "808900"; +v(Rule, 'Sv3', a) -> v(Rule, 'Sv2', 2); +v(Rule, 'Sv3', b) -> v(Rule, 'Sv2', 3); +v(Rule, 'Sv3', z) -> v(Rule, 'Sv2', 17); +v(Rule, 'Sv3', Val) when is_integer(Val) -> v(Rule, 'Sv2', Val). shorter_ext(per, "a") -> <<16#80,16#01,16#61>>; shorter_ext(uper, "a") -> <<16#80,16#E1>>; shorter_ext(ber, _) -> none. refed_NNL_name(_Erule) -> - ?line {ok,_} = asn1_wrapper:encode('Constraints','AnotherThing',fred), - ?line {error,_Reason} = - asn1_wrapper:encode('Constraints','AnotherThing',fred3). + roundtrip('AnotherThing', fred), + {error,_Reason} = 'Constraints':encode('AnotherThing', fred3). v_roundtrip(Erule, Type, Value) -> Encoded = asn1_test_lib:hex_to_bin(v(Erule, Type, Value)), Encoded = roundtrip('Constraints', Type, Value). +v_roundtrip(Erule, Type, Value, Expected) -> + Encoded = asn1_test_lib:hex_to_bin(v(Erule, Type, Value)), + Encoded = asn1_test_lib:roundtrip_enc('Constraints', Type, Value, Expected). + roundtrip(Type, Value) -> roundtrip('Constraints', Type, Value). roundtrip(Module, Type, Value) -> - {ok,Encoded} = Module:encode(Type, Value), - {ok,Value} = Module:decode(Type, Encoded), - Encoded. + asn1_test_lib:roundtrip_enc(Module, Type, Value). roundtrip_enc(Type, Value, Enc) -> - Module = 'Constraints', - {ok,Encoded} = Module:encode(Type, Value), - {ok,Value} = Module:decode(Type, Encoded), + Encoded = asn1_test_lib:roundtrip_enc('Constraints', Type, Value), case Enc of none -> ok; Encoded -> ok diff --git a/lib/asn1/test/testContextSwitchingTypes.erl b/lib/asn1/test/testContextSwitchingTypes.erl index 40dbe25015..bdd6883dac 100644 --- a/lib/asn1/test/testContextSwitchingTypes.erl +++ b/lib/asn1/test/testContextSwitchingTypes.erl @@ -24,31 +24,21 @@ -include_lib("test_server/include/test_server.hrl"). test(Config) -> - ?line ValT = 'ContextSwitchingTypes':'val1-T'(), - ?line {ok,Bytes1} = - asn1_wrapper:encode('ContextSwitchingTypes','T',ValT), - ?line {ok,Result1} = - asn1_wrapper:decode('ContextSwitchingTypes','T',Bytes1), - ?line ok = check_EXTERNAL(Result1), - ?line {ok,ValT2} = asn1ct:value('ContextSwitchingTypes','T', - [{i, ?config(case_dir, Config)}]), - ?line {ok,Bytes1_2} = - asn1_wrapper:encode('ContextSwitchingTypes','T',ValT2), - ?line {ok,Result1_2} = - asn1_wrapper:decode('ContextSwitchingTypes','T',Bytes1_2), - ?line ok = check_EXTERNAL(Result1_2), + ValT = 'ContextSwitchingTypes':'val1-T'(), + check_EXTERNAL(enc_dec('T', ValT)), - ?line ValEP = 'ContextSwitchingTypes':'val1-EP'(), - ?line {ok,Bytes2} = - asn1_wrapper:encode('ContextSwitchingTypes','EP',ValEP), - ?line {ok,_Result2} = - asn1_wrapper:decode('ContextSwitchingTypes','EP',Bytes2), + {ok,ValT2} = asn1ct:value('ContextSwitchingTypes', 'T', + [{i,?config(case_dir, Config)}]), + check_EXTERNAL(enc_dec('T', ValT2)), - ?line ValCS = 'ContextSwitchingTypes':'val1-CS'(), - ?line {ok,Bytes3} = - asn1_wrapper:encode('ContextSwitchingTypes','CS',ValCS), - ?line {ok,_Result3} = - asn1_wrapper:decode('ContextSwitchingTypes','CS',Bytes3). + ValEP = 'ContextSwitchingTypes':'val1-EP'(), + ValEPDec = enc_dec('EP', ValEP), + io:format("~p\n~p\n", [ValEP,ValEPDec]), + + ValCS = 'ContextSwitchingTypes':'val1-CS'(), + ValCSDec = enc_dec('EP', ValCS), + io:format("~p\n~p\n", [ValCS,ValCSDec]), + ok. check_EXTERNAL({'EXTERNAL',Identif,DVD,DV})-> @@ -85,3 +75,9 @@ check_object_identifier(Tuple) when is_tuple(Tuple) -> not is_integer(E)] of [] -> ok end. + +enc_dec(T, V0) -> + M = 'ContextSwitchingTypes', + {ok,Enc} = M:encode(T, V0), + {ok,V} = M:decode(T, Enc), + V. diff --git a/lib/asn1/test/testDER.erl b/lib/asn1/test/testDER.erl index 395116bd34..3f74a16797 100644 --- a/lib/asn1/test/testDER.erl +++ b/lib/asn1/test/testDER.erl @@ -25,26 +25,24 @@ test() -> Val = {'Set',12,{version,214},true}, - ?line {ok,Bin}=asn1_wrapper:encode('DERSpec','Set',Val), - ?line ok = match_value('Set',Bin), - ?line {ok,{'Set',12,{version,214},true}} = - asn1_wrapper:decode('DERSpec','Set',Bin), + roundtrip_enc('Set', Val, <<49,12,1,1,255,2,2,0,214,161,3,2,1,12>>), - ValSof = [{version,12},{message,"PrintableString"},{message,"Print"},{version,11}], - ?line {ok,BSof} = asn1_wrapper:encode('DERSpec','SetOf',ValSof), - ?line ok = match_value('SetOf',BSof), - ?line {ok,[{version,11},{version,12},{message,"Print"},{message,"PrintableString"}]} = asn1_wrapper:decode('DERSpec','SetOf',BSof), + ValSof = [{version,12},{message,"PrintableString"}, + {message,"Print"},{version,11}], + ValSofSorted = [{version,11},{version,12}, + {message,"Print"},{message,"PrintableString"}], + roundtrip_enc('SetOf', ValSof, ValSofSorted, + <<49,30,2,1,11,2,1,12,19,5,80,114,105,110,116,19,15,80, + 114,105,110,116,97,98,108,101,83,116,114,105,110,103>>), ValSO = [{'Seq2',1,true},{'Seq2',120000,false},{'Seq2',3,true}], - ?line {ok,SOB} = asn1_wrapper:encode('DERSpec','SO',ValSO), - ?line {ok,ValSO} = asn1_wrapper:decode('DERSpec','SO',SOB). + roundtrip('SO', ValSO). +roundtrip(T, V) -> + asn1_test_lib:roundtrip('DERSpec', T, V). -match_value('Set',<<49,12,1,1,255,2,2,0,214,161,3,2,1,12>>) -> - ok; -match_value('Set',[49,12,1,1,255,2,2,0,214,161,3,2,1,12]) -> - ok; -match_value('SetOf',<<49,30,2,1,11,2,1,12,19,5,80,114,105,110,116,19,15,80,114,105,110,116,97,98,108,101,83,116,114,105,110,103>>) -> ok; -match_value('SetOf',[49,30,2,1,11,2,1,12,19,5,80,114,105,110,116,19,15,80,114,105,110,116,97,98,108,101,83,116,114,105,110,103]) -> ok; -match_value(_,B) -> - {error,B}. +roundtrip_enc(T, V, Enc) -> + Enc = asn1_test_lib:roundtrip_enc('DERSpec', T, V). + +roundtrip_enc(T, V, Expected, Enc) -> + Enc = asn1_test_lib:roundtrip_enc('DERSpec', T, V, Expected). diff --git a/lib/asn1/test/testDeepTConstr.erl b/lib/asn1/test/testDeepTConstr.erl index f17dedc043..880f15e91a 100644 --- a/lib/asn1/test/testDeepTConstr.erl +++ b/lib/asn1/test/testDeepTConstr.erl @@ -40,8 +40,7 @@ main(_Erule) -> {any,"DK"}, {final,"NO"}]}}, - {ok,Bytes1} = 'TConstrChoice':encode('FilterItem', Val1), - {error,Reason} = asn1_wrapper:decode('TConstrChoice','FilterItem',Bytes1), + Reason = must_fail('TConstrChoice', 'FilterItem', Val1), io:format("Reason: ~p~n~n",[Reason]), {ok,Bytes2} = 'TConstrChoice':encode('FilterItem', Val2), {ok,Res} = 'TConstrChoice':decode('FilterItem', Bytes2), @@ -70,10 +69,33 @@ main(_Erule) -> {'Deeper_a',12, {'Deeper_a_s',{2,4},42}}, {'Deeper_b',13,{'Type-object1',14,true}}}), + + roundtrip('TConstr', 'Seq3', + {'Seq3', + {'Seq3_a',42,'TConstr':'id-object1'()}, + {'Seq3_b', + {'Type-object1',-777,true}, + 12345, + {'Seq3_b_bc',12345789,{'Type-object1',-999,true}}}}), + roundtrip('TConstr', 'Seq3-Opt', + {'Seq3-Opt', + {'Seq3-Opt_a',42,'TConstr':'id-object1'()}, + {'Seq3-Opt_b', + {'Type-object1',-777,true}, + 12345, + {'Seq3-Opt_b_bc',12345789,{'Type-object1',-999,true}}}}), ok. roundtrip(M, T, V) -> - {ok,E} = M:encode(T, V), - {ok,V} = M:decode(T, E), - ok. + asn1_test_lib:roundtrip(M, T, V). + +%% Either encoding or decoding must fail. +must_fail(M, T, V) -> + case M:encode(T, V) of + {ok,E} -> + {error,Reason} = M:decode(T, E), + Reason; + {error,Reason} -> + Reason + end. diff --git a/lib/asn1/test/testDef.erl b/lib/asn1/test/testDef.erl index 48f0015008..b8df3c4f8b 100644 --- a/lib/asn1/test/testDef.erl +++ b/lib/asn1/test/testDef.erl @@ -37,81 +37,45 @@ bool33 = asn1_DEFAULT}). main(_Rules) -> - - ?line {ok,Bytes11} = asn1_wrapper:encode('Def','Def1',#'Def1'{bool0 = true, - bool1 = true, - bool2 = true, - bool3 = true}), - ?line {ok,{'Def1',true,true,true,true}} = - asn1_wrapper:decode('Def','Def1',lists:flatten(Bytes11)), - - ?line {ok,Bytes12} = asn1_wrapper:encode('Def','Def1',#'Def1'{bool0 = true}), - ?line {ok,{'Def1',true,false,false,false}} = - asn1_wrapper:decode('Def','Def1',lists:flatten(Bytes12)), - - ?line {ok,Bytes13} = asn1_wrapper:encode('Def','Def1',#'Def1'{bool0 = true, - bool2 = false}), - ?line {ok,{'Def1',true,false,false,false}} = - asn1_wrapper:decode('Def','Def1',lists:flatten(Bytes13)), - - ?line {ok,Bytes14} = asn1_wrapper:encode('Def','Def1',#'Def1'{bool0 = false, - bool3 = false}), - ?line {ok,{'Def1',false,false,false,false}} = - asn1_wrapper:decode('Def','Def1',lists:flatten(Bytes14)), - - - - - ?line {ok,Bytes21} = asn1_wrapper:encode('Def','Def2',#'Def2'{bool10 = false, - bool11 = false, - bool12 = false, - bool13 = false}), - ?line {ok,{'Def2',false,false,false,false}} = - asn1_wrapper:decode('Def','Def2',lists:flatten(Bytes21)), - - ?line {ok,Bytes22} = asn1_wrapper:encode('Def','Def2',#'Def2'{bool10 = true, - bool13 = false}), - ?line {ok,{'Def2',true,false,false,false}} = - asn1_wrapper:decode('Def','Def2',lists:flatten(Bytes22)), - - ?line {ok,Bytes23} = asn1_wrapper:encode('Def','Def2',#'Def2'{bool10 = true, - bool11 = false, - bool13 = false}), - ?line {ok,{'Def2',true,false,false,false}} = - asn1_wrapper:decode('Def','Def2',lists:flatten(Bytes23)), - - ?line {ok,Bytes24} = asn1_wrapper:encode('Def','Def2',#'Def2'{bool10 = false, - bool12 = false, - bool13 = false}), - ?line {ok,{'Def2',false,false,false,false}} = - asn1_wrapper:decode('Def','Def2',lists:flatten(Bytes24)), - - - - - ?line {ok,Bytes31} = asn1_wrapper:encode('Def','Def3',#'Def3'{bool30 = false, - bool31 = false, - bool32 = false, - bool33 = false}), - ?line {ok,{'Def3',false,false,false,false}} = - asn1_wrapper:decode('Def','Def3',lists:flatten(Bytes31)), - - ?line {ok,Bytes32} = asn1_wrapper:encode('Def','Def3',#'Def3'{}), - ?line {ok,{'Def3',false,false,false,false}} = - asn1_wrapper:decode('Def','Def3',lists:flatten(Bytes32)), - - ?line {ok,Bytes33} = asn1_wrapper:encode('Def','Def3',#'Def3'{bool30 = true}), - ?line {ok,{'Def3',true,false,false,false}} = - asn1_wrapper:decode('Def','Def3',lists:flatten(Bytes33)), - - ?line {ok,Bytes34} = asn1_wrapper:encode('Def','Def3',#'Def3'{bool32 = false}), - ?line {ok,{'Def3',false,false,false,false}} = - asn1_wrapper:decode('Def','Def3',lists:flatten(Bytes34)), - - ?line {ok,Bytes35} = asn1_wrapper:encode('Def','Def3',#'Def3'{bool33 = false}), - ?line {ok,{'Def3',false,false,false,false}} = - asn1_wrapper:decode('Def','Def3',lists:flatten(Bytes35)), - - - + roundtrip('Def1', #'Def1'{bool0=true,bool1=true,bool2=true,bool3=true}), + roundtrip('Def1', + #'Def1'{bool0=true}, + #'Def1'{bool0=true,bool1=false,bool2=false,bool3=false}), + roundtrip('Def1', + #'Def1'{bool0=true,bool2=false}, + #'Def1'{bool0=true,bool1=false,bool2=false,bool3=false}), + roundtrip('Def1', + #'Def1'{bool0=false,bool3=false}, + #'Def1'{bool0=false,bool1=false,bool2=false,bool3=false}), + + roundtrip('Def2', #'Def2'{bool10=false,bool11=false,bool12=false,bool13=false}), + roundtrip('Def2', + #'Def2'{bool10=true,bool13=false}, + #'Def2'{bool10=true,bool11=false,bool12=false,bool13=false}), + roundtrip('Def2', + #'Def2'{bool10=true,bool11=false,bool13=false}, + #'Def2'{bool10=true,bool11=false,bool12=false,bool13=false}), + roundtrip('Def2', + #'Def2'{bool10=false,bool12=false,bool13=false}, + #'Def2'{bool10=false,bool11=false,bool12=false,bool13=false}), + + roundtrip('Def3', #'Def3'{bool30=false,bool31=false,bool32=false,bool33=false}), + roundtrip('Def3', + #'Def3'{}, + #'Def3'{bool30=false,bool31=false,bool32=false,bool33=false}), + roundtrip('Def3', + #'Def3'{bool30=true}, + #'Def3'{bool30=true,bool31=false,bool32=false,bool33=false}), + roundtrip('Def3', + #'Def3'{bool32=false}, + #'Def3'{bool30=false,bool31=false,bool32=false,bool33=false}), + roundtrip('Def3', + #'Def3'{bool33=false}, + #'Def3'{bool30=false,bool31=false,bool32=false,bool33=false}), ok. + +roundtrip(Type, Value) -> + roundtrip(Type, Value, Value). + +roundtrip(Type, Value, ExpectedValue) -> + asn1_test_lib:roundtrip('Def', Type, Value, ExpectedValue). diff --git a/lib/asn1/test/testDoubleEllipses.erl b/lib/asn1/test/testDoubleEllipses.erl index 1032156b91..4e8972cdfc 100644 --- a/lib/asn1/test/testDoubleEllipses.erl +++ b/lib/asn1/test/testDoubleEllipses.erl @@ -34,67 +34,27 @@ -record('SetAltV2',{a,d,b,e,h,i,c,f,g}). main(_Rules) -> - %% SEQUENCE - ?line {ok,Bytes} = - asn1_wrapper:encode('DoubleEllipses','Seq',#'Seq'{a = 10,c = true}), - ?line {ok,#'SeqV2'{a=10,b = asn1_NOVALUE, c = true}} = - asn1_wrapper:decode('DoubleEllipses','SeqV2',Bytes), - ?line {ok,Bytes2} = - asn1_wrapper:encode('DoubleEllipses','SeqV2', - #'SeqV2'{a=10,b = false, c = true}), - ?line {ok,#'Seq'{a = 10, c = true}} = - asn1_wrapper:decode('DoubleEllipses','Seq',Bytes2), + roundtrip('Seq', #'Seq'{a=10,c=true}), + roundtrip('SeqV2', #'SeqV2'{a=10,b=false,c=true}), + roundtrip('SeqAlt', + #'SeqAlt'{a=10,d=12,b = <<2#1010:4>>, + e=true,c=false,f=14,g=16}), + roundtrip('SeqAltV2', + #'SeqAltV2'{a=10,d=12, + b = <<2#1010:4>>, + e=true,h="PS",i=13,c=false,f=14,g=16}), - ?line {ok,Bytes3} = - asn1_wrapper:encode('DoubleEllipses','SeqAlt', - #'SeqAlt'{a = 10, d = 12, - b = [1,0,1,0], e = true, - c = false, f = 14, g = 16}), - ?line {ok,#'SeqAltV2'{a = 10, d = 12, - b = <<2#1010:4>>, e = true, - h = asn1_NOVALUE, i = asn1_NOVALUE, - c = false, f = 14, g = 16}} = - asn1_wrapper:decode('DoubleEllipses','SeqAltV2',Bytes3), - ?line {ok,Bytes4} = - asn1_wrapper:encode('DoubleEllipses','SeqAltV2', - #'SeqAltV2'{a = 10, d = 12, - b = [1,0,1,0], e = true, - h = "PS", i = 13, - c = false, f = 14, g = 16}), - ?line {ok,#'SeqAlt'{a = 10, d = 12, - b = <<2#1010:4>>, e = true, - c = false, f = 14, g = 16}} = - asn1_wrapper:decode('DoubleEllipses','SeqAlt',Bytes4), - - %% SET - ?line {ok,Bytes5} = - asn1_wrapper:encode('DoubleEllipses','Set',#'Set'{a = 10,c = true}), - ?line {ok,#'SetV2'{a=10,b = asn1_NOVALUE, c = true}} = - asn1_wrapper:decode('DoubleEllipses','SetV2',Bytes5), - ?line {ok,Bytes6} = - asn1_wrapper:encode('DoubleEllipses','SetV2', - #'SetV2'{a=10,b = false, c = true}), - ?line {ok,#'Set'{a = 10, c = true}} = - asn1_wrapper:decode('DoubleEllipses','Set',Bytes6), - - ?line {ok,Bytes7} = - asn1_wrapper:encode('DoubleEllipses','SetAlt', - #'SetAlt'{a = 10, d = 12, - b = [1,0,1,0], e = true, - c = false, f = 14, g = 16}), - ?line {ok,#'SetAltV2'{a = 10, d = 12, - b = <<2#1010:4>>, e = true, - h = asn1_NOVALUE, i = asn1_NOVALUE, - c = false, f = 14, g = 16}} = - asn1_wrapper:decode('DoubleEllipses','SetAltV2',Bytes7), - ?line {ok,Bytes8} = - asn1_wrapper:encode('DoubleEllipses','SetAltV2', - #'SetAltV2'{a = 10, d = 12, - b = [1,0,1,0], e = true, - h = "PS", i = 13, - c = false, f = 14, g = 16}), - ?line {ok,#'SetAlt'{a = 10, d = 12, - b = <<2#1010:4>>, e = true, - c = false, f = 14, g = 16}} = - asn1_wrapper:decode('DoubleEllipses','SetAlt',Bytes8), + roundtrip('Set', #'Set'{a=10,c=true}), + roundtrip('SetV2', #'SetV2'{a=10,b=false,c=true}), + roundtrip('SetAlt', + #'SetAlt'{a=10,d=12, + b = <<2#1010:4>>, + e=true,c=false,f=14,g=16}), + roundtrip('SetAltV2', + #'SetAltV2'{a=10,d=12, + b = <<2#1010:4>>, + e=true,h="PS",i=13,c=false,f=14,g=16}), ok. + +roundtrip(T, V) -> + asn1_test_lib:roundtrip('DoubleEllipses', T, V). diff --git a/lib/asn1/test/testEnumExt.erl b/lib/asn1/test/testEnumExt.erl index cbc13ee6da..c66adaf949 100644 --- a/lib/asn1/test/testEnumExt.erl +++ b/lib/asn1/test/testEnumExt.erl @@ -33,7 +33,7 @@ main(Rule) when Rule =:= per; Rule =:= uper -> %% ENUMERATED with extensionmark (value is an extensionvalue) Or = roundtrip('Ext1', orange), %% unknown extensionvalue - {ok,{asn1_enum,0}} = asn1_wrapper:decode('EnumExt','Ext',Or), + {ok,{asn1_enum,0}} = 'EnumExt':decode('Ext', Or), %% ENUMERATED no extensionmark B64 = <<64>>, @@ -45,12 +45,12 @@ main(ber) -> roundtrip('Ext', red), %% value is an extensionvalue - {ok,Bytes1_1} = asn1_wrapper:encode('EnumExt','Ext1',orange), - {ok,{asn1_enum,7}} = asn1_wrapper:decode('EnumExt','Ext',lists:flatten(Bytes1_1)), + {ok,Bytes1_1} = 'EnumExt':encode('Ext1', orange), + {ok,{asn1_enum,7}} = 'EnumExt':decode('Ext', Bytes1_1), %% ENUMERATED no extensionmark roundtrip('Noext', red), - ?line {error,{asn1,_}} = (catch asn1_wrapper:encode('EnumExt','Noext',orange)), + {error,{asn1,_}} = (catch 'EnumExt':encode('Noext', orange)), %% ENUMERATED with atom 'com' roundtrip('Globalstate', preop), @@ -77,9 +77,7 @@ common(Erule) -> ok. roundtrip(Type, Value) -> - {ok,Encoded} = 'EnumExt':encode(Type, Value), - {ok,Value} = 'EnumExt':decode(Type, Encoded), - Encoded. + asn1_test_lib:roundtrip_enc('EnumExt', Type, Value). v_roundtrip(Erule, Type, Value) -> Encoded = roundtrip(Type, Value), diff --git a/lib/asn1/test/testFragmented.erl b/lib/asn1/test/testFragmented.erl new file mode 100644 index 0000000000..8d5fa07a5b --- /dev/null +++ b/lib/asn1/test/testFragmented.erl @@ -0,0 +1,40 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(testFragmented). + +-export([main/1]). + +main(_Erule) -> + roundtrip('PDU', {'PDU',1,false,["abc","def"]}), + B256 = lists:seq(0, 255), + K1 = lists:duplicate(4, B256), + K8 = binary_to_list(iolist_to_binary(lists:duplicate(8, K1))), + roundtrip('PDU', {'PDU',1,false,[K8,K8]}), + roundtrip('PDU', {'PDU',1,false,[K8,K8,K8,K8]}), + roundtrip('PDU', {'PDU',1,false,[K8,K8,K8,K8,K8,K8]}), + roundtrip('PDU', {'PDU',1,false,[K8,K8,K8,K8,K8,K8,K8,K8]}), + roundtrip('PDU', {'PDU',1,false,[K8,K8,K8,K8,K8,K8,K8,K8, + K8,K8,K8,K8,K8,K8]}), + roundtrip('PDU', {'PDU',1,false,[K8,K8,K8,K8,K8,K8,K8,K8, + K8,K8,K8,K8,K8,K8,K8,K8]}), + ok. + +roundtrip(T, V) -> + asn1_test_lib:roundtrip('Fragmented', T, V). diff --git a/lib/asn1/test/testINSTANCE_OF.erl b/lib/asn1/test/testINSTANCE_OF.erl index ce411beb92..c855ca3c06 100644 --- a/lib/asn1/test/testINSTANCE_OF.erl +++ b/lib/asn1/test/testINSTANCE_OF.erl @@ -18,46 +18,23 @@ %% %% -module(testINSTANCE_OF). - -export([main/1]). -include_lib("test_server/include/test_server.hrl"). -main(Erule) -> +main(_Erule) -> + Int = roundtrip('Int', 3), - ?line {ok,Integer} = asn1_wrapper:encode('INSTANCEOF','Int',3), - Int = list_to_binary(Integer), ValotherName = {otherName,{'INSTANCE OF',{2,4},Int}}, + _ = roundtrip('GeneralName', ValotherName), + VallastName1 = {lastName,{'GeneralName_lastName',{2,4},12}}, + _ = roundtrip('GeneralName', VallastName1), + VallastName2 = {lastName,{'GeneralName_lastName',{2,3,4}, {'Seq',12,true}}}, - ?line {ok,BytesoN}= - asn1_wrapper:encode('INSTANCEOF','GeneralName',ValotherName), - ?line {ok,Res1={otherName,_}} = - asn1_wrapper:decode('INSTANCEOF','GeneralName',BytesoN), - ?line ok = test_encdec(Erule,Int,Res1), - - ?line {ok,ByteslN1}= - asn1_wrapper:encode('INSTANCEOF','GeneralName',VallastName1), - ?line {ok,Res2={lastName,_}} = - asn1_wrapper:decode('INSTANCEOF','GeneralName',ByteslN1), - ?line test_encdec(Erule,Res2), - - ?line {ok,ByteslN2}= - asn1_wrapper:encode('INSTANCEOF','GeneralName',VallastName2), - ?line {ok,Res3={lastName,_}} = - asn1_wrapper:decode('INSTANCEOF','GeneralName',ByteslN2), - ?line test_encdec(Erule,Res3). - -test_encdec(_Erule,Int,{otherName,{'INSTANCE OF',{2,4},Int}}) -> - ok; -test_encdec(Erule,Int,R={otherName,{'INSTANCE OF',{2,4},_Int2}}) -> - {error,{Erule,Int,R}}. + _ = roundtrip('GeneralName', VallastName2), + ok. -test_encdec(_Erule,{lastName,{'GeneralName_lastName',{2,4},12}}) -> - ok; -test_encdec(_Erule,{lastName,{'GeneralName_lastName',{2,3,4}, - {'Seq',12,true}}}) -> - ok; -test_encdec(Erule,Res) -> - {error,{Erule,Res}}. +roundtrip(T, V) -> + asn1_test_lib:roundtrip_enc('INSTANCEOF', T, V). diff --git a/lib/asn1/test/testInfObj.erl b/lib/asn1/test/testInfObj.erl index c7b19a0cbb..cd335e1023 100644 --- a/lib/asn1/test/testInfObj.erl +++ b/lib/asn1/test/testInfObj.erl @@ -59,13 +59,71 @@ main(_Erule) -> {'ConstructedPdu',2,{'CONSTRUCTED-DEFAULT_Type',999,false}}), roundtrip('InfObj', 'ConstructedPdu', {'ConstructedPdu',3,true}), + {'ConstructedPdu',4,{_,42,<<13:7>>}} = + enc_dec('InfObj', 'ConstructedPdu', + {'ConstructedPdu',4,{'',42,<<13:7>>}}), + roundtrip('InfObj', 'ConstructedPdu', + {'ConstructedPdu',5,{i,-250138}}), + roundtrip('InfObj', 'ConstructedPdu', + {'ConstructedPdu',5,{b,<<13456:15>>}}), + roundtrip('InfObj', 'ConstructedPdu', + {'ConstructedPdu',6,[]}), + roundtrip('InfObj', 'ConstructedPdu', + {'ConstructedPdu',6,[10,7,16,1,5,13,12]}), + roundtrip('InfObj', 'ConstructedPdu', + {'ConstructedPdu',7,[]}), + roundtrip('InfObj', 'ConstructedPdu', + {'ConstructedPdu',7,[64,1,19,17,35]}), + + roundtrip('InfObj', 'ConstructedSet', + {'ConstructedSet',1,{'CONSTRUCTED-DEFAULT_Type',-2001,true}}), + roundtrip('InfObj', 'ConstructedSet', + {'ConstructedSet',2,{'CONSTRUCTED-DEFAULT_Type',999,false}}), + roundtrip('InfObj', 'ConstructedSet', + {'ConstructedSet',3,true}), + {'ConstructedSet',4,{_,42,<<13:7>>}} = + enc_dec('InfObj', 'ConstructedSet', + {'ConstructedSet',4,{'',42,<<13:7>>}}), + roundtrip('InfObj', 'ConstructedSet', + {'ConstructedSet',5,{i,-250138}}), + roundtrip('InfObj', 'ConstructedSet', + {'ConstructedSet',5,{b,<<13456:15>>}}), + roundtrip('InfObj', 'ConstructedSet', + {'ConstructedSet',6,[]}), + roundtrip('InfObj', 'ConstructedSet', + {'ConstructedSet',6,[10,7,16,1,5,13,12]}), + roundtrip('InfObj', 'ConstructedSet', + {'ConstructedSet',7,[]}), + roundtrip('InfObj', 'ConstructedSet', + {'ConstructedSet',7,[64,1,19,17,35]}), roundtrip('InfObj', 'Seq2', {'Seq2',42,[true,false,false,true], - [false,true,false]}). + [false,true,false]}), + + roundtrip('InfObj', 'OptionalInSeq', {'OptionalInSeq',3,true}), + roundtrip('InfObj', 'OptionalInSeq', {'OptionalInSeq',3,asn1_NOVALUE}), + roundtrip('InfObj', 'DefaultInSeq', {'DefaultInSeq',3,false}), + roundtrip('InfObj', 'DefaultInSeq', {'DefaultInSeq',3,true}), + {'DefaultInSeq',3,true} = + enc_dec('InfObj', 'DefaultInSeq', {'DefaultInSeq',3,asn1_DEFAULT}), + + roundtrip('InfObj', 'Multiple-Optionals', + {'Multiple-Optionals',1,42,true,"abc"}), + roundtrip('InfObj', 'Multiple-Optionals', + {'Multiple-Optionals',1,asn1_NOVALUE,true,"abc"}), + roundtrip('InfObj', 'Multiple-Optionals', + {'Multiple-Optionals',1,42,asn1_NOVALUE,"abc"}), + roundtrip('InfObj', 'Multiple-Optionals', + {'Multiple-Optionals',1,42,true,asn1_NOVALUE}), + roundtrip('InfObj', 'Multiple-Optionals', + {'Multiple-Optionals',1,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}). roundtrip(M, T, V) -> - {ok,Enc} = M:encode(T, V), + asn1_test_lib:roundtrip(M, T, V). + +enc_dec(M, T, V0) -> + {ok,Enc} = M:encode(T, V0), {ok,V} = M:decode(T, Enc), - ok. + V. diff --git a/lib/asn1/test/testInfObjectClass.erl b/lib/asn1/test/testInfObjectClass.erl index 98408502c6..c36c05a2ea 100644 --- a/lib/asn1/test/testInfObjectClass.erl +++ b/lib/asn1/test/testInfObjectClass.erl @@ -29,24 +29,22 @@ main(Rule) -> %% this test is added for OTP-4591, to test that elements in decoded %% value has terms in right order. Val = {'Seq',12,13,2}, - ?line {ok,Bytes}= asn1_wrapper:encode('InfClass','Seq',Val), - ?line {ok,Val} = asn1_wrapper:decode('InfClass','Seq',Bytes), + roundtrip('Seq', Val), %% OTP-5783 - ?line {error,{asn1,{'Type not compatible with table constraint', - {component,'ArgumentType'}, - {value,_},_}}} = asn1_wrapper:encode('InfClass','Seq', - {'Seq',12,13,1}), + {error,{asn1,{'Type not compatible with table constraint', + {component,'ArgumentType'}, + {value,_},_}}} = 'InfClass':encode('Seq', {'Seq',12,13,1}), Bytes2 = case Rule of ber -> <<48,9,2,1,12,2,1,11,2,1,1>>; _ -> - <<1,12,1,11,1,1>> + <<1,12,1,11,1,1>> end, - ?line {error,{asn1,{'Type not compatible with table constraint', - {{component,_}, - {value,_B},_}}}} = - asn1_wrapper:decode('InfClass','Seq',Bytes2). + {error,{asn1,{'Type not compatible with table constraint', + {{component,_}, + {value,_B},_}}}} = 'InfClass':decode('Seq', Bytes2), + ok. - - +roundtrip(T, V) -> + asn1_test_lib:roundtrip('InfClass', T, V). diff --git a/lib/asn1/test/testMegaco.erl b/lib/asn1/test/testMegaco.erl index f4edcebb7e..644042b484 100644 --- a/lib/asn1/test/testMegaco.erl +++ b/lib/asn1/test/testMegaco.erl @@ -20,165 +20,28 @@ -module(testMegaco). --export([compile/3,main/2,msg11/0]). +-export([compile/3,main/2]). -include_lib("test_server/include/test_server.hrl"). --define(MID, {ip4Address, #'IP4Address'{address = [124, 124, 124, 222], - portNumber = 55555}}). --define(A4444, ["11111111"]). --record('MegacoMessage', - { - authHeader = asn1_NOVALUE, - mess - }). - --record('Message', - { - version, - mId, - messageBody - }). % with extension mark - --record('IP4Address', - { - address, - portNumber = asn1_NOVALUE - }). - --record('TransactionRequest', - { - transactionId, - actions = [] - }). % with extension mark - --record('ActionRequest', - { - contextId, - contextRequest = asn1_NOVALUE, - contextAttrAuditReq = asn1_NOVALUE, - commandRequests = [] - }). - --record('CommandRequest', - { - command, - optional = asn1_NOVALUE, - wildcardReturn = asn1_NOVALUE - }). % with extension mark - --record('NotifyRequest', - { - terminationID, - observedEventsDescriptor, - errorDescriptor = asn1_NOVALUE - }). % with extension mark - --record('ObservedEventsDescriptor', - { - requestId, - observedEventLst = [] - }). - --record('ObservedEvent', - { - eventName, - streamID = asn1_NOVALUE, - eventParList = [], - timeNotation = asn1_NOVALUE - }). % with extension mark - --record('EventParameter', - { - eventParameterName, - value - }). - --record('TimeNotation', - { - date, - time - }). - --record(megaco_term_id, {contains_wildcards = ["f"], id}). - - -compile(_Config,ber,[optimize]) -> - {ok,no_module,no_module}; -compile(_Config,per,[optimize]) -> - {ok,no_module,no_module}; -compile(Config,Erule,Options) -> +compile(Config, Erule, Options) -> asn1_test_lib:compile("MEDIA-GATEWAY-CONTROL.asn", Config, [Erule|Options]), asn1_test_lib:compile("OLD-MEDIA-GATEWAY-CONTROL.asn", Config, [Erule|Options]), {ok,'OLD-MEDIA-GATEWAY-CONTROL','MEDIA-GATEWAY-CONTROL'}. - main(no_module,_) -> ok; main('OLD-MEDIA-GATEWAY-CONTROL',Config) -> -% Msg = msg11(), CaseDir = ?config(case_dir, Config), {ok,Msg} = asn1ct:value('OLD-MEDIA-GATEWAY-CONTROL','MegacoMessage', [{i, CaseDir}]), - ?line {ok,Bytes} = asn1_wrapper:encode('OLD-MEDIA-GATEWAY-CONTROL', - 'MegacoMessage',Msg), - ?line {ok,Msg} = asn1_wrapper:decode('OLD-MEDIA-GATEWAY-CONTROL', - 'MegacoMessage', - Bytes), + asn1_test_lib:roundtrip('OLD-MEDIA-GATEWAY-CONTROL', 'MegacoMessage', Msg), ok; -main(Mod='MEDIA-GATEWAY-CONTROL',Config) -> - ?line DataDir = ?config(data_dir,Config), - io:format("DataDir:~p~n",[DataDir]), - ?line {ok,FilenameList} = file:list_dir(filename:join([DataDir, - megacomessages])), - %% remove any junk files that may be in the megacomessage directory - Pred = fun(X) -> - case lists:reverse(X) of - [$l,$a,$v,$.|_R] ->true; - _ -> false - end - end, - MegacoMsgFilenameList = lists:filter(Pred,FilenameList), - - Fun = fun(F) -> - M = read_msg(filename:join([DataDir,megacomessages,F])), - {ok,B} = asn1_wrapper:encode(Mod,element(1,M),M), - {ok,M} = asn1_wrapper:decode(Mod,element(1,M),B) - end, - ?line lists:foreach(Fun,MegacoMsgFilenameList), - ok. - -read_msg(File) -> - case file:read_file(File) of - {ok,Bin} -> - binary_to_term(Bin); - _ -> - io:format("couldn't read file ~p~n",[File]) - end. - - -request(Mid, TransId, ContextId, CmdReq) when is_list(CmdReq) -> - Actions = [#'ActionRequest'{contextId = ContextId, - commandRequests = CmdReq}], - Req = {transactions, - [{transactionRequest, - #'TransactionRequest'{transactionId = TransId, - actions = Actions}}]}, - #'MegacoMessage'{mess = #'Message'{version = 1, - mId = Mid, - messageBody = Req}}. - -msg11() -> - TimeStamp = #'TimeNotation'{date = "19990729", - time = "22012001"}, - Parm = #'EventParameter'{eventParameterName = "ds", - value = "916135551212"}, - - Event = #'ObservedEvent'{eventName = "ddce", - timeNotation = TimeStamp, - eventParList = [Parm]}, - Desc = #'ObservedEventsDescriptor'{requestId = 2223, - observedEventLst = [Event]}, - NotifyReq = #'NotifyRequest'{terminationID = [#megaco_term_id{id = ?A4444}], - observedEventsDescriptor = Desc}, - CmdReq = #'CommandRequest'{command = {notifyReq, NotifyReq}}, - request(?MID, 10002, 0, [CmdReq]). +main('MEDIA-GATEWAY-CONTROL'=Mod, Config) -> + DataDir = ?config(data_dir, Config), + Files = filelib:wildcard(filename:join([DataDir,megacomessages,"*.val"])), + lists:foreach(fun(File) -> + {ok,Bin} = file:read_file(File), + V = binary_to_term(Bin), + T = element(1, V), + asn1_test_lib:roundtrip(Mod, T, V) + end, Files). diff --git a/lib/asn1/test/testMergeCompile.erl b/lib/asn1/test/testMergeCompile.erl index 8ef7ba3458..7cda71c441 100644 --- a/lib/asn1/test/testMergeCompile.erl +++ b/lib/asn1/test/testMergeCompile.erl @@ -30,42 +30,35 @@ main(Erule) -> %% test of module MS.set.asn that tests OTP-4492: different tagdefault in %% modules and types with same name in modules - ?line MSVal = {'Type4M2',8,true,three,"OCTET STRING"}, - ?line {ok,MSBytes} = asn1_wrapper:encode('MS','Type4M2',MSVal), - ?line {ok,MSVal} = asn1_wrapper:decode('MS','Type4M2',MSBytes), - + MSVal = {'Type4M2',8,true,three,"OCTET STRING"}, + asn1_test_lib:roundtrip('MS', 'Type4M2', MSVal), %% test of RANAP.set.asn1 - ?line _PIEVal = [{'ProtocolIE-Field',4,ignore,{'Cause',{radioNetwork,{'CauseRadioNetwork','rab-pre-empted'}}}}], PIEVal2 = [{'ProtocolIE-Field',4,ignore,{radioNetwork,'rab-pre-empted'}}], - ?line _PEVal = [{'ProtocolExtensionField',[0]}], -%% ?line EncVal = asn1rt_per_v1:encode_integer([],100), - ?line EncVal = + EncVal = case Erule of per -> <<1,100>>; uper -> <<1,100>>; ber -> - [2,1,1] + <<2,1,1>> end, - ?line PEVal2 = [{dummy,1,ignore,EncVal},{dummy,2,reject,EncVal}], - ?line Val2 = + PEVal2 = [{'ProtocolExtensionField',1,ignore,EncVal}, + {'ProtocolExtensionField',2,reject,EncVal}], + Val2 = #'InitiatingMessage'{procedureCode=1, criticality=ignore, value=#'Iu-ReleaseCommand'{protocolIEs=PIEVal2, protocolExtensions=asn1_NOVALUE}}, - ?line {ok,Bytes2} = asn1_wrapper:encode('RANAPSET','InitiatingMessage',Val2), - ?line {ok,_Ret2} = asn1_wrapper:decode('RANAPSET','InitiatingMessage',Bytes2), - - ?line Val3 = + asn1_test_lib:roundtrip('RANAPSET', 'InitiatingMessage', Val2), + Val3 = #'InitiatingMessage'{procedureCode=1, criticality=ignore, value=#'Iu-ReleaseCommand'{protocolIEs=PIEVal2, protocolExtensions=PEVal2}}, - ?line {ok,Bytes3} = asn1_wrapper:encode('RANAPSET','InitiatingMessage',Val3), - ?line {ok,_Ret3} = asn1_wrapper:decode('RANAPSET','InitiatingMessage',Bytes3). + asn1_test_lib:roundtrip('RANAPSET', 'InitiatingMessage', Val3). mvrasn(Erule) -> @@ -83,78 +76,73 @@ mvrasn(Erule) -> ?line ok = test(mvrasn6,'InsertSubscriberDataArg'). test(isd)-> - EncPdu = [48,128,129,7,145,148,113,50,1,0,241,131,1,0,176,128,5,0,161,128,48,22,2,1,1,144,2,241,33,145,4,0,1,2,3,146,3,36,131,16,148,2,1,42,48,35,2,1,2,144,2,241,33,145,4,255,255,255,255,146,3,37,147,18,147,0,148,13,7,67,79,77,80,65,78,89,4,67,79,77,53,48,28,2,1,3,144,2,241,33,146,3,26,98,31,148,14,9,67,79,77,80,65,78,89,49,50,3,67,79,77,0,0,0,0,152,1,2,0,0], - - ?line {ok,_} = asn1_wrapper:decode('Mvrasn4', - 'InsertSubscriberDataArg', - EncPdu), + EncPdu = <<48,128,129,7,145,148,113,50,1,0,241,131,1,0,176,128,5,0, + 161,128,48,22,2,1,1,144,2,241,33,145,4,0,1,2,3,146,3,36, + 131,16,148,2,1,42,48,35,2,1,2,144,2,241,33,145,4,255,255, + 255,255,146,3,37,147,18,147,0,148,13,7,67,79,77,80,65,78, + 89,4,67,79,77,53,48,28,2,1,3,144,2,241,33,146,3,26,98,31, + 148,14,9,67,79,77,80,65,78,89,49,50,3,67,79,77,0,0,0,0, + 152,1,2,0,0>>, + {ok,_} = 'Mvrasn4':decode('InsertSubscriberDataArg', EncPdu), ok; % % Problems with indefinite length encoding !!! % test(isd2)-> - EncPdu = [48, 128, 128, 8, 98, 2, 50, 1, 0, 0, 0, 241, 176, 128, 161, 128, 48, 128, 2, 1, 1, 144, 2, 241, 33, 145, 4, 255, 23, 12, 1, 146, 3, 9, 17, 1, 147, 0, 148, 13, 7, 67, 79, 77, 80, 65, 78, 89, 4, 67, 79, 77, 53, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0], - - ?line {ok,_DecPdu} = asn1_wrapper:decode('Mvrasn4', - 'InsertSubscriberDataArg', - EncPdu), - + EncPdu = <<48,128,128,8,98,2,50,1,0,0,0,241,176,128,161,128,48,128,2,1,1,144, + 2,241,33,145,4,255,23,12,1,146,3,9,17,1,147,0,148,13,7,67,79,77,80, + 65,78,89,4,67,79,77,53,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0>>, + {ok,_DecPdu} = 'Mvrasn4':decode('InsertSubscriberDataArg', EncPdu), ok; % % Is doing fine, although there is indefinite encoding used... !!! % test(dsd)-> - EncPdu = [48, 128, 128, 8, 98, 2, 50, 1, 0, 0, 0, 241, 170, 2, 5, 0, 0, 0, 0, 0], - - ?line {ok,_DecPdu} = asn1_wrapper:decode('Mvrasn4', - 'DeleteSubscriberDataArg', - EncPdu), - + EncPdu = <<48,128,128,8,98,2,50,1,0,0,0,241,170,2,5,0,0,0,0,0>>, + {ok,_DecPdu} = 'Mvrasn4':decode('DeleteSubscriberDataArg', EncPdu), ok; % % Is doing fine !!! % test(ul_res)-> - EncPdu = [48, 9, 4, 7, 145, 148, 113, 66, 16, 17, 241], - - ?line {ok,_DecPdu} = asn1_wrapper:decode('Mvrasn4', - 'UpdateGprsLocationRes', - EncPdu), - + EncPdu = <<48,9,4,7,145,148,113,66,16,17,241>>, + {ok,_DecPdu} = 'Mvrasn4':decode('UpdateGprsLocationRes', EncPdu), ok; test(seqofseq) -> - {ok,_V} = asn1_wrapper:decode('Mvrasn4', - 'SentParameters', - [48,129,190,161,128,4,16,176,197,182,68,41,243,188,205,123,13,9,145,206,200,144,102,4,4,176,197,182,68,4,8,41,243,188,205,123,13,9,145,0,0,161,128,4,16,39,0,3,117,35,189,130,21,42,104,49,194,212,24,151,234,4,4,39,0,3,117,4,8,35,189,130,21,42,104,49,194,0,0,161,128,4,16,62,207,166,59,71,29,37,97,120,25,132,80,144,251,161,123,4,4,62,207,166,59,4,8,71,29,37,97,120,25,132,80,0,0,161,128,4,16,95,183,173,151,17,76,148,146,248,102,127,215,102,224,39,60,4,4,95,183,173,151,4,8,17,76,148,146,248,102,127,215,0,0,161,128,4,16,41,198,247,157,117,190,203,170,91,146,88,91,223,220,188,16,4,4,41,198,247,157,4,8,117,190,203,170,91,146,88,91,0,0]), + EncPdu = <<48,129,190,161,128,4,16,176,197,182,68,41,243,188,205,123,13, + 9,145,206,200,144,102,4,4,176,197,182,68,4,8,41,243,188,205, + 123,13,9,145,0,0,161,128,4,16,39,0,3,117,35,189,130,21,42,104, + 49,194,212,24,151,234,4,4,39,0,3,117,4,8,35,189,130,21,42,104, + 49,194,0,0,161,128,4,16,62,207,166,59,71,29,37,97,120,25,132, + 80,144,251,161,123,4,4,62,207,166,59,4,8,71,29,37,97,120,25, + 132,80,0,0,161,128,4,16,95,183,173,151,17,76,148,146,248,102, + 127,215,102,224,39,60,4,4,95,183,173,151,4,8,17,76,148,146,248, + 102,127,215,0,0,161,128,4,16,41,198,247,157,117,190,203,170,91, + 146,88,91,223,220,188,16,4,4,41,198,247,157,4,8,117,190,203,170,91,146,88,91,0,0>>, + {ok,_V} = 'Mvrasn4':decode('SentParameters', EncPdu), ok; test('InsertSubscriberDataArg') -> - {ok,_V} = - asn1_wrapper:decode('Mvrasn4','InsertSubscriberDataArg', - [16#30,16#80,16#81,16#07,16#91,16#94, - 16#71,16#92,16#00,16#35,16#80,16#83, - 16#01,16#00,16#A6,16#06,16#04,16#01, - 16#21,16#04,16#01,16#22,16#B0,16#80, - 16#05,16#00,16#A1,16#80,16#30,16#1A, - 16#02,16#01,16#01,16#90,16#02,16#F1, - 16#21,16#92,16#03,16#0D,16#92,16#1F, - 16#94,16#0C,16#03,16#53,16#49,16#4D, - 16#03,16#47,16#53,16#4E,16#03,16#4C, - 16#4B,16#50,16#00,16#00,16#00,16#00, - 16#98,16#01,16#00,16#00,16#00]), + EncPdu = <<16#30,16#80,16#81,16#07,16#91,16#94, + 16#71,16#92,16#00,16#35,16#80,16#83, + 16#01,16#00,16#A6,16#06,16#04,16#01, + 16#21,16#04,16#01,16#22,16#B0,16#80, + 16#05,16#00,16#A1,16#80,16#30,16#1A, + 16#02,16#01,16#01,16#90,16#02,16#F1, + 16#21,16#92,16#03,16#0D,16#92,16#1F, + 16#94,16#0C,16#03,16#53,16#49,16#4D, + 16#03,16#47,16#53,16#4E,16#03,16#4C, + 16#4B,16#50,16#00,16#00,16#00,16#00, + 16#98,16#01,16#00,16#00,16#00>>, + {ok,_V} = 'Mvrasn4':decode('InsertSubscriberDataArg', EncPdu), ok. test(mvrasn6,'InsertSubscriberDataArg') -> Val = {'InsertSubscriberDataArg',"IMSI","Address","C",serviceGranted,["abc","cde"],["tele","serv","ice"],asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,{'NAEA-PreferredCI',"NCC",asn1_NOVALUE},{'GPRSSubscriptionData','NULL',[{'PDP-Context',49,"PT","PDP-Address","QoS",'NULL',"APN",asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}],asn1_NOVALUE},'NULL',onlyMSC,{'LSAInformation','NULL',accessOutsideLSAsAllowed,[{'LSAData',"LSA","L",'NULL',asn1_NOVALUE},{'LSAData',"LSA","L",'NULL',asn1_NOVALUE}],asn1_NOVALUE},'NULL',{'LCSInformation',["Addr","ess","string"],[{'LCS-PrivacyClass',"S","ExtSS",notifyLocationAllowed,[{'ExternalClient',{'LCSClientExternalID',"Addr",asn1_NOVALUE},asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}],[broadcastService,anonymousLocation,targetMSsubscribedService],asn1_NOVALUE}],asn1_NOVALUE},100,"age",{'MC-SS-Info',"S","ExtSS",5,4,asn1_NOVALUE},"C",{'SGSN-CAMEL-SubscriptionInfo',{'GPRS-CSI',[{'GPRS-CamelTDPData',attach,13,"Addr",continueTransaction,asn1_NOVALUE}],11,asn1_NOVALUE,'NULL','NULL'},{'SMS-CSI',[{'SMS-CAMEL-TDP-DataList','sms-CollectedInfo',13,"Addr",continueTransaction,asn1_NOVALUE}],11,asn1_NOVALUE,'NULL','NULL'},asn1_NOVALUE},"ON"}, - - {ok,Bytes}= - asn1_wrapper:encode('Mvrasn6','InsertSubscriberDataArg',Val), - - {ok,_Res} = - asn1_wrapper:decode('Mvrasn6','InsertSubscriberDataArg',Bytes), - + {ok,Bytes} = 'Mvrasn6':encode('InsertSubscriberDataArg', Val), + {ok,_} = 'Mvrasn6':decode('InsertSubscriberDataArg', Bytes), ok. diff --git a/lib/asn1/test/testNBAPsystem.erl b/lib/asn1/test/testNBAPsystem.erl index 0f4459f5b2..57cb483374 100644 --- a/lib/asn1/test/testNBAPsystem.erl +++ b/lib/asn1/test/testNBAPsystem.erl @@ -19,7 +19,7 @@ %% -module(testNBAPsystem). --export([compile/2,test/2,cell_setup_req_msg/0]). +-export([compile/2,test/2]). -include_lib("test_server/include/test_server.hrl"). @@ -96,23 +96,16 @@ test(_Erule,Config) -> ticket_5812(Config) -> ?line Msg = v_5812(), - ?line {ok,B2} = asn1_wrapper:encode('NBAP-PDU-Discriptions', - 'NBAP-PDU', - Msg), + {ok,B2} = 'NBAP-PDU-Discriptions':encode('NBAP-PDU', Msg), V = <<0,28,74,0,3,48,0,0,1,0,123,64,41,0,0,0,126,64,35,95,208,2,89,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,145,0,1,205,0,0,0,0,2,98,64,1,128>>, ?line ok = compare(V,B2), - ?line {ok,Msg2} = asn1_wrapper:decode('NBAP-PDU-Discriptions', - 'NBAP-PDU',B2), + {ok,Msg2} = 'NBAP-PDU-Discriptions':decode('NBAP-PDU', B2), ?line ok = check_record_names(Msg2,Config). enc_audit_req_msg() -> Msg = {initiatingMessage, audit_req_msg()}, - ?line {ok,B}=asn1_wrapper:encode('NBAP-PDU-Discriptions', - 'NBAP-PDU', - Msg), - ?line {ok,_Msg}=asn1_wrapper:decode('NBAP-PDU-Discriptions', - 'NBAP-PDU', - B), + {ok,B} = 'NBAP-PDU-Discriptions':encode('NBAP-PDU', Msg), + {ok,_Msg} = 'NBAP-PDU-Discriptions':decode('NBAP-PDU', B), ?line {initiatingMessage, #'InitiatingMessage'{value=#'AuditRequest'{protocolIEs=[{_,114,ignore,_}], protocolExtensions = asn1_NOVALUE}}} = _Msg, @@ -121,12 +114,8 @@ enc_audit_req_msg() -> cell_setup_req_msg_test() -> Msg = {initiatingMessage, cell_setup_req_msg()}, - ?line {ok,B}=asn1_wrapper:encode('NBAP-PDU-Discriptions', - 'NBAP-PDU', - Msg), - ?line {ok,_Msg}=asn1_wrapper:decode('NBAP-PDU-Discriptions', - 'NBAP-PDU', - B), + {ok,B} = 'NBAP-PDU-Discriptions':encode('NBAP-PDU', Msg), + {ok,_Msg} = 'NBAP-PDU-Discriptions':decode('NBAP-PDU', B), io:format("Msg: ~P~n~n_Msg: ~P~n",[Msg,15,_Msg,15]), ok. diff --git a/lib/asn1/test/testOpenTypeImplicitTag.erl b/lib/asn1/test/testOpenTypeImplicitTag.erl index a37d8004ef..0fbf70d037 100644 --- a/lib/asn1/test/testOpenTypeImplicitTag.erl +++ b/lib/asn1/test/testOpenTypeImplicitTag.erl @@ -24,18 +24,9 @@ -include_lib("test_server/include/test_server.hrl"). main(_Rules) -> - - ?line {ok,Bytes1} = - asn1_wrapper:encode('OpenTypeImplicitTag','Seq', - {'Seq',[1,1,255],[1,1,255],12,[1,1,255]}), - ?line {ok,{'Seq',_,_,12,_}} = - asn1_wrapper:decode('OpenTypeImplicitTag','Seq', - lists:flatten(Bytes1)), - - ?line {ok,Bytes2} = - asn1_wrapper:encode('OpenTypeImplicitTag','Seq', - {'Seq',[1,1,255],asn1_NOVALUE,12,[1,1,255]}), - ?line {ok,{'Seq',_,asn1_NOVALUE,12,_}} = - asn1_wrapper:decode('OpenTypeImplicitTag','Seq', - lists:flatten(Bytes2)), + roundtrip('Seq', {'Seq',<<1,1,255>>,<<1,1,255>>,12,<<1,1,255>>}), + roundtrip('Seq', {'Seq',<<1,1,255>>,asn1_NOVALUE,12,<<1,1,255>>}), ok. + +roundtrip(T, V) -> + asn1_test_lib:roundtrip('OpenTypeImplicitTag', T, V). diff --git a/lib/asn1/test/testOpt.erl b/lib/asn1/test/testOpt.erl index a1ad8099b5..a6dcccad15 100644 --- a/lib/asn1/test/testOpt.erl +++ b/lib/asn1/test/testOpt.erl @@ -18,8 +18,6 @@ %% %% -module(testOpt). - --export([compile/2]). -export([main/1]). -include_lib("test_server/include/test_server.hrl"). @@ -39,92 +37,29 @@ bool32 = asn1_NOVALUE, bool33 = asn1_NOVALUE}). - -compile(Config,Rules) -> - - ?line DataDir = ?config(data_dir,Config), - ?line OutDir = ?config(priv_dir,Config), - ?line true = code:add_patha(?config(priv_dir,Config)), - ?line ok = asn1ct:compile(DataDir ++ "Opt",[Rules,{outdir,OutDir}]). - - - main(_Rules) -> - - ?line {ok,Bytes11} = asn1_wrapper:encode('Opt','Opt1',#'Opt1'{bool0 = true, - bool1 = true, - bool2 = true, - bool3 = true}), - ?line {ok,{'Opt1',true,true,true,true}} = - asn1_wrapper:decode('Opt','Opt1',lists:flatten(Bytes11)), + roundtrip('Opt1', #'Opt1'{bool0=true,bool1=true,bool2=true,bool3=true}), + roundtrip('Opt1', #'Opt1'{bool0=true,bool1=asn1_NOVALUE,bool2=asn1_NOVALUE, + bool3=asn1_NOVALUE}), + roundtrip('Opt1', #'Opt1'{bool0=true,bool1=asn1_NOVALUE,bool2=false,bool3=asn1_NOVALUE}), + roundtrip('Opt1', #'Opt1'{bool0=false,bool1=asn1_NOVALUE,bool2=asn1_NOVALUE,bool3=false}), - ?line {ok,Bytes12} = asn1_wrapper:encode('Opt','Opt1',#'Opt1'{bool0 = true}), - ?line {ok,{'Opt1',true,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}} = - asn1_wrapper:decode('Opt','Opt1',lists:flatten(Bytes12)), - - ?line {ok,Bytes13} = asn1_wrapper:encode('Opt','Opt1',#'Opt1'{bool0 = true, - bool2 = false}), - ?line {ok,{'Opt1',true,asn1_NOVALUE,false,asn1_NOVALUE}} = - asn1_wrapper:decode('Opt','Opt1',lists:flatten(Bytes13)), - - ?line {ok,Bytes14} = asn1_wrapper:encode('Opt','Opt1',#'Opt1'{bool0 = false, - bool3 = false}), - ?line {ok,{'Opt1',false,asn1_NOVALUE,asn1_NOVALUE,false}} = - asn1_wrapper:decode('Opt','Opt1',lists:flatten(Bytes14)), - - - - - ?line {ok,Bytes21} = asn1_wrapper:encode('Opt','Opt2',#'Opt2'{bool10 = false, - bool11 = false, - bool12 = false, - bool13 = false}), - ?line {ok,{'Opt2',false,false,false,false}} = - asn1_wrapper:decode('Opt','Opt2',lists:flatten(Bytes21)), - - ?line {ok,Bytes22} = asn1_wrapper:encode('Opt','Opt2',#'Opt2'{bool10 = true, - bool13 = false}), - ?line {ok,{'Opt2',true,asn1_NOVALUE,asn1_NOVALUE,false}} = - asn1_wrapper:decode('Opt','Opt2',lists:flatten(Bytes22)), - - ?line {ok,Bytes23} = asn1_wrapper:encode('Opt','Opt2',#'Opt2'{bool10 = true, - bool11 = false, - bool13 = false}), - ?line {ok,{'Opt2',true,false,asn1_NOVALUE,false}} = - asn1_wrapper:decode('Opt','Opt2',lists:flatten(Bytes23)), - - ?line {ok,Bytes24} = asn1_wrapper:encode('Opt','Opt2',#'Opt2'{bool10 = false, - bool12 = false, - bool13 = false}), - ?line {ok,{'Opt2',false,asn1_NOVALUE,false,false}} = - asn1_wrapper:decode('Opt','Opt2',lists:flatten(Bytes24)), - - - - - ?line {ok,Bytes31} = asn1_wrapper:encode('Opt','Opt3',#'Opt3'{bool30 = false, - bool31 = false, - bool32 = false, - bool33 = false}), - ?line {ok,{'Opt3',false,false,false,false}} = - asn1_wrapper:decode('Opt','Opt3',lists:flatten(Bytes31)), - - ?line {ok,Bytes32} = asn1_wrapper:encode('Opt','Opt3',#'Opt3'{}), - ?line {ok,{'Opt3',asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}} = - asn1_wrapper:decode('Opt','Opt3',lists:flatten(Bytes32)), - - ?line {ok,Bytes33} = asn1_wrapper:encode('Opt','Opt3',#'Opt3'{bool30 = true}), - ?line {ok,{'Opt3',true,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}} = - asn1_wrapper:decode('Opt','Opt3',lists:flatten(Bytes33)), - - ?line {ok,Bytes34} = asn1_wrapper:encode('Opt','Opt3',#'Opt3'{bool32 = false}), - ?line {ok,{'Opt3',asn1_NOVALUE,asn1_NOVALUE,false,asn1_NOVALUE}} = - asn1_wrapper:decode('Opt','Opt3',lists:flatten(Bytes34)), - - ?line {ok,Bytes35} = asn1_wrapper:encode('Opt','Opt3',#'Opt3'{bool33 = false}), - ?line {ok,{'Opt3',asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE,false}} = - asn1_wrapper:decode('Opt','Opt3',lists:flatten(Bytes35)), - - - + roundtrip('Opt2', #'Opt2'{bool10=false,bool11=false,bool12=false,bool13=false}), + roundtrip('Opt2', #'Opt2'{bool10=true,bool11=asn1_NOVALUE,bool12=asn1_NOVALUE, + bool13=false}), + roundtrip('Opt2', #'Opt2'{bool10=true,bool11=false,bool12=asn1_NOVALUE,bool13=false}), + roundtrip('Opt2', #'Opt2'{bool10=false,bool11=asn1_NOVALUE,bool12=false,bool13=false}), + + roundtrip('Opt3', #'Opt3'{bool30=false,bool31=false,bool32=false,bool33=false}), + roundtrip('Opt3', #'Opt3'{bool30=asn1_NOVALUE,bool31=asn1_NOVALUE,bool32=asn1_NOVALUE, + bool33=asn1_NOVALUE}), + roundtrip('Opt3', #'Opt3'{bool30=true,bool31=asn1_NOVALUE,bool32=asn1_NOVALUE, + bool33=asn1_NOVALUE}), + roundtrip('Opt3', #'Opt3'{bool30=asn1_NOVALUE,bool31=asn1_NOVALUE,bool32=false, + bool33=asn1_NOVALUE}), + roundtrip('Opt3', #'Opt3'{bool30=asn1_NOVALUE,bool31=asn1_NOVALUE,bool32=asn1_NOVALUE, + bool33=false}), ok. + +roundtrip(Type, Value) -> + asn1_test_lib:roundtrip('Opt', Type, Value). diff --git a/lib/asn1/test/testParamBasic.erl b/lib/asn1/test/testParamBasic.erl index a10468d592..3db89ca174 100644 --- a/lib/asn1/test/testParamBasic.erl +++ b/lib/asn1/test/testParamBasic.erl @@ -29,53 +29,27 @@ -record('T22',{number, string}). main(Rules) -> - - ?line {ok,Bytes11} = - asn1_wrapper:encode('ParamBasic','T11', - #'T11'{number = 11, - string = "hello"}), - ?line {ok,{'T11',11,"hello"}} = - asn1_wrapper:decode('ParamBasic','T11',Bytes11), - - ?line {ok,Bytes12} = - asn1_wrapper:encode('ParamBasic','T12', - #'T12'{number = 11, - string = <<2#10101:5>>}), - {ok,{'T12',11,<<2#10101:5>>}} = - asn1_wrapper:decode('ParamBasic','T12',Bytes12), - - ?line {ok,Bytes13} = - asn1_wrapper:encode('ParamBasic','T21', - #'T21'{number = 11, - string = "hello"}), - ?line {ok,{'T21',11,"hello"}} = - asn1_wrapper:decode('ParamBasic','T21',Bytes13), - - ?line {ok,Bytes14} = - asn1_wrapper:encode('ParamBasic','T22', - #'T22'{number = 11, - string = <<2#10101:5>>}), - {ok,{'T22',11,<<2#10101:5>>}} = - asn1_wrapper:decode('ParamBasic','T22',Bytes14), - + roundtrip('T11', #'T11'{number=11,string="hello"}), + roundtrip('T12', #'T12'{number=11,string = <<21:5>>}), + roundtrip('T21', #'T21'{number=11,string="hello"}), + roundtrip('T22', #'T22'{number=11,string = <<21:5>>}), case Rules of der -> - - ?line {ok,[48,3,128,1,11]} = - asn1_wrapper:encode('ParamBasic','T11', - #'T11'{number = 11, - string = "hej"}), - ?line {ok,{'T11',11,"hej"}} = - asn1_wrapper:decode('ParamBasic','T11',[48,3,128,1,11]), - - ?line {ok,[48,3,128,1,11]} = - asn1_wrapper:encode('ParamBasic','T12', - #'T12'{number = 11, - string = [1,0,1,0]}), - - ?line {ok,{'T12',11,[1,0,1,0]}} = - asn1_wrapper:decode('ParamBasic','T12',[48,3,128,1,11]); + <<48,3,128,1,11>> = + roundtrip_enc('T11', #'T11'{number=11,string="hej"}), + <<48,3,128,1,11>> = + roundtrip_enc('T12', + #'T12'{number=11,string=[1,0,1,0]}, + #'T12'{number=11,string = <<10:4>>}); _ -> ok end, - ok. + +roundtrip(Type, Value) -> + asn1_test_lib:roundtrip('ParamBasic', Type, Value). + +roundtrip_enc(Type, Value) -> + asn1_test_lib:roundtrip_enc('ParamBasic', Type, Value). + +roundtrip_enc(Type, Value, Expected) -> + asn1_test_lib:roundtrip_enc('ParamBasic', Type, Value, Expected). diff --git a/lib/asn1/test/testParameterizedInfObj.erl b/lib/asn1/test/testParameterizedInfObj.erl index 1dfa52f401..f3b4f9b170 100644 --- a/lib/asn1/test/testParameterizedInfObj.erl +++ b/lib/asn1/test/testParameterizedInfObj.erl @@ -41,53 +41,51 @@ param(Erule) -> iE_Extensions = [#'ProtocolExtensionField'{id=14, criticality=reject, - extensionValue=open_type(Erule,[0])}, + extensionValue= <<0>>}, #'ProtocolExtensionField'{id=2, criticality=ignore, - extensionValue=open_type(Erule,[1])}]}, + extensionValue= <<1>>}]}, BERVal = #'AllocationOrRetentionPriority' {priorityLevel = true, iE_Extensions = [#'ProtocolExtensionField'{id=14, criticality=reject, - extensionValue=[2,1,0]}, + extensionValue= <<2,1,0>>}, #'ProtocolExtensionField'{id=2, criticality=ignore, - extensionValue=[2,1,1]}]}, - ?line {ok,Bytes1} = - case asn1_wrapper:erule(Erule) of - per -> - asn1_wrapper:encode('Param','AllocationOrRetentionPriority', - PERVal); - _ -> - asn1_wrapper:encode('Param','AllocationOrRetentionPriority', - BERVal) - end, - - ?line {ok,{'AllocationOrRetentionPriority',true,[_R1,_R2]}} = - asn1_wrapper:decode('Param','AllocationOrRetentionPriority',Bytes1), + extensionValue= <<2,1,1>>}]}, + case Erule of + ber -> + roundtrip('AllocationOrRetentionPriority', BERVal); + per -> + roundtrip('AllocationOrRetentionPriority', PERVal); + uper -> + roundtrip('AllocationOrRetentionPriority', PERVal) + end, %% test code for OTP-4242, ValueFromObject - case asn1_wrapper:erule(Erule) of + case Erule of ber -> - ?line {ok,_Val3} = asn1_wrapper:decode('Param','OS1',[4,2,1,2]), - ?line {error,_Reason1} = - asn1_wrapper:decode('Param','OS1',[4,4,1,2,3,4]), - ?line {error,_Reason2} = - asn1_wrapper:decode('Param','OS2',[4,4,1,2,3,4]), - ?line {ok,_Val4} = asn1_wrapper:decode('Param','OS1',[4,2,1,2]); - per -> - ?line {ok,Bytes3} = - asn1_wrapper:encode('Param','OS1',[1,2]), - ?line {ok,[1,2]} = - asn1_wrapper:decode('Param','OS1',Bytes3), - ?line {error,_Reason3} = - asn1_wrapper:encode('Param','OS1',[1,2,3,4]) + {ok,_Val3} = 'Param':decode('OS1', [4,2,1,2]), + {error,_Reason1} = 'Param':decode('OS1',[4,4,1,2,3,4]), + {error,_Reason2} = 'Param':decode('OS2',[4,4,1,2,3,4]), + {ok,_Val4} = 'Param':decode('OS1',[4,2,1,2]); + _ -> %per/uper + roundtrip('OS1', [1,2]), + {error,_Reason3} = 'Param':encode('OS1', [1,2,3,4]) end, + roundtrip('Scl', {'Scl',42,{a,9738654}}), + roundtrip('Scl', {'Scl',42,{b,false}}), + roundtrip('Scl', {'Scl',42,{b,true}}), + ok. +roundtrip(T, V) -> + asn1_test_lib:roundtrip('Param', T, V). + + ranap(_Erule) -> PIEVal2 = [{'ProtocolIE-Field',4,ignore,{radioNetwork,'rab-pre-empted'}}], ?line Val2 = @@ -96,16 +94,11 @@ ranap(_Erule) -> value=#'Iu-ReleaseCommand'{protocolIEs=PIEVal2, protocolExtensions=asn1_NOVALUE}}, - ?line {ok,Bytes2} = asn1_wrapper:encode('RANAP','InitiatingMessage',Val2), - ?line {ok,_Ret2} = asn1_wrapper:decode('RANAP','InitiatingMessage',Bytes2), + {ok,Bytes2} = 'RANAP':encode('InitiatingMessage', Val2), + {ok,_Ret2} = 'RANAP':decode('InitiatingMessage', Bytes2), ok. -open_type(uper,Val) when is_list(Val) -> - list_to_binary(Val); -open_type(_,Val) -> - Val. - param2(Config, Erule) -> roundtrip2('HandoverRequired', {'HandoverRequired', @@ -138,7 +131,7 @@ param2(Config, Erule) -> {'ProtocolIE-Field',2,-42}, {'ProtocolIE-Field',100,Open100}, {'ProtocolIE-Field',101,Open101}]}} = - asn1_wrapper:decode('Param2', 'HandoverRequired', Enc), + 'Param2':decode('HandoverRequired', Enc), true = is_binary(Open100), true = is_binary(Open101), @@ -150,6 +143,4 @@ param2(Config, Erule) -> roundtrip2(T, V) -> - {ok,Enc} = asn1_wrapper:encode('Param2', T, V), - {ok,V} = asn1_wrapper:decode('Param2', T, Enc), - Enc. + asn1_test_lib:roundtrip_enc('Param2', T, V). diff --git a/lib/asn1/test/testPrim.erl b/lib/asn1/test/testPrim.erl index a6e68a9fe0..e07379e634 100644 --- a/lib/asn1/test/testPrim.erl +++ b/lib/asn1/test/testPrim.erl @@ -36,8 +36,7 @@ bool(Rules) -> case Rules of ber -> [begin - {error,{asn1,{encode_boolean,517}}} = - (catch 'Prim':encode(T, 517)) + {error,{asn1,{encode_boolean,517}}} = enc_error(T, 517) end || T <- Types], ok; _ -> @@ -90,12 +89,12 @@ enum(Rules) -> roundtrip('Enum', monday), roundtrip('Enum', thursday), - {error,{asn1,{_,4}}} = (catch 'Prim':encode('Enum', 4)), + {error,{asn1,{_,4}}} = enc_error('Enum', 4), case Rules of Per when Per =:= per; Per =:= uper -> - {ok,<<0>>} = 'Prim':encode('SingleEnumVal', true), - {ok,<<0>>} = 'Prim':encode('SingleEnumValExt', true); + <<0>> = roundtrip('SingleEnumVal', true), + <<0>> = roundtrip('SingleEnumValExt', true); ber -> ok end, @@ -128,15 +127,36 @@ null(_Rules) -> %%========================================================== %% Null ::= NULL %%========================================================== - - {ok,Bytes1} = asn1_wrapper:encode('Prim','Null',monday), - {ok,'NULL'} = asn1_wrapper:decode('Prim','Null',lists:flatten(Bytes1)), + roundtrip('Null', monday, 'NULL'), ok. roundtrip(T, V) -> - {ok,E} = 'Prim':encode(T, V), - {ok,V} = 'Prim':decode(T, E), - E. + roundtrip(T, V, V). + +roundtrip(Type, Value, ExpectedValue) -> + case get(no_ok_wrapper) of + false -> + asn1_test_lib:roundtrip_enc('Prim', Type, Value, ExpectedValue); + true -> + M = 'Prim', + Enc = M:encode(Type, Value), + ExpectedValue = M:decode(Type, Enc), + Enc + end. + +enc_error(T, V) -> + case get(no_ok_wrapper) of + false -> + 'Prim':encode(T, V); + true -> + try 'Prim':encode(T, V) of + _ -> + ?t:fail() + catch + _:Reason -> + Reason + end + end. real(_Rules) -> %%========================================================== @@ -144,67 +164,45 @@ real(_Rules) -> %%========================================================== %% Base 2 - ?line {ok,Bytes1} = asn1_wrapper:encode('Real','AngleInRadians',{1,2,1}), - ?line {ok,{1,2,1}} = asn1_wrapper:decode('Real','AngleInRadians',Bytes1), - - ?line {ok,Bytes2} = asn1_wrapper:encode('Real','AngleInRadians',{129,2,1}), - ?line {ok,{129,2,1}} = asn1_wrapper:decode('Real','AngleInRadians',Bytes2), - - ?line {ok,Bytes3} = asn1_wrapper:encode('Real','AngleInRadians',{128,2,1}), - ?line {ok,{1,2,8}} = asn1_wrapper:decode('Real','AngleInRadians',Bytes3), - - ?line {ok,Bytes4} = asn1_wrapper:encode('Real','AngleInRadians',{128,2,-7}), - ?line {ok,{1,2,0}} = asn1_wrapper:decode('Real','AngleInRadians',Bytes4), - - ?line {ok,Bytes5} = asn1_wrapper:encode('Real','AngleInRadians',{16#f1f1f1,2,128}), - ?line {ok,{16#f1f1f1,2,128}} = asn1_wrapper:decode('Real','AngleInRadians',Bytes5), + real_roundtrip('AngleInRadians', {1,2,1}), + real_roundtrip('AngleInRadians', {129,2,1}), + real_roundtrip('AngleInRadians', {128,2,1}, {1,2,8}), + real_roundtrip('AngleInRadians', {128,2,-7}, {1,2,0}), + real_roundtrip('AngleInRadians', {16#f1f1f1,2,128}), %% Base 10, tuple format - ?line {ok,Bytes6} = asn1_wrapper:encode('Real','AngleInRadians',{1,10,1}), - ?line {ok,"1.E1"} = asn1_wrapper:decode('Real','AngleInRadians',Bytes6), - - ?line {ok,Bytes7} = asn1_wrapper:encode('Real','AngleInRadians',{100,10,1}), - ?line {ok,"1.E3"} = asn1_wrapper:decode('Real','AngleInRadians',Bytes7), - - ?line {ok,Bytes8} = asn1_wrapper:encode('Real','AngleInRadians',{-100,10,1}), - ?line {ok,"-1.E3"} = asn1_wrapper:decode('Real','AngleInRadians',Bytes8), - - ?line {ok,Bytes9} = asn1_wrapper:encode('Real','AngleInRadians',{00002,10,1}), - ?line {ok,"2.E1"} = asn1_wrapper:decode('Real','AngleInRadians',Bytes9), - - ?line {ok,Bytes10} = asn1_wrapper:encode('Real','AngleInRadians',{123000,10,0}), - ?line {ok,"123.E3"} = asn1_wrapper:decode('Real','AngleInRadians',Bytes10), - - ?line {ok,Bytes11} = asn1_wrapper:encode('Real','AngleInRadians',{123456789,10,123456789}), - ?line {ok,"123456789.E123456789"} = asn1_wrapper:decode('Real','AngleInRadians',Bytes11), - - ?line {ok,Bytes12} = asn1_wrapper:encode('Real','AngleInRadians',{-12345,10,-12345}), - ?line {ok,"-12345.E-12345"} = asn1_wrapper:decode('Real','AngleInRadians',Bytes12), + real_roundtrip('AngleInRadians', {1,10,1}, "1.E1"), + real_roundtrip('AngleInRadians', {100,10,1}, "1.E3"), + real_roundtrip('AngleInRadians', {-100,10,1}, "-1.E3"), + real_roundtrip('AngleInRadians', {2,10,1}, "2.E1"), + real_roundtrip('AngleInRadians', {123000,10,0}, "123.E3"), + real_roundtrip('AngleInRadians', {123456789,10,123456789}, + "123456789.E123456789" ), + real_roundtrip('AngleInRadians', {-12345,10,-12345}, "-12345.E-12345"), %% Base 10, string format NR3 - - ?line {ok,Bytes13} = asn1_wrapper:encode('Real','AngleInRadians',"123.123E123"), - ?line {ok,"123123.E120"} = asn1_wrapper:decode('Real','AngleInRadians',Bytes13), - - ?line {ok,Bytes14} = asn1_wrapper:encode('Real','AngleInRadians',"0.0E0"), - ?line {ok,"0.E+0"} = asn1_wrapper:decode('Real','AngleInRadians',Bytes14), - ?line {ok,Bytes15} = asn1_wrapper:encode('Real','AngleInRadians',"0.0123"), - ?line {ok,"123.E-4"} = asn1_wrapper:decode('Real','AngleInRadians',Bytes15), + real_roundtrip('AngleInRadians', "123.123E123", "123123.E120"), + real_roundtrip('AngleInRadians', "0.0E0", "0.E+0"), + real_roundtrip('AngleInRadians', "0.0123", "123.E-4"), + real_roundtrip('AngleInRadians', "0", "0.E+0"), + real_roundtrip('AngleInRadians', "-123.45", "-12345.E-2"), + real_roundtrip('AngleInRadians', "123456789E123456789", + "123456789.E123456789"), + real_roundtrip('AngleInRadians', "01.000E1", "1.E1"), + real_roundtrip('AngleInRadians', "120.0001", "1200001.E-4"), - ?line {ok,Bytes16} = asn1_wrapper:encode('Real','AngleInRadians',"0"), - ?line {ok,"0.E+0"} = asn1_wrapper:decode('Real','AngleInRadians',Bytes16), - - ?line {ok,Bytes17} = asn1_wrapper:encode('Real','AngleInRadians',"-123.45"), - ?line {ok,"-12345.E-2"} = asn1_wrapper:decode('Real','AngleInRadians',Bytes17), - - ?line {ok,Bytes18} = - asn1_wrapper:encode('Real','AngleInRadians',"123456789E123456789"), - ?line {ok,"123456789.E123456789"} = - asn1_wrapper:decode('Real','AngleInRadians',Bytes18), + ok. - ?line {ok,Bytes19} = asn1_wrapper:encode('Real','AngleInRadians',"01.000E1"), - ?line {ok,"1.E1"} = asn1_wrapper:decode('Real','AngleInRadians',Bytes19), +real_roundtrip(T, V) -> + real_roundtrip(T, V, V). - ?line {ok,Bytes20} = asn1_wrapper:encode('Real','AngleInRadians',"120.0001"), - ?line {ok,"1200001.E-4"} = asn1_wrapper:decode('Real','AngleInRadians',Bytes20). +real_roundtrip(Type, Value, ExpectedValue) -> + case get(no_ok_wrapper) of + false -> + asn1_test_lib:roundtrip('Real', Type, Value, ExpectedValue); + true -> + M = 'Real', + ExpectedValue = M:decode(Type, M:encode(Type, Value)), + ok + end. diff --git a/lib/asn1/test/testPrimExternal.erl b/lib/asn1/test/testPrimExternal.erl index 65c3c3a31a..07a1de931f 100644 --- a/lib/asn1/test/testPrimExternal.erl +++ b/lib/asn1/test/testPrimExternal.erl @@ -24,84 +24,27 @@ -include_lib("test_server/include/test_server.hrl"). external(_Rules) -> - - - ?line {ok,Bytes10} = asn1_wrapper:encode('PrimExternal','NT',"kalle"), - ?line {ok,"kalle"} = asn1_wrapper:decode('PrimExternal','NT',lists:flatten(Bytes10)), - - ?line {ok,Bytes11} = asn1_wrapper:encode('PrimExternal','Imp',"kalle"), - ?line {ok,"kalle"} = asn1_wrapper:decode('PrimExternal','Imp',lists:flatten(Bytes11)), - - ?line {ok,Bytes12} = asn1_wrapper:encode('PrimExternal','Exp',"kalle"), - ?line {ok,"kalle"} = asn1_wrapper:decode('PrimExternal','Exp',lists:flatten(Bytes12)), - - - ?line {ok,Bytes13} = asn1_wrapper:encode('PrimExternal','NTNT',"kalle"), - ?line {ok,"kalle"} = asn1_wrapper:decode('PrimExternal','NTNT',lists:flatten(Bytes13)), - - ?line {ok,Bytes14} = asn1_wrapper:encode('PrimExternal','NTImp',"kalle"), - ?line {ok,"kalle"} = asn1_wrapper:decode('PrimExternal','NTImp',lists:flatten(Bytes14)), - - ?line {ok,Bytes15} = asn1_wrapper:encode('PrimExternal','NTExp',"kalle"), - ?line {ok,"kalle"} = asn1_wrapper:decode('PrimExternal','NTExp',lists:flatten(Bytes15)), - - - ?line {ok,Bytes16} = asn1_wrapper:encode('PrimExternal','ImpNT',"kalle"), - ?line {ok,"kalle"} = asn1_wrapper:decode('PrimExternal','ImpNT',lists:flatten(Bytes16)), - - ?line {ok,Bytes17} = asn1_wrapper:encode('PrimExternal','ImpImp',"kalle"), - ?line {ok,"kalle"} = asn1_wrapper:decode('PrimExternal','ImpImp',lists:flatten(Bytes17)), - - ?line {ok,Bytes18} = asn1_wrapper:encode('PrimExternal','ImpExp',"kalle"), - ?line {ok,"kalle"} = asn1_wrapper:decode('PrimExternal','ImpExp',lists:flatten(Bytes18)), - - - ?line {ok,Bytes19} = asn1_wrapper:encode('PrimExternal','ExpNT',"kalle"), - ?line {ok,"kalle"} = asn1_wrapper:decode('PrimExternal','ExpNT',lists:flatten(Bytes19)), - - ?line {ok,Bytes20} = asn1_wrapper:encode('PrimExternal','ExpImp',"kalle"), - ?line {ok,"kalle"} = asn1_wrapper:decode('PrimExternal','ExpImp',lists:flatten(Bytes20)), - - ?line {ok,Bytes21} = asn1_wrapper:encode('PrimExternal','ExpExp',"kalle"), - ?line {ok,"kalle"} = asn1_wrapper:decode('PrimExternal','ExpExp',lists:flatten(Bytes21)), - - - - - - ?line {ok,Bytes31} = asn1_wrapper:encode('PrimExternal','XNTNT',"kalle"), - ?line {ok,"kalle"} = asn1_wrapper:decode('PrimExternal','XNTNT',lists:flatten(Bytes31)), - - ?line {ok,Bytes32} = asn1_wrapper:encode('PrimExternal','XNTImp',"kalle"), - ?line {ok,"kalle"} = asn1_wrapper:decode('PrimExternal','XNTImp',lists:flatten(Bytes32)), - - ?line {ok,Bytes33} = asn1_wrapper:encode('PrimExternal','XNTExp',"kalle"), - ?line {ok,"kalle"} = asn1_wrapper:decode('PrimExternal','XNTExp',lists:flatten(Bytes33)), - - - ?line {ok,Bytes34} = asn1_wrapper:encode('PrimExternal','XImpNT',"kalle"), - ?line {ok,"kalle"} = asn1_wrapper:decode('PrimExternal','XImpNT',lists:flatten(Bytes34)), - - ?line {ok,Bytes35} = asn1_wrapper:encode('PrimExternal','XImpImp',"kalle"), - ?line {ok,"kalle"} = asn1_wrapper:decode('PrimExternal','XImpImp',lists:flatten(Bytes35)), - - ?line {ok,Bytes36} = asn1_wrapper:encode('PrimExternal','XImpExp',"kalle"), - ?line {ok,"kalle"} = asn1_wrapper:decode('PrimExternal','XImpExp',lists:flatten(Bytes36)), - - - ?line {ok,Bytes37} = asn1_wrapper:encode('PrimExternal','XExpNT',"kalle"), - ?line {ok,"kalle"} = asn1_wrapper:decode('PrimExternal','XExpNT',lists:flatten(Bytes37)), - - ?line {ok,Bytes38} = asn1_wrapper:encode('PrimExternal','XExpImp',"kalle"), - ?line {ok,"kalle"} = asn1_wrapper:decode('PrimExternal','XExpImp',lists:flatten(Bytes38)), - - ?line {ok,Bytes39} = asn1_wrapper:encode('PrimExternal','XExpExp',"kalle"), - ?line {ok,"kalle"} = asn1_wrapper:decode('PrimExternal','XExpExp',lists:flatten(Bytes39)), - - - - - - - -ok. + Types = ['NT', + 'Imp', + 'Exp', + 'NTNT', + 'NTImp', + 'NTExp', + 'ImpNT', + 'ImpImp', + 'ImpExp', + 'ExpNT', + 'ExpImp', + 'ExpExp', + 'XNTNT', + 'XNTImp', + 'XNTExp', + 'XImpNT', + 'XImpImp', + 'XImpExp', + 'XExpNT', + 'XExpImp', + 'XExpExp'], + _ = [asn1_test_lib:roundtrip('PrimExternal', T, "kalle") || + T <- Types], + ok. diff --git a/lib/asn1/test/testPrimStrings.erl b/lib/asn1/test/testPrimStrings.erl index e2322c92a9..2fe0780701 100644 --- a/lib/asn1/test/testPrimStrings.erl +++ b/lib/asn1/test/testPrimStrings.erl @@ -19,7 +19,7 @@ %% -module(testPrimStrings). --export([bit_string/1]). +-export([bit_string/2]). -export([octet_string/1]). -export([numeric_string/1]). -export([other_strings/1]). @@ -28,10 +28,47 @@ -export([bmp_string/1]). -export([times/1]). -export([utf8_string/1]). +-export([fragmented/1]). -include_lib("test_server/include/test_server.hrl"). -bit_string(Rules) -> +fragmented(Rules) -> + Lens = fragmented_lengths(), + fragmented_octet_string(Rules, Lens), + case Rules of + per -> + %% NYI. + ok; + _ -> + fragmented_strings(Lens) + end. + +fragmented_strings(Lens) -> + Types = ['Ns','Ps','Ps11','Vis','IA5'], + [fragmented_strings(Len, Types) || Len <- Lens], + ok. + +fragmented_strings(Len, Types) -> + Str = make_ns_value(Len), + [roundtrip(Type, Str) || Type <- Types], + ok. + +make_ns_value(0) -> []; +make_ns_value(N) -> [($0 - 1) + random:uniform(10)|make_ns_value(N-1)]. + +fragmented_lengths() -> + K16 = 1 bsl 14, + K32 = K16 + K16, + K48 = K32 + K16, + K64 = K48 + K16, + [0,1,14,15,16,17,127,128, + K16-1,K16,K16+1,K16+(1 bsl 7)-1,K16+(1 bsl 7),K16+(1 bsl 7)+1, + K32-1,K32,K32+1,K32+(1 bsl 7)-1,K32+(1 bsl 7),K32+(1 bsl 7)+1, + K48-1,K48,K48+1,K48+(1 bsl 7)-1,K48+(1 bsl 7),K48+(1 bsl 7)+1, + K64-1,K64,K64+1,K64+(1 bsl 7)-1,K64+(1 bsl 7),K64+(1 bsl 7)+1, + K64+K16-1,K64+K16,K64+K16+1]. + +bit_string(Rules, Opts) -> %%========================================================== %% Bs1 ::= BIT STRING @@ -53,9 +90,10 @@ bit_string(Rules) -> bs_roundtrip('Bs1', [0,1,0,0,1,0]), bs_roundtrip('Bs1', [1,0,0,0,0,0,0,0,0]), bs_roundtrip('Bs1', [0,1,0,0,1,0,1,1,1,1,1,0,0,0,1,0,0,1,1]), - - case Rules of - ber -> + + + case {Rules,Opts} of + {ber,[]} -> bs_decode('Bs1', <<35,8,3,2,0,73,3,2,4,32>>, [0,1,0,0,1,0,0,1,0,0,1,0]), bs_decode('Bs1', <<35,9,3,2,0,234,3,3,7,156,0>>, @@ -63,7 +101,17 @@ bit_string(Rules) -> bs_decode('Bs1', <<35,128,3,2,0,234,3,3,7,156,0,0,0>>, [1,1,1,0,1,0,1,0,1,0,0,1,1,1,0,0,0]); _ -> - ok + %% DER, PER, UPER + consistent_def_enc('BsDef1', + [2#111101, + [1,0,1,1,1,1], + {2,<<2#101111:6,0:2>>}, + <<2#101111:6>>]), + consistent_def_enc('BsDef2', + [[1,1,0,1, 1,1,1,0, 1,0,1,0, 1,1,0,1, + 1,0,1,1, 1,1,1,0, 1,1,1,0, 1,1,1,1], + {0,<<16#DEADBEEF:4/unit:8>>}, + <<16#DEADBEEF:4/unit:8>>]) end, @@ -180,6 +228,24 @@ bit_string(Rules) -> _ -> per_bs_strings() end. +consistent_def_enc(Type, Vs) -> + M = 'PrimStrings', + {ok,Enc} = M:encode(Type, {Type,asn1_DEFAULT}), + {ok,Val} = M:decode(Type, Enc), + + %% Ensure that the value has the correct format. + case {M:bit_string_format(),Val} of + {bitstring,{_,Bs}} when is_bitstring(Bs) -> ok; + {compact,{_,{Unused,Bin}}} when is_integer(Unused), + is_binary(Bin) -> ok; + {legacy,{_,Bs}} when is_list(Bs) -> ok + end, + + %% All values should be recognized and encoded as the + %% the default value (i.e. not encoded at all). + _ = [{ok,Enc} = M:encode(Type, {Type,V}) || V <- Vs], + ok. + %% The PER encoding rules requires that a BIT STRING with %% named positions should never have any trailing zeroes %% (except to reach the minimum number of bits as given by @@ -311,8 +377,6 @@ octet_string(Rules) -> ok end, - fragmented_octet_string(Rules), - S255 = lists:seq(1, 255), Strings = {type,true,"","1","12","345",true, S255,[$a|S255],[$a,$b|S255],397}, @@ -324,17 +388,7 @@ octet_string(Rules) -> p_roundtrip('OsVarStringsExt', ShortenedStrings), ok. -fragmented_octet_string(Erules) -> - K16 = 1 bsl 14, - K32 = K16 + K16, - K48 = K32 + K16, - K64 = K48 + K16, - Lens = [0,1,14,15,16,17,127,128, - K16-1,K16,K16+1,K16+(1 bsl 7)-1,K16+(1 bsl 7),K16+(1 bsl 7)+1, - K32-1,K32,K32+1,K32+(1 bsl 7)-1,K32+(1 bsl 7),K32+(1 bsl 7)+1, - K48-1,K48,K48+1,K48+(1 bsl 7)-1,K48+(1 bsl 7),K48+(1 bsl 7)+1, - K64-1,K64,K64+1,K64+(1 bsl 7)-1,K64+(1 bsl 7),K64+(1 bsl 7)+1, - K64+K16-1,K64+K16,K64+K16+1], +fragmented_octet_string(Erules, Lens) -> Types = ['Os','OsFrag','OsFragExt'], [fragmented_octet_string(Erules, Types, L) || L <- Lens], fragmented_octet_string(Erules, ['FixedOs65536'], 65536), @@ -697,14 +751,10 @@ p_roundtrip(Type, Value0) -> roundtrip(Type, Value). roundtrip(Type, Value) -> - {ok,Encoded} = 'PrimStrings':encode(Type, Value), - {ok,Value} = 'PrimStrings':decode(Type, Encoded), - ok. + roundtrip(Type, Value, Value). roundtrip(Type, Value, Expected) -> - {ok,Encoded} = 'PrimStrings':encode(Type, Value), - {ok,Expected} = 'PrimStrings':decode(Type, Encoded), - ok. + asn1_test_lib:roundtrip('PrimStrings', Type, Value, Expected). bs_roundtrip(Type, Value) -> bs_roundtrip(Type, Value, Value). diff --git a/lib/asn1/test/testSelectionTypes.erl b/lib/asn1/test/testSelectionTypes.erl index 6d1641388f..6d060321da 100644 --- a/lib/asn1/test/testSelectionTypes.erl +++ b/lib/asn1/test/testSelectionTypes.erl @@ -18,19 +18,16 @@ %% %% -module(testSelectionTypes). - -export([test/0]). -include_lib("test_server/include/test_server.hrl"). test() -> Val = ["PrintableString","PrintableString","PrintableString"], - ?line {ok,Bin}=asn1_wrapper:encode('SelectionType','MendeleyevTable',Val), - ?line {ok,Val} = asn1_wrapper:decode('SelectionType','MendeleyevTable',Bin), - - ?line Val2 = ['SelectionType':einsteinium()], - ?line ["Es"] = Val2, - - ?line {ok,Bin2}=asn1_wrapper:encode('SelectionType','MendeleyevTable',Val2), - ?line {ok,Val2} = asn1_wrapper:decode('SelectionType','MendeleyevTable',Bin2). + ["Es"] = Val2 = ['SelectionType':einsteinium()], + roundtrip('MendeleyevTable', Val), + roundtrip('MendeleyevTable', Val2), + ok. +roundtrip(T, V) -> + asn1_test_lib:roundtrip('SelectionType', T, V). diff --git a/lib/asn1/test/testSeq2738.erl b/lib/asn1/test/testSeq2738.erl index cddfe4b311..9c059f2fc9 100644 --- a/lib/asn1/test/testSeq2738.erl +++ b/lib/asn1/test/testSeq2738.erl @@ -18,27 +18,16 @@ %% %% -module(testSeq2738). - -export([main/1]). -include_lib("test_server/include/test_server.hrl"). -%-record('SeqOpt',{int, opt = asn1_NOVALUE}). -record('SeqOptFake',{int, opt = asn1_NOVALUE}). -%-record('OptSeq',{int=17}). -record('OptSeqFake',{bool = false}). - - - main(_Rules) -> - - ?line {ok,Bytes} = - asn1_wrapper:encode('Seq2738','SeqOptFake', - #'SeqOptFake'{int = 10, - opt = #'OptSeqFake'{}}), - ?line {ok,#'SeqOptFake'{int=10,opt=#'OptSeqFake'{bool=false}}} = - asn1_wrapper:decode('Seq2738','SeqOptFake',lists:flatten(Bytes)), - ?line {error,_} = - asn1_wrapper:decode('Seq2738','SeqOpt',lists:flatten(Bytes)), + Enc = asn1_test_lib:roundtrip_enc('Seq2738', + 'SeqOptFake', + #'SeqOptFake'{int=10,opt=#'OptSeqFake'{}}), + {error,_} = 'Seq2738':decode('SeqOpt', Enc), ok. diff --git a/lib/asn1/test/testSeqDefault.erl b/lib/asn1/test/testSeqDefault.erl index a772b749bd..22c1b7ee3a 100644 --- a/lib/asn1/test/testSeqDefault.erl +++ b/lib/asn1/test/testSeqDefault.erl @@ -33,148 +33,64 @@ -record('SeqDef3',{bool3 = asn1_DEFAULT, seq3 = asn1_DEFAULT, int3 = asn1_DEFAULT}). -record('SeqDef3Imp',{bool3 = asn1_DEFAULT, seq3 = asn1_DEFAULT, int3 = asn1_DEFAULT}). -record('SeqDef3Exp',{bool3 = asn1_DEFAULT, seq3 = asn1_DEFAULT, int3 = asn1_DEFAULT}). --record('SeqIn',{boolIn, intIn}). +-record('SeqIn',{boolIn = asn1_NOVALUE, intIn = 12}). main(_Rules) -> - - ?line {ok,Bytes11} = - asn1_wrapper:encode('SeqDefault','SeqDef1',#'SeqDef1'{bool1 = true, - int1 = 15, - seq1 = #'SeqIn'{boolIn = true, - intIn = 66}}), - ?line {ok,{'SeqDef1',true,15,{'SeqIn',true,66}}} = - asn1_wrapper:decode('SeqDefault','SeqDef1',lists:flatten(Bytes11)), - - - ?line {ok,Bytes12} = asn1_wrapper:encode('SeqDefault','SeqDef1',#'SeqDef1'{int1 = 15}), - ?line {ok,{'SeqDef1',true,15,{'SeqIn',asn1_NOVALUE,12}}} = - asn1_wrapper:decode('SeqDefault','SeqDef1',lists:flatten(Bytes12)), - - - ?line {ok,Bytes21} = - asn1_wrapper:encode('SeqDefault','SeqDef2',#'SeqDef2'{bool2 = true, - int2 = 15, - seq2 = #'SeqIn'{boolIn = true, - intIn = 66}}), - ?line {ok,{'SeqDef2',{'SeqIn',true,66},true,15}} = - asn1_wrapper:decode('SeqDefault','SeqDef2',lists:flatten(Bytes21)), - - - ?line {ok,Bytes22} = asn1_wrapper:encode('SeqDefault','SeqDef2',#'SeqDef2'{int2 = 15}), - ?line {ok,{'SeqDef2',{'SeqIn',asn1_NOVALUE,12},true,15}} = - asn1_wrapper:decode('SeqDefault','SeqDef2',lists:flatten(Bytes22)), - - - - ?line {ok,Bytes31} = - asn1_wrapper:encode('SeqDefault','SeqDef3',#'SeqDef3'{bool3 = true, - int3 = 15, - seq3 = #'SeqIn'{boolIn = true, - intIn = 66}}), - ?line {ok,{'SeqDef3',true,{'SeqIn',true,66},15}} = - asn1_wrapper:decode('SeqDefault','SeqDef3',lists:flatten(Bytes31)), - - - ?line {ok,Bytes32} = asn1_wrapper:encode('SeqDefault','SeqDef3',#'SeqDef3'{int3 = 15}), - ?line {ok,{'SeqDef3',true,{'SeqIn',asn1_NOVALUE,12},15}} = - asn1_wrapper:decode('SeqDefault','SeqDef3',lists:flatten(Bytes32)), - - - - - - ?line {ok,Bytes41} = - asn1_wrapper:encode('SeqDefault','SeqDef1Imp',#'SeqDef1Imp'{bool1 = true, - int1 = 15, - seq1 = #'SeqIn'{boolIn = true, - intIn = 66}}), - ?line {ok,{'SeqDef1Imp',true,15,{'SeqIn',true,66}}} = - asn1_wrapper:decode('SeqDefault','SeqDef1Imp',lists:flatten(Bytes41)), - - - ?line {ok,Bytes42} = asn1_wrapper:encode('SeqDefault','SeqDef1Imp',#'SeqDef1Imp'{int1 = 15}), - ?line {ok,{'SeqDef1Imp',true,15,{'SeqIn',asn1_NOVALUE,12}}} = - asn1_wrapper:decode('SeqDefault','SeqDef1Imp',lists:flatten(Bytes42)), - - - ?line {ok,Bytes51} = - asn1_wrapper:encode('SeqDefault','SeqDef2Imp',#'SeqDef2Imp'{bool2 = true, - int2 = 15, - seq2 = #'SeqIn'{boolIn = true, - intIn = 66}}), - ?line {ok,{'SeqDef2Imp',{'SeqIn',true,66},true,15}} = - asn1_wrapper:decode('SeqDefault','SeqDef2Imp',lists:flatten(Bytes51)), - - - ?line {ok,Bytes52} = asn1_wrapper:encode('SeqDefault','SeqDef2Imp',#'SeqDef2Imp'{int2 = 15}), - ?line {ok,{'SeqDef2Imp',{'SeqIn',asn1_NOVALUE,12},true,15}} = - asn1_wrapper:decode('SeqDefault','SeqDef2Imp',lists:flatten(Bytes52)), - - - - ?line {ok,Bytes61} = - asn1_wrapper:encode('SeqDefault','SeqDef3Imp',#'SeqDef3Imp'{bool3 = true, - int3 = 15, - seq3 = #'SeqIn'{boolIn = true, - intIn = 66}}), - ?line {ok,{'SeqDef3Imp',true,{'SeqIn',true,66},15}} = - asn1_wrapper:decode('SeqDefault','SeqDef3Imp',lists:flatten(Bytes61)), - - - ?line {ok,Bytes62} = asn1_wrapper:encode('SeqDefault','SeqDef3Imp',#'SeqDef3Imp'{int3 = 15}), - ?line {ok,{'SeqDef3Imp',true,{'SeqIn',asn1_NOVALUE,12},15}} = - asn1_wrapper:decode('SeqDefault','SeqDef3Imp',lists:flatten(Bytes62)), - - - - - - - ?line {ok,Bytes71} = - asn1_wrapper:encode('SeqDefault','SeqDef1Exp',#'SeqDef1Exp'{bool1 = true, - int1 = 15, - seq1 = #'SeqIn'{boolIn = true, - intIn = 66}}), - ?line {ok,{'SeqDef1Exp',true,15,{'SeqIn',true,66}}} = - asn1_wrapper:decode('SeqDefault','SeqDef1Exp',lists:flatten(Bytes71)), - - - ?line {ok,Bytes72} = asn1_wrapper:encode('SeqDefault','SeqDef1Exp',#'SeqDef1Exp'{int1 = 15}), - ?line {ok,{'SeqDef1Exp',true,15,{'SeqIn',asn1_NOVALUE,12}}} = - asn1_wrapper:decode('SeqDefault','SeqDef1Exp',lists:flatten(Bytes72)), - - - ?line {ok,Bytes81} = - asn1_wrapper:encode('SeqDefault','SeqDef2Exp',#'SeqDef2Exp'{bool2 = true, - int2 = 15, - seq2 = #'SeqIn'{boolIn = true, - intIn = 66}}), - ?line {ok,{'SeqDef2Exp',{'SeqIn',true,66},true,15}} = - asn1_wrapper:decode('SeqDefault','SeqDef2Exp',lists:flatten(Bytes81)), - - - ?line {ok,Bytes82} = asn1_wrapper:encode('SeqDefault','SeqDef2Exp',#'SeqDef2Exp'{int2 = 15, - bool2 = true}), - ?line {ok,{'SeqDef2Exp',{'SeqIn',asn1_NOVALUE,12},true,15}} = - asn1_wrapper:decode('SeqDefault','SeqDef2Exp',lists:flatten(Bytes82)), - - - - ?line {ok,Bytes91} = - asn1_wrapper:encode('SeqDefault','SeqDef3Exp',#'SeqDef3Exp'{bool3 = true, - int3 = 15, - seq3 = #'SeqIn'{boolIn = true, - intIn = 66}}), - ?line {ok,{'SeqDef3Exp',true,{'SeqIn',true,66},15}} = - asn1_wrapper:decode('SeqDefault','SeqDef3Exp',lists:flatten(Bytes91)), - - - ?line {ok,Bytes92} = asn1_wrapper:encode('SeqDefault','SeqDef3Exp',#'SeqDef3Exp'{int3 = 15}), - ?line {ok,{'SeqDef3Exp',true,{'SeqIn',asn1_NOVALUE,12},15}} = - asn1_wrapper:decode('SeqDefault','SeqDef3Exp',lists:flatten(Bytes92)), - - - - + roundtrip('SeqDef1', #'SeqDef1'{bool1=true,int1=15,seq1=#'SeqIn'{boolIn=true,intIn=66}}), + roundtrip('SeqDef1', + #'SeqDef1'{bool1=asn1_DEFAULT,int1=15,seq1=asn1_DEFAULT}, + #'SeqDef1'{bool1=true,int1=15,seq1=#'SeqIn'{}}), + + roundtrip('SeqDef2', #'SeqDef2'{seq2=#'SeqIn'{boolIn=true,intIn=66},bool2=true,int2=15}), + roundtrip('SeqDef2', + #'SeqDef2'{seq2=asn1_DEFAULT,bool2=asn1_DEFAULT,int2=15}, + #'SeqDef2'{seq2=#'SeqIn'{},bool2=true,int2=15}), + + roundtrip('SeqDef3', #'SeqDef3'{bool3=true,seq3=#'SeqIn'{boolIn=true,intIn=66},int3=15}), + roundtrip('SeqDef3', + #'SeqDef3'{bool3=asn1_DEFAULT,seq3=asn1_DEFAULT,int3=15}, + #'SeqDef3'{bool3=true,seq3=#'SeqIn'{},int3=15}), + + roundtrip('SeqDef1Imp', #'SeqDef1Imp'{bool1=true,int1=15, + seq1=#'SeqIn'{boolIn=true,intIn=66}}), + roundtrip('SeqDef1Imp', + #'SeqDef1Imp'{bool1=asn1_DEFAULT,int1=15,seq1=asn1_DEFAULT}, + #'SeqDef1Imp'{bool1=true,int1=15,seq1=#'SeqIn'{}}), + + roundtrip('SeqDef2Imp', #'SeqDef2Imp'{seq2=#'SeqIn'{boolIn=true,intIn=66}, + bool2=true,int2=15}), + roundtrip('SeqDef2Imp', + #'SeqDef2Imp'{seq2=asn1_DEFAULT,bool2=asn1_DEFAULT,int2=15}, + #'SeqDef2Imp'{seq2=#'SeqIn'{},bool2=true,int2=15}), + + roundtrip('SeqDef3Imp', + #'SeqDef3Imp'{bool3=true,seq3=#'SeqIn'{boolIn=true,intIn=66},int3=15}), + roundtrip('SeqDef3Imp', + #'SeqDef3Imp'{bool3=asn1_DEFAULT,seq3=asn1_DEFAULT,int3=15}, + #'SeqDef3Imp'{bool3=true,seq3=#'SeqIn'{},int3=15}), + + roundtrip('SeqDef1Exp', + #'SeqDef1Exp'{bool1=true,int1=15,seq1=#'SeqIn'{boolIn=true,intIn=66}}), + roundtrip('SeqDef1Exp', + #'SeqDef1Exp'{bool1=asn1_DEFAULT,int1=15,seq1=asn1_DEFAULT}, + #'SeqDef1Exp'{bool1=true,int1=15,seq1=#'SeqIn'{}}), + + roundtrip('SeqDef2Exp', #'SeqDef2Exp'{seq2=#'SeqIn'{boolIn=true,intIn=66}, + bool2=true,int2=15}), + roundtrip('SeqDef2Exp', + #'SeqDef2Exp'{seq2=asn1_DEFAULT,bool2=true,int2=15}, + #'SeqDef2Exp'{seq2=#'SeqIn'{},bool2=true,int2=15}), + + roundtrip('SeqDef3Exp', + #'SeqDef3Exp'{bool3=true,seq3=#'SeqIn'{boolIn=true,intIn=66},int3=15}), + roundtrip('SeqDef3Exp', + #'SeqDef3Exp'{bool3=asn1_DEFAULT,seq3=asn1_DEFAULT,int3=15}, + #'SeqDef3Exp'{bool3=true,seq3=#'SeqIn'{},int3=15}), ok. + +roundtrip(Type, Value) -> + roundtrip(Type, Value, Value). + +roundtrip(Type, Value, ExpectedValue) -> + asn1_test_lib:roundtrip('SeqDefault', Type, Value, ExpectedValue). diff --git a/lib/asn1/test/testSeqExtension.erl b/lib/asn1/test/testSeqExtension.erl index b996634996..8473459c36 100644 --- a/lib/asn1/test/testSeqExtension.erl +++ b/lib/asn1/test/testSeqExtension.erl @@ -108,18 +108,14 @@ main(Erule, DataDir, Opts) -> ok. roundtrip(Type, Value) -> - {ok,Encoded} = 'SeqExtension':encode(Type, Value), - {ok,Value} = 'SeqExtension':decode(Type, Encoded), - ok. + asn1_test_lib:roundtrip('SeqExtension', Type, Value). v_roundtrip2(Erule, Type, Value) -> Encoded = asn1_test_lib:hex_to_bin(v(Erule, Type)), Encoded = roundtrip2(Type, Value). roundtrip2(Type, Value) -> - {ok,Encoded} = 'SeqExtension2':encode(Type, Value), - {ok,Value} = 'SeqExtension2':decode(Type, Encoded), - Encoded. + asn1_test_lib:roundtrip_enc('SeqExtension2', Type, Value). v(ber, 'SeqExt66') -> "30049F41 017D"; v(per, 'SeqExt66') -> "C0420000 00000000 00004001 FA"; diff --git a/lib/asn1/test/testSeqExternal.erl b/lib/asn1/test/testSeqExternal.erl index b89b98d3fa..a8e0902244 100644 --- a/lib/asn1/test/testSeqExternal.erl +++ b/lib/asn1/test/testSeqExternal.erl @@ -20,121 +20,38 @@ -module(testSeqExternal). -include("External.hrl"). --export([compile/3]). -export([main/1]). -include_lib("test_server/include/test_server.hrl"). - -record('SeqXSet1',{set, bool, int}). -record('SeqXSet2',{bool, set, int}). -record('SeqXSet3',{bool, int, set}). -%-record('NT',{os, bool}). -%-record('Imp',{os, bool}). -%-record('Exp',{os, bool}). - - -compile(Config,Rules,Options) -> - - ?line DataDir = ?config(data_dir,Config), - ?line OutDir = ?config(priv_dir,Config), - ?line true = code:add_patha(?config(priv_dir,Config)), - ?line ok = asn1ct:compile(DataDir ++ "SeqExternal", - [Rules,{outdir,OutDir}]++Options). - - main(_Rules) -> - - ?line {ok,Bytes11} = - asn1_wrapper:encode('SeqExternal','XNTNT',#'XSeqNT'{bool = true, os = "kalle"}), - ?line {ok,{'XSeqNT',[107,97,108,108,101],true}} = - asn1_wrapper:decode('SeqExternal','XNTNT',lists:flatten(Bytes11)), - - ?line {ok,Bytes12} = - asn1_wrapper:encode('SeqExternal','XImpNT',#'XSeqNT'{bool = true, os = "kalle"}), - ?line {ok,{'XSeqNT',[107,97,108,108,101],true}} = - asn1_wrapper:decode('SeqExternal','XImpNT',lists:flatten(Bytes12)), - - ?line {ok,Bytes13} = - asn1_wrapper:encode('SeqExternal','XExpNT',#'XSeqNT'{bool = true, os = "kalle"}), - ?line {ok,{'XSeqNT',[107,97,108,108,101],true}} = - asn1_wrapper:decode('SeqExternal','XExpNT',lists:flatten(Bytes13)), - - - - ?line {ok,Bytes21} = - asn1_wrapper:encode('SeqExternal','XNTImp',#'XSeqImp'{bool = true, os = "kalle"}), - ?line {ok,{'XSeqImp',[107,97,108,108,101],true}} = - asn1_wrapper:decode('SeqExternal','XNTImp',lists:flatten(Bytes21)), - - ?line {ok,Bytes22} = - asn1_wrapper:encode('SeqExternal','XImpImp',#'XSeqImp'{bool = true, os = "kalle"}), - ?line {ok,{'XSeqImp',[107,97,108,108,101],true}} = - asn1_wrapper:decode('SeqExternal','XImpImp',lists:flatten(Bytes22)), - - ?line {ok,Bytes23} = - asn1_wrapper:encode('SeqExternal','XExpImp',#'XSeqImp'{bool = true, os = "kalle"}), - ?line {ok,{'XSeqImp',[107,97,108,108,101],true}} = - asn1_wrapper:decode('SeqExternal','XExpImp',lists:flatten(Bytes23)), - - - - ?line {ok,Bytes31} = - asn1_wrapper:encode('SeqExternal','XNTExp',#'XSeqExp'{bool = true, os = "kalle"}), - ?line {ok,{'XSeqExp',[107,97,108,108,101],true}} = - asn1_wrapper:decode('SeqExternal','XNTExp',lists:flatten(Bytes31)), - - ?line {ok,Bytes32} = - asn1_wrapper:encode('SeqExternal','XImpExp',#'XSeqExp'{bool = true, os = "kalle"}), - ?line {ok,{'XSeqExp',[107,97,108,108,101],true}} = - asn1_wrapper:decode('SeqExternal','XImpExp',lists:flatten(Bytes32)), - - ?line {ok,Bytes33} = - asn1_wrapper:encode('SeqExternal','XExpExp',#'XSeqExp'{bool = true, os = "kalle"}), - ?line {ok,{'XSeqExp',[107,97,108,108,101],true}} = - asn1_wrapper:decode('SeqExternal','XExpExp',lists:flatten(Bytes33)), - - - - ?line {ok,Bytes41} = - asn1_wrapper:encode('SeqExternal','SeqXSet1', - #'SeqXSet1'{bool = true, - int = 66, - set = #'XSet1'{bool1 = true, - int1 = 77, - set1 = #'XSetIn'{boolIn = false, - intIn = 88}}}), - ?line {ok,{'SeqXSet1',{'XSet1',true,77,{'XSetIn',false,88}},true,66}} = - asn1_wrapper:decode('SeqExternal','SeqXSet1',lists:flatten(Bytes41)), - - - - ?line {ok,Bytes42} = - asn1_wrapper:encode('SeqExternal','SeqXSet2', - #'SeqXSet2'{bool = true, - int = 66, - set = #'XSet1'{bool1 = true, - int1 = 77, - set1 = #'XSetIn'{boolIn = false, - intIn = 88}}}), - ?line {ok,{'SeqXSet2',true,{'XSet1',true,77,{'XSetIn',false,88}},66}} = - asn1_wrapper:decode('SeqExternal','SeqXSet2',lists:flatten(Bytes42)), - - ?line {ok,Bytes43} = - asn1_wrapper:encode('SeqExternal','SeqXSet3', - #'SeqXSet3'{bool = true, - int = 66, - set = #'XSet1'{bool1 = true, - int1 = 77, - set1 = #'XSetIn'{boolIn = false, - intIn = 88}}}), - ?line {ok,{'SeqXSet3',true,66,{'XSet1',true,77,{'XSetIn',false,88}}}} = - asn1_wrapper:decode('SeqExternal','SeqXSet3',lists:flatten(Bytes43)), - - - - + roundtrip('XNTNT', #'XSeqNT'{os="kalle",bool=true}), + roundtrip('XImpNT', #'XSeqNT'{os="kalle",bool=true}), + roundtrip('XExpNT', #'XSeqNT'{os="kalle",bool=true}), + roundtrip('XNTImp', #'XSeqImp'{os="kalle",bool=true}), + roundtrip('XImpImp', #'XSeqImp'{os="kalle",bool=true}), + roundtrip('XExpImp', #'XSeqImp'{os="kalle",bool=true}), + roundtrip('XNTExp', #'XSeqExp'{os="kalle",bool=true}), + roundtrip('XImpExp', #'XSeqExp'{os="kalle",bool=true}), + roundtrip('XExpExp', #'XSeqExp'{os="kalle",bool=true}), + roundtrip('SeqXSet1', + #'SeqXSet1'{set=#'XSet1'{bool1=true,int1=77, + set1=#'XSetIn'{boolIn=false,intIn=88}}, + bool=true,int=66}), + roundtrip('SeqXSet2', + #'SeqXSet2'{bool=true, + set=#'XSet1'{bool1=true,int1=77, + set1=#'XSetIn'{boolIn=false,intIn=88}}, + int=66}), + roundtrip('SeqXSet3', + #'SeqXSet3'{bool=true,int=66, + set=#'XSet1'{bool1=true,int1=77, + set1=#'XSetIn'{boolIn=false,intIn=88}}}), ok. - +roundtrip(T, V) -> + asn1_test_lib:roundtrip('SeqExternal', T, V). diff --git a/lib/asn1/test/testSeqIndefinite.erl b/lib/asn1/test/testSeqIndefinite.erl deleted file mode 100644 index c7b8aba523..0000000000 --- a/lib/asn1/test/testSeqIndefinite.erl +++ /dev/null @@ -1,48 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% 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(testSeqIndefinite). - --export([main/1]). - --include_lib("test_server/include/test_server.hrl"). - -main(per) -> ok; -main(ber) -> - - %% normal encoding - B = [48,20,1,1,255,48,9,1,1,255,2,4,251,35,238,194,2,4,251,55,236,161], - %% indefinite length encoding - Bi = [48,22,1,1,255,48,128,1,1,255,2,4,251,35,238,194,0,0,2,4,251,55,236,161], - %% the value which is encoded - V = {'SeqS3',true,{'SeqS3_seqS3',true,-81531198},-80221023}, - ?line {ok,V} = asn1_wrapper:decode('SeqSetIndefinite','SeqS3',B), - ?line {ok,V} = asn1_wrapper:decode('SeqSetIndefinite','SeqS3',Bi), - - %% normal encoding but with unknown extension component - _Be = [48,23,1,1,255,48,12,1,1,255,2,4,251,35,238,194,1,1,255,2,4,251,55,236,161], - %% indefinite length encoding but with unknown extension component - _Bei = [48,25,1,1,255,48,128,1,1,255,2,4,251,35,238,194,1,1,255,0,0,2,4,251,55,236,161], - - ?line {ok,V} = asn1_wrapper:decode('SeqSetIndefinite','SeqS3',B), - ?line {ok,V} = asn1_wrapper:decode('SeqSetIndefinite','SeqS3',Bi), - ok. - - - diff --git a/lib/asn1/test/testSeqOf.erl b/lib/asn1/test/testSeqOf.erl index db537b1478..7f8f4079b4 100644 --- a/lib/asn1/test/testSeqOf.erl +++ b/lib/asn1/test/testSeqOf.erl @@ -83,6 +83,32 @@ main(_Rules) -> roundtrip('Seq4', #'Seq4'{seq43=SeqIn3}, #'Seq4'{seq41=[],seq42=[], seq43=SeqIn3}), + + roundtrip('Seq5', {'Seq5',true,[],77}), + roundtrip('Seq5', {'Seq5',true,[""],77}), + roundtrip('Seq5', {'Seq5',true,["a"],77}), + roundtrip('Seq5', {'Seq5',true,["ab"],77}), + roundtrip('Seq5', {'Seq5',true,["abc"],77}), + + roundtrip('Seq6', {'Seq6',[],[],101}), + roundtrip('Seq6', {'Seq6',[],[7],101}), + roundtrip('Seq6', {'Seq6',[],[1,7],101}), + roundtrip('Seq6', {'Seq6',[1],[],101}), + roundtrip('Seq6', {'Seq6',[2],[7],101}), + roundtrip('Seq6', {'Seq6',[3],[1,7],101}), + + roundtrip('Seq8', {'Seq8',[],37}), + + roundtrip('Seq9', {'Seq9',true,[],97}), + roundtrip('Seq9', {'Seq9',true,[""],97}), + roundtrip('Seq9', {'Seq9',true,["x"],97}), + roundtrip('Seq9', {'Seq9',true,["xy"],97}), + roundtrip('Seq9', {'Seq9',true,["xyz"],97}), + + roundtrip('Seq10', {'Seq10',true,[""],97}), + roundtrip('Seq10', {'Seq10',true,["a"],97}), + roundtrip('Seq10', {'Seq10',true,["a","b"],97}), + roundtrip('Seq10', {'Seq10',true,["a","b","c"],97}), roundtrip('SeqEmp', #'SeqEmp'{seq1=[#'Empty'{}]}), @@ -123,15 +149,9 @@ roundtrip(T, V) -> roundtrip(T, V, V). roundtrip(Type, Val, Expected) -> - M = 'SeqOf', - {ok,Enc} = M:encode(Type, Val), - {ok,Expected} = M:decode(Type, Enc), - ok. + asn1_test_lib:roundtrip('SeqOf', Type, Val, Expected). xroundtrip(T1, T2, Val) -> - M = 'XSeqOf', - {ok,Enc} = M:encode(T1, Val), - {ok,Enc} = M:encode(T2, Val), - {ok,Val} = M:decode(T1, Enc), - {ok,Val} = M:decode(T2, Enc), + Enc = asn1_test_lib:roundtrip_enc('XSeqOf', T1, Val), + Enc = asn1_test_lib:roundtrip_enc('XSeqOf', T2, Val), ok. diff --git a/lib/asn1/test/testSeqOfCho.erl b/lib/asn1/test/testSeqOfCho.erl index 5b83c8bf21..f749845bb9 100644 --- a/lib/asn1/test/testSeqOfCho.erl +++ b/lib/asn1/test/testSeqOfCho.erl @@ -31,117 +31,45 @@ -record('SeqOfChoEmbOpt_SEQOF',{bool1, int1, seq1 = asn1_NOVALUE}). main(_Rules) -> - - ?line {ok,Bytes11} = - asn1_wrapper:encode('SeqOfCho','SeqChoDef',#'SeqChoDef'{bool1 = true, - int1 = 17}), - ?line {ok,{'SeqChoDef',true,17,[]}} = - asn1_wrapper:decode('SeqOfCho','SeqChoDef',lists:flatten(Bytes11)), - - - ?line {ok,Bytes12} = - asn1_wrapper:encode('SeqOfCho','SeqChoDef',#'SeqChoDef'{bool1 = true, - int1 = 17, - seq1 = [{boolIn,true}, - {intIn,25}]}), - ?line {ok,{'SeqChoDef',true,17,[{boolIn,true},{intIn,25}]}} = - asn1_wrapper:decode('SeqOfCho','SeqChoDef',lists:flatten(Bytes12)), - - - - ?line {ok,Bytes15} = - asn1_wrapper:encode('SeqOfCho','SeqChoOpt',#'SeqChoOpt'{bool1 = true, - int1 = 17}), - ?line {ok,{'SeqChoOpt',true,17,asn1_NOVALUE}} = - asn1_wrapper:decode('SeqOfCho','SeqChoOpt',lists:flatten(Bytes15)), - - - ?line {ok,Bytes16} = - asn1_wrapper:encode('SeqOfCho','SeqChoOpt',#'SeqChoOpt'{bool1 = true, - int1 = 17, - seq1 = [{boolIn,true}, - {intIn,25}]}), - ?line {ok,{'SeqChoOpt',true,17,[{boolIn,true},{intIn,25}]}} = - asn1_wrapper:decode('SeqOfCho','SeqChoOpt',lists:flatten(Bytes16)), - - - - - - ?line {ok,Bytes21} = - asn1_wrapper:encode('SeqOfCho','SeqChoEmbDef',#'SeqChoEmbDef'{bool1 = true, - int1 = 17}), - ?line {ok,{'SeqChoEmbDef',true,17,[]}} = - asn1_wrapper:decode('SeqOfCho','SeqChoEmbDef',lists:flatten(Bytes21)), - - - ?line {ok,Bytes22} = - asn1_wrapper:encode('SeqOfCho','SeqChoEmbDef',#'SeqChoEmbDef'{bool1 = true, - int1 = 17, - seq1 = [{boolIn,true}, - {intIn,25}]}), - ?line {ok,{'SeqChoEmbDef',true,17,[{boolIn,true},{intIn,25}]}} = - asn1_wrapper:decode('SeqOfCho','SeqChoEmbDef',lists:flatten(Bytes22)), - - - - ?line {ok,Bytes25} = - asn1_wrapper:encode('SeqOfCho','SeqChoEmbOpt',#'SeqChoEmbOpt'{bool1 = true, - int1 = 17}), - ?line {ok,{'SeqChoEmbOpt',true,17,asn1_NOVALUE}} = - asn1_wrapper:decode('SeqOfCho','SeqChoEmbOpt',lists:flatten(Bytes25)), - - - ?line {ok,Bytes26} = - asn1_wrapper:encode('SeqOfCho','SeqChoEmbOpt',#'SeqChoEmbOpt'{bool1 = true, - int1 = 17, - seq1 = [{boolIn,true}, - {intIn,25}]}), - ?line {ok,{'SeqChoEmbOpt',true,17,[{boolIn,true},{intIn,25}]}} = - asn1_wrapper:decode('SeqOfCho','SeqChoEmbOpt',lists:flatten(Bytes26)), - - - - - - - ?line {ok,Bytes31} = - asn1_wrapper:encode('SeqOfCho','SeqOfChoEmbDef',[#'SeqOfChoEmbDef_SEQOF'{bool1 = true, - int1 = 17}]), - ?line {ok,[{'SeqOfChoEmbDef_SEQOF',true,17,[]}]} = - asn1_wrapper:decode('SeqOfCho','SeqOfChoEmbDef',lists:flatten(Bytes31)), - - - ?line {ok,Bytes32} = - asn1_wrapper:encode('SeqOfCho','SeqOfChoEmbDef', - [#'SeqOfChoEmbDef_SEQOF'{bool1 = true, - int1 = 17, - seq1 = [{boolIn,true}, - {intIn,25}]}]), - ?line {ok,[{'SeqOfChoEmbDef_SEQOF',true,17,[{boolIn,true},{intIn,25}]}]} = - asn1_wrapper:decode('SeqOfCho','SeqOfChoEmbDef',lists:flatten(Bytes32)), - - - - ?line {ok,Bytes35} = - asn1_wrapper:encode('SeqOfCho','SeqOfChoEmbOpt',[#'SeqOfChoEmbOpt_SEQOF'{bool1 = true, - int1 = 17}]), - ?line {ok,[{'SeqOfChoEmbOpt_SEQOF',true,17,asn1_NOVALUE}]} = - asn1_wrapper:decode('SeqOfCho','SeqOfChoEmbOpt',lists:flatten(Bytes35)), - - - ?line {ok,Bytes36} = - asn1_wrapper:encode('SeqOfCho','SeqOfChoEmbOpt', - [#'SeqOfChoEmbOpt_SEQOF'{bool1 = true, - int1 = 17, - seq1 = [{boolIn,true}, - {intIn,25}]}]), - ?line {ok,[{'SeqOfChoEmbOpt_SEQOF',true,17,[{boolIn,true},{intIn,25}]}]} = - asn1_wrapper:decode('SeqOfCho','SeqOfChoEmbOpt',lists:flatten(Bytes36)), - - - - + roundtrip('SeqChoDef', + #'SeqChoDef'{bool1=true,int1=17,seq1=asn1_DEFAULT}, + #'SeqChoDef'{bool1=true,int1=17,seq1=[]}), + roundtrip('SeqChoDef', + #'SeqChoDef'{bool1=true,int1=17, + seq1=[{boolIn,true},{intIn,25}]}), + roundtrip('SeqChoOpt', + #'SeqChoOpt'{bool1=true,int1=17,seq1=asn1_NOVALUE}), + roundtrip('SeqChoOpt', + #'SeqChoOpt'{bool1=true,int1=17, + seq1=[{boolIn,true},{intIn,25}]}), + + roundtrip('SeqChoEmbDef', + #'SeqChoEmbDef'{bool1=true,int1=17,seq1=asn1_DEFAULT}, + #'SeqChoEmbDef'{bool1=true,int1=17,seq1=[]}), + roundtrip('SeqChoEmbDef', + #'SeqChoEmbDef'{bool1=true,int1=17, + seq1=[{boolIn,true},{intIn,25}]}), + roundtrip('SeqChoEmbOpt', + #'SeqChoEmbOpt'{bool1=true,int1=17,seq1=asn1_NOVALUE}), + roundtrip('SeqChoEmbOpt', + #'SeqChoEmbOpt'{bool1=true,int1=17, + seq1=[{boolIn,true},{intIn,25}]}), + + roundtrip('SeqOfChoEmbDef', + [#'SeqOfChoEmbDef_SEQOF'{bool1=true,int1=17,seq1=asn1_DEFAULT}], + [#'SeqOfChoEmbDef_SEQOF'{bool1=true,int1=17,seq1=[]}]), + roundtrip('SeqOfChoEmbDef', + [#'SeqOfChoEmbDef_SEQOF'{bool1=true,int1=17, + seq1=[{boolIn,true},{intIn,25}]}]), + roundtrip('SeqOfChoEmbOpt', + [#'SeqOfChoEmbOpt_SEQOF'{bool1=true,int1=17,seq1=asn1_NOVALUE}]), + roundtrip('SeqOfChoEmbOpt', + [#'SeqOfChoEmbOpt_SEQOF'{bool1=true,int1=17, + seq1=[{boolIn,true},{intIn,25}]}]), ok. +roundtrip(Type, Value) -> + roundtrip(Type, Value, Value). +roundtrip(Type, Value, ExpectedValue) -> + asn1_test_lib:roundtrip('SeqOfCho', Type, Value, ExpectedValue). diff --git a/lib/asn1/test/testSeqOfExternal.erl b/lib/asn1/test/testSeqOfExternal.erl index 4c4c9e2b0f..2e60f441c1 100644 --- a/lib/asn1/test/testSeqOfExternal.erl +++ b/lib/asn1/test/testSeqOfExternal.erl @@ -18,9 +18,6 @@ %% %% -module(testSeqOfExternal). - - --export([compile/3]). -export([main/1]). -include_lib("test_server/include/test_server.hrl"). @@ -30,142 +27,53 @@ -record('Imp',{os, bool}). -record('Exp',{os, bool}). - - -compile(Config,Rules,Options) -> - - ?line DataDir = ?config(data_dir,Config), - ?line OutDir = ?config(priv_dir,Config), - ?line true = code:add_patha(?config(priv_dir,Config)), - ?line ok = asn1ct:compile(DataDir ++ "SeqOfExternal",[Rules,{outdir,OutDir}]++Options). - - - main(_Rules) -> - - ?line {ok,Bytes11} = - asn1_wrapper:encode('SeqOfExternal','NTNT',[#'NT'{bool = true, os = "kalle"}, - #'NT'{bool = true, os = "kalle"}]), - ?line {ok,[{'NT',[107,97,108,108,101],true},{'NT',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SeqOfExternal','NTNT',lists:flatten(Bytes11)), - - ?line {ok,Bytes12} = - asn1_wrapper:encode('SeqOfExternal','ImpNT',[#'NT'{bool = true, os = "kalle"}, - #'NT'{bool = true, os = "kalle"}]), - ?line {ok,[{'NT',[107,97,108,108,101],true},{'NT',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SeqOfExternal','ImpNT',lists:flatten(Bytes12)), - - ?line {ok,Bytes13} = - asn1_wrapper:encode('SeqOfExternal','ExpNT',[#'NT'{bool = true, os = "kalle"}, - #'NT'{bool = true, os = "kalle"}]), - ?line {ok,[{'NT',[107,97,108,108,101],true},{'NT',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SeqOfExternal','ExpNT',lists:flatten(Bytes13)), - - - - ?line {ok,Bytes21} = - asn1_wrapper:encode('SeqOfExternal','NTImp',[#'Imp'{bool = true, os = "kalle"}, - #'Imp'{bool = true, os = "kalle"}]), - ?line {ok,[{'Imp',[107,97,108,108,101],true},{'Imp',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SeqOfExternal','NTImp',lists:flatten(Bytes21)), - - ?line {ok,Bytes22} = - asn1_wrapper:encode('SeqOfExternal','ImpImp',[#'Imp'{bool = true, os = "kalle"}, - #'Imp'{bool = true, os = "kalle"}]), - ?line {ok,[{'Imp',[107,97,108,108,101],true},{'Imp',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SeqOfExternal','ImpImp',lists:flatten(Bytes22)), - - ?line {ok,Bytes23} = - asn1_wrapper:encode('SeqOfExternal','ExpImp',[#'Imp'{bool = true, os = "kalle"}, - #'Imp'{bool = true, os = "kalle"}]), - ?line {ok,[{'Imp',[107,97,108,108,101],true},{'Imp',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SeqOfExternal','ExpImp',lists:flatten(Bytes23)), - - - - ?line {ok,Bytes31} = - asn1_wrapper:encode('SeqOfExternal','NTExp',[#'Exp'{bool = true, os = "kalle"}, - #'Exp'{bool = true, os = "kalle"}]), - ?line {ok,[{'Exp',[107,97,108,108,101],true},{'Exp',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SeqOfExternal','NTExp',lists:flatten(Bytes31)), - - ?line {ok,Bytes32} = - asn1_wrapper:encode('SeqOfExternal','ImpExp',[#'Exp'{bool = true, os = "kalle"}, - #'Exp'{bool = true, os = "kalle"}]), - ?line {ok,[{'Exp',[107,97,108,108,101],true},{'Exp',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SeqOfExternal','ImpExp',lists:flatten(Bytes32)), - - ?line {ok,Bytes33} = - asn1_wrapper:encode('SeqOfExternal','ExpExp',[#'Exp'{bool = true, os = "kalle"}, - #'Exp'{bool = true, os = "kalle"}]), - ?line {ok,[{'Exp',[107,97,108,108,101],true},{'Exp',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SeqOfExternal','ExpExp',lists:flatten(Bytes33)), - - - - - - - - ?line {ok,Bytes41} = - asn1_wrapper:encode('SeqOfExternal','XNTNT',[#'XSeqNT'{bool = true, os = "kalle"}, - #'XSeqNT'{bool = true, os = "kalle"}]), - ?line {ok,[{'XSeqNT',[107,97,108,108,101],true},{'XSeqNT',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SeqOfExternal','XNTNT',lists:flatten(Bytes41)), - - ?line {ok,Bytes42} = - asn1_wrapper:encode('SeqOfExternal','XImpNT',[#'XSeqNT'{bool = true, os = "kalle"}, - #'XSeqNT'{bool = true, os = "kalle"}]), - ?line {ok,[{'XSeqNT',[107,97,108,108,101],true},{'XSeqNT',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SeqOfExternal','XImpNT',lists:flatten(Bytes42)), - - ?line {ok,Bytes43} = - asn1_wrapper:encode('SeqOfExternal','XExpNT',[#'XSeqNT'{bool = true, os = "kalle"}, - #'XSeqNT'{bool = true, os = "kalle"}]), - ?line {ok,[{'XSeqNT',[107,97,108,108,101],true},{'XSeqNT',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SeqOfExternal','XExpNT',lists:flatten(Bytes43)), - - - - ?line {ok,Bytes51} = - asn1_wrapper:encode('SeqOfExternal','XNTImp',[#'XSeqImp'{bool = true, os = "kalle"}, - #'XSeqImp'{bool = true, os = "kalle"}]), - ?line {ok,[{'XSeqImp',[107,97,108,108,101],true},{'XSeqImp',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SeqOfExternal','XNTImp',lists:flatten(Bytes51)), - - ?line {ok,Bytes52} = - asn1_wrapper:encode('SeqOfExternal','XImpImp',[#'XSeqImp'{bool = true, os = "kalle"}, - #'XSeqImp'{bool = true, os = "kalle"}]), - ?line {ok,[{'XSeqImp',[107,97,108,108,101],true},{'XSeqImp',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SeqOfExternal','XImpImp',lists:flatten(Bytes52)), - - ?line {ok,Bytes53} = - asn1_wrapper:encode('SeqOfExternal','XExpImp',[#'XSeqImp'{bool = true, os = "kalle"}, - #'XSeqImp'{bool = true, os = "kalle"}]), - ?line {ok,[{'XSeqImp',[107,97,108,108,101],true},{'XSeqImp',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SeqOfExternal','XExpImp',lists:flatten(Bytes53)), - - - - ?line {ok,Bytes61} = - asn1_wrapper:encode('SeqOfExternal','XNTExp',[#'XSeqExp'{bool = true, os = "kalle"}, - #'XSeqExp'{bool = true, os = "kalle"}]), - ?line {ok,[{'XSeqExp',[107,97,108,108,101],true},{'XSeqExp',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SeqOfExternal','XNTExp',lists:flatten(Bytes61)), - - ?line {ok,Bytes62} = - asn1_wrapper:encode('SeqOfExternal','XImpExp',[#'XSeqExp'{bool = true, os = "kalle"}, - #'XSeqExp'{bool = true, os = "kalle"}]), - ?line {ok,[{'XSeqExp',[107,97,108,108,101],true},{'XSeqExp',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SeqOfExternal','XImpExp',lists:flatten(Bytes62)), - - ?line {ok,Bytes63} = - asn1_wrapper:encode('SeqOfExternal','XExpExp',[#'XSeqExp'{bool = true, os = "kalle"}, - #'XSeqExp'{bool = true, os = "kalle"}]), - ?line {ok,[{'XSeqExp',[107,97,108,108,101],true},{'XSeqExp',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SeqOfExternal','XExpExp',lists:flatten(Bytes63)), - - - - + roundtrip('NTNT', + [#'NT'{os="kalle",bool=true},#'NT'{os="kalle",bool=true}]), + roundtrip('ImpNT', + [#'NT'{os="kalle",bool=true},#'NT'{os="kalle",bool=true}]), + roundtrip('ExpNT', + [#'NT'{os="kalle",bool=true},#'NT'{os="kalle",bool=true}]), + roundtrip('NTImp', + [#'Imp'{os="kalle",bool=true},#'Imp'{os="kalle",bool=true}]), + roundtrip('ImpImp', + [#'Imp'{os="kalle",bool=true},#'Imp'{os="kalle",bool=true}]), + roundtrip('ExpImp', + [#'Imp'{os="kalle",bool=true},#'Imp'{os="kalle",bool=true}]), + roundtrip('NTExp', + [#'Exp'{os="kalle",bool=true},#'Exp'{os="kalle",bool=true}]), + roundtrip('ImpExp', + [#'Exp'{os="kalle",bool=true},#'Exp'{os="kalle",bool=true}]), + roundtrip('ExpExp', + [#'Exp'{os="kalle",bool=true},#'Exp'{os="kalle",bool=true}]), + roundtrip('XNTNT', + [#'XSeqNT'{os="kalle",bool=true}, + #'XSeqNT'{os="kalle",bool=true}]), + roundtrip('XImpNT', + [#'XSeqNT'{os="kalle",bool=true}, + #'XSeqNT'{os="kalle",bool=true}]), + roundtrip('XExpNT', + [#'XSeqNT'{os="kalle",bool=true}, + #'XSeqNT'{os="kalle",bool=true}]), + roundtrip('XNTImp', + [#'XSeqImp'{os="kalle",bool=true}, + #'XSeqImp'{os="kalle",bool=true}]), + roundtrip('XImpImp', + [#'XSeqImp'{os="kalle",bool=true}, + #'XSeqImp'{os="kalle",bool=true}]), + roundtrip('XExpImp', + [#'XSeqImp'{os="kalle",bool=true}, + #'XSeqImp'{os="kalle",bool=true}]), + roundtrip('XNTExp', + [#'XSeqExp'{os="kalle",bool=true}, + #'XSeqExp'{os="kalle",bool=true}]), + roundtrip('XImpExp', + [#'XSeqExp'{os="kalle",bool=true}, + #'XSeqExp'{os="kalle",bool=true}]), + roundtrip('XExpExp', + [#'XSeqExp'{os="kalle",bool=true}, + #'XSeqExp'{os="kalle",bool=true}]), ok. + +roundtrip(T, V) -> + asn1_test_lib:roundtrip('SeqOfExternal', T, V). diff --git a/lib/asn1/test/testSeqOfIndefinite.erl b/lib/asn1/test/testSeqOfIndefinite.erl index 01ef36e0b4..b771405d84 100644 --- a/lib/asn1/test/testSeqOfIndefinite.erl +++ b/lib/asn1/test/testSeqOfIndefinite.erl @@ -33,60 +33,53 @@ main() -> ?line ok = test('InsertSubscriberDataArg'). % OTP-4232 test(isd)-> - EncPdu = [48,128,129,7,145,148,113,50,1,0,241,131,1,0,176,128,5,0,161,128,48,22,2,1,1,144,2,241,33,145,4,0,1,2,3,146,3,36,131,16,148,2,1,42,48,35,2,1,2,144,2,241,33,145,4,255,255,255,255,146,3,37,147,18,147,0,148,13,7,67,79,77,80,65,78,89,4,67,79,77,53,48,28,2,1,3,144,2,241,33,146,3,26,98,31,148,14,9,67,79,77,80,65,78,89,49,50,3,67,79,77,0,0,0,0,152,1,2,0,0], - - ?line {ok,_} = asn1_wrapper:decode('Mvrasn-11-4', - 'InsertSubscriberDataArg', - EncPdu), + EncPdu = <<48,128,129,7,145,148,113,50,1,0,241,131,1,0,176,128,5,0, + 161,128,48,22,2,1,1,144,2,241,33,145,4,0,1,2,3,146,3,36, + 131,16,148,2,1,42,48,35,2,1,2,144,2,241,33,145,4,255,255, + 255,255,146,3,37,147,18,147,0,148,13,7,67,79,77,80,65,78, + 89,4,67,79,77,53,48,28,2,1,3,144,2,241,33,146,3,26,98,31, + 148,14,9,67,79,77,80,65,78,89,49,50,3,67,79,77,0,0,0,0, + 152,1,2,0,0>>, + {ok,_} = 'Mvrasn-11-4':decode('InsertSubscriberDataArg', EncPdu), ok; % % Problems with indefinite length encoding !!! % test(isd2)-> - EncPdu = [48, 128, 128, 8, 98, 2, 50, 1, 0, 0, 0, 241, 176, 128, 161, 128, 48, 128, 2, 1, 1, 144, 2, 241, 33, 145, 4, 255, 23, 12, 1, 146, 3, 9, 17, 1, 147, 0, 148, 13, 7, 67, 79, 77, 80, 65, 78, 89, 4, 67, 79, 77, 53, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0], - - ?line {ok,_DecPdu} = asn1_wrapper:decode('Mvrasn-11-4', - 'InsertSubscriberDataArg', - EncPdu), - + EncPdu = <<48,128,128,8,98,2,50,1,0,0,0,241,176,128,161,128,48,128,2,1,1,144, + 2,241,33,145,4,255,23,12,1,146,3,9,17,1,147,0,148,13,7,67,79,77,80, + 65,78,89,4,67,79,77,53,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0>>, + {ok,_DecPdu} = 'Mvrasn-11-4':decode('InsertSubscriberDataArg', EncPdu), ok; % % Is doing fine, although there is indefinite encoding used... !!! % test(dsd)-> - EncPdu = [48, 128, 128, 8, 98, 2, 50, 1, 0, 0, 0, 241, 170, 2, 5, 0, 0, 0, 0, 0], - - ?line {ok,_DecPdu} = asn1_wrapper:decode('Mvrasn-11-4', - 'DeleteSubscriberDataArg', - EncPdu), - + EncPdu = <<48,128,128,8,98,2,50,1,0,0,0,241,170,2,5,0,0,0,0,0>>, + {ok,_DecPdu} = 'Mvrasn-11-4':decode('DeleteSubscriberDataArg', EncPdu), ok; % % Is doing fine !!! % test(ul_res)-> - EncPdu = [48, 9, 4, 7, 145, 148, 113, 66, 16, 17, 241], - - ?line {ok,_DecPdu} = asn1_wrapper:decode('Mvrasn-11-4', - 'UpdateGprsLocationRes', - EncPdu), - + EncPdu = <<48,9,4,7,145,148,113,66,16,17,241>>, + {ok,_DecPdu} = 'Mvrasn-11-4':decode('UpdateGprsLocationRes', EncPdu), ok; test(prim) -> - ?line {ok,Bytes} = asn1_wrapper:encode('SeqOf','SeqOfInt',[10,20,30]), - ?line [Tag,_Len|Ints] = lists:flatten(Bytes), - ?line {ok,[10,20,30]} = - asn1_wrapper:decode('SeqOf','SeqOfInt',[Tag,128|Ints] ++ [0,0]), + Bytes = asn1_test_lib:roundtrip_enc('SeqOf', 'SeqOfInt', [10,20,30]), + <<Tag,_Len,Ints/binary>> = Bytes, + {ok,[10,20,30]} = + 'SeqOf':decode('SeqOfInt', <<Tag,128,Ints/binary,0,0>>), ok; test(seqofseq) -> - {ok,_V} = asn1_wrapper:decode('Mvrasn-DataTypes-1', - 'SentParameters', - [48, + {ok,_V} = 'Mvrasn-DataTypes-1':decode( + 'SentParameters', + [48, 129, 190, 161, @@ -281,17 +274,16 @@ test(seqofseq) -> 0]), ok; test('InsertSubscriberDataArg') -> - {ok,_V} = - asn1_wrapper:decode('Mvrasn-11-4','InsertSubscriberDataArg', - [16#30,16#80,16#81,16#07,16#91,16#94, - 16#71,16#92,16#00,16#35,16#80,16#83, - 16#01,16#00,16#A6,16#06,16#04,16#01, - 16#21,16#04,16#01,16#22,16#B0,16#80, - 16#05,16#00,16#A1,16#80,16#30,16#1A, - 16#02,16#01,16#01,16#90,16#02,16#F1, - 16#21,16#92,16#03,16#0D,16#92,16#1F, - 16#94,16#0C,16#03,16#53,16#49,16#4D, - 16#03,16#47,16#53,16#4E,16#03,16#4C, - 16#4B,16#50,16#00,16#00,16#00,16#00, - 16#98,16#01,16#00,16#00,16#00]), + EncPdu = <<16#30,16#80,16#81,16#07,16#91,16#94, + 16#71,16#92,16#00,16#35,16#80,16#83, + 16#01,16#00,16#A6,16#06,16#04,16#01, + 16#21,16#04,16#01,16#22,16#B0,16#80, + 16#05,16#00,16#A1,16#80,16#30,16#1A, + 16#02,16#01,16#01,16#90,16#02,16#F1, + 16#21,16#92,16#03,16#0D,16#92,16#1F, + 16#94,16#0C,16#03,16#53,16#49,16#4D, + 16#03,16#47,16#53,16#4E,16#03,16#4C, + 16#4B,16#50,16#00,16#00,16#00,16#00, + 16#98,16#01,16#00,16#00,16#00>>, + {ok,_V} = 'Mvrasn-11-4':decode('InsertSubscriberDataArg', EncPdu), ok. diff --git a/lib/asn1/test/testSeqOfTag.erl b/lib/asn1/test/testSeqOfTag.erl index 2359df0c59..38c1dcb90f 100644 --- a/lib/asn1/test/testSeqOfTag.erl +++ b/lib/asn1/test/testSeqOfTag.erl @@ -44,145 +44,48 @@ -record('Exp',{os, bool}). main(_Rules) -> - - ?line {ok,Bytes11} = - asn1_wrapper:encode('SeqOfTag','SeqTagNt', - #'SeqTagNt'{nt = [#'NT'{bool = true, os = "kalle"}, - #'NT'{bool = true, os = "kalle"}]}), - ?line {ok,{'SeqTagNt', - [{'NT',[107,97,108,108,101],true},{'NT',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SeqOfTag','SeqTagNt',lists:flatten(Bytes11)), - - ?line {ok,Bytes12} = - asn1_wrapper:encode('SeqOfTag','SeqTagNtI', - #'SeqTagNtI'{imp = [#'Imp'{bool = true, os = "kalle"}, - #'Imp'{bool = true, os = "kalle"}]}), - ?line {ok,{'SeqTagNtI', - [{'Imp',[107,97,108,108,101],true},{'Imp',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SeqOfTag','SeqTagNtI',lists:flatten(Bytes12)), - - ?line {ok,Bytes13} = - asn1_wrapper:encode('SeqOfTag','SeqTagNtE', - #'SeqTagNtE'{exp = [#'Exp'{bool = true, os = "kalle"}, - #'Exp'{bool = true, os = "kalle"}]}), - ?line {ok,{'SeqTagNtE', - [{'Exp',[107,97,108,108,101],true},{'Exp',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SeqOfTag','SeqTagNtE',lists:flatten(Bytes13)), - - - - ?line {ok,Bytes21} = - asn1_wrapper:encode('SeqOfTag','SeqTagI', - #'SeqTagI'{nt = [#'NT'{bool = true, os = "kalle"}, - #'NT'{bool = true, os = "kalle"}]}), - ?line {ok,{'SeqTagI', - [{'NT',[107,97,108,108,101],true},{'NT',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SeqOfTag','SeqTagI',lists:flatten(Bytes21)), - - ?line {ok,Bytes22} = - asn1_wrapper:encode('SeqOfTag','SeqTagII', - #'SeqTagII'{imp = [#'Imp'{bool = true, os = "kalle"}, - #'Imp'{bool = true, os = "kalle"}]}), - ?line {ok,{'SeqTagII', - [{'Imp',[107,97,108,108,101],true},{'Imp',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SeqOfTag','SeqTagII',lists:flatten(Bytes22)), - - ?line {ok,Bytes23} = - asn1_wrapper:encode('SeqOfTag','SeqTagIE', - #'SeqTagIE'{exp = [#'Exp'{bool = true, os = "kalle"}, - #'Exp'{bool = true, os = "kalle"}]}), - ?line {ok,{'SeqTagIE', - [{'Exp',[107,97,108,108,101],true},{'Exp',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SeqOfTag','SeqTagIE',lists:flatten(Bytes23)), - - - - ?line {ok,Bytes31} = - asn1_wrapper:encode('SeqOfTag','SeqTagE', - #'SeqTagE'{nt = [#'NT'{bool = true, os = "kalle"}, - #'NT'{bool = true, os = "kalle"}]}), - ?line {ok,{'SeqTagE', - [{'NT',[107,97,108,108,101],true},{'NT',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SeqOfTag','SeqTagE',lists:flatten(Bytes31)), - - ?line {ok,Bytes32} = - asn1_wrapper:encode('SeqOfTag','SeqTagEI', - #'SeqTagEI'{imp = [#'Imp'{bool = true, os = "kalle"}, - #'Imp'{bool = true, os = "kalle"}]}), - ?line {ok,{'SeqTagEI', - [{'Imp',[107,97,108,108,101],true},{'Imp',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SeqOfTag','SeqTagEI',lists:flatten(Bytes32)), - - ?line {ok,Bytes33} = - asn1_wrapper:encode('SeqOfTag','SeqTagEE', - #'SeqTagEE'{exp = [#'Exp'{bool = true, os = "kalle"}, - #'Exp'{bool = true, os = "kalle"}]}), - ?line {ok,{'SeqTagEE', - [{'Exp',[107,97,108,108,101],true},{'Exp',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SeqOfTag','SeqTagEE',lists:flatten(Bytes33)), - - - - + roundtrip('SeqTagNt', #'SeqTagNt'{nt=[#'NT'{os="kalle",bool=true}, + #'NT'{os="kalle",bool=true}]}), + roundtrip('SeqTagNtI', #'SeqTagNtI'{imp=[#'Imp'{os="kalle",bool=true}, + #'Imp'{os="kalle",bool=true}]}), + roundtrip('SeqTagNtE', #'SeqTagNtE'{exp=[#'Exp'{os="kalle",bool=true}, + #'Exp'{os="kalle",bool=true}]}), + roundtrip('SeqTagI', #'SeqTagI'{nt=[#'NT'{os="kalle",bool=true}, + #'NT'{os="kalle",bool=true}]}), + roundtrip('SeqTagII', #'SeqTagII'{imp=[#'Imp'{os="kalle",bool=true}, + #'Imp'{os="kalle",bool=true}]}), + roundtrip('SeqTagIE', #'SeqTagIE'{exp=[#'Exp'{os="kalle",bool=true}, + #'Exp'{os="kalle",bool=true}]}), + roundtrip('SeqTagE', #'SeqTagE'{nt=[#'NT'{os="kalle",bool=true}, + #'NT'{os="kalle",bool=true}]}), + roundtrip('SeqTagEI', #'SeqTagEI'{imp=[#'Imp'{os="kalle",bool=true}, + #'Imp'{os="kalle",bool=true}]}), + roundtrip('SeqTagEE', #'SeqTagEE'{exp=[#'Exp'{os="kalle",bool=true}, + #'Exp'{os="kalle",bool=true}]}), + roundtrip('SeqTagXNt', + #'SeqTagXNt'{xnt=[#'XSeqNT'{os="kalle",bool=true}, + #'XSeqNT'{os="kalle",bool=true}]}), + roundtrip('SeqTagXI', + #'SeqTagXI'{ximp=[#'XSeqImp'{os="kalle",bool=true}, + #'XSeqImp'{os="kalle",bool=true}]}), + roundtrip('SeqTagXE', + #'SeqTagXE'{xexp=[#'XSeqExp'{os="kalle",bool=true}, + #'XSeqExp'{os="kalle",bool=true}]}), + roundtrip('SeqTagImpX', + #'SeqTagImpX'{xnt=[#'XSeqNT'{os="kalle",bool=true}, + #'XSeqNT'{os="kalle",bool=true}], + ximp=[#'XSeqImp'{os="kalle",bool=true}, + #'XSeqImp'{os="kalle",bool=true}], + xexp=[#'XSeqExp'{os="kalle",bool=true}, + #'XSeqExp'{os="kalle",bool=true}]}), + roundtrip('SeqTagExpX', + #'SeqTagExpX'{xnt=[#'XSeqNT'{os="kalle",bool=true}, + #'XSeqNT'{os="kalle",bool=true}], + ximp=[#'XSeqImp'{os="kalle",bool=true}, + #'XSeqImp'{os="kalle",bool=true}], + xexp=[#'XSeqExp'{os="kalle",bool=true}, + #'XSeqExp'{os="kalle",bool=true}]}), + ok. - - - ?line {ok,Bytes41} = - asn1_wrapper:encode('SeqOfTag','SeqTagXNt', - #'SeqTagXNt'{xnt = [#'XSeqNT'{bool = true, os = "kalle"}, - #'XSeqNT'{bool = true, os = "kalle"}]}), - ?line {ok,{'SeqTagXNt', - [{'XSeqNT',[107,97,108,108,101],true},{'XSeqNT',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SeqOfTag','SeqTagXNt',lists:flatten(Bytes41)), - - ?line {ok,Bytes42} = - asn1_wrapper:encode('SeqOfTag','SeqTagXI', - #'SeqTagXI'{ximp = [#'XSeqImp'{bool = true, os = "kalle"}, - #'XSeqImp'{bool = true, os = "kalle"}]}), - ?line {ok,{'SeqTagXI', - [{'XSeqImp',[107,97,108,108,101],true},{'XSeqImp',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SeqOfTag','SeqTagXI',lists:flatten(Bytes42)), - - ?line {ok,Bytes43} = - asn1_wrapper:encode('SeqOfTag','SeqTagXE', - #'SeqTagXE'{xexp = [#'XSeqExp'{bool = true, os = "kalle"}, - #'XSeqExp'{bool = true, os = "kalle"}]}), - ?line {ok,{'SeqTagXE', - [{'XSeqExp',[107,97,108,108,101],true},{'XSeqExp',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SeqOfTag','SeqTagXE',lists:flatten(Bytes43)), - - - - - - ?line {ok,Bytes51} = - asn1_wrapper:encode('SeqOfTag','SeqTagImpX', - #'SeqTagImpX'{xnt = [#'XSeqNT'{bool = true, os = "kalle"}, - #'XSeqNT'{bool = true, os = "kalle"}], - ximp = [#'XSeqImp'{bool = true, os = "kalle"}, - #'XSeqImp'{bool = true, os = "kalle"}], - xexp = [#'XSeqExp'{bool = true, os = "kalle"}, - #'XSeqExp'{bool = true, os = "kalle"}]}), - ?line {ok,{'SeqTagImpX', - [{'XSeqNT',[107,97,108,108,101],true},{'XSeqNT',[107,97,108,108,101],true}], - [{'XSeqImp',[107,97,108,108,101],true},{'XSeqImp',[107,97,108,108,101],true}], - [{'XSeqExp',[107,97,108,108,101],true},{'XSeqExp',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SeqOfTag','SeqTagImpX',lists:flatten(Bytes51)), - - - - ?line {ok,Bytes52} = - asn1_wrapper:encode('SeqOfTag','SeqTagExpX', - #'SeqTagExpX'{xnt = [#'XSeqNT'{bool = true, os = "kalle"}, - #'XSeqNT'{bool = true, os = "kalle"}], - ximp = [#'XSeqImp'{bool = true, os = "kalle"}, - #'XSeqImp'{bool = true, os = "kalle"}], - xexp = [#'XSeqExp'{bool = true, os = "kalle"}, - #'XSeqExp'{bool = true, os = "kalle"}]}), - ?line {ok,{'SeqTagExpX', - [{'XSeqNT',[107,97,108,108,101],true},{'XSeqNT',[107,97,108,108,101],true}], - [{'XSeqImp',[107,97,108,108,101],true},{'XSeqImp',[107,97,108,108,101],true}], - [{'XSeqExp',[107,97,108,108,101],true},{'XSeqExp',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SeqOfTag','SeqTagExpX',lists:flatten(Bytes52)), - -ok. +roundtrip(T, V) -> + asn1_test_lib:roundtrip('SeqOfTag', T, V). diff --git a/lib/asn1/test/testSeqOptional.erl b/lib/asn1/test/testSeqOptional.erl index 8013f3c685..c9478105a4 100644 --- a/lib/asn1/test/testSeqOptional.erl +++ b/lib/asn1/test/testSeqOptional.erl @@ -37,159 +37,48 @@ -record('SeqChoOpt',{int, cho = asn1_NOVALUE}). main(_Rules) -> - - ?line {ok,Bytes11} = - asn1_wrapper:encode('SeqOptional','SeqOpt1',#'SeqOpt1'{bool1 = true, - int1 = 15, - seq1 = #'SeqIn'{boolIn = true, - intIn = 66}}), - ?line {ok,{'SeqOpt1',true,15,{'SeqIn',true,66}}} = - asn1_wrapper:decode('SeqOptional','SeqOpt1',lists:flatten(Bytes11)), - - - ?line {ok,Bytes12} = asn1_wrapper:encode('SeqOptional','SeqOpt1',#'SeqOpt1'{int1 = 15}), - ?line {ok,{'SeqOpt1',asn1_NOVALUE,15,asn1_NOVALUE}} = - asn1_wrapper:decode('SeqOptional','SeqOpt1',lists:flatten(Bytes12)), - - - ?line {ok,Bytes21} = - asn1_wrapper:encode('SeqOptional','SeqOpt2',#'SeqOpt2'{bool2 = true, - int2 = 15, - seq2 = #'SeqIn'{boolIn = true, - intIn = 66}}), - ?line {ok,{'SeqOpt2',{'SeqIn',true,66},true,15}} = - asn1_wrapper:decode('SeqOptional','SeqOpt2',lists:flatten(Bytes21)), - - - ?line {ok,Bytes22} = asn1_wrapper:encode('SeqOptional','SeqOpt2',#'SeqOpt2'{int2 = 15, - bool2 = true}), - ?line {ok,{'SeqOpt2',asn1_NOVALUE,true,15}} = - asn1_wrapper:decode('SeqOptional','SeqOpt2',lists:flatten(Bytes22)), - - - - ?line {ok,Bytes31} = - asn1_wrapper:encode('SeqOptional','SeqOpt3',#'SeqOpt3'{bool3 = true, - int3 = 15, - seq3 = #'SeqIn'{boolIn = true, - intIn = 66}}), - ?line {ok,{'SeqOpt3',true,{'SeqIn',true,66},15}} = - asn1_wrapper:decode('SeqOptional','SeqOpt3',lists:flatten(Bytes31)), - - - ?line {ok,Bytes32} = asn1_wrapper:encode('SeqOptional','SeqOpt3',#'SeqOpt3'{int3 = 15}), - ?line {ok,{'SeqOpt3',asn1_NOVALUE,asn1_NOVALUE,15}} = - asn1_wrapper:decode('SeqOptional','SeqOpt3',lists:flatten(Bytes32)), - - - - - - ?line {ok,Bytes41} = - asn1_wrapper:encode('SeqOptional','SeqOpt1Imp',#'SeqOpt1Imp'{bool1 = true, - int1 = 15, - seq1 = #'SeqIn'{boolIn = true, - intIn = 66}}), - ?line {ok,{'SeqOpt1Imp',true,15,{'SeqIn',true,66}}} = - asn1_wrapper:decode('SeqOptional','SeqOpt1Imp',lists:flatten(Bytes41)), - - - ?line {ok,Bytes42} = asn1_wrapper:encode('SeqOptional','SeqOpt1Imp',#'SeqOpt1Imp'{int1 = 15}), - ?line {ok,{'SeqOpt1Imp',asn1_NOVALUE,15,asn1_NOVALUE}} = - asn1_wrapper:decode('SeqOptional','SeqOpt1Imp',lists:flatten(Bytes42)), - - - ?line {ok,Bytes51} = - asn1_wrapper:encode('SeqOptional','SeqOpt2Imp',#'SeqOpt2Imp'{bool2 = true, - int2 = 15, - seq2 = #'SeqIn'{boolIn = true, - intIn = 66}}), - ?line {ok,{'SeqOpt2Imp',{'SeqIn',true,66},true,15}} = - asn1_wrapper:decode('SeqOptional','SeqOpt2Imp',lists:flatten(Bytes51)), - - - ?line {ok,Bytes52} = asn1_wrapper:encode('SeqOptional','SeqOpt2Imp',#'SeqOpt2Imp'{int2 = 15, - bool2 = true}), - ?line {ok,{'SeqOpt2Imp',asn1_NOVALUE,true,15}} = - asn1_wrapper:decode('SeqOptional','SeqOpt2Imp',lists:flatten(Bytes52)), - - - - ?line {ok,Bytes61} = - asn1_wrapper:encode('SeqOptional','SeqOpt3Imp',#'SeqOpt3Imp'{bool3 = true, - int3 = 15, - seq3 = #'SeqIn'{boolIn = true, - intIn = 66}}), - ?line {ok,{'SeqOpt3Imp',true,{'SeqIn',true,66},15}} = - asn1_wrapper:decode('SeqOptional','SeqOpt3Imp',lists:flatten(Bytes61)), - - - ?line {ok,Bytes62} = asn1_wrapper:encode('SeqOptional','SeqOpt3Imp',#'SeqOpt3Imp'{int3 = 15}), - ?line {ok,{'SeqOpt3Imp',asn1_NOVALUE,asn1_NOVALUE,15}} = - asn1_wrapper:decode('SeqOptional','SeqOpt3Imp',lists:flatten(Bytes62)), - - - - - - - ?line {ok,Bytes71} = - asn1_wrapper:encode('SeqOptional','SeqOpt1Exp',#'SeqOpt1Exp'{bool1 = true, - int1 = 15, - seq1 = #'SeqIn'{boolIn = true, - intIn = 66}}), - ?line {ok,{'SeqOpt1Exp',true,15,{'SeqIn',true,66}}} = - asn1_wrapper:decode('SeqOptional','SeqOpt1Exp',lists:flatten(Bytes71)), - - - ?line {ok,Bytes72} = asn1_wrapper:encode('SeqOptional','SeqOpt1Exp',#'SeqOpt1Exp'{int1 = 15}), - ?line {ok,{'SeqOpt1Exp',asn1_NOVALUE,15,asn1_NOVALUE}} = - asn1_wrapper:decode('SeqOptional','SeqOpt1Exp',lists:flatten(Bytes72)), - - - ?line {ok,Bytes81} = - asn1_wrapper:encode('SeqOptional','SeqOpt2Exp',#'SeqOpt2Exp'{bool2 = true, - int2 = 15, - seq2 = #'SeqIn'{boolIn = true, - intIn = 66}}), - ?line {ok,{'SeqOpt2Exp',{'SeqIn',true,66},true,15}} = - asn1_wrapper:decode('SeqOptional','SeqOpt2Exp',lists:flatten(Bytes81)), - - - ?line {ok,Bytes82} = asn1_wrapper:encode('SeqOptional','SeqOpt2Exp',#'SeqOpt2Exp'{int2 = 15, - bool2 = true}), - ?line {ok,{'SeqOpt2Exp',asn1_NOVALUE,true,15}} = - asn1_wrapper:decode('SeqOptional','SeqOpt2Exp',lists:flatten(Bytes82)), - - - - ?line {ok,Bytes91} = - asn1_wrapper:encode('SeqOptional','SeqOpt3Exp',#'SeqOpt3Exp'{bool3 = true, - int3 = 15, - seq3 = #'SeqIn'{boolIn = true, - intIn = 66}}), - ?line {ok,{'SeqOpt3Exp',true,{'SeqIn',true,66},15}} = - asn1_wrapper:decode('SeqOptional','SeqOpt3Exp',lists:flatten(Bytes91)), - - - ?line {ok,Bytes92} = asn1_wrapper:encode('SeqOptional','SeqOpt3Exp',#'SeqOpt3Exp'{int3 = 15}), - ?line {ok,{'SeqOpt3Exp',asn1_NOVALUE,asn1_NOVALUE,15}} = - asn1_wrapper:decode('SeqOptional','SeqOpt3Exp',lists:flatten(Bytes92)), - - - - ?line {ok,Bytes101} = - asn1_wrapper:encode('SeqOptional','SeqChoOpt',#'SeqChoOpt'{int = 15, - cho = {boolC,true}}), - ?line {ok,{'SeqChoOpt',15,{boolC,true}}} = - asn1_wrapper:decode('SeqOptional','SeqChoOpt',lists:flatten(Bytes101)), - - - ?line {ok,Bytes102} = asn1_wrapper:encode('SeqOptional','SeqChoOpt',#'SeqChoOpt'{int = 15}), - ?line {ok,{'SeqChoOpt',15,asn1_NOVALUE}} = - asn1_wrapper:decode('SeqOptional','SeqChoOpt',lists:flatten(Bytes102)), - - - - + roundtrip('SeqOpt1', #'SeqOpt1'{bool1=true,int1=15, + seq1=#'SeqIn'{boolIn=true,intIn=66}}), + roundtrip('SeqOpt1', #'SeqOpt1'{bool1=asn1_NOVALUE, + int1=15,seq1=asn1_NOVALUE}), + roundtrip('SeqOpt2', #'SeqOpt2'{seq2=#'SeqIn'{boolIn=true,intIn=66}, + bool2=true,int2=15}), + roundtrip('SeqOpt2', #'SeqOpt2'{seq2=asn1_NOVALUE,bool2=true,int2=15}), + roundtrip('SeqOpt3', #'SeqOpt3'{bool3=true, + seq3=#'SeqIn'{boolIn=true, + intIn=66},int3=15}), + roundtrip('SeqOpt3', #'SeqOpt3'{bool3=asn1_NOVALUE, + seq3=asn1_NOVALUE,int3=15}), + roundtrip('SeqOpt1Imp', #'SeqOpt1Imp'{bool1=true,int1=15, + seq1=#'SeqIn'{boolIn=true,intIn=66}}), + roundtrip('SeqOpt1Imp', #'SeqOpt1Imp'{bool1=asn1_NOVALUE, + int1=15,seq1=asn1_NOVALUE}), + roundtrip('SeqOpt2Imp', #'SeqOpt2Imp'{seq2=#'SeqIn'{boolIn=true,intIn=66}, + bool2=true,int2=15}), + roundtrip('SeqOpt2Imp', #'SeqOpt2Imp'{seq2=asn1_NOVALUE, + bool2=true,int2=15}), + roundtrip('SeqOpt3Imp', #'SeqOpt3Imp'{bool3=true, + seq3=#'SeqIn'{boolIn=true,intIn=66}, + int3=15}), + roundtrip('SeqOpt3Imp', #'SeqOpt3Imp'{bool3=asn1_NOVALUE, + seq3=asn1_NOVALUE,int3=15}), + roundtrip('SeqOpt1Exp', #'SeqOpt1Exp'{bool1=true,int1=15, + seq1=#'SeqIn'{boolIn=true, + intIn=66}}), + roundtrip('SeqOpt1Exp', #'SeqOpt1Exp'{bool1=asn1_NOVALUE, + int1=15,seq1=asn1_NOVALUE}), + roundtrip('SeqOpt2Exp', #'SeqOpt2Exp'{seq2=#'SeqIn'{boolIn=true,intIn=66}, + bool2=true,int2=15}), + roundtrip('SeqOpt2Exp', #'SeqOpt2Exp'{seq2=asn1_NOVALUE, + bool2=true,int2=15}), + roundtrip('SeqOpt3Exp', #'SeqOpt3Exp'{bool3=true, + seq3=#'SeqIn'{boolIn=true,intIn=66}, + int3=15}), + roundtrip('SeqOpt3Exp', #'SeqOpt3Exp'{bool3=asn1_NOVALUE, + seq3=asn1_NOVALUE,int3=15}), + roundtrip('SeqChoOpt', #'SeqChoOpt'{int=15,cho={boolC,true}}), + roundtrip('SeqChoOpt', #'SeqChoOpt'{int=15,cho=asn1_NOVALUE}), ok. + +roundtrip(Type, Value) -> + asn1_test_lib:roundtrip('SeqOptional', Type, Value). diff --git a/lib/asn1/test/testSeqPrim.erl b/lib/asn1/test/testSeqPrim.erl index c2451a7cd1..eb21d50a37 100644 --- a/lib/asn1/test/testSeqPrim.erl +++ b/lib/asn1/test/testSeqPrim.erl @@ -27,58 +27,15 @@ -record('Empty',{}). main(_Rules) -> - - - - ?line {ok,Bytes11} = - asn1_wrapper:encode('SeqPrim','Seq',#'Seq'{bool = true, - boolCon = true, - boolPri = true, - boolApp = true, - boolExpCon = true, - boolExpPri = true, - boolExpApp = true}), - ?line {ok,{'Seq',true,true,true,true,true,true,true}} = - asn1_wrapper:decode('SeqPrim','Seq',lists:flatten(Bytes11)), - - - - - ?line {ok,Bytes12} = - asn1_wrapper:encode('SeqPrim','Seq',#'Seq'{bool = false, - boolCon = false, - boolPri = false, - boolApp = false, - boolExpCon = false, - boolExpPri = false, - boolExpApp = false}), - ?line {ok,{'Seq',false,false,false,false,false,false,false}} = - asn1_wrapper:decode('SeqPrim','Seq',lists:flatten(Bytes12)), - - - - - ?line {ok,Bytes13} = - asn1_wrapper:encode('SeqPrim','Seq',#'Seq'{bool = false, - boolCon = true, - boolPri = false, - boolApp = true, - boolExpCon = false, - boolExpPri = true, - boolExpApp = false}), - ?line {ok,{'Seq',false,true,false,true,false,true,false}} = - asn1_wrapper:decode('SeqPrim','Seq',lists:flatten(Bytes13)), - - - - - - ?line {ok,Bytes21} = - asn1_wrapper:encode('SeqPrim','Empty',#'Empty'{}), - ?line {ok,{'Empty'}} = - asn1_wrapper:decode('SeqPrim','Empty',lists:flatten(Bytes21)), - - - + roundtrip('Seq', #'Seq'{bool=true,boolCon=true,boolPri=true,boolApp=true, + boolExpCon=true,boolExpPri=true,boolExpApp=true}), + roundtrip('Seq', #'Seq'{bool=false,boolCon=false,boolPri=false, + boolApp=false,boolExpCon=false, + boolExpPri=false,boolExpApp=false}), + roundtrip('Seq', #'Seq'{bool=false,boolCon=true,boolPri=false,boolApp=true, + boolExpCon=false,boolExpPri=true,boolExpApp=false}), + roundtrip('Empty', #'Empty'{}), ok. +roundtrip(Type, Value) -> + asn1_test_lib:roundtrip('SeqPrim', Type, Value). diff --git a/lib/asn1/test/testSeqSetDefaultVal.erl b/lib/asn1/test/testSeqSetDefaultVal.erl index bd6c9428e2..044099199f 100644 --- a/lib/asn1/test/testSeqSetDefaultVal.erl +++ b/lib/asn1/test/testSeqSetDefaultVal.erl @@ -18,10 +18,9 @@ %% %% -module(testSeqSetDefaultVal). +-export([main/2]). -include("External.hrl"). --export([main/1]). - -include_lib("test_server/include/test_server.hrl"). -record('SeqInts',{a = asn1_DEFAULT, @@ -35,7 +34,8 @@ -record('SeqBS',{a = asn1_DEFAULT, b = asn1_DEFAULT, c = asn1_DEFAULT, - d = asn1_DEFAULT}). + d = asn1_DEFAULT, + e = asn1_DEFAULT}). -record('SetBS',{a = asn1_DEFAULT, b = asn1_DEFAULT, c = asn1_DEFAULT, @@ -94,243 +94,368 @@ -record('S4_b',{ba = asn1_DEFAULT, bb = asn1_DEFAULT}). -main(_Rules) -> - - ?line {ok,[48,0]} = - asn1_wrapper:encode('Default','SeqInts',#'SeqInts'{}), - ?line {ok,[48,0]} = - asn1_wrapper:encode('Default','SeqInts',#'SeqInts'{a=1,b=-1,c=three, - d=1}), - ?line {ok,{'SeqInts',1,-1,3,1}} = - asn1_wrapper:decode('Default','SeqInts',[48,0]), - - ?line {ok,[49,0]} = - asn1_wrapper:encode('Default','SetInts',#'SetInts'{}), - ?line {ok,[49,0]} = - asn1_wrapper:encode('Default','SetInts',#'SetInts'{a=1,b=-1,c=three, - d=1}), - ?line {ok,{'SetInts',1,-1,3,1}} = - asn1_wrapper:decode('Default','SetInts',[49,0]), - - - ?line {ok,[48,0]} = - asn1_wrapper:encode('Default','SeqBS', - #'SeqBS'{a=2#1010110, - b=16#A8A, - c=[second], - d=[1,0,0,1]}), - - ?line {ok,[48,0]} = - asn1_wrapper:encode('Default','SeqBS', - #'SeqBS'{a=[1,0,1,0,1,1,0], - b=[1,0,1,0,1,0,0,0,1,0,1,0], - c={5,<<64>>}, - d=9}), - - ?line {ok,[48,3,131,1,0]} = - asn1_wrapper:encode('Default','SeqBS', - #'SeqBS'{a=[1,0,1,0,1,1,0], - b=[1,0,1,0,1,0,0,0,1,0,1,0], - c={5,<<64>>}, - d=0}), - - {ok,{'SeqBS',[1,0,1,0,1,1,0],2698,[second],<<>>}} = - asn1_wrapper:decode('Default','SeqBS',[48,3,131,1,0]), - - ?line {ok,{'SeqBS',[1,0,1,0,1,1,0],2698,[second],[1,0,0,1]}} = - asn1_wrapper:decode('Default','SeqBS',[48,0]), - - ?line {ok,[49,0]} = - asn1_wrapper:encode('Default','SetBS', - #'SetBS'{a=2#1010110, - b=16#A8A, - c=[second], - d=[1,0,0,1]}), - - ?line {ok,[49,0]} = - asn1_wrapper:encode('Default','SetBS', - #'SetBS'{a=[1,0,1,0,1,1,0], - b=[1,0,1,0,1,0,0,0,1,0,1,0], - c={5,<<64>>}, - d=9}), - - ?line {ok,[49,3,131,1,0]} = - asn1_wrapper:encode('Default','SetBS', - #'SetBS'{a=[1,0,1,0,1,1,0], - b=[1,0,1,0,1,0,0,0,1,0,1,0], - c={5,<<64>>}, - d=0}), - - {ok,{'SetBS',[1,0,1,0,1,1,0],2698,[second],<<>>}} = - asn1_wrapper:decode('Default','SetBS',[49,3,131,1,0]), - - ?line {ok,{'SetBS',[1,0,1,0,1,1,0],2698,[second],[1,0,0,1]}} = - asn1_wrapper:decode('Default','SetBS',[49,0]), - - ?line {ok,[48,0]} = - asn1_wrapper:encode('Default','SeqOS', - #'SeqOS'{a=[172], - b=[16#A8,16#A0], - c='NULL'}), - - ?line {ok,[48,0]} = - asn1_wrapper:encode('Default','SeqOS', - #'SeqOS'{a=2#10101100, - b=16#A8A0, - c='NULL'}), - - ?line {ok,{'SeqOS',[172],[16#A8,16#A0],'NULL'}} = - asn1_wrapper:decode('Default','SeqOS',[48,0]), - - ?line {ok,[49,0]} = - asn1_wrapper:encode('Default','SetOS', - #'SetOS'{a=[172], - b=[16#A8,16#A0], - c='NULL'}), - - ?line {ok,[49,0]} = - asn1_wrapper:encode('Default','SetOS', - #'SetOS'{a=2#10101100, - b=16#A8A0, - c='NULL'}), - - ?line {ok,{'SetOS',[172],[16#A8,16#A0],'NULL'}} = - asn1_wrapper:decode('Default','SetOS',[49,0]), - - ?line {ok,[48,0]} = - asn1_wrapper:encode('Default','SeqOI', - #'SeqOI'{a={1,2,14,15}, - b={iso,'member-body',250,3,4}, - c={iso,standard,8571,2,250,4}}), - - ?line {ok,{'SeqOI',{1,2,14,15},{1,2,250,3,4},{1,0,8571,2,250,4}}} = - asn1_wrapper:decode('Default','SeqOI',[48,0]), - - ?line {ok,[49,0]} = - asn1_wrapper:encode('Default','SetOI', - #'SetOI'{a={1,2,14,15}, - b={iso,'member-body',250,3,4}, - c={iso,standard,8571,2,250,4}}), - - ?line {ok,{'SetOI',{1,2,14,15},{1,2,250,3,4},{1,0,8571,2,250,4}}} = - asn1_wrapper:decode('Default','SetOI',[49,0]), - - ?line {ok,[48,0]} = - asn1_wrapper:encode('Default','SeqEnum',#'SeqEnum'{a=b4,b=b2}), - - ?line {ok,{'SeqEnum',b4,b2}} = - asn1_wrapper:decode('Default','SeqEnum',[48,0]), - - ?line {ok,[49,0]} = - asn1_wrapper:encode('Default','SetEnum',#'SetEnum'{a=b4,b=b2}), - - ?line {ok,{'SetEnum',b4,b2}} = - asn1_wrapper:decode('Default','SetEnum',[49,0]), - - ?line {ok,[48,0]} = - asn1_wrapper:encode('Default','SeqIntBool', - #'SeqIntBool'{a=#'SeqIntBool_a'{aa=12,ab=13}, - b=#'S2'{a=14,b=true}, - c=#'S2'{a=15,b=false}}), - - ?line {ok,[48,0]} = - asn1_wrapper:encode('Default','SeqIntBool', - #'SeqIntBool'{}), - - ?line {ok,{'SeqIntBool',{'SeqIntBool_a',12,13}, - {'S2',14,true},{'S2',15,false}}} = - asn1_wrapper:decode('Default','SeqIntBool',[48,0]), - - ?line {ok,[49,0]} = - asn1_wrapper:encode('Default','SetIntBool', - #'SetIntBool'{a=#'SetIntBool_a'{aa=12,ab=13}, - b=#'S2'{a=14,b=true}, - c=#'S2'{a=15,b=false}}), - - ?line {ok,[49,0]} = - asn1_wrapper:encode('Default','SetIntBool', - #'SetIntBool'{}), - - ?line {ok,{'SetIntBool',{'SetIntBool_a',12,13}, - {'S2',14,true},{'S2',15,false}}} = - asn1_wrapper:decode('Default','SetIntBool',[49,0]), - - ?line {ok,[48,0]} = - asn1_wrapper:encode('Default','SeqStrings', - #'SeqStrings'{a="123456789", - b1="abcdef", - b2={0,13}, - b3={"First line",{0,13},"Second line"}, - c="Printable string", - d={0,0,1,14}}), - - ?line {ok,{'SeqStrings',"123456789","abcdef",[0,13], - ["First line",[0,13],"Second line"],"Printable string", - [0,0,1,14]}} = - asn1_wrapper:decode('Default','SeqStrings',[48,0]), - - ?line {ok,[49,0]} = - asn1_wrapper:encode('Default','SetStrings', - #'SetStrings'{a="123456789", - b1="abcdef", - b2={0,13}, - b3={"First line",{0,13},"Second line"}, - c="Printable string", - d={0,0,1,14}}), - - ?line {ok,{'SetStrings',"123456789","abcdef",[0,13], - ["First line",[0,13],"Second line"],"Printable string", - [0,0,1,14]}} = - asn1_wrapper:decode('Default','SetStrings',[49,0]), - - - ?line {ok,[48,0]} = - asn1_wrapper:encode('Default','S1', - #'S1'{a=#'S1_a'{aa=1, - ab=#'S2'{a=2,b=true}}, - b=#'S4'{a=#'S2'{a=2,b=true}, - b=#'S4_b'{ba=true, - bb=5}}}), - - ?line {ok,{'S1',{'S1_a',1,{'S2',2,true}}, - {'S4',{'S2',2,true},{'S4_b',true,5}}}} = - asn1_wrapper:decode('Default','S1',[48,0]), - - ?line {ok,[48,3,129,1,255]} = - asn1_wrapper:encode('Default','S2', - #'S2'{a=1,b=true}), - - ?line {ok,[48,0]} = - asn1_wrapper:encode('Default','S3', - #'S3'{a=[11,12,13], - b=[{a,11},{b,true},{c,13}], - c=[1,2,3,4], - d=[#'S2'{a=20,b=true},#'S2'{a=30,b=false}]}), - - ?line {ok,[48,0]} = - asn1_wrapper:encode('Default','S3', - #'S3'{a=[11,13,12], - b=[{b,true},{a,11},{c,13}], - c=[3,4,1,2], - d=[#'S2'{a=30,b=false},#'S2'{a=20,b=true}]}), - - ?line {ok,[48,0]} = asn1_wrapper:encode('Default','S3',#'S3'{}), - - ?line {ok,[49,0]} = - asn1_wrapper:encode('Default','S3set', - #'S3set'{a=[{c,#'S2'{a=3,b=true}}, - {b,17},{a,false}], - b=[1,2,3,4]}), - - ?line {ok,[49,0]} = - asn1_wrapper:encode('Default','S3set', - #'S3set'{a=[{b,17},{c,#'S2'{a=3,b=true}}, - {a,false}], - b=[1,3,4,2]}), - - ?line {ok,[49,0]} = asn1_wrapper:encode('Default','S3set',#'S3set'{}), - - ?line {ok,[48,0]} = - asn1_wrapper:encode('Default','S4',#'S4'{a={'S2',1,asn1_NOVALUE}, - b=#'S4_b'{ba=true,bb=0}}), +main(ber, []) -> + %% Nothing to test because plain BER will only use + %% default values when explicitly told to do so by + %% asn1_DEFAULT. + ok; +main(Rule, Opts) -> + %% DER, PER, UPER. These encodings should not encode + %% values that are equal to the default value. + + case {Rule,Opts} of + {ber,[der]} -> + der(); + {_,_} -> + ok + end, + + Ts = [{#'SeqInts'{}, + [{#'SeqInts'.c, + [asn1_DEFAULT, + three, + 3]}]}, + + {#'SeqBS'{}, + [{#'SeqBS'.a, + [asn1_DEFAULT, + 2#0110101, + [1,0,1,0,1,1,0], + {1,<<16#AC>>}, + <<1:1,0:1,1:1,0:1,1:1,1:1,0:1>>]}, + {#'SeqBS'.b, + [asn1_DEFAULT, + 2#10100010101, + [1,0,1,0,1,0,0,0,1,0,1,0], + {4,<<16#A8,16#A0>>}, + <<16#A8:8,16#A:4>>]}, + {#'SeqBS'.c, + [asn1_DEFAULT, + [second], + [0,1], + {6,<<0:1,1:1,0:6>>}, + <<1:2>>]}, + {#'SeqBS'.c, %Zeroes on the right + [asn1_DEFAULT, + [second], + [0,1,0,0,0], + {4,<<0:1,1:1,0:6>>}, + <<1:2,0:17>>]}, + {#'SeqBS'.d, + [asn1_DEFAULT, + 2#1001, + [1,0,0,1], + {4,<<2#1001:4,0:4>>}, + <<2#1001:4>>]}, + {#'SeqBS'.e, + [asn1_DEFAULT, + [0,1,0,1,1,0,1,0], + {0,<<2#01011010:8>>}, + <<2#01011010:8>>]}, + %% Not EQUAL to DEFAULT. + {#'SeqBS'.b, + [[1,1,0], %Not equal to DEFAULT + {5,<<6:3,0:5>>}, + <<6:3>>]} + ]}, + + {#'SeqOS'{}, + [{#'SeqOS'.a, + [asn1_DEFAULT, + [172]]}]}, + + {#'SeqOI'{}, + [{#'SeqOI'.a, + [asn1_DEFAULT, + {1,2,14,15}]}, + {#'SeqOI'.b, + [asn1_DEFAULT, +%% {iso,'member-body',250,3,4}, + {1,2,250,3,4}]}, + {#'SeqOI'.c, + [asn1_DEFAULT, +%% {iso,standard,8571,2,250,4}, + {1,0,8571,2,250,4}]}]} + ], + io:format("~p\n", [Ts]), + R0 = [[consistency(Rec, Pos, Vs) || {Pos,Vs} <- Fs] || {Rec,Fs} <- Ts], + case lists:flatten(R0) of + [] -> + ok; + [_|_]=R -> + io:format("~p\n", [R]), + ?t:fail() + end. + +consistency(Rec0, Pos, [V|Vs]) -> + T = element(1, Rec0), + Rec = setelement(Pos, Rec0, V), + {ok,Enc} = 'Default':encode(T, Rec), + {ok,_SmokeTest} = 'Default':decode(T, Enc), + consistency_1(Vs, Rec0, Pos, Enc). + +consistency_1([V|Vs], Rec0, Pos, Enc) -> + Rec = setelement(Pos, Rec0, V), + case 'Default':encode(element(1, Rec), Rec) of + {ok,Enc} -> + consistency_1(Vs, Rec0, Pos, Enc); + {ok,WrongEnc} -> + [{Rec,{wrong,WrongEnc},{should_be,Enc}}| + consistency_1(Vs, Rec0, Pos, Enc)] + end; +consistency_1([], _, _, _) -> []. + +der() -> + io:put_chars("Peforming DER-specific tests..."), + roundtrip(<<48,0>>, + 'SeqInts', + #'SeqInts'{a=asn1_DEFAULT,b=asn1_DEFAULT, + c=asn1_DEFAULT,d=asn1_DEFAULT}, + #'SeqInts'{a=1,b=-1,c=3,d=1}), + roundtrip(<<48,0>>, + 'SeqInts', + #'SeqInts'{a=1,b=-1,c=three,d=1}, + #'SeqInts'{a=1,b=-1,c=3,d=1}), + + roundtrip(<<49,0>>, + 'SetInts', + #'SetInts'{a=asn1_DEFAULT,b=asn1_DEFAULT, + c=asn1_DEFAULT,d=asn1_DEFAULT}, + #'SetInts'{a=1,b=-1,c=3,d=1}), + roundtrip(<<49,0>>, + 'SetInts', + #'SetInts'{a=1,b=-1,c=three,d=1}, + #'SetInts'{a=1,b=-1,c=3,d=1}), + + + roundtrip(<<48,0>>, + 'SeqBS', + #'SeqBS'{a=2#0110101, + b=2#010100010101, + c=[second], + d=[1,0,0,1]}, + #'SeqBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>, + c=[second], d = <<2#1001:4>>, + e = <<2#01011010:8>>}), + roundtrip(<<48,0>>, + 'SeqBS', + #'SeqBS'{a=[1,0,1,0,1,1,0], + b=[1,0,1,0,1,0,0,0,1,0,1,0], + c={5,<<64>>}, + d=2#1001}, + #'SeqBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>, + c=[second], d = <<2#1001:4>>, + e = <<2#01011010:8>>}), + roundtrip(<<48,3,131,1,0>>, + 'SeqBS', + #'SeqBS'{a=[1,0,1,0,1,1,0], + b=[1,0,1,0,1,0,0,0,1,0,1,0], + c={5,<<64>>}, + d=0}, + #'SeqBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>, + c=[second], d = <<>>, + e = <<2#01011010:8>>}), + roundtrip(<<48,3,131,1,0>>, + 'SeqBS', + #'SeqBS'{a = <<1:1,0:1,1:1,0:1,1:1,1:1,0:1>>, + b = <<1:1,0:1,1:1,0:1,1:1,0:1,0:1,0:1,1:1,0:1,1:1,0:1>>, + c = <<2:3>>, + d=0, + e = <<16#5A:8>>}, + #'SeqBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>, + c=[second], d = <<>>, + e = <<2#01011010:8>>}), + + %% None of the default values are used. + roundtrip(<<48,19,128,2,7,128,129,2,5,64,130,2,5,32,131,1,0,132,2,5,224>>, + 'SeqBS', + #'SeqBS'{a = <<1:1>>, + b = {5,<<64>>}, + c = [third], + d = 0, + e = <<7:3>>}, + #'SeqBS'{a = <<1:1>>, + b = <<2:3>>, + c = [third], + d = <<>>, + e = <<7:3>>}), + + roundtrip(<<49,0>>, + 'SetBS', + #'SetBS'{a=2#0110101, + b=2#010100010101, + c=[second], + d=[1,0,0,1]}, + #'SetBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>, + c=[second], d = <<2#1001:4>>}), + roundtrip(<<49,0>>, + 'SetBS', + #'SetBS'{a=[1,0,1,0,1,1,0], + b=[1,0,1,0,1,0,0,0,1,0,1,0], + c={5,<<64>>}, + d=9}, + #'SetBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>, + c=[second], d = <<2#1001:4>>}), + roundtrip(<<49,3,131,1,0>>, + 'SetBS', + #'SetBS'{a=[1,0,1,0,1,1,0], + b=[1,0,1,0,1,0,0,0,1,0,1,0], + c={5,<<64>>}, + d=0}, + #'SetBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>, + c=[second], d = <<>>}), + roundtrip(<<49,3,131,1,0>>, + 'SetBS', + #'SetBS'{a = <<1:1,0:1,1:1,0:1,1:1,1:1,0:1>>, + b = <<1:1,0:1,1:1,0:1,1:1,0:1,0:1,0:1,1:1,0:1,1:1,0:1>>, + c = <<2:3>>, + d=0}, + #'SetBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>, + c=[second], d = <<>>}), + + roundtrip(<<48,0>>, 'SeqOS', + #'SeqOS'{a=[172],b=[16#A8,16#A0],c='NULL'}), + roundtrip(<<48,0>>, + 'SeqOS', + #'SeqOS'{a=172,b=43168,c='NULL'}, + #'SeqOS'{a=[172],b=[16#A8,16#A0],c='NULL'}), + + roundtrip(<<49,0>>, 'SetOS', #'SetOS'{a=[172],b=[16#A8,16#A0],c='NULL'}), + roundtrip(<<49,0>>, + 'SetOS', + #'SetOS'{a=172,b=43168,c='NULL'}, + #'SetOS'{a=[172],b=[16#A8,16#A0],c='NULL'}), + + roundtrip(<<48,0>>, + 'SeqOI', + #'SeqOI'{a={1,2,14,15}, + b={iso,'member-body',250,3,4}, + c={iso,standard,8571,2,250,4}}, + #'SeqOI'{a={1,2,14,15}, + b={1,2,250,3,4}, + c={1,0,8571,2,250,4}}), + + roundtrip(<<49,0>>, + 'SetOI', + #'SetOI'{a={1,2,14,15}, + b={iso,'member-body',250,3,4}, + c={iso,standard,8571,2,250,4}}, + #'SetOI'{a={1,2,14,15}, + b={1,2,250,3,4}, + c={1,0,8571,2,250,4}}), + + roundtrip(<<48,0>>, 'SeqEnum', #'SeqEnum'{a=b4,b=b2}), + roundtrip(<<49,0>>, 'SetEnum', #'SetEnum'{a=b4,b=b2}), + + roundtrip(<<48,0>>, + 'SeqIntBool', + #'SeqIntBool'{a=#'SeqIntBool_a'{aa=12,ab=13}, + b=#'S2'{a=14,b=true}, + c=#'S2'{a=15,b=false}}), + roundtrip(<<48,0>>, + 'SeqIntBool', + #'SeqIntBool'{a=asn1_DEFAULT,b=asn1_DEFAULT,c=asn1_DEFAULT}, + #'SeqIntBool'{a=#'SeqIntBool_a'{aa=12,ab=13}, + b=#'S2'{a=14,b=true}, + c=#'S2'{a=15,b=false}}), + + roundtrip(<<49,0>>, + 'SetIntBool', + #'SetIntBool'{a=#'SetIntBool_a'{aa=12,ab=13}, + b=#'S2'{a=14,b=true}, + c=#'S2'{a=15,b=false}}), + roundtrip(<<49,0>>, + 'SetIntBool', + #'SetIntBool'{a=asn1_DEFAULT,b=asn1_DEFAULT,c=asn1_DEFAULT}, + #'SetIntBool'{a=#'SetIntBool_a'{aa=12,ab=13}, + b=#'S2'{a=14,b=true}, + c=#'S2'{a=15,b=false}}), + + roundtrip(<<48,0>>, + 'SeqStrings', + #'SeqStrings'{a="123456789",b1="abcdef", + b2={0,13}, + b3={"First line",{0,13},"Second line"}, + c="Printable string", + d={0,0,1,14}}, + #'SeqStrings'{a="123456789",b1="abcdef", + b2=[0,13], + b3=["First line",[0,13],"Second line"], + c="Printable string", + d=[0,0,1,14]}), + + roundtrip(<<49,0>>, + 'SetStrings', + #'SetStrings'{a="123456789",b1="abcdef", + b2={0,13}, + b3={"First line",{0,13},"Second line"}, + c="Printable string", + d={0,0,1,14}}, + #'SetStrings'{a="123456789",b1="abcdef", + b2=[0,13], + b3=["First line",[0,13],"Second line"], + c="Printable string", + d=[0,0,1,14]}), + + roundtrip(<<48,0>>, + 'S1', + #'S1'{a=#'S1_a'{aa=1,ab=#'S2'{a=2,b=true}}, + b=#'S4'{a=#'S2'{a=2,b=true},b=#'S4_b'{ba=true,bb=5}}}), + + roundtrip(<<48,3,129,1,255>>, 'S2', #'S2'{a=1,b=true}), + + roundtrip(<<48,0>>, + 'S3', + #'S3'{a="\v\f\r", + b=[{a,11},{b,true},{c,13}], + c=[1,2,3,4], + d=[#'S2'{a=20,b=true},#'S2'{a=30,b=false}]}), + roundtrip(<<48,0>>, + 'S3', + #'S3'{a=[11,13,12], + b=[{b,true},{a,11},{c,13}], + c=[3,4,1,2], + d=[#'S2'{a=30,b=false},#'S2'{a=20,b=true}]}, + #'S3'{a=[11,12,13], + b=[{a,11},{b,true},{c,13}], + c=[1,2,3,4], + d=[#'S2'{a=20,b=true},#'S2'{a=30,b=false}]}), + roundtrip(<<48,0>>, + 'S3', + #'S3'{a=asn1_DEFAULT,b=asn1_DEFAULT, + c=asn1_DEFAULT,d=asn1_DEFAULT}, + #'S3'{a=[11,12,13], + b=[{a,11},{b,true},{c,13}], + c=[1,2,3,4], + d=[#'S2'{a=20,b=true},#'S2'{a=30,b=false}]}), + + roundtrip(<<49,0>>, + 'S3set', + #'S3set'{a=[{c,#'S2'{a=3,b=true}},{b,17},{a,false}], + b=[1,2,3,4]}), + roundtrip(<<49,0>>, + 'S3set', + #'S3set'{a=[{b,17},{c,#'S2'{a=3,b=true}},{a,false}], + b=[1,3,4,2]}, + #'S3set'{a=[{c,#'S2'{a=3,b=true}},{b,17},{a,false}], + b=[1,2,3,4]}), + roundtrip(<<49,0>>, + 'S3set', + #'S3set'{a=asn1_DEFAULT,b=asn1_DEFAULT}, + #'S3set'{a=[{c,#'S2'{a=3,b=true}},{b,17},{a,false}], + b=[1,2,3,4]}), + + roundtrip(<<48,0>>, + 'S4', + #'S4'{a=#'S2'{a=1,b=asn1_NOVALUE},b=#'S4_b'{ba=true,bb=0}}, + #'S4'{a=#'S2'{a=1,b=asn1_NOVALUE},b=#'S4_b'{ba=true,bb=0}}), + + ok. + +roundtrip(Encoded, Type, Value) -> + roundtrip(Encoded, Type, Value, Value). + +roundtrip(Encoded, Type, Value, ExpectedValue) -> + Encoded = asn1_test_lib:roundtrip_enc('Default', Type, + Value, ExpectedValue), ok. diff --git a/lib/asn1/test/testSeqSetIndefinite.erl b/lib/asn1/test/testSeqSetIndefinite.erl new file mode 100644 index 0000000000..6becf84e77 --- /dev/null +++ b/lib/asn1/test/testSeqSetIndefinite.erl @@ -0,0 +1,52 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(testSeqSetIndefinite). +-export([main/0]). + +-include_lib("test_server/include/test_server.hrl"). + +main() -> + seq_indefinite(), + set_indefinite(). + +seq_indefinite() -> + %% normal encoding + B = <<48,20,1,1,255,48,9,1,1,255,2,4,251,35,238,194,2,4,251,55,236,161>>, + %% indefinite length encoding + Bi = <<48,22,1,1,255,48,128,1,1,255,2,4,251,35,238,194,0,0,2,4,251,55,236,161>>, + %% the value which is encoded + V = {'SeqS3',true,{'SeqS3_seqS3',true,-81531198},-80221023}, + {ok,V} = 'SeqSetIndefinite':decode('SeqS3', B), + {ok,V} = 'SeqSetIndefinite':decode('SeqS3', Bi), + + ok. + +set_indefinite() -> + %% normal encoding + B = <<49,20,1,1,255,49,9,1,1,255,2,4,251,35,238,194,2,4,251,55,236,161>>, + %% indefinite length encoding + Bi = <<49,22,1,1,255,49,128,1,1,255,2,4,251,35,238,194,0,0,2,4,251,55,236,161>>, + + %% the value which is encoded + V = {'SetS3',true,{'SetS3_setS3',true,-81531198},-80221023}, + {ok,V} = 'SeqSetIndefinite':decode('SetS3', B), + {ok,V} = 'SeqSetIndefinite':decode('SetS3', Bi), + + ok. diff --git a/lib/asn1/test/testSeqTag.erl b/lib/asn1/test/testSeqTag.erl index 9fdaae35dd..2f127b3e97 100644 --- a/lib/asn1/test/testSeqTag.erl +++ b/lib/asn1/test/testSeqTag.erl @@ -35,69 +35,25 @@ -record('Exp',{os, bool}). main(_Rules) -> - - - ?line {ok,Bytes11} = - asn1_wrapper:encode('SeqTag','SeqTag',#'SeqTag'{nt = #'NT'{bool = true, os = "kalle"}, - imp = #'Imp'{bool = true, os = "kalle"}, - exp = #'Exp'{bool = true, os = "kalle"}}), - ?line {ok,{'SeqTag',{'NT',"kalle",true},{'Imp',"kalle",true},{'Exp',"kalle",true}}} = - asn1_wrapper:decode('SeqTag','SeqTag',lists:flatten(Bytes11)), - - - ?line {ok,Bytes12} = - asn1_wrapper:encode('SeqTag','SeqTagImp',#'SeqTagImp'{nt = #'NT'{bool = true, os = "kalle"}, - imp = #'Imp'{bool = true, os = "kalle"}, - exp = #'Exp'{bool = true, os = "kalle"}}), - ?line {ok,{'SeqTagImp',{'NT',"kalle",true},{'Imp',"kalle",true},{'Exp',"kalle",true}}} = - asn1_wrapper:decode('SeqTag','SeqTagImp',lists:flatten(Bytes12)), - - - ?line {ok,Bytes13} = - asn1_wrapper:encode('SeqTag','SeqTagExp',#'SeqTagExp'{nt = #'NT'{bool = true, os = "kalle"}, - imp = #'Imp'{bool = true, os = "kalle"}, - exp = #'Exp'{bool = true, os = "kalle"}}), - ?line {ok,{'SeqTagExp',{'NT',"kalle",true},{'Imp',"kalle",true},{'Exp',"kalle",true}}} = - asn1_wrapper:decode('SeqTag','SeqTagExp',lists:flatten(Bytes13)), - - - - - - ?line {ok,Bytes21} = - asn1_wrapper:encode('SeqTag','SeqTagX', - #'SeqTagX'{xnt = #'XSeqNT'{bool = true, os = "kalle"}, - ximp = #'XSeqImp'{bool = true, os = "kalle"}, - xexp = #'XSeqExp'{bool = true, os = "kalle"}}), - ?line {ok,{'SeqTagX',{'XSeqNT',"kalle",true}, - {'XSeqImp',"kalle",true}, - {'XSeqExp',"kalle",true}}} = - asn1_wrapper:decode('SeqTag','SeqTagX',lists:flatten(Bytes21)), - - - ?line {ok,Bytes22} = - asn1_wrapper:encode('SeqTag','SeqTagImpX', - #'SeqTagImpX'{xnt = #'XSeqNT'{bool = true, os = "kalle"}, - ximp = #'XSeqImp'{bool = true, os = "kalle"}, - xexp = #'XSeqExp'{bool = true, os = "kalle"}}), - ?line {ok,{'SeqTagImpX',{'XSeqNT',"kalle",true}, - {'XSeqImp',"kalle",true}, - {'XSeqExp',"kalle",true}}} = - asn1_wrapper:decode('SeqTag','SeqTagImpX',lists:flatten(Bytes22)), - - - ?line {ok,Bytes23} = - asn1_wrapper:encode('SeqTag','SeqTagExpX', - #'SeqTagExpX'{xnt = #'XSeqNT'{bool = true, os = "kalle"}, - ximp = #'XSeqImp'{bool = true, os = "kalle"}, - xexp = #'XSeqExp'{bool = true, os = "kalle"}}), - ?line {ok,{'SeqTagExpX',{'XSeqNT',"kalle",true}, - {'XSeqImp',"kalle",true}, - {'XSeqExp',"kalle",true}}} = - asn1_wrapper:decode('SeqTag','SeqTagExpX',lists:flatten(Bytes23)), - - - - - + roundtrip('SeqTag', #'SeqTag'{nt=#'NT'{os="kalle",bool=true}, + imp=#'Imp'{os="kalle",bool=true}, + exp=#'Exp'{os="kalle",bool=true}}), + roundtrip('SeqTagImp', #'SeqTagImp'{nt=#'NT'{os="kalle",bool=true}, + imp=#'Imp'{os="kalle",bool=true}, + exp=#'Exp'{os="kalle",bool=true}}), + roundtrip('SeqTagExp', #'SeqTagExp'{nt=#'NT'{os="kalle",bool=true}, + imp=#'Imp'{os="kalle",bool=true}, + exp=#'Exp'{os="kalle",bool=true}}), + roundtrip('SeqTagX', #'SeqTagX'{xnt=#'XSeqNT'{os="kalle",bool=true}, + ximp=#'XSeqImp'{os="kalle",bool=true}, + xexp=#'XSeqExp'{os="kalle",bool=true}}), + roundtrip('SeqTagImpX', #'SeqTagImpX'{xnt=#'XSeqNT'{os="kalle",bool=true}, + ximp=#'XSeqImp'{os="kalle",bool=true}, + xexp=#'XSeqExp'{os="kalle",bool=true}}), + roundtrip('SeqTagExpX', #'SeqTagExpX'{xnt=#'XSeqNT'{os="kalle",bool=true}, + ximp=#'XSeqImp'{os="kalle",bool=true}, + xexp=#'XSeqExp'{os="kalle",bool=true}}), ok. + +roundtrip(T, V) -> + asn1_test_lib:roundtrip('SeqTag', T, V). diff --git a/lib/asn1/test/testSeqTypeRefCho.erl b/lib/asn1/test/testSeqTypeRefCho.erl index 4b9eac7034..b008bc46b8 100644 --- a/lib/asn1/test/testSeqTypeRefCho.erl +++ b/lib/asn1/test/testSeqTypeRefCho.erl @@ -27,17 +27,12 @@ -record('SeqTRcho',{seqCho, seqChoE, 'seqCho-E', 'seqChoE-E'}). main(_Rules) -> - - - ?line {ok,Bytes11} = - asn1_wrapper:encode('SeqTypeRefCho','SeqTRcho', - #'SeqTRcho'{'seqCho' = {choOs,"A string 1"}, - 'seqChoE' = {choOs,"A string 3"}, - 'seqCho-E' = {choOs,"A string 7"}, - 'seqChoE-E' = {choOs,"A string 9"}}), - ?line {ok,{'SeqTRcho',{choOs,"A string 1"},{choOs,"A string 3"},{choOs,"A string 7"},{choOs,"A string 9"}}} = - asn1_wrapper:decode('SeqTypeRefCho','SeqTRcho',lists:flatten(Bytes11)), - - - + roundtrip('SeqTRcho', + #'SeqTRcho'{'seqCho' = {choOs,"A string 1"}, + 'seqChoE' = {choOs,"A string 3"}, + 'seqCho-E' = {choOs,"A string 7"}, + 'seqChoE-E' = {choOs,"A string 9"}}), ok. + +roundtrip(T, V) -> + asn1_test_lib:roundtrip('SeqTypeRefCho', T, V). diff --git a/lib/asn1/test/testSeqTypeRefPrim.erl b/lib/asn1/test/testSeqTypeRefPrim.erl index 7d4c2acc0e..b63882ae99 100644 --- a/lib/asn1/test/testSeqTypeRefPrim.erl +++ b/lib/asn1/test/testSeqTypeRefPrim.erl @@ -18,40 +18,24 @@ %% %% -module(testSeqTypeRefPrim). - --export([compile/3]). -export([main/1]). -include_lib("test_server/include/test_server.hrl"). -record('SeqTR',{octStr, octStrI, octStrE, 'octStr-I', 'octStrI-I', 'octStrE-I', 'octStr-E', 'octStrI-E', 'octStrE-E'}). - -compile(Config,Rules,Options) -> - - ?line DataDir = ?config(data_dir,Config), - ?line OutDir = ?config(priv_dir,Config), - ?line true = code:add_patha(?config(priv_dir,Config)), - ?line ok = asn1ct:compile(DataDir ++ "SeqTypeRefPrim",[Rules,{outdir,OutDir}]++Options). - - - main(_Rules) -> - - - ?line {ok,Bytes11} = - asn1_wrapper:encode('SeqTypeRefPrim','SeqTR',#'SeqTR'{'octStr' = "A string 1", - 'octStrI' = "A string 2", - 'octStrE' = "A string 3", - 'octStr-I' = "A string 4", - 'octStrI-I' = "A string 5", - 'octStrE-I' = "A string 6", - 'octStr-E' = "A string 7", - 'octStrI-E' = "A string 8", - 'octStrE-E' = "A string 9"}) , - ?line {ok,{'SeqTR',"A string 1","A string 2","A string 3","A string 4","A string 5","A string 6","A string 7","A string 8","A string 9"}} = - asn1_wrapper:decode('SeqTypeRefPrim','SeqTR',lists:flatten(Bytes11)), - - - + roundtrip('SeqTR', + #'SeqTR'{'octStr' = "A string 1", + 'octStrI' = "A string 2", + 'octStrE' = "A string 3", + 'octStr-I' = "A string 4", + 'octStrI-I' = "A string 5", + 'octStrE-I' = "A string 6", + 'octStr-E' = "A string 7", + 'octStrI-E' = "A string 8", + 'octStrE-E' = "A string 9"}), ok. + +roundtrip(T, V) -> + asn1_test_lib:roundtrip('SeqTypeRefPrim', T, V). diff --git a/lib/asn1/test/testSeqTypeRefSeq.erl b/lib/asn1/test/testSeqTypeRefSeq.erl index 57ec6c19b1..fc2e0a67c9 100644 --- a/lib/asn1/test/testSeqTypeRefSeq.erl +++ b/lib/asn1/test/testSeqTypeRefSeq.erl @@ -44,133 +44,43 @@ -record('SeqSeqExp',{seqInt, seqOs}). - main(_Rules) -> - - - ?line {ok,Bytes11} = - asn1_wrapper:encode('SeqTypeRefSeq','Seq1',#'Seq1'{bool1 = true, - int1 = 15, - seq1 = #'SeqIn'{boolIn = true, - intIn = 66}}), - ?line {ok,{'Seq1',true,15,{'SeqIn',true,66}}} = - asn1_wrapper:decode('SeqTypeRefSeq','Seq1',lists:flatten(Bytes11)), - - - - ?line {ok,Bytes12} = - asn1_wrapper:encode('SeqTypeRefSeq','Seq2',#'Seq2'{seq2 = #'SeqIn'{boolIn = true, - intIn = 66}, - bool2 = true, - int2 = 15}), - ?line {ok,{'Seq2',{'SeqIn',true,66},true,15}} = - asn1_wrapper:decode('SeqTypeRefSeq','Seq2',lists:flatten(Bytes12)), - - - ?line {ok,Bytes13} = - asn1_wrapper:encode('SeqTypeRefSeq','Seq3',#'Seq3'{bool3 = true, - seq3 = #'SeqIn'{boolIn = true, - intIn = 66}, - int3 = 15}), - ?line {ok,{'Seq3',true,{'SeqIn',true,66},15}} = - asn1_wrapper:decode('SeqTypeRefSeq','Seq3',lists:flatten(Bytes13)), - - - - ?line {ok,Bytes14} = - asn1_wrapper:encode('SeqTypeRefSeq','Seq4',#'Seq4'{seq41 = #'SeqIn'{boolIn = true, - intIn = 66}, - seq42 = #'SeqIn'{boolIn = true, - intIn = 66}, - seq43 = #'SeqIn'{boolIn = true, - intIn = 66}}), - ?line {ok,{'Seq4',{'SeqIn',true,66},{'SeqIn',true,66},{'SeqIn',true,66}}} = - asn1_wrapper:decode('SeqTypeRefSeq','Seq4',lists:flatten(Bytes14)), - - - - - - - - - ?line {ok,Bytes21} = - asn1_wrapper:encode('SeqTypeRefSeq','SeqS1',#'SeqS1'{boolS1 = true, - intS1 = 15, - seqS1 = #'SeqS1_seqS1'{boolIn = true, - intIn = 66}}), - ?line {ok,{'SeqS1',true,15,{'SeqS1_seqS1',true,66}}} = - asn1_wrapper:decode('SeqTypeRefSeq','SeqS1',lists:flatten(Bytes21)), - - - ?line {ok,Bytes22} = - asn1_wrapper:encode('SeqTypeRefSeq','SeqS2',#'SeqS2'{seqS2 = #'SeqS2_seqS2'{boolIn = true, - intIn = 66}, - boolS2 = true, - intS2 = 15}), - ?line {ok,{'SeqS2',{'SeqS2_seqS2',true,66},true,15}} = - asn1_wrapper:decode('SeqTypeRefSeq','SeqS2',lists:flatten(Bytes22)), - - - - ?line {ok,Bytes23} = - asn1_wrapper:encode('SeqTypeRefSeq','SeqS3',#'SeqS3'{boolS3 = true, - seqS3 = #'SeqS3_seqS3'{boolIn = true, - intIn = 66}, - intS3 = 15}), - ?line {ok,{'SeqS3',true,{'SeqS3_seqS3',true,66},15}} = - asn1_wrapper:decode('SeqTypeRefSeq','SeqS3',lists:flatten(Bytes23)), - - - - - - - ?line {ok,Bytes31} = - asn1_wrapper:encode('SeqTypeRefSeq','SeqSTag',#'SeqSTag'{seqS1 = #'SeqSTag_seqS1'{b1 = true, - i1 = 11}, - seqS2 = #'SeqSTag_seqS2'{b2 = true, - i2 = 22}, - seqS3 = #'SeqSTag_seqS3'{b3 = true, - i3 = 33}}), - ?line {ok,{'SeqSTag',{'SeqSTag_seqS1',true,11}, - {'SeqSTag_seqS2',true,22}, - {'SeqSTag_seqS3',true,33}}} = - asn1_wrapper:decode('SeqTypeRefSeq','SeqSTag',lists:flatten(Bytes31)), - - - - - - ?line {ok,Bytes41} = - asn1_wrapper:encode('SeqTypeRefSeq','SeqTRseq', - #'SeqTRseq'{'seqSeq' = #'SeqSeq'{seqOs = "A1", - seqInt = 2}, - 'seqSeqI' = #'SeqSeq'{seqOs = "A2", - seqInt = 2}, - 'seqSeqE' = #'SeqSeq'{seqOs = "A3", - seqInt = 2}, - 'seqSeq-I' = #'SeqSeqImp'{seqOs = "A4", - seqInt = 2}, - 'seqSeqI-I' = #'SeqSeqImp'{seqOs = "A5", - seqInt = 2}, - 'seqSeqE-I' = #'SeqSeqImp'{seqOs = "A6", - seqInt = 2}, - 'seqSeq-E' = #'SeqSeqExp'{seqOs = "A7", - seqInt = 2}, - 'seqSeqI-E' = #'SeqSeqExp'{seqOs = "A8", - seqInt = 2}, - 'seqSeqE-E' = #'SeqSeqExp'{seqOs = "A9", - seqInt = 2}}), - ?line {ok,{'SeqTRseq',{'SeqSeq',2,"A1"}, - {'SeqSeq',2,"A2"}, - {'SeqSeq',2,"A3"}, - {'SeqSeqImp',2,"A4"}, - {'SeqSeqImp',2,"A5"}, - {'SeqSeqImp',2,"A6"}, - {'SeqSeqExp',2,"A7"}, - {'SeqSeqExp',2,"A8"}, - {'SeqSeqExp',2,"A9"}}} = - asn1_wrapper:decode('SeqTypeRefSeq','SeqTRseq',lists:flatten(Bytes41)), - + roundtrip('Seq1', + #'Seq1'{bool1=true,int1=15, + seq1=#'SeqIn'{boolIn=true,intIn=66}}), + roundtrip('Seq2', + #'Seq2'{seq2=#'SeqIn'{boolIn=true,intIn=66}, + bool2=true,int2=15}), + roundtrip('Seq3', + #'Seq3'{bool3=true,seq3=#'SeqIn'{boolIn=true,intIn=66},int3=15}), + roundtrip('Seq4', + #'Seq4'{seq41=#'SeqIn'{boolIn=true,intIn=66}, + seq42=#'SeqIn'{boolIn=true,intIn=66}, + seq43=#'SeqIn'{boolIn=true,intIn=66}}), + roundtrip('SeqS1', + #'SeqS1'{boolS1=true,intS1=15, + seqS1=#'SeqS1_seqS1'{boolIn=true,intIn=66}}), + roundtrip('SeqS2', + #'SeqS2'{seqS2=#'SeqS2_seqS2'{boolIn=true,intIn=66}, + boolS2=true,intS2=15}), + roundtrip('SeqS3', + #'SeqS3'{boolS3=true,seqS3=#'SeqS3_seqS3'{boolIn=true,intIn=66}, + intS3=15}), + roundtrip('SeqSTag', + #'SeqSTag'{seqS1=#'SeqSTag_seqS1'{b1=true,i1=11}, + seqS2=#'SeqSTag_seqS2'{b2=true,i2=22}, + seqS3=#'SeqSTag_seqS3'{b3=true,i3=33}}), + roundtrip('SeqTRseq', + #'SeqTRseq'{seqSeq=#'SeqSeq'{seqInt=2,seqOs="A1"}, + seqSeqI=#'SeqSeq'{seqInt=2,seqOs="A2"}, + seqSeqE=#'SeqSeq'{seqInt=2,seqOs="A3"}, + 'seqSeq-I'=#'SeqSeqImp'{seqInt=2,seqOs="A4"}, + 'seqSeqI-I'=#'SeqSeqImp'{seqInt=2,seqOs="A5"}, + 'seqSeqE-I'=#'SeqSeqImp'{seqInt=2,seqOs="A6"}, + 'seqSeq-E'=#'SeqSeqExp'{seqInt=2,seqOs="A7"}, + 'seqSeqI-E'=#'SeqSeqExp'{seqInt=2,seqOs="A8"}, + 'seqSeqE-E'=#'SeqSeqExp'{seqInt=2,seqOs="A9"}}), ok. + +roundtrip(T, V) -> + asn1_test_lib:roundtrip('SeqTypeRefSeq', T, V). diff --git a/lib/asn1/test/testSeqTypeRefSet.erl b/lib/asn1/test/testSeqTypeRefSet.erl index c06a0e7a2b..911a4b7a47 100644 --- a/lib/asn1/test/testSeqTypeRefSet.erl +++ b/lib/asn1/test/testSeqTypeRefSet.erl @@ -31,36 +31,17 @@ main(_Rules) -> - - ?line {ok,Bytes41} = - asn1_wrapper:encode('SeqTypeRefSet','SeqTRset', - #'SeqTRset'{'seqSet' = #'SeqSet'{setOs = "A1", - setInt = 2}, - 'seqSetI' = #'SeqSet'{setOs = "A2", - setInt = 2}, - 'seqSetE' = #'SeqSet'{setOs = "A3", - setInt = 2}, - 'seqSet-I' = #'SeqSetImp'{setOs = "A4", - setInt = 2}, - 'seqSetI-I' = #'SeqSetImp'{setOs = "A5", - setInt = 2}, - 'seqSetE-I' = #'SeqSetImp'{setOs = "A6", - setInt = 2}, - 'seqSet-E' = #'SeqSetExp'{setOs = "A7", - setInt = 2}, - 'seqSetI-E' = #'SeqSetExp'{setOs = "A8", - setInt = 2}, - 'seqSetE-E' = #'SeqSetExp'{setOs = "A9", - setInt = 2}}), - ?line {ok,{'SeqTRset',{'SeqSet',2,"A1"}, - {'SeqSet',2,"A2"}, - {'SeqSet',2,"A3"}, - {'SeqSetImp',2,"A4"}, - {'SeqSetImp',2,"A5"}, - {'SeqSetImp',2,"A6"}, - {'SeqSetExp',2,"A7"}, - {'SeqSetExp',2,"A8"}, - {'SeqSetExp',2,"A9"}}} = - asn1_wrapper:decode('SeqTypeRefSet','SeqTRset',lists:flatten(Bytes41)), - + roundtrip('SeqTRset', + #'SeqTRset'{seqSet=#'SeqSet'{setInt=2,setOs="A1"}, + seqSetI=#'SeqSet'{setInt=2,setOs="A2"}, + seqSetE=#'SeqSet'{setInt=2,setOs="A3"}, + 'seqSet-I'=#'SeqSetImp'{setInt=2,setOs="A4"}, + 'seqSetI-I'=#'SeqSetImp'{setInt=2,setOs="A5"}, + 'seqSetE-I'=#'SeqSetImp'{setInt=2,setOs="A6"}, + 'seqSet-E'=#'SeqSetExp'{setInt=2,setOs="A7"}, + 'seqSetI-E'=#'SeqSetExp'{setInt=2,setOs="A8"}, + 'seqSetE-E'=#'SeqSetExp'{setInt=2,setOs="A9"}}), ok. + +roundtrip(T, V) -> + asn1_test_lib:roundtrip('SeqTypeRefSet', T, V). diff --git a/lib/asn1/test/testSetDefault.erl b/lib/asn1/test/testSetDefault.erl index 8aa205e0f0..055dc6cecf 100644 --- a/lib/asn1/test/testSetDefault.erl +++ b/lib/asn1/test/testSetDefault.erl @@ -26,58 +26,34 @@ -record('SetDef1',{bool1 = asn1_DEFAULT, int1, set1 = asn1_DEFAULT}). -record('SetDef2',{set2 = asn1_DEFAULT, bool2, int2}). -record('SetDef3',{bool3 = asn1_DEFAULT, set3 = asn1_DEFAULT, int3 = asn1_DEFAULT}). --record('SetIn',{boolIn, intIn}). +-record('SetIn', {boolIn = asn1_NOVALUE, intIn = 12}). main(_Rules) -> - - ?line {ok,Bytes11} = - asn1_wrapper:encode('SetDefault','SetDef1',#'SetDef1'{bool1 = true, - int1 = 15, - set1 = #'SetIn'{boolIn = true, - intIn = 66}}), - ?line {ok,{'SetDef1',true,15,{'SetIn',true,66}}} = - asn1_wrapper:decode('SetDefault','SetDef1',lists:flatten(Bytes11)), - - - ?line {ok,Bytes12} = asn1_wrapper:encode('SetDefault','SetDef1',#'SetDef1'{int1 = 15}), - ?line {ok,{'SetDef1',true,15,{'SetIn',asn1_NOVALUE,12}}} = - asn1_wrapper:decode('SetDefault','SetDef1',lists:flatten(Bytes12)), - - - ?line {ok,Bytes21} = - asn1_wrapper:encode('SetDefault','SetDef2',#'SetDef2'{bool2 = true, - int2 = 15, - set2 = #'SetIn'{boolIn = true, - intIn = 66}}), - ?line {ok,{'SetDef2',{'SetIn',true,66},true,15}} = - asn1_wrapper:decode('SetDefault','SetDef2',lists:flatten(Bytes21)), - - - ?line {ok,Bytes22} = asn1_wrapper:encode('SetDefault','SetDef2',#'SetDef2'{bool2 = true, - int2 = 15}), - ?line {ok,{'SetDef2',{'SetIn',asn1_NOVALUE,12},true,15}} = - asn1_wrapper:decode('SetDefault','SetDef2',lists:flatten(Bytes22)), - - - - ?line {ok,Bytes31} = - asn1_wrapper:encode('SetDefault','SetDef3',#'SetDef3'{bool3 = true, - int3 = 15, - set3 = #'SetIn'{boolIn = true, - intIn = 66}}), - ?line {ok,{'SetDef3',true,{'SetIn',true,66},15}} = - asn1_wrapper:decode('SetDefault','SetDef3',lists:flatten(Bytes31)), - - - ?line {ok,Bytes32} = asn1_wrapper:encode('SetDefault','SetDef3',#'SetDef3'{int3 = 15}), - ?line {ok,{'SetDef3',true,{'SetIn',asn1_NOVALUE,12},15}} = - asn1_wrapper:decode('SetDefault','SetDef3',lists:flatten(Bytes32)), - - - - + roundtrip('SetDef1', + #'SetDef1'{bool1=true,int1=15, + set1=#'SetIn'{boolIn=true,intIn=66}}), + roundtrip('SetDef1', + #'SetDef1'{bool1=asn1_DEFAULT,int1=15,set1=asn1_DEFAULT}, + #'SetDef1'{bool1=true,int1=15,set1=#'SetIn'{}}), - - + roundtrip('SetDef2', + #'SetDef2'{set2=#'SetIn'{boolIn=true,intIn=66}, + bool2=true,int2=15}), + roundtrip('SetDef2', + #'SetDef2'{set2=asn1_DEFAULT,bool2=true,int2=15}, + #'SetDef2'{set2=#'SetIn'{},bool2=true,int2=15}), + + roundtrip('SetDef3', + #'SetDef3'{bool3=true,set3=#'SetIn'{boolIn=true,intIn=66}, + int3=15}), + roundtrip('SetDef3', + #'SetDef3'{bool3=asn1_DEFAULT,set3=asn1_DEFAULT,int3=15}, + #'SetDef3'{bool3=true,set3=#'SetIn'{},int3=15}), ok. + +roundtrip(Type, Value) -> + roundtrip(Type, Value, Value). + +roundtrip(Type, Value, ExpectedValue) -> + asn1_test_lib:roundtrip('SetDefault', Type, Value, ExpectedValue). diff --git a/lib/asn1/test/testSetExtension.erl b/lib/asn1/test/testSetExtension.erl index c7fb3b42c4..4e2463326b 100644 --- a/lib/asn1/test/testSetExtension.erl +++ b/lib/asn1/test/testSetExtension.erl @@ -18,10 +18,7 @@ %% %% -module(testSetExtension). - - -include("External.hrl"). --export([compile/3]). -export([main/1]). -include_lib("test_server/include/test_server.hrl"). @@ -31,76 +28,20 @@ -record('SetExt3',{bool, int}). -record('SetExt4',{bool, int}). - -compile(Config,Rules,Options) -> - - ?line DataDir = ?config(data_dir,Config), - ?line OutDir = ?config(priv_dir,Config), - ?line true = code:add_patha(?config(priv_dir,Config)), - ?line ok = asn1ct:compile(DataDir ++ "SetExtension", - [Rules,{outdir,OutDir}]++Options). - - - main(_Rules) -> - - ?line {ok,Bytes11} = - asn1_wrapper:encode('SetExtension','SetExt1',#'SetExt1'{}), - ?line {ok,{'SetExt1'}} = - asn1_wrapper:decode('SetExtension','SetExt1',lists:flatten(Bytes11)), - - ?line {ok,Bytes21} = - asn1_wrapper:encode('SetExtension','SetExt2',#'SetExt2'{bool = true,int = 99}), - ?line {ok,{'SetExt2',true,99}} = - asn1_wrapper:decode('SetExtension','SetExt2',lists:flatten(Bytes21)), - - ?line {ok,Bytes22} = - asn1_wrapper:encode('SetExtension','SetExt2',#'SetExt2'{int = 99,bool = true}), - ?line {ok,{'SetExt2',true,99}} = - asn1_wrapper:decode('SetExtension','SetExt2',lists:flatten(Bytes22)), - - ?line {ok,Bytes31} = - asn1_wrapper:encode('SetExtension','SetExt3',#'SetExt3'{bool = true,int = 99}), - ?line {ok,{'SetExt3',true,99}} = - asn1_wrapper:decode('SetExtension','SetExt3',lists:flatten(Bytes31)), - - ?line {ok,Bytes32} = - asn1_wrapper:encode('SetExtension','SetExt3',#'SetExt3'{int = 99,bool = true}), - ?line {ok,{'SetExt3',true,99}} = - asn1_wrapper:decode('SetExtension','SetExt3',lists:flatten(Bytes32)), - - ?line {ok,Bytes41} = - asn1_wrapper:encode('SetExtension','SetExt4',#'SetExt4'{bool = true,int = 99}), - ?line {ok,{'SetExt4',true,99}} = - asn1_wrapper:decode('SetExtension','SetExt4',lists:flatten(Bytes41)), - - ?line {ok,Bytes42} = - asn1_wrapper:encode('SetExtension','SetExt4',#'SetExt4'{int = 99,bool = true}), - ?line {ok,{'SetExt4',true,99}} = - asn1_wrapper:decode('SetExtension','SetExt4',lists:flatten(Bytes42)), - - - %% Test of extension , needs to be improved and extended - - ?line {ok,BytesX11} = - asn1_wrapper:encode('SetExtension','SetExt1',#'SetExt1'{}), - ?line {ok,{'SetExt1'}} = - asn1_wrapper:decode('SetExtension','SetExt1',lists:flatten(BytesX11)), - - ?line {ok,BytesX21} = - asn1_wrapper:encode('SetExtension','SetExt2',#'SetExt2'{bool = true,int = 99}), - ?line {ok,{'SetExt2',true,99}} = - asn1_wrapper:decode('SetExtension','SetExt2',lists:flatten(BytesX21)), - - ?line {ok,BytesX22} = - asn1_wrapper:encode('SetExtension','SetExt2',#'SetExt2'{int = 99,bool = true}), - ?line {ok,{'SetExt2',true,99}} = - asn1_wrapper:decode('SetExtension','SetExt2',lists:flatten(BytesX22)), - - - - - + roundtrip('SetExt1', #'SetExt1'{}), + roundtrip('SetExt2', #'SetExt2'{bool=true,int=99}), + roundtrip('SetExt2', #'SetExt2'{bool=true,int=99}), + roundtrip('SetExt3', #'SetExt3'{bool=true,int=99}), + roundtrip('SetExt3', #'SetExt3'{bool=true,int=99}), + roundtrip('SetExt4', #'SetExt4'{bool=true,int=99}), + roundtrip('SetExt4', #'SetExt4'{bool=true,int=99}), + roundtrip('SetExt1', #'SetExt1'{}), + roundtrip('SetExt2', #'SetExt2'{bool=true,int=99}), + roundtrip('SetExt2', #'SetExt2'{bool=true,int=99}), ok. +roundtrip(T, V) -> + asn1_test_lib:roundtrip('SetExtension', T, V). + diff --git a/lib/asn1/test/testSetExternal.erl b/lib/asn1/test/testSetExternal.erl index 30cddcacfb..e17d7053aa 100644 --- a/lib/asn1/test/testSetExternal.erl +++ b/lib/asn1/test/testSetExternal.erl @@ -18,111 +18,36 @@ %% %% -module(testSetExternal). - --include("External.hrl"). -export([main/1]). +-include("External.hrl"). -include_lib("test_server/include/test_server.hrl"). - -record('SetXSeq1',{seq, bool, int}). -record('SetXSeq2',{bool, seq, int}). -record('SetXSeq3',{bool, int, seq}). -%-record('NT',{os, bool}). -%-record('Imp',{os, bool}). -%-record('Exp',{os, bool}). main(_Rules) -> - - ?line {ok,Bytes11} = - asn1_wrapper:encode('SetExternal','XNTNT',#'XSetNT'{bool = true, os = "kalle"}), - ?line {ok,{'XSetNT',[107,97,108,108,101],true}} = - asn1_wrapper:decode('SetExternal','XNTNT',lists:flatten(Bytes11)), - - ?line {ok,Bytes12} = - asn1_wrapper:encode('SetExternal','XImpNT',#'XSetNT'{bool = true, os = "kalle"}), - ?line {ok,{'XSetNT',[107,97,108,108,101],true}} = - asn1_wrapper:decode('SetExternal','XImpNT',lists:flatten(Bytes12)), - - ?line {ok,Bytes13} = - asn1_wrapper:encode('SetExternal','XExpNT',#'XSetNT'{bool = true, os = "kalle"}), - ?line {ok,{'XSetNT',[107,97,108,108,101],true}} = - asn1_wrapper:decode('SetExternal','XExpNT',lists:flatten(Bytes13)), - - - - ?line {ok,Bytes21} = - asn1_wrapper:encode('SetExternal','XNTImp',#'XSetImp'{bool = true, os = "kalle"}), - ?line {ok,{'XSetImp',[107,97,108,108,101],true}} = - asn1_wrapper:decode('SetExternal','XNTImp',lists:flatten(Bytes21)), - - ?line {ok,Bytes22} = - asn1_wrapper:encode('SetExternal','XImpImp',#'XSetImp'{bool = true, os = "kalle"}), - ?line {ok,{'XSetImp',[107,97,108,108,101],true}} = - asn1_wrapper:decode('SetExternal','XImpImp',lists:flatten(Bytes22)), - - ?line {ok,Bytes23} = - asn1_wrapper:encode('SetExternal','XExpImp',#'XSetImp'{bool = true, os = "kalle"}), - ?line {ok,{'XSetImp',[107,97,108,108,101],true}} = - asn1_wrapper:decode('SetExternal','XExpImp',lists:flatten(Bytes23)), - - - - ?line {ok,Bytes31} = - asn1_wrapper:encode('SetExternal','XNTExp',#'XSetExp'{bool = true, os = "kalle"}), - ?line {ok,{'XSetExp',[107,97,108,108,101],true}} = - asn1_wrapper:decode('SetExternal','XNTExp',lists:flatten(Bytes31)), - - ?line {ok,Bytes32} = - asn1_wrapper:encode('SetExternal','XImpExp',#'XSetExp'{bool = true, os = "kalle"}), - ?line {ok,{'XSetExp',[107,97,108,108,101],true}} = - asn1_wrapper:decode('SetExternal','XImpExp',lists:flatten(Bytes32)), - - ?line {ok,Bytes33} = - asn1_wrapper:encode('SetExternal','XExpExp',#'XSetExp'{bool = true, os = "kalle"}), - ?line {ok,{'XSetExp',[107,97,108,108,101],true}} = - asn1_wrapper:decode('SetExternal','XExpExp',lists:flatten(Bytes33)), - - - - ?line {ok,Bytes41} = - asn1_wrapper:encode('SetExternal','SetXSeq1', - #'SetXSeq1'{bool = true, - int = 66, - seq = #'XSeq1'{bool1 = true, - int1 = 77, - seq1 = #'XSeqIn'{boolIn = false, - intIn = 88}}}), - ?line {ok,{'SetXSeq1',{'XSeq1',true,77,{'XSeqIn',false,88}},true,66}} = - asn1_wrapper:decode('SetExternal','SetXSeq1',lists:flatten(Bytes41)), - - - - ?line {ok,Bytes42} = - asn1_wrapper:encode('SetExternal','SetXSeq2', - #'SetXSeq2'{bool = true, - int = 66, - seq = #'XSeq1'{bool1 = true, - int1 = 77, - seq1 = #'XSeqIn'{boolIn = false, - intIn = 88}}}), - ?line {ok,{'SetXSeq2',true,{'XSeq1',true,77,{'XSeqIn',false,88}},66}} = - asn1_wrapper:decode('SetExternal','SetXSeq2',lists:flatten(Bytes42)), - - ?line {ok,Bytes43} = - asn1_wrapper:encode('SetExternal','SetXSeq3', - #'SetXSeq3'{bool = true, - int = 66, - seq = #'XSeq1'{bool1 = true, - int1 = 77, - seq1 = #'XSeqIn'{boolIn = false, - intIn = 88}}}), - ?line {ok,{'SetXSeq3',true,66,{'XSeq1',true,77,{'XSeqIn',false,88}}}} = - asn1_wrapper:decode('SetExternal','SetXSeq3',lists:flatten(Bytes43)), - - - - + roundtrip('XNTNT', #'XSetNT'{os="kalle",bool=true}), + roundtrip('XImpNT', #'XSetNT'{os="kalle",bool=true}), + roundtrip('XExpNT', #'XSetNT'{os="kalle",bool=true}), + roundtrip('XNTImp', #'XSetImp'{os="kalle",bool=true}), + roundtrip('XImpImp', #'XSetImp'{os="kalle",bool=true}), + roundtrip('XExpImp', #'XSetImp'{os="kalle",bool=true}), + roundtrip('XNTExp', #'XSetExp'{os="kalle",bool=true}), + roundtrip('XImpExp', #'XSetExp'{os="kalle",bool=true}), + roundtrip('XExpExp', #'XSetExp'{os="kalle",bool=true}), + roundtrip('SetXSeq1', #'SetXSeq1'{seq=#'XSeq1'{bool1=true,int1=77, + seq1=#'XSeqIn'{boolIn=false,intIn=88}}, + bool=true,int=66}), + roundtrip('SetXSeq2', #'SetXSeq2'{bool=true, + seq=#'XSeq1'{bool1=true,int1=77, + seq1=#'XSeqIn'{boolIn=false,intIn=88}}, + int=66}), + roundtrip('SetXSeq3', #'SetXSeq3'{bool=true,int=66, + seq=#'XSeq1'{bool1=true,int1=77, + seq1=#'XSeqIn'{boolIn=false,intIn=88}}}), ok. - +roundtrip(T, V) -> + asn1_test_lib:roundtrip('SetExternal', T, V). diff --git a/lib/asn1/test/testSetIndefinite.erl b/lib/asn1/test/testSetIndefinite.erl deleted file mode 100644 index 73006da62b..0000000000 --- a/lib/asn1/test/testSetIndefinite.erl +++ /dev/null @@ -1,41 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% 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(testSetIndefinite). - --export([main/1]). - --include_lib("test_server/include/test_server.hrl"). - - -main(per) -> ok; -main(ber) -> - - %% normal encoding - B = [49,20,1,1,255,49,9,1,1,255,2,4,251,35,238,194,2,4,251,55,236,161], - %% indefinite length encoding - Bi = [49,22,1,1,255,49,128,1,1,255,2,4,251,35,238,194,0,0,2,4,251,55,236,161], - %% the value which is encoded - V = {'SetS3',true,{'SetS3_setS3',true,-81531198},-80221023}, - ?line {ok,V} = asn1_wrapper:decode('SeqSetIndefinite','SetS3',B), - ?line {ok,V} = asn1_wrapper:decode('SeqSetIndefinite','SetS3',Bi), - ok. - - - diff --git a/lib/asn1/test/testSetOf.erl b/lib/asn1/test/testSetOf.erl index 08723fb468..54c42c1f21 100644 --- a/lib/asn1/test/testSetOf.erl +++ b/lib/asn1/test/testSetOf.erl @@ -28,198 +28,108 @@ -record('Set3',{bool3, set3 = asn1_DEFAULT, int3}). -record('Set4',{set41 = asn1_DEFAULT, set42 = asn1_DEFAULT, set43 = asn1_DEFAULT}). -record('SetIn',{boolIn, intIn}). -%-record('SetCho',{bool1, int1, set1 = asn1_DEFAULT}). -%-record('SetChoInline',{bool1, int1, set1 = asn1_DEFAULT}). -%-record('SetChoOfInline_SETOF',{bool1, int1, set1 = asn1_DEFAULT}). -record('SetEmp',{set1}). -record('Empty',{}). main(_Rules) -> + roundtrip('Set1', + #'Set1'{bool1=true,int1=17,set1=asn1_DEFAULT}, + #'Set1'{bool1=true,int1=17,set1=[]}), + roundtrip('Set1', + #'Set1'{bool1=true,int1=17, + set1=[#'SetIn'{boolIn=true,intIn=25}]}), + roundtrip('Set1', #'Set1'{bool1=true,int1=17, + set1=[#'SetIn'{boolIn=true,intIn=25}, + #'SetIn'{boolIn=false,intIn=125}, + #'SetIn'{boolIn=false,intIn=225}]}), + + roundtrip('Set2', + #'Set2'{set2=asn1_DEFAULT,bool2=true,int2=17}, + #'Set2'{set2=[],bool2=true,int2=17}), + roundtrip('Set2', + #'Set2'{set2=[#'SetIn'{boolIn=true,intIn=25}], + bool2=true,int2=17}), + roundtrip('Set2', + #'Set2'{set2=[#'SetIn'{boolIn=true,intIn=25}, + #'SetIn'{boolIn=false,intIn=125}, + #'SetIn'{boolIn=false,intIn=225}], + bool2=true,int2=17}), + + roundtrip('Set3', + #'Set3'{bool3=true,set3=asn1_DEFAULT,int3=17}, + #'Set3'{bool3=true,set3=[],int3=17}), + roundtrip('Set3', + #'Set3'{bool3=true,set3=[#'SetIn'{boolIn=true,intIn=25}], + int3=17}), + roundtrip('Set3', + #'Set3'{bool3=true, + set3=[#'SetIn'{boolIn=true,intIn=25}, + #'SetIn'{boolIn=false,intIn=125}, + #'SetIn'{boolIn=false,intIn=225}], + int3=17}), + + roundtrip('Set4', + #'Set4'{set41=asn1_DEFAULT,set42=asn1_DEFAULT, + set43=asn1_DEFAULT}, + #'Set4'{set41=[],set42=[],set43=[]}), + roundtrip('Set4', + #'Set4'{set41=[#'SetIn'{boolIn=true,intIn=25}], + set42=asn1_DEFAULT,set43=asn1_DEFAULT}, + #'Set4'{set41=[#'SetIn'{boolIn=true,intIn=25}], + set42=[],set43=[]}), + roundtrip('Set4', + #'Set4'{set41=[#'SetIn'{boolIn=true,intIn=25}, + #'SetIn'{boolIn=false,intIn=125}, + #'SetIn'{boolIn=false,intIn=225}], + set42=asn1_DEFAULT,set43=asn1_DEFAULT}, + #'Set4'{set41=[#'SetIn'{boolIn=true,intIn=25}, + #'SetIn'{boolIn=false,intIn=125}, + #'SetIn'{boolIn=false,intIn=225}], + set42=[],set43=[]}), + roundtrip('Set4', + #'Set4'{set41=asn1_DEFAULT, + set42=[#'SetIn'{boolIn=true,intIn=25}], + set43=asn1_DEFAULT}, + #'Set4'{set41=[], + set42=[#'SetIn'{boolIn=true,intIn=25}], + set43=[]}), + roundtrip('Set4', + #'Set4'{set41=asn1_DEFAULT, + set42=[#'SetIn'{boolIn=true,intIn=25}, + #'SetIn'{boolIn=false,intIn=125}, + #'SetIn'{boolIn=false,intIn=225}], + set43=asn1_DEFAULT}, + #'Set4'{set41=[], + set42=[#'SetIn'{boolIn=true,intIn=25}, + #'SetIn'{boolIn=false,intIn=125}, + #'SetIn'{boolIn=false,intIn=225}], + set43=[]}), + roundtrip('Set4', + #'Set4'{set41=asn1_DEFAULT,set42=asn1_DEFAULT, + set43=[#'SetIn'{boolIn=true,intIn=25}]}, + #'Set4'{set41=[],set42=[], + set43=[#'SetIn'{boolIn=true,intIn=25}]}), + roundtrip('Set4', + #'Set4'{set41=asn1_DEFAULT,set42=asn1_DEFAULT, + set43=[#'SetIn'{boolIn=true,intIn=25}, + #'SetIn'{boolIn=false,intIn=125}, + #'SetIn'{boolIn=false,intIn=225}]}, + #'Set4'{set41=[],set42=[], + set43=[#'SetIn'{boolIn=true,intIn=25}, + #'SetIn'{boolIn=false,intIn=125}, + #'SetIn'{boolIn=false,intIn=225}]}), + + roundtrip('SetOs', ["First","Second","Third"]), + roundtrip('SetOsImp', ["First","Second","Third"]), + roundtrip('SetOsExp', ["First","Second","Third"]), + roundtrip('SetEmp', #'SetEmp'{set1=[#'Empty'{}]}), - ?line {ok,Bytes11} = - asn1_wrapper:encode('SetOf','Set1',#'Set1'{bool1 = true, - int1 = 17}), - ?line {ok,{'Set1',true,17,[]}} = - asn1_wrapper:decode('SetOf','Set1',lists:flatten(Bytes11)), - - - ?line {ok,Bytes12} = - asn1_wrapper:encode('SetOf','Set1',#'Set1'{bool1 = true, - int1 = 17, - set1 = [#'SetIn'{boolIn = true, - intIn = 25}]}), - ?line {ok,{'Set1',true,17,[{'SetIn',true,25}]}} = - asn1_wrapper:decode('SetOf','Set1',lists:flatten(Bytes12)), - - - - ?line {ok,Bytes13} = - asn1_wrapper:encode('SetOf','Set1',#'Set1'{bool1 = true, - int1 = 17, - set1 = [#'SetIn'{boolIn = true, - intIn = 25}, - #'SetIn'{boolIn = false, - intIn = 125}, - #'SetIn'{boolIn = false, - intIn = 225}]}), - ?line {ok,{'Set1',true,17,[{'SetIn',true,25},{'SetIn',false,125},{'SetIn',false,225}]}} = - asn1_wrapper:decode('SetOf','Set1',lists:flatten(Bytes13)), - - - - - - - ?line {ok,Bytes21} = - asn1_wrapper:encode('SetOf','Set2',#'Set2'{bool2 = true, - int2 = 17}), - - ?line {ok,{'Set2',[],true,17}} = - asn1_wrapper:decode('SetOf','Set2',lists:flatten(Bytes21)), - - - ?line {ok,Bytes22} = - asn1_wrapper:encode('SetOf','Set2',#'Set2'{bool2 = true, - int2 = 17, - set2 = [#'SetIn'{boolIn = true, - intIn = 25}]}), - ?line {ok,{'Set2',[{'SetIn',true,25}],true,17}} = - asn1_wrapper:decode('SetOf','Set2',lists:flatten(Bytes22)), - - - ?line {ok,Bytes23} = - asn1_wrapper:encode('SetOf','Set2',#'Set2'{bool2 = true, - int2 = 17, - set2 = [#'SetIn'{boolIn = true, - intIn = 25}, - #'SetIn'{boolIn = false, - intIn = 125}, - #'SetIn'{boolIn = false, - intIn = 225}]}), - ?line {ok,{'Set2',[{'SetIn',true,25},{'SetIn',false,125},{'SetIn',false,225}],true,17}} = - asn1_wrapper:decode('SetOf','Set2',lists:flatten(Bytes23)), - - - - - - - ?line {ok,Bytes31} = - asn1_wrapper:encode('SetOf','Set3',#'Set3'{bool3 = true, - int3 = 17}), - ?line {ok,{'Set3',true,[],17}} = - asn1_wrapper:decode('SetOf','Set3',lists:flatten(Bytes31)), - - - ?line {ok,Bytes32} = - asn1_wrapper:encode('SetOf','Set3',#'Set3'{bool3 = true, - int3 = 17, - set3 = [#'SetIn'{boolIn = true, - intIn = 25}]}), - ?line {ok,{'Set3',true,[{'SetIn',true,25}],17}} = - asn1_wrapper:decode('SetOf','Set3',lists:flatten(Bytes32)), - - - ?line {ok,Bytes33} = - asn1_wrapper:encode('SetOf','Set3',#'Set3'{bool3 = true, - int3 = 17, - set3 = [#'SetIn'{boolIn = true, - intIn = 25}, - #'SetIn'{boolIn = false, - intIn = 125}, - #'SetIn'{boolIn = false, - intIn = 225}]}), - ?line {ok,{'Set3',true,[{'SetIn',true,25},{'SetIn',false,125},{'SetIn',false,225}],17}} = - asn1_wrapper:decode('SetOf','Set3',lists:flatten(Bytes33)), - - - - - - - - ?line {ok,Bytes41} = asn1_wrapper:encode('SetOf','Set4',#'Set4'{}), - ?line {ok,{'Set4',[],[],[]}} = asn1_wrapper:decode('SetOf','Set4',lists:flatten(Bytes41)), - - - ?line {ok,Bytes42} = - asn1_wrapper:encode('SetOf','Set4',#'Set4'{set41 = [#'SetIn'{boolIn = true, - intIn = 25}]}), - ?line {ok,{'Set4',[{'SetIn',true,25}],[],[]}} = - asn1_wrapper:decode('SetOf','Set4',lists:flatten(Bytes42)), - - - ?line {ok,Bytes43} = - asn1_wrapper:encode('SetOf','Set4',#'Set4'{set41 = [#'SetIn'{boolIn = true, - intIn = 25}, - #'SetIn'{boolIn = false, - intIn = 125}, - #'SetIn'{boolIn = false, - intIn = 225}]}), - ?line {ok,{'Set4',[{'SetIn',true,25},{'SetIn',false,125},{'SetIn',false,225}],[],[]}} = - asn1_wrapper:decode('SetOf','Set4',lists:flatten(Bytes43)), - - - ?line {ok,Bytes44} = - asn1_wrapper:encode('SetOf','Set4',#'Set4'{set42 = [#'SetIn'{boolIn = true, - intIn = 25}]}), - ?line {ok,{'Set4',[],[{'SetIn',true,25}],[]}} = - asn1_wrapper:decode('SetOf','Set4',lists:flatten(Bytes44)), - - - ?line {ok,Bytes45} = - asn1_wrapper:encode('SetOf','Set4',#'Set4'{set42 = [#'SetIn'{boolIn = true, - intIn = 25}, - #'SetIn'{boolIn = false, - intIn = 125}, - #'SetIn'{boolIn = false, - intIn = 225}]}), - ?line {ok,{'Set4',[],[{'SetIn',true,25},{'SetIn',false,125},{'SetIn',false,225}],[]}} = - asn1_wrapper:decode('SetOf','Set4',lists:flatten(Bytes45)), - - - ?line {ok,Bytes46} = - asn1_wrapper:encode('SetOf','Set4',#'Set4'{set43 = [#'SetIn'{boolIn = true, - intIn = 25}]}), - ?line {ok,{'Set4',[],[],[{'SetIn',true,25}]}} = - asn1_wrapper:decode('SetOf','Set4',lists:flatten(Bytes46)), - - - ?line {ok,Bytes47} = - asn1_wrapper:encode('SetOf','Set4',#'Set4'{set43 = [#'SetIn'{boolIn = true, - intIn = 25}, - #'SetIn'{boolIn = false, - intIn = 125}, - #'SetIn'{boolIn = false, - intIn = 225}]}), - ?line {ok,{'Set4',[],[],[{'SetIn',true,25},{'SetIn',false,125},{'SetIn',false,225}]}} = - asn1_wrapper:decode('SetOf','Set4',lists:flatten(Bytes47)), - - - - - ?line {ok,Bytes51} = asn1_wrapper:encode('SetOf','SetOs',["First","Second","Third"]), - ?line {ok,["First","Second","Third"]} = - asn1_wrapper:decode('SetOf','SetOs',lists:flatten(Bytes51)), - - ?line {ok,Bytes52} = asn1_wrapper:encode('SetOf','SetOsImp',["First","Second","Third"]), - ?line {ok,["First","Second","Third"]} = - asn1_wrapper:decode('SetOf','SetOsImp',lists:flatten(Bytes52)), - - ?line {ok,Bytes53} = asn1_wrapper:encode('SetOf','SetOsExp',["First","Second","Third"]), - ?line {ok,["First","Second","Third"]} = - asn1_wrapper:decode('SetOf','SetOsExp',lists:flatten(Bytes53)), - - - - - - - - ?line {ok,Bytes71} = asn1_wrapper:encode('SetOf','SetEmp',#'SetEmp'{set1 = [#'Empty'{}]}), - ?line {ok,{'SetEmp',[{'Empty'}]}} = asn1_wrapper:decode('SetOf','SetEmp',lists:flatten(Bytes71)), - ok. +roundtrip(T, V) -> + roundtrip(T, V, V). + +roundtrip(Type, Value, ExpectedValue) -> + asn1_test_lib:roundtrip('SetOf', Type, Value, ExpectedValue). diff --git a/lib/asn1/test/testSetOfCho.erl b/lib/asn1/test/testSetOfCho.erl index c89bf9596e..09c075e468 100644 --- a/lib/asn1/test/testSetOfCho.erl +++ b/lib/asn1/test/testSetOfCho.erl @@ -30,120 +30,46 @@ -record('SetOfChoEmbDef_SETOF',{bool1, int1, set1 = asn1_DEFAULT}). -record('SetOfChoEmbOpt_SETOF',{bool1, int1, set1 = asn1_NOVALUE}). +main(_Rules) -> + roundtrip('SetChoDef', + #'SetChoDef'{bool1=true,int1=17,set1=asn1_DEFAULT}, + #'SetChoDef'{bool1=true,int1=17,set1=[]}), + roundtrip('SetChoDef', + #'SetChoDef'{bool1=true,int1=17,set1=[{boolIn,true},{intIn,25}]}), + roundtrip('SetChoOpt', + #'SetChoOpt'{bool1=true,int1=17,set1=asn1_NOVALUE}), + roundtrip('SetChoOpt', + #'SetChoOpt'{bool1=true,int1=17,set1=[{boolIn,true},{intIn,25}]}), + roundtrip('SetChoEmbDef', + #'SetChoEmbDef'{bool1=true,int1=17,set1=asn1_DEFAULT}, + #'SetChoEmbDef'{bool1=true,int1=17,set1=[]}), + roundtrip('SetChoEmbDef', + #'SetChoEmbDef'{bool1=true,int1=17, + set1=[{boolIn,true},{intIn,25}]}), + roundtrip('SetChoEmbOpt', + #'SetChoEmbOpt'{bool1=true,int1=17,set1=asn1_NOVALUE}), + roundtrip('SetChoEmbOpt', + #'SetChoEmbOpt'{bool1=true,int1=17, + set1=[{boolIn,true},{intIn,25}]}), + + roundtrip('SetOfChoEmbDef', + [#'SetOfChoEmbDef_SETOF'{bool1=true,int1=17,set1=asn1_DEFAULT}], + [#'SetOfChoEmbDef_SETOF'{bool1=true,int1=17,set1=[]}]), + roundtrip('SetOfChoEmbDef', + [#'SetOfChoEmbDef_SETOF'{bool1=true,int1=17, + set1=[{boolIn,true},{intIn,25}]}]), + + roundtrip('SetOfChoEmbOpt', + [#'SetOfChoEmbOpt_SETOF'{bool1=true,int1=17,set1=asn1_NOVALUE}]), + roundtrip('SetOfChoEmbOpt', + [#'SetOfChoEmbOpt_SETOF'{bool1=true,int1=17, + set1=[{boolIn,true},{intIn,25}]}]), -main(_Rules) -> - - ?line {ok,Bytes11} = - asn1_wrapper:encode('SetOfCho','SetChoDef',#'SetChoDef'{bool1 = true, - int1 = 17}), - ?line {ok,{'SetChoDef',true,17,[]}} = - asn1_wrapper:decode('SetOfCho','SetChoDef',lists:flatten(Bytes11)), - - - ?line {ok,Bytes12} = - asn1_wrapper:encode('SetOfCho','SetChoDef',#'SetChoDef'{bool1 = true, - int1 = 17, - set1 = [{boolIn,true}, - {intIn,25}]}), - ?line {ok,{'SetChoDef',true,17,[{boolIn,true},{intIn,25}]}} = - asn1_wrapper:decode('SetOfCho','SetChoDef',lists:flatten(Bytes12)), - - - - ?line {ok,Bytes15} = - asn1_wrapper:encode('SetOfCho','SetChoOpt',#'SetChoOpt'{bool1 = true, - int1 = 17}), - ?line {ok,{'SetChoOpt',true,17,asn1_NOVALUE}} = - asn1_wrapper:decode('SetOfCho','SetChoOpt',lists:flatten(Bytes15)), - - - ?line {ok,Bytes16} = - asn1_wrapper:encode('SetOfCho','SetChoOpt',#'SetChoOpt'{bool1 = true, - int1 = 17, - set1 = [{boolIn,true}, - {intIn,25}]}), - ?line {ok,{'SetChoOpt',true,17,[{boolIn,true},{intIn,25}]}} = - asn1_wrapper:decode('SetOfCho','SetChoOpt',lists:flatten(Bytes16)), - - - - - - ?line {ok,Bytes21} = - asn1_wrapper:encode('SetOfCho','SetChoEmbDef',#'SetChoEmbDef'{bool1 = true, - int1 = 17}), - ?line {ok,{'SetChoEmbDef',true,17,[]}} = - asn1_wrapper:decode('SetOfCho','SetChoEmbDef',lists:flatten(Bytes21)), - - - ?line {ok,Bytes22} = - asn1_wrapper:encode('SetOfCho','SetChoEmbDef',#'SetChoEmbDef'{bool1 = true, - int1 = 17, - set1 = [{boolIn,true}, - {intIn,25}]}), - ?line {ok,{'SetChoEmbDef',true,17,[{boolIn,true},{intIn,25}]}} = - asn1_wrapper:decode('SetOfCho','SetChoEmbDef',lists:flatten(Bytes22)), - - - - ?line {ok,Bytes25} = - asn1_wrapper:encode('SetOfCho','SetChoEmbOpt',#'SetChoEmbOpt'{bool1 = true, - int1 = 17}), - ?line {ok,{'SetChoEmbOpt',true,17,asn1_NOVALUE}} = - asn1_wrapper:decode('SetOfCho','SetChoEmbOpt',lists:flatten(Bytes25)), - - - ?line {ok,Bytes26} = - asn1_wrapper:encode('SetOfCho','SetChoEmbOpt',#'SetChoEmbOpt'{bool1 = true, - int1 = 17, - set1 = [{boolIn,true}, - {intIn,25}]}), - ?line {ok,{'SetChoEmbOpt',true,17,[{boolIn,true},{intIn,25}]}} = - asn1_wrapper:decode('SetOfCho','SetChoEmbOpt',lists:flatten(Bytes26)), - - - - - - - ?line {ok,Bytes31} = - asn1_wrapper:encode('SetOfCho','SetOfChoEmbDef',[#'SetOfChoEmbDef_SETOF'{bool1 = true, - int1 = 17}]), - ?line {ok,[{'SetOfChoEmbDef_SETOF',true,17,[]}]} = - asn1_wrapper:decode('SetOfCho','SetOfChoEmbDef',lists:flatten(Bytes31)), - - - ?line {ok,Bytes32} = - asn1_wrapper:encode('SetOfCho','SetOfChoEmbDef', - [#'SetOfChoEmbDef_SETOF'{bool1 = true, - int1 = 17, - set1 = [{boolIn,true}, - {intIn,25}]}]), - ?line {ok,[{'SetOfChoEmbDef_SETOF',true,17,[{boolIn,true},{intIn,25}]}]} = - asn1_wrapper:decode('SetOfCho','SetOfChoEmbDef',lists:flatten(Bytes32)), - - - - ?line {ok,Bytes35} = - asn1_wrapper:encode('SetOfCho','SetOfChoEmbOpt',[#'SetOfChoEmbOpt_SETOF'{bool1 = true, - int1 = 17}]), - ?line {ok,[{'SetOfChoEmbOpt_SETOF',true,17,asn1_NOVALUE}]} = - asn1_wrapper:decode('SetOfCho','SetOfChoEmbOpt',lists:flatten(Bytes35)), - - - ?line {ok,Bytes36} = - asn1_wrapper:encode('SetOfCho','SetOfChoEmbOpt', - [#'SetOfChoEmbOpt_SETOF'{bool1 = true, - int1 = 17, - set1 = [{boolIn,true}, - {intIn,25}]}]), - ?line {ok,[{'SetOfChoEmbOpt_SETOF',true,17,[{boolIn,true},{intIn,25}]}]} = - asn1_wrapper:decode('SetOfCho','SetOfChoEmbOpt',lists:flatten(Bytes36)), - - - - ok. +roundtrip(T, V) -> + roundtrip(T, V, V). +roundtrip(Type, Value, ExpectedValue) -> + asn1_test_lib:roundtrip('SetOfCho', Type, Value, ExpectedValue). diff --git a/lib/asn1/test/testSetOfExternal.erl b/lib/asn1/test/testSetOfExternal.erl index 6b280a2595..a380ba5ac1 100644 --- a/lib/asn1/test/testSetOfExternal.erl +++ b/lib/asn1/test/testSetOfExternal.erl @@ -18,8 +18,6 @@ %% %% -module(testSetOfExternal). - - -export([main/1]). -include_lib("test_server/include/test_server.hrl"). @@ -29,133 +27,26 @@ -record('Imp',{os, bool}). -record('Exp',{os, bool}). - - main(_Rules) -> - - ?line {ok,Bytes11} = - asn1_wrapper:encode('SetOfExternal','NTNT',[#'NT'{bool = true, os = "kalle"}, - #'NT'{bool = true, os = "kalle"}]), - ?line {ok,[{'NT',[107,97,108,108,101],true},{'NT',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SetOfExternal','NTNT',lists:flatten(Bytes11)), - - ?line {ok,Bytes12} = - asn1_wrapper:encode('SetOfExternal','ImpNT',[#'NT'{bool = true, os = "kalle"}, - #'NT'{bool = true, os = "kalle"}]), - ?line {ok,[{'NT',[107,97,108,108,101],true},{'NT',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SetOfExternal','ImpNT',lists:flatten(Bytes12)), - - ?line {ok,Bytes13} = - asn1_wrapper:encode('SetOfExternal','ExpNT',[#'NT'{bool = true, os = "kalle"}, - #'NT'{bool = true, os = "kalle"}]), - ?line {ok,[{'NT',[107,97,108,108,101],true},{'NT',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SetOfExternal','ExpNT',lists:flatten(Bytes13)), - - - - ?line {ok,Bytes21} = - asn1_wrapper:encode('SetOfExternal','NTImp',[#'Imp'{bool = true, os = "kalle"}, - #'Imp'{bool = true, os = "kalle"}]), - ?line {ok,[{'Imp',[107,97,108,108,101],true},{'Imp',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SetOfExternal','NTImp',lists:flatten(Bytes21)), - - ?line {ok,Bytes22} = - asn1_wrapper:encode('SetOfExternal','ImpImp',[#'Imp'{bool = true, os = "kalle"}, - #'Imp'{bool = true, os = "kalle"}]), - ?line {ok,[{'Imp',[107,97,108,108,101],true},{'Imp',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SetOfExternal','ImpImp',lists:flatten(Bytes22)), - - ?line {ok,Bytes23} = - asn1_wrapper:encode('SetOfExternal','ExpImp',[#'Imp'{bool = true, os = "kalle"}, - #'Imp'{bool = true, os = "kalle"}]), - ?line {ok,[{'Imp',[107,97,108,108,101],true},{'Imp',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SetOfExternal','ExpImp',lists:flatten(Bytes23)), - - - - ?line {ok,Bytes31} = - asn1_wrapper:encode('SetOfExternal','NTExp',[#'Exp'{bool = true, os = "kalle"}, - #'Exp'{bool = true, os = "kalle"}]), - ?line {ok,[{'Exp',[107,97,108,108,101],true},{'Exp',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SetOfExternal','NTExp',lists:flatten(Bytes31)), - - ?line {ok,Bytes32} = - asn1_wrapper:encode('SetOfExternal','ImpExp',[#'Exp'{bool = true, os = "kalle"}, - #'Exp'{bool = true, os = "kalle"}]), - ?line {ok,[{'Exp',[107,97,108,108,101],true},{'Exp',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SetOfExternal','ImpExp',lists:flatten(Bytes32)), - - ?line {ok,Bytes33} = - asn1_wrapper:encode('SetOfExternal','ExpExp',[#'Exp'{bool = true, os = "kalle"}, - #'Exp'{bool = true, os = "kalle"}]), - ?line {ok,[{'Exp',[107,97,108,108,101],true},{'Exp',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SetOfExternal','ExpExp',lists:flatten(Bytes33)), - - - - - - - - ?line {ok,Bytes41} = - asn1_wrapper:encode('SetOfExternal','XNTNT',[#'XSetNT'{bool = true, os = "kalle"}, - #'XSetNT'{bool = true, os = "kalle"}]), - ?line {ok,[{'XSetNT',[107,97,108,108,101],true},{'XSetNT',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SetOfExternal','XNTNT',lists:flatten(Bytes41)), - - ?line {ok,Bytes42} = - asn1_wrapper:encode('SetOfExternal','XImpNT',[#'XSetNT'{bool = true, os = "kalle"}, - #'XSetNT'{bool = true, os = "kalle"}]), - ?line {ok,[{'XSetNT',[107,97,108,108,101],true},{'XSetNT',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SetOfExternal','XImpNT',lists:flatten(Bytes42)), - - ?line {ok,Bytes43} = - asn1_wrapper:encode('SetOfExternal','XExpNT',[#'XSetNT'{bool = true, os = "kalle"}, - #'XSetNT'{bool = true, os = "kalle"}]), - ?line {ok,[{'XSetNT',[107,97,108,108,101],true},{'XSetNT',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SetOfExternal','XExpNT',lists:flatten(Bytes43)), - - - - ?line {ok,Bytes51} = - asn1_wrapper:encode('SetOfExternal','XNTImp',[#'XSetImp'{bool = true, os = "kalle"}, - #'XSetImp'{bool = true, os = "kalle"}]), - ?line {ok,[{'XSetImp',[107,97,108,108,101],true},{'XSetImp',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SetOfExternal','XNTImp',lists:flatten(Bytes51)), - - ?line {ok,Bytes52} = - asn1_wrapper:encode('SetOfExternal','XImpImp',[#'XSetImp'{bool = true, os = "kalle"}, - #'XSetImp'{bool = true, os = "kalle"}]), - ?line {ok,[{'XSetImp',[107,97,108,108,101],true},{'XSetImp',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SetOfExternal','XImpImp',lists:flatten(Bytes52)), - - ?line {ok,Bytes53} = - asn1_wrapper:encode('SetOfExternal','XExpImp',[#'XSetImp'{bool = true, os = "kalle"}, - #'XSetImp'{bool = true, os = "kalle"}]), - ?line {ok,[{'XSetImp',[107,97,108,108,101],true},{'XSetImp',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SetOfExternal','XExpImp',lists:flatten(Bytes53)), - - - - ?line {ok,Bytes61} = - asn1_wrapper:encode('SetOfExternal','XNTExp',[#'XSetExp'{bool = true, os = "kalle"}, - #'XSetExp'{bool = true, os = "kalle"}]), - ?line {ok,[{'XSetExp',[107,97,108,108,101],true},{'XSetExp',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SetOfExternal','XNTExp',lists:flatten(Bytes61)), - - ?line {ok,Bytes62} = - asn1_wrapper:encode('SetOfExternal','XImpExp',[#'XSetExp'{bool = true, os = "kalle"}, - #'XSetExp'{bool = true, os = "kalle"}]), - ?line {ok,[{'XSetExp',[107,97,108,108,101],true},{'XSetExp',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SetOfExternal','XImpExp',lists:flatten(Bytes62)), - - ?line {ok,Bytes63} = - asn1_wrapper:encode('SetOfExternal','XExpExp',[#'XSetExp'{bool = true, os = "kalle"}, - #'XSetExp'{bool = true, os = "kalle"}]), - ?line {ok,[{'XSetExp',[107,97,108,108,101],true},{'XSetExp',[107,97,108,108,101],true}]} = - asn1_wrapper:decode('SetOfExternal','XExpExp',lists:flatten(Bytes63)), - - - - + roundtrip('NTNT', [#'NT'{os="kalle",bool=true},#'NT'{os="kalle",bool=true}]), + roundtrip('ImpNT', [#'NT'{os="kalle",bool=true},#'NT'{os="kalle",bool=true}]), + roundtrip('ExpNT', [#'NT'{os="kalle",bool=true},#'NT'{os="kalle",bool=true}]), + roundtrip('NTImp', [#'Imp'{os="kalle",bool=true},#'Imp'{os="kalle",bool=true}]), + roundtrip('ImpImp', [#'Imp'{os="kalle",bool=true},#'Imp'{os="kalle",bool=true}]), + roundtrip('ExpImp', [#'Imp'{os="kalle",bool=true},#'Imp'{os="kalle",bool=true}]), + roundtrip('NTExp', [#'Exp'{os="kalle",bool=true},#'Exp'{os="kalle",bool=true}]), + roundtrip('ImpExp', [#'Exp'{os="kalle",bool=true},#'Exp'{os="kalle",bool=true}]), + roundtrip('ExpExp', [#'Exp'{os="kalle",bool=true},#'Exp'{os="kalle",bool=true}]), + roundtrip('XNTNT', [#'XSetNT'{os="kalle",bool=true},#'XSetNT'{os="kalle",bool=true}]), + roundtrip('XImpNT', [#'XSetNT'{os="kalle",bool=true},#'XSetNT'{os="kalle",bool=true}]), + roundtrip('XExpNT', [#'XSetNT'{os="kalle",bool=true},#'XSetNT'{os="kalle",bool=true}]), + roundtrip('XNTImp', [#'XSetImp'{os="kalle",bool=true},#'XSetImp'{os="kalle",bool=true}]), + roundtrip('XImpImp', [#'XSetImp'{os="kalle",bool=true},#'XSetImp'{os="kalle",bool=true}]), + roundtrip('XExpImp', [#'XSetImp'{os="kalle",bool=true},#'XSetImp'{os="kalle",bool=true}]), + roundtrip('XNTExp', [#'XSetExp'{os="kalle",bool=true},#'XSetExp'{os="kalle",bool=true}]), + roundtrip('XImpExp', [#'XSetExp'{os="kalle",bool=true},#'XSetExp'{os="kalle",bool=true}]), + roundtrip('XExpExp', [#'XSetExp'{os="kalle",bool=true},#'XSetExp'{os="kalle",bool=true}]), ok. + +roundtrip(T, V) -> + asn1_test_lib:roundtrip('SetOfExternal', T, V). diff --git a/lib/asn1/test/testSetOfTag.erl b/lib/asn1/test/testSetOfTag.erl index 2c7a2f5473..81bc467abb 100644 --- a/lib/asn1/test/testSetOfTag.erl +++ b/lib/asn1/test/testSetOfTag.erl @@ -18,14 +18,11 @@ %% %% -module(testSetOfTag). - - -export([main/1]). -include_lib("test_server/include/test_server.hrl"). -include("External.hrl"). - -record('SetTagNt',{nt}). -record('SetTagNtI',{imp}). -record('SetTagNtE',{exp}). @@ -44,148 +41,44 @@ -record('Imp',{os, bool}). -record('Exp',{os, bool}). - - main(_Rules) -> - - ?line {ok,Bytes11} = - asn1_wrapper:encode('SetOfTag','SetTagNt', - #'SetTagNt'{nt = [#'NT'{bool = true, os = "kalle"}, - #'NT'{bool = true, os = "kalle"}]}), - ?line {ok,{'SetTagNt', - [{'NT',[107,97,108,108,101],true},{'NT',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SetOfTag','SetTagNt',lists:flatten(Bytes11)), - - ?line {ok,Bytes12} = - asn1_wrapper:encode('SetOfTag','SetTagNtI', - #'SetTagNtI'{imp = [#'Imp'{bool = true, os = "kalle"}, - #'Imp'{bool = true, os = "kalle"}]}), - ?line {ok,{'SetTagNtI', - [{'Imp',[107,97,108,108,101],true},{'Imp',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SetOfTag','SetTagNtI',lists:flatten(Bytes12)), - - ?line {ok,Bytes13} = - asn1_wrapper:encode('SetOfTag','SetTagNtE', - #'SetTagNtE'{exp = [#'Exp'{bool = true, os = "kalle"}, - #'Exp'{bool = true, os = "kalle"}]}), - ?line {ok,{'SetTagNtE', - [{'Exp',[107,97,108,108,101],true},{'Exp',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SetOfTag','SetTagNtE',lists:flatten(Bytes13)), - - - - ?line {ok,Bytes21} = - asn1_wrapper:encode('SetOfTag','SetTagI', - #'SetTagI'{nt = [#'NT'{bool = true, os = "kalle"}, - #'NT'{bool = true, os = "kalle"}]}), - ?line {ok,{'SetTagI', - [{'NT',[107,97,108,108,101],true},{'NT',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SetOfTag','SetTagI',lists:flatten(Bytes21)), - - ?line {ok,Bytes22} = - asn1_wrapper:encode('SetOfTag','SetTagII', - #'SetTagII'{imp = [#'Imp'{bool = true, os = "kalle"}, - #'Imp'{bool = true, os = "kalle"}]}), - ?line {ok,{'SetTagII', - [{'Imp',[107,97,108,108,101],true},{'Imp',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SetOfTag','SetTagII',lists:flatten(Bytes22)), - - ?line {ok,Bytes23} = - asn1_wrapper:encode('SetOfTag','SetTagIE', - #'SetTagIE'{exp = [#'Exp'{bool = true, os = "kalle"}, - #'Exp'{bool = true, os = "kalle"}]}), - ?line {ok,{'SetTagIE', - [{'Exp',[107,97,108,108,101],true},{'Exp',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SetOfTag','SetTagIE',lists:flatten(Bytes23)), - - - - ?line {ok,Bytes31} = - asn1_wrapper:encode('SetOfTag','SetTagE', - #'SetTagE'{nt = [#'NT'{bool = true, os = "kalle"}, - #'NT'{bool = true, os = "kalle"}]}), - ?line {ok,{'SetTagE', - [{'NT',[107,97,108,108,101],true},{'NT',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SetOfTag','SetTagE',lists:flatten(Bytes31)), - - ?line {ok,Bytes32} = - asn1_wrapper:encode('SetOfTag','SetTagEI', - #'SetTagEI'{imp = [#'Imp'{bool = true, os = "kalle"}, - #'Imp'{bool = true, os = "kalle"}]}), - ?line {ok,{'SetTagEI', - [{'Imp',[107,97,108,108,101],true},{'Imp',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SetOfTag','SetTagEI',lists:flatten(Bytes32)), - - ?line {ok,Bytes33} = - asn1_wrapper:encode('SetOfTag','SetTagEE', - #'SetTagEE'{exp = [#'Exp'{bool = true, os = "kalle"}, - #'Exp'{bool = true, os = "kalle"}]}), - ?line {ok,{'SetTagEE', - [{'Exp',[107,97,108,108,101],true},{'Exp',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SetOfTag','SetTagEE',lists:flatten(Bytes33)), - - - - - - - - ?line {ok,Bytes41} = - asn1_wrapper:encode('SetOfTag','SetTagXNt', - #'SetTagXNt'{xnt = [#'XSetNT'{bool = true, os = "kalle"}, - #'XSetNT'{bool = true, os = "kalle"}]}), - ?line {ok,{'SetTagXNt', - [{'XSetNT',[107,97,108,108,101],true},{'XSetNT',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SetOfTag','SetTagXNt',lists:flatten(Bytes41)), - - ?line {ok,Bytes42} = - asn1_wrapper:encode('SetOfTag','SetTagXI', - #'SetTagXI'{ximp = [#'XSetImp'{bool = true, os = "kalle"}, - #'XSetImp'{bool = true, os = "kalle"}]}), - ?line {ok,{'SetTagXI', - [{'XSetImp',[107,97,108,108,101],true},{'XSetImp',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SetOfTag','SetTagXI',lists:flatten(Bytes42)), - - ?line {ok,Bytes43} = - asn1_wrapper:encode('SetOfTag','SetTagXE', - #'SetTagXE'{xexp = [#'XSetExp'{bool = true, os = "kalle"}, - #'XSetExp'{bool = true, os = "kalle"}]}), - ?line {ok,{'SetTagXE', - [{'XSetExp',[107,97,108,108,101],true},{'XSetExp',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SetOfTag','SetTagXE',lists:flatten(Bytes43)), - - - - - - ?line {ok,Bytes51} = - asn1_wrapper:encode('SetOfTag','SetTagImpX', - #'SetTagImpX'{xnt = [#'XSetNT'{bool = true, os = "kalle"}, - #'XSetNT'{bool = true, os = "kalle"}], - ximp = [#'XSetImp'{bool = true, os = "kalle"}, - #'XSetImp'{bool = true, os = "kalle"}], - xexp = [#'XSetExp'{bool = true, os = "kalle"}, - #'XSetExp'{bool = true, os = "kalle"}]}), - ?line {ok,{'SetTagImpX', - [{'XSetNT',[107,97,108,108,101],true},{'XSetNT',[107,97,108,108,101],true}], - [{'XSetImp',[107,97,108,108,101],true},{'XSetImp',[107,97,108,108,101],true}], - [{'XSetExp',[107,97,108,108,101],true},{'XSetExp',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SetOfTag','SetTagImpX',lists:flatten(Bytes51)), - - - - ?line {ok,Bytes52} = - asn1_wrapper:encode('SetOfTag','SetTagExpX', - #'SetTagExpX'{xnt = [#'XSetNT'{bool = true, os = "kalle"}, - #'XSetNT'{bool = true, os = "kalle"}], - ximp = [#'XSetImp'{bool = true, os = "kalle"}, - #'XSetImp'{bool = true, os = "kalle"}], - xexp = [#'XSetExp'{bool = true, os = "kalle"}, - #'XSetExp'{bool = true, os = "kalle"}]}), - ?line {ok,{'SetTagExpX', - [{'XSetNT',[107,97,108,108,101],true},{'XSetNT',[107,97,108,108,101],true}], - [{'XSetImp',[107,97,108,108,101],true},{'XSetImp',[107,97,108,108,101],true}], - [{'XSetExp',[107,97,108,108,101],true},{'XSetExp',[107,97,108,108,101],true}]}} = - asn1_wrapper:decode('SetOfTag','SetTagExpX',lists:flatten(Bytes52)), - + roundtrip('SetTagNt', #'SetTagNt'{nt=[#'NT'{os="kalle",bool=true}, + #'NT'{os="kalle",bool=true}]}), + roundtrip('SetTagNtI', #'SetTagNtI'{imp=[#'Imp'{os="kalle",bool=true}, + #'Imp'{os="kalle",bool=true}]}), + roundtrip('SetTagNtE', #'SetTagNtE'{exp=[#'Exp'{os="kalle",bool=true}, + #'Exp'{os="kalle",bool=true}]}), + roundtrip('SetTagI', #'SetTagI'{nt=[#'NT'{os="kalle",bool=true}, + #'NT'{os="kalle",bool=true}]}), + roundtrip('SetTagII', #'SetTagII'{imp=[#'Imp'{os="kalle",bool=true}, + #'Imp'{os="kalle",bool=true}]}), + roundtrip('SetTagIE', #'SetTagIE'{exp=[#'Exp'{os="kalle",bool=true}, + #'Exp'{os="kalle",bool=true}]}), + roundtrip('SetTagE', #'SetTagE'{nt=[#'NT'{os="kalle",bool=true}, + #'NT'{os="kalle",bool=true}]}), + roundtrip('SetTagEI', #'SetTagEI'{imp=[#'Imp'{os="kalle",bool=true}, + #'Imp'{os="kalle",bool=true}]}), + roundtrip('SetTagEE', #'SetTagEE'{exp=[#'Exp'{os="kalle",bool=true}, + #'Exp'{os="kalle",bool=true}]}), + roundtrip('SetTagXNt', #'SetTagXNt'{xnt=[#'XSetNT'{os="kalle",bool=true}, + #'XSetNT'{os="kalle",bool=true}]}), + roundtrip('SetTagXI', #'SetTagXI'{ximp=[#'XSetImp'{os="kalle",bool=true}, + #'XSetImp'{os="kalle",bool=true}]}), + roundtrip('SetTagXE', #'SetTagXE'{xexp=[#'XSetExp'{os="kalle",bool=true}, + #'XSetExp'{os="kalle",bool=true}]}), + roundtrip('SetTagImpX', #'SetTagImpX'{xnt=[#'XSetNT'{os="kalle",bool=true}, + #'XSetNT'{os="kalle",bool=true}], + ximp=[#'XSetImp'{os="kalle",bool=true}, + #'XSetImp'{os="kalle",bool=true}], + xexp=[#'XSetExp'{os="kalle",bool=true}, + #'XSetExp'{os="kalle",bool=true}]}), + roundtrip('SetTagExpX', #'SetTagExpX'{xnt=[#'XSetNT'{os="kalle",bool=true}, + #'XSetNT'{os="kalle",bool=true}], + ximp=[#'XSetImp'{os="kalle",bool=true}, + #'XSetImp'{os="kalle",bool=true}], + xexp=[#'XSetExp'{os="kalle",bool=true}, + #'XSetExp'{os="kalle",bool=true}]}), ok. + +roundtrip(T, V) -> + asn1_test_lib:roundtrip('SetOfTag', T, V). diff --git a/lib/asn1/test/testSetOptional.erl b/lib/asn1/test/testSetOptional.erl index bb43ff0a96..eb095fd480 100644 --- a/lib/asn1/test/testSetOptional.erl +++ b/lib/asn1/test/testSetOptional.erl @@ -93,6 +93,4 @@ ticket_7533(_) -> ok. roundtrip(Type, Value) -> - {ok,Encoded} = 'SetOptional':encode(Type, Value), - {ok,Value} = 'SetOptional':decode(Type, Encoded), - ok. + asn1_test_lib:roundtrip('SetOptional', Type, Value). diff --git a/lib/asn1/test/testSetPrim.erl b/lib/asn1/test/testSetPrim.erl index 3234b65135..f417f343a7 100644 --- a/lib/asn1/test/testSetPrim.erl +++ b/lib/asn1/test/testSetPrim.erl @@ -27,59 +27,17 @@ -record('Empty',{}). main(_Rules) -> - - - - ?line {ok,Bytes11} = - asn1_wrapper:encode('SetPrim','Set',#'Set'{bool = true, - boolCon = true, - boolPri = true, - boolApp = true, - boolExpCon = true, - boolExpPri = true, - boolExpApp = true}), - ?line {ok,{'Set',true,true,true,true,true,true,true}} = - asn1_wrapper:decode('SetPrim','Set',lists:flatten(Bytes11)), - - - - - ?line {ok,Bytes12} = - asn1_wrapper:encode('SetPrim','Set',#'Set'{bool = false, - boolCon = false, - boolPri = false, - boolApp = false, - boolExpCon = false, - boolExpPri = false, - boolExpApp = false}), - ?line {ok,{'Set',false,false,false,false,false,false,false}} = - asn1_wrapper:decode('SetPrim','Set',lists:flatten(Bytes12)), - - - - - ?line {ok,Bytes13} = - asn1_wrapper:encode('SetPrim','Set',#'Set'{bool = false, - boolCon = true, - boolPri = false, - boolApp = true, - boolExpCon = false, - boolExpPri = true, - boolExpApp = false}), - ?line {ok,{'Set',false,true,false,true,false,true,false}} = - asn1_wrapper:decode('SetPrim','Set',lists:flatten(Bytes13)), - - - - - - ?line {ok,Bytes21} = - asn1_wrapper:encode('SetPrim','Empty',#'Empty'{}), - ?line {ok,{'Empty'}} = - asn1_wrapper:decode('SetPrim','Empty',lists:flatten(Bytes21)), - - - + roundtrip('Set', + #'Set'{bool=true,boolCon=true,boolPri=true,boolApp=true, + boolExpCon=true,boolExpPri=true,boolExpApp=true}), + roundtrip('Set', + #'Set'{bool=false,boolCon=false,boolPri=false,boolApp=false, + boolExpCon=false,boolExpPri=false,boolExpApp=false}), + roundtrip('Set', + #'Set'{bool=false,boolCon=true,boolPri=false,boolApp=true, + boolExpCon=false,boolExpPri=true,boolExpApp=false}), + roundtrip('Empty', #'Empty'{}), ok. - +roundtrip(T, V) -> + asn1_test_lib:roundtrip('SetPrim', T, V). diff --git a/lib/asn1/test/testSetTag.erl b/lib/asn1/test/testSetTag.erl index 8b9364d603..5863a149b9 100644 --- a/lib/asn1/test/testSetTag.erl +++ b/lib/asn1/test/testSetTag.erl @@ -18,7 +18,6 @@ %% %% -module(testSetTag). - -export([main/1]). -include_lib("test_server/include/test_server.hrl"). @@ -35,69 +34,25 @@ -record('Exp',{os, bool}). main(_Rules) -> - - - ?line {ok,Bytes11} = - asn1_wrapper:encode('SetTag','SetTag',#'SetTag'{nt = #'NT'{bool = true, os = "kalle"}, - imp = #'Imp'{bool = true, os = "kalle"}, - exp = #'Exp'{bool = true, os = "kalle"}}), - ?line {ok,{'SetTag',{'NT',"kalle",true},{'Imp',"kalle",true},{'Exp',"kalle",true}}} = - asn1_wrapper:decode('SetTag','SetTag',lists:flatten(Bytes11)), - - - ?line {ok,Bytes12} = - asn1_wrapper:encode('SetTag','SetTagImp',#'SetTagImp'{nt = #'NT'{bool = true, os = "kalle"}, - imp = #'Imp'{bool = true, os = "kalle"}, - exp = #'Exp'{bool = true, os = "kalle"}}), - ?line {ok,{'SetTagImp',{'NT',"kalle",true},{'Imp',"kalle",true},{'Exp',"kalle",true}}} = - asn1_wrapper:decode('SetTag','SetTagImp',lists:flatten(Bytes12)), - - - ?line {ok,Bytes13} = - asn1_wrapper:encode('SetTag','SetTagExp',#'SetTagExp'{nt = #'NT'{bool = true, os = "kalle"}, - imp = #'Imp'{bool = true, os = "kalle"}, - exp = #'Exp'{bool = true, os = "kalle"}}), - ?line {ok,{'SetTagExp',{'NT',"kalle",true},{'Imp',"kalle",true},{'Exp',"kalle",true}}} = - asn1_wrapper:decode('SetTag','SetTagExp',lists:flatten(Bytes13)), - - - - - - ?line {ok,Bytes21} = - asn1_wrapper:encode('SetTag','SetTagX', - #'SetTagX'{xnt = #'XSetNT'{bool = true, os = "kalle"}, - ximp = #'XSetImp'{bool = true, os = "kalle"}, - xexp = #'XSetExp'{bool = true, os = "kalle"}}), - ?line {ok,{'SetTagX',{'XSetNT',"kalle",true}, - {'XSetImp',"kalle",true}, - {'XSetExp',"kalle",true}}} = - asn1_wrapper:decode('SetTag','SetTagX',lists:flatten(Bytes21)), - - - ?line {ok,Bytes22} = - asn1_wrapper:encode('SetTag','SetTagImpX', - #'SetTagImpX'{xnt = #'XSetNT'{bool = true, os = "kalle"}, - ximp = #'XSetImp'{bool = true, os = "kalle"}, - xexp = #'XSetExp'{bool = true, os = "kalle"}}), - ?line {ok,{'SetTagImpX',{'XSetNT',"kalle",true}, - {'XSetImp',"kalle",true}, - {'XSetExp',"kalle",true}}} = - asn1_wrapper:decode('SetTag','SetTagImpX',lists:flatten(Bytes22)), - - - ?line {ok,Bytes23} = - asn1_wrapper:encode('SetTag','SetTagExpX', - #'SetTagExpX'{xnt = #'XSetNT'{bool = true, os = "kalle"}, - ximp = #'XSetImp'{bool = true, os = "kalle"}, - xexp = #'XSetExp'{bool = true, os = "kalle"}}), - ?line {ok,{'SetTagExpX',{'XSetNT',"kalle",true}, - {'XSetImp',"kalle",true}, - {'XSetExp',"kalle",true}}} = - asn1_wrapper:decode('SetTag','SetTagExpX',lists:flatten(Bytes23)), - - - - - + roundtrip('SetTag', #'SetTag'{nt=#'NT'{os="kalle",bool=true}, + imp=#'Imp'{os="kalle",bool=true}, + exp=#'Exp'{os="kalle",bool=true}}), + roundtrip('SetTagImp', #'SetTagImp'{nt=#'NT'{os="kalle",bool=true}, + imp=#'Imp'{os="kalle",bool=true}, + exp=#'Exp'{os="kalle",bool=true}}), + roundtrip('SetTagExp', #'SetTagExp'{nt=#'NT'{os="kalle",bool=true}, + imp=#'Imp'{os="kalle",bool=true}, + exp=#'Exp'{os="kalle",bool=true}}), + roundtrip('SetTagX', #'SetTagX'{xnt=#'XSetNT'{os="kalle",bool=true}, + ximp=#'XSetImp'{os="kalle",bool=true}, + xexp=#'XSetExp'{os="kalle",bool=true}}), + roundtrip('SetTagImpX', #'SetTagImpX'{xnt=#'XSetNT'{os="kalle",bool=true}, + ximp=#'XSetImp'{os="kalle",bool=true}, + xexp=#'XSetExp'{os="kalle",bool=true}}), + roundtrip('SetTagExpX', #'SetTagExpX'{xnt=#'XSetNT'{os="kalle",bool=true}, + ximp=#'XSetImp'{os="kalle",bool=true}, + xexp=#'XSetExp'{os="kalle",bool=true}}), ok. + +roundtrip(T, V) -> + asn1_test_lib:roundtrip('SetTag', T, V). diff --git a/lib/asn1/test/testSetTypeRefCho.erl b/lib/asn1/test/testSetTypeRefCho.erl index a0989926c7..8d62f45bfa 100644 --- a/lib/asn1/test/testSetTypeRefCho.erl +++ b/lib/asn1/test/testSetTypeRefCho.erl @@ -28,17 +28,12 @@ main(_Rules) -> - - - ?line {ok,Bytes11} = - asn1_wrapper:encode('SetTypeRefCho','SetTRcho', - #'SetTRcho'{'setCho' = {choOs,"A string 1"}, - 'setChoE' = {choOs,"A string 3"}, - 'setCho-E' = {choOs,"A string 7"}, - 'setChoE-E' = {choOs,"A string 9"}}), - ?line {ok,{'SetTRcho',{choOs,"A string 1"},{choOs,"A string 3"},{choOs,"A string 7"},{choOs,"A string 9"}}} = - asn1_wrapper:decode('SetTypeRefCho','SetTRcho',lists:flatten(Bytes11)), - - - + roundtrip('SetTRcho', + #'SetTRcho'{'setCho' = {choOs,"A string 1"}, + 'setChoE' = {choOs,"A string 3"}, + 'setCho-E' = {choOs,"A string 7"}, + 'setChoE-E' = {choOs,"A string 9"}}), ok. + +roundtrip(T, V) -> + asn1_test_lib:roundtrip('SetTypeRefCho', T, V). diff --git a/lib/asn1/test/testSetTypeRefPrim.erl b/lib/asn1/test/testSetTypeRefPrim.erl index 9c7fbd803e..cc2e157e68 100644 --- a/lib/asn1/test/testSetTypeRefPrim.erl +++ b/lib/asn1/test/testSetTypeRefPrim.erl @@ -27,21 +27,17 @@ main(_Rules) -> - - - ?line {ok,Bytes11} = - asn1_wrapper:encode('SetTypeRefPrim','SetTR',#'SetTR'{'octStr' = "A string 1", - 'octStrI' = "A string 2", - 'octStrE' = "A string 3", - 'octStr-I' = "A string 4", - 'octStrI-I' = "A string 5", - 'octStrE-I' = "A string 6", - 'octStr-E' = "A string 7", - 'octStrI-E' = "A string 8", - 'octStrE-E' = "A string 9"}), - ?line {ok,{'SetTR',"A string 1","A string 2","A string 3","A string 4","A string 5","A string 6","A string 7","A string 8","A string 9"}} = - asn1_wrapper:decode('SetTypeRefPrim','SetTR',lists:flatten(Bytes11)), - - - + roundtrip('SetTR', + #'SetTR'{'octStr' = "A string 1", + 'octStrI' = "A string 2", + 'octStrE' = "A string 3", + 'octStr-I' = "A string 4", + 'octStrI-I' = "A string 5", + 'octStrE-I' = "A string 6", + 'octStr-E' = "A string 7", + 'octStrI-E' = "A string 8", + 'octStrE-E' = "A string 9"}), ok. + +roundtrip(T, V) -> + asn1_test_lib:roundtrip('SetTypeRefPrim', T, V). diff --git a/lib/asn1/test/testSetTypeRefSeq.erl b/lib/asn1/test/testSetTypeRefSeq.erl index a3ef4b188d..17af5c2922 100644 --- a/lib/asn1/test/testSetTypeRefSeq.erl +++ b/lib/asn1/test/testSetTypeRefSeq.erl @@ -28,12 +28,8 @@ -record('SetSeqImp',{seqInt, seqOs}). -record('SetSeqExp',{seqInt, seqOs}). - - main(_Rules) -> - - ?line {ok,Bytes41} = - asn1_wrapper:encode('SetTypeRefSeq','SetTRseq', + roundtrip('SetTRseq', #'SetTRseq'{'setSeq' = #'SetSeq'{seqOs = "A1", seqInt = 2}, 'setSeqI' = #'SetSeq'{seqOs = "A2", @@ -52,15 +48,7 @@ main(_Rules) -> seqInt = 2}, 'setSeqE-E' = #'SetSeqExp'{seqOs = "A9", seqInt = 2}}), - ?line {ok,{'SetTRseq',{'SetSeq',2,"A1"}, - {'SetSeq',2,"A2"}, - {'SetSeq',2,"A3"}, - {'SetSeqImp',2,"A4"}, - {'SetSeqImp',2,"A5"}, - {'SetSeqImp',2,"A6"}, - {'SetSeqExp',2,"A7"}, - {'SetSeqExp',2,"A8"}, - {'SetSeqExp',2,"A9"}}} = - asn1_wrapper:decode('SetTypeRefSeq','SetTRseq',lists:flatten(Bytes41)), - ok. + +roundtrip(T, V) -> + asn1_test_lib:roundtrip('SetTypeRefSeq', T, V). diff --git a/lib/asn1/test/testSetTypeRefSet.erl b/lib/asn1/test/testSetTypeRefSet.erl index ce77316ef8..8786e0fb4d 100644 --- a/lib/asn1/test/testSetTypeRefSet.erl +++ b/lib/asn1/test/testSetTypeRefSet.erl @@ -46,131 +46,42 @@ main(_Rules) -> - - - ?line {ok,Bytes11} = - asn1_wrapper:encode('SetTypeRefSet','Set1',#'Set1'{bool1 = true, - int1 = 15, - set1 = #'SetIn'{boolIn = true, - intIn = 66}}), - ?line {ok,{'Set1',true,15,{'SetIn',true,66}}} = - asn1_wrapper:decode('SetTypeRefSet','Set1',lists:flatten(Bytes11)), - - - - ?line {ok,Bytes12} = - asn1_wrapper:encode('SetTypeRefSet','Set2',#'Set2'{set2 = #'SetIn'{boolIn = true, - intIn = 66}, - bool2 = true, - int2 = 15}), - ?line {ok,{'Set2',{'SetIn',true,66},true,15}} = - asn1_wrapper:decode('SetTypeRefSet','Set2',lists:flatten(Bytes12)), - - - ?line {ok,Bytes13} = - asn1_wrapper:encode('SetTypeRefSet','Set3',#'Set3'{bool3 = true, - set3 = #'SetIn'{boolIn = true, - intIn = 66}, - int3 = 15}), - ?line {ok,{'Set3',true,{'SetIn',true,66},15}} = - asn1_wrapper:decode('SetTypeRefSet','Set3',lists:flatten(Bytes13)), - - - - ?line {ok,Bytes14} = - asn1_wrapper:encode('SetTypeRefSet','Set4',#'Set4'{set41 = #'SetIn'{boolIn = true, - intIn = 66}, - set42 = #'SetIn'{boolIn = true, - intIn = 66}, - set43 = #'SetIn'{boolIn = true, - intIn = 66}}), - ?line {ok,{'Set4',{'SetIn',true,66},{'SetIn',true,66},{'SetIn',true,66}}} = - asn1_wrapper:decode('SetTypeRefSet','Set4',lists:flatten(Bytes14)), - - - - - - - - - ?line {ok,Bytes21} = - asn1_wrapper:encode('SetTypeRefSet','SetS1',#'SetS1'{boolS1 = true, - intS1 = 15, - setS1 = #'SetS1_setS1'{boolIn = true, - intIn = 66}}), - ?line {ok,{'SetS1',true,15,{'SetS1_setS1',true,66}}} = - asn1_wrapper:decode('SetTypeRefSet','SetS1',lists:flatten(Bytes21)), - - - ?line {ok,Bytes22} = - asn1_wrapper:encode('SetTypeRefSet','SetS2',#'SetS2'{setS2 = #'SetS2_setS2'{boolIn = true, - intIn = 66}, - boolS2 = true, - intS2 = 15}), - ?line {ok,{'SetS2',{'SetS2_setS2',true,66},true,15}} = - asn1_wrapper:decode('SetTypeRefSet','SetS2',lists:flatten(Bytes22)), - - - - ?line {ok,Bytes23} = - asn1_wrapper:encode('SetTypeRefSet','SetS3',#'SetS3'{boolS3 = true, - setS3 = #'SetS3_setS3'{boolIn = true, - intIn = 66}, - intS3 = 15}), - ?line {ok,{'SetS3',true,{'SetS3_setS3',true,66},15}} = - asn1_wrapper:decode('SetTypeRefSet','SetS3',lists:flatten(Bytes23)), - - - - - - - ?line {ok,Bytes31} = - asn1_wrapper:encode('SetTypeRefSet','SetSTag',#'SetSTag'{setS1 = #'SetSTag_setS1'{b1 = true, - i1 = 11}, - setS2 = #'SetSTag_setS2'{b2 = true, - i2 = 22}, - setS3 = #'SetSTag_setS3'{b3 = true, - i3 = 33}}), - ?line {ok,{'SetSTag',{'SetSTag_setS1',true,11}, - {'SetSTag_setS2',true,22}, - {'SetSTag_setS3',true,33}}} = - asn1_wrapper:decode('SetTypeRefSet','SetSTag',lists:flatten(Bytes31)), - - - - - - ?line {ok,Bytes41} = - asn1_wrapper:encode('SetTypeRefSet','SetTRset', - #'SetTRset'{'setSet' = #'SetSet'{setOs = "A1", - setInt = 2}, - 'setSetI' = #'SetSet'{setOs = "A2", - setInt = 2}, - 'setSetE' = #'SetSet'{setOs = "A3", - setInt = 2}, - 'setSet-I' = #'SetSetImp'{setOs = "A4", - setInt = 2}, - 'setSetI-I' = #'SetSetImp'{setOs = "A5", - setInt = 2}, - 'setSetE-I' = #'SetSetImp'{setOs = "A6", - setInt = 2}, - 'setSet-E' = #'SetSetExp'{setOs = "A7", - setInt = 2}, - 'setSetI-E' = #'SetSetExp'{setOs = "A8", - setInt = 2}, - 'setSetE-E' = #'SetSetExp'{setOs = "A9", - setInt = 2}}), - ?line {ok,{'SetTRset',{'SetSet',2,"A1"}, - {'SetSet',2,"A2"}, - {'SetSet',2,"A3"}, - {'SetSetImp',2,"A4"}, - {'SetSetImp',2,"A5"}, - {'SetSetImp',2,"A6"}, - {'SetSetExp',2,"A7"}, - {'SetSetExp',2,"A8"}, - {'SetSetExp',2,"A9"}}} = - asn1_wrapper:decode('SetTypeRefSet','SetTRset',lists:flatten(Bytes41)), + roundtrip('Set1', + #'Set1'{bool1=true,int1=15,set1=#'SetIn'{boolIn=true,intIn=66}}), + roundtrip('Set2', + #'Set2'{set2=#'SetIn'{boolIn=true,intIn=66},bool2=true,int2=15}), + roundtrip('Set3', + #'Set3'{bool3=true,set3=#'SetIn'{boolIn=true,intIn=66},int3=15}), + roundtrip('Set4', + #'Set4'{set41=#'SetIn'{boolIn=true,intIn=66}, + set42=#'SetIn'{boolIn=true,intIn=66}, + set43=#'SetIn'{boolIn=true,intIn=66}}), + roundtrip('SetS1', + #'SetS1'{boolS1=true,intS1=15, + setS1=#'SetS1_setS1'{boolIn=true,intIn=66}}), + roundtrip('SetS2', + #'SetS2'{setS2=#'SetS2_setS2'{boolIn=true,intIn=66}, + boolS2=true,intS2=15}), + roundtrip('SetS3', + #'SetS3'{boolS3=true, + setS3=#'SetS3_setS3'{boolIn=true,intIn=66}, + intS3=15}), + roundtrip('SetSTag', + #'SetSTag'{setS1=#'SetSTag_setS1'{b1=true,i1=11}, + setS2=#'SetSTag_setS2'{b2=true,i2=22}, + setS3=#'SetSTag_setS3'{b3=true,i3=33}}), + roundtrip('SetTRset', + #'SetTRset'{setSet=#'SetSet'{setInt=2,setOs="A1"}, + setSetI=#'SetSet'{setInt=2,setOs="A2"}, + setSetE=#'SetSet'{setInt=2,setOs="A3"}, + 'setSet-I'=#'SetSetImp'{setInt=2,setOs="A4"}, + 'setSetI-I'=#'SetSetImp'{setInt=2,setOs="A5"}, + 'setSetE-I'=#'SetSetImp'{setInt=2,setOs="A6"}, + 'setSet-E'=#'SetSetExp'{setInt=2,setOs="A7"}, + 'setSetI-E'=#'SetSetExp'{setInt=2,setOs="A8"}, + 'setSetE-E'=#'SetSetExp'{setInt=2,setOs="A9"}}), ok. + +roundtrip(T, V) -> + asn1_test_lib:roundtrip('SetTypeRefSet', T, V). diff --git a/lib/asn1/test/testTCAP.erl b/lib/asn1/test/testTCAP.erl index aba13c94de..17511dc2b7 100644 --- a/lib/asn1/test/testTCAP.erl +++ b/lib/asn1/test/testTCAP.erl @@ -40,25 +40,26 @@ compile_asn1config(Config, Options) -> test(Erule,_Config) -> % ?line OutDir = ?config(priv_dir,Config), %% testing OTP-4798, open type encoded with indefinite length - ?line {ok,_Res} = asn1_wrapper:decode('TCAPMessages-simple','MessageType', val_OTP_4798(Erule)), + {ok,_Res} = 'TCAPMessages-simple':decode('MessageType', + val_OTP_4798(Erule)), + %% testing OTP-4799, absent optional open type - ?line {ok,_Res2} = asn1_wrapper:decode('TCAPMessages-simple','MessageType',val_OTP_4799(Erule)), + {ok,_Res2} = 'TCAPMessages-simple':decode('MessageType', + val_OTP_4799(Erule)), + %% testing vance shipley's problems. Parameterized object sets. ?line Val3 = 'TCAPPackage_msg':val('PackageType',unidirectional), - ?line {ok,Bytes3} = asn1_wrapper:encode('TCAPPackage','PackageType',Val3), - ?line {ok,Res3} = asn1_wrapper:decode('TCAPPackage','PackageType',Bytes3), + Res3 = enc_dec('PackageType', Val3), ?line ok = 'TCAPPackage_msg':check_result('PackageType',unidirectional,Res3), %% ?line io:format("Res3:~n~p~n~n",[Res3]), ?line Val4 = 'TCAPPackage_msg':val('PackageType',abort), - ?line {ok,Bytes4} = asn1_wrapper:encode('TCAPPackage','PackageType',Val4), - ?line {ok,Res4} = asn1_wrapper:decode('TCAPPackage','PackageType',Bytes4), + Res4 = enc_dec('PackageType', Val4), ?line ok = 'TCAPPackage_msg':check_result('PackageType',abort,Res4), %% ?line io:format("Res4:~n~p~n~n",[Res4]), ?line Val5 = 'TCAPPackage_msg':val('PackageType',response), - ?line {ok,Bytes5} = asn1_wrapper:encode('TCAPPackage','PackageType',Val5), - ?line {ok,Res5} = asn1_wrapper:decode('TCAPPackage','PackageType',Bytes5), + Res5 = enc_dec('PackageType', Val5), ?line ok = 'TCAPPackage_msg':check_result('PackageType',response,Res5). %% ?line io:format("Res5:~n~p~n~n",[Res5]). @@ -73,21 +74,26 @@ val_OTP_4799(_) -> <<100,16,73,4,41,182,36,0,108,8,163,6,2,1,29,2,1,27>>. test_asn1config() -> - ?line Val = 'TCAPPackage_msg':val('PackageType',queryWithPerm), - ?line {ok,B} = asn1_wrapper:encode('TCAPPackage','PackageType',Val), - ?line {ok,ExMsg}='TCAPPackage':decode_PackageType(list_to_binary(B)), - ?line {_,{_,_,_,{Key,ExVal}}}=ExMsg, - ?line {ok,_Parts}='TCAPPackage':decode_part(Key,ExVal), + Val = 'TCAPPackage_msg':val('PackageType', queryWithPerm), + {ok,B} = 'TCAPPackage':encode('PackageType', Val), + {ok,ExMsg}='TCAPPackage':decode_PackageType(B), + {_,{_,_,_,{Key,ExVal}}} = ExMsg, + {ok,_Parts} = 'TCAPPackage':decode_part(Key, ExVal), - ?line Val2 = 'TCAPPackage_msg':val('TransactionPDU'), - ?line {ok,B2} = 'TCAPPackage':encode('TransactionPDU',Val2), - {ok,ExMsg2}='TCAPPackage':decode_TransactionPDU(B2), - ?line {_,_,_,{Key2,ExVal2}}=ExMsg2, - ?line {ok,_Parts2}='TCAPPackage':decode_part(Key2,ExVal2), + Val2 = 'TCAPPackage_msg':val('TransactionPDU'), + {ok,B2} = 'TCAPPackage':encode('TransactionPDU', Val2), + {ok,ExMsg2} = 'TCAPPackage':decode_TransactionPDU(B2), + {_,_,_,{Key2,ExVal2}} = ExMsg2, + {ok,_Parts2} = 'TCAPPackage':decode_part(Key2, ExVal2), - ?line Val3 = 'TCAPPackage_msg':val('PackageType',response), - ?line {ok,B3} = asn1_wrapper:encode('TCAPPackage','PackageType',Val3), - ?line {ok,ExMsg3}='TCAPPackage':decode_PackageType(list_to_binary(B3)), - ?line {_,{_,_,_,{Key3,ExVal3}}}=ExMsg3, - ?line {ok,_Parts3}='TCAPPackage':decode_part(Key3,ExVal3). + Val3 = 'TCAPPackage_msg':val('PackageType', response), + {ok,B3} = 'TCAPPackage':encode('PackageType', Val3), + {ok,ExMsg3} = 'TCAPPackage':decode_PackageType(B3), + {_,{_,_,_,{Key3,ExVal3}}} = ExMsg3, + {ok,_Parts3}='TCAPPackage':decode_part(Key3, ExVal3). +enc_dec(T, V0) -> + M = 'TCAPPackage', + {ok,Enc} = M:encode(T, V0), + {ok,V} = M:decode(T, Enc), + V. diff --git a/lib/asn1/test/testTimer.erl b/lib/asn1/test/testTimer.erl index cd7ceb5630..0f02bab6e0 100644 --- a/lib/asn1/test/testTimer.erl +++ b/lib/asn1/test/testTimer.erl @@ -18,9 +18,7 @@ %% %% -module(testTimer). - --compile(export_all). -%%-export([Function/Arity, ...]). +-export([go/2]). -include_lib("test_server/include/test_server.hrl"). @@ -127,7 +125,7 @@ val() -> {'H323-UserInformation_user-data',24,"O"}}. -go(Config,Enc) -> +go(Config, _Enc) -> ?line true = code:add_patha(?config(priv_dir,Config)), Module = 'H323-MESSAGES', @@ -137,13 +135,12 @@ go(Config,Enc) -> CompileOptions = compile_options(), - ?line {ValWr, done} = timer:tc(?MODULE, encode, [?times, Module, Type, Value]), + {ValWr,done} = timer:tc(fun() -> encode(?times, Module, Type, Value) end), ?line io:format("ASN1 encode ~p: ~p micro~n", [CompileOptions, ValWr / ?times]), - ?line done = decode(2,Module,Type,Bytes,Enc), + done = decode(2, Module, Type, Bytes), - ?line {ValRead, done} = timer:tc(?MODULE, decode, [?times, Module, - Type, Bytes,Enc]), + {ValRead,done} = timer:tc(fun() -> decode(?times, Module, Type, Bytes) end), ?line io:format("ASN1 decode ~p: ~p micro~n", [CompileOptions, ValRead /?times]), @@ -162,11 +159,11 @@ encode(N, Module,Type,Value) -> end, encode(N-1, Module,Type,Value). -decode(0, _Module,_Type,_Value,_Erule) -> +decode(0, _Module, _Type, _Value) -> done; -decode(N, Module,Type,Value,Erule) -> - {ok,_B} = asn1rt:decode(Module,Type,Value), - decode(N-1, Module,Type,Value,Erule). +decode(N, Module, Type, Value) -> + {ok,_B} = asn1rt:decode(Module, Type, Value), + decode(N-1, Module, Type, Value). compile_options() -> {ok,Info} = asn1rt:info('H323-MESSAGES'), diff --git a/lib/asn1/test/testTypeValueNotation.erl b/lib/asn1/test/testTypeValueNotation.erl index 61d69edd0e..b46d7177f5 100644 --- a/lib/asn1/test/testTypeValueNotation.erl +++ b/lib/asn1/test/testTypeValueNotation.erl @@ -24,13 +24,15 @@ -record('Seq', {octstr, int, bool, enum, bitstr, null, oid, vstr}). main(_Rule, _Option) -> - Value1 = #'Seq'{octstr = [1, 2, 3, 4], - int = 12, - bool = true, - enum = a, - bitstr = <<2#1010:4>>, - null = 'NULL', - oid = {1, 2, 55}, - vstr = "Hello World"}, - {ok, Bytes} = asn1_wrapper:encode('SeqTypeRefPrim', 'Seq', Value1), - {ok, Value1} = asn1_wrapper:decode('SeqTypeRefPrim', 'Seq', Bytes). + Value = #'Seq'{octstr = [1, 2, 3, 4], + int = 12, + bool = true, + enum = a, + bitstr = <<2#1010:4>>, + null = 'NULL', + oid = {1, 2, 55}, + vstr = "Hello World"}, + roundtrip('Seq', Value). + +roundtrip(T, V) -> + asn1_test_lib:roundtrip('SeqTypeRefPrim', T, V). diff --git a/lib/asn1/test/testWSParamClass.erl b/lib/asn1/test/testWSParamClass.erl index ae67ca8b81..66ba56a6d8 100644 --- a/lib/asn1/test/testWSParamClass.erl +++ b/lib/asn1/test/testWSParamClass.erl @@ -11,7 +11,4 @@ main(_) -> ok. roundtrip(Data) -> - IF = 'InformationFramework', - {ok,Enc} = asn1_wrapper:encode(IF, 'Attribute', Data), - {ok,Data} = IF:decode('Attribute', Enc), - ok. + asn1_test_lib:roundtrip('InformationFramework', 'Attribute', Data). diff --git a/lib/asn1/test/testX420.erl b/lib/asn1/test/testX420.erl index 70bdb0640d..4ddc55dc16 100644 --- a/lib/asn1/test/testX420.erl +++ b/lib/asn1/test/testX420.erl @@ -27,21 +27,11 @@ compile(Erule, Options, Config) -> - Specs = specs(), - 99 = length(Specs), - ok = compile_loop(Erule,Specs,Options,Config). - -compile_loop(_Erule, [], _Options, _Config) -> - ok; -compile_loop(Erule, [Spec|Specs], Options, Config) - when Erule =:= ber; Erule =:= per -> + Specs0 = specs(), + 99 = length(Specs0), CaseDir = ?config(case_dir, Config), - asn1_test_lib:compile(filename:join([x420, Spec]), Config, - [Erule, {i, CaseDir} | Options]), - compile_loop(Erule, Specs, Options, Config); -compile_loop(_Erule, _Specs, _Options, _Config) -> - ok. - + Specs = [filename:join(x420, Spec) || Spec <- Specs0], + asn1_test_lib:compile_all(Specs, Config, [Erule,{i,CaseDir}|Options]). specs() -> ["ACSE-1", "AuthenticationFramework", "BasicAccessControl", @@ -93,9 +83,9 @@ specs() -> ticket7759(_Erule,_Config) -> Encoded = encoded_msg(), io:format("Testing ticket7759 ...~n",[]), - ?line {ok, ContentInfo} = asn1_wrapper:decode('PKCS7','ContentInfo',Encoded), - ?line {'ContentInfo',_Id,PKCS7_content} = ContentInfo, - ?line {ok,_} = asn1_wrapper:decode('PKCS7','SignedData',PKCS7_content), + {ok, ContentInfo} = 'PKCS7':decode('ContentInfo',Encoded), + {'ContentInfo',_Id,PKCS7_content} = ContentInfo, + {ok,_} = 'PKCS7':decode('SignedData',PKCS7_content), ok. diff --git a/lib/asn1/test/test_driver_load.erl b/lib/asn1/test/test_driver_load.erl deleted file mode 100644 index e0e6602046..0000000000 --- a/lib/asn1/test/test_driver_load.erl +++ /dev/null @@ -1,45 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-2012. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% -%% --module(test_driver_load). - --export([test/1,encode/0]). - --include_lib("test_server/include/test_server.hrl"). - - -test(0) -> - ok; -test(N) -> - spawn(?MODULE,encode,[]), - test(N-1). - -encode() -> - ?line Msg = msg(), - ?line {ok,_}=asn1_wrapper:encode('P-Record','PersonnelRecord',Msg), - ok. - -msg() -> - {'PersonnelRecord',{'Name',"John","P","Smith"}, - "Director", - 51, - "19710917", - {'Name',"Mary","T","Smith"}, - [{'ChildInformation',{'Name',"Ralph","T","Smith"},"19571111"},{'ChildInformation',{'Name',"Susan","B","Jones"},"19590717"}]}. - diff --git a/lib/asn1/test/test_modified_x420.erl b/lib/asn1/test/test_modified_x420.erl index a525fd6ae1..0df72a1831 100644 --- a/lib/asn1/test/test_modified_x420.erl +++ b/lib/asn1/test/test_modified_x420.erl @@ -26,8 +26,9 @@ test(Config) -> DataDir = ?config(data_dir,Config), Der = read_pem(filename:join([DataDir,modified_x420,"p7_signed_data.pem"])), - {ok,{_,_,SignedData}} = asn1_wrapper:decode('PKCS7', 'ContentInfo', Der), - {ok,_} = asn1_wrapper:decode('PKCS7', 'SignedData', SignedData). + {ok,{_,_,SignedData}} = 'PKCS7':decode( 'ContentInfo', Der), + {ok,_} = 'PKCS7':decode('SignedData', SignedData), + ok. read_pem(File) -> {ok,Bin} = file:read_file(File), diff --git a/lib/asn1/test/test_partial_incomplete_decode.erl b/lib/asn1/test/test_partial_incomplete_decode.erl index 8ede06938d..4a8a4cd74c 100644 --- a/lib/asn1/test/test_partial_incomplete_decode.erl +++ b/lib/asn1/test/test_partial_incomplete_decode.erl @@ -25,84 +25,57 @@ test(Config) -> FMsg = msg('F'), - ?line {ok,Bytes} = asn1_wrapper:encode('PartialDecSeq','F',FMsg), - ?line {ok,_} = asn1_wrapper:decode('PartialDecSeq','F',Bytes), - ?line {ok,IncFMsg} = - 'PartialDecSeq':decode_F_fb_incomplete(list_to_binary(Bytes)), - ?line decode_parts('F',IncFMsg), + Bytes1 = roundtrip('PartialDecSeq', 'F', FMsg), + {ok,IncFMsg} = 'PartialDecSeq':decode_F_fb_incomplete(Bytes1), + decode_parts('F', IncFMsg), + {ok,IncF2Msg} = 'PartialDecSeq':decode_F_fb_exclusive2(Bytes1), + decode_parts('F2', IncF2Msg), DMsg = msg('D'), - ?line {ok,Bytes2} = asn1_wrapper:encode('PartialDecSeq','D',DMsg), - ?line {ok,_} = asn1_wrapper:decode('PartialDecSeq','D',Bytes2), - ?line {ok,IncDMsg} = - 'PartialDecSeq':decode_D_incomplete(list_to_binary(Bytes2)), - ?line decode_parts('D',IncDMsg), - - ?line {ok,IncF2Msg} = - 'PartialDecSeq':decode_F_fb_exclusive2(list_to_binary(Bytes)), - ?line decode_parts('F2',IncF2Msg), + Bytes2 = roundtrip('PartialDecSeq', 'D', DMsg), + {ok,IncDMsg} = 'PartialDecSeq':decode_D_incomplete(Bytes2), + decode_parts('D', IncDMsg), F3Msg = msg('F3'), - ?line {ok,BytesF3} = asn1_wrapper:encode('PartialDecSeq','F',F3Msg), - ?line {ok,_} = asn1_wrapper:decode('PartialDecSeq','F',BytesF3), - ?line {ok,IncF3Msg} = - 'PartialDecSeq':decode_F_fb_exclusive3(list_to_binary(BytesF3)), - ?line decode_parts('F3',IncF3Msg), - - - AMsg =msg('A'), - ?line {ok,Bytes3} = asn1_wrapper:encode('PartialDecSeq2','A',AMsg), - ?line {ok,_} = asn1_wrapper:decode('PartialDecSeq2','A',Bytes3), - ?line {ok,IncFMsg3} = - 'PartialDecSeq2':decode_A_c_b_incomplete(list_to_binary(Bytes3)), - ?line decode_parts('A',IncFMsg3), + BytesF3 = roundtrip('PartialDecSeq', 'F', F3Msg), + {ok,IncF3Msg} = 'PartialDecSeq':decode_F_fb_exclusive3(BytesF3), + decode_parts('F3', IncF3Msg), + + AMsg = msg('A'), + Bytes3 = roundtrip('PartialDecSeq2', 'A', AMsg), + {ok,IncFMsg3} = 'PartialDecSeq2':decode_A_c_b_incomplete(Bytes3), + decode_parts('A', IncFMsg3), MyHTTPMsg = msg('GetRequest'), - ?line {ok,Bytes4} = asn1_wrapper:encode('PartialDecMyHTTP', - 'GetRequest',MyHTTPMsg), - ?line {ok,_} = asn1_wrapper:decode('PartialDecMyHTTP','GetRequest', - Bytes4), - ?line {ok,IncFMsg4} = - 'PartialDecMyHTTP':decode_GetRequest_incomplete(list_to_binary(Bytes4)), - ?line decode_parts('GetRequest',IncFMsg4), + Bytes4 = roundtrip('PartialDecMyHTTP', 'GetRequest', MyHTTPMsg), + {ok,IncFMsg4} = 'PartialDecMyHTTP':decode_GetRequest_incomplete(Bytes4), + decode_parts('GetRequest', IncFMsg4), MsgS1_1 = msg('S1_1'), - ?line {ok,Bytes5} = asn1_wrapper:encode('PartialDecSeq3','S1',MsgS1_1), - ?line {ok,_} = asn1_wrapper:decode('PartialDecSeq3','S1',Bytes5), - ?line {ok,IncFMsg5} = - 'PartialDecSeq3':decode_S1_incomplete(list_to_binary(Bytes5)), - ?line decode_parts('S1_1',IncFMsg5), + Bytes5 = roundtrip('PartialDecSeq3', 'S1', MsgS1_1), + {ok,IncFMsg5} = 'PartialDecSeq3':decode_S1_incomplete(Bytes5), + decode_parts('S1_1', IncFMsg5), MsgS1_2 = msg('S1_2'), - ?line {ok,Bytes6} = asn1_wrapper:encode('PartialDecSeq3','S1',MsgS1_2), - ?line {ok,IncFMsg6} = - 'PartialDecSeq3':decode_S1_incomplete(list_to_binary(Bytes6)), - ?line ok = decode_parts('S1_2',IncFMsg6), + Bytes6 = roundtrip('PartialDecSeq3', 'S1', MsgS1_2), + {ok,IncFMsg6} = 'PartialDecSeq3':decode_S1_incomplete(Bytes6), + decode_parts('S1_2', IncFMsg6), %% test of MEDIA-GATEWAY-CONTROL test_megaco(Config), ok. test_megaco(Config) -> - ?line DataDir = ?config(data_dir,Config), - Mod='MEDIA-GATEWAY-CONTROL', - ?line {ok,FilenameList} = file:list_dir(filename:join([DataDir, - megacomessages])), - %% remove any junk files that may be in the megacomessage directory - Pred = fun(X) -> - case lists:reverse(X) of - [$l,$a,$v,$.|_R] ->true; - _ -> false - end - end, - MegacoMsgFilenameList = lists:filter(Pred,FilenameList), - Fun = fun(F) -> - M = read_msg(filename:join([DataDir,megacomessages,F])), - ?line {ok,B} = asn1_wrapper:encode(Mod,element(1,M),M), - ?line exclusive_decode(list_to_binary(B),F) - end, - ?line lists:foreach(Fun,MegacoMsgFilenameList), - ok. + DataDir = ?config(data_dir, Config), + Files = filelib:wildcard(filename:join([DataDir,megacomessages,"*.val"])), + Mod = 'MEDIA-GATEWAY-CONTROL', + lists:foreach(fun(File) -> + {ok,Bin} = file:read_file(File), + V = binary_to_term(Bin), + T = element(1, V), + Enc = roundtrip(Mod, T, V), + exclusive_decode(Enc, File) + end, Files). exclusive_decode(Bin,F) -> Mod='MEDIA-GATEWAY-CONTROL', @@ -113,15 +86,6 @@ exclusive_decode(Bin,F) -> ?line {ok,_} = Mod:decode_part(MsgMBodyKey,MsgMBody), ok. - -read_msg(File) -> - case file:read_file(File) of - {ok,Bin} -> - binary_to_term(Bin); - _ -> - io:format("couldn't read file ~p~n",[File]) - end. - decode_parts('F',PartDecMsg) -> ?line {fb,{'E',35,{NameE_b,ListBinE_b},false,{NameE_d,BinE_d}}} = PartDecMsg, ?line {ok,[{'D',3,true}|_]} = 'PartialDecSeq':decode_part(NameE_b,ListBinE_b), @@ -200,7 +164,10 @@ msg('A') -> {'A',12,{c,{'S',true,false}},{b,{'A_c_b',false,false}}}; msg('GetRequest') -> - {'GetRequest',true,false,{'AcceptTypes',[1,1,1,1],["hell","othe","reho","peyo","uare","fine"]},"IamfineThankYOu"}; + {'GetRequest',true,false, + {'AcceptTypes',[html,'plain-text',gif,jpeg], + ["hell","othe","reho","peyo","uare","fine"]}, + "IamfineThankYOu"}; msg('S1_1') -> {'S1',14,msg('S2'),msg('C1_a'),msg('SO1')}; @@ -213,10 +180,13 @@ msg('C1_a') -> msg('C1_b') -> {b,{'C1_b',11,true,msg('S4')}}; msg('S3') -> - {'S3',10,"PrintableString","OCTETSTRING",[1,1,1,1]}; + {'S3',10,"PrintableString","OCTETSTRING",[one,two,three,four]}; msg('S4') -> {'S4',msg('Name'),"MSc"}; msg('SO1') -> [msg('Name'),msg('Name'),msg('Name')]; msg('Name') -> {'Name',"Hans","HCA","Andersen"}. + +roundtrip(M, T, V) -> + asn1_test_lib:roundtrip_enc(M, T, V). diff --git a/lib/asn1/test/test_selective_decode.erl b/lib/asn1/test/test_selective_decode.erl index ebe1296cf3..f42f24e0e3 100644 --- a/lib/asn1/test/test_selective_decode.erl +++ b/lib/asn1/test/test_selective_decode.erl @@ -18,39 +18,39 @@ %% %% -module(test_selective_decode). - -export([test/0]). -include_lib("test_server/include/test_server.hrl"). - test() -> FMsg = msg('F'), - ?line {ok,Bytes} = asn1_wrapper:encode('PartialDecSeq','F',FMsg), - ?line {ok,3} = - 'PartialDecSeq':selected_decode_F1(list_to_binary(Bytes)), - ?line {ok,[{'D',3,true},{'D',4,false},{'D',5,true},{'D',6,true},{'D',7,false},{'D',8,true},{'D',9,true},{'D',10,false},{'D',11,true},{'D',12,true},{'D',13,false},{'D',14,true}]} = 'PartialDecSeq':selected_decode_F2(list_to_binary(Bytes)), - ?line {ok,{'D',3,true}} = 'PartialDecSeq':selected_decode_F3(list_to_binary(Bytes)), - - ?line {ok,17} = 'PartialDecSeq':selected_decode_F4(list_to_binary(Bytes)), + Bytes = roundtrip('PartialDecSeq', 'F', FMsg), + {ok,3} = 'PartialDecSeq':selected_decode_F1(Bytes), + {ok,[{'D',3,true},{'D',4,false},{'D',5,true},{'D',6,true}, + {'D',7,false},{'D',8,true},{'D',9,true},{'D',10,false}, + {'D',11,true},{'D',12,true},{'D',13,false},{'D',14,true}]} = + 'PartialDecSeq':selected_decode_F2(Bytes), + {ok,{'D',3,true}} = 'PartialDecSeq':selected_decode_F3(Bytes), + {ok,17} = 'PartialDecSeq':selected_decode_F4(Bytes), EMsg = msg('E'), - ?line {ok,Bytes2} = asn1_wrapper:encode('PartialDecSeq','E',EMsg), - ?line {ok,14} = 'PartialDecSeq':selected_decode_E1(list_to_binary(Bytes2)), + Bytes2 = roundtrip('PartialDecSeq', 'E', EMsg), + {ok,14} = 'PartialDecSeq':selected_decode_E1(Bytes2), + MGCMsg = msg('M-G-C'), - ?line {ok,Bytes3} = asn1_wrapper:encode('MEDIA-GATEWAY-CONTROL', - 'MegacoMessage',MGCMsg), - ?line {ok,1} = 'MEDIA-GATEWAY-CONTROL':decode_MegacoMessage_selective(list_to_binary(Bytes3)), + Bytes3 = roundtrip('MEDIA-GATEWAY-CONTROL', 'MegacoMessage', MGCMsg), + {ok,1} = 'MEDIA-GATEWAY-CONTROL':decode_MegacoMessage_selective(Bytes3), PRecMsg = {'PersonnelRecord',{'Name',"Sven","S","Svensson"}, "manager",123,"20000202",{'Name',"Inga","K","Svensson"}, asn1_DEFAULT}, - ?line {ok,Bytes4} = asn1_wrapper:encode('P-Record','PersonnelRecord', - PRecMsg), - ?line {ok,_} = 'P-Record':sel_dec(list_to_binary(Bytes4)), - ok. - + PRecMsgDec = {'PersonnelRecord',{'Name',"Sven","S","Svensson"}, + "manager",123,"20000202",{'Name',"Inga","K","Svensson"}, + []}, + Bytes4 = roundtrip('P-Record', 'PersonnelRecord', PRecMsg, PRecMsgDec), + {ok,_} = 'P-Record':sel_dec(Bytes4), + ok. msg('F') -> {fb,{'E',35,[{'D',3,true},{'D',4,false},{'D',5,true},{'D',6,true},{'D',7,false},{'D',8,true},{'D',9,true},{'D',10,false},{'D',11,true},{'D',12,true},{'D',13,false},{'D',14,true}],false,{da,[{'A',16,{'D',17,true}}]}}}; @@ -60,3 +60,10 @@ msg('E') -> msg('M-G-C') -> {'MegacoMessage',asn1_NOVALUE,{'Message',1,{ip4Address,{'IP4Address',[125,125,125,111],55555}},{transactions,[{transactionReply,{'TransactionReply',50007,asn1_NOVALUE,{actionReplies,[{'ActionReply',0,asn1_NOVALUE,asn1_NOVALUE,[{auditValueReply,{auditResult,{'AuditResult',{'TerminationID',[],[255,255,255]},[{mediaDescriptor,{'MediaDescriptor',asn1_NOVALUE,{multiStream,[{'StreamDescriptor',1,{'StreamParms',{'LocalControlDescriptor',sendRecv,asn1_NOVALUE,asn1_NOVALUE,[{'PropertyParm',[0,11,0,7],[[52,48]],asn1_NOVALUE}]},{'LocalRemoteDescriptor',[[{'PropertyParm',[0,0,176,1],[[48]],asn1_NOVALUE},{'PropertyParm',[0,0,176,8],[[73,78,32,73,80,52,32,49,50,53,46,49,50,53,46,49,50,53,46,49,49,49]],asn1_NOVALUE},{'PropertyParm',[0,0,176,15],[[97,117,100,105,111,32,49,49,49,49,32,82,84,80,47,65,86,80,32,32,52]],asn1_NOVALUE},{'PropertyParm',[0,0,176,12],[[112,116,105,109,101,58,51,48]],asn1_NOVALUE}]]},{'LocalRemoteDescriptor',[[{'PropertyParm',[0,0,176,1],[[48]],asn1_NOVALUE},{'PropertyParm',[0,0,176,8],[[73,78,32,73,80,52,32,49,50,52,46,49,50,52,46,49,50,52,46,50,50,50]],asn1_NOVALUE},{'PropertyParm',[0,0,176,15],[[97,117,100,105,111,32,50,50,50,50,32,82,84,80,47,65,86,80,32,32,52]],asn1_NOVALUE},{'PropertyParm',[0,0,176,12],[[112,116,105,109,101,58,51,48]],asn1_NOVALUE}]]}}}]}}},{packagesDescriptor,[{'PackagesItem',[0,11],1},{'PackagesItem',[0,11],1}]},{statisticsDescriptor,[{'StatisticsParameter',[0,12,0,4],[[49,50,48,48]]},{'StatisticsParameter',[0,11,0,2],[[54,50,51,48,48]]},{'StatisticsParameter',[0,12,0,5],[[55,48,48]]},{'StatisticsParameter',[0,11,0,3],[[52,53,49,48,48]]},{'StatisticsParameter',[0,12,0,6],[[48,46,50]]},{'StatisticsParameter',[0,12,0,7],[[50,48]]},{'StatisticsParameter',[0,12,0,8],[[52,48]]}]}]}}}]}]}}}]}}}. + + +roundtrip(M, T, V) -> + asn1_test_lib:roundtrip_enc(M, T, V). + +roundtrip(M, T, V, E) -> + asn1_test_lib:roundtrip_enc(M, T, V, E). diff --git a/lib/asn1/test/test_special_decode_performance.erl b/lib/asn1/test/test_special_decode_performance.erl index 7dfab1f25a..0f52ae4cd2 100644 --- a/lib/asn1/test/test_special_decode_performance.erl +++ b/lib/asn1/test/test_special_decode_performance.erl @@ -19,7 +19,7 @@ %% -module(test_special_decode_performance). --export([go/1,loop2/4,loop1/5]). +-export([go/1]). -include_lib("test_server/include/test_server.hrl"). @@ -49,7 +49,7 @@ go1(_,_,[],_,_,AccTime) -> %% go1 for common decode go1(common,Mod,_,Bin,N,_) -> ?line TT=get_top_type(Mod), - ?line {Time,Result}=timer:tc(?MODULE,loop1,[Mod,decode,TT,Bin,N]), + {Time,Result} = timer:tc(fun() -> loop1(Mod, decode, TT, Bin, N) end), case Result of {ok,_R1} -> io:format("common Decode ~p:decode, ~p times on time ~p~n", @@ -59,7 +59,7 @@ go1(common,Mod,_,Bin,N,_) -> end, Time; go1(Dec,Mod,[F|Fs],Bin,N,AccTime) -> - ?line {Time,Result}=timer:tc(?MODULE,loop2,[Mod,F,Bin,N]), + {Time,Result}=timer:tc(fun() -> loop2(Mod, F, Bin, N) end), case Result of {ok,_R1} -> io:format("~p Decode ~p:~p, ~p times on time ~p~n",[Dec,Mod,F,N,Time]); diff --git a/lib/asn1/test/test_undecoded_rest.erl b/lib/asn1/test/test_undecoded_rest.erl index 36fd26ed59..91e614d38a 100644 --- a/lib/asn1/test/test_undecoded_rest.erl +++ b/lib/asn1/test/test_undecoded_rest.erl @@ -26,28 +26,42 @@ %% testing OTP-5104 -test(Opt, Config) -> - {ok, Msg} = asn1ct:value('P-Record', 'PersonnelRecord', - [{i, ?config(case_dir, Config)}]), - {ok, Bytes} = asn1_wrapper:encode('P-Record', 'PersonnelRecord', Msg), - Bytes2 = if is_list(Bytes) -> - Bytes ++ [55, 55, 55]; - is_binary(Bytes) -> - iolist_to_binary([Bytes, <<55, 55, 55>>]) - end, - case Opt of - undec_rest -> - {ok, Msg, R} = asn1_wrapper:decode('P-Record', 'PersonnelRecord', - Bytes2), +test(Opts, Config) -> + {ok,Msg} = asn1ct:value('P-Record', 'PersonnelRecord', + [{i,?config(case_dir, Config)}]), + Bytes0 = encode(Opts, 'PersonnelRecord', Msg), + Bytes1 = iolist_to_binary([Bytes0, <<55,55,55>>]), + case proplists:get_bool(undec_rest, Opts) of + true -> + {Msg,R} = decode(Opts, 'PersonnelRecord', Bytes1), case R of - <<55, 55, 55>> -> ok; - [55, 55, 55] -> ok; + <<55,55,55>> -> + ok; BStr when is_bitstring(BStr) -> PadLen = (8 - (bit_size(BStr) rem 8)) rem 8, - <<0, 55, 55, 55>> = <<0:PadLen, BStr/bitstring>> + <<0,55,55,55>> = <<0:PadLen, BStr/bitstring>> end; - _ -> - {ok, Msg} = asn1_wrapper:decode('P-Record', 'PersonnelRecord', - Bytes2) + false -> + Msg = decode(Opts, 'PersonnelRecord', Bytes1) end, ok. + +encode(Opts, T, V) -> + M = 'P-Record', + case proplists:get_bool(no_ok_wrapper, Opts) of + false -> + {ok,Enc} = M:encode(T, V), + Enc; + true -> + Enc = M:encode(T, V), + true = is_binary(Enc), + Enc + end. + +decode(Opts, T, E) -> + M = 'P-Record', + case {proplists:get_bool(no_ok_wrapper, Opts),M:decode(T, E)} of + {false,{ok,Val}} -> Val; + {false,{ok,Val,Rest}} -> {Val,Rest}; + {true,Result} -> Result + end. diff --git a/lib/asn1/test/test_x691.erl b/lib/asn1/test/test_x691.erl index dcfa211d80..9b141e2389 100644 --- a/lib/asn1/test/test_x691.erl +++ b/lib/asn1/test/test_x691.erl @@ -18,50 +18,25 @@ %% %% -module(test_x691). - --export([cases/2]). +-export([cases/1]). -include_lib("test_server/include/test_server.hrl"). -cases(Erule,Variant) -> - MsgA1 = a1(), - ?line {ok,B1} = asn1_wrapper:encode('P-RecordA1','PersonnelRecord',MsgA1), - ?line {ok,MsgA1} = asn1_wrapper:decode('P-RecordA1','PersonnelRecord',B1), - io:format("compare_format(~p,B1) ->~p~nencval(a1,~p,binary) ->~p~n", - [Erule, - compare_format(Erule,B1), - Variant, - encval(a1,Variant,binary)]), - ?line true = (compare_format(Erule,B1) == encval(a1,Variant,binary)), - - MsgA2 = a2(), - ?line {ok,B2} = asn1_wrapper:encode('P-RecordA2','PersonnelRecord',MsgA2), - ?line {ok,MsgA2} = asn1_wrapper:decode('P-RecordA2','PersonnelRecord',B2), - io:format("compare_format(~p,B2) ->~p~nencval(a2,~p,binary) ->~p~n", - [Erule, - compare_format(Erule,B2), - Variant, - encval(a2,Variant,binary)]), - ?line true = (compare_format(Erule,B2) == encval(a2,Variant,binary)), - - MsgA3 = a3(), - ?line {ok,B3} = asn1_wrapper:encode('P-RecordA3','PersonnelRecord',MsgA3), - ?line {ok,MsgA3} = asn1_wrapper:decode('P-RecordA3','PersonnelRecord',B3), - io:format("compare_format(~p,B3) ->~p~nencval(a3,~p,binary) ->~p~n", - [Erule, - compare_format(Erule,B3), - Variant, - encval(a3,Variant,binary)]), - ?line true = (compare_format(Erule,B3) == encval(a3,Variant,binary)). - -compare_format(Erule,Val) when is_list(Val) -> - compare_format(Erule,list_to_binary(Val)); -%% compare_format(per,Val) -> -%% binary_to_list(Val); -compare_format(_,Val) -> - Val. - -a1() -> +cases(Erule) -> + _ = [begin + Mod = module(Name), + Msg = msg(Name), + Hex = encval(Name, Erule), + Enc = asn1_test_lib:hex_to_bin(Hex), + Enc = asn1_test_lib:roundtrip_enc(Mod, 'PersonnelRecord', Msg) + end || Name <- [a1,a2,a3]], + ok. + +module(a1) -> 'P-RecordA1'; +module(a2) -> 'P-RecordA2'; +module(a3) -> 'P-RecordA3'. + +msg(a1) -> {'PersonnelRecord', {'Name',"John", "P", "Smith"}, "Director", @@ -73,12 +48,10 @@ a1() -> "19571111"}, {'ChildInformation', {'Name', "Susan", "B", "Jones"}, - "19590717"}]}. - -a2() -> - a1(). - -a3() -> + "19590717"}]}; +msg(a2) -> + msg(a1); +msg(a3) -> {'PersonnelRecord', {'Name',"John", "P", "Smith"}, "Director", @@ -94,119 +67,15 @@ a3() -> "19590717", female}]}. -encval(An,Variant,Encoding) when Encoding == hex; Encoding == binary -> - Msg = encval(An,Variant), - encoding(Encoding,Msg). - -encval(a1,aligned) -> +encval(a1, per) -> "80044A6F 686E0150 05536D69 74680133 08446972 6563746F 72083139 37313039 3137044D 61727901 5405536D 69746802 0552616C 70680154 05536D69 74680831 39353731 31313105 53757361 6E014205 4A6F6E65 73083139 35393037 3137"; -encval(a1,unaligned) -> +encval(a1, uper) -> "824ADFA3 700D005A 7B74F4D0 02661113 4F2CB8FA 6FE410C5 CB762C1C B16E0937 0F2F2035 0169EDD3 D340102D 2C3B3868 01A80B4F 6E9E9A02 18B96ADD 8B162C41 69F5E787 700C2059 5BF765E6 10C5CB57 2C1BB16E"; -encval(a2,aligned) -> +encval(a2, per) -> "864A6F68 6E501053 6D697468 01330844 69726563 746F7219 7109170C 4D617279 5410536D 69746802 1052616C 70685410 536D6974 68195711 11105375 73616E42 104A6F6E 65731959 0717"; -encval(a2,unaligned) -> +encval(a2, uper) -> "865D51D2 888A5125 F1809984 44D3CB2E 3E9BF90C B8848B86 7396E8A8 8A5125F1 81089B93 D71AA229 4497C632 AE222222 985CE521 885D54C1 70CAC838 B8"; -encval(a3,aligned) -> +encval(a3, per) -> "40C04A6F 686E5008 536D6974 68000033 08446972 6563746F 72001971 0917034D 61727954 08536D69 74680100 52616C70 68540853 6D697468 00195711 11820053 7573616E 42084A6F 6E657300 19590717 010140"; -encval(a3,unaligned) -> +encval(a3, uper) -> "40CBAA3A 5108A512 5F180330 889A7965 C7D37F20 CB8848B8 19CE5BA2 A114A24B E3011372 7AE35422 94497C61 95711118 22985CE5 21842EAA 60B832B2 0E2E0202 80". - -encoding(binary,Msg) -> - list_to_binary(bin(Msg)); -encoding(hex,Msg) -> - hex(Msg). - -bin(Msg) -> - HexList = hex(Msg), - Fun = fun([H1,H2|Rest],F) -> [(H1 bsl 4) + H2|F(Rest,F)];([],_) -> [] end, - Fun(HexList,Fun). - -hex(Msg) -> - [to_hex(X)||X <- Msg,X /= $ ]. - -to_hex(I) when I >= $0, I =< $9 -> - I-48; -to_hex(C) when C >= $A,C =< $F -> - C - 55. - -%% ex('EUTRA','BCCH-DL-SCH-Message',1) -> -%% {'BCCH-DL-SCH-Message', -%% {c1, -%% {systemInformation1, -%% {'SystemInformationBlockType1', -%% {'SystemInformationBlockType1_cellAccessRelatedInformation', -%% [{'SystemInformationBlockType1_cellAccessRelatedInformation_SOF', -%% {'PLMN-Identity'}, -%% true}, -%% {'SystemInformationBlockType1_cellAccessRelatedInformation_SOF', -%% {'PLMN-Identity'}, -%% false}, -%% {'SystemInformationBlockType1_cellAccessRelatedInformation_SOF', -%% {'PLMN-Identity'}, -%% true}], -%% {'TrackingAreaCode'}, -%% {'CellIdentity'}, -%% false, -%% true, -%% true, -%% true}, -%% {'SystemInformationBlockType1_cellSelectionInfo', -%% -50}, -%% 24, -%% [{'SystemInformationBlockType1_schedulinInformation_SOF', -%% {'SystemInformationBlockType1_schedulinInformation_SOF_si-MessageType'}, -%% ms320, -%% {'SystemInformationBlockType1_schedulinInformation_SOF_sib-MappingInfo'} -%% }], -%% 0 -%% } -%% } -%% } -%% }. - -%% eutra1(msg) -> -%% {'BCCH-BCH-Message',{'MasterInformationBlock',[0,1,0,1],[1,0,1,0],{'PHICH-Configuration',short,ffs},[1,0,1,0,0,0,0,0]}}; -%% eutra1(result) -> -%% <<90,80,0>>. - -%% eutra2(msg) -> -%% {'BCCH-DL-SCH-Message', -%% {c1, -%% {systemInformation1, -%% {'SystemInformationBlockType1', -%% {'SystemInformationBlockType1_cellAccessRelatedInformation', -%% [{'SystemInformationBlockType1_cellAccessRelatedInformation_plmn-IdentityList_SEQOF',{'PLMN-Identity'},true}, -%% {'SystemInformationBlockType1_cellAccessRelatedInformation_plmn-IdentityList_SEQOF',{'PLMN-Identity'},false}, -%% {'SystemInformationBlockType1_cellAccessRelatedInformation_plmn-IdentityList_SEQOF',{'PLMN-Identity'},true}], -%% {'TrackingAreaCode'}, -%% {'CellIdentity'}, -%% false, -%% true, -%% true, -%% true -%% }, -%% {'SystemInformationBlockType1_cellSelectionInfo',-50}, -%% 24, -%% [{'SystemInformationBlockType1_schedulinInformation_SEQOF', -%% {'SystemInformationBlockType1_schedulinInformation_SEQOF_si-MessageType'}, -%% ms320, -%% {'SystemInformationBlockType1_schedulinInformation_SEQOF_sib-MappingInfo'}}], -%% 0 -%% } -%% } -%% } -%% }; -%% eutra2(result) -> -%% %% 55 5C A5 E0 -%% <<85,92,165,224>>. - - - -%% compare([H|T1],[H|T2],Acc) -> -%% compare(T1,T2,[H|Acc]); -%% compare([],[],_Acc) -> -%% ok; -%% compare(L1,L2,Acc) -> -%% {miss_match,L1,L2,lists:reverse(Acc)}. - - diff --git a/lib/asn1/vsn.mk b/lib/asn1/vsn.mk index b75de179dc..0861fc2681 100644 --- a/lib/asn1/vsn.mk +++ b/lib/asn1/vsn.mk @@ -1,2 +1,2 @@ #next version number to use is 2.0 -ASN1_VSN = 2.0.2 +ASN1_VSN = 2.0.3 diff --git a/lib/common_test/doc/src/common_test_app.xml b/lib/common_test/doc/src/common_test_app.xml index 84adbb5723..ea4522c40b 100644 --- a/lib/common_test/doc/src/common_test_app.xml +++ b/lib/common_test/doc/src/common_test_app.xml @@ -99,11 +99,11 @@ be executed by Common Test. A test case is represented by an atom, the name of the test case function. A test case group is represented by a <c>group</c> tuple, where <c>GroupName</c>, - an atom, is the name of the group (defined in <c><seealso marker="#Module:groups-0">groups/0</seealso></c>). + an atom, is the name of the group (defined in <seealso marker="#Module:groups-0"><c>groups/0</c></seealso>). Execution properties for groups may also be specified, both for a top level group and for any of its sub-groups. Group execution properties specified here, will override - properties in the group definition (see <c><seealso marker="#Module:groups-0">groups/0</seealso></c>). + properties in the group definition (see <seealso marker="#Module:groups-0"><c>groups/0</c></seealso>). (With value <c>default</c>, the group definition properties will be used).</p> @@ -186,8 +186,8 @@ test cases in the suite).</p> <p>The <c>timetrap</c> tag sets the maximum time each - test case is allowed to execute (including <c><seealso marker="#Module:init_per_testcase-2">init_per_testcase/2</seealso></c> - and <c><seealso marker="#Module:end_per_testcase-2">end_per_testcase/2</seealso></c>). If the timetrap time is + test case is allowed to execute (including <seealso marker="#Module:init_per_testcase-2"><c>init_per_testcase/2</c></seealso> + and <seealso marker="#Module:end_per_testcase-2"><c>end_per_testcase/2</c></seealso>). If the timetrap time is exceeded, the test case fails with reason <c>timetrap_timeout</c>. A <c>TimeFunc</c> function can be used to set a new timetrap by returning a <c>TimeVal</c>. It may also be @@ -203,11 +203,11 @@ in any of the configuration files, all test cases are skipped. For more information about the 'require' functionality, see the reference manual for the function - <c><seealso marker="ct#require-1">ct:require/1/2</seealso></c>.</p> + <seealso marker="ct#require-1"><c>ct:require/1/2</c></seealso>.</p> <p>With <c>userdata</c>, it is possible for the user to specify arbitrary test suite related information which can be - read by calling <c><seealso marker="ct#userdata-2">ct:userdata/2</seealso></c>.</p> + read by calling <seealso marker="ct#userdata-2"><c>ct:userdata/2</c></seealso>.</p> <p>The <c>ct_hooks</c> tag specifies which <seealso marker="ct_hooks_chapter">Common Test Hooks</seealso> @@ -266,7 +266,7 @@ <p>This function is called as the last test case in the suite. It is meant to be used for cleaning up after - <c><seealso marker="#Module:init_per_suite-1">init_per_suite/1</seealso></c>. + <seealso marker="#Module:init_per_suite-1"><c>init_per_suite/1</c></seealso>. For information on <c>save_config</c>, please see <seealso marker="dependencies_chapter#save_config">Dependencies between Test Cases and Suites</seealso> in the User's Guide.</p> @@ -313,13 +313,13 @@ return a list of tagged tuples that specify various properties related to the execution of a test case group (i.e. its test cases and sub-groups). Properties set by - <c><seealso marker="#Module:group-1">group/1</seealso></c> override + <seealso marker="#Module:group-1"><c>group/1</c></seealso> override properties with the same key that have been previously set by - <c><seealso marker="#Module:suite-0">suite/0</seealso></c>.</p> + <seealso marker="#Module:suite-0"><c>suite/0</c></seealso>.</p> <p>The <c>timetrap</c> tag sets the maximum time each - test case is allowed to execute (including <c><seealso marker="#Module:init_per_testcase-2">init_per_testcase/2</seealso></c> - and <c><seealso marker="#Module:end_per_testcase-2">end_per_testcase/2</seealso></c>). If the timetrap time is + test case is allowed to execute (including <seealso marker="#Module:init_per_testcase-2"><c>init_per_testcase/2</c></seealso> + and <seealso marker="#Module:end_per_testcase-2"><c>end_per_testcase/2</c></seealso>). If the timetrap time is exceeded, the test case fails with reason <c>timetrap_timeout</c>. A <c>TimeFunc</c> function can be used to set a new timetrap by returning a <c>TimeVal</c>. It may also be @@ -334,11 +334,11 @@ in any of the configuration files, all test cases in this group are skipped. For more information about the 'require' functionality, see the reference manual for the function - <c><seealso marker="ct#require-1">ct:require/1/2</seealso></c>.</p> + <seealso marker="ct#require-1"><c>ct:require/1/2</c></seealso>.</p> <p>With <c>userdata</c>, it is possible for the user to specify arbitrary test case group related information which can be - read by calling <c><seealso marker="ct#userdata-2">ct:userdata/2</seealso></c>.</p> + read by calling <seealso marker="ct#userdata-2"><c>ct:userdata/2</c></seealso>.</p> <p>The <c>ct_hooks</c> tag specifies which <seealso marker="ct_hooks_chapter">Common Test Hooks</seealso> @@ -371,7 +371,7 @@ test case group. It typically contains initializations which are common for all test cases and sub-groups in the group, and which shall only be performed once. <c>GroupName</c> is the name of the - group, as specified in the group definition (see <c><seealso marker="#Module:groups-0">groups/0</seealso></c>). The + group, as specified in the group definition (see <seealso marker="#Module:groups-0"><c>groups/0</c></seealso>). The <c>Config</c> parameter is the configuration data which can be modified here. The return value of this function is given as <c>Config</c> to all test cases and sub-groups in the group. If <c>{skip,Reason}</c> @@ -400,10 +400,10 @@ <p> OPTIONAL </p> <p>This function is called after the execution of a test case group is finished. - It is meant to be used for cleaning up after <c><seealso marker="#Module:init_per_group-2">init_per_group/2</seealso></c>. + It is meant to be used for cleaning up after <seealso marker="#Module:init_per_group-2"><c>init_per_group/2</c></seealso>. By means of <c>{return_group_result,Status}</c>, it is possible to return a status value for a nested sub-group. The status can be retrieved in - <c><seealso marker="#Module:end_per_group-2">end_per_group/2</seealso></c> for the group on the level above. The status will also + <seealso marker="#Module:end_per_group-2"><c>end_per_group/2</c></seealso> for the group on the level above. The status will also be used by Common Test for deciding if execution of a group should proceed in case the property <c>sequence</c> or <c>repeat_until_*</c> is set.</p> @@ -454,7 +454,7 @@ <p> OPTIONAL </p> <p> This function is called after each test case, and can be used - to clean up after <c><seealso marker="#Module:init_per_testcase-2">init_per_testcase/2</seealso></c> and the test case. + to clean up after <seealso marker="#Module:init_per_testcase-2"><c>init_per_testcase/2</c></seealso> and the test case. Any return value (besides <c>{fail,Reason}</c> and <c>{save_config,SaveConfig}</c>) is ignored. By returning <c>{fail,Reason}</c>, <c>TestCase</c> will be marked as failed (even though it was actually successful in the sense that it returned @@ -496,15 +496,15 @@ <p>This is the test case info function. It is supposed to return a list of tagged tuples that specify various properties related to the execution of this particular test case. - Properties set by <c><seealso marker="#Module:Testcase-0">Testcase/0</seealso></c> override + Properties set by <seealso marker="#Module:Testcase-0"><c>Testcase/0</c></seealso> override properties that have been previously set for the test case - by <c><seealso marker="#Module:group-1">group/1</seealso></c> or <c><seealso marker="#Module:suite-0">suite/0</seealso></c>.</p> + by <seealso marker="#Module:group-1"><c>group/1</c></seealso> or <seealso marker="#Module:suite-0"><c>suite/0</c></seealso>.</p> <p>The <c>timetrap</c> tag sets the maximum time the test case is allowed to execute. If the timetrap time is exceeded, the test case fails with reason - <c>timetrap_timeout</c>. <c><seealso marker="#Module:init_per_testcase-2">init_per_testcase/2</seealso></c> - and <c><seealso marker="#Module:end_per_testcase-2">end_per_testcase/2</seealso></c> are included in the + <c>timetrap_timeout</c>. <seealso marker="#Module:init_per_testcase-2"><c>init_per_testcase/2</c></seealso> + and <seealso marker="#Module:end_per_testcase-2"><c>end_per_testcase/2</c></seealso> are included in the timetrap time. A <c>TimeFunc</c> function can be used to set a new timetrap by returning a <c>TimeVal</c>. It may also be used to trigger a timetrap timeout by, at some point, returning a @@ -518,15 +518,15 @@ configuration files, the test case is skipped. For more information about the 'require' functionality, see the reference manual for the function - <c><seealso marker="ct#require-1">ct:require/1/2</seealso></c>.</p> + <seealso marker="ct#require-1"><c>ct:require/1/2</c></seealso>.</p> <p>If <c>timetrap</c> and/or <c>require</c> is not set, the - default values specified by <c><seealso marker="#Module:suite-0">suite/0</seealso></c> (or - <c><seealso marker="#Module:group-1">group/1</seealso></c>) will be used.</p> + default values specified by <seealso marker="#Module:suite-0"><c>suite/0</c></seealso> (or + <seealso marker="#Module:group-1"><c>group/1</c></seealso>) will be used.</p> <p>With <c>userdata</c>, it is possible for the user to specify arbitrary test case related information which can be - read by calling <c><seealso marker="ct#userdata-3">ct:userdata/3</seealso></c>.</p> + read by calling <seealso marker="ct#userdata-3"><c>ct:userdata/3</c></seealso>.</p> <p>Other tuples than the ones defined will simply be ignored.</p> @@ -554,7 +554,7 @@ <p>This is the implementation of a test case. Here you must call the functions you want to test, and do whatever you need to check the result. If something fails, make sure the - function causes a runtime error, or call <c><seealso marker="ct#fail-1">ct:fail/1/2</seealso></c> + function causes a runtime error, or call <seealso marker="ct#fail-1"><c>ct:fail/1/2</c></seealso> (which also causes the test case process to terminate).</p> <p>Elements from the <c>Config</c> list can e.g. be read @@ -582,7 +582,7 @@ Test Cases and Suites</seealso> in the User's Guide.</p> </desc> </func> - + </funcs> </erlref> diff --git a/lib/common_test/doc/src/config_file_chapter.xml b/lib/common_test/doc/src/config_file_chapter.xml index 1849c17bb8..d3068db17b 100644 --- a/lib/common_test/doc/src/config_file_chapter.xml +++ b/lib/common_test/doc/src/config_file_chapter.xml @@ -80,7 +80,7 @@ test is skipped (unless a default value has been specified, see the <seealso marker="write_test_chapter#info_function">test case info function</seealso> chapter for details). There is also a function - <c><seealso marker="ct#require-1">ct:require/1/2</seealso></c> which can be called from a test case + <seealso marker="ct#require-1"><c>ct:require/1/2</c></seealso> which can be called from a test case in order to check if a specific variable is available. The return value from this function must be checked explicitly and appropriate action be taken depending on the result (e.g. to skip the test case @@ -90,7 +90,7 @@ info-list should look like this: <c>{require,CfgVarName}</c> or <c>{require,AliasName,CfgVarName}</c>. The arguments <c>AliasName</c> and <c>CfgVarName</c> are the same as the - arguments to <c><seealso marker="ct#require-1">ct:require/1/2</seealso></c> which are described in the + arguments to <seealso marker="ct#require-1"><c>ct:require/1/2</c></seealso> which are described in the reference manual for <seealso marker="ct">ct</seealso>. <c>AliasName</c> becomes an alias for the configuration variable, and can be used as reference to the configuration data value. @@ -103,7 +103,7 @@ (or test case) and improve readability.</item> </list> <p>To read the value of a config variable, use the function - <c><seealso marker="ct#get_config-1">get_config/1/2/3</seealso></c> + <seealso marker="ct#get_config-1"><c>get_config/1/2/3</c></seealso> which is also described in the reference manual for <seealso marker="ct">ct</seealso>.</p> <p>Example:</p> @@ -121,7 +121,7 @@ <section> <title>Using configuration variables defined in multiple files</title> <p>If a configuration variable is defined in multiple files and you - want to access all possible values, you may use the <c><seealso marker="ct#get_config-3">ct:get_config/3</seealso></c> + want to access all possible values, you may use the <seealso marker="ct#get_config-3"><c>ct:get_config/3</c></seealso> function and specify <c>all</c> in the options list. The values will then be returned in a list and the order of the elements corresponds to the order that the config files were specified at startup. Please see @@ -133,7 +133,7 @@ <marker id="encrypted_config_files"></marker> <p>It is possible to encrypt configuration files containing sensitive data if these files must be stored in open and shared directories.</p> - <p>Call <c><seealso marker="ct#encrypt_config_file-2">ct:encrypt_config_file/2/3</seealso></c> to have Common Test encrypt a + <p>Call <seealso marker="ct#encrypt_config_file-2"><c>ct:encrypt_config_file/2/3</c></seealso> to have Common Test encrypt a specified file using the DES3 function in the OTP <c>crypto</c> application. The encrypted file can then be used as a regular configuration file, in combination with other encrypted files or normal text files. The key @@ -142,7 +142,7 @@ <c>decrypt_file</c> flag/option, or a key file in a predefined location.</p> <p>Common Test also provides decryption functions, - <c><seealso marker="ct#decrypt_config_file-2">ct:decrypt_config_file/2/3</seealso></c>, for recreating the original text + <seealso marker="ct#decrypt_config_file-2"><c>ct:decrypt_config_file/2/3</c></seealso>, for recreating the original text files.</p> <p>Please see the <seealso marker="ct">ct</seealso> reference manual for @@ -152,8 +152,8 @@ <section> <title>Opening connections by using configuration data</title> <p>There are two different methods for opening a connection - by means of the support functions in e.g. <c><seealso marker="ct_ssh">ct_ssh</seealso></c>, <c><seealso marker="ct_ftp">ct_ftp</seealso></c>, - and <c><seealso marker="ct_telnet">ct_telnet</seealso></c>:</p> + by means of the support functions in e.g. <seealso marker="ct_ssh"><c>ct_ssh</c></seealso>, <seealso marker="ct_ftp"><c>ct_ftp</c></seealso>, + and <seealso marker="ct_telnet"><c>ct_telnet</c></seealso>:</p> <list> <item>Using a configuration target name (an alias) as reference.</item> <item>Using the configuration variable as reference.</item> diff --git a/lib/common_test/doc/src/cover_chapter.xml b/lib/common_test/doc/src/cover_chapter.xml index 2d504b485f..a215c8c2f3 100644 --- a/lib/common_test/doc/src/cover_chapter.xml +++ b/lib/common_test/doc/src/cover_chapter.xml @@ -94,7 +94,7 @@ <p><c>$ ct_run -dir $TESTOBJS/db -cover $TESTOBJS/db/config/db.coverspec</c></p> <p>You may also pass the cover specification file name in a - call to <c><seealso marker="ct#run_test-1">ct:run_test/1</seealso></c>, by adding a <c>{cover,CoverSpec}</c> + call to <seealso marker="ct#run_test-1"><c>ct:run_test/1</c></seealso>, by adding a <c>{cover,CoverSpec}</c> tuple to the <c>Opts</c> argument. Also, you can of course enable code coverage in your test specifications (read more in the chapter about @@ -102,8 +102,8 @@ specifications</seealso>).</p> </section> - <marker id="cover_stop"></marker> <section> + <marker id="cover_stop"></marker> <title>Stopping the cover tool when tests are completed</title> <p>By default the Cover tool is automatically stopped when the tests are completed. This causes the original (non cover @@ -120,8 +120,8 @@ <p>The option can be set by using the <c>-cover_stop</c> flag with <c>ct_run</c>, by adding <c>{cover_stop,true|false}</c> to the - Opts argument to <c><seealso - marker="ct#run_test-1">ct:run_test/1</seealso></c>, or by adding + Opts argument to <seealso + marker="ct#run_test-1"><c>ct:run_test/1</c></seealso>, or by adding a <c>cover_stop</c> term in your test specification (see chapter about <seealso marker="run_test_chapter#test_specifications">test @@ -189,8 +189,8 @@ specification file for Common Test).</p> </section> - <marker id="cross_cover"/> <section> + <marker id="cross_cover"/> <title>Cross cover analysis</title> <p>The cross cover mechanism allows cover analysis of modules across multiple tests. It is useful if some code, e.g. a library diff --git a/lib/common_test/doc/src/ct_hooks_chapter.xml b/lib/common_test/doc/src/ct_hooks_chapter.xml index fe871eb516..60cd9be918 100644 --- a/lib/common_test/doc/src/ct_hooks_chapter.xml +++ b/lib/common_test/doc/src/ct_hooks_chapter.xml @@ -192,12 +192,12 @@ <section> <title>External configuration data and Logging</title> <p>It's possible in the CTH to read configuration data values - by calling <c><seealso marker="ct#get_config-1">ct:get_config/1/2/3</seealso></c> (as explained in the + by calling <seealso marker="ct#get_config-1"><c>ct:get_config/1/2/3</c></seealso> (as explained in the <seealso marker="config_file_chapter#require_config_data"> External configuration data</seealso> chapter). The config variables in question must, as always, first have been <c>required</c> by means of a suite-, group-, or test case info function, - or the <c><seealso marker="ct#require-1">ct:require/1/2</seealso></c> function. Note that the latter can also be used + or the <seealso marker="ct#require-1"><c>ct:require/1/2</c></seealso> function. Note that the latter can also be used in CT hook functions.</p> <p>The CT hook functions may call any of the logging functions available in the <c>ct</c> interface to print information to the log files, or to @@ -252,13 +252,13 @@ {ok, Handle} -> {[{db_handle, Handle} | Config], CTHState#state{ handle = Handle }} end.</code> - <note>If using multiple CTHs, the first part of the return tuple will be + <note><p>If using multiple CTHs, the first part of the return tuple will be used as input for the next CTH. So in the case above the next CTH might get <c>{fail,Reason}</c> as the second parameter. If you have many CTHs which interact, it might be a good idea to not let each CTH return <c>fail</c> or <c>skip</c>. Instead return that an action should be taken through the <c>Config</c> list and implement a CTH which at the end takes - the correct action. </note> + the correct action.</p></note> </section> @@ -301,9 +301,9 @@ post_end_per_testcase(_TC, Config, Return, CTHState) -> %% Do nothing if tc does not crash. {Return, CTHState}.</code> - <note>Recovering from a testcase failure using CTHs should only be done as + <note><p>Recovering from a testcase failure using CTHs should only be done as a last resort. If used wrongly it could become very difficult to - determine which tests pass or fail in a test run</note> + determine which tests pass or fail in a test run</p></note> </section> @@ -322,6 +322,34 @@ post_end_per_testcase(_TC, Config, Return, CTHState) -> </section> + <marker id="synchronizing"/> + <section> + <title>Synchronizing external user applications with Common Test</title> + <p>CTHs can be used to synchronize test runs with external user applications. + The init function may e.g. start and/or communicate with an application that + has the purpose of preparing the SUT for an upcoming test run, or maybe + initialize a database for saving test data to during the test run. The + terminate function may similarly order such an application to reset the SUT + after the test run, and/or tell the application to finish active sessions + and terminate. + Any system error- or progress reports generated during the init- or + termination stage will be saved in the + <seealso marker="run_test_chapter#pre_post_test_io_log">Pre- + and post test I/O log</seealso>. (This is also true for any printouts made + with <c>ct:log/2</c> and <c>ct:pal/2</c>).</p> + <p>In order to ensure that Common Test doesn't start executing tests, or + closes its log files and shuts down, before the external application + is ready for it, Common Test may be synchronized with the application. + During startup and shutdown, Common Test can be suspended, simply by + having a CTH evaluate a <c>receive</c> expression in the init- or terminate + function. The macros <c>?CT_HOOK_INIT_PROCESS</c> (the process executing the hook + init function) and <c>?CT_HOOK_TERMINATE_PROCESS</c> (the process executing + the hook terminate function), each specifies the name of the correct Common Test + process to send a message to in order to return from the <c>receive</c>. + These macros are defined in <c>ct.hrl</c>. + </p> + </section> + <marker id="example"/> <section> <title>Example CTH</title> diff --git a/lib/common_test/doc/src/ct_master_chapter.xml b/lib/common_test/doc/src/ct_master_chapter.xml index e95823a560..37a0805055 100644 --- a/lib/common_test/doc/src/ct_master_chapter.xml +++ b/lib/common_test/doc/src/ct_master_chapter.xml @@ -220,6 +220,7 @@ <p>The default <seealso marker="ct_slave">ct_slave</seealso> callback module, which is part of the Common Test application, has the following features: + </p> <list> <item>Starting Erlang target nodes on local or remote hosts (ssh is used for communication). @@ -237,7 +238,6 @@ Functions can be given as a list of {Module, Function, Arguments} tuples. </item> </list> - </p> <p>Note that it is possible to specify an <c>eval</c> term for the node as well as <c>startup_functions</c> in the <c>node_start</c> options list. In this case first the node will be started, then the <c>startup_functions</c> are diff --git a/lib/common_test/doc/src/ct_run.xml b/lib/common_test/doc/src/ct_run.xml index a6e61984e6..39259b092a 100644 --- a/lib/common_test/doc/src/ct_run.xml +++ b/lib/common_test/doc/src/ct_run.xml @@ -36,8 +36,6 @@ OS command line. </comsummary> - <marker id="top"></marker> - <description> <p>The <c>ct_run</c> program is automatically installed with Erlang/OTP and Common Test (please see the Installation chapter in the Common @@ -48,7 +46,7 @@ particular mode.</p> <p>There is an interface function that corresponds to this program, - called <c><seealso marker="ct#run_test-1">ct:run_test/1</seealso></c>, for starting Common Test from the Erlang + called <seealso marker="ct#run_test-1"><c>ct:run_test/1</c></seealso>, for starting Common Test from the Erlang shell (or an Erlang program). Please see the <c>ct</c> man page for details.</p> @@ -83,9 +81,9 @@ <p>it prints all valid start flags to stdout.</p> </description> - <marker id="ct_run"></marker> <section> + <marker id="ct_run"></marker> <title>Run tests from command line</title> <pre> ct_run [-dir TestDir1 TestDir2 .. TestDirN] | diff --git a/lib/common_test/doc/src/event_handler_chapter.xml b/lib/common_test/doc/src/event_handler_chapter.xml index 824240ef7d..65cc2a4042 100644 --- a/lib/common_test/doc/src/event_handler_chapter.xml +++ b/lib/common_test/doc/src/event_handler_chapter.xml @@ -64,7 +64,7 @@ <marker id="usage"></marker> <title>Usage</title> <p>Event handlers may be installed by means of an <c>event_handler</c> - start flag (<c>ct_run</c>) or option (<c><seealso marker="ct#run_test-1">ct:run_test/1</seealso></c>), where the + start flag (<c>ct_run</c>) or option (<seealso marker="ct#run_test-1"><c>ct:run_test/1</c></seealso>), where the argument specifies the names of one or more event handler modules. Example:</p> <p><c>$ ct_run -suite test/my_SUITE -event_handler handlers/my_evh1 @@ -78,7 +78,7 @@ example).</p> <p>An event_handler tuple in the argument <c>Opts</c> has the following - definition (see also <c><seealso marker="ct#run_test-1">ct:run_test/1</seealso></c> in the reference manual):</p> + definition (see also <seealso marker="ct#run_test-1"><c>ct:run_test/1</c></seealso> in the reference manual):</p> <pre> {event_handler,EventHandlers} @@ -224,8 +224,9 @@ <c>end_per_testcase</c> for the case failed. </p></item> + <item> <marker id="tc_auto_skip"></marker> - <item><c>#event{name = tc_auto_skip, data = {Suite,Func,Reason}}</c> + <c>#event{name = tc_auto_skip, data = {Suite,Func,Reason}}</c> <p><c>Suite = atom()</c>, the name of the suite.</p> <p><c>Func = atom()</c>, the name of the test case or configuration function.</p> <p><c>Reason = {failed,FailReason} | @@ -251,8 +252,9 @@ the <c>tc_done</c> event. </p></item> + <item> <marker id="tc_user_skip"></marker> - <item><c>#event{name = tc_user_skip, data = {Suite,TestCase,Comment}}</c> + <c>#event{name = tc_user_skip, data = {Suite,TestCase,Comment}}</c> <p><c>Suite = atom()</c>, name of the suite.</p> <p><c>TestCase = atom()</c>, name of the test case.</p> <p><c>Comment = string()</c>, reason for skipping the test case.</p> @@ -308,7 +310,7 @@ manager can look like.</p> <note><p>To ensure that printouts to standard out (or printouts made with - <c><seealso marker="ct#log-2">ct:log/2/3</seealso></c> or <c><seealso marker="ct:pal-2">ct:pal/2/3</seealso></c>) get written to the test case log + <seealso marker="ct#log-2"><c>ct:log/2/3</c></seealso> or <seealso marker="ct:pal-2"><c>ct:pal/2/3</c></seealso>) get written to the test case log file, and not to the Common Test framework log, you can syncronize with the Common Test server by matching on the <c>tc_start</c> and <c>tc_done</c> events. In the period between these events, all IO gets directed to the diff --git a/lib/common_test/doc/src/getting_started_chapter.xml b/lib/common_test/doc/src/getting_started_chapter.xml index 06610bef25..445c731d01 100644 --- a/lib/common_test/doc/src/getting_started_chapter.xml +++ b/lib/common_test/doc/src/getting_started_chapter.xml @@ -61,13 +61,11 @@ <title>Test case execution</title> <p>Execution of test cases is handled this way:</p> - <p> <image file="tc_execution.gif"> <icaption> Successful vs unsuccessful test case execution. </icaption> </image> - </p> <p>For each test case that Common Test is told to execute, it spawns a dedicated process on which the test case function in question starts @@ -90,7 +88,7 @@ <p>As you can understand from the illustration above, Common Test requires that a test case generates a runtime error to indicate failure (e.g. by causing a bad match error or by calling <c>exit/1</c>, preferrably - through the <c><seealso marker="ct#fail-1">ct:fail/1,2</seealso></c> help function). A succesful execution is + through the <seealso marker="ct#fail-1"><c>ct:fail/1,2</c></seealso> help function). A succesful execution is indicated by means of a normal return from the test case function. </p> </section> @@ -100,13 +98,15 @@ <p>As you've seen in the basics chapter, the test suite module implements <seealso marker="common_test">callback functions</seealso> (mandatory or optional) for various purposes, e.g: + </p> <list> <item>Init/end configuration function for the test suite</item> <item>Init/end configuration function for a test case</item> <item>Init/end configuration function for a test case group</item> <item>Test cases</item> </list> - The configuration functions are optional and if you don't need them for + <p> + The configuration functions are optional and if you don't need them for your test, a test suite with one simple test case could look like this: </p> <pre> @@ -136,13 +136,11 @@ "lower level"). The data flow looks like this: </p> - <p> <image file="config.gif"> <icaption> Config data flow in the suite. </icaption> </image> - </p> <p> Here's an example of a test suite which uses configuration functions @@ -203,13 +201,11 @@ shows the log file structure: </p> - <p> <image file="html_logs.gif"> <icaption> HTML log file structure. </icaption> </image> - </p> </section> <section> diff --git a/lib/common_test/doc/src/install_chapter.xml b/lib/common_test/doc/src/install_chapter.xml index ca15cba511..7f8c606324 100644 --- a/lib/common_test/doc/src/install_chapter.xml +++ b/lib/common_test/doc/src/install_chapter.xml @@ -56,13 +56,13 @@ shell script version run_test, however, this script needs to be generated first, according to the instructions below.</p> - <p><note>Before reading on, please note that since Common Test version + <note><p>Before reading on, please note that since Common Test version 1.5, the run_test shell script is no longer required for starting tests with Common Test from the OS command line. The ct_run program (descibed above) is the new recommended command line interface for Common Test. The shell script exists mainly for legacy reasons and may not be updated in future releases of Common Test. It may even be removed. - </note></p> + </p></note> <p>Optional step to generate a shell script for starting Common Test:</p> <p>To generate the run_test shell script, navigate to the diff --git a/lib/common_test/doc/src/notes.xml b/lib/common_test/doc/src/notes.xml index cc3c5231a5..b4a5c610cf 100644 --- a/lib/common_test/doc/src/notes.xml +++ b/lib/common_test/doc/src/notes.xml @@ -32,6 +32,99 @@ <file>notes.xml</file> </header> +<section><title>Common_Test 1.7.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Documentation is added for ct_netconfc:send and + ct_netconfc:send_rpc.</p> + <p> + Own Id: OTP-11132</p> + </item> + <item> + <p> + ct_netconfc:create_subscription only allowed one XML + element inside the 'filter' element. According to RFC5277 + it should be allowed to add any number of elements inside + the filter, so this is now corrected.</p> + <p> + Own Id: OTP-11166</p> + </item> + <item> + <p> + The error handler installed by the Common Test hook + cth_log_redirect did not respond to init:stop/1/2. This + has been corrected.</p> + <p> + Own Id: OTP-11175 Aux Id: seq12356 </p> + </item> + <item> + <p> + Calling ct:pal/2 or ct:print/2 when Common Test was not + running, would cause an exit. This has been changed and + the string is now simply printed to stdout instead.</p> + <p> + Own Id: OTP-11176</p> + </item> + <item> + <p> + Fixed problem with the cth_log_redirect hook making calls + to an undefined function in ct_logs.</p> + <p> + Own Id: OTP-11238</p> + </item> + <item> + <p> + When running tests with the 'repeat' option, the Common + Test utility process did not always terminate quickly + enough after a test run, causing the start of the next + run to fail. A monitor is now used to ensure termination + of the utility process after each test run.</p> + <p> + Own Id: OTP-11244 Aux Id: seq12396 </p> + </item> + <item> + <p> + Test Server installed an error handler (test_server_h) + only to be able to write the name of the current test + case to stdout whenever it received an error- or progress + report. This functionality was not useful and has been + removed. The built-in Common Test hook, cth_log_redirect, + has instead been improved to now also tag all error- and + progress reports in the log with suite-, group-, and/or + test case name.</p> + <p> + Own Id: OTP-11263 Aux Id: seq12251 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + A new log, the "Pre- and Post Test I/O Log", has been + introduced, which makes it possible to capture error- and + progress reports, as well as printouts made with ct:log/2 + and ct:pal/2, before and after a test run. (Some minor + improvements of the logging system have been made at the + same time). Links to the new log are found on the Common + Test Framework Log page. The Common Test User's Guide has + been updated with information about the new log and also + with a new section on how to synchronize external + applications with Common Test by means of the CT Hook + init and terminate functions.</p> + <p> + Own Id: OTP-11272</p> + </item> + </list> + </section> + +</section> + <section><title>Common_Test 1.7.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/common_test/doc/src/run_test_chapter.xml b/lib/common_test/doc/src/run_test_chapter.xml index 4f826d4e31..03d98eb371 100644 --- a/lib/common_test/doc/src/run_test_chapter.xml +++ b/lib/common_test/doc/src/run_test_chapter.xml @@ -21,7 +21,7 @@ </legalnotice> - <title>Running Tests</title> + <title>Running Tests and Analyzing Results</title> <prepared>Peter Andersson, Kenneth Lundin</prepared> <docno></docno> <date></date> @@ -105,8 +105,8 @@ RPC from a remote node.</p> </section> - <marker id="ct_run"></marker> <section> + <marker id="ct_run"></marker> <title>Running tests from the OS command line</title> <p>The <c>ct_run</c> program can be used for running tests from @@ -225,15 +225,15 @@ <p>Common Test provides an Erlang API for running tests. The main (and most flexible) function for specifying and executing tests is called - <c><seealso marker="ct#run_test-1">ct:run_test/1</seealso></c>. + <seealso marker="ct#run_test-1"><c>ct:run_test/1</c></seealso>. This function takes the same start parameters as - the <c><seealso marker="run_test_chapter#ct_run">ct_run</seealso></c> + the <seealso marker="run_test_chapter#ct_run"><c>ct_run</c></seealso> program described above, only the flags are instead given as options in a list of key-value tuples. E.g. a test specified with <c>ct_run</c> like:</p> <p><c>$ ct_run -suite ./my_SUITE -logdir ./results</c></p> - <p>is with <c><seealso marker="ct#run_test-1">ct:run_test/1</seealso></c> specified as:</p> + <p>is with <seealso marker="ct#run_test-1"><c>ct:run_test/1</c></seealso> specified as:</p> <p><c>1> ct:run_test([{suite,"./my_SUITE"},{logdir,"./results"}]).</c></p> <p>The function returns the test result, represented by the tuple: @@ -245,7 +245,7 @@ <section> <title>Releasing the Erlang shell</title> <p>During execution of tests, started with - <c><seealso marker="ct#run_test-1">ct:run_test/1</seealso></c>, + <seealso marker="ct#run_test-1"><c>ct:run_test/1</c></seealso>, the Erlang shell process, controlling stdin, will remain the top level process of the Common Test system of processes. The result is that the Erlang shell is not available for interaction during @@ -260,19 +260,19 @@ <c>ct:run_test/1</c> returns the pid of this process rather than the test result - which instead is printed to tty at the end of the test run.</p> <note><p>Note that in order to use the - <c><seealso marker="ct#break-1">ct:break/1/2</seealso></c> and - <c><seealso marker="ct#continue-0">ct:continue/0/1</seealso></c> functions, + <seealso marker="ct#break-1"><c>ct:break/1/2</c></seealso> and + <seealso marker="ct#continue-0"><c>ct:continue/0/1</c></seealso> functions, <c>release_shell</c> <em>must</em> be set to <c>true</c>.</p></note> </section> <p>For detailed documentation about - <c><seealso marker="ct#run_test-1">ct:run_test/1</seealso></c>, + <seealso marker="ct#run_test-1"><c>ct:run_test/1</c></seealso>, please see the - <c><seealso marker="ct#run_test-1">ct</seealso></c> manual page.</p> + <seealso marker="ct#run_test-1"><c>ct</c></seealso> manual page.</p> </section> - <marker id="group_execution"></marker> <section> + <marker id="group_execution"></marker> <title>Test case group execution</title> <p>With the <c>ct_run</c> flag, or <c>ct:run_test/1</c> option <c>group</c>, @@ -442,9 +442,9 @@ for trying out various operations during test suite development.</p> <p>To invoke the interactive shell mode, you can start an Erlang shell - manually and call <c><seealso marker="ct#install-1">ct:install/1</seealso></c> to install any configuration + manually and call <seealso marker="ct#install-1"><c>ct:install/1</c></seealso> to install any configuration data you might need (use <c>[]</c> as argument otherwise), then - call <c><seealso marker="ct#start_interactive-0">ct:start_interactive/0</seealso></c> to start Common Test. If you use + call <seealso marker="ct#start_interactive-0"><c>ct:start_interactive/0</c></seealso> to start Common Test. If you use the <c>ct_run</c> program, you may start the Erlang shell and Common Test in the same go by using the <c>-shell</c> and, optionally, the <c>-config</c> and/or <c>-userconfig</c> flag. Examples: @@ -463,8 +463,8 @@ <p>If any functions using "required config data" (e.g. ct_telnet or ct_ftp functions) are to be called from the erlang shell, config - data must first be required with <c><seealso marker="ct#require-1"> - ct:require/1/2</seealso></c>. This is + data must first be required with <seealso marker="ct#require-1"><c> + ct:require/1/2</c></seealso>. This is equivalent to a <c>require</c> statement in the <seealso marker="write_test_chapter#suite">Test Suite Info Function</seealso> or in the <seealso @@ -491,11 +491,11 @@ is not supported.</p> <p>If you wish to exit the interactive mode (e.g. to start an - automated test run with <c><seealso marker="ct#run_test-1">ct:run_test/1</seealso></c>), call the function - <c><seealso marker="ct#stop_interactive-0">ct:stop_interactive/0</seealso></c>. This shuts down the + automated test run with <seealso marker="ct#run_test-1"><c>ct:run_test/1</c></seealso>), call the function + <seealso marker="ct#stop_interactive-0"><c>ct:stop_interactive/0</c></seealso>. This shuts down the running <c>ct</c> application. Associations between configuration names and data created with <c>require</c> are - consequently deleted. <c><seealso marker="ct#start_interactive-0">ct:start_interactive/0</seealso></c> will get you + consequently deleted. <seealso marker="ct#start_interactive-0"><c>ct:start_interactive/0</c></seealso> will get you back into interactive mode, but the previous state is not restored.</p> </section> @@ -503,7 +503,7 @@ <title>Step by step execution of test cases with the Erlang Debugger</title> <p>By means of <c>ct_run -step [opts]</c>, or by passing the - <c>{step,Opts}</c> option to <c><seealso marker="ct#run_test-1">ct:run_test/1</seealso></c>, it is possible + <c>{step,Opts}</c> option to <seealso marker="ct#run_test-1"><c>ct:run_test/1</c></seealso>, it is possible to get the Erlang Debugger started automatically and use its graphical interface to investigate the state of the current test case and to execute it step by step and/or set execution breakpoints.</p> @@ -527,17 +527,17 @@ with <c>dir</c>.</p> </section> - <marker id="test_specifications"></marker> <section> + <marker id="test_specifications"></marker> <title>Test Specifications</title> <section> <title>General description</title> <p>The most flexible way to specify what to test, is to use a so called test specification. A test specification is a sequence of Erlang terms. The terms are normally declared in one or more text files - (see <c><seealso marker="ct#run_test-1">ct:run_test/1</seealso></c>), but + (see <seealso marker="ct#run_test-1"><c>ct:run_test/1</c></seealso>), but may also be passed to Common Test on the form of a list (see - <c><seealso marker="ct#run_testspec-1">ct:run_testspec/1</seealso></c>). + <seealso marker="ct#run_testspec-1"><c>ct:run_testspec/1</c></seealso>). There are two general types of terms: configuration terms and test specification terms.</p> <p>With configuration terms it is possible to e.g. label the test @@ -989,7 +989,7 @@ <c>ct_run</c>. This forces Common Test to ignore unrecognizable terms. Note that in this mode, Common Test is not able to check the specification for errors as efficiently as if the scanner runs in default mode. - If <c><seealso marker="ct#run_test-1">ct:run_test/1</seealso></c> is used + If <seealso marker="ct#run_test-1"><c>ct:run_test/1</c></seealso> is used for starting the tests, the relaxed scanner mode is enabled by means of the tuple: <c>{allow_user_terms,true}</c></p> </section> @@ -999,7 +999,7 @@ <title>Running tests from the Web based GUI</title> <p>The web based GUI, VTS, is started with the - <c><seealso marker="run_test_chapter#ct_run">ct_run</seealso></c> + <seealso marker="run_test_chapter#ct_run"><c>ct_run</c></seealso> program. From the GUI you can load config files, and select directories, suites and cases to run. You can also state the config files, directories, suites and cases on the command line @@ -1087,18 +1087,18 @@ </list> <p>On the test run index page there is a link to the Common Test - Framework log file in which information about imported - configuration data and general test progress is written. This - log file is useful to get snapshot information about the test - run during execution. It can also be very helpful when - analyzing test results or debugging test suites.</p> + Framework Log file in which information about imported + configuration data and general test progress is written. This + log file is useful to get snapshot information about the test + run during execution. It can also be very helpful when + analyzing test results or debugging test suites.</p> <p>On the test run index page it is noted if a test has missing suites (i.e. suites that Common Test has failed to compile). Names of the missing suites can be found in the - Common Test Framework log file.</p> + Common Test Framework Log file.</p> - <p>The major logfile shows a detailed report of the test run. It + <p>The major log file shows a detailed report of the test run. It includes test suite and test case names, execution time, the exact reason for failures etc. The information is available in both a file with textual and with HTML representation. The HTML file shows a @@ -1172,6 +1172,40 @@ <url href="http://tablesorter.com">tablesorter</url> plugin, with customized sorting functions, for this implementation.</p> </section> + + <section> + <title>The Unexpected I/O Log</title> + <p>On the test suites overview page you find a link to the Unexpected I/O Log. + In this log, Common Test saves printouts made with + <c>ct:log/2</c> and <c>ct:pal/2</c>, as well as captured system error- and + progress reports, that cannot be associated with particular test cases and + therefore cannot be written to individual test case log files. This happens e.g. + if a log printout is made from an external process (not a test case process), + or if an error- or progress report comes in, during a short interval while Common + Test is not executing a test case or configuration function, <em>or</em> while + Common Test is currently executing a parallell test case group.</p> + </section> + + <section> + <marker id="pre_post_test_io_log"></marker> + <title>The Pre- and Post Test I/O Log</title> + <p>On the Common Test Framework Log page you find links to the so called + Pre- and Post Test I/O Log. In this log, Common Test saves printouts made with + <c>ct:log/2</c> and <c>ct:pal/2</c>, as well as captured system error- + and progress reports, that take place before - and after - the actual test run. + Examples of this are printouts from a CT hook init- or terminate function, or + progress reports generated when an OTP application is started from a CT hook + init function. Another example is an error report generated due to + a failure when an external application is stopped from a CT hook terminate function. + All information in these examples ends up in the Pre- and Post Test I/O Log. + For more information on how to synchronize test runs with external user + applications, please see the + <seealso marker="ct_hooks_chapter#synchronizing">Synchronizing</seealso> + section in the Common Test Hooks chapter.</p> + <p>Note that logging to file with <c>ct:log/2</c> or <c>ct:pal/2</c> + only works when Common Test is running. Printouts with <c>ct:pal/2</c> + are however always displayed on screen.</p> + </section> </section> <section> diff --git a/lib/common_test/doc/src/write_test_chapter.xml b/lib/common_test/doc/src/write_test_chapter.xml index 69b17f3c4b..055fb90641 100644 --- a/lib/common_test/doc/src/write_test_chapter.xml +++ b/lib/common_test/doc/src/write_test_chapter.xml @@ -129,8 +129,8 @@ </p> </section> - <marker id="per_testcase"/> <section> + <marker id="per_testcase"/> <title>Init and end per test case</title> <p>Each test suite module can contain the optional configuration functions @@ -173,7 +173,7 @@ </p> <p>The <c>end_per_testcase/2</c> function is called even after a - test case terminates due to a call to <c><seealso marker="ct#abort_current_testcase-1">ct:abort_current_testcase/1</seealso></c>, + test case terminates due to a call to <seealso marker="ct#abort_current_testcase-1"><c>ct:abort_current_testcase/1</c></seealso>, or after a timetrap timeout. However, <c>end_per_testcase</c> will then execute on a different process than the test case function, and in this situation, <c>end_per_testcase</c> will @@ -243,8 +243,8 @@ <note><p>The test case function argument <c>Config</c> should not be confused with the information that can be retrieved from - configuration files (using <c><seealso marker="ct#get_config-1"> - ct:get_config/1/2</seealso></c>). The Config argument + configuration files (using <seealso marker="ct#get_config-1"><c> + ct:get_config/1/2</c></seealso>). The Config argument should be used for runtime configuration of the test suite and the test cases, while configuration files should typically contain data related to the SUT. These two types of configuration data are handled @@ -303,7 +303,7 @@ <item> <p> Use this to specify arbitrary data related to the testcase. This - data can be retrieved at any time using the <c><seealso marker="ct#userdata-3">ct:userdata/3</seealso></c> + data can be retrieved at any time using the <seealso marker="ct#userdata-3"><c>ct:userdata/3</c></seealso> utility function. </p> </item> @@ -348,8 +348,8 @@ </taglist> <p>See the <seealso marker="config_file_chapter#require_config_data">Config files</seealso> - chapter and the <c><seealso marker="ct#require-1"> - ct:require/1/2</seealso></c> function in the + chapter and the <seealso marker="ct#require-1"><c> + ct:require/1/2</c></seealso> function in the <seealso marker="ct">ct</seealso> reference manual for more information about <c>require</c>.</p> @@ -826,14 +826,16 @@ Common Test to create one dedicated private directory per test case and execution instead. This is accomplished by means of the flag/option: <c>create_priv_dir</c> (to be used with the - <c>ct_run</c> program, the <c><seealso marker="ct#run_test-1">ct:run_test/1</seealso></c> function, or + <c>ct_run</c> program, the <seealso marker="ct#run_test-1"><c>ct:run_test/1</c></seealso> function, or as test specification term). There are three possible values for this option: + </p> <list> <item><c>auto_per_run</c></item> <item><c>auto_per_tc</c></item> <item><c>manual_per_tc</c></item> </list> + <p> The first value indicates the default priv_dir behaviour, i.e. one private directory created per test run. The two latter values tell Common Test to generate a unique test directory name @@ -842,7 +844,7 @@ become very inefficient for test runs with many test cases and/or repetitions. Therefore, in case the manual version is instead used, the test case must tell Common Test to create priv_dir when it needs it. - It does this by calling the function <c><seealso marker="ct#make_priv_dir-0">ct:make_priv_dir/0</seealso></c>. + It does this by calling the function <seealso marker="ct#make_priv_dir-0"><c>ct:make_priv_dir/0</c></seealso>. </p> <note><p>You should not depend on current working directory for @@ -890,7 +892,7 @@ <p>It is also possible to dynamically set/reset a timetrap during the excution of a test case, or configuration function. This is done by calling - <c><seealso marker="ct#timetrap-1">ct:timetrap/1</seealso></c>. This function cancels the current timetrap + <seealso marker="ct#timetrap-1"><c>ct:timetrap/1</c></seealso>. This function cancels the current timetrap and starts a new one (that stays active until timeout, or end of the current function).</p> @@ -903,12 +905,12 @@ <p>If a test case needs to suspend itself for a time that also gets multipled by <c>multiply_timetraps</c> (and possibly also scaled up if - <c>scale_timetraps</c> is enabled), the function <c><seealso marker="ct#sleep-1">ct:sleep/1</seealso></c> + <c>scale_timetraps</c> is enabled), the function <seealso marker="ct#sleep-1"><c>ct:sleep/1</c></seealso> may be used (instead of e.g. <c>timer:sleep/1</c>).</p> <p>A function (<c>fun/0</c> or <c>MFA</c>) may be specified as timetrap value in the suite-, group- and test case info function, as - well as argument to the <c><seealso marker="ct#timetrap-1">ct:timetrap/1</seealso></c> function. Examples:</p> + well as argument to the <seealso marker="ct#timetrap-1"><c>ct:timetrap/1</c></seealso> function. Examples:</p> <p><c>{timetrap,{my_test_utils,timetrap,[?MODULE,system_start]}}</c></p> <p><c>ct:timetrap(fun() -> my_timetrap(TestCaseName, Config) end)</c></p> diff --git a/lib/common_test/include/ct.hrl b/lib/common_test/include/ct.hrl index bde2709ad1..44cc33f01e 100644 --- a/lib/common_test/include/ct.hrl +++ b/lib/common_test/include/ct.hrl @@ -32,3 +32,7 @@ -define(STD_VERBOSITY, 50 ). -define(HI_VERBOSITY, 75 ). -define(MAX_VERBOSITY, 100). + +%% name of process executing the CT Hook init and terminate function +-define(CT_HOOK_INIT_PROCESS, ct_util_server). +-define(CT_HOOK_TERMINATE_PROCESS, ct_util_server). diff --git a/lib/common_test/src/ct_hooks.erl b/lib/common_test/src/ct_hooks.erl index 3d87a82e24..e845e9e908 100644 --- a/lib/common_test/src/ct_hooks.erl +++ b/lib/common_test/src/ct_hooks.erl @@ -50,9 +50,8 @@ -spec init(State :: term()) -> ok | {fail, Reason :: term()}. init(Opts) -> - call(get_new_hooks(Opts, undefined) ++ get_builtin_hooks(Opts), + call(get_builtin_hooks(Opts) ++ get_new_hooks(Opts, undefined), ok, init, []). - %% @doc Called after all suites are done. -spec terminate(Hooks :: term()) -> @@ -276,8 +275,10 @@ get_new_hooks(Config, Fun) -> end, get_new_hooks(Config)). get_new_hooks(Config) when is_list(Config) -> - lists:flatmap(fun({?config_name, HookConfigs}) -> + lists:flatmap(fun({?config_name, HookConfigs}) when is_list(HookConfigs) -> HookConfigs; + ({?config_name, HookConfig}) when is_atom(HookConfig) -> + [HookConfig]; (_) -> [] end, Config); diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index bd37b690b6..1a6e4d31a8 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -61,6 +61,7 @@ -define(index_name, "index.html"). -define(totals_name, "totals.info"). -define(log_cache_name, "ct_log_cache"). +-define(misc_io_log, "misc_io.log.html"). -define(table_color1,"#ADD8E6"). -define(table_color2,"#E4F0FE"). @@ -523,7 +524,7 @@ int_footer() -> div_header(Class) -> div_header(Class,"User"). div_header(Class,Printer) -> - "<div class=\"" ++ atom_to_list(Class) ++ "\"><b>*** " ++ Printer ++ + "\n<div class=\"" ++ atom_to_list(Class) ++ "\"><b>*** " ++ Printer ++ " " ++ log_timestamp(now()) ++ " ***</b>". div_footer() -> "</div>". @@ -617,6 +618,34 @@ logger(Parent, Mode, Verbosity) -> end end end, + + test_server_io:start_link(), + MiscIoName = filename:join(Dir, ?misc_io_log), + {ok,MiscIoFd} = file:open(MiscIoName, + [write,{encoding,utf8}]), + test_server_io:set_fd(unexpected_io, MiscIoFd), + + {MiscIoHeader,MiscIoFooter} = + case get_ts_html_wrapper("Pre/post-test I/O log", Dir, false, + Dir, undefined, utf8) of + {basic_html,UH,UF} -> + {UH,UF}; + {xhtml,UH,UF} -> + {UH,UF} + end, + io:put_chars(MiscIoFd, + [MiscIoHeader, + "<a name=\"pretest\"></a>\n", + xhtml("<br>\n<h2>Pre-test Log</h2>", + "<br />\n<h3>PRE-TEST LOG</h3>"), + "\n<pre>\n"]), + MiscIoDivider = + "\n<a name=\"posttest\"></a>\n"++ + xhtml("</pre>\n<br><h2>Post-test Log</h2>\n<pre>\n", + "</pre>\n<br />\n<h3>POST-TEST LOG</h3>\n<pre>\n"), + ct_util:set_testdata_async({misc_io_log,{filename:absname(MiscIoName), + MiscIoDivider,MiscIoFooter}}), + ct_event:notify(#event{name=start_logging,node=node(), data=AbsDir}), make_all_runs_index(start), @@ -627,7 +656,7 @@ logger(Parent, Mode, Verbosity) -> end, file:set_cwd(Dir), make_last_run_index(Time), - CtLogFd = open_ctlog(), + CtLogFd = open_ctlog(?misc_io_log), io:format(CtLogFd,int_header()++int_footer(), [log_timestamp(now()),"Common Test Logger started"]), Parent ! {started,self(),{Time,filename:absname("")}}, @@ -922,7 +951,7 @@ set_evmgr_gl(GL) -> EvMgrPid -> group_leader(GL,EvMgrPid) end. -open_ctlog() -> +open_ctlog(MiscIoName) -> {ok,Fd} = file:open(?ct_log_name,[write,{encoding,utf8}]), io:format(Fd, header("Common Test Framework Log", {[],[1,2],[]}), []), case file:consult(ct_run:variables_file_name("../")) of @@ -937,10 +966,21 @@ open_ctlog() -> "No configuration found for test!!\n", [Variables,Reason]) end, + io:format(Fd, + xhtml("<br><br><h2>Pre/post-test I/O Log</h2>\n", + "<br /><br />\n<h4>PRE/POST TEST I/O LOG</h4>\n"), []), + io:format(Fd, + "\n<ul>\n" + "<li><a href=\"~ts#pretest\">" + "View I/O logged before the test run</a></li>\n" + "<li><a href=\"~ts#posttest\">" + "View I/O logged after the test run</a></li>\n</ul>\n", + [MiscIoName,MiscIoName]), + print_style(Fd,undefined), io:format(Fd, - xhtml("<br><br><h2>Progress Log</h2>\n<pre>\n", - "<br /><br /><h4>PROGRESS LOG</h4>\n<pre>\n"), []), + xhtml("<br><h2>Progress Log</h2>\n<pre>\n", + "<br />\n<h4>PROGRESS LOG</h4>\n<pre>\n"), []), Fd. print_style(Fd,undefined) -> @@ -2856,6 +2896,9 @@ make_relative1(DirTs, CwdTs) -> %%% @doc %%% get_ts_html_wrapper(TestName, PrintLabel, Cwd, TableCols, Encoding) -> + get_ts_html_wrapper(TestName, undefined, PrintLabel, Cwd, TableCols, Encoding). + +get_ts_html_wrapper(TestName, Logdir, PrintLabel, Cwd, TableCols, Encoding) -> TestName1 = if is_list(TestName) -> lists:flatten(TestName); true -> @@ -2876,7 +2919,12 @@ get_ts_html_wrapper(TestName, PrintLabel, Cwd, TableCols, Encoding) -> end end, CTPath = code:lib_dir(common_test), - {ok,CtLogdir} = get_log_dir(true), + + {ok,CtLogdir} = + if Logdir == undefined -> get_log_dir(true); + true -> {ok,Logdir} + end, + AllRuns = make_relative(filename:join(filename:dirname(CtLogdir), ?all_runs_name), Cwd), TestIndex = make_relative(filename:join(filename:dirname(CtLogdir), @@ -3074,16 +3122,8 @@ unexpected_io(Pid,ct_internal,_Importance,List,State) -> IoFun = create_io_fun(Pid,State), io:format(State#logger_state.ct_log_fd, "~ts", [lists:foldl(IoFun, [], List)]); -unexpected_io(Pid,Category,Importance,List,State) -> +unexpected_io(Pid,_Category,_Importance,List,State) -> IoFun = create_io_fun(Pid,State), Data = io_lib:format("~ts", [lists:foldl(IoFun, [], List)]), - %% if unexpected io comes in during startup or shutdown, test_server - %% might not be running - if so (noproc exit), simply print to - %% stdout instead (will result in double printouts when pal is used) - try test_server_io:print_unexpected(Data) of - _ -> - ok - catch - _:{noproc,_} -> tc_print(Category,Importance,Data,[]); - _:Reason -> exit(Reason) - end. + test_server_io:print_unexpected(Data), + ok. diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index 266ca73417..7c797be03e 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -1883,7 +1883,7 @@ verify_suites(TestSuites) -> atom_to_list( Suite)), io:format(user, - "Suite ~w not found" + "Suite ~w not found " "in directory ~ts~n", [Suite,TestDir]), {Found,[{DS,[Name]}|NotFound]} diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl index abda87c2cd..bcc4caa62e 100644 --- a/lib/common_test/src/ct_util.erl +++ b/lib/common_test/src/ct_util.erl @@ -187,6 +187,7 @@ do_start(Parent, Mode, LogDir, Verbosity) -> false -> ok end, + {StartTime,TestLogDir} = ct_logs:init(Mode, Verbosity), ct_event:notify(#event{name=test_start, @@ -198,12 +199,26 @@ do_start(Parent, Mode, LogDir, Verbosity) -> ok -> Parent ! {self(),started}; {fail,CTHReason} -> - ct_logs:tc_print('Suite Callback',CTHReason,[]), + ErrorInfo = if is_atom(CTHReason) -> + io_lib:format("{~p,~p}", + [CTHReason, + erlang:get_stacktrace()]); + true -> + CTHReason + end, + ct_logs:tc_print('Suite Callback',ErrorInfo,[]), self() ! {{stop,{self(),{user_error,CTHReason}}}, {Parent,make_ref()}} catch _:CTHReason -> - ct_logs:tc_print('Suite Callback',CTHReason,[]), + ErrorInfo = if is_atom(CTHReason) -> + io_lib:format("{~p,~p}", + [CTHReason, + erlang:get_stacktrace()]); + true -> + CTHReason + end, + ct_logs:tc_print('Suite Callback',ErrorInfo,[]), self() ! {{stop,{self(),{user_error,CTHReason}}}, {Parent,make_ref()}} end, @@ -392,19 +407,38 @@ loop(Mode,TestData,StartDir) -> return(From,StartDir), loop(From,TestData,StartDir); {{stop,Info},From} -> + test_server_io:reset_state(), + {MiscIoName,MiscIoDivider,MiscIoFooter} = + proplists:get_value(misc_io_log,TestData), + {ok,MiscIoFd} = file:open(MiscIoName, + [append,{encoding,utf8}]), + io:put_chars(MiscIoFd, MiscIoDivider), + test_server_io:set_fd(unexpected_io, MiscIoFd), + Time = calendar:local_time(), ct_event:sync_notify(#event{name=test_done, node=node(), data=Time}), - Callbacks = ets:lookup_element(?suite_table, - ct_hooks, - #suite_data.value), + Callbacks = + try ets:lookup_element(?suite_table, + ct_hooks, + #suite_data.value) of + CTHMods -> CTHMods + catch + %% this is because ct_util failed in init + error:badarg -> [] + end, ct_hooks:terminate(Callbacks), close_connections(ets:tab2list(?conn_table)), ets:delete(?conn_table), ets:delete(?board_table), ets:delete(?suite_table), ets:delete(?verbosity_table), + + io:put_chars(MiscIoFd, "\n</pre>\n"++MiscIoFooter), + test_server_io:stop([unexpected_io]), + test_server_io:finish(), + ct_logs:close(Info, StartDir), ct_event:stop(), ct_config:stop(), @@ -679,8 +713,14 @@ reset_silent_connections() -> %%% @see ct stop(Info) -> case whereis(ct_util_server) of - undefined -> ok; - _ -> call({stop,Info}) + undefined -> + ok; + CtUtilPid -> + Ref = monitor(process, CtUtilPid), + call({stop,Info}), + receive + {'DOWN',Ref,_,_,_} -> ok + end end. %%%----------------------------------------------------------------- diff --git a/lib/common_test/src/cth_log_redirect.erl b/lib/common_test/src/cth_log_redirect.erl index 958b7a94c7..8fed341600 100644 --- a/lib/common_test/src/cth_log_redirect.erl +++ b/lib/common_test/src/cth_log_redirect.erl @@ -25,16 +25,31 @@ %% CTH Callbacks --export([id/1, init/2, post_init_per_group/4, pre_end_per_group/3, - post_end_per_testcase/4]). +-export([id/1, init/2, + pre_init_per_suite/3, pre_end_per_suite/3, post_end_per_suite/4, + pre_init_per_group/3, post_init_per_group/4, + pre_end_per_group/3, post_end_per_group/4, + pre_init_per_testcase/3, post_end_per_testcase/4]). %% Event handler Callbacks -export([init/1, handle_event/2, handle_call/2, handle_info/2, - terminate/1]). + terminate/1, terminate/2, code_change/3]). + +%% Other +-export([handle_remote_events/1]). -include("ct.hrl"). +-behaviour(gen_event). + +-record(eh_state, {log_func, + curr_suite, + curr_group, + curr_func, + parallel_tcs = false, + handle_remote_events = false}). + id(_Opts) -> ?MODULE. @@ -42,36 +57,62 @@ init(?MODULE, _Opts) -> error_logger:add_report_handler(?MODULE), tc_log_async. +pre_init_per_suite(Suite, Config, State) -> + set_curr_func({Suite,init_per_suite}, Config), + {Config, State}. + +pre_end_per_suite(Suite, Config, State) -> + set_curr_func({Suite,end_per_suite}, Config), + {Config, State}. + +post_end_per_suite(_Suite, Config, Return, State) -> + set_curr_func(undefined, Config), + {Return, State}. + +pre_init_per_group(Group, Config, State) -> + set_curr_func({group,Group,init_per_group}, Config), + {Config, State}. + post_init_per_group(Group, Config, Result, tc_log_async) -> case lists:member(parallel,proplists:get_value( tc_group_properties,Config,[])) of true -> - {Result, {set_log_func(ct_log),Group}}; + {Result, {set_log_func(tc_log),Group}}; false -> {Result, tc_log_async} end; post_init_per_group(_Group, _Config, Result, State) -> {Result, State}. +pre_init_per_testcase(TC, Config, State) -> + set_curr_func(TC, Config), + {Config, State}. + post_end_per_testcase(_TC, _Config, Result, State) -> %% Make sure that the event queue is flushed %% before ending this test case. gen_event:call(error_logger, ?MODULE, flush, 300000), {Result, State}. -pre_end_per_group(Group, Config, {ct_log, Group}) -> +pre_end_per_group(Group, Config, {tc_log, Group}) -> + set_curr_func({group,Group,end_per_group}, Config), {Config, set_log_func(tc_log_async)}; -pre_end_per_group(_Group, Config, State) -> +pre_end_per_group(Group, Config, State) -> + set_curr_func({group,Group,end_per_group}, Config), {Config, State}. +post_end_per_group(_Group, Config, Return, State) -> + set_curr_func({group,undefined}, Config), + {Return, State}. %% Copied and modified from sasl_report_tty_h.erl init(_Type) -> - {ok, tc_log_async}. + {ok, #eh_state{log_func = tc_log_async}}. -handle_event({_Type, GL, _Msg}, State) when node(GL) /= node() -> +handle_event({_Type,GL,_Msg}, #eh_state{handle_remote_events = false} = State) + when node(GL) /= node() -> {ok, State}; -handle_event(Event, LogFunc) -> +handle_event(Event, #eh_state{log_func = LogFunc} = State) -> case lists:keyfind(sasl, 1, application:which_applications()) of false -> sasl_not_started; @@ -80,7 +121,8 @@ handle_event(Event, LogFunc) -> SReport = sasl_report:format_report(group_leader(), ErrLogType, tag_event(Event)), if is_list(SReport) -> - ct_logs:LogFunc(sasl, ?STD_IMPORTANCE, "System", SReport, []); + SaslHeader = format_header(State), + ct_logs:LogFunc(sasl, ?STD_IMPORTANCE, SaslHeader, SReport, []); true -> %% Report is an atom if no logging is to be done ignore end @@ -88,27 +130,117 @@ handle_event(Event, LogFunc) -> EReport = error_logger_tty_h:write_event( tag_event(Event),io_lib), if is_list(EReport) -> - ct_logs:LogFunc(error_logger, ?STD_IMPORTANCE, "System", EReport, []); + ErrHeader = format_header(State), + ct_logs:LogFunc(error_logger, ?STD_IMPORTANCE, ErrHeader, EReport, []); true -> %% Report is an atom if no logging is to be done ignore end, - {ok, LogFunc}. - + {ok, State}. + +handle_info({'EXIT',User,killed}, State) -> + case whereis(user) of + %% init:stop/1/2 has been called, let's finish! + undefined -> + remove_handler; + User -> + remove_handler; + _ -> + {ok,State} + end; -handle_info(_,State) -> {ok, State}. +handle_info(_, State) -> + {ok,State}. handle_call(flush,State) -> {ok, ok, State}; -handle_call({set_logfunc,NewLogFunc},_) -> - {ok, NewLogFunc, NewLogFunc}; -handle_call(_Query, _State) -> {error, bad_query}. -terminate(_State) -> +handle_call({set_curr_func,{group,Group,Conf},Config}, State) -> + Parallel = case proplists:get_value(tc_group_properties, Config) of + undefined -> false; + Props -> lists:member(parallel, Props) + end, + {ok, ok, State#eh_state{curr_group = Group, + curr_func = Conf, + parallel_tcs = Parallel}}; +handle_call({set_curr_func,{group,undefined},_Config}, State) -> + {ok, ok, State#eh_state{curr_group = undefined, + curr_func = undefined, + parallel_tcs = false}}; +handle_call({set_curr_func,{Suite,Conf},_Config}, State) -> + {ok, ok, State#eh_state{curr_suite = Suite, + curr_func = Conf, + parallel_tcs = false}}; +handle_call({set_curr_func,undefined,_Config}, State) -> + {ok, ok, State#eh_state{curr_suite = undefined, + curr_func = undefined, + parallel_tcs = false}}; +handle_call({set_curr_func,TC,_Config}, State) -> + {ok, ok, State#eh_state{curr_func = TC}}; + +handle_call({set_logfunc,NewLogFunc}, State) -> + {ok, NewLogFunc, State#eh_state{log_func = NewLogFunc}}; + +handle_call({handle_remote_events,Bool}, State) -> + {ok, ok, State#eh_state{handle_remote_events = Bool}}; + +handle_call(_Query, _State) -> + {error, bad_query}. + +terminate(_) -> error_logger:delete_report_handler(?MODULE), []. +terminate(_Arg, _State) -> + ok. + tag_event(Event) -> {calendar:local_time(), Event}. +set_curr_func(CurrFunc, Config) -> + gen_event:call(error_logger, ?MODULE, {set_curr_func, CurrFunc, Config}). + set_log_func(Func) -> gen_event:call(error_logger, ?MODULE, {set_logfunc, Func}). + +handle_remote_events(Bool) -> + gen_event:call(error_logger, ?MODULE, {handle_remote_events, Bool}). + +%%%----------------------------------------------------------------- + +format_header(#eh_state{curr_suite = undefined, + curr_group = undefined, + curr_func = undefined}) -> + io_lib:format("System report", []); + +format_header(#eh_state{curr_suite = Suite, + curr_group = undefined, + curr_func = undefined}) -> + io_lib:format("System report during ~w", [Suite]); + +format_header(#eh_state{curr_suite = Suite, + curr_group = undefined, + curr_func = TcOrConf}) -> + io_lib:format("System report during ~w:~w/1", + [Suite,TcOrConf]); + +format_header(#eh_state{curr_suite = Suite, + curr_group = Group, + curr_func = Conf}) when Conf == init_per_group; + Conf == end_per_group -> + io_lib:format("System report during ~w:~w/2 for ~w", + [Suite,Conf,Group]); + +format_header(#eh_state{curr_suite = Suite, + curr_group = Group, + parallel_tcs = true}) -> + io_lib:format("System report during ~w in ~w", + [Group,Suite]); + +format_header(#eh_state{curr_suite = Suite, + curr_group = Group, + curr_func = TC}) -> + io_lib:format("System report during ~w:~w/1 in ~w", + [Suite,TC,Group]). + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. diff --git a/lib/common_test/test/Makefile b/lib/common_test/test/Makefile index 9d2edcd653..085f19d023 100644 --- a/lib/common_test/test/Makefile +++ b/lib/common_test/test/Makefile @@ -51,6 +51,7 @@ MODULES= \ ct_master_SUITE \ ct_misc_1_SUITE \ ct_hooks_SUITE \ + ct_pre_post_test_io_SUITE \ ct_netconfc_SUITE \ ct_basic_html_SUITE \ ct_auto_compile_SUITE \ diff --git a/lib/common_test/test/ct_gen_conn_SUITE_data/proto.erl b/lib/common_test/test/ct_gen_conn_SUITE_data/proto.erl index 8fcd35e0a4..1d08ce167b 100644 --- a/lib/common_test/test/ct_gen_conn_SUITE_data/proto.erl +++ b/lib/common_test/test/ct_gen_conn_SUITE_data/proto.erl @@ -1,10 +1,21 @@ -%%% @author Peter Andersson <[email protected]> -%%% @copyright (C) 2013, Peter Andersson -%%% @doc -%%% -%%% @end -%%% Created : 24 May 2013 by Peter Andersson <[email protected]> - +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% -module(proto). -compile(export_all). diff --git a/lib/common_test/test/ct_hooks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE.erl index 796a0832d7..596bfe3ff0 100644 --- a/lib/common_test/test/ct_hooks_SUITE.erl +++ b/lib/common_test/test/ct_hooks_SUITE.erl @@ -84,7 +84,7 @@ all(suite) -> skip_post_suite_cth, recover_post_suite_cth, update_config_cth, state_update_cth, options_cth, same_id_cth, fail_n_skip_with_minimal_cth, prio_cth, no_config, - data_dir + data_dir, cth_log ] ). @@ -222,7 +222,32 @@ data_dir(Config) when is_list(Config) -> do_test(data_dir, "ct_data_dir_SUITE.erl", [verify_data_dir_cth],Config). - +cth_log(Config) when is_list(Config) -> + %% test that cth_log_redirect writes properly to + %% unexpected I/O log + StartOpts = do_test(cth_log, "cth_log_SUITE.erl", [], Config), + Logdir = proplists:get_value(logdir, StartOpts), + UnexpIoLogs = + filelib:wildcard( + filename:join(Logdir, + "ct_run*/cth.tests*/run*/unexpected_io.log.html")), + lists:foreach( + fun(UnexpIoLog) -> + {ok,Bin} = file:read_file(UnexpIoLog), + Ts = string:tokens(binary_to_list(Bin),[$\n]), + Matches = lists:foldl(fun([$=,$E,$R,$R,$O,$R|_], N) -> + N+1; + ([$L,$o,$g,$g,$e,$r|_], N) -> + N+1; + (_, N) -> N + end, 0, Ts), + ct:pal("~p matches in ~tp", [Matches,UnexpIoLog]), + if Matches > 10 -> ok; + true -> exit({no_unexpected_io_found,UnexpIoLog}) + end + end, UnexpIoLogs), + ok. + %%%----------------------------------------------------------------- %%% HELP FUNCTIONS @@ -251,7 +276,8 @@ do_test(Tag, SuiteWildCard, CTHs, Config, Res, EC) -> Opts), TestEvents = events_to_check(Tag, EC), - ok = ct_test_support:verify_events(TestEvents, Events, Config). + ok = ct_test_support:verify_events(TestEvents, Events, Config), + Opts. setup(Test, Config) -> Opts0 = ct_test_support:get_opts(Config), @@ -1187,6 +1213,23 @@ test_events(data_dir) -> {?eh,stop_logging,[]} ]; +test_events(cth_log) -> + [{?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,tc_start,{cth_log_SUITE,init_per_suite}}, + + {parallel, + [{?eh,tc_start,{ct_framework,{init_per_group,g1,[parallel]}}}, + {?eh,tc_done,{ct_framework,{init_per_group,g1,[parallel]},ok}}, + {?eh,test_stats,{30,0,{0,0}}}, + {?eh,tc_start,{ct_framework,{end_per_group,g1,[parallel]}}}, + {?eh,tc_done,{ct_framework,{end_per_group,g1,[parallel]},ok}}]}, + + {?eh,tc_done,{cth_log_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + test_events(ok) -> ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_SUITE.erl new file mode 100644 index 0000000000..18dd07e87e --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_SUITE.erl @@ -0,0 +1,124 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(cth_log_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +%%-------------------------------------------------------------------- +%% @spec suite() -> Info +%% Info = [tuple()] +%% @end +%%-------------------------------------------------------------------- +suite() -> + [{timetrap,{seconds,30}}]. + +%%-------------------------------------------------------------------- +%% @spec init_per_suite(Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + Gen = spawn(fun() -> gen() end), + [{gen,Gen}|Config]. + +%%-------------------------------------------------------------------- +%% @spec end_per_suite(Config0) -> void() | {save_config,Config1} +%% Config0 = Config1 = [tuple()] +%% @end +%%-------------------------------------------------------------------- +end_per_suite(Config) -> + Gen = proplists:get_value(gen, Config), + exit(Gen, kill), + timer:sleep(100), + ok. + +%%-------------------------------------------------------------------- +%% @spec init_per_testcase(TestCase, Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +%% TestCase = atom() +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +init_per_testcase(_TestCase, Config) -> + Config. + +%%-------------------------------------------------------------------- +%% @spec end_per_testcase(TestCase, Config0) -> +%% void() | {save_config,Config1} | {fail,Reason} +%% TestCase = atom() +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +end_per_testcase(_TestCase, _Config) -> + ok. + +%%-------------------------------------------------------------------- +%% @spec groups() -> [Group] +%% Group = {GroupName,Properties,GroupsAndTestCases} +%% GroupName = atom() +%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}] +%% GroupsAndTestCases = [Group | {group,GroupName} | TestCase] +%% TestCase = atom() +%% Shuffle = shuffle | {shuffle,{integer(),integer(),integer()}} +%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail | +%% repeat_until_any_ok | repeat_until_any_fail +%% N = integer() | forever +%% @end +%%-------------------------------------------------------------------- +groups() -> + [{g1,[parallel,{repeat,10}],[tc1,tc2,tc3]}]. + +%%-------------------------------------------------------------------- +%% @spec all() -> GroupsAndTestCases | {skip,Reason} +%% GroupsAndTestCases = [{group,GroupName} | TestCase] +%% GroupName = atom() +%% TestCase = atom() +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +all() -> + [{group,g1}]. + +tc1(_) -> + ct:sleep(100), + ok. +tc2(_) -> + ct:sleep(100), + ok. +tc3(_) -> + ct:sleep(100), + ok. + +%%%----------------------------------------------------------------- + +gen() -> + gen_loop(1). + +gen_loop(N) -> + ct:log("Logger iteration: ~p", [N]), + error_logger:error_report(N), + ct:sleep(200), + gen_loop(N+1). diff --git a/lib/common_test/test/ct_pre_post_test_io_SUITE.erl b/lib/common_test/test/ct_pre_post_test_io_SUITE.erl new file mode 100644 index 0000000000..5de1ecc2bd --- /dev/null +++ b/lib/common_test/test/ct_pre_post_test_io_SUITE.erl @@ -0,0 +1,255 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%%------------------------------------------------------------------- +%%% File: ct_pre_post_test_io_SUITE +%%% +%%% Description: +%%% +%%% Test that ct:log/2 printouts and error/progress reports that happen +%%% before or after the test run are saved in the pre/post test IO log. +%%%------------------------------------------------------------------- +-module(ct_pre_post_test_io_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("common_test/include/ct_event.hrl"). + +-define(eh, ct_test_support_eh). + +%%-------------------------------------------------------------------- +%% TEST SERVER CALLBACK FUNCTIONS +%%-------------------------------------------------------------------- + +%%-------------------------------------------------------------------- +%% Description: Since Common Test starts another Test Server +%% instance, the tests need to be performed on a separate node (or +%% there will be clashes with logging processes etc). +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + DataDir = ?config(data_dir, Config), + CTH = filename:join(DataDir, "cth_ctrl.erl"), + ct:pal("Compiling ~p: ~p", + [CTH,compile:file(CTH,[{outdir,DataDir},debug_info])]), + ct_test_support:init_per_suite([{path_dirs,[DataDir]}, + {start_sasl,true} | Config]). + +end_per_suite(Config) -> + ct_test_support:end_per_suite(Config). + +init_per_testcase(TestCase, Config) -> + ct_test_support:init_per_testcase(TestCase, Config). + +end_per_testcase(TestCase, Config) -> + ct_test_support:end_per_testcase(TestCase, Config). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [ + pre_post_io + ]. + +%%-------------------------------------------------------------------- +%% TEST CASES +%%-------------------------------------------------------------------- + +%%%----------------------------------------------------------------- +%%% +pre_post_io(Config) -> + TC = pre_post_io, + DataDir = ?config(data_dir, Config), + Suite = filename:join(DataDir, "dummy_SUITE"), + {Opts,ERPid} = setup([{suite,Suite},{label,TC},{ct_hooks,[cth_ctrl]}], + Config), + + %%!-------------------------------------------------------------------- + %%! Note that error reports will not start showing up in the pre-test + %%! io log until handle_remote_events has been set to true (see below). + %%! The reason is that the error logger has its group leader on the + %%! test_server node (not the ct node) and cth_log_redirect ignores + %%! events with remote destination until told otherwise. + %%!-------------------------------------------------------------------- + + spawn(fun() -> + ct:pal("CONTROLLER: Started!", []), + %% --- test run 1 --- + timer:sleep(3000), + ct:pal("CONTROLLER: Handle remote events = true", []), + ok = ct_test_support:ct_rpc({cth_log_redirect, + handle_remote_events, + [true]}, Config), + timer:sleep(2000), + ct:pal("CONTROLLER: Proceeding with test run #1!", []), + ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), + timer:sleep(6000), + ct:pal("CONTROLLER: Proceeding with shutdown #1!", []), + ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), + %% --- test run 2 --- + timer:sleep(3000), + ct:pal("CONTROLLER: Handle remote events = true", []), + ok = ct_test_support:ct_rpc({cth_log_redirect, + handle_remote_events, + [true]}, Config), + timer:sleep(2000), + ct:pal("CONTROLLER: Proceeding with test run #2!", []), + ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), + timer:sleep(6000), + ct:pal("CONTROLLER: Proceeding with shutdown #2!", []), + ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config) + end), + ct_test_support:run(Opts, Config), + Events = ct_test_support:get_events(ERPid, Config), + ct_test_support:log_events(TC, + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), + TestEvents = events_to_check(TC), + ok = ct_test_support:verify_events(TestEvents, Events, Config), + + LogDirs = lists:flatmap(fun({_EH,#event{name=start_logging,data=Dir}}) -> + [Dir]; + (_) -> + [] + end, Events), + PrePostIoFiles = + [filename:join(LogDir, "misc_io.log.html") || LogDir <- LogDirs], + lists:foreach( + fun(PrePostIoFile) -> + ct:log("Reading Pre/Post Test IO Log file: ~ts", [PrePostIoFile]), + {ok,Bin} = file:read_file(PrePostIoFile), + Ts = string:tokens(binary_to_list(Bin),[$\n]), + PrePostIOEntries = + lists:foldl(fun([$L,$o,$g,$g,$e,$r|_], + {pre,PreLogN,PreErrN,0,0}) -> + {pre,PreLogN+1,PreErrN,0,0}; + ([$=,$E,$R,$R,$O,$R|_], + {pre,PreLogN,PreErrN,0,0}) -> + {pre,PreLogN,PreErrN+1,0,0}; + ([_,_,_,_,$P,$O,$S,$T,$-,$T,$E,$S,$T|_], + {pre,PreLogN,PreErrN,0,0}) -> + {post,PreLogN,PreErrN,0,0}; + ([$L,$o,$g,$g,$e,$r|_], + {post,PreLogN,PreErrN,PostLogN,PostErrN}) -> + {post,PreLogN,PreErrN,PostLogN+1,PostErrN}; + ([$=,$E,$R,$R,$O,$R|_], + {post,PreLogN,PreErrN,PostLogN,PostErrN}) -> + {post,PreLogN,PreErrN,PostLogN,PostErrN+1}; + (_, Counters) -> + Counters + end, {pre,0,0,0,0}, Ts), + [_|Counters] = tuple_to_list(PrePostIOEntries), + ct:log("Entries in the Pre/Post Test IO Log: ~p", [Counters]), + case [C || C <- Counters, C < 2] of + [] -> + ok; + _ -> + exit("Not enough entries in the Pre/Post Test IO Log!") + end + end, PrePostIoFiles), + + UnexpIoFiles = + [filelib:wildcard( + filename:join(LogDir, + "*dummy_SUITE.logs/run.*/" + "unexpected_io.log.html")) || LogDir <- LogDirs], + lists:foreach( + fun(UnexpIoFile) -> + ct:log("Reading Unexpected IO Log file: ~ts", [UnexpIoFile]), + {ok,Bin} = file:read_file(UnexpIoFile), + Ts = string:tokens(binary_to_list(Bin),[$\n]), + UnexpIOEntries = + lists:foldl(fun([$L,$o,$g,$g,$e,$r|_], [LogN,ErrN]) -> + [LogN+1,ErrN]; + ([$=,$E,$R,$R,$O,$R|_], [LogN,ErrN]) -> + [LogN,ErrN+1]; + (_, Counters) -> Counters + end, [0,0], Ts), + ct:log("Entries in the Unexpected IO Log: ~p", [UnexpIOEntries]), + case [N || N <- UnexpIOEntries, N < 2] of + [] -> + ok; + _ -> + exit("Not enough entries in the Unexpected IO Log!") + end + end, UnexpIoFiles), + ok. + +%%%----------------------------------------------------------------- +%%% HELP FUNCTIONS +%%%----------------------------------------------------------------- + +setup(Test, Config) -> + Opts0 = ct_test_support:get_opts(Config), + Level = ?config(trace_level, Config), + EvHArgs = [{cbm,ct_test_support},{trace_level,Level}], + Opts = Opts0 ++ [{event_handler,{?eh,EvHArgs}}|Test], + ERPid = ct_test_support:start_event_receiver(Config), + {Opts,ERPid}. + +reformat(Events, EH) -> + ct_test_support:reformat(Events, EH). + +%%%----------------------------------------------------------------- +%%% TEST EVENTS +%%%----------------------------------------------------------------- + +events_to_check(pre_post_io) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,7}}, + {?eh,tc_start,{dummy_SUITE,init_per_suite}}, + {?eh,tc_done,{dummy_SUITE,init_per_suite,ok}}, + {parallel, + [{?eh,tc_start,{dummy_SUITE,{init_per_group,g1,[parallel]}}}, + {?eh,tc_done, + {dummy_SUITE,{init_per_group,g1,[parallel]},ok}}, + {?eh,tc_start,{dummy_SUITE,tc1}}, + {?eh,tc_start,{dummy_SUITE,tc2}}, + {?eh,tc_start,{dummy_SUITE,tc3}}, + {?eh,tc_done,{dummy_SUITE,tc2,ok}}, + {?eh,tc_done,{dummy_SUITE,tc1,ok}}, + {?eh,tc_done,{dummy_SUITE,tc3,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + {?eh,test_stats,{2,0,{0,0}}}, + {?eh,test_stats,{3,0,{0,0}}}, + {?eh,tc_start,{dummy_SUITE,{end_per_group,g1,[parallel]}}}, + {?eh,tc_done,{dummy_SUITE,{end_per_group,g1,[parallel]},ok}}]}, + {?eh,tc_start,{dummy_SUITE,tc1}}, + {?eh,tc_done,{dummy_SUITE,tc1,ok}}, + {?eh,test_stats,{4,0,{0,0}}}, + {?eh,tc_start,{dummy_SUITE,tc2}}, + {?eh,tc_done,{dummy_SUITE,tc2,ok}}, + {?eh,test_stats,{5,0,{0,0}}}, + [{?eh,tc_start,{dummy_SUITE,{init_per_group,g2,[]}}}, + {?eh,tc_done,{dummy_SUITE,{init_per_group,g2,[]},ok}}, + {?eh,tc_start,{dummy_SUITE,tc4}}, + {?eh,tc_done,{dummy_SUITE,tc4,ok}}, + {?eh,test_stats,{6,0,{0,0}}}, + {?eh,tc_start,{dummy_SUITE,tc5}}, + {?eh,tc_done,{dummy_SUITE,tc5,ok}}, + {?eh,test_stats,{7,0,{0,0}}}, + {?eh,tc_start,{dummy_SUITE,{end_per_group,g2,[]}}}, + {?eh,tc_done,{dummy_SUITE,{end_per_group,g2,[]},ok}}], + {?eh,tc_start,{dummy_SUITE,end_per_suite}}, + {?eh,tc_done,{dummy_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}]. diff --git a/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl b/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl new file mode 100644 index 0000000000..2ba991fc61 --- /dev/null +++ b/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl @@ -0,0 +1,108 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(cth_ctrl). + +-export([proceed/0, + init/2, terminate/1]). + +-include_lib("common_test/include/ct.hrl"). + +%%%=================================================================== +%%% API +%%%=================================================================== + +proceed() -> + ?MODULE ! proceed, + ok. + +%%-------------------------------------------------------------------- +%% Hook functions +%%-------------------------------------------------------------------- +init(_Id, _Opts) -> + case lists:keyfind(sasl, 1, application:which_applications()) of + false -> + exit(sasl_not_started); + _Else -> + ok + end, + WhoAmI = self(), + WhoAmI = whereis(?CT_HOOK_INIT_PROCESS), + DispPid = spawn_link(fun() -> dispatcher(WhoAmI) end), + register(?MODULE, DispPid), + ct:pal("~n~n+++ Startup of ~w on ~p finished, " + "call ~w:proceed() to run tests...~n", + [?MODULE,node(),?MODULE]), + start_external_logger(cth_logger), + receive + {?MODULE,proceed} -> ok + after + 10000 -> + ok + end, + {ok,[],ct_last}. + +terminate(_State) -> + WhoAmI = whereis(?CT_HOOK_TERMINATE_PROCESS), + WhoAmI = self(), + ct:pal("~n~n+++ Tests finished, call ~w:proceed() to shut down...~n", + [?MODULE]), + receive + {?MODULE,proceed} -> ok + after + 10000 -> + ok + end, + stop_external_logger(cth_logger), + stop_dispatcher(), + ok. + +%%%=================================================================== +%%% Internal functions +%%%=================================================================== + +start_external_logger(Name) -> + case whereis(Name) of + undefined -> ok; + Pid -> exit(Pid, kill) + end, + spawn(fun() -> init_logger(Name) end). + +stop_external_logger(Name) -> + catch exit(whereis(Name), kill). + +init_logger(Name) -> + register(Name, self()), + logger_loop(1). + +logger_loop(N) -> + ct:log("Logger iteration: ~p", [N]), + error_logger:error_report(N), + timer:sleep(250), + logger_loop(N+1). + +%%%----------------------------------------------------------------- + +dispatcher(SendTo) -> + receive Msg -> SendTo ! {?MODULE,Msg} end, + dispatcher(SendTo). + +stop_dispatcher() -> + catch exit(whereis(?MODULE), kill). + + diff --git a/lib/common_test/test/ct_pre_post_test_io_SUITE_data/dummy_SUITE.erl b/lib/common_test/test/ct_pre_post_test_io_SUITE_data/dummy_SUITE.erl new file mode 100644 index 0000000000..ac9c4efd31 --- /dev/null +++ b/lib/common_test/test/ct_pre_post_test_io_SUITE_data/dummy_SUITE.erl @@ -0,0 +1,132 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(dummy_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +%%-------------------------------------------------------------------- +%% @spec suite() -> Info +%% Info = [tuple()] +%% @end +%%-------------------------------------------------------------------- +suite() -> + [{timetrap,{seconds,30}}]. + +%%-------------------------------------------------------------------- +%% @spec init_per_suite(Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + Config. + +%%-------------------------------------------------------------------- +%% @spec end_per_suite(Config0) -> void() | {save_config,Config1} +%% Config0 = Config1 = [tuple()] +%% @end +%%-------------------------------------------------------------------- +end_per_suite(_Config) -> + ok. + +%%-------------------------------------------------------------------- +%% @spec init_per_group(GroupName, Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +%% GroupName = atom() +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +init_per_group(_GroupName, Config) -> + Config. + +%%-------------------------------------------------------------------- +%% @spec end_per_group(GroupName, Config0) -> +%% void() | {save_config,Config1} +%% GroupName = atom() +%% Config0 = Config1 = [tuple()] +%% @end +%%-------------------------------------------------------------------- +end_per_group(_GroupName, _Config) -> + ok. + +%%-------------------------------------------------------------------- +%% @spec init_per_testcase(TestCase, Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +%% TestCase = atom() +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +init_per_testcase(_TestCase, Config) -> + ct:sleep(500), + Config. + +%%-------------------------------------------------------------------- +%% @spec end_per_testcase(TestCase, Config0) -> +%% void() | {save_config,Config1} | {fail,Reason} +%% TestCase = atom() +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +end_per_testcase(_TestCase, _Config) -> + ok. + +%%-------------------------------------------------------------------- +%% @spec groups() -> [Group] +%% Group = {GroupName,Properties,GroupsAndTestCases} +%% GroupName = atom() +%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}] +%% GroupsAndTestCases = [Group | {group,GroupName} | TestCase] +%% TestCase = atom() +%% Shuffle = shuffle | {shuffle,{integer(),integer(),integer()}} +%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail | +%% repeat_until_any_ok | repeat_until_any_fail +%% N = integer() | forever +%% @end +%%-------------------------------------------------------------------- +groups() -> + [{g1,[parallel],[tc1,tc2,tc3]}, + {g2,[],[tc4,tc5]}]. + +%%-------------------------------------------------------------------- +%% @spec all() -> GroupsAndTestCases | {skip,Reason} +%% GroupsAndTestCases = [{group,GroupName} | TestCase] +%% GroupName = atom() +%% TestCase = atom() +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +all() -> + [{group,g1},tc1,tc2,{group,g2}]. + +tc1(_C) -> + ok. +tc2(_C) -> + ok. +tc3(_C) -> + ok. +tc4(_C) -> + ok. +tc5(_C) -> + ok. diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl index 4132995bf6..67e430f821 100644 --- a/lib/common_test/test/ct_test_support.erl +++ b/lib/common_test/test/ct_test_support.erl @@ -38,7 +38,7 @@ -export([start_slave/3, slave_stop/1]). --export([ct_test_halt/1]). +-export([ct_test_halt/1, ct_rpc/2]). -include_lib("kernel/include/file.hrl"). @@ -65,7 +65,6 @@ init_per_suite(Config, Level) -> _ -> ok end, - start_slave(Config, Level). start_slave(Config, Level) -> @@ -103,6 +102,14 @@ start_slave(NodeName, Config, Level) -> test_server:format(Level, "Dirs added to code path (on ~w):~n", [CTNode]), [io:format("~s~n", [D]) || D <- PathDirs], + + case proplists:get_value(start_sasl, Config) of + true -> + rpc:call(CTNode, application, start, [sasl]), + test_server:format(Level, "SASL started on ~w~n", [CTNode]); + _ -> + ok + end, TraceFile = filename:join(DataDir, "ct.trace"), case file:read_file_info(TraceFile) of @@ -378,6 +385,16 @@ wait_for_ct_stop(Retries, CTNode) -> end. %%%----------------------------------------------------------------- +%%% ct_rpc/1 +ct_rpc({M,F,A}, Config) -> + CTNode = proplists:get_value(ct_node, Config), + Level = proplists:get_value(trace_level, Config), + test_server:format(Level, "~nCalling ~w:~w(~p) on ~p...", + [M,F,A, CTNode]), + rpc:call(CTNode, M, F, A). + + +%%%----------------------------------------------------------------- %%% EVENT HANDLING handle_event(EH, Event) -> diff --git a/lib/common_test/vsn.mk b/lib/common_test/vsn.mk index d60b4ba675..c810a0d98d 100644 --- a/lib/common_test/vsn.mk +++ b/lib/common_test/vsn.mk @@ -1 +1 @@ -COMMON_TEST_VSN = 1.7.2 +COMMON_TEST_VSN = 1.7.3 diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml index 96907f6b10..73d75851cf 100644 --- a/lib/compiler/doc/src/compile.xml +++ b/lib/compiler/doc/src/compile.xml @@ -859,6 +859,10 @@ pi() -> 3.1416. {ErrorLine, Module, ErrorDescriptor} </code> + <p><c>ErrorLine</c> will be the atom <c>none</c> if the error does + not correspond to a specific line (e.g. if the source file does + not exist).</p> + <p>A string describing the error is obtained with the following call:</p> <code> diff --git a/lib/compiler/doc/src/notes.xml b/lib/compiler/doc/src/notes.xml index 837fcf4368..eb5fa8b398 100644 --- a/lib/compiler/doc/src/notes.xml +++ b/lib/compiler/doc/src/notes.xml @@ -31,6 +31,67 @@ <p>This document describes the changes made to the Compiler application.</p> +<section><title>Compiler 4.9.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Expressions such as <c>'B = is_integer(V), if B and B + -> ok end'</c> would crash the compiler.</p> + <p> + Own Id: OTP-11240</p> + </item> + <item> + <p> + <c>compile:file2/2</c> with the option + <c>report_errors</c> could return ErrorInfo tuples with + only two elements, while the documentation says that the + ErrorInfo tuple always has three elements. Also updated + the documentation to add that the first element may be + '<c>none</c>' if no line number is applicable.</p> + <p> + Own Id: OTP-11304 Aux Id: seq12412 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Fix matching of floating point middle-endian machines. + Thanks to Johannes Weissl.</p> + <p> + Own Id: OTP-11201</p> + </item> + <item> + <p> + Restrict inlining of local fun references. Thanks to + Anthony Ramine.</p> + <p> + Own Id: OTP-11211</p> + </item> + <item> + <p> + Silence a misleading warning with some comprehensions. + Thanks to Anthony Ramine.</p> + <p> + Own Id: OTP-11212</p> + </item> + <item> + <p> + Forbid returning a match context in beam_validator. + Thanks to Anthony Ramine.</p> + <p> + Own Id: OTP-11247</p> + </item> + </list> + </section> + +</section> + <section><title>Compiler 4.9.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index e208ffec1f..9d89e21a4e 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -86,7 +86,7 @@ add_to_work_list(F, {Fs,Used}=Sets) -> false -> {[F|Fs],sets:add_element(F, Used)} end. - + %%% %%% Coalesce adjacent labels. Renumber all labels to eliminate gaps. %%% This cleanup will slightly reduce file size and slightly speed up loading. diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 3b51216a6c..3ec57a67da 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -600,7 +600,7 @@ checkerror_1([], OrigIs) -> OrigIs. checkerror_2(OrigIs) -> [{set,[],[],fcheckerror}|OrigIs]. - + %%% Routines for maintaining a type database. The type database %%% associates type information with registers. %%% diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 2ca403de54..47d446273b 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -41,7 +41,8 @@ -type option() :: atom() | {atom(), term()} | {'d', atom(), term()}. --type err_info() :: {erl_scan:line(), module(), term()}. %% ErrorDescriptor +-type err_info() :: {erl_scan:line() | 'none', + module(), term()}. %% ErrorDescriptor -type errors() :: [{file:filename(), [err_info()]}]. -type warnings() :: [{file:filename(), [err_info()]}]. -type mod_ret() :: {'ok', module()} @@ -1290,10 +1291,10 @@ native_compile_1(St) -> {error,R} -> case IgnoreErrors of true -> - Ws = [{St#compile.ifile,[{?MODULE,{native,R}}]}], + Ws = [{St#compile.ifile,[{none,?MODULE,{native,R}}]}], {ok,St#compile{warnings=St#compile.warnings ++ Ws}}; false -> - Es = [{St#compile.ifile,[{?MODULE,{native,R}}]}], + Es = [{St#compile.ifile,[{none,?MODULE,{native,R}}]}], {error,St#compile{errors=St#compile.errors ++ Es}} end catch @@ -1302,7 +1303,7 @@ native_compile_1(St) -> case IgnoreErrors of true -> Ws = [{St#compile.ifile, - [{?MODULE,{native_crash,R,Stk}}]}], + [{none,?MODULE,{native_crash,R,Stk}}]}], {ok,St#compile{warnings=St#compile.warnings ++ Ws}}; false -> erlang:raise(Class, R, Stk) @@ -1349,7 +1350,7 @@ save_binary(#compile{module=Mod,ofile=Outfile, save_binary_1(St); _ -> Es = [{St#compile.ofile, - [{?MODULE,{module_name,Mod,Base}}]}], + [{none,?MODULE,{module_name,Mod,Base}}]}], {error,St#compile{errors=St#compile.errors ++ Es}} end end. @@ -1363,20 +1364,20 @@ save_binary_1(St) -> ok -> {ok,St}; {error,RenameError} -> - Es0 = [{Ofile,[{?MODULE,{rename,Tfile,Ofile, - RenameError}}]}], + Es0 = [{Ofile,[{none,?MODULE,{rename,Tfile,Ofile, + RenameError}}]}], Es = case file:delete(Tfile) of ok -> Es0; {error,DeleteError} -> Es0 ++ [{Ofile, - [{?MODULE,{delete_temp,Tfile, - DeleteError}}]}] + [{none,?MODULE,{delete_temp,Tfile, + DeleteError}}]}] end, {error,St#compile{errors=St#compile.errors ++ Es}} end; {error,_Error} -> - Es = [{Tfile,[{compile,write_error}]}], + Es = [{Tfile,[{none,compile,write_error}]}], {error,St#compile{errors=St#compile.errors ++ Es}} end. @@ -1419,6 +1420,9 @@ report_warnings(#compile{options=Opts,warnings=Ws0}) -> false -> ok end. +format_message(F, P, [{none,Mod,E}|Es]) -> + M = {none,io_lib:format("~ts: ~s~ts\n", [F,P,Mod:format_error(E)])}, + [M|format_message(F, P, Es)]; format_message(F, P, [{{Line,Column}=Loc,Mod,E}|Es]) -> M = {{F,Loc},io_lib:format("~ts:~w:~w ~s~ts\n", [F,Line,Column,P,Mod:format_error(E)])}, @@ -1428,12 +1432,17 @@ format_message(F, P, [{Line,Mod,E}|Es]) -> [F,Line,P,Mod:format_error(E)])}, [M|format_message(F, P, Es)]; format_message(F, P, [{Mod,E}|Es]) -> + %% Not documented and not expected to be used any more, but + %% keep a while just in case. M = {none,io_lib:format("~ts: ~s~ts\n", [F,P,Mod:format_error(E)])}, [M|format_message(F, P, Es)]; format_message(_, _, []) -> []. %% list_errors(File, ErrorDescriptors) -> ok +list_errors(F, [{none,Mod,E}|Es]) -> + io:fwrite("~ts: ~ts\n", [F,Mod:format_error(E)]), + list_errors(F, Es); list_errors(F, [{{Line,Column},Mod,E}|Es]) -> io:fwrite("~ts:~w:~w: ~ts\n", [F,Line,Column,Mod:format_error(E)]), list_errors(F, Es); @@ -1441,6 +1450,8 @@ list_errors(F, [{Line,Mod,E}|Es]) -> io:fwrite("~ts:~w: ~ts\n", [F,Line,Mod:format_error(E)]), list_errors(F, Es); list_errors(F, [{Mod,E}|Es]) -> + %% Not documented and not expected to be used any more, but + %% keep a while just in case. io:fwrite("~ts: ~ts\n", [F,Mod:format_error(E)]), list_errors(F, Es); list_errors(_F, []) -> ok. @@ -1545,7 +1556,7 @@ restore_expand_module([F|Fs]) -> [F|restore_expand_module(Fs)]; restore_expand_module([]) -> []. - + -spec options() -> 'ok'. options() -> @@ -1582,7 +1593,7 @@ help([_|T]) -> help(_) -> ok. - + %% compile(AbsFileName, Outfilename, Options) %% Compile entry point for erl_compile. diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl index 1e8983f594..67d37ff1fc 100644 --- a/lib/compiler/src/core_lint.erl +++ b/lib/compiler/src/core_lint.erl @@ -68,7 +68,7 @@ | {'undefined_function', fa(), fa()} | {'tail_segment_not_at_end', fa()}. --type error() :: {module(), err_desc()}. +-type error() :: {'none', module(), err_desc()}. -type warning() :: {module(), term()}. %%----------------------------------------------------------------------- @@ -162,7 +162,7 @@ return_status(St) -> %% add_warning(ErrorDescriptor, State) -> State' %% Note that we don't use line numbers here. -add_error(E, St) -> St#lint{errors=[{?MODULE,E}|St#lint.errors]}. +add_error(E, St) -> St#lint{errors=[{none,?MODULE,E}|St#lint.errors]}. %%add_warning(W, St) -> St#lint{warnings=[{none,core_lint,W}|St#lint.warnings]}. diff --git a/lib/compiler/src/core_scan.erl b/lib/compiler/src/core_scan.erl index 0d90739bfc..a4fe920258 100644 --- a/lib/compiler/src/core_scan.erl +++ b/lib/compiler/src/core_scan.erl @@ -95,7 +95,7 @@ format_error(Other) -> io_lib:write(Other). string_thing($') -> "atom"; %' stupid emacs string_thing($") -> "string". %" stupid emacs - + %% Re-entrant pre-scanner. %% %% If the input list of characters is insufficient to build a term the @@ -213,7 +213,7 @@ pre_comment(eof, Sofar, Pos) -> pre_error(E, Epos, Pos) -> {error,{Epos,core_scan,E}, Pos}. - + %% scan(CharList, StartPos) %% This takes a list of characters and tries to tokenise them. %% diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab index 75ac91907a..ebc9b1c85b 100644..100755 --- a/lib/compiler/src/genop.tab +++ b/lib/compiler/src/genop.tab @@ -23,45 +23,148 @@ BEAM_FORMAT_NUMBER=0 # arity or semantics, the format number above must be bumped. # +## @spec label Lbl +## @doc Specify a module local label. +## Label gives this code address a name (Lbl) and marks the start of +## a basic block. 1: label/1 + +## @spec func_info M F A +## @doc Define a function M:F/A 2: func_info/3 + 3: int_code_end/0 # # Function and BIF calls. # + +## @spec call Arity Label +## @doc Call the function at Label. +## Save the next instruction as the return address in the CP register. 4: call/2 + +## @spec call_last Arity Label Dellocate +## @doc Deallocate and do a tail recursive call to the function at Label. +## Do not update the CP register. +## Before the call deallocate Deallocate words of stack. 5: call_last/3 + +## @spec call_only Arity Label +## @doc Do a tail recursive call to the function at Label. +## Do not update the CP register. 6: call_only/2 +## @spec call_ext Arity Destination +## @doc Call the function of arity Arity pointed to by Destination. +## Save the next instruction as the return address in the CP register. 7: call_ext/2 + +## @spec call_ext_last Arity Destination Deallocate +## @doc Deallocate and do a tail call to function of arity Arity +## pointed to by Destination. +## Do not update the CP register. +## Deallocate Deallocate words from the stack before the call. 8: call_ext_last/3 +## @spec bif0 Bif Reg +## @doc Call the bif Bif and store the result in Reg. 9: bif0/2 + +## @spec bif1 Lbl Bif Arg Reg +## @doc Call the bif Bif with the argument Arg, and store the result in Reg. +## On failure jump to Lbl. 10: bif1/4 + +## @spec bif2 Lbl Bif Arg1 Arg2 Reg +## @doc Call the bif Bif with the arguments Arg1 and Arg2, +## and store the result in Reg. +## On failure jump to Lbl. 11: bif2/5 # # Allocating, deallocating and returning. # + +## @spec allocate StackNeed Live +## @doc Allocate space for StackNeed words on the stack. If a GC is needed +## during allocation there are Live number of live X registers. +## Also save the continuation pointer (CP) on the stack. 12: allocate/2 + +## @spec allocate_heap StackNeed HeapNeed Live +## @doc Allocate space for StackNeed words on the stack and ensure there is +## space for HeapNeed words on the heap. If a GC is needed +## save Live number of X registers. +## Also save the continuation pointer (CP) on the stack. 13: allocate_heap/3 + +## @spec allocate_zero StackNeed Live +## @doc Allocate space for StackNeed words on the stack. If a GC is needed +## during allocation there are Live number of live X registers. +## Clear the new stack words. (By writing NIL.) +## Also save the continuation pointer (CP) on the stack. 14: allocate_zero/2 + +## @spec allocate_heap_zero StackNeed HeapNeed Live +## @doc Allocate space for StackNeed words on the stack and HeapNeed words +## on the heap. If a GC is needed +## during allocation there are Live number of live X registers. +## Clear the new stack words. (By writing NIL.) +## Also save the continuation pointer (CP) on the stack. 15: allocate_heap_zero/3 + +## @spec test_heap HeapNeed Live +## @doc Ensure there is space for HeapNeed words on the heap. If a GC is needed +## save Live number of X registers. 16: test_heap/2 + +## @spec init N +## @doc Clear the Nth stack word. (By writing NIL.) 17: init/1 + +## @spec deallocate N +## @doc Restore the continuation pointer (CP) from the stack and deallocate +## N+1 words from the stack (the + 1 is for the CP). 18: deallocate/1 + +## @spec return +## @doc Return to the address in the continuation pointer (CP). 19: return/0 # # Sending & receiving. # +## @spec send +## @doc Send argument in x(0) as a message to the destination process in x(0). +## The message in x(1) ends up as the result of the send in x(0). 20: send/0 + +## @spec remove_message +## @doc Unlink the current message from the message queue and store a +## pointer to the message in x(0). Remove any timeout. 21: remove_message/0 + +## @spec timeout +## @doc Reset the save point of the mailbox and clear the timeout flag. 22: timeout/0 + +## @spec loop_rec Label Source +## @doc Loop over the message queue, if it is empty jump to Label. 23: loop_rec/2 + +## @spec loop_rec_end Label +## @doc Advance the save pointer to the next message and jump back to Label. 24: loop_rec_end/1 + +## @spec wait Label +## @doc Suspend the processes and set the entry point to the beginning of the +## receive loop at Label. 25: wait/1 + +## @spec wait_timeout Lable Time +## @doc Sets up a timeout of Time milllisecons and saves the address of the +## following instruction as the entry point if the timeout triggers. 26: wait_timeout/2 # @@ -83,36 +186,106 @@ BEAM_FORMAT_NUMBER=0 # # Comparision operators. # + +## @spec is_lt Lbl Arg1 Arg2 +## @doc Compare two terms and jump to Lbl if Arg1 is not less than Arg2. 39: is_lt/3 + +## @spec is_ge Lbl Arg1 Arg2 +## @doc Compare two terms and jump to Lbl if Arg1 is less than Arg2. 40: is_ge/3 + +## @spec is_eq Lbl Arg1 Arg2 +## @doc Compare two terms and jump to Lbl if Arg1 is not (numerically) equal to Arg2. 41: is_eq/3 + +## @spec is_ne Lbl Arg1 Arg2 +## @doc Compare two terms and jump to Lbl if Arg1 is (numerically) equal to Arg2. 42: is_ne/3 + +## @spec is_eq_exact Lbl Arg1 Arg2 +## @doc Compare two terms and jump to Lbl if Arg1 is not exactly equal to Arg2. 43: is_eq_exact/3 + +## @spec is_ne_exact Lbl Arg1 Arg2 +## @doc Compare two terms and jump to Lbl if Arg1 is exactly equal to Arg2. 44: is_ne_exact/3 # # Type tests. # + +## @spec is_integer Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not an integer. 45: is_integer/2 + +## @spec is_float Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not a float. 46: is_float/2 + +## @spec is_number Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not a number. 47: is_number/2 + +## @spec is_atom Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not an atom. 48: is_atom/2 + +## @spec is_pid Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not a pid. 49: is_pid/2 + +## @spec is_reference Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not a reference. 50: is_reference/2 + +## @spec is_port Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not a port. 51: is_port/2 + +## @spec is_nil Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not nil. 52: is_nil/2 + +## @spec is_binary Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not a binary. 53: is_binary/2 + 54: -is_constant/2 + +## @spec is_list Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not a cons or nil. 55: is_list/2 + +## @spec is_nonempty_list Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not a cons. 56: is_nonempty_list/2 + +## @spec is_tuple Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not a tuple. 57: is_tuple/2 + +## @spec test_arity Lbl Arg1 Arity +## @doc Test the arity of (the tuple in) Arg1 and jump +## to Lbl if it is not equal to Arity. 58: test_arity/3 # # Indexing & jumping. # + +## @spec select_val Arg FailLabel Destinations +## @doc Jump to the destination label corresponding to Arg +## in the Destinations list, if no arity matches, jump to FailLabel. 59: select_val/3 + +## @spec select_tuple_arity Tuple FailLabel Destinations +## @doc Check the arity of the tuple Tuple and jump to the corresponding +## destination label, if no arity matches, jump to FailLabel. 60: select_tuple_arity/3 + +## @spec jump Label +## @doc Jump to Label. 61: jump/1 # @@ -124,9 +297,26 @@ BEAM_FORMAT_NUMBER=0 # # Moving, extracting, modifying. # + +## @spec move Source Destination +## @doc Move the source Source (a literal or a register) to +## the destination register Destination. 64: move/2 + +## @spec get_list Source Head Tail +## @doc Get the head and tail (or car and cdr) parts of a list +## (a cons cell) from Source and put them into the registers +## Head and Tail. 65: get_list/3 + +## @spec get_tuple_element Source Element Destination +## @doc Get element number Element from the tuple in Source and put +## it in the destination register Destination. 66: get_tuple_element/3 + +## @spec set_tuple_element NewElement Tuple Position +## @doc Update the element at postition Position of the tuple Tuple +## with the new element NewElement. 67: set_tuple_element/3 # @@ -147,13 +337,26 @@ BEAM_FORMAT_NUMBER=0 # # 'fun' support. # +## @spec call_fun Arity +## @doc Call a fun of arity Arity. Assume arguments in +## registers x(0) to x(Arity-1) and that the fun is in x(Arity). +## Save the next instruction as the return address in the CP register. 75: call_fun/1 + 76: -make_fun/3 + +## @spec is_function Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not a +## function (i.e. fun or closure). 77: is_function/2 # # Late additions to R5. # + +## @spec call_ext_only Arity Label +## Do a tail recursive call to the function at Label. +## Do not update the CP register. 78: call_ext_only/2 # @@ -212,9 +415,14 @@ BEAM_FORMAT_NUMBER=0 111: bs_add/5 112: apply/1 113: apply_last/2 +## @spec is_boolean Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not a Boolean. 114: is_boolean/2 # New instructions in R10B-6. +## @spec is_function2 Lbl Arg1 Arity +## @doc Test the type of Arg1 and jump to Lbl if it is not a +## function of arity Arity. 115: is_function2/3 # New bit syntax matching in R11B. @@ -229,7 +437,20 @@ BEAM_FORMAT_NUMBER=0 123: bs_restore2/2 # New GC bifs introduced in R11B. + +## @spec gc_bif1 Lbl Live Bif Arg Reg +## @doc Call the bif Bif with the argument Arg, and store the result in Reg. +## On failure jump to Lbl. +## Do a garbage collection if necessary to allocate space on the heap +## for the result (saving Live number of X registers). 124: gc_bif1/5 + +## @spec gc_bif2 Lbl Live Bif Arg1 Arg2 Reg +## @doc Call the bif Bif with the arguments Arg1 and Arg2, +## and store the result in Reg. +## On failure jump to Lbl. +## Do a garbage collection if necessary to allocate space on the heap +## for the result (saving Live number of X registers). 125: gc_bif2/6 # Experimental new bit_level bifs introduced in R11B. @@ -241,6 +462,8 @@ BEAM_FORMAT_NUMBER=0 128: -put_literal/2 # R11B-5 +## @spec is_bitstr Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not a bit string. 129: is_bitstr/2 # R12B @@ -250,7 +473,12 @@ BEAM_FORMAT_NUMBER=0 133: bs_init_writable/0 134: bs_append/8 135: bs_private_append/6 + +## @spec trim N Remaining +## @doc Reduce the stack usage by N words, +## keeping the CP on the top of the stack. 136: trim/2 + 137: bs_init_bits/6 # R12B-5 @@ -277,8 +505,24 @@ BEAM_FORMAT_NUMBER=0 # R14A +## @spec recv_mark Label +## @doc Save the end of the message queue and the address of +## the label Label so that a recv_set instruction can start +## scanning the inbox from this position. 150: recv_mark/1 + +## @spec recv_set Label +## @doc Check that the saved mark points to Label and set the +## save pointer in the message queue to the last position +## of the message queue saved by the recv_mark instruction. 151: recv_set/1 + +## @spec gc_bif3 Lbl Live Bif Arg1 Arg2 Arg3 Reg +## @doc Call the bif Bif with the arguments Arg1, Arg2 and Arg3, +## and store the result in Reg. +## On failure jump to Lbl. +## Do a garbage collection if necessary to allocate space on the heap +## for the result (saving Live number of X registers). 152: gc_bif3/7 # R15A diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 6dc4f3f300..33f5015e0b 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -553,16 +553,22 @@ expr({'try',L,Es0,[],[],As0}, St0) -> %% 'try ... after ... end' {Es1,St1} = exprs(Es0, St0), {As1,St2} = exprs(As0, St1), - {Evs,Hs0,St3} = try_after(As1, St2), - %% We must kill the id for any funs in the duplicated after body, - %% to avoid getting two local functions having the same name. - Hs = kill_id_anns(Hs0), + {Name,St3} = new_fun_name("after", St2), {V,St4} = new_var(St3), % (must not exist in As1) - %% TODO: this duplicates the 'after'-code; should lift to function. - Lanno = lineno_anno(L, St4), - {#itry{anno=#a{anno=Lanno},args=Es1,vars=[V],body=As1++[V], - evars=Evs,handler=Hs}, - [],St4}; + LA = lineno_anno(L, St4), + Lanno = #a{anno=LA}, + Fc = function_clause([], LA, {Name,0}), + Fun = #ifun{anno=Lanno,id=[],vars=[], + clauses=[#iclause{anno=Lanno,pats=[], + guard=[#c_literal{val=true}], + body=As1}], + fc=Fc}, + App = #iapply{anno=Lanno,op=#c_var{anno=LA,name={Name,0}},args=[]}, + {Evs,Hs,St5} = try_after([App], St4), + Try = #itry{anno=Lanno,args=Es1,vars=[V],body=[App,V],evars=Evs,handler=Hs}, + Letrec = #iletrec{anno=Lanno,defs=[{{Name,0},Fun}], + body=[Try]}, + {Letrec,[],St5}; expr({'try',L,Es,Cs,Ecs,As}, St0) -> %% 'try ... [of ...] [catch ...] after ... end' expr({'try',L,[{'try',L,Es,Cs,Ecs,[]}],[],[],As}, St0); @@ -1897,7 +1903,7 @@ new_in_all([Le|Les]) -> foldl(fun (L, Ns) -> intersection((get_anno(L))#a.ns, Ns) end, (get_anno(Le))#a.ns, Les); new_in_all([]) -> []. - + %% The AfterVars are the variables which are used afterwards. We need %% this to work out which variables are actually exported and used %% from case/receive. In subblocks/clauses the AfterVars of the block @@ -2041,24 +2047,6 @@ cexpr(Lit, _As, St) -> %%Vs = lit_vars(Lit), {set_anno(Lit, Anno#a.anno),[],Vs,St}. -%% Kill the id annotations for any fun inside the expression. -%% Necessary when duplicating code in try ... after. - -kill_id_anns(#ifun{clauses=Cs0}=Fun) -> - Cs = kill_id_anns(Cs0), - Fun#ifun{clauses=Cs,id=[]}; -kill_id_anns(#a{}=A) -> - %% Optimization: Don't waste time searching for funs inside annotations. - A; -kill_id_anns([H|T]) -> - [kill_id_anns(H)|kill_id_anns(T)]; -kill_id_anns([]) -> []; -kill_id_anns(Tuple) when is_tuple(Tuple) -> - L0 = tuple_to_list(Tuple), - L = kill_id_anns(L0), - list_to_tuple(L); -kill_id_anns(Other) -> Other. - %% lit_vars(Literal) -> [Var]. lit_vars(Lit) -> lit_vars(Lit, []). diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 5f1c108f7c..65f1251099 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -160,8 +160,8 @@ function({#c_var{name={F,Arity}=FA},Body}, St0) -> io:fwrite("Function: ~w/~w\n", [F,Arity]), erlang:raise(Class, Error, Stack) end. - - + + %% body(Cexpr, Sub, State) -> {Kexpr,[PreKepxr],State}. %% Do the main sequence of a body. A body ends in an atomic value or %% values. Must check if vector first so do expr. @@ -834,7 +834,7 @@ last([_|T]) -> last(T). first([_]) -> []; first([H|T]) -> [H|first(T)]. - + %% This code implements the algorithm for an optimizing compiler for %% pattern matching given "The Implementation of Functional %% Programming Languages" by Simon Peyton Jones. The code is much @@ -1428,7 +1428,7 @@ arg_val(Arg, C) -> {set_kanno(S, []),U,T,Fs} end end. - + %% ubody_used_vars(Expr, State) -> [UsedVar] %% Return all used variables for the body sequence. Much more %% efficient than using ubody/3 if the body contains nested letrecs. @@ -1875,7 +1875,7 @@ format_error(bad_segment_size) -> add_warning(none, Term, Anno, #kern{ws=Ws}=St) -> File = get_file(Anno), - St#kern{ws=[{File,[{?MODULE,Term}]}|Ws]}; + St#kern{ws=[{File,[{none,?MODULE,Term}]}|Ws]}; add_warning(Line, Term, Anno, #kern{ws=Ws}=St) -> File = get_file(Anno), St#kern{ws=[{File,[{Line,?MODULE,Term}]}|Ws]}. diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index da8aecdc8b..66ce6c00ab 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -139,8 +139,8 @@ forms_2(Config) when is_list(Config) -> module_mismatch(Config) when is_list(Config) -> ?line DataDir = ?config(data_dir, Config), ?line File = filename:join(DataDir, "wrong_module_name.erl"), - ?line {error,[{"wrong_module_name.beam", - [{compile,{module_name,arne,"wrong_module_name"}}]}], + {error,[{"wrong_module_name.beam", + [{none,compile,{module_name,arne,"wrong_module_name"}}]}], []} = compile:file(File, [return]), ?line error = compile:file(File, [report]), diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index abc9ab6a72..a5a4e62a42 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -299,7 +299,7 @@ unused_multiple_values_error(Config) when is_list(Config) -> Opts = [no_copt,clint,return,from_core,{outdir,PrivDir} |test_lib:opt_opts(?MODULE)], {error,[{unused_multiple_values_error, - [{core_lint,{return_mismatch,{hello,1}}}]}], + [{none,core_lint,{return_mismatch,{hello,1}}}]}], []} = c:c(Core, Opts), ok. diff --git a/lib/compiler/vsn.mk b/lib/compiler/vsn.mk index 1c6f49d89b..8cfd8d294e 100644 --- a/lib/compiler/vsn.mk +++ b/lib/compiler/vsn.mk @@ -1 +1 @@ -COMPILER_VSN = 4.9.2 +COMPILER_VSN = 4.9.3 diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index c28ff8136c..30c8c2554d 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -538,16 +538,17 @@ static ERL_NIF_TERM atom_onbasis; #define PRINTF_ERR1(FMT,A1) #ifdef HAVE_DYNAMIC_CRYPTO_LIB -static int change_basename(char* buf, int bufsz, const char* newfile) +static int change_basename(ErlNifBinary* bin, char* buf, int bufsz, const char* newfile) { - char* p = strrchr(buf, '/'); - p = (p == NULL) ? buf : p + 1; + const unsigned char* p = (unsigned char*)strrchr((char*)bin->data, '/'); + int i = (p == NULL) ? 0 : (p+1) - bin->data; - if ((p - buf) + strlen(newfile) >= bufsz) { + if (i + strlen(newfile) >= bufsz) { PRINTF_ERR0("CRYPTO: lib name too long"); return 0; } - strcpy(p, newfile); + memcpy(buf, bin->data, i); + strcpy(buf+i, newfile); return 1; } @@ -566,14 +567,15 @@ static int init(ErlNifEnv* env, ERL_NIF_TERM load_info) int tpl_arity; const ERL_NIF_TERM* tpl_array; int vernum; + ErlNifBinary lib_bin; char lib_buf[1000]; - /* load_info: {201, "/full/path/of/this/library"} */ + /* load_info: {301, <<"/full/path/of/this/library">>} */ if (!enif_get_tuple(env, load_info, &tpl_arity, &tpl_array) || tpl_arity != 2 || !enif_get_int(env, tpl_array[0], &vernum) - || vernum != 201 - || enif_get_string(env, tpl_array[1], lib_buf, sizeof(lib_buf), ERL_NIF_LATIN1) <= 0) { + || vernum != 301 + || !enif_inspect_binary(env, tpl_array[1], &lib_bin)) { PRINTF_ERR1("CRYPTO: Invalid load_info '%T'", load_info); return 0; @@ -633,7 +635,7 @@ static int init(ErlNifEnv* env, ERL_NIF_TERM load_info) #ifdef HAVE_DYNAMIC_CRYPTO_LIB { void* handle; - if (!change_basename(lib_buf, sizeof(lib_buf), "crypto_callback")) { + if (!change_basename(&lib_bin, lib_buf, sizeof(lib_buf), "crypto_callback")) { return 0; } if (!(handle = enif_dlopen(lib_buf, &error_handler, NULL))) { diff --git a/lib/crypto/doc/src/notes.xml b/lib/crypto/doc/src/notes.xml index 6abe19eac5..0ff0c8aa96 100644 --- a/lib/crypto/doc/src/notes.xml +++ b/lib/crypto/doc/src/notes.xml @@ -30,6 +30,22 @@ </header> <p>This document describes the changes made to the Crypto application.</p> +<section><title>Crypto 3.1</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Refactor ecdsa cipher to simplify code and improve + performance.</p> + <p> + Own Id: OTP-11320</p> + </item> + </list> + </section> + +</section> + <section><title>Crypto 3.0</title> <section><title>Improvements and New Features</title> diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index 8e8370f3b0..784fcc0119 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -183,7 +183,7 @@ %%-type ec_key() :: {Curve :: ec_curve(), PrivKey :: binary() | undefined, PubKey :: ec_point() | undefined}. -on_load(on_load/0). --define(CRYPTO_NIF_VSN,201). +-define(CRYPTO_NIF_VSN,301). -define(nif_stub,nif_stub_error(?LINE)). nif_stub_error(Line) -> @@ -640,7 +640,7 @@ on_load() -> end end, Lib = filename:join([PrivDir, "lib", LibName]), - Status = case erlang:load_nif(Lib, {?CRYPTO_NIF_VSN,Lib}) of + Status = case erlang:load_nif(Lib, {?CRYPTO_NIF_VSN,path2bin(Lib)}) of ok -> ok; {error, {load_failed, _}}=Error1 -> ArchLibDir = @@ -652,7 +652,7 @@ on_load() -> [] -> Error1; _ -> ArchLib = filename:join([ArchLibDir, LibName]), - erlang:load_nif(ArchLib, {?CRYPTO_NIF_VSN,ArchLib}) + erlang:load_nif(ArchLib, {?CRYPTO_NIF_VSN,path2bin(ArchLib)}) end; Error1 -> Error1 end, @@ -663,6 +663,14 @@ on_load() -> "OpenSSL might not be installed on this system.~n",[E,Str]), Status end. + +path2bin(Path) when is_list(Path) -> + Encoding = file:native_name_encoding(), + case unicode:characters_to_binary(Path,Encoding,Encoding) of + Bin when is_binary(Bin) -> + Bin + end. + %%-------------------------------------------------------------------- %%% Internal functions (some internal API functions are part of the deprecated API) %%-------------------------------------------------------------------- diff --git a/lib/crypto/vsn.mk b/lib/crypto/vsn.mk index d5d7c8a128..3bd2f9b4bf 100644 --- a/lib/crypto/vsn.mk +++ b/lib/crypto/vsn.mk @@ -1 +1 @@ -CRYPTO_VSN = 3.0 +CRYPTO_VSN = 3.1 diff --git a/lib/debugger/doc/src/notes.xml b/lib/debugger/doc/src/notes.xml index 5f1d411db2..a3543a1e11 100644 --- a/lib/debugger/doc/src/notes.xml +++ b/lib/debugger/doc/src/notes.xml @@ -32,6 +32,22 @@ <p>This document describes the changes made to the Debugger application.</p> +<section><title>Debugger 3.2.12</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Fix matching of floating point middle-endian machines. + Thanks to Johannes Weissl.</p> + <p> + Own Id: OTP-11201</p> + </item> + </list> + </section> + +</section> + <section><title>Debugger 3.2.11</title> <section><title>Improvements and New Features</title> diff --git a/lib/debugger/test/dbg_ui_SUITE_data/manual_data/src/lists1.erl b/lib/debugger/test/dbg_ui_SUITE_data/manual_data/src/lists1.erl index 0214983c11..db84ee5fc8 100644 --- a/lib/debugger/test/dbg_ui_SUITE_data/manual_data/src/lists1.erl +++ b/lib/debugger/test/dbg_ui_SUITE_data/manual_data/src/lists1.erl @@ -236,7 +236,7 @@ flatlength([H|T], L) when list(H) -> flatlength([H|T], L) -> flatlength(T, L + 1); flatlength([], L) -> L. - + %% keymember(Key, Index, [Tuple]) %% keysearch(Key, Index, [Tuple]) %% keydelete(Key, Index, [Tuple]) @@ -298,7 +298,7 @@ keymap(Fun, ExtraArgs, Index, [Tup|Tail]) -> [setelement(Index, Tup, apply(Fun, [element(Index, Tup)|ExtraArgs]))| keymap(Fun, ExtraArgs, Index, Tail)]; keymap( _, _ , _, []) -> []. - + %% all(Predicate, List) %% any(Predicate, List) %% map(Function, List) diff --git a/lib/debugger/test/int_SUITE_data/lists1.erl b/lib/debugger/test/int_SUITE_data/lists1.erl index 0214983c11..db84ee5fc8 100644 --- a/lib/debugger/test/int_SUITE_data/lists1.erl +++ b/lib/debugger/test/int_SUITE_data/lists1.erl @@ -236,7 +236,7 @@ flatlength([H|T], L) when list(H) -> flatlength([H|T], L) -> flatlength(T, L + 1); flatlength([], L) -> L. - + %% keymember(Key, Index, [Tuple]) %% keysearch(Key, Index, [Tuple]) %% keydelete(Key, Index, [Tuple]) @@ -298,7 +298,7 @@ keymap(Fun, ExtraArgs, Index, [Tup|Tail]) -> [setelement(Index, Tup, apply(Fun, [element(Index, Tup)|ExtraArgs]))| keymap(Fun, ExtraArgs, Index, Tail)]; keymap( _, _ , _, []) -> []. - + %% all(Predicate, List) %% any(Predicate, List) %% map(Function, List) diff --git a/lib/debugger/test/int_SUITE_data/my_lists.erl b/lib/debugger/test/int_SUITE_data/my_lists.erl index 98eb4396e3..f9399b1085 100644 --- a/lib/debugger/test/int_SUITE_data/my_lists.erl +++ b/lib/debugger/test/int_SUITE_data/my_lists.erl @@ -237,7 +237,7 @@ flatlength([H|T], L) when list(H) -> flatlength([H|T], L) -> flatlength(T, L + 1); flatlength([], L) -> L. - + %% keymember(Key, Index, [Tuple]) %% keysearch(Key, Index, [Tuple]) %% keydelete(Key, Index, [Tuple]) @@ -299,7 +299,7 @@ keymap(Fun, ExtraArgs, Index, [Tup|Tail]) -> [setelement(Index, Tup, apply(Fun, [element(Index, Tup)|ExtraArgs]))| keymap(Fun, ExtraArgs, Index, Tail)]; keymap( _, _ , _, []) -> []. - + %% all(Predicate, List) %% any(Predicate, List) %% map(Function, List) @@ -698,7 +698,7 @@ flatlength_1([H|T], L) when list(H) -> flatlength_1([H|T], L) -> flatlength_1(T, L + 1); flatlength_1([], L) -> L. - + %% keymember(Key, Index, [Tuple]) %% keysearch(Key, Index, [Tuple]) %% keydelete(Key, Index, [Tuple]) @@ -760,7 +760,7 @@ keymap_1(Fun, ExtraArgs, Index, [Tup|Tail]) -> [setelement(Index, Tup, apply(Fun, [element(Index, Tup)|ExtraArgs]))| keymap_1(Fun, ExtraArgs, Index, Tail)]; keymap_1( _, _ , _, []) -> []. - + %% all(Predicate, List) %% any(Predicate, List) %% map(Function, List) @@ -1162,7 +1162,7 @@ flatlength_2([H|T], L) when list(H) -> flatlength_2([H|T], L) -> flatlength_2(T, L + 1); flatlength_2([], L) -> L. - + %% keymember_2(Key, Index, [Tuple]) %% keysearch_2(Key, Index, [Tuple]) %% keydelete_2(Key, Index, [Tuple]) @@ -1224,7 +1224,7 @@ keymap_2(Fun, ExtraArgs, Index, [Tup|Tail]) -> [setelement(Index, Tup, apply(Fun, [element(Index, Tup)|ExtraArgs]))| keymap_2(Fun, ExtraArgs, Index, Tail)]; keymap_2( _, _ , _, []) -> []. - + %% all_2(Predicate, List) %% any_2(Predicate, List) %% map_2(Function, List) @@ -1624,7 +1624,7 @@ flatlength_3([H|T], L) when list(H) -> flatlength_3([H|T], L) -> flatlength_3(T, L + 1); flatlength_3([], L) -> L. - + %% keymember_3(Key, Index, [Tuple]) %% keysearch_3(Key, Index, [Tuple]) %% keydelete_3(Key, Index, [Tuple]) @@ -1686,7 +1686,7 @@ keymap_3(Fun, ExtraArgs, Index, [Tup|Tail]) -> [setelement(Index, Tup, apply(Fun, [element(Index, Tup)|ExtraArgs]))| keymap_3(Fun, ExtraArgs, Index, Tail)]; keymap_3( _, _ , _, []) -> []. - + %% all_3(Predicate, List) %% any_3(Predicate, List) %% map_3(Function, List) diff --git a/lib/debugger/vsn.mk b/lib/debugger/vsn.mk index c3e3579e2c..a245e26a55 100644 --- a/lib/debugger/vsn.mk +++ b/lib/debugger/vsn.mk @@ -1 +1 @@ -DEBUGGER_VSN = 3.2.11 +DEBUGGER_VSN = 3.2.12 diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_clean.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_clean.erl index 04225e9bd0..4fc4e89ce9 100644 --- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_clean.erl +++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_clean.erl @@ -80,7 +80,7 @@ add_to_work_list(F, {Fs,Used}=Sets) -> false -> {[F|Fs],sets:add_element(F, Used)} end. - + %%% %%% Coalesce adjacent labels. Renumber all labels to eliminate gaps. %%% This cleanup will slightly reduce file size and slightly speed up loading. diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_type.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_type.erl index d2ac3fcd99..f59cc897d6 100644 --- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_type.erl +++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_type.erl @@ -456,7 +456,7 @@ are_live_regs_determinable([{'%live',_}|_]) -> true; are_live_regs_determinable([_|Is]) -> are_live_regs_determinable(Is); are_live_regs_determinable([]) -> false. - + %%% Routines for maintaining a type database. The type database %%% associates type information with registers. %%% diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl index 2b6d14e300..9b56d384ab 100644 --- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl +++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl @@ -990,7 +990,7 @@ listing(LFun, Ext, St) -> Es = [{Lfile,[{none,compile,write_error}]}], {error,St#compile{errors=St#compile.errors ++ Es}} end. - + options() -> help(standard_passes()). @@ -1022,7 +1022,7 @@ help([_|T]) -> help(_) -> ok. - + %% compile(AbsFileName, Outfilename, Options) %% Compile entry point for erl_compile. diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/core_scan.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/core_scan.erl index 5ca3d6becd..2f9f6a2bcc 100644 --- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/core_scan.erl +++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/core_scan.erl @@ -122,7 +122,7 @@ format_error(Other) -> io_lib:write(Other). string_thing($') -> "atom"; string_thing($") -> "string". - + %% Re-entrant pre-scanner. %% %% If the input list of characters is insufficient to build a term the @@ -240,7 +240,7 @@ pre_comment(eof, Sofar, Pos) -> pre_error(E, Epos, Pos) -> {error,{Epos,core_scan,E}, Pos}. - + %% scan(CharList, StartPos) %% This takes a list of characters and tries to tokenise them. %% diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_pre_expand.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_pre_expand.erl index 41b7cb248d..590cc682c9 100644 --- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_pre_expand.erl +++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_pre_expand.erl @@ -647,7 +647,7 @@ new_fun_name(#expand{func=F,arity=A,fcount=I}=St) -> ++ "-fun-" ++ integer_to_list(I) ++ "-", {list_to_atom(Name),St#expand{fcount=I+1}}. - + %% normalise_fields([RecDef]) -> [Field]. %% Normalise the field definitions to always have a default value. If %% none has been given then use 'undefined'. @@ -881,7 +881,7 @@ bin_expand_strings(Es) -> end, Es1, S); (E, Es1) -> [E|Es1] end, [], Es). - + %% new_var_name(State) -> {VarName,State}. new_var_name(St) -> diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_core.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_core.erl index c96837ab5e..45a8bc4ad9 100644 --- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_core.erl +++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_core.erl @@ -1127,7 +1127,7 @@ new_in_all([Le|Les]) -> foldl(fun (L, Ns) -> intersection((core_lib:get_anno(L))#a.ns, Ns) end, (core_lib:get_anno(Le))#a.ns, Les); new_in_all([]) -> []. - + %% The AfterVars are the variables which are used afterwards. We need %% this to work out which variables are actually exported and used %% from case/receive. In subblocks/clauses the AfterVars of the block diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_kernel.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_kernel.erl index d7c3e1add9..ecba19b1d1 100644 --- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_kernel.erl +++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_kernel.erl @@ -129,7 +129,7 @@ function(#c_def{anno=Af,name=#c_fname{id=F,arity=Arity},val=Body}, St0) -> %%B1 = B0, St3 = St2, %Null second pass {#k_fdef{anno=#k{us=[],ns=[],a=Af ++ Ab}, func=F,arity=Arity,vars=Kvs,body=B1},St3}. - + %% body(Cexpr, Sub, State) -> {Kexpr,[PreKepxr],State}. %% Do the main sequence of a body. A body ends in an atomic value or %% values. Must check if vector first so do expr. @@ -719,7 +719,7 @@ last([_|T]) -> last(T). first([_]) -> []; first([H|T]) -> [H|first(T)]. - + %% This code implements the algorithm for an optimizing compiler for %% pattern matching given "The Implementation of Functional %% Programming Languages" by Simon Peyton Jones. The code is much @@ -1143,7 +1143,7 @@ arg_val(Arg) -> #k_bin_end{} -> 0; #k_binary{} -> 0 end. - + %% ubody(Expr, Break, State) -> {Expr,[UsedVar],State}. %% Tag the body sequence with its used variables. These bodies %% either end with a #k_break{}, or with #k_return{} or an expression diff --git a/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_cgi.erl b/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_cgi.erl index d3f67eb77a..8c91b6f430 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_cgi.erl +++ b/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_cgi.erl @@ -338,7 +338,7 @@ exec_script(false,Info,Script,_AfterScript,_RequestURI) -> %% proxy(#mod{config_db = ConfigDb} = Info, Port) -> - Timeout = httpd_util:lookup(ConfigDb, cgi_timeout, ?DEFAULT_CGI_TIMEOUT), + Timeout = httpd_util:lookup(ConfigDb, script_timeout, ?DEFAULT_CGI_TIMEOUT), proxy(Info, Port, 0, undefined,[], Timeout). proxy(Info, Port, Size, StatusCode, AccResponse, Timeout) -> diff --git a/lib/dialyzer/test/small_SUITE_data/results/trec b/lib/dialyzer/test/small_SUITE_data/results/trec index 01ccc63761..b95df1e6ef 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/trec +++ b/lib/dialyzer/test/small_SUITE_data/results/trec @@ -1,7 +1,7 @@ -trec.erl:26: Function test/0 has no local return -trec.erl:27: The call trec:mk_foo_loc(42,any()) will never return since it differs in the 1st argument from the success typing arguments: ('undefined',atom()) -trec.erl:29: Function mk_foo_loc/2 has no local return -trec.erl:30: Record construction violates the declared type for #foo{} since variable A cannot be of type atom() -trec.erl:36: Function mk_foo_exp/2 has no local return -trec.erl:37: Record construction violates the declared type for #foo{} since variable A cannot be of type atom() +trec.erl:28: Function test/0 has no local return +trec.erl:29: The call trec:mk_foo_loc(42,any()) will never return since it differs in the 1st argument from the success typing arguments: ('undefined',atom()) +trec.erl:31: Function mk_foo_loc/2 has no local return +trec.erl:32: Record construction violates the declared type for #foo{} since variable A cannot be of type atom() +trec.erl:38: Function mk_foo_exp/2 has no local return +trec.erl:39: Record construction violates the declared type for #foo{} since variable A cannot be of type atom() diff --git a/lib/dialyzer/test/small_SUITE_data/src/appmon_place.erl b/lib/dialyzer/test/small_SUITE_data/src/appmon_place.erl index 60ffbe818f..ddb97796fb 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/appmon_place.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/appmon_place.erl @@ -1,6 +1,6 @@ %%--------------------------------------------------------------------- %% This is added as a test because it was giving a false positive -%% (function move/4 will nevr be called) due to the strange use of +%% (function move/4 will never be called) due to the strange use of %% self-recursive fun construction in placex/3. %% %% The analysis was getting confused that the foldl call will never diff --git a/lib/dialyzer/test/small_SUITE_data/src/contract3.erl b/lib/dialyzer/test/small_SUITE_data/src/contract3.erl index 5b0bee9694..a6ce91882e 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/contract3.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/contract3.erl @@ -18,16 +18,23 @@ t(X, Y, Z) -> (atom()|list()) -> atom(). t1(X) -> - foo:bar(X). + f(X). -spec t2(atom(), integer()) -> integer(); (atom(), list()) -> atom(). t2(X, Y) -> - foo:bar(X, Y). + g(X, Y). -spec t3(atom(), integer(), list()) -> integer(); (X, integer(), list()) -> X. t3(X, Y, Z) -> X. + +%% dummy functions below + +f(X) -> X. + +g(X, Y) when is_atom(X), is_integer(Y) -> Y; +g(X, Y) when is_atom(X), is_list(Y) -> X. diff --git a/lib/dialyzer/test/small_SUITE_data/src/empty_list_infimum.erl b/lib/dialyzer/test/small_SUITE_data/src/empty_list_infimum.erl index b58fa732cb..3acc5ca065 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/empty_list_infimum.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/empty_list_infimum.erl @@ -1,6 +1,6 @@ %% -%% The Original Code is RabbitMQ. -%% +%% This is stripped down code from RabbitMQ. It is used to report an +%% invalid type specification for function list_vhost_permissions/1. %% The Initial Developer of the Original Code is VMware, Inc. %% @@ -38,7 +38,7 @@ vhost_perms_info_keys() -> -spec list_vhost_permissions(vhost()) -> infos(). list_vhost_permissions(VHostPath) -> - list_permissions(vhost_perms_info_keys(), rabbit_foo:some_list()). + list_permissions(vhost_perms_info_keys(), some_mod:some_function()). filter_props(Keys, Props) -> [T || T = {K, _} <- Props, lists:member(K, Keys)]. diff --git a/lib/dialyzer/test/small_SUITE_data/src/gencall.erl b/lib/dialyzer/test/small_SUITE_data/src/gencall.erl index d2875c9df1..762be55007 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/gencall.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/gencall.erl @@ -7,6 +7,6 @@ f() -> gen_server:call(1,2,3), ets:lookup(1,2,3), - gencall2:foo(), + some_mod:some_function(), gencall:foo(), gen_server:handle_cast(1,2). diff --git a/lib/dialyzer/test/small_SUITE_data/src/maybe_improper.erl b/lib/dialyzer/test/small_SUITE_data/src/maybe_improper.erl index 1743d81493..6d2a35b7c8 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/maybe_improper.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/maybe_improper.erl @@ -1,7 +1,18 @@ +%%%======================================================================== +%%% Tests handling of maybe improper lists +%%%======================================================================== -module(maybe_improper). --export([s/1]). +-export([s/1, t/0]). -spec s(maybe_improper_list(X,Y)) -> {[X], maybe_improper_list(X,Y)}. -s(A) -> - lists:split(2,A). +s(L) -> + lists:split(2, L). + +%% Having a remote type in the 'tail' of the list crashed dialyzer. +%% The problem was fixed for R16B03. +-type t_mil() :: maybe_improper_list(integer(), orddict:orddict()). + +-spec t() -> t_mil(). +t() -> + [42 | []]. diff --git a/lib/dialyzer/test/small_SUITE_data/src/overloaded1.erl b/lib/dialyzer/test/small_SUITE_data/src/overloaded1.erl index 0af4f7446f..074a93e2fe 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/overloaded1.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/overloaded1.erl @@ -1,5 +1,5 @@ %%----------------------------------------------------------------------------- -%% Test that tests overloaded contratcs. +%% Test that tests overloaded contracts. %% In December 2008 it works as far as intersection types are concerned (test1) %% However, it does NOT work as far as type variables are concerned (test2) %%----------------------------------------------------------------------------- @@ -16,13 +16,13 @@ test2() -> -type mod() :: atom(). --spec foo(ATM, list()) -> {'ok', ATM} | {'error', _} when is_subtype(ATM, mod()) - ; (MFA, list()) -> {'ok', MFA} | {'error', _} when is_subtype(MFA, mfa()). +-spec foo(ATM, list()) -> {'ok', ATM} | {'error', _} when ATM :: mod() + ; (MFA, list()) -> {'ok', MFA} | {'error', _} when MFA :: mfa(). foo(F, _) when is_atom(F) -> case atom_to_list(F) of - [42|_] -> {ok, F}; - _Other -> {error, mod:bar(F)} + [42|_] -> {ok, F}; + _Other -> {error, some_mod:some_function()} end; foo({M,F,A}, _) -> case A =:= 0 of diff --git a/lib/dialyzer/test/small_SUITE_data/src/trec.erl b/lib/dialyzer/test/small_SUITE_data/src/trec.erl index ba50c3b401..06706162c1 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/trec.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/trec.erl @@ -18,20 +18,22 @@ %% ('undefined',atom()) %% 3. Function mk_foo_loc/2 has no local return %% -%% Arguably, the second warning is not what most users have in mind -%% when they wrote the type declarations in the 'foo' record, so no -%% doubt they'll find it confusing. But note that it is also inconsistent! -%% How come there is a success typing for a function that has no local return? +%% Arguably, the second warning is not what most users have in mind when +%% they wrote the type declarations in the 'foo' record, so no doubt +%% they'll find it confusing. But note that it is also quite confusing! +%% Many users may be wondering: How come there is a success typing for a +%% function that has no local return? Running typer on this module +%% reveals a success typing for this function that is interesting indeed. %% test() -> - mk_foo_loc(42, bar:f()). + mk_foo_loc(42, some_mod:some_function()). mk_foo_loc(A, B) -> #foo{a = A, b = [A,B]}. %% -%% For this function we currently get "has no local return" but we get -%% no reason; I want us to get a reason. +%% For this function we used to get a "has no local return" warning +%% but we got no reason. This has now been fixed. %% mk_foo_exp(A, B) when is_integer(A) -> #foo{a = A, b = [A,B]}. diff --git a/lib/diameter/doc/src/notes.xml b/lib/diameter/doc/src/notes.xml index 6e79a9589a..274a3f594c 100644 --- a/lib/diameter/doc/src/notes.xml +++ b/lib/diameter/doc/src/notes.xml @@ -42,6 +42,52 @@ first.</p> <!-- ===================================================================== --> +<section><title>diameter 1.4.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix UTF8String encode.</p> + <p> + Encode now accepts any nested list of codepoints and + binaries. A list containing a binary was previously + misinterpreted and the documentation was incomplete.</p> + <p> + Own Id: OTP-11172</p> + </item> + <item> + <p> + Ensure DWR isn't sent immediately after DWA.</p> + <p> + This was possible if the timing was unfortunate. An + incoming DWR now properly resets the watchdog timer.</p> + <p> + Own Id: OTP-11184</p> + </item> + <item> + <p> + Fix faulty encode of Failed-AVP</p> + <p> + Reception of a CER, DWR or DPR that has decode failures + caused encode of the corresponding answer message to + fail.</p> + <p> + Own Id: OTP-11293</p> + </item> + <item> + <p> + Fix broken service_opt() spawn_opt.</p> + <p> + The option was ignored.</p> + <p> + Own Id: OTP-11299</p> + </item> + </list> + </section> + +</section> + <section><title>diameter 1.4.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/diameter/src/base/diameter_config.erl b/lib/diameter/src/base/diameter_config.erl index fc5c284bf2..34b40c3a29 100644 --- a/lib/diameter/src/base/diameter_config.erl +++ b/lib/diameter/src/base/diameter_config.erl @@ -651,8 +651,9 @@ make_opts(Opts, Defs) -> [{K, opt(K,V)} || {K,V} <- Known]. -opt(spawn_opt, L) -> - is_list(L); +opt(spawn_opt, L) + when is_list(L) -> + L; opt(K, false = B) when K /= sequence -> diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl index 2b99ecc59c..282276827f 100644 --- a/lib/diameter/src/base/diameter_peer_fsm.erl +++ b/lib/diameter/src/base/diameter_peer_fsm.erl @@ -741,7 +741,7 @@ rejected(N, T, S) -> rejected({N, []}, T, S). failed_avp(RC, [{RC, Avp} | _]) -> - [{'Failed-AVP', [{'AVP', [Avp]}]}]; + [{'Failed-AVP', [[{'AVP', [Avp]}]]}]; failed_avp(RC, [_ | Es]) -> failed_avp(RC, Es); failed_avp(_, [] = No) -> diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl index 9dd8aafc61..47e03cd0a0 100644 --- a/lib/diameter/src/base/diameter_service.erl +++ b/lib/diameter/src/base/diameter_service.erl @@ -673,7 +673,8 @@ service_options(Opts) -> {use_shared_peers, get_value(use_shared_peers, Opts)}, {restrict_connections, proplists:get_value(restrict_connections, Opts, - ?RESTRICT)}]. + ?RESTRICT)}, + {spawn_opt, proplists:get_value(spawn_opt, Opts, [])}]. %% The order of options is significant since we match against the list. mref(false = No) -> diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src index 62ace16faa..c6828e6705 100644 --- a/lib/diameter/src/diameter.appup.src +++ b/lib/diameter/src/diameter.appup.src @@ -29,38 +29,13 @@ {"1.3", [{restart_application, diameter}]}, %% R15B03 {"1.3.1", [{restart_application, diameter}]}, {"1.4", [{restart_application, diameter}]}, %% R16A - {"1.4.1", [{load_module, diameter_reg}, %% R16B - {load_module, diameter_stats}, - {load_module, diameter_traffic}, - {load_module, diameter_service}, + {"1.4.1", [{restart_application, diameter}]}, %% R16B + {"1.4.1.1", [{restart_application, diameter}]}, + {"1.4.2", [{load_module, diameter_types}, %% R16B01 {load_module, diameter_config}, - {load_module, diameter_peer}, + {load_module, diameter_service}, {load_module, diameter_peer_fsm}, - {load_module, diameter_watchdog}, - {load_module, diameter_capx}, - {load_module, diameter_codec}, - {load_module, diameter_gen_base_rfc3588}, - {load_module, diameter_gen_base_accounting}, - {load_module, diameter_gen_base_rfc6733}, - {load_module, diameter_gen_base_acct6733}, - {load_module, diameter_tcp}, - {load_module, diameter_lib}, - {load_module, diameter}]}, - {"1.4.1.1", [{load_module, diameter_traffic}, - {load_module, diameter_service}, - {load_module, diameter_config}, - {load_module, diameter_peer}, - {load_module, diameter_peer_fsm}, - {load_module, diameter_watchdog}, - {load_module, diameter_capx}, - {load_module, diameter_codec}, - {load_module, diameter_gen_base_rfc3588}, - {load_module, diameter_gen_base_accounting}, - {load_module, diameter_gen_base_rfc6733}, - {load_module, diameter_gen_base_acct6733}, - {load_module, diameter_tcp}, - {load_module, diameter_lib}, - {load_module, diameter}]} + {load_module, diameter_watchdog}]} ], [ {"0.9", [{restart_application, diameter}]}, @@ -73,6 +48,7 @@ {"1.3.1", [{restart_application, diameter}]}, {"1.4", [{restart_application, diameter}]}, {"1.4.1", [{restart_application, diameter}]}, - {"1.4.1.1", [{restart_application, diameter}]} + {"1.4.1.1", [{restart_application, diameter}]}, + {"1.4.2", [{restart_application, diameter}]} ] }. diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk index f7462c3916..e003fe76b9 100644 --- a/lib/diameter/vsn.mk +++ b/lib/diameter/vsn.mk @@ -18,5 +18,5 @@ # %CopyrightEnd% APPLICATION = diameter -DIAMETER_VSN = 1.4.2 +DIAMETER_VSN = 1.4.3 APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN) diff --git a/lib/edoc/doc/src/notes.xml b/lib/edoc/doc/src/notes.xml index d2ec82efc8..394e7af09c 100644 --- a/lib/edoc/doc/src/notes.xml +++ b/lib/edoc/doc/src/notes.xml @@ -31,6 +31,23 @@ <p>This document describes the changes made to the EDoc application.</p> +<section><title>Edoc 0.7.12.1</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + The encoding of the <c>notes.xml</c> file has been + changed from latin1 to utf-8 to avoid future merge + problems.</p> + <p> + Own Id: OTP-11310</p> + </item> + </list> + </section> + +</section> + <section><title>Edoc 0.7.12</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/edoc/vsn.mk b/lib/edoc/vsn.mk index af2aa2203f..2fcc97e406 100644 --- a/lib/edoc/vsn.mk +++ b/lib/edoc/vsn.mk @@ -1 +1 @@ -EDOC_VSN = 0.7.12 +EDOC_VSN = 0.7.12.1 diff --git a/lib/eldap/src/eldap.erl b/lib/eldap/src/eldap.erl index d11f904996..8ebb88e35b 100644 --- a/lib/eldap/src/eldap.erl +++ b/lib/eldap/src/eldap.erl @@ -42,8 +42,8 @@ log, % User provided log function timeout = infinity, % Request timeout anon_auth = false, % Allow anonymous authentication - use_tls = false, % LDAP/LDAPS - tls_opts = [] % ssl:ssloptsion() + use_tls = false, % LDAP/LDAPS + tls_opts = [] % ssl:ssloption() }). %%% For debug purposes @@ -389,8 +389,7 @@ try_connect([],_) -> do_connect(Host, Data, Opts) when Data#eldap.use_tls == false -> gen_tcp:connect(Host, Data#eldap.port, Opts, Data#eldap.timeout); do_connect(Host, Data, Opts) when Data#eldap.use_tls == true -> - SslOpts = [{verify,0} | Opts ++ Data#eldap.tls_opts], - ssl:connect(Host, Data#eldap.port, SslOpts). + ssl:connect(Host, Data#eldap.port, Opts ++ Data#eldap.tls_opts). loop(Cpid, Data) -> receive diff --git a/lib/erl_docgen/doc/src/notes.xml b/lib/erl_docgen/doc/src/notes.xml index 2ae5f93165..24d12b2bb7 100644 --- a/lib/erl_docgen/doc/src/notes.xml +++ b/lib/erl_docgen/doc/src/notes.xml @@ -30,7 +30,24 @@ </header> <p>This document describes the changes made to the <em>erl_docgen</em> application.</p> - <section><title>Erl_Docgen 0.3.4</title> + <section><title>Erl_Docgen 0.3.4.1</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + The encoding of the <c>notes.xml</c> file has been + changed from latin1 to utf-8 to avoid future merge + problems.</p> + <p> + Own Id: OTP-11310</p> + </item> + </list> + </section> + +</section> + +<section><title>Erl_Docgen 0.3.4</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/erl_docgen/priv/dtd/common.dtd b/lib/erl_docgen/priv/dtd/common.dtd index fdc02c55a1..f999ef8ea4 100644 --- a/lib/erl_docgen/priv/dtd/common.dtd +++ b/lib/erl_docgen/priv/dtd/common.dtd @@ -67,7 +67,7 @@ <!-- References --> -<!ELEMENT seealso (#PCDATA) > +<!ELEMENT seealso (#PCDATA|c|em)* > <!ATTLIST seealso marker CDATA #REQUIRED > <!ELEMENT url (#PCDATA) > <!ATTLIST url href CDATA #REQUIRED > diff --git a/lib/erl_docgen/vsn.mk b/lib/erl_docgen/vsn.mk index a2262198dc..cda8671cfd 100644 --- a/lib/erl_docgen/vsn.mk +++ b/lib/erl_docgen/vsn.mk @@ -1 +1 @@ -ERL_DOCGEN_VSN = 0.3.4 +ERL_DOCGEN_VSN = 0.3.4.1 diff --git a/lib/erl_interface/doc/src/notes.xml b/lib/erl_interface/doc/src/notes.xml index 930b24c26a..f05456bbbd 100644 --- a/lib/erl_interface/doc/src/notes.xml +++ b/lib/erl_interface/doc/src/notes.xml @@ -30,6 +30,38 @@ </header> <p>This document describes the changes made to the Erl_interface application.</p> +<section><title>Erl_Interface 3.7.14</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Introduced functionality for inspection of system and + build configuration.</p> + <p> + Own Id: OTP-11196</p> + </item> + <item> + <p> + Header and library files from ic and erl_interface are + now installed into usr/{include,lib}. Note that these + directories are unversioned, so the latest installed + version will be the one in the directory.</p> + <p> + Own Id: OTP-11284</p> + </item> + <item> + <p> + Fix location of true binary under Mac OSX. Thanks to + Simon Cornish.</p> + <p> + Own Id: OTP-11289</p> + </item> + </list> + </section> + +</section> + <section><title>Erl_Interface 3.7.13</title> <section><title>Improvements and New Features</title> diff --git a/lib/erl_interface/src/Makefile.in b/lib/erl_interface/src/Makefile.in index ebacc1cee0..e36b39c1fb 100644 --- a/lib/erl_interface/src/Makefile.in +++ b/lib/erl_interface/src/Makefile.in @@ -866,8 +866,12 @@ release: opt $(INSTALL_DIR) "$(RELSYSDIR)/src/misc" $(INSTALL_DIR) "$(RELSYSDIR)/src/prog" $(INSTALL_DIR) "$(RELSYSDIR)/src/registry" + $(INSTALL_DIR) "$(RELEASE_PATH)/usr/include" + $(INSTALL_DIR) "$(RELEASE_PATH)/usr/lib" $(INSTALL_DATA) $(HEADERS) "$(RELSYSDIR)/include" + $(INSTALL_DATA) $(HEADERS) "$(RELEASE_PATH)/usr/include" $(INSTALL_DATA) $(OBJ_TARGETS) "$(RELSYSDIR)/lib" + $(INSTALL_DATA) $(OBJ_TARGETS) "$(RELEASE_PATH)/usr/lib" ifneq ($(EXE_TARGETS),) $(INSTALL_PROGRAM) $(EXE_TARGETS) "$(RELSYSDIR)/bin" endif diff --git a/lib/erl_interface/src/legacy/erl_eterm.c b/lib/erl_interface/src/legacy/erl_eterm.c index 7ca4f430de..636d26b24b 100644 --- a/lib/erl_interface/src/legacy/erl_eterm.c +++ b/lib/erl_interface/src/legacy/erl_eterm.c @@ -686,7 +686,7 @@ int erl_length(const ETERM *ep) return n; } - + /*********************************************************************** * I o l i s t f u n c t i o n s * diff --git a/lib/erl_interface/test/all_SUITE_data/ei_runner.c b/lib/erl_interface/test/all_SUITE_data/ei_runner.c index 205f911e38..cdf32b48c4 100644 --- a/lib/erl_interface/test/all_SUITE_data/ei_runner.c +++ b/lib/erl_interface/test/all_SUITE_data/ei_runner.c @@ -77,7 +77,7 @@ run_tests(char* argv0, TestCase test_cases[], unsigned number) } } - + /*********************************************************************** * * R e a d i n g p a c k e t s @@ -182,7 +182,7 @@ char *read_packet(int *len) return io_buf; } - + /*********************************************************************** * S e n d i n g r e p l i e s * diff --git a/lib/erl_interface/test/all_SUITE_data/runner.c b/lib/erl_interface/test/all_SUITE_data/runner.c index a474c17722..038d651275 100644 --- a/lib/erl_interface/test/all_SUITE_data/runner.c +++ b/lib/erl_interface/test/all_SUITE_data/runner.c @@ -78,7 +78,7 @@ run_tests(char* argv0, TestCase test_cases[], unsigned number) } } - + /*********************************************************************** * * R e a d i n g p a c k e t s @@ -188,7 +188,7 @@ char *read_packet(int *len) return io_buf; } - + /*********************************************************************** * S e n d i n g r e p l i e s * diff --git a/lib/erl_interface/test/ei_accept_SUITE.erl b/lib/erl_interface/test/ei_accept_SUITE.erl index 48469e68dc..642809ea7a 100644 --- a/lib/erl_interface/test/ei_accept_SUITE.erl +++ b/lib/erl_interface/test/ei_accept_SUITE.erl @@ -155,7 +155,7 @@ start_einode(Einode, N, Host, Port) -> ok. - + %%% Interface functions for ei (erl_interface) functions. ei_connect_init(P, Num, Cookie, Creation) -> diff --git a/lib/erl_interface/test/ei_decode_encode_SUITE.erl b/lib/erl_interface/test/ei_decode_encode_SUITE.erl index 2271278291..c7830f58f2 100644 --- a/lib/erl_interface/test/ei_decode_encode_SUITE.erl +++ b/lib/erl_interface/test/ei_decode_encode_SUITE.erl @@ -68,6 +68,8 @@ test_ei_decode_encode(Config) when is_list(Config) -> Port = case os:type() of {win32,_} -> open_port({spawn,"sort"},[]); + {unix, darwin} -> + open_port({spawn,"/usr/bin/true"},[]); _ -> open_port({spawn,"/bin/true"},[]) end, diff --git a/lib/erl_interface/test/erl_connect_SUITE.erl b/lib/erl_interface/test/erl_connect_SUITE.erl index bd54013402..c8becc760c 100644 --- a/lib/erl_interface/test/erl_connect_SUITE.erl +++ b/lib/erl_interface/test/erl_connect_SUITE.erl @@ -106,7 +106,7 @@ erl_reg_send(Config) when is_list(Config) -> ?line runner:recv_eot(P), ok. - + %%% Interface functions for erl_interface functions. erl_connect_init(P, Num, Cookie, Creation) -> diff --git a/lib/erl_interface/test/erl_eterm_SUITE.erl b/lib/erl_interface/test/erl_eterm_SUITE.erl index 10a27e48e3..100e9b6f68 100644 --- a/lib/erl_interface/test/erl_eterm_SUITE.erl +++ b/lib/erl_interface/test/erl_eterm_SUITE.erl @@ -108,7 +108,7 @@ end_per_group(_GroupName, Config) -> Config. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% 1. B a s i c t e s t s @@ -196,7 +196,7 @@ t_erl_free_compound(Config) when is_list(Config) -> ?line runner:test(?t_erl_free_compound), ok. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% 2. C o n s t r u c t i n g t e r m s @@ -521,7 +521,7 @@ t_erl_cons(Config) when is_list(Config) -> - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% 3. E x t r a c t i n g & i n f o f u n c t i o n s @@ -669,7 +669,7 @@ t_erl_element(Config) when is_list(Config) -> ok. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% 4. I / O l i s t f u n c t i o n s @@ -894,7 +894,7 @@ iolist_to_string(Port, Term) -> 'NULL' -> 'NULL' end. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% 5. M i s c e l l a n o u s T e s t s diff --git a/lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c b/lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c index 80d7f69520..94959187b9 100644 --- a/lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c +++ b/lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c @@ -269,7 +269,7 @@ TESTCASE(t_erl_free_compound) report(1); } - + /*********************************************************************** * * 2. C o n s t r u c t i n g t e r m s @@ -1047,7 +1047,7 @@ TESTCASE(t_erl_cons) - + /*********************************************************************** * * 3. E x t r a c t i n g & i n f o f u n c t i o n s @@ -1296,7 +1296,7 @@ TESTCASE(extractor_macros) } - + /*********************************************************************** * * 4. I / O l i s t f u n c t i o n s @@ -1393,7 +1393,7 @@ TESTCASE(t_erl_iolist_to_string) } } - + /*********************************************************************** * * 5. M i s c e l l a n o u s T e s t s diff --git a/lib/erl_interface/vsn.mk b/lib/erl_interface/vsn.mk index 6f08d380ca..5cde054a49 100644 --- a/lib/erl_interface/vsn.mk +++ b/lib/erl_interface/vsn.mk @@ -1 +1 @@ -EI_VSN = 3.7.13 +EI_VSN = 3.7.14 diff --git a/lib/et/doc/src/notes.xml b/lib/et/doc/src/notes.xml index 7b9d3fcf81..815dfada5e 100644 --- a/lib/et/doc/src/notes.xml +++ b/lib/et/doc/src/notes.xml @@ -36,6 +36,23 @@ one section in this document. The title of each section is the version number of <c>Event Tracer (ET)</c>.</p> +<section><title>ET 1.4.4.5</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + The encoding of the <c>notes.xml</c> file has been + changed from latin1 to utf-8 to avoid future merge + problems.</p> + <p> + Own Id: OTP-11310</p> + </item> + </list> + </section> + +</section> + <section><title>ET 1.4.4.4</title> <section><title>Improvements and New Features</title> @@ -43,7 +60,7 @@ <item> <p> Use erlang:demonitor(Ref, [flush]) where applicable. - Thanks to Lo�c Hoguin.</p> + Thanks to Loïc Hoguin.</p> <p> Own Id: OTP-11039</p> </item> diff --git a/lib/et/vsn.mk b/lib/et/vsn.mk index 40cdc2b298..282991aa49 100644 --- a/lib/et/vsn.mk +++ b/lib/et/vsn.mk @@ -1 +1 @@ -ET_VSN = 1.4.4.4 +ET_VSN = 1.4.4.5 diff --git a/lib/eunit/doc/src/notes.xml b/lib/eunit/doc/src/notes.xml index d5675574fc..21f759c4b1 100644 --- a/lib/eunit/doc/src/notes.xml +++ b/lib/eunit/doc/src/notes.xml @@ -32,6 +32,22 @@ </header> <p>This document describes the changes made to the EUnit application.</p> +<section><title>Eunit 2.2.5</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Wrap eunit macros into begin ... end blocks. Thanks to + Anthony Ramine.</p> + <p> + Own Id: OTP-11217</p> + </item> + </list> + </section> + +</section> + <section><title>Eunit 2.2.4</title> <section><title>Improvements and New Features</title> diff --git a/lib/eunit/src/eunit_proc.erl b/lib/eunit/src/eunit_proc.erl index ec7d93fd48..03d1a18321 100644 --- a/lib/eunit/src/eunit_proc.erl +++ b/lib/eunit/src/eunit_proc.erl @@ -643,11 +643,11 @@ io_request({get_until, _Prompt, _M, _F, _As}, Buf) -> io_request({setopts, _Opts}, Buf) -> {ok, Buf}; io_request(getopts, Buf) -> - {error, {error, enotsup}, Buf}; + {{error, enotsup}, Buf}; io_request({get_geometry,columns}, Buf) -> - {error, {error, enotsup}, Buf}; + {{error, enotsup}, Buf}; io_request({get_geometry,rows}, Buf) -> - {error, {error, enotsup}, Buf}; + {{error, enotsup}, Buf}; io_request({requests, Reqs}, Buf) -> io_requests(Reqs, {ok, Buf}); io_request(_, Buf) -> @@ -657,3 +657,10 @@ io_requests([R | Rs], {ok, Buf}) -> io_requests(Rs, io_request(R, Buf)); io_requests(_, Result) -> Result. + +-ifdef(TEST). +io_error_test_() -> + [?_assertMatch({error, enotsup}, io:getopts()), + ?_assertMatch({error, enotsup}, io:columns()), + ?_assertMatch({error, enotsup}, io:rows())]. +-endif. diff --git a/lib/eunit/vsn.mk b/lib/eunit/vsn.mk index 798196f8cf..be06c81559 100644 --- a/lib/eunit/vsn.mk +++ b/lib/eunit/vsn.mk @@ -1 +1 @@ -EUNIT_VSN = 2.2.4 +EUNIT_VSN = 2.2.5 diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index d1243b2325..d7d8a878c5 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -671,8 +671,9 @@ t_solve_remote(?function(Domain, Range), ET, R, C) -> {RT2, RR2} = t_solve_remote(Range, ET, R, C), {?function(RT1, RT2), RR1 ++ RR2}; t_solve_remote(?list(Types, Term, Size), ET, R, C) -> - {RT, RR} = t_solve_remote(Types, ET, R, C), - {?list(RT, Term, Size), RR}; + {RT1, RR1} = t_solve_remote(Types, ET, R, C), + {RT2, RR2} = t_solve_remote(Term, ET, R, C), + {?list(RT1, RT2, Size), RR1 ++ RR2}; t_solve_remote(?product(Types), ET, R, C) -> {RL, RR} = list_solve_remote(Types, ET, R, C), {?product(RL), RR}; @@ -1349,8 +1350,8 @@ t_maybe_improper_list() -> t_maybe_improper_list(_Content, ?unit) -> ?none; t_maybe_improper_list(?unit, _Termination) -> ?none; t_maybe_improper_list(Content, Termination) -> - %% Safety check - true = t_is_subtype(t_nil(), Termination), + %% Safety check: would be nice to have but does not work with remote types + %% true = t_is_subtype(t_nil(), Termination), ?list(Content, Termination, ?unknown_qual). -spec t_is_maybe_improper_list(erl_type()) -> boolean(). @@ -1365,8 +1366,8 @@ t_is_maybe_improper_list(_) -> false. %% t_improper_list(?unit, _Termination) -> ?none; %% t_improper_list(_Content, ?unit) -> ?none; %% t_improper_list(Content, Termination) -> -%% %% Safety check -%% false = t_is_subtype(t_nil(), Termination), +%% %% Safety check: would be nice to have but does not work with remote types +%% %% false = t_is_subtype(t_nil(), Termination), %% ?list(Content, Termination, ?any). -spec lift_list_to_pos_empty(erl_type()) -> erl_type(). diff --git a/lib/hipe/doc/src/notes.xml b/lib/hipe/doc/src/notes.xml index 52c5e068e1..2f8f1782cc 100644 --- a/lib/hipe/doc/src/notes.xml +++ b/lib/hipe/doc/src/notes.xml @@ -30,6 +30,23 @@ </header> <p>This document describes the changes made to HiPE.</p> +<section><title>Hipe 3.10.2.1</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + The encoding of the <c>notes.xml</c> file has been + changed from latin1 to utf-8 to avoid future merge + problems.</p> + <p> + Own Id: OTP-11310</p> + </item> + </list> + </section> + +</section> + <section><title>Hipe 3.10.2</title> <section><title>Improvements and New Features</title> @@ -37,7 +54,7 @@ <item> <p> Fix the title of hipe_app documentation page. Thanks to - Lo�c Hoguin.</p> + Loïc Hoguin.</p> <p> Own Id: OTP-10904</p> </item> diff --git a/lib/hipe/vsn.mk b/lib/hipe/vsn.mk index deb16b02fd..d9ed0b299f 100644 --- a/lib/hipe/vsn.mk +++ b/lib/hipe/vsn.mk @@ -1 +1 @@ -HIPE_VSN = 3.10.2 +HIPE_VSN = 3.10.2.1 diff --git a/lib/ic/c_src/Makefile.in b/lib/ic/c_src/Makefile.in index 856823b1b3..ed860ab73b 100644 --- a/lib/ic/c_src/Makefile.in +++ b/lib/ic/c_src/Makefile.in @@ -132,10 +132,8 @@ docs: _create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR)) $(LIBRARY): $(OBJ_FILES) - $(ar_verbose) - -$(AR) $(AR_OUT) $@ $(OBJ_FILES) - $(ranlib_verbose) - -$(RANLIB) $@ + -$(V_AR) $(AR_OUT) $@ $(OBJ_FILES) + -$(V_RANLIB) $@ $(OBJDIR)/%.o: %.c $(V_CC) $(CC_FLAGS) -c -o $@ $(ALL_CFLAGS) $< @@ -149,9 +147,13 @@ release_spec: opt $(INSTALL_DIR) "$(RELSYSDIR)/c_src" $(INSTALL_DIR) "$(RELSYSDIR)/include" $(INSTALL_DIR) "$(RELSYSDIR)/priv/lib" + $(INSTALL_DIR) "$(RELEASE_PATH)/usr/include" + $(INSTALL_DIR) "$(RELEASE_PATH)/usr/lib" $(INSTALL_DATA) ic.c ic_tmo.c "$(RELSYSDIR)/c_src" $(INSTALL_DATA) $(IDL_FILES) $(H_FILES) "$(RELSYSDIR)/include" $(INSTALL_DATA) $(LIBRARY) "$(RELSYSDIR)/priv/lib" + $(INSTALL_DATA) $(IDL_FILES) $(H_FILES) "$(RELEASE_PATH)/usr/include" + $(INSTALL_DATA) $(LIBRARY) "$(RELEASE_PATH)/usr/lib" release_docs_spec: diff --git a/lib/ic/doc/src/notes.xml b/lib/ic/doc/src/notes.xml index 7169a58543..112c0aff09 100644 --- a/lib/ic/doc/src/notes.xml +++ b/lib/ic/doc/src/notes.xml @@ -30,7 +30,25 @@ <file>notes.xml</file> </header> - <section><title>IC 4.3.2</title> + <section><title>IC 4.3.3</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Header and library files from ic and erl_interface are + now installed into usr/{include,lib}. Note that these + directories are unversioned, so the latest installed + version will be the one in the directory.</p> + <p> + Own Id: OTP-11284</p> + </item> + </list> + </section> + +</section> + +<section><title>IC 4.3.2</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/ic/vsn.mk b/lib/ic/vsn.mk index 53b81ad731..d1969ef3d8 100644 --- a/lib/ic/vsn.mk +++ b/lib/ic/vsn.mk @@ -1 +1 @@ -IC_VSN = 4.3.2 +IC_VSN = 4.3.3 diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml index 39860a4cc2..357a62381d 100644 --- a/lib/inets/doc/src/httpc.xml +++ b/lib/inets/doc/src/httpc.xml @@ -440,7 +440,10 @@ apply(Module, Function, [ReplyInfo | Args]) <v>Profile = profile() | pid() (when started <c>stand_alone</c>)</v> </type> <desc> - <p>Cancels an asynchronous HTTP-request. </p> + <p>Cancels an asynchronous HTTP-request. Note this does not guarantee + that the request response will not be delivered, as it is asynchronous the + the request may already have been completed when the cancellation arrives. + </p> <marker id="set_options"></marker> </desc> diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index 42183b8cc5..4e0dc8bd37 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -32,7 +32,51 @@ <file>notes.xml</file> </header> - <section><title>Inets 5.9.5</title> + <section><title>Inets 5.9.6</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + httpc: Allow content body in DELETE requests. Thanks to + James Wheare.</p> + <p> + Own Id: OTP-11190</p> + </item> + <item> + <p> + Add missing brackets to report formatting on ftp_progress + process exit. Thanks to Artur Wilniewczyc.</p> + <p> + Own Id: OTP-11202</p> + </item> + <item> + <p> + Fix some errors in the inets documentation. Thanks to + Johannes Weissl.</p> + <p> + Own Id: OTP-11210</p> + </item> + <item> + <p> + Fix various typos in httpd, inets. Thanks to Tomohiko + Aono.</p> + <p> + Own Id: OTP-11226</p> + </item> + <item> + <p> + Fix httpd config option 'erl_script_nocache'. Thanks to + Johannes Weissl.</p> + <p> + Own Id: OTP-11260</p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 5.9.5</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl index 4d7023a8e9..da9bbdd1ec 100644 --- a/lib/inets/src/http_client/httpc.erl +++ b/lib/inets/src/http_client/httpc.erl @@ -208,16 +208,8 @@ cancel_request(RequestId) -> cancel_request(RequestId, Profile) when is_atom(Profile) orelse is_pid(Profile) -> ?hcrt("cancel request", [{request_id, RequestId}, {profile, Profile}]), - ok = httpc_manager:cancel_request(RequestId, profile_name(Profile)), - receive - %% If the request was already fulfilled throw away the - %% answer as the request has been canceled. - {http, {RequestId, _}} -> - ok - after 0 -> - ok - end. - + httpc_manager:cancel_request(RequestId, profile_name(Profile)). + %%-------------------------------------------------------------------------- %% set_options(Options) -> ok | {error, Reason} @@ -241,14 +233,7 @@ set_options(Options, Profile) when is_atom(Profile) orelse is_pid(Profile) -> ?hcrt("set options", [{options, Options}, {profile, Profile}]), case validate_options(Options) of {ok, Opts} -> - try - begin - httpc_manager:set_options(Opts, profile_name(Profile)) - end - catch - exit:{noproc, _} -> - {error, inets_not_started} - end; + httpc_manager:set_options(Opts, profile_name(Profile)); {error, Reason} -> {error, Reason} end. @@ -343,8 +328,6 @@ store_cookies(SetCookieHeaders, Url, Profile) ok end catch - exit:{noproc, _} -> - {error, {not_started, Profile}}; error:{badmatch, Bad} -> {error, {parse_failed, Bad}} end. diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 55794f57dc..80c8b2439e 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -32,7 +32,7 @@ start_link/4, %% connect_and_send/2, send/2, - cancel/3, + cancel/2, stream_next/1, info/1 ]). @@ -117,8 +117,8 @@ send(Request, Pid) -> %% Description: Cancels a request. Intended to be called by the httpc %% manager process. %%-------------------------------------------------------------------- -cancel(RequestId, Pid, From) -> - cast({cancel, RequestId, From}, Pid). +cancel(RequestId, Pid) -> + cast({cancel, RequestId}, Pid). %%-------------------------------------------------------------------- @@ -400,19 +400,17 @@ handle_call(info, _, State) -> %% handle_keep_alive_queue/2 on the other hand will just skip the %% request as if it was never issued as in this case the request will %% not have been sent. -handle_cast({cancel, RequestId, From}, +handle_cast({cancel, RequestId}, #state{request = #request{id = RequestId} = Request, profile_name = ProfileName, canceled = Canceled} = State) -> ?hcrv("cancel current request", [{request_id, RequestId}, {profile, ProfileName}, {canceled, Canceled}]), - httpc_manager:request_canceled(RequestId, ProfileName, From), - ?hcrv("canceled", []), {stop, normal, State#state{canceled = [RequestId | Canceled], request = Request#request{from = answer_sent}}}; -handle_cast({cancel, RequestId, From}, +handle_cast({cancel, RequestId}, #state{profile_name = ProfileName, request = #request{id = CurrId}, canceled = Canceled} = State) -> @@ -420,8 +418,6 @@ handle_cast({cancel, RequestId, From}, {curr_req_id, CurrId}, {profile, ProfileName}, {canceled, Canceled}]), - httpc_manager:request_canceled(RequestId, ProfileName, From), - ?hcrv("canceled", []), {noreply, State#state{canceled = [RequestId | Canceled]}}; handle_cast(stream_next, #state{session = Session} = State) -> @@ -521,19 +517,12 @@ handle_info({Proto, _Socket, Data}, activate_once(Session), {noreply, State#state{mfa = NewMFA}} catch - exit:_Exit -> - ?hcrd("data processing exit", [{exit, _Exit}]), + _:_Reason -> + ?hcrd("data processing exit", [{exit, _Reason}]), ClientReason = {could_not_parse_as_http, Data}, ClientErrMsg = httpc_response:error(Request, ClientReason), NewState = answer_request(Request, ClientErrMsg, State), - {stop, normal, NewState}; - error:_Error -> - ?hcrd("data processing error", [{error, _Error}]), - ClientReason = {could_not_parse_as_http, Data}, - ClientErrMsg = httpc_response:error(Request, ClientReason), - NewState = answer_request(Request, ClientErrMsg, State), {stop, normal, NewState} - end, ?hcri("data processed", [{final_result, FinalResult}]), FinalResult; @@ -1165,7 +1154,7 @@ handle_http_body(Body, #state{headers = Headers, handle_response(#state{status = new} = State) -> ?hcrd("handle response - status = new", []), - handle_response(try_to_enable_pipeline_or_keep_alive(State)); + handle_response(check_persistent(State)); handle_response(#state{request = Request, status = Status, @@ -1440,39 +1429,22 @@ is_keep_alive_enabled_server(_,_) -> is_keep_alive_connection(Headers, #session{client_close = ClientClose}) -> (not ((ClientClose) orelse httpc_response:is_server_closing(Headers))). -try_to_enable_pipeline_or_keep_alive( - #state{session = Session, - request = #request{method = Method}, +check_persistent( + #state{session = #session{type = Type} = Session, status_line = {Version, _, _}, headers = Headers, - profile_name = ProfileName} = State) -> - ?hcrd("try to enable pipeline or keep-alive", - [{version, Version}, - {headers, Headers}, - {session, Session}]), + profile_name = ProfileName} = State) -> case is_keep_alive_enabled_server(Version, Headers) andalso - is_keep_alive_connection(Headers, Session) of + is_keep_alive_connection(Headers, Session) of true -> - case (is_pipeline_enabled_client(Session) andalso - httpc_request:is_idempotent(Method)) of - true -> - insert_session(Session, ProfileName), - State#state{status = pipeline}; - false -> - insert_session(Session, ProfileName), - %% Make sure type is keep_alive in session - %% as it in this case might be pipeline - NewSession = Session#session{type = keep_alive}, - State#state{status = keep_alive, - session = NewSession} - end; + mark_persistent(ProfileName, Session), + State#state{status = Type}; false -> State#state{status = close} end. answer_request(#request{id = RequestId, from = From} = Request, Msg, - #state{session = Session, - timers = Timers, + #state{timers = Timers, profile_name = ProfileName} = State) -> ?hcrt("answer request", [{request, Request}, {msg, Msg}]), httpc_response:send(From, Msg), @@ -1482,19 +1454,14 @@ answer_request(#request{id = RequestId, from = From} = Request, Msg, Timer = {RequestId, TimerRef}, cancel_timer(TimerRef, {timeout, Request#request.id}), httpc_manager:request_done(RequestId, ProfileName), - NewSession = maybe_make_session_available(ProfileName, Session), Timers2 = Timers#timers{request_timers = lists:delete(Timer, RequestTimers)}, State#state{request = Request#request{from = answer_sent}, - session = NewSession, timers = Timers2}. -maybe_make_session_available(ProfileName, - #session{available = false} = Session) -> - update_session(ProfileName, Session, #session.available, true), - Session#session{available = true}; -maybe_make_session_available(_ProfileName, Session) -> - Session. +mark_persistent(ProfileName, Session) -> + update_session(ProfileName, Session, #session.persistent, true), + Session#session{persistent = true}. cancel_timers(#timers{request_timers = ReqTmrs, queue_timer = QTmr}) -> cancel_timer(QTmr, timeout_queue), diff --git a/lib/inets/src/http_client/httpc_internal.hrl b/lib/inets/src/http_client/httpc_internal.hrl index 30e2742e9d..d5b3dd2a2a 100644 --- a/lib/inets/src/http_client/httpc_internal.hrl +++ b/lib/inets/src/http_client/httpc_internal.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2012. All Rights Reserved. +%% Copyright Ericsson AB 2005-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -143,8 +143,8 @@ %% true | false %% This will be true, when a response has been received for - %% the first request. See type above. - available = false + %% the first request and the server has not closed the connection + persistent = false }). diff --git a/lib/inets/src/http_client/httpc_manager.erl b/lib/inets/src/http_client/httpc_manager.erl index c45dcab802..a3ed371e61 100644 --- a/lib/inets/src/http_client/httpc_manager.erl +++ b/lib/inets/src/http_client/httpc_manager.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2012. All Rights Reserved. +%% Copyright Ericsson AB 2002-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -29,7 +29,6 @@ start_link/3, request/2, cancel_request/2, - request_canceled/3, request_done/2, retry_request/2, redirect_request/2, @@ -144,22 +143,7 @@ redirect_request(Request, ProfileName) -> %%-------------------------------------------------------------------- cancel_request(RequestId, ProfileName) -> - call(ProfileName, {cancel_request, RequestId}). - - -%%-------------------------------------------------------------------- -%% Function: request_canceled(RequestId, ProfileName) -> ok -%% RequestId - ref() -%% ProfileName = atom() -%% -%% Description: Confirms that a request has been canceld. Intended to -%% be called by the httpc handler process. -%%-------------------------------------------------------------------- - -request_canceled(RequestId, ProfileName, From) -> - gen_server:reply(From, ok), - cast(ProfileName, {request_canceled, RequestId}). - + cast(ProfileName, {cancel_request, RequestId}). %%-------------------------------------------------------------------- %% Function: request_done(RequestId, ProfileName) -> ok @@ -467,33 +451,13 @@ do_init(ProfileName, CookiesDir) -> %%-------------------------------------------------------------------- handle_call({request, Request}, _, State) -> ?hcri("request", [{request, Request}]), - case (catch handle_request(Request, State)) of + case (catch handle_request(Request, State, false)) of {reply, Msg, NewState} -> {reply, Msg, NewState}; Error -> {stop, Error, httpc_response:error(Request, Error), State} end; -handle_call({cancel_request, RequestId}, From, - #state{handler_db = HandlerDb} = State) -> - ?hcri("cancel_request", [{request_id, RequestId}]), - case ets:lookup(HandlerDb, RequestId) of - [] -> - %% The request has allready compleated make sure - %% it is deliverd to the client process queue so - %% it can be thrown away by httpc:cancel_request - %% This delay is hopfully a temporary workaround. - %% Note that it will not not delay the manager, - %% only the client that called httpc:cancel_request - timer:apply_after(?DELAY, gen_server, reply, [From, ok]), - {noreply, State}; - [{_, Pid, _}] -> - httpc_handler:cancel(RequestId, Pid, From), - {noreply, - State#state{cancel = - [{RequestId, Pid, From} | State#state.cancel]}} - end; - handle_call(reset_cookies, _, #state{cookie_db = CookieDb} = State) -> ?hcrv("reset cookies", []), httpc_cookie:reset_db(CookieDb), @@ -547,7 +511,7 @@ handle_cast({retry_or_redirect_request, {Time, Request}}, {noreply, State}; handle_cast({retry_or_redirect_request, Request}, State) -> - case (catch handle_request(Request, State)) of + case (catch handle_request(Request, State, true)) of {reply, {ok, _}, NewState} -> {noreply, NewState}; Error -> @@ -555,19 +519,19 @@ handle_cast({retry_or_redirect_request, Request}, State) -> {stop, Error, State} end; -handle_cast({request_canceled, RequestId}, State) -> - ?hcrv("request canceled", [{request_id, RequestId}]), - ets:delete(State#state.handler_db, RequestId), - case lists:keysearch(RequestId, 1, State#state.cancel) of - {value, Entry = {RequestId, _, From}} -> - ?hcrt("found in cancel", [{from, From}]), - {noreply, - State#state{cancel = lists:delete(Entry, State#state.cancel)}}; - Else -> - ?hcrt("not found in cancel", [{else, Else}]), - {noreply, State} +handle_cast({cancel_request, RequestId}, + #state{handler_db = HandlerDb} = State) -> + case ets:lookup(HandlerDb, RequestId) of + [] -> + %% Request already compleated nothing to + %% cancel + {noreply, State}; + [{_, Pid, _}] -> + httpc_handler:cancel(RequestId, Pid), + ets:delete(State#state.handler_db, RequestId), + {noreply, State} end; - + handle_cast({request_done, RequestId}, State) -> ?hcrv("request done", [{request_id, RequestId}]), ets:delete(State#state.handler_db, RequestId), @@ -629,22 +593,8 @@ handle_info({'EXIT', _, _}, State) -> %% Handled in DOWN {noreply, State}; handle_info({'DOWN', _, _, Pid, _}, State) -> - ets:match_delete(State#state.handler_db, {'_', Pid, '_'}), - - %% If there where any canceled request, handled by the - %% the process that now has terminated, the - %% cancelation can be viewed as sucessfull! - NewCanceldList = - lists:foldl(fun(Entry = {_, HandlerPid, From}, Acc) -> - case HandlerPid of - Pid -> - gen_server:reply(From, ok), - lists:delete(Entry, Acc); - _ -> - Acc - end - end, State#state.cancel, State#state.cancel), - {noreply, State#state{cancel = NewCanceldList}}; + ets:match_delete(State#state.handler_db, {'_', Pid, '_'}), + {noreply, State}; handle_info(Info, State) -> Report = io_lib:format("Unknown message in " "httpc_manager:handle_info ~p~n", [Info]), @@ -774,7 +724,7 @@ get_handler_info(Tab) -> handle_request(#request{settings = #http_options{version = "HTTP/0.9"}} = Request, - State) -> + State, _) -> %% Act as an HTTP/0.9 client that does not know anything %% about persistent connections @@ -787,7 +737,7 @@ handle_request(#request{settings = handle_request(#request{settings = #http_options{version = "HTTP/1.0"}} = Request, - State) -> + State, _) -> %% Act as an HTTP/1.0 client that does not %% use persistent connections @@ -798,13 +748,13 @@ handle_request(#request{settings = start_handler(NewRequest#request{headers = NewHeaders}, State), {reply, {ok, NewRequest#request.id}, State}; -handle_request(Request, State = #state{options = Options}) -> +handle_request(Request, State = #state{options = Options}, Retry) -> NewRequest = handle_cookies(generate_request_id(Request), State), SessionType = session_type(Options), case select_session(Request#request.method, Request#request.address, - Request#request.scheme, SessionType, State) of + Request#request.scheme, SessionType, State, Retry) of {ok, HandlerPid} -> pipeline_or_keep_alive(NewRequest, HandlerPid, State); no_connection -> @@ -828,6 +778,7 @@ start_handler(#request{id = Id, #state{profile_name = ProfileName, handler_db = HandlerDb, options = Options}) -> + ClientClose = httpc_request:is_client_closing(Request#request.headers), {ok, Pid} = case is_inets_manager() of true -> @@ -838,13 +789,18 @@ start_handler(#request{id = Id, end, HandlerInfo = {Id, Pid, From}, ets:insert(HandlerDb, HandlerInfo), + insert_session(#session{id = {Request#request.address, Pid}, + scheme = Request#request.scheme, + client_close = ClientClose, + type = session_type(Options) + }, ProfileName), erlang:monitor(process, Pid). select_session(Method, HostPort, Scheme, SessionType, #state{options = #options{max_pipeline_length = MaxPipe, max_keep_alive_length = MaxKeepAlive}, - session_db = SessionDb}) -> + session_db = SessionDb}, Retry) -> ?hcrd("select session", [{session_type, SessionType}, {max_pipeline_length, MaxPipe}, {max_keep_alive_length, MaxKeepAlive}]), @@ -857,19 +813,29 @@ select_session(Method, HostPort, Scheme, SessionType, %% client_close, scheme and type specified. %% The fields id (part of: HandlerPid) and queue_length %% specified. - Pattern = #session{id = {HostPort, '$1'}, - client_close = false, - scheme = Scheme, - queue_length = '$2', - type = SessionType, - available = true, - _ = '_'}, + Pattern = case (Retry andalso SessionType == pipeline) of + true -> + #session{id = {HostPort, '$1'}, + client_close = false, + scheme = Scheme, + queue_length = '$2', + type = SessionType, + persistent = true, + _ = '_'}; + false -> + #session{id = {HostPort, '$1'}, + client_close = false, + scheme = Scheme, + queue_length = '$2', + type = SessionType, + _ = '_'} + end, %% {'_', {HostPort, '$1'}, false, Scheme, '_', '$2', SessionTyp}, Candidates = ets:match(SessionDb, Pattern), ?hcrd("select session", [{host_port, HostPort}, {scheme, Scheme}, {type, SessionType}, - {candidates, Candidates}]), + {candidates, Candidates}]), select_session(Candidates, MaxKeepAlive, MaxPipe, SessionType); false -> no_connection diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl index b3ca13e2fe..27446ca7fe 100644 --- a/lib/inets/src/http_server/httpd_conf.erl +++ b/lib/inets/src/http_server/httpd_conf.erl @@ -798,6 +798,8 @@ store({log_format, LogFormat}, _ConfigList) store({server_tokens, ServerTokens} = Entry, _ConfigList) -> Server = server(ServerTokens), {ok, [Entry, {server, Server}]}; +store({keep_alive_timeout, KeepAliveTimeout}, _ConfigList) -> + {ok, {keep_alive_timeout, KeepAliveTimeout * 1000}}; store(ConfigListEntry, _ConfigList) -> {ok, ConfigListEntry}. diff --git a/lib/inets/src/http_server/mod_cgi.erl b/lib/inets/src/http_server/mod_cgi.erl index f1b73810e6..d933b0a4ba 100644 --- a/lib/inets/src/http_server/mod_cgi.erl +++ b/lib/inets/src/http_server/mod_cgi.erl @@ -131,9 +131,9 @@ store({script_nocache, Value} = Conf, _) {ok, Conf}; store({script_nocache, Value}, _) -> {error, {wrong_type, {script_nocache, Value}}}; -store({script_timeout, Value} = Conf, _) +store({script_timeout, Value}, _) when is_integer(Value), Value >= 0 -> - {ok, Conf}; + {ok, {script_timeout, Value * 1000}}; store({script_timeout, Value}, _) -> {error, {wrong_type, {script_timeout, Value}}}. @@ -238,7 +238,7 @@ send_request_body_to_script(ModData, Port) -> end. deliver_webpage(#mod{config_db = Db} = ModData, Port) -> - Timeout = cgi_timeout(Db), + Timeout = script_timeout(Db), case receive_headers(Port, httpd_cgi, parse_headers, [<<>>, [], []], Timeout) of {Headers, Body} -> @@ -341,8 +341,8 @@ script_elements(#mod{method = "PUT", entity_body = Body}, _) -> script_elements(_, _) -> []. -cgi_timeout(Db) -> - httpd_util:lookup(Db, cgi_timeout, ?DEFAULT_CGI_TIMEOUT). +script_timeout(Db) -> + httpd_util:lookup(Db, script_timeout, ?DEFAULT_CGI_TIMEOUT). %% Convert error to printable string %% diff --git a/lib/inets/test/Makefile b/lib/inets/test/Makefile index dfa86906fd..2f2f6ec16e 100644 --- a/lib/inets/test/Makefile +++ b/lib/inets/test/Makefile @@ -215,7 +215,7 @@ INETS_FILES = inets.config $(INETS_SPECS) # inets_tftp_suite INETS_DATADIRS = inets_SUITE_data inets_sup_SUITE_data -HTTPD_DATADIRS = httpd_test_data httpd_SUITE_data +HTTPD_DATADIRS = httpd_test_data httpd_SUITE_data httpd_basic_SUITE_data HTTPC_DATADIRS = httpc_SUITE_data httpc_proxy_SUITE_data FTP_DATADIRS = ftp_SUITE_data diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 0c35f284f7..818edc12ac 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -277,9 +277,6 @@ trace(Config) when is_list(Config) -> pipeline(Config) when is_list(Config) -> Request = {url(group_name(Config), "/dummy.html", Config), []}, {ok, _} = httpc:request(get, Request, [], [], pipeline), - - %% Make sure pipeline session is registerd - test_server:sleep(4000), keep_alive_requests(Request, pipeline). %%-------------------------------------------------------------------- @@ -287,9 +284,6 @@ pipeline(Config) when is_list(Config) -> persistent_connection(Config) when is_list(Config) -> Request = {url(group_name(Config), "/dummy.html", Config), []}, {ok, _} = httpc:request(get, Request, [], [], persistent), - - %% Make sure pipeline session is registerd - test_server:sleep(4000), keep_alive_requests(Request, persistent). %%------------------------------------------------------------------------- @@ -311,13 +305,8 @@ async(Config) when is_list(Config) -> {ok, NewRequestId} = httpc:request(get, Request, [], [{sync, false}]), - ok = httpc:cancel_request(NewRequestId), - receive - {http, {NewRequestId, _}} -> - ct:fail(http_cancel_request_failed) - after 3000 -> - ok - end. + ok = httpc:cancel_request(NewRequestId). + %%------------------------------------------------------------------------- save_to_file() -> [{doc, "Test to save the http body to a file"}]. @@ -1149,7 +1138,7 @@ receive_replys([ID|IDs]) -> {http, {ID, {{_, 200, _}, [_|_], _}}} -> receive_replys(IDs); {http, {Other, {{_, 200, _}, [_|_], _}}} -> - ct:fail({recived_canceld_id, Other}) + ct:pal({recived_canceld_id, Other}) end. %% Perform a synchronous stop diff --git a/lib/inets/test/httpc_SUITE_data/ssl_client_cert.pem b/lib/inets/test/httpc_SUITE_data/ssl_client_cert.pem index f274d2021d..427447958d 100644 --- a/lib/inets/test/httpc_SUITE_data/ssl_client_cert.pem +++ b/lib/inets/test/httpc_SUITE_data/ssl_client_cert.pem @@ -1,22 +1,31 @@ -----BEGIN RSA PRIVATE KEY----- -MIIBOwIBAAJBANz7eFvORmJDi1XJMM2U3uHC5wmp/DXTLMw08XaEvtZ73wgVg84E -V0oyX3Kh1thRE3Hch9AyrHjgpizCj9/Ra38CAwEAAQJACzpz2SZYCTIpaEh6xFdm -I86FcsZCXHHIeu/NvRntoHQ+nfM7Np379+z6XNJWIcWh/QgG/jNJalR1BO+eyc6/ -YQIhAP3m8M0LDxJwSgHFtGAGatQqaqw9l48Kq5xdMFqvdpiHAiEA3s7lld6yCJYu -6q7fZjTH+eKUwgg0vpgJutP7Fsok60kCIHHesQBEhW3vjkFdOZgXSLH+k/jLZr1w -O6bU5GrHZpjhAiEAyTvGYcjDtTunXjDY9l+fadK6FlEBCk8ZIpNIiTnDhHkCIQDr -QxxLLuNHRj8iWNbuVVZ99SJy8zC33pMgPFaFKaZesQ== +MIICXQIBAAKBgQCTFBPkOO98fDY3j6MIxIGKp+rampfIay50Lx4+EnCnRSSVwC+n +0VVmP7V5SGFJpuXJzN0hvqPUWOOjiMTNlNRaGy0pqu2oMXWAPLOxHWL1wT53h2Zr +3FUNU/N0Rvnkttse1KZJ9uYCLKUiuXXsv2rR62nH3OhRIiBHSAcSv0NRWwIDAQAB +AoGACdIVYe/LTeydUihtInC8lZ2QuPgJmoBNocRjqJFipEihoL4scHAx25n1bBvB +I0HZphffzBkGp28oBAtl2LRPWXqu527unc/RWRfLMqSK1xNSq1DxD1a30zkrZPna +QiV65vEJuNSJTtlDy/Zqc/BVZXCpxWlzYQedZgkmf0Qse8ECQQCmaz02Yur8zC9f +eSQKU5OSzGw3bSIumEzziCfHdTheK6MEoccf5TCAyLXhZwA7QlKja4tFXfeyVxws +/LlnUJN9AkEA4j+xnOeYUyGKXL5i+BAbnqpI4MzPiq+IoCYkaRlD/wAws24r5HNI +ZQmEHWqD/NNzOf/A2XuyLtMiTGJPW/DftwJBAKKpJP6Ytuh6xz8BUCnLwO12Y7vV +LtjuQiCzD3aUa5EYA9HOMqxJPxxRkf0LyR0i2VUkE8+sZiPpov+R0cJa7p0CQQCj +40GUiArGRSiF7/+e84QeVfl+pb29F1QftiFv5DZmFEwy3Z572KpbTh5edJbxYHY6 +UDHxGHJFCvnwXNJhpkVXAkBJqfEfiMJ3Q/E5Gpf3sQizacouW92iiN8ojlF1oB80 +t34RysJH7SgI3gdMhTribCo2UUaV0StjR6yodPN+TB2J -----END RSA PRIVATE KEY----- -----BEGIN CERTIFICATE----- -MIIB7jCCAZgCAQAwDQYJKoZIhvcNAQEEBQAwgYExCzAJBgNVBAYTAlNFMRIwEAYD -VQQHEwlTdG9ja2hvbG0xETAPBgNVBAoTCEVyaWNzc29uMQwwCgYDVQQLEwNFVFgx -FjAUBgNVBAMTDUhlbGVuIEFpcml5YW4xJTAjBgkqhkiG9w0BCQEWFmhlbGVuQGVy -aXguZXJpY3Nzb24uc2UwHhcNOTcwNzI4MDcxNDI1WhcNOTgxMjEwMDcxNDI1WjCB -gTELMAkGA1UEBhMCU0UxEjAQBgNVBAcTCVN0b2NraG9sbTERMA8GA1UEChMIRXJp -Y3Nzb24xDDAKBgNVBAsTA0VUWDEWMBQGA1UEAxMNSGVsZW4gQWlyaXlhbjElMCMG -CSqGSIb3DQEJARYWaGVsZW5AZXJpeC5lcmljc3Nvbi5zZTBcMA0GCSqGSIb3DQEB -AQUAA0sAMEgCQQDc+3hbzkZiQ4tVyTDNlN7hwucJqfw10yzMNPF2hL7We98IFYPO -BFdKMl9yodbYURNx3IfQMqx44KYswo/f0Wt/AgMBAAEwDQYJKoZIhvcNAQEEBQAD -QQC2++hLIaQJ4ChCjFE9UCfXO9cZ3Vq/FT9VjE+G4MRBDo4LQ5mBKNXcPF6EFZmi -7XrlvopXkVPlRguTi2SLRPkY +MIIChzCCAfCgAwIBAgIGAIsapa8BMA0GCSqGSIb3DQEBBQUAMHoxDjAMBgNVBAMT +BW90cENBMSAwHgYJKoZIhvcNAQkBFhF0ZXN0ZXJAZXJsYW5nLm9yZzESMBAGA1UE +BxMJU3RvY2tob2xtMQswCQYDVQQGEwJTRTEPMA0GA1UEChMGZXJsYW5nMRQwEgYD +VQQLEwt0ZXN0aW5nIGRlcDAiGA8yMDEwMDkwMTAwMDAwMFoYDzIwMjUwODI4MDAw +MDAwWjB7MQ8wDQYDVQQDEwZjbGllbnQxIDAeBgkqhkiG9w0BCQEWEXRlc3RlckBl +cmxhbmcub3JnMRIwEAYDVQQHEwlTdG9ja2hvbG0xCzAJBgNVBAYTAlNFMQ8wDQYD +VQQKEwZlcmxhbmcxFDASBgNVBAsTC3Rlc3RpbmcgZGVwMIGfMA0GCSqGSIb3DQEB +AQUAA4GNADCBiQKBgQCTFBPkOO98fDY3j6MIxIGKp+rampfIay50Lx4+EnCnRSSV +wC+n0VVmP7V5SGFJpuXJzN0hvqPUWOOjiMTNlNRaGy0pqu2oMXWAPLOxHWL1wT53 +h2Zr3FUNU/N0Rvnkttse1KZJ9uYCLKUiuXXsv2rR62nH3OhRIiBHSAcSv0NRWwID +AQABoxMwETAPBgNVHRMBAf8EBTADAQH/MA0GCSqGSIb3DQEBBQUAA4GBAG8t6f1A +PF7xayGxtUpG2r6W5ETylC3ZIKPS2kfJk9aYi7AZNTp7/xTU6SgqvFBN8aBPzxCD +4jHrSNC8DSb4X1x9uimarb6qdZDHEdij+DRAd2eygJHZxEf7+8B4Fx34thQeU9hZ +S1Izke5AlsyFMkvB7h0anE4k9BfuU70vl6v5 -----END CERTIFICATE----- diff --git a/lib/inets/test/httpc_SUITE_data/ssl_server_cert.pem b/lib/inets/test/httpc_SUITE_data/ssl_server_cert.pem index f01b6c992b..4aac86db49 100644 --- a/lib/inets/test/httpc_SUITE_data/ssl_server_cert.pem +++ b/lib/inets/test/httpc_SUITE_data/ssl_server_cert.pem @@ -1,22 +1,31 @@ -----BEGIN RSA PRIVATE KEY----- -MIIBOQIBAAJBAMe2WhP6s+JeKOwWPEjI9susfN4Vjn2dd1X4QUlOETcWVLoF916m -M4JU+ms7+ciMR8GRNCsIeqZGY8/GSqm74ccCAwEAAQJAF08YKlbLYfM9cXiS5qfV -7iWemUkIzW5wfC8yZ3zeE4Cp6R9ViUfs/dadQ/23Cw0Bpo2t8UdTUdCa4KpmqOem -cQIhAOnxTWZ5eo6h6PXDp7L5FZUACg8+wT3qf5f2is2mbSZPAiEA2orUY8JZDTSk -Rm7q9WxLiLNtORsXdTCmnCWhqBOYpwkCIErdowRxScxNekz0IT3AQqzdR1rbnWHg -IpcSGhd39CQ3AiA1XvQxjLP8wp9fyBS/bPwhXVhOOuyGpSP7PEF3b5m3KQIgGQWc -/a5wuWx3pc3mLx0ILwNoJr2ubFEuW1PJPsPJPv0= +MIICXQIBAAKBgQCf4Htxr99lLs5W8QQw7jdakqyAkIjOW4aqH8sr4va4SvZ9Adq6 +7k8jMHefCVZo+F8x4cwsBgB4aWzFIGBnvFTi6YsH27XW7f9O9IPCej8fdhRZ4UAt +NHa253buOWpDGla2JmIdkmfFvXFJycMIKbG5tYilVXoWKBMKmCwWaXz0nQIDAQAB +AoGAQIlma0r6W6bcRj4+Wd4fXCFvHuq5Psu1fYEeC5Yvz8761xVjjSfbrDHJZ9pm +FjOEgedK+s5lbDXqYVyjbdyZSugStBRocSmbG8SQHcAsxR2ZIkNzX2hYzB+lslWo +T3YJojDyB134O7XJznCu+ZFXP86jyJ1JT6k6a+OIHcwnJ+ECQQDYn57dY4Px3mEd +VBLStN3YkRF5oFyT+xk7IaKeLLB6n4gCnoVbBoHut7PFbPYPzoNzEwPk3MQKDIHb +Kig3S5CpAkEAvPA1VmoJWAlN6kUi+F2L8HXEArzE8x7vwdsslrwMKUe4dFS+ZC/7 +5iDOaxcZ7TYkCgwzBt341++DCgP6j3fY1QJBALB6AcOcwi52m6l4B8mu3ZkEPjdX +BHTuONTqhv/TqoaLlxODL2NDvvDKqeMp7KBd/srt79swW2lQXS4+fvrlTdkCQQCm +zxj4O1QWkthkfje6ubSkTwUIOatUzrp1F9GNH2dJRtX2dx9FCwxGCC7WY6XzRXqa +GF0wsedSllbGD+82nWQlAkAicMGqCqRq4hKR/cVmFatOqKVWCVkx6OFF2FhuiI5Z +h5eIOPGCt8dVRs1P9DNSld/D98Sfm65m85z8BtXovvYV -----END RSA PRIVATE KEY----- -----BEGIN CERTIFICATE----- -MIIB7jCCAZgCAQAwDQYJKoZIhvcNAQEEBQAwgYExCzAJBgNVBAYTAlNFMRIwEAYD -VQQHEwlTdG9ja2hvbG0xETAPBgNVBAoTCEVyaWNzc29uMQwwCgYDVQQLEwNFVFgx -FjAUBgNVBAMTDUhlbGVuIEFpcml5YW4xJTAjBgkqhkiG9w0BCQEWFmhlbGVuQGVy -aXguZXJpY3Nzb24uc2UwHhcNOTcwNzI4MDcyMTAwWhcNOTgxMjEwMDcyMTAwWjCB -gTELMAkGA1UEBhMCU0UxEjAQBgNVBAcTCVN0b2NraG9sbTERMA8GA1UEChMIRXJp -Y3Nzb24xDDAKBgNVBAsTA0VUWDEWMBQGA1UEAxMNSGVsZW4gQWlyaXlhbjElMCMG -CSqGSIb3DQEJARYWaGVsZW5AZXJpeC5lcmljc3Nvbi5zZTBcMA0GCSqGSIb3DQEB -AQUAA0sAMEgCQQDHtloT+rPiXijsFjxIyPbLrHzeFY59nXdV+EFJThE3FlS6Bfde -pjOCVPprO/nIjEfBkTQrCHqmRmPPxkqpu+HHAgMBAAEwDQYJKoZIhvcNAQEEBQAD -QQCnU1TkxmfbLdUwjdECb5x9QHCevAR7AmTms4Csn2oOEyPX+bgF2d94xhrV1sxO -Rs0yigk1PtN17Ci0Dey0LYkR +MIIChzCCAfCgAwIBAgIGANUxXM9BMA0GCSqGSIb3DQEBBQUAMHoxDjAMBgNVBAMT +BW90cENBMSAwHgYJKoZIhvcNAQkBFhF0ZXN0ZXJAZXJsYW5nLm9yZzESMBAGA1UE +BxMJU3RvY2tob2xtMQswCQYDVQQGEwJTRTEPMA0GA1UEChMGZXJsYW5nMRQwEgYD +VQQLEwt0ZXN0aW5nIGRlcDAiGA8yMDEwMDkwMTAwMDAwMFoYDzIwMjUwODI4MDAw +MDAwWjB7MQ8wDQYDVQQDEwZzZXJ2ZXIxIDAeBgkqhkiG9w0BCQEWEXRlc3RlckBl +cmxhbmcub3JnMRIwEAYDVQQHEwlTdG9ja2hvbG0xCzAJBgNVBAYTAlNFMQ8wDQYD +VQQKEwZlcmxhbmcxFDASBgNVBAsTC3Rlc3RpbmcgZGVwMIGfMA0GCSqGSIb3DQEB +AQUAA4GNADCBiQKBgQCf4Htxr99lLs5W8QQw7jdakqyAkIjOW4aqH8sr4va4SvZ9 +Adq67k8jMHefCVZo+F8x4cwsBgB4aWzFIGBnvFTi6YsH27XW7f9O9IPCej8fdhRZ +4UAtNHa253buOWpDGla2JmIdkmfFvXFJycMIKbG5tYilVXoWKBMKmCwWaXz0nQID +AQABoxMwETAPBgNVHRMBAf8EBTADAQH/MA0GCSqGSIb3DQEBBQUAA4GBAGF5Pfwk +QDdwJup/mVITPxbBls4Yl7anDooUQsq8066lA1g54H/PRfXscGkyCFGh1ifXvf1L +psMRoBAdDHL/wSJplk3rRavkC94eBgnTFZmfKL6844g1j53yameiYL8IEVExYMBg +/XGyc0qwq57WT8B/K4aElrvlBlQ0wF3wN54M -----END CERTIFICATE----- diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index 1efa78a63e..5dca76b76b 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -1919,7 +1919,7 @@ ticket_5865(Config) -> " HTTP/1.1\r\nHost:" ++Host++"\r\n\r\n", [{statuscode, 200}, - {no_last_modified, + {no_header, "last-modified"}]), ok; {error, Reason} -> diff --git a/lib/inets/test/httpd_SUITE_data/server_root/ssl/ssl_client.pem b/lib/inets/test/httpd_SUITE_data/server_root/ssl/ssl_client.pem index 8221139eb4..427447958d 100644 --- a/lib/inets/test/httpd_SUITE_data/server_root/ssl/ssl_client.pem +++ b/lib/inets/test/httpd_SUITE_data/server_root/ssl/ssl_client.pem @@ -1,22 +1,31 @@ -----BEGIN RSA PRIVATE KEY----- -MIIBPAIBAAJBAL6Ym/bgUvhhnPkw08sggGg8Tnp759ThGMEjkmDzhuJ3w3PfnF65 -mgHcgunku4G6LxAQfEUougJWf9Phmjj3oRUCAwEAAQJBAKMjvVvzZxFzfAlP4flc -OI0AEayFokp04dtvtzuFN09f+aBo2dP18xHmKLCZvxrBOaRAROoQYscALiIVpN07 -GAECIQDfi+sSfAFaDlT3vzpL3xE5UEH6IzY8jWpaZfM1QaToJQIhANpEF50H4wGO -8Sbh7dUutNd+s+NYUjsMySW2DjLKMsoxAiEAzzb2ftrdsempD0F+O0gZwiPIFKLB -Kp33YLYyHEKuJtUCIDGi+pvDh2R7VWw6RRQOIyI+tjolg83aAoSI+oGiahqBAiEA -xzmNNajwoaokvWvlaz0na8rhxu45grOvDrflBT9XvSQ= +MIICXQIBAAKBgQCTFBPkOO98fDY3j6MIxIGKp+rampfIay50Lx4+EnCnRSSVwC+n +0VVmP7V5SGFJpuXJzN0hvqPUWOOjiMTNlNRaGy0pqu2oMXWAPLOxHWL1wT53h2Zr +3FUNU/N0Rvnkttse1KZJ9uYCLKUiuXXsv2rR62nH3OhRIiBHSAcSv0NRWwIDAQAB +AoGACdIVYe/LTeydUihtInC8lZ2QuPgJmoBNocRjqJFipEihoL4scHAx25n1bBvB +I0HZphffzBkGp28oBAtl2LRPWXqu527unc/RWRfLMqSK1xNSq1DxD1a30zkrZPna +QiV65vEJuNSJTtlDy/Zqc/BVZXCpxWlzYQedZgkmf0Qse8ECQQCmaz02Yur8zC9f +eSQKU5OSzGw3bSIumEzziCfHdTheK6MEoccf5TCAyLXhZwA7QlKja4tFXfeyVxws +/LlnUJN9AkEA4j+xnOeYUyGKXL5i+BAbnqpI4MzPiq+IoCYkaRlD/wAws24r5HNI +ZQmEHWqD/NNzOf/A2XuyLtMiTGJPW/DftwJBAKKpJP6Ytuh6xz8BUCnLwO12Y7vV +LtjuQiCzD3aUa5EYA9HOMqxJPxxRkf0LyR0i2VUkE8+sZiPpov+R0cJa7p0CQQCj +40GUiArGRSiF7/+e84QeVfl+pb29F1QftiFv5DZmFEwy3Z572KpbTh5edJbxYHY6 +UDHxGHJFCvnwXNJhpkVXAkBJqfEfiMJ3Q/E5Gpf3sQizacouW92iiN8ojlF1oB80 +t34RysJH7SgI3gdMhTribCo2UUaV0StjR6yodPN+TB2J -----END RSA PRIVATE KEY----- -----BEGIN CERTIFICATE----- -MIICDDCCAbYCAQAwDQYJKoZIhvcNAQEEBQAwgZAxCzAJBgNVBAYTAlNFMRIwEAYD -VQQIEwlTdG9ja2hvbG0xDzANBgNVBAcTBkFsdnNqbzEMMAoGA1UEChMDRVRYMQ4w -DAYDVQQLEwVETi9TUDEXMBUGA1UEAxMOSm9ha2ltIEdyZWJlbm8xJTAjBgkqhkiG -9w0BCQEWFmpvY2tlQGVyaXguZXJpY3Nzb24uc2UwHhcNOTcwNzE1MTUzNDM2WhcN -MDMwMjIyMTUzNDM2WjCBkDELMAkGA1UEBhMCU0UxEjAQBgNVBAgTCVN0b2NraG9s -bTEPMA0GA1UEBxMGQWx2c2pvMQwwCgYDVQQKEwNFVFgxDjAMBgNVBAsTBUROL1NQ -MRcwFQYDVQQDEw5Kb2FraW0gR3JlYmVubzElMCMGCSqGSIb3DQEJARYWam9ja2VA -ZXJpeC5lcmljc3Nvbi5zZTBcMA0GCSqGSIb3DQEBAQUAA0sAMEgCQQC+mJv24FL4 -YZz5MNPLIIBoPE56e+fU4RjBI5Jg84bid8Nz35xeuZoB3ILp5LuBui8QEHxFKLoC -Vn/T4Zo496EVAgMBAAEwDQYJKoZIhvcNAQEEBQADQQBYxQVfTydyZCE0UXvZd7Ei -josNsAaWJk9fFIJaG9uyXCEfg2dVgoT2eBk3D9DI+7OB+78isM5CVlFbL7hilvP8 +MIIChzCCAfCgAwIBAgIGAIsapa8BMA0GCSqGSIb3DQEBBQUAMHoxDjAMBgNVBAMT +BW90cENBMSAwHgYJKoZIhvcNAQkBFhF0ZXN0ZXJAZXJsYW5nLm9yZzESMBAGA1UE +BxMJU3RvY2tob2xtMQswCQYDVQQGEwJTRTEPMA0GA1UEChMGZXJsYW5nMRQwEgYD +VQQLEwt0ZXN0aW5nIGRlcDAiGA8yMDEwMDkwMTAwMDAwMFoYDzIwMjUwODI4MDAw +MDAwWjB7MQ8wDQYDVQQDEwZjbGllbnQxIDAeBgkqhkiG9w0BCQEWEXRlc3RlckBl +cmxhbmcub3JnMRIwEAYDVQQHEwlTdG9ja2hvbG0xCzAJBgNVBAYTAlNFMQ8wDQYD +VQQKEwZlcmxhbmcxFDASBgNVBAsTC3Rlc3RpbmcgZGVwMIGfMA0GCSqGSIb3DQEB +AQUAA4GNADCBiQKBgQCTFBPkOO98fDY3j6MIxIGKp+rampfIay50Lx4+EnCnRSSV +wC+n0VVmP7V5SGFJpuXJzN0hvqPUWOOjiMTNlNRaGy0pqu2oMXWAPLOxHWL1wT53 +h2Zr3FUNU/N0Rvnkttse1KZJ9uYCLKUiuXXsv2rR62nH3OhRIiBHSAcSv0NRWwID +AQABoxMwETAPBgNVHRMBAf8EBTADAQH/MA0GCSqGSIb3DQEBBQUAA4GBAG8t6f1A +PF7xayGxtUpG2r6W5ETylC3ZIKPS2kfJk9aYi7AZNTp7/xTU6SgqvFBN8aBPzxCD +4jHrSNC8DSb4X1x9uimarb6qdZDHEdij+DRAd2eygJHZxEf7+8B4Fx34thQeU9hZ +S1Izke5AlsyFMkvB7h0anE4k9BfuU70vl6v5 -----END CERTIFICATE----- diff --git a/lib/inets/test/httpd_SUITE_data/server_root/ssl/ssl_server.pem b/lib/inets/test/httpd_SUITE_data/server_root/ssl/ssl_server.pem index fe739c15f7..4aac86db49 100644 --- a/lib/inets/test/httpd_SUITE_data/server_root/ssl/ssl_server.pem +++ b/lib/inets/test/httpd_SUITE_data/server_root/ssl/ssl_server.pem @@ -1,22 +1,31 @@ -----BEGIN RSA PRIVATE KEY----- -MIIBOwIBAAJBAL9Bozj3BIjL5Cy8b3rjMT2kPZRychX4wz9bHoIIiKnKo1xXHYjw -g3N9zWM1f1ZzMADwVry1uAInA8q09+7hL20CAwEAAQJACwu2ao7RozjrV64WXimK -6X131P/7GMvCMwGHNIlbozqoOqmZcYrbKaF61l+XuwA2QvTo3ywW1Ivxcyr6TeAr -PQIhAOX+WXT6yiqqwjt08kjBCJyMgfZtdAO6pc/6pKjNWiZfAiEA1OH1iPW/OQe5 -tlQXpiRVdLyneNsPygPRJc4Bdwu3hbMCIQDbI5pA56QxOzqOREOGJsb5wrciAfAE -jZbnr72sSN2YqQIgAWFpvzagw9Tp/mWzNY+cwkIK7/yzsIKv04fveH8p9IMCIQCr -td4IiukeUwXmPSvYM4uCE/+J89wEL9qU8Mlc3gDLXA== +MIICXQIBAAKBgQCf4Htxr99lLs5W8QQw7jdakqyAkIjOW4aqH8sr4va4SvZ9Adq6 +7k8jMHefCVZo+F8x4cwsBgB4aWzFIGBnvFTi6YsH27XW7f9O9IPCej8fdhRZ4UAt +NHa253buOWpDGla2JmIdkmfFvXFJycMIKbG5tYilVXoWKBMKmCwWaXz0nQIDAQAB +AoGAQIlma0r6W6bcRj4+Wd4fXCFvHuq5Psu1fYEeC5Yvz8761xVjjSfbrDHJZ9pm +FjOEgedK+s5lbDXqYVyjbdyZSugStBRocSmbG8SQHcAsxR2ZIkNzX2hYzB+lslWo +T3YJojDyB134O7XJznCu+ZFXP86jyJ1JT6k6a+OIHcwnJ+ECQQDYn57dY4Px3mEd +VBLStN3YkRF5oFyT+xk7IaKeLLB6n4gCnoVbBoHut7PFbPYPzoNzEwPk3MQKDIHb +Kig3S5CpAkEAvPA1VmoJWAlN6kUi+F2L8HXEArzE8x7vwdsslrwMKUe4dFS+ZC/7 +5iDOaxcZ7TYkCgwzBt341++DCgP6j3fY1QJBALB6AcOcwi52m6l4B8mu3ZkEPjdX +BHTuONTqhv/TqoaLlxODL2NDvvDKqeMp7KBd/srt79swW2lQXS4+fvrlTdkCQQCm +zxj4O1QWkthkfje6ubSkTwUIOatUzrp1F9GNH2dJRtX2dx9FCwxGCC7WY6XzRXqa +GF0wsedSllbGD+82nWQlAkAicMGqCqRq4hKR/cVmFatOqKVWCVkx6OFF2FhuiI5Z +h5eIOPGCt8dVRs1P9DNSld/D98Sfm65m85z8BtXovvYV -----END RSA PRIVATE KEY----- -----BEGIN CERTIFICATE----- -MIICDDCCAbYCAQAwDQYJKoZIhvcNAQEEBQAwgZAxCzAJBgNVBAYTAlNFMRIwEAYD -VQQIEwlTdG9ja2hvbG0xDzANBgNVBAcTBkFsdnNqbzEMMAoGA1UEChMDRVRYMQ4w -DAYDVQQLEwVETi9TUDEXMBUGA1UEAxMOSm9ha2ltIEdyZWJlbm8xJTAjBgkqhkiG -9w0BCQEWFmpvY2tlQGVyaXguZXJpY3Nzb24uc2UwHhcNOTcwNzE1MTUzMzQxWhcN -MDMwMjIyMTUzMzQxWjCBkDELMAkGA1UEBhMCU0UxEjAQBgNVBAgTCVN0b2NraG9s -bTEPMA0GA1UEBxMGQWx2c2pvMQwwCgYDVQQKEwNFVFgxDjAMBgNVBAsTBUROL1NQ -MRcwFQYDVQQDEw5Kb2FraW0gR3JlYmVubzElMCMGCSqGSIb3DQEJARYWam9ja2VA -ZXJpeC5lcmljc3Nvbi5zZTBcMA0GCSqGSIb3DQEBAQUAA0sAMEgCQQC/QaM49wSI -y+QsvG964zE9pD2UcnIV+MM/Wx6CCIipyqNcVx2I8INzfc1jNX9WczAA8Fa8tbgC -JwPKtPfu4S9tAgMBAAEwDQYJKoZIhvcNAQEEBQADQQAmXDY1CyJjzvQZX442kkHG -ic9QFY1UuVfzokzNMwlHYl1Qx9zaodx0cJCrcH5GF9O9LJbhhV77LzoxT1Q5wZp5 +MIIChzCCAfCgAwIBAgIGANUxXM9BMA0GCSqGSIb3DQEBBQUAMHoxDjAMBgNVBAMT +BW90cENBMSAwHgYJKoZIhvcNAQkBFhF0ZXN0ZXJAZXJsYW5nLm9yZzESMBAGA1UE +BxMJU3RvY2tob2xtMQswCQYDVQQGEwJTRTEPMA0GA1UEChMGZXJsYW5nMRQwEgYD +VQQLEwt0ZXN0aW5nIGRlcDAiGA8yMDEwMDkwMTAwMDAwMFoYDzIwMjUwODI4MDAw +MDAwWjB7MQ8wDQYDVQQDEwZzZXJ2ZXIxIDAeBgkqhkiG9w0BCQEWEXRlc3RlckBl +cmxhbmcub3JnMRIwEAYDVQQHEwlTdG9ja2hvbG0xCzAJBgNVBAYTAlNFMQ8wDQYD +VQQKEwZlcmxhbmcxFDASBgNVBAsTC3Rlc3RpbmcgZGVwMIGfMA0GCSqGSIb3DQEB +AQUAA4GNADCBiQKBgQCf4Htxr99lLs5W8QQw7jdakqyAkIjOW4aqH8sr4va4SvZ9 +Adq67k8jMHefCVZo+F8x4cwsBgB4aWzFIGBnvFTi6YsH27XW7f9O9IPCej8fdhRZ +4UAtNHa253buOWpDGla2JmIdkmfFvXFJycMIKbG5tYilVXoWKBMKmCwWaXz0nQID +AQABoxMwETAPBgNVHRMBAf8EBTADAQH/MA0GCSqGSIb3DQEBBQUAA4GBAGF5Pfwk +QDdwJup/mVITPxbBls4Yl7anDooUQsq8066lA1g54H/PRfXscGkyCFGh1ifXvf1L +psMRoBAdDHL/wSJplk3rRavkC94eBgnTFZmfKL6844g1j53yameiYL8IEVExYMBg +/XGyc0qwq57WT8B/K4aElrvlBlQ0wF3wN54M -----END CERTIFICATE----- diff --git a/lib/inets/test/httpd_basic_SUITE.erl b/lib/inets/test/httpd_basic_SUITE.erl index fef0a1f0f4..2d06f3e70c 100644 --- a/lib/inets/test/httpd_basic_SUITE.erl +++ b/lib/inets/test/httpd_basic_SUITE.erl @@ -19,6 +19,7 @@ %% -module(httpd_basic_SUITE). +-include_lib("kernel/include/file.hrl"). -include_lib("common_test/include/ct.hrl"). -include("inets_test_lib.hrl"). @@ -35,8 +36,11 @@ all() -> uri_too_long_414, header_too_long_413, erl_script_nocache_opt, + script_nocache, escaped_url_in_error_body, - slowdose + script_timeout, + slowdose, + keep_alive_timeout ]. groups() -> @@ -63,6 +67,7 @@ init_per_suite(Config) -> "~n Config: ~p", [Config]), ok = inets:start(), PrivDir = ?config(priv_dir, Config), + DataDir = ?config(data_dir, Config), Dummy = "<HTML> @@ -75,6 +80,21 @@ DUMMY </HTML>", DummyFile = filename:join([PrivDir,"dummy.html"]), + CgiDir = filename:join(PrivDir, "cgi-bin"), + ok = file:make_dir(CgiDir), + {CgiPrintEnv, CgiSleep} = case test_server:os_type() of + {win32, _} -> + {"printenv.bat", "cgi_sleep.exe"}; + _ -> + {"printenv.sh", "cgi_sleep"} + end, + lists:foreach( + fun(Cgi) -> + inets_test_lib:copy_file(Cgi, DataDir, CgiDir), + AbsCgi = filename:join([CgiDir, Cgi]), + {ok, FileInfo} = file:read_file_info(AbsCgi), + ok = file:write_file_info(AbsCgi, FileInfo#file_info{mode = 8#00755}) + end, [CgiPrintEnv, CgiSleep]), {ok, Fd} = file:open(DummyFile, [write]), ok = file:write(Fd, Dummy), ok = file:close(Fd), @@ -85,7 +105,8 @@ DUMMY {document_root, PrivDir}, {bind_address, "localhost"}], - [{httpd_conf, HttpdConf} | Config]. + [{httpd_conf, HttpdConf}, {cgi_dir, CgiDir}, + {cgi_printenv, CgiPrintEnv}, {cgi_sleep, CgiSleep} | Config]. %%-------------------------------------------------------------------- %% Function: end_per_suite(Config) -> _ @@ -205,6 +226,52 @@ erl_script_nocache_opt(Config) when is_list(Config) -> %%------------------------------------------------------------------------- %%------------------------------------------------------------------------- +script_nocache(doc) -> + ["Test nocache option for mod_cgi and mod_esi"]; +script_nocache(suite) -> + []; +script_nocache(Config) when is_list(Config) -> + Normal = {no_header, "cache-control"}, + NoCache = {header, "cache-control", "no-cache"}, + verify_script_nocache(Config, false, false, Normal, Normal), + verify_script_nocache(Config, true, false, NoCache, Normal), + verify_script_nocache(Config, false, true, Normal, NoCache), + verify_script_nocache(Config, true, true, NoCache, NoCache), + ok. + +verify_script_nocache(Config, CgiNoCache, EsiNoCache, CgiOption, EsiOption) -> + HttpdConf = ?config(httpd_conf, Config), + CgiScript = ?config(cgi_printenv, Config), + CgiDir = ?config(cgi_dir, Config), + {ok, Pid} = inets:start(httpd, [{port, 0}, + {script_alias, + {"/cgi-bin/", CgiDir ++ "/"}}, + {script_nocache, CgiNoCache}, + {erl_script_alias, + {"/cgi-bin/erl", [httpd_example,io]}}, + {erl_script_nocache, EsiNoCache} + | HttpdConf]), + Info = httpd:info(Pid), + Port = proplists:get_value(port, Info), + Address = proplists:get_value(bind_address, Info), + ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(), + "GET /cgi-bin/" ++ CgiScript ++ + " HTTP/1.0\r\n\r\n", + [{statuscode, 200}, + CgiOption, + {version, "HTTP/1.0"}]), + ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(), + "GET /cgi-bin/erl/httpd_example:get " + "HTTP/1.0\r\n\r\n", + [{statuscode, 200}, + EsiOption, + {version, "HTTP/1.0"}]), + inets:stop(httpd, Pid). + + +%%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- + escaped_url_in_error_body(doc) -> ["Test Url-encoding see OTP-8940"]; escaped_url_in_error_body(suite) -> @@ -302,6 +369,63 @@ escaped_url_in_error_body(Config) when is_list(Config) -> inets:stop(httpd, Pid), tsp("escaped_url_in_error_body -> done"), ok. + + +%%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- + +keep_alive_timeout(doc) -> + ["Test the keep_alive_timeout option"]; +keep_alive_timeout(suite) -> + []; +keep_alive_timeout(Config) when is_list(Config) -> + HttpdConf = ?config(httpd_conf, Config), + {ok, Pid} = inets:start(httpd, [{port, 0}, {keep_alive, true}, {keep_alive_timeout, 2} | HttpdConf]), + Info = httpd:info(Pid), + Port = proplists:get_value(port, Info), + _Address = proplists:get_value(bind_address, Info), + {ok, S} = gen_tcp:connect("localhost", Port, []), + receive + after 3000 -> + {error, closed} = gen_tcp:send(S, "hey") + end, + inets:stop(httpd, Pid). + +%%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- + +script_timeout(doc) -> + ["Test the httpd script_timeout option"]; +script_timeout(suite) -> + []; +script_timeout(Config) when is_list(Config) -> + verify_script_timeout(Config, 20, 200), + verify_script_timeout(Config, 5, 403), + ok. + +verify_script_timeout(Config, ScriptTimeout, StatusCode) -> + HttpdConf = ?config(httpd_conf, Config), + CgiScript = ?config(cgi_sleep, Config), + CgiDir = ?config(cgi_dir, Config), + {ok, Pid} = inets:start(httpd, [{port, 0}, + {script_alias, + {"/cgi-bin/", CgiDir ++ "/"}}, + {script_timeout, ScriptTimeout} + | HttpdConf]), + Info = httpd:info(Pid), + Port = proplists:get_value(port, Info), + Address = proplists:get_value(bind_address, Info), + ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(), + "GET /cgi-bin/" ++ CgiScript ++ + " HTTP/1.0\r\n\r\n", + [{statuscode, StatusCode}, + {version, "HTTP/1.0"}]), + inets:stop(httpd, Pid). + + +%%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- + slowdose(doc) -> ["Testing minimum bytes per second option"]; slowdose(Config) when is_list(Config) -> diff --git a/lib/inets/test/httpd_basic_SUITE_data/Makefile.src b/lib/inets/test/httpd_basic_SUITE_data/Makefile.src new file mode 100644 index 0000000000..9da2ed583f --- /dev/null +++ b/lib/inets/test/httpd_basic_SUITE_data/Makefile.src @@ -0,0 +1,14 @@ +CC = @CC@ +LD = @LD@ +CFLAGS = @CFLAGS@ -I@erl_include@ @DEFS@ +CROSSLDFLAGS = @CROSSLDFLAGS@ + +PROGS = cgi_sleep@exe@ + +all: $(PROGS) + +cgi_sleep@exe@: cgi_sleep@obj@ + $(LD) $(CROSSLDFLAGS) -o cgi_sleep cgi_sleep@obj@ @LIBS@ + +cgi_sleep@obj@: cgi_sleep.c + $(CC) -c -o cgi_sleep@obj@ $(CFLAGS) cgi_sleep.c diff --git a/lib/inets/test/httpd_basic_SUITE_data/cgi_sleep.c b/lib/inets/test/httpd_basic_SUITE_data/cgi_sleep.c new file mode 100644 index 0000000000..126bb23987 --- /dev/null +++ b/lib/inets/test/httpd_basic_SUITE_data/cgi_sleep.c @@ -0,0 +1,26 @@ +#include <stdlib.h> +#include <stdio.h> + +#ifdef __WIN32__ +#include <windows.h> +#include <fcntl.h> +#include <io.h> +#else +#include <unistd.h> +#endif + +int main(void) +{ + unsigned int seconds = 10; + +#ifdef __WIN32__ + Sleep(seconds * 1000); + _setmode(_fileno(stdout), _O_BINARY); +#else + sleep(seconds); +#endif + + printf("Content-type: text/plain\r\n\r\n"); + printf("Slept for %u seconds.\r\n", seconds); + exit(EXIT_SUCCESS); +} diff --git a/lib/inets/test/httpd_basic_SUITE_data/printenv.bat b/lib/inets/test/httpd_basic_SUITE_data/printenv.bat new file mode 120000 index 0000000000..1bc8e52059 --- /dev/null +++ b/lib/inets/test/httpd_basic_SUITE_data/printenv.bat @@ -0,0 +1 @@ +../httpd_SUITE_data/server_root/cgi-bin/printenv.bat
\ No newline at end of file diff --git a/lib/inets/test/httpd_basic_SUITE_data/printenv.sh b/lib/inets/test/httpd_basic_SUITE_data/printenv.sh new file mode 120000 index 0000000000..0136a3fa23 --- /dev/null +++ b/lib/inets/test/httpd_basic_SUITE_data/printenv.sh @@ -0,0 +1 @@ +../httpd_SUITE_data/server_root/cgi-bin/printenv.sh
\ No newline at end of file diff --git a/lib/inets/test/httpd_mod.erl b/lib/inets/test/httpd_mod.erl index df4ed6b179..7d3326fb65 100644 --- a/lib/inets/test/httpd_mod.erl +++ b/lib/inets/test/httpd_mod.erl @@ -842,6 +842,14 @@ cgi(Type, Port, Host, Node) -> {version, "HTTP/1.0"}]), %% tsp("cgi -> done"), + + %% Check "ScriptNoCache" directive (default: false) + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET /cgi-bin/" ++ Script ++ + " HTTP/1.0\r\n\r\n", + [{statuscode, 200}, + {no_header, "cache-control"}, + {version, "HTTP/1.0"}]), ok. @@ -899,6 +907,13 @@ esi(Type, Port, Host, Node) -> " HTTP/1.0\r\n\r\n", [{statuscode, 302}, {version, "HTTP/1.0"}]), + %% Check "ErlScriptNoCache" directive (default: false) + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET /cgi-bin/erl/httpd_example:get" + " HTTP/1.0\r\n\r\n", + [{statuscode, 200}, + {no_header, "cache-control"}, + {version, "HTTP/1.0"}]), ok. diff --git a/lib/inets/test/httpd_test_lib.erl b/lib/inets/test/httpd_test_lib.erl index 13584c50f6..3e82324a30 100644 --- a/lib/inets/test/httpd_test_lib.erl +++ b/lib/inets/test/httpd_test_lib.erl @@ -361,7 +361,7 @@ do_validate(Header, [{header, HeaderField, Value}|Rest],N,P) -> tsf({wrong_header_field_value, LowerHeaderField, Header}) end, do_validate(Header, Rest, N, P); -do_validate(Header,[{no_last_modified, HeaderField}|Rest],N,P) -> +do_validate(Header,[{no_header, HeaderField}|Rest],N,P) -> case lists:keysearch(HeaderField,1,Header) of {value,_} -> tsf({wrong_header_field_value, HeaderField, Header}); diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index 3f464c8684..36463d9388 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -18,7 +18,7 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 5.9.5 +INETS_VSN = 5.9.6 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/kernel/doc/src/gen_sctp.xml b/lib/kernel/doc/src/gen_sctp.xml index dacea7a239..dc9e4766a9 100644 --- a/lib/kernel/doc/src/gen_sctp.xml +++ b/lib/kernel/doc/src/gen_sctp.xml @@ -322,7 +322,7 @@ <p> Branch off an existing association <anno>Assoc</anno> in a socket <anno>Socket</anno> of type <c>seqpacket</c> - (one-to-may style) into + (one-to-many style) into a new socket <anno>NewSocket</anno> of type <c>stream</c> (one-to-one style). </p> @@ -496,9 +496,11 @@ orthogonal to the sets of TCP, UDP and generic INET options: only those options which are explicitly listed below are allowed for SCTP sockets. Options can be set on the socket using - <c>gen_sctp:open/1,2</c> or <c>inet:setopts/2</c>, - retrieved using <c>inet:getopts/2</c>, and when calling - <c>gen_sctp:connect/4,5</c> options can be changed.</p> + <seealso marker="#open/1"><c>gen_sctp:open/1,2</c></seealso> + or <seealso marker="inet#setopts/2"><c>inet:setopts/2</c></seealso>, + retrieved using <seealso marker="inet#getopts/2"><c>inet:getopts/2</c></seealso>, + and when calling <seealso marker="#connect/4"><c>gen_sctp:connect/4,5</c></seealso> + options can be changed.</p> <marker id="option-binary"></marker> <marker id="option-list"></marker> <taglist> @@ -507,7 +509,7 @@ <p>Determines the type of data returned from <c>gen_sctp:recv/1,2</c>.</p> <marker id="option-active"></marker> </item> - <tag><c>{active, true|false|once}</c></tag> + <tag><c>{active, true|false|once|N}</c></tag> <item> <list type="bulleted"> <item> @@ -524,11 +526,28 @@ </item> <item> <p>If <c>once</c>, only one message is automatically placed - in the message queue, after that the mode is automatically - re-set to passive. This provides flow control as well as + in the message queue, and after that the mode is automatically + reset to passive. This provides flow control as well as the possibility for the receiver to listen for its incoming SCTP data interleaved with other inter-process messages.</p> </item> + <item> + <p>If <c>active</c> is specified as an integer <c>N</c> in the + range -32768 to 32767 (inclusive), then that number is added to + the socket's count of the number of data messages to be + delivered to the controlling process. If the result of the + addition would be negative, the count is set to 0. Once the + count reaches 0, either through the delivery of messages or by + being explicitly set with <seealso + marker="inet#setopts/2">inet:setopts/2</seealso>, the socket's + mode is automatically reset to passive (<c>{active, + false}</c>) mode. When a socket in this active mode transitions to + passive mode, the message <c>{sctp_passive, Socket}</c> is sent + to the controlling process to notify it that if it wants to + receive more data messages from the socket, it must call + <seealso marker="inet#setopts/2">inet:setopts/2</seealso> to set + the socket back into an active mode.</p> + </item> </list> </item> <tag><c>{tos, integer()}</c></tag> diff --git a/lib/kernel/doc/src/gen_tcp.xml b/lib/kernel/doc/src/gen_tcp.xml index 7afd73f4bf..dbd0d3c815 100644 --- a/lib/kernel/doc/src/gen_tcp.xml +++ b/lib/kernel/doc/src/gen_tcp.xml @@ -148,6 +148,12 @@ do_recv(Sock, Bs) -> as messages:</p> <code type="none"> {tcp, Socket, Data}</code> + <p>If the socket is in <c>{active, N}</c> mode (see <seealso marker="inet#setopts/2"> + inet:setopts/2</seealso> for details) and its message counter + drops to 0, the following message is delivered to indicate that the + socket has transitioned to passive (<c>{active, false}</c>) mode:</p> + <code type="none"> +{tcp_passive, Socket}</code> <p>If the socket is closed, the following message is delivered:</p> <code type="none"> {tcp_closed, Socket}</code> diff --git a/lib/kernel/doc/src/gen_udp.xml b/lib/kernel/doc/src/gen_udp.xml index faca31e928..503725fe18 100644 --- a/lib/kernel/doc/src/gen_udp.xml +++ b/lib/kernel/doc/src/gen_udp.xml @@ -145,14 +145,23 @@ <seealso marker="inet#setopts/2">inet:setopts/2</seealso>.</p> </item> </taglist> - <p>The returned socket <c><anno>Socket</anno></c> is used to send packets - from this port with <c>send/4</c>. When UDP packets arrive at - the opened port, they are delivered as messages:</p> + <p>The returned socket <c><anno>Socket</anno></c> is used to send + packets from this port with <c>send/4</c>. When UDP packets arrive + at the opened port, if the socket is in an active mode the packets + are delivered as messages to the controlling process:</p> <code type="none"> {udp, Socket, IP, InPortNo, Packet}</code> - <p>Note that arriving UDP packets that are longer than + <p>If the socket is not in an active mode, data can be + retrieved via the <seealso marker="#recv/2">recv/2,3</seealso> calls. + Note that arriving UDP packets that are longer than the receive buffer option specifies, might be truncated without warning.</p> + <p>When a socket in <c>{active, N}</c> mode (see <seealso marker="inet#setopts/2"> + inet:setopts/2</seealso> for details) transitions to passive + (<c>{active, false}</c>) mode, the controlling process is notified by a + message of the following form:</p> + <code type="none"> +{udp_passive, Socket}</code> <p><c>IP</c> and <c>InPortNo</c> define the address from which <c>Packet</c> came. <c>Packet</c> is a list of bytes if the option <c>list</c> was specified. <c>Packet</c> is a diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml index 4a3796a15b..fb8bf32978 100644 --- a/lib/kernel/doc/src/inet.xml +++ b/lib/kernel/doc/src/inet.xml @@ -456,47 +456,66 @@ fe80::204:acff:fe17:bf38 <p>Sets one or more options for a socket. The following options are available:</p> <taglist> - <tag><c>{active, true | false | once}</c></tag> + <tag><c>{active, true | false | once | N}</c></tag> <item> <p>If the value is <c>true</c>, which is the default, everything received from the socket will be sent as messages to the receiving process. If the value is <c>false</c> (passive mode), the process must explicitly - receive incoming data by calling <c>gen_tcp:recv/2,3</c> - or <c>gen_udp:recv/2,3</c> (depending on the type of - socket).</p> + receive incoming data by calling + <seealso marker="gen_tcp#recv/2"><c>gen_tcp:recv/2,3</c></seealso>, + <seealso marker="gen_udp#recv/2"><c>gen_udp:recv/2,3</c></seealso> + or <seealso marker="gen_sctp#recv/1"><c>gen_sctp:recv/1,2</c></seealso> + (depending on the type of socket).</p> <p>If the value is <c>once</c> (<c>{active, once}</c>), <em>one</em> data message from the socket will be sent to the process. To receive one more message, <c>setopts/2</c> must be called again with the <c>{active, once}</c> option.</p> - <p>When using <c>{active, once}</c>, the socket changes - behaviour automatically when data is received. This can - sometimes be confusing in combination with connection - oriented sockets (i.e. <c>gen_tcp</c>) as a socket with - <c>{active, false}</c> behaviour reports closing + <p>If the value is an integer <c>N</c> in the range -32768 to 32767 + (inclusive), the value is added to the socket's count of data + messages sent to the controlling process. A socket's default + message count is 0. If a negative value is specified and its + magnitude is equal to or greater than the socket's current + message count, the socket's message count is set to 0. Once + the socket's message count reaches 0, either due to sending + received data messages to the process or by being explicitly set, + the process is then notified by a special message, specific to + the type of socket, that the socket has entered passive + mode. Once the socket enters passive mode, to receive more + messages <c>setopts/2</c> must be called again to set the + socket back into an active mode.</p> + <p>When using <c>{active, once}</c> or <c>{active, N}</c>, the + socket changes behaviour automatically when data is received. + This can sometimes be confusing in combination with + connection-oriented sockets (i.e. <c>gen_tcp</c>) as a socket + with <c>{active, false}</c> behaviour reports closing differently than a socket with <c>{active, true}</c> behaviour. To make programming easier, a socket where the peer closed and this was detected while in <c>{active, false}</c> mode, will still generate the message - <c>{tcp_closed,Socket}</c> when set to <c>{active, once}</c> or <c>{active, true}</c> mode. It is therefore + <c>{tcp_closed,Socket}</c> when set to <c>{active, once}</c>, + <c>{active, true}</c> or <c>{active, N}</c> mode. It is therefore safe to assume that the message <c>{tcp_closed,Socket}</c>, possibly followed by socket port termination (depending on the <c>exit_on_close</c> option) will eventually appear when a socket changes back and forth between <c>{active, true}</c> and - <c>{active, false}</c> mode. However, + <c>{active, false}</c> mode. However, <em>when</em> peer closing is detected is all up to the underlying TCP/IP stack and protocol.</p> - <p>Note that <c>{active,true}</c> mode provides no flow + <p>Note that <c>{active, true}</c> mode provides no flow control; a fast sender could easily overflow the - receiver with incoming messages. Use active mode only if + receiver with incoming messages. The same is true of + <c>{active, N}</c> mode while the message count is greater + than zero. Use active mode only if your high-level protocol provides its own flow control (for instance, acknowledging received messages) or the - amount of data exchanged is small. <c>{active,false}</c> - mode or use of the <c>{active, once}</c> mode provides - flow control; the other side will not be able send + amount of data exchanged is small. <c>{active, false}</c> + mode, use of the <c>{active, once}</c> mode or <c>{active, N}</c> + mode with values of <c>N</c> appropriate for the application + provides flow control; the other side will not be able send faster than the receiver can read.</p> </item> @@ -722,6 +741,59 @@ fe80::204:acff:fe17:bf38 <p>Received <c>Packet</c> is delivered as defined by Mode.</p> </item> + <tag><c>{netns, Namespace :: file:filename_all()}</c></tag> + <item> + <p>Set a network namespace for the socket. The <c>Namespace</c> + parameter is a filename defining the namespace for example + <c>"/var/run/netns/example"</c> typically created by the command + <c>ip netns add example</c>. This option must be used in a + function call that creates a socket i.e + <seealso marker="gen_tcp#connect/3"> + gen_tcp:connect/3,4</seealso>, + <seealso marker="gen_tcp#listen/2"> + gen_tcp:listen/2</seealso>, + <seealso marker="gen_udp#open/1"> + gen_udp:open/1,2</seealso> or + <seealso marker="gen_sctp#open/0"> + gen_sctp:open/0-2</seealso>. + </p> + <p>This option uses the Linux specific syscall + <c>setns()</c> such as in Linux kernel 3.0 or later + and therefore only exists when the runtime system + has been compiled for such an operating system. + </p> + <p> + The virtual machine also needs elevated privileges either + running as superuser or (for Linux) having the capability + <c>CAP_SYS_ADMIN</c> according to the documentation for setns(2). + However, during testing also <c>CAP_SYS_PTRACE</c> + and <c>CAP_DAC_READ_SEARCH</c> has proven to be necessary. + Example:<code> +setcap cap_sys_admin,cap_sys_ptrace,cap_dac_read_search+epi beam.smp +</code> + Note also that the filesystem containing the virtual machine + executable (<c>beam.smp</c> in the example above) has to be local, + mounted without the <c>nosetuid</c> flag, + support extended attributes and that + the kernel has to support file capabilities. + All this runs out of the box on at least Ubuntu 12.04 LTS, + except that SCTP sockets appears to not support + network namespaces. + </p> + <p>The <c>Namespace</c> is a file name and is encoded + and decoded as discussed in + <seealso marker="file">file</seealso> + except that the emulator flag <c>+fnu</c> is ignored and + <seealso marker="#getopts/2">getopts/2</seealso> + for this option will return a binary for the filename + if the stored filename can not be decoded, + which should only happen if you set the option using a binary + that can not be decoded with the emulator's filename encoding: + <seealso marker="file#native_name_encoding/0"> + file:native_name_encoding/0</seealso>. + </p> + </item> + <tag><c>list</c></tag> <item> <p>Received <c>Packet</c> is delivered as a list.</p> diff --git a/lib/kernel/doc/src/notes.xml b/lib/kernel/doc/src/notes.xml index 6b703b7c2b..6cdc3a9d17 100644 --- a/lib/kernel/doc/src/notes.xml +++ b/lib/kernel/doc/src/notes.xml @@ -30,6 +30,66 @@ </header> <p>This document describes the changes made to the Kernel application.</p> +<section><title>Kernel 2.16.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix indentation of User switch command help in Erlang + shell. Thanks to Sylvain Benner.</p> + <p> + Own Id: OTP-11209</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + The previous undocumented function ntoa/1 has been added + to inet docs and exported in the inet module.</p> + <p> + Own Id: OTP-10676 Aux Id: OTP-10314 </p> + </item> + <item> + <p> + Fix typo in abcast() function comment. Thanks to Johannes + Weissl.</p> + <p> + Own Id: OTP-11219</p> + </item> + <item> + <p> + Add application:ensure_all_started/1-2. Thanks to Fred + Hebert.</p> + <p> + Own Id: OTP-11250</p> + </item> + <item> + <p> + Make edlin understand a few important control keys. + Thanks to Stefan Zegenhagen.</p> + <p> + Own Id: OTP-11251</p> + </item> + <item> + <p> + Cleanup of hipe_unified_loader, eliminating uses of + is_subtype/2 in specs, change module-local void functions + to return 'ok' instead of [] and made sure there are no + dialyzer warnings with --Wunmatched_returns. Thanks to + Kostis Sagonas.</p> + <p> + Own Id: OTP-11301</p> + </item> + </list> + </section> + +</section> + <section><title>Kernel 2.16.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/kernel/src/gen_sctp.erl b/lib/kernel/src/gen_sctp.erl index 0d005eb651..23a698f9b2 100644 --- a/lib/kernel/src/gen_sctp.erl +++ b/lib/kernel/src/gen_sctp.erl @@ -36,7 +36,7 @@ -type assoc_id() :: term(). -type option() :: - {active, true | false | once} | + {active, true | false | once | -32768..32767} | {buffer, non_neg_integer()} | {dontroute, boolean()} | {high_msgq_watermark, pos_integer()} | diff --git a/lib/kernel/src/gen_tcp.erl b/lib/kernel/src/gen_tcp.erl index 96026aa428..bc8ffbe5e3 100644 --- a/lib/kernel/src/gen_tcp.erl +++ b/lib/kernel/src/gen_tcp.erl @@ -30,7 +30,7 @@ -include("file.hrl"). -type option() :: - {active, true | false | once} | + {active, true | false | once | -32768..32767} | {buffer, non_neg_integer()} | {delay_send, boolean()} | {deliver, port | term} | diff --git a/lib/kernel/src/gen_udp.erl b/lib/kernel/src/gen_udp.erl index e82b11d2ef..70dceb3679 100644 --- a/lib/kernel/src/gen_udp.erl +++ b/lib/kernel/src/gen_udp.erl @@ -26,7 +26,7 @@ -include("inet_int.hrl"). -type option() :: - {active, true | false | once} | + {active, true | false | once | -32768..32767} | {add_membership, {inet:ip_address(), inet:ip_address()}} | {broadcast, boolean()} | {buffer, non_neg_integer()} | diff --git a/lib/kernel/src/hipe_unified_loader.erl b/lib/kernel/src/hipe_unified_loader.erl index cc51b5ae07..e111cb800e 100644 --- a/lib/kernel/src/hipe_unified_loader.erl +++ b/lib/kernel/src/hipe_unified_loader.erl @@ -85,7 +85,7 @@ chunk_name(Architecture) -> %%======================================================================== -spec load_native_code(Mod, binary()) -> 'no_native' | {'module', Mod} - when is_subtype(Mod, atom()). + when Mod :: atom(). %% @doc %% Loads the native code of a module Mod. %% Returns {module,Mod} on success (for compatibility with @@ -148,8 +148,8 @@ version_check(Version, Mod) when is_atom(Mod) -> %%======================================================================== --spec load_module(Mod, binary(), _) -> 'bad_crc' | {'module',Mod} - when is_subtype(Mod,atom()). +-spec load_module(Mod, binary(), _) -> 'bad_crc' | {'module', Mod} + when Mod :: atom(). load_module(Mod, Bin, Beam) -> erlang:system_flag(multi_scheduling, block), try @@ -169,8 +169,8 @@ load_module(Mod, Bin, Beam, OldReferencesToPatch) -> %%======================================================================== --spec load(Mod, binary()) -> 'bad_crc' | {'module',Mod} - when is_subtype(Mod,atom()). +-spec load(Mod, binary()) -> 'bad_crc' | {'module', Mod} when Mod :: atom(). + load(Mod, Bin) -> erlang:system_flag(multi_scheduling, block), try @@ -204,15 +204,17 @@ load_common(Mod, Bin, Beam, OldReferencesToPatch) -> bad_crc; true -> %% Create data segment - {ConstAddr,ConstMap2} = create_data_segment(ConstAlign, ConstSize, ConstMap), + {ConstAddr,ConstMap2} = + create_data_segment(ConstAlign, ConstSize, ConstMap), %% Find callees for which we may need trampolines. CalleeMFAs = find_callee_mfas(Refs), %% Write the code to memory. - {CodeAddress,Trampolines} = enter_code(CodeSize, CodeBinary, CalleeMFAs, Mod, Beam), + {CodeAddress,Trampolines} = + enter_code(CodeSize, CodeBinary, CalleeMFAs, Mod, Beam), %% Construct CalleeMFA-to-trampoline mapping. TrampolineMap = mk_trampoline_map(CalleeMFAs, Trampolines), %% Patch references to code labels in data seg. - patch_consts(LabelMap, ConstAddr, CodeAddress), + ok = patch_consts(LabelMap, ConstAddr, CodeAddress), %% Find out which functions are being loaded (and where). %% Note: Addresses are sorted descending. {MFAs,Addresses} = exports(ExportMap, CodeAddress), @@ -221,7 +223,7 @@ load_common(Mod, Bin, Beam, OldReferencesToPatch) -> ok = remove_refs_from(MFAs), %% Patch all dynamic references in the code. %% Function calls, Atoms, Constants, System calls - patch(Refs, CodeAddress, ConstMap2, Addresses, TrampolineMap), + ok = patch(Refs, CodeAddress, ConstMap2, Addresses, TrampolineMap), %% Tell the system where the loaded funs are. %% (patches the BEAM code to redirect to native.) case Beam of @@ -324,7 +326,7 @@ trampoline_map_get(MFA, Map) -> gb_trees:get(MFA, Map). trampoline_map_lookup(_, []) -> []; % archs not using trampolines trampoline_map_lookup(Primop, Map) -> case gb_trees:lookup(Primop, Map) of - {value,X} -> X; + {value, X} -> X; _ -> [] end. @@ -371,7 +373,7 @@ offsets_to_addresses(Os, Base) -> find_closure_patches([{Type,Refs} | Rest]) -> case ?EXT2PATCH_TYPE(Type) of load_address -> - find_closure_refs(Refs,Rest); + find_closure_refs(Refs, Rest); _ -> find_closure_patches(Rest) end; @@ -406,16 +408,17 @@ export_funs([FunDef | Addresses]) -> hipe_bifs:set_native_address(MFA, Address, IsClosure), export_funs(Addresses); export_funs([]) -> - true. + ok. export_funs(Mod, Beam, Addresses, ClosuresToPatch) -> - Fs = [{F,A,Address} || #fundef{address=Address, mfa={_M,F,A}} <- Addresses], - code:make_stub_module(Mod, Beam, {Fs,ClosuresToPatch}). + Fs = [{F,A,Address} || #fundef{address=Address, mfa={_M,F,A}} <- Addresses], + Mod = code:make_stub_module(Mod, Beam, {Fs,ClosuresToPatch}), + ok. %%======================================================================== %% Patching %% @spec patch(refs(), BaseAddress::integer(), ConstAndZone::term(), -%% Addresses::term(), TrampolineMap::term()) -> term() +%% Addresses::term(), TrampolineMap::term()) -> 'ok'. %% @type refs()=[{RefType::integer(), Reflist::reflist()} | refs()] %% %% @type reflist()= [{Data::term(), Offsets::offests()}|reflist()] @@ -428,7 +431,7 @@ export_funs(Mod, Beam, Addresses, ClosuresToPatch) -> %% patch([{Type,SortedRefs}|Rest], CodeAddress, ConstMap2, Addresses, TrampolineMap) -> - ?debug_msg("Patching ~w at [~w+offset] with ~w\n", + ?debug_msg("Patching ~w at [~w+offset] with ~w\n", [Type,CodeAddress,SortedRefs]), case ?EXT2PATCH_TYPE(Type) of call_local -> @@ -439,7 +442,7 @@ patch([{Type,SortedRefs}|Rest], CodeAddress, ConstMap2, Addresses, TrampolineMap patch_all(Other, SortedRefs, CodeAddress, {ConstMap2,CodeAddress}, Addresses) end, patch(Rest, CodeAddress, ConstMap2, Addresses, TrampolineMap); -patch([], _, _, _, _) -> true. +patch([], _, _, _, _) -> ok. %%---------------------------------------------------------------- %% Handle a 'call_local' or 'call_remote' patch. @@ -461,14 +464,14 @@ patch_call([{DestMFA,Offsets}|SortedRefs], BaseAddress, Addresses, RemoteOrLocal end, patch_call(SortedRefs, BaseAddress, Addresses, RemoteOrLocal, TrampolineMap); patch_call([], _, _, _, _) -> - true. + ok. patch_bif_call_list([Offset|Offsets], BaseAddress, BifAddress, Trampoline) -> CallAddress = BaseAddress+Offset, ?ASSERT(assert_local_patch(CallAddress)), patch_call_insn(CallAddress, BifAddress, Trampoline), patch_bif_call_list(Offsets, BaseAddress, BifAddress, Trampoline); -patch_bif_call_list([], _, _, _) -> []. +patch_bif_call_list([], _, _, _) -> ok. patch_mfa_call_list([Offset|Offsets], BaseAddress, DestMFA, DestAddress, Addresses, RemoteOrLocal, Trampoline) -> CallAddress = BaseAddress+Offset, @@ -476,7 +479,7 @@ patch_mfa_call_list([Offset|Offsets], BaseAddress, DestMFA, DestAddress, Address ?ASSERT(assert_local_patch(CallAddress)), patch_call_insn(CallAddress, DestAddress, Trampoline), patch_mfa_call_list(Offsets, BaseAddress, DestMFA, DestAddress, Addresses, RemoteOrLocal, Trampoline); -patch_mfa_call_list([], _, _, _, _, _, _) -> []. +patch_mfa_call_list([], _, _, _, _, _, _) -> ok. patch_call_insn(CallAddress, DestAddress, Trampoline) -> %% This assertion is false when we're called from redirect/2. @@ -489,7 +492,7 @@ patch_call_insn(CallAddress, DestAddress, Trampoline) -> patch_all(Type, [{Dest,Offsets}|Rest], BaseAddress, ConstAndZone, Addresses)-> patch_all_offsets(Type, Dest, Offsets, BaseAddress, ConstAndZone, Addresses), patch_all(Type, Rest, BaseAddress, ConstAndZone, Addresses); -patch_all(_, [], _, _, _) -> true. +patch_all(_, [], _, _, _) -> ok. patch_all_offsets(Type, Data, [Offset|Offsets], BaseAddress, ConstAndZone, Addresses) -> @@ -499,7 +502,7 @@ patch_all_offsets(Type, Data, [Offset|Offsets], BaseAddress, patch_offset(Type, Data, Address, ConstAndZone, Addresses), ?debug_msg("Patching done\n",[]), patch_all_offsets(Type, Data, Offsets, BaseAddress, ConstAndZone, Addresses); -patch_all_offsets(_, _, [], _, _, _) -> true. +patch_all_offsets(_, _, [], _, _, _) -> ok. %%---------------------------------------------------------------- %% Handle any patch type except 'call_local' or 'call_remote'. diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl index 7a516c3947..ea06a07bb3 100644 --- a/lib/kernel/src/inet.erl +++ b/lib/kernel/src/inet.erl @@ -120,6 +120,17 @@ 'addr' | 'broadaddr' | 'dstaddr' | 'mtu' | 'netmask' | 'flags' |'hwaddr'. +-type if_getopt_result() :: + {'addr', ip_address()} | + {'broadaddr', ip_address()} | + {'dstaddr', ip_address()} | + {'mtu', non_neg_integer()} | + {'netmask', ip_address()} | + {'flags', ['up' | 'down' | 'broadcast' | 'no_broadcast' | + 'pointtopoint' | 'no_pointtopoint' | + 'running' | 'multicast' | 'loopback']} | + {'hwaddr', ether_address()}. + -type address_family() :: 'inet' | 'inet6'. -type socket_protocol() :: 'tcp' | 'udp' | 'sctp'. -type socket_type() :: 'stream' | 'dgram' | 'seqpacket'. @@ -200,7 +211,14 @@ send(Socket, Packet) -> Options :: [socket_setopt()]. setopts(Socket, Opts) -> - prim_inet:setopts(Socket, Opts). + SocketOpts = + [case Opt of + {netns,NS} -> + {netns,filename2binary(NS)}; + _ -> + Opt + end || Opt <- Opts], + prim_inet:setopts(Socket, SocketOpts). -spec getopts(Socket, Options) -> {'ok', OptionValues} | {'error', posix()} when @@ -209,7 +227,18 @@ setopts(Socket, Opts) -> OptionValues :: [socket_setopt()]. getopts(Socket, Opts) -> - prim_inet:getopts(Socket, Opts). + case prim_inet:getopts(Socket, Opts) of + {ok,OptionValues} -> + {ok, + [case OptionValue of + {netns,Bin} -> + {netns,binary2filename(Bin)}; + _ -> + OptionValue + end || OptionValue <- OptionValues]}; + Other -> + Other + end. -spec getifaddrs(Socket :: socket()) -> {'ok', [string()]} | {'error', posix()}. @@ -248,13 +277,13 @@ getiflist() -> -spec ifget(Socket :: socket(), Name :: string() | atom(), Opts :: [if_getopt()]) -> - {'ok', [if_setopt()]} | {'error', posix()}. + {'ok', [if_getopt_result()]} | {'error', posix()}. ifget(Socket, Name, Opts) -> prim_inet:ifget(Socket, Name, Opts). -spec ifget(Name :: string() | atom(), Opts :: [if_getopt()]) -> - {'ok', [if_setopt()]} | {'error', posix()}. + {'ok', [if_getopt_result()]} | {'error', posix()}. ifget(Name, Opts) -> withsocket(fun(S) -> prim_inet:ifget(S, Name, Opts) end). @@ -641,6 +670,17 @@ con_opt([Opt | Opts], R, As) -> {tcp_module,_} -> con_opt(Opts, R, As); inet -> con_opt(Opts, R, As); inet6 -> con_opt(Opts, R, As); + {netns,NS} -> + BinNS = filename2binary(NS), + case prim_inet:is_sockopt_val(netns, BinNS) of + true -> + con_opt(Opts, R#connect_opts { fd = [{netns,BinNS}] }, As); + false -> + {error, badarg} + end; + {active,N} when is_integer(N), N < 32768, N >= -32768 -> + NOpts = lists:keydelete(active, 1, R#connect_opts.opts), + con_opt(Opts, R#connect_opts { opts = [{active,N}|NOpts] }, As); {Name,Val} when is_atom(Name) -> con_add(Name, Val, R, Opts, As); _ -> {error, badarg} end; @@ -699,6 +739,17 @@ list_opt([Opt | Opts], R, As) -> {tcp_module,_} -> list_opt(Opts, R, As); inet -> list_opt(Opts, R, As); inet6 -> list_opt(Opts, R, As); + {netns,NS} -> + BinNS = filename2binary(NS), + case prim_inet:is_sockopt_val(netns, BinNS) of + true -> + list_opt(Opts, R#listen_opts { fd = [{netns,BinNS}] }, As); + false -> + {error, badarg} + end; + {active,N} when is_integer(N), N < 32768, N >= -32768 -> + NOpts = lists:keydelete(active, 1, R#listen_opts.opts), + list_opt(Opts, R#listen_opts { opts = [{active,N}|NOpts] }, As); {Name,Val} when is_atom(Name) -> list_add(Name, Val, R, Opts, As); _ -> {error, badarg} end; @@ -745,6 +796,17 @@ udp_opt([Opt | Opts], R, As) -> {udp_module,_} -> udp_opt(Opts, R, As); inet -> udp_opt(Opts, R, As); inet6 -> udp_opt(Opts, R, As); + {netns,NS} -> + BinNS = filename2binary(NS), + case prim_inet:is_sockopt_val(netns, BinNS) of + true -> + list_opt(Opts, R#udp_opts { fd = [{netns,BinNS}] }, As); + false -> + {error, badarg} + end; + {active,N} when is_integer(N), N < 32768, N >= -32768 -> + NOpts = lists:keydelete(active, 1, R#udp_opts.opts), + udp_opt(Opts, R#udp_opts { opts = [{active,N}|NOpts] }, As); {Name,Val} when is_atom(Name) -> udp_add(Name, Val, R, Opts, As); _ -> {error, badarg} end; @@ -763,7 +825,7 @@ udp_add(Name, Val, R, Opts, As) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Currently supported options include: % (*) {mode, list|binary} or just list|binary -% (*) {active, true|false|once} +% (*) {active, true|false|once|N} % (*) {sctp_module, inet_sctp|inet6_sctp} or just inet|inet6 % (*) options set via setsockopt. % The full list is below in sctp_options/0 . @@ -814,6 +876,20 @@ sctp_opt([Opt|Opts], Mod, R, As) -> {sctp_module,_} -> sctp_opt (Opts, Mod, R, As); % Done with inet -> sctp_opt (Opts, Mod, R, As); % Done with inet6 -> sctp_opt (Opts, Mod, R, As); % Done with + {netns,NS} -> + BinNS = filename2binary(NS), + case prim_inet:is_sockopt_val(netns, BinNS) of + true -> + sctp_opt( + Opts, Mod, + R#sctp_opts { fd = [{netns,BinNS}] }, + As); + false -> + {error, badarg} + end; + {active,N} when is_integer(N), N < 32768, N >= -32768 -> + NOpts = lists:keydelete(active, 1, R#sctp_opts.opts), + sctp_opt(Opts, Mod, R#sctp_opts { opts = [{active,N}|NOpts] }, As); {Name,Val} -> sctp_opt (Opts, Mod, R, As, Name, Val); _ -> {error,badarg} end; @@ -858,6 +934,39 @@ add_opt(Name, Val, Opts, As) -> end. +%% Passthrough all unknown - catch type errors later +filename2binary(List) when is_list(List) -> + OutEncoding = file:native_name_encoding(), + try unicode:characters_to_binary(List, unicode, OutEncoding) of + Bin when is_binary(Bin) -> + Bin; + _ -> + List + catch + error:badarg -> + List + end; +filename2binary(Bin) -> + Bin. + +binary2filename(Bin) -> + InEncoding = file:native_name_encoding(), + case unicode:characters_to_list(Bin, InEncoding) of + Filename when is_list(Filename) -> + Filename; + _ -> + %% For getopt/setopt of netns this should only happen if + %% a binary with wrong encoding was used when setting the + %% option, hence the user shall eat his/her own medicine. + %% + %% I.e passthrough here too for now. + %% Future usecases will most probably not want this, + %% rather Unicode error or warning + %% depending on emulator flag instead. + Bin + end. + + translate_ip(any, inet) -> {0,0,0,0}; translate_ip(loopback, inet) -> {127,0,0,1}; translate_ip(any, inet6) -> {0,0,0,0,0,0,0,0}; @@ -1070,7 +1179,7 @@ gethostbyaddr_tm_native(Addr, Timer, Opts) -> Result -> Result end. --spec open(Fd :: integer(), +-spec open(Fd_or_OpenOpts :: integer() | list(), Addr :: ip_address(), Port :: port_number(), Opts :: [socket_setopt()], @@ -1080,8 +1189,14 @@ gethostbyaddr_tm_native(Addr, Timer, Opts) -> Module :: atom()) -> {'ok', socket()} | {'error', posix()}. -open(Fd, Addr, Port, Opts, Protocol, Family, Type, Module) when Fd < 0 -> - case prim_inet:open(Protocol, Family, Type) of +open(FdO, Addr, Port, Opts, Protocol, Family, Type, Module) + when is_integer(FdO), FdO < 0; + is_list(FdO) -> + OpenOpts = + if is_list(FdO) -> FdO; + true -> [] + end, + case prim_inet:open(Protocol, Family, Type, OpenOpts) of {ok,S} -> case prim_inet:setopts(S, Opts) of ok -> @@ -1104,7 +1219,8 @@ open(Fd, Addr, Port, Opts, Protocol, Family, Type, Module) when Fd < 0 -> Error -> Error end; -open(Fd, _Addr, _Port, Opts, Protocol, Family, Type, Module) -> +open(Fd, _Addr, _Port, Opts, Protocol, Family, Type, Module) + when is_integer(Fd) -> fdopen(Fd, Opts, Protocol, Family, Type, Module). bindx(S, [Addr], Port0) -> diff --git a/lib/kernel/src/inet_int.hrl b/lib/kernel/src/inet_int.hrl index 67a99913a1..024a5fd3b6 100644 --- a/lib/kernel/src/inet_int.hrl +++ b/lib/kernel/src/inet_int.hrl @@ -46,6 +46,7 @@ -define(INET_PASSIVE, 0). -define(INET_ACTIVE, 1). -define(INET_ONCE, 2). % Active once then passive +-define(INET_MULTI, 3). % Active N then passive %% state codes (getstatus, INET_REQ_GETSTATUS) -define(INET_F_OPEN, 16#0001). @@ -143,6 +144,7 @@ -define(INET_LOPT_TCP_SEND_TIMEOUT_CLOSE, 35). -define(INET_LOPT_MSGQ_HIWTRMRK, 36). -define(INET_LOPT_MSGQ_LOWTRMRK, 37). +-define(INET_LOPT_NETNS, 38). % Specific SCTP options: separate range: -define(SCTP_OPT_RTOINFO, 100). -define(SCTP_OPT_ASSOCINFO, 101). diff --git a/lib/kernel/test/gen_sctp_SUITE.erl b/lib/kernel/test/gen_sctp_SUITE.erl index e89cb44797..6dad52395b 100644 --- a/lib/kernel/test/gen_sctp_SUITE.erl +++ b/lib/kernel/test/gen_sctp_SUITE.erl @@ -35,8 +35,9 @@ open_unihoming_ipv6_socket/1, open_multihoming_ipv6_socket/1, open_multihoming_ipv4_and_ipv6_socket/1, - basic_stream/1, xfer_stream_min/1, peeloff_active_once/1, - peeloff_active_true/1, buffers/1]). + basic_stream/1, xfer_stream_min/1, active_n/1, + peeloff_active_once/1, peeloff_active_true/1, peeloff_active_n/1, + buffers/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -46,9 +47,9 @@ all() -> open_multihoming_ipv4_socket, open_unihoming_ipv6_socket, open_multihoming_ipv6_socket, - open_multihoming_ipv4_and_ipv6_socket, + open_multihoming_ipv4_and_ipv6_socket, active_n, basic_stream, xfer_stream_min, peeloff_active_once, - peeloff_active_true, buffers]. + peeloff_active_true, peeloff_active_n, buffers]. groups() -> []. @@ -767,6 +768,106 @@ implicit_inet6(S1, Addr) -> end, ?line ok = gen_sctp:close(S2). +active_n(doc) -> + "Verify {active,N} socket management"; +active_n(suite) -> + []; +active_n(Config) when is_list(Config) -> + N = 3, + S1 = ok(gen_sctp:open([{active,N}])), + [{active,N}] = ok(inet:getopts(S1, [active])), + ok = inet:setopts(S1, [{active,-N}]), + receive + {sctp_passive, S1} -> ok + after + 5000 -> + exit({error,sctp_passive_failure}) + end, + [{active,false}] = ok(inet:getopts(S1, [active])), + ok = inet:setopts(S1, [{active,0}]), + receive + {sctp_passive, S1} -> ok + after + 5000 -> + exit({error,sctp_passive_failure}) + end, + ok = inet:setopts(S1, [{active,32767}]), + {error,einval} = inet:setopts(S1, [{active,1}]), + {error,einval} = inet:setopts(S1, [{active,-32769}]), + ok = inet:setopts(S1, [{active,-32768}]), + receive + {sctp_passive, S1} -> ok + after + 5000 -> + exit({error,sctp_passive_failure}) + end, + [{active,false}] = ok(inet:getopts(S1, [active])), + ok = inet:setopts(S1, [{active,N}]), + ok = inet:setopts(S1, [{active,true}]), + [{active,true}] = ok(inet:getopts(S1, [active])), + receive + _ -> exit({error,active_n}) + after + 0 -> + ok + end, + ok = inet:setopts(S1, [{active,N}]), + ok = inet:setopts(S1, [{active,once}]), + [{active,once}] = ok(inet:getopts(S1, [active])), + receive + _ -> exit({error,active_n}) + after + 0 -> + ok + end, + {error,einval} = inet:setopts(S1, [{active,32768}]), + ok = inet:setopts(S1, [{active,false}]), + [{active,false}] = ok(inet:getopts(S1, [active])), + ok = gen_sctp:listen(S1, true), + S1Port = ok(inet:port(S1)), + S2 = ok(gen_sctp:open(0, [{active,false}])), + Assoc = ok(gen_sctp:connect(S2, "localhost", S1Port, [])), + ok = inet:setopts(S1, [{active,N}]), + [{active,N}] = ok(inet:getopts(S1, [active])), + LoopFun = fun(Count, Count, _Fn) -> + receive + {sctp_passive,S1} -> + ok + after + 5000 -> + exit({error,timeout}) + end; + (I, Count, Fn) -> + Msg = list_to_binary("message "++integer_to_list(I)), + ok = gen_sctp:send(S2, Assoc, 0, Msg), + receive + {sctp,S1,_,_,{[SR],Msg}} when is_record(SR, sctp_sndrcvinfo) -> + Fn(I+1, Count, Fn); + {sctp,S1,_,_,_} -> + %% ignore non-data messages + ok = inet:setopts(S1, [{active,1}]), + Fn(I, Count, Fn); + Other -> + exit({unexpected, Other}) + after + 5000 -> + exit({error,timeout}) + end + end, + ok = LoopFun(1, N, LoopFun), + S3 = ok(gen_sctp:open([{active,0}])), + receive + {sctp_passive,S3} -> + [{active,false}] = ok(inet:getopts(S3, [active])) + after + 5000 -> + exit({error,udp_passive}) + end, + ok = gen_sctp:close(S3), + ok = gen_sctp:close(S2), + ok = gen_sctp:close(S1), + ok. + basic_stream(doc) -> "Hello world stream socket"; basic_stream(suite) -> @@ -941,6 +1042,14 @@ peeloff_active_true(suite) -> peeloff_active_true(Config) -> peeloff(Config, [{active,true}]). +peeloff_active_n(doc) -> + "Peel off an SCTP stream socket ({active,N})"; +peeloff_active_n(suite) -> + []; + +peeloff_active_n(Config) -> + peeloff(Config, [{active,1}]). + peeloff(Config, SockOpts) when is_list(Config) -> ?line Addr = {127,0,0,1}, ?line Stream = 0, @@ -1519,7 +1628,13 @@ s_loop(Socket, Timeout, Parent, Handler, State) -> end. again(Socket) -> - inet:setopts(Socket, [{active,once}]). + receive + {sctp_passive,Socket} -> + [{active, false}] = ok(inet:getopts(Socket, [active])), + ok = inet:setopts(Socket,[{active,1}]) + after 0 -> + ok = inet:setopts(Socket, [{active,once}]) + end. gb_push(Key, Val, GBT) -> case gb_trees:lookup(Key, GBT) of diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl index ee271fbdfa..ee8bfcceb1 100644 --- a/lib/kernel/test/gen_tcp_misc_SUITE.erl +++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl @@ -25,7 +25,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, controlling_process/1, controlling_process_self/1, - no_accept/1, close_with_pending_output/1, + no_accept/1, close_with_pending_output/1, active_n/1, data_before_close/1, iter_max_socks/1, get_status/1, passive_sockets/1, accept_closed_by_other_process/1, init_per_testcase/2, end_per_testcase/2, @@ -70,7 +70,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [controlling_process, controlling_process_self, no_accept, close_with_pending_output, data_before_close, - iter_max_socks, passive_sockets, + iter_max_socks, passive_sockets, active_n, accept_closed_by_other_process, otp_3924, closed_socket, shutdown_active, shutdown_passive, shutdown_pending, default_options, http_bad_packet, busy_send, @@ -407,6 +407,114 @@ send_loop(Sock, Data, Left) -> ok = gen_tcp:send(Sock, Data), send_loop(Sock, Data, Left-1). +%% Test {active,N} option +active_n(doc) -> + ["Verify operation of the {active,N} option."]; +active_n(suite) -> []; +active_n(Config) when is_list(Config) -> + N = 3, + LS = ok(gen_tcp:listen(0, [{active,N}])), + [{active,N}] = ok(inet:getopts(LS, [active])), + ok = inet:setopts(LS, [{active,-N}]), + receive + {tcp_passive, LS} -> ok + after + 5000 -> + exit({error,tcp_passive_failure}) + end, + [{active,false}] = ok(inet:getopts(LS, [active])), + ok = inet:setopts(LS, [{active,0}]), + receive + {tcp_passive, LS} -> ok + after + 5000 -> + exit({error,tcp_passive_failure}) + end, + ok = inet:setopts(LS, [{active,32767}]), + {error,einval} = inet:setopts(LS, [{active,1}]), + {error,einval} = inet:setopts(LS, [{active,-32769}]), + ok = inet:setopts(LS, [{active,-32768}]), + receive + {tcp_passive, LS} -> ok + after + 5000 -> + exit({error,tcp_passive_failure}) + end, + [{active,false}] = ok(inet:getopts(LS, [active])), + ok = inet:setopts(LS, [{active,N}]), + ok = inet:setopts(LS, [{active,true}]), + [{active,true}] = ok(inet:getopts(LS, [active])), + receive + _ -> exit({error,active_n}) + after + 0 -> + ok + end, + ok = inet:setopts(LS, [{active,N}]), + ok = inet:setopts(LS, [{active,once}]), + [{active,once}] = ok(inet:getopts(LS, [active])), + receive + _ -> exit({error,active_n}) + after + 0 -> + ok + end, + {error,einval} = inet:setopts(LS, [{active,32768}]), + ok = inet:setopts(LS, [{active,false}]), + [{active,false}] = ok(inet:getopts(LS, [active])), + Port = ok(inet:port(LS)), + C = ok(gen_tcp:connect("localhost", Port, [{active,N}])), + [{active,N}] = ok(inet:getopts(C, [active])), + S = ok(gen_tcp:accept(LS)), + ok = inet:setopts(S, [{active,N}]), + [{active,N}] = ok(inet:getopts(S, [active])), + repeat(3, + fun(I) -> + Msg = "message "++integer_to_list(I), + ok = gen_tcp:send(C, Msg), + receive + {tcp,S,Msg} -> + ok = gen_tcp:send(S, Msg) + after + 5000 -> + exit({error,timeout}) + end, + receive + {tcp,C,Msg} -> + ok + after + 5000 -> + exit({error,timeout}) + end + end), + receive + {tcp_passive,S} -> + [{active,false}] = ok(inet:getopts(S, [active])) + after + 5000 -> + exit({error,tcp_passive}) + end, + receive + {tcp_passive,C} -> + [{active,false}] = ok(inet:getopts(C, [active])) + after + 5000 -> + exit({error,tcp_passive}) + end, + LS2 = ok(gen_tcp:listen(0, [{active,0}])), + receive + {tcp_passive,LS2} -> + [{active,false}] = ok(inet:getopts(LS2, [active])) + after + 5000 -> + exit({error,tcp_passive}) + end, + ok = gen_tcp:close(LS2), + ok = gen_tcp:close(C), + ok = gen_tcp:close(S), + ok = gen_tcp:close(LS), + ok. + -define(OTP_3924_MAX_DELAY, 100). %% Taken out of the blue, but on intra host connections %% I expect propagation of a close to be quite fast @@ -2659,3 +2767,5 @@ oct_aloop(S,X,Times) -> gen_tcp:close(S), closed end. + +ok({ok,V}) -> V. diff --git a/lib/kernel/test/gen_udp_SUITE.erl b/lib/kernel/test/gen_udp_SUITE.erl index 4cc6018614..6bb41999c5 100644 --- a/lib/kernel/test/gen_udp_SUITE.erl +++ b/lib/kernel/test/gen_udp_SUITE.erl @@ -33,7 +33,7 @@ init_per_group/2,end_per_group/2]). -export([init_per_testcase/2, end_per_testcase/2]). --export([send_to_closed/1, +-export([send_to_closed/1, active_n/1, buffer_size/1, binary_passive_recv/1, bad_address/1, read_packets/1, open_fd/1, connect/1, implicit_inet6/1]). @@ -42,7 +42,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [send_to_closed, buffer_size, binary_passive_recv, bad_address, read_packets, open_fd, connect, - implicit_inet6]. + implicit_inet6, active_n]. groups() -> []. @@ -465,6 +465,108 @@ open_fd(Config) when is_list(Config) -> ?t:fail(io_lib:format("~w", [flush()])) end. +active_n(Config) when is_list(Config) -> + N = 3, + S1 = ok(gen_udp:open(0, [{active,N}])), + [{active,N}] = ok(inet:getopts(S1, [active])), + ok = inet:setopts(S1, [{active,-N}]), + receive + {udp_passive, S1} -> ok + after + 5000 -> + exit({error,udp_passive_failure}) + end, + [{active,false}] = ok(inet:getopts(S1, [active])), + ok = inet:setopts(S1, [{active,0}]), + receive + {udp_passive, S1} -> ok + after + 5000 -> + exit({error,udp_passive_failure}) + end, + ok = inet:setopts(S1, [{active,32767}]), + {error,einval} = inet:setopts(S1, [{active,1}]), + {error,einval} = inet:setopts(S1, [{active,-32769}]), + ok = inet:setopts(S1, [{active,-32768}]), + receive + {udp_passive, S1} -> ok + after + 5000 -> + exit({error,udp_passive_failure}) + end, + [{active,false}] = ok(inet:getopts(S1, [active])), + ok = inet:setopts(S1, [{active,N}]), + ok = inet:setopts(S1, [{active,true}]), + [{active,true}] = ok(inet:getopts(S1, [active])), + receive + _ -> exit({error,active_n}) + after + 0 -> + ok + end, + ok = inet:setopts(S1, [{active,N}]), + ok = inet:setopts(S1, [{active,once}]), + [{active,once}] = ok(inet:getopts(S1, [active])), + receive + _ -> exit({error,active_n}) + after + 0 -> + ok + end, + {error,einval} = inet:setopts(S1, [{active,32768}]), + ok = inet:setopts(S1, [{active,false}]), + [{active,false}] = ok(inet:getopts(S1, [active])), + S1Port = ok(inet:port(S1)), + S2 = ok(gen_udp:open(0, [{active,N}])), + S2Port = ok(inet:port(S2)), + [{active,N}] = ok(inet:getopts(S2, [active])), + ok = inet:setopts(S1, [{active,N}]), + [{active,N}] = ok(inet:getopts(S1, [active])), + lists:foreach( + fun(I) -> + Msg = "message "++integer_to_list(I), + ok = gen_udp:send(S2, "localhost", S1Port, Msg), + receive + {udp,S1,_,S2Port,Msg} -> + ok = gen_udp:send(S1, "localhost", S2Port, Msg) + after + 5000 -> + exit({error,timeout}) + end, + receive + {udp,S2,_,S1Port,Msg} -> + ok + after + 5000 -> + exit({error,timeout}) + end + end, lists:seq(1,N)), + receive + {udp_passive,S1} -> + [{active,false}] = ok(inet:getopts(S1, [active])) + after + 5000 -> + exit({error,udp_passive}) + end, + receive + {udp_passive,S2} -> + [{active,false}] = ok(inet:getopts(S2, [active])) + after + 5000 -> + exit({error,udp_passive}) + end, + S3 = ok(gen_udp:open(0, [{active,0}])), + receive + {udp_passive,S3} -> + [{active,false}] = ok(inet:getopts(S3, [active])) + after + 5000 -> + exit({error,udp_passive}) + end, + ok = gen_udp:close(S3), + ok = gen_udp:close(S2), + ok = gen_udp:close(S1), + ok. % % Utils diff --git a/lib/kernel/test/inet_SUITE.erl b/lib/kernel/test/inet_SUITE.erl index 46c8c0b88b..ed43749cc0 100644 --- a/lib/kernel/test/inet_SUITE.erl +++ b/lib/kernel/test/inet_SUITE.erl @@ -38,10 +38,10 @@ gethostnative_debug_level/0, gethostnative_debug_level/1, getif/1, getif_ifr_name_overflow/1,getservbyname_overflow/1, getifaddrs/1, - parse_strict_address/1]). + parse_strict_address/1, simple_netns/1]). -export([get_hosts/1, get_ipv6_hosts/1, parse_hosts/1, parse_address/1, - kill_gethost/0, parallell_gethost/0]). + kill_gethost/0, parallell_gethost/0, test_netns/0]). -export([init_per_testcase/2, end_per_testcase/2]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -53,7 +53,7 @@ all() -> t_gethostnative, gethostnative_parallell, cname_loop, gethostnative_debug_level, gethostnative_soft_restart, getif, getif_ifr_name_overflow, getservbyname_overflow, - getifaddrs, parse_strict_address]. + getifaddrs, parse_strict_address, simple_netns]. groups() -> [{parse, [], [parse_hosts, parse_address]}]. @@ -1099,3 +1099,96 @@ toupper([C|Cs]) when is_integer(C) -> end; toupper([]) -> []. + + +simple_netns(Config) when is_list(Config) -> + {ok,U} = gen_udp:open(0), + case inet:setopts(U, [{netns,""}]) of + ok -> + jog_netns_opt(U), + ok = gen_udp:close(U), + %% + {ok,L} = gen_tcp:listen(0, []), + jog_netns_opt(L), + ok = gen_tcp:close(L), + %% + {ok,S} = gen_sctp:open(), + jog_netns_opt(S), + ok = gen_sctp:close(S); + {error,einval} -> + {skip,"setns() not supported"} + end. + +jog_netns_opt(S) -> + %% This is just jogging the option mechanics + ok = inet:setopts(S, [{netns,""}]), + {ok,[{netns,""}]} = inet:getopts(S, [netns]), + ok = inet:setopts(S, [{netns,"/proc/self/ns/net"}]), + {ok,[{netns,"/proc/self/ns/net"}]} = inet:getopts(S, [netns]), + ok. + + +%% Manual test to be run outside test_server in an emulator +%% started by root, in a machine with setns() support... +test_netns() -> + DefaultIF = v1, + DefaultIP = {192,168,1,17}, + Namespace = "test", + NamespaceIF = v2, + NamespaceIP = {192,168,1,18}, + %% + DefaultIPString = inet_parse:ntoa(DefaultIP), + NamespaceIPString = inet_parse:ntoa(NamespaceIP), + cmd("ip netns add ~s", + [Namespace]), + cmd("ip link add name ~w type veth peer name ~w netns ~s", + [DefaultIF,NamespaceIF,Namespace]), + cmd("ip netns exec ~s ip addr add ~s/30 dev ~w", + [Namespace,NamespaceIPString,NamespaceIF]), + cmd("ip netns exec ~s ip link set ~w up", + [Namespace,NamespaceIF]), + cmd("ip addr add ~s/30 dev ~w", + [DefaultIPString,DefaultIF]), + cmd("ip link set ~w up", + [DefaultIF]), + try test_netns( + {DefaultIF,DefaultIP}, + filename:join("/var/run/netns/", Namespace), + {NamespaceIF,NamespaceIP}) of + Result -> + io:put_chars(["#### Test done",io_lib:nl()]), + Result + after + cmd("ip link delete ~w type veth", + [DefaultIF]), + cmd("ip netns delete ~s", + [Namespace]) + end. + +test_netns({DefaultIF,DefaultIP}, Namespace, {NamespaceIF,NamespaceIP}) -> + {ok,ListenSocket} = gen_tcp:listen(0, [{active,false}]), + {ok,[{addr,DefaultIP}]} = inet:ifget(ListenSocket, DefaultIF, [addr]), + {ok,ListenPort} = inet:port(ListenSocket), + {ok,ConnectSocket} = + gen_tcp:connect( + DefaultIP, ListenPort, [{active,false},{netns,Namespace}], 3000), + {ok,[{addr,NamespaceIP}]} = inet:ifget(ConnectSocket, NamespaceIF, [addr]), + {ok,ConnectPort} = inet:port(ConnectSocket), + {ok,AcceptSocket} = gen_tcp:accept(ListenSocket, 0), + {ok,AcceptPort} = inet:port(AcceptSocket), + {ok,{NamespaceIP,ConnectPort}} = inet:peername(AcceptSocket), + {ok,{DefaultIP,AcceptPort}} = inet:peername(ConnectSocket), + ok = gen_tcp:send(ConnectSocket, "data"), + ok = gen_tcp:close(ConnectSocket), + {ok,"data"} = gen_tcp:recv(AcceptSocket, 4, 1000), + {error,closed} = gen_tcp:recv(AcceptSocket, 1, 1000), + ok = gen_tcp:close(AcceptSocket), + ok = gen_tcp:close(ListenSocket). + +cmd(Cmd, Args) -> + cmd(io_lib:format(Cmd, Args)). +%% +cmd(CmdString) -> + io:put_chars(["# ",CmdString,io_lib:nl()]), + io:put_chars([os:cmd(CmdString++" ; echo ' =>' $?")]), + ok. diff --git a/lib/megaco/doc/src/notes.xml b/lib/megaco/doc/src/notes.xml index 50b2661c57..a1039cbda0 100644 --- a/lib/megaco/doc/src/notes.xml +++ b/lib/megaco/doc/src/notes.xml @@ -36,7 +36,23 @@ section is the version number of Megaco.</p> - <section><title>Megaco 3.17.0.1</title> + <section><title>Megaco 3.17.0.2</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Introduced functionality for inspection of system and + build configuration.</p> + <p> + Own Id: OTP-11196</p> + </item> + </list> + </section> + +</section> + +<section><title>Megaco 3.17.0.1</title> <section><title>Improvements and New Features</title> <list> diff --git a/lib/megaco/src/app/megaco.appup.src b/lib/megaco/src/app/megaco.appup.src index b3659366a4..da171e0c18 100644 --- a/lib/megaco/src/app/megaco.appup.src +++ b/lib/megaco/src/app/megaco.appup.src @@ -170,6 +170,8 @@ {"%VSN%", [ + {"3.17.0.1", []}, + {"3.17", []}, {"3.16.0.3", [ {update, megaco_flex_scanner_handler, {advanced, upgrade_from_pre_3_17}, @@ -178,6 +180,8 @@ } ], [ + {"3.17.0.1", []}, + {"3.17", []}, {"3.16.0.3", [ {update, megaco_flex_scanner_handler, {advanced, downgrade_to_pre_3_17}, diff --git a/lib/megaco/vsn.mk b/lib/megaco/vsn.mk index db956102a6..ea4e9f2eb8 100644 --- a/lib/megaco/vsn.mk +++ b/lib/megaco/vsn.mk @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = megaco -MEGACO_VSN = 3.17.0.1 +MEGACO_VSN = 3.17.0.2 PRE_VSN = APP_VSN = "$(APPLICATION)-$(MEGACO_VSN)$(PRE_VSN)" diff --git a/lib/mnesia/doc/src/notes.xml b/lib/mnesia/doc/src/notes.xml index 99a26dd281..da66a647f5 100644 --- a/lib/mnesia/doc/src/notes.xml +++ b/lib/mnesia/doc/src/notes.xml @@ -38,7 +38,36 @@ thus constitutes one section in this document. The title of each section is the version number of Mnesia.</p> - <section><title>Mnesia 4.9</title> + <section><title>Mnesia 4.10</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix timing issues in checkpoint creation.</p> + <p> + Own Id: OTP-10957</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Fixed a problem where the fallback BUP file is removed + when calling mnesia:uninstall_fallback and mnesia is not + started.</p> + <p> + Own Id: OTP-11241</p> + </item> + </list> + </section> + +</section> + +<section><title>Mnesia 4.9</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/mnesia/vsn.mk b/lib/mnesia/vsn.mk index d7a132bc1a..c8187013be 100644 --- a/lib/mnesia/vsn.mk +++ b/lib/mnesia/vsn.mk @@ -1 +1 @@ -MNESIA_VSN = 4.9 +MNESIA_VSN = 4.10 diff --git a/lib/observer/doc/src/notes.xml b/lib/observer/doc/src/notes.xml index 998a4e4f9f..8a7a5cc41b 100644 --- a/lib/observer/doc/src/notes.xml +++ b/lib/observer/doc/src/notes.xml @@ -31,6 +31,23 @@ <p>This document describes the changes made to the Observer application.</p> +<section><title>Observer 1.3.1.1</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + The encoding of the <c>notes.xml</c> file has been + changed from latin1 to utf-8 to avoid future merge + problems.</p> + <p> + Own Id: OTP-11310</p> + </item> + </list> + </section> + +</section> + <section><title>Observer 1.3.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/observer/doc/src/ttb.xml b/lib/observer/doc/src/ttb.xml index b48febc2a9..6e60a9cb3b 100644 --- a/lib/observer/doc/src/ttb.xml +++ b/lib/observer/doc/src/ttb.xml @@ -105,8 +105,9 @@ ttb:p(all, call)</code> <v>Nodes = atom() | [atom()] | all | existing | new</v> <v>Opts = Opt | [Opt]</v> <v>Opt = {file,Client} | {handler, FormatHandler} | {process_info,PI} | - shell | {shell, ShellSpec} | {timer, TimerSpec} | {overload, {MSec, Module, Function}} - | {flush, MSec} | resume | {resume, FetchTimeout}</v> + shell | {shell, ShellSpec} | {timer, TimerSpec} | + {overload_check, {MSec, Module, Function}} | + {flush, MSec} | resume | {resume, FetchTimeout}</v> <v>TimerSpec = MSec | {MSec, StopOpts}</v> <v>MSec = FetchTimeout = integer()</v> <v>Module = Function = atom() </v> @@ -158,7 +159,7 @@ ttb:p(all, call)</code> network communication are always present. The timer starts after <c>ttb:p/2</c> is issued, so you can set up your trace patterns before. </p> - <p>The <c>overload</c> option allows to enable overload + <p>The <c>overload_check</c> option allows to enable overload checking on the nodes under trace. <c>Module:Function(check)</c> is performed each <c>MSec</c> milliseconds. If the check returns <c>true</c>, the tracing is disabled on a given node.<br/> diff --git a/lib/observer/vsn.mk b/lib/observer/vsn.mk index 96d9d885da..e933f7480c 100644 --- a/lib/observer/vsn.mk +++ b/lib/observer/vsn.mk @@ -1 +1 @@ -OBSERVER_VSN = 1.3.1 +OBSERVER_VSN = 1.3.1.1 diff --git a/lib/odbc/doc/src/notes.xml b/lib/odbc/doc/src/notes.xml index a1c6f999e0..13dff1489f 100644 --- a/lib/odbc/doc/src/notes.xml +++ b/lib/odbc/doc/src/notes.xml @@ -31,7 +31,44 @@ <p>This document describes the changes made to the odbc application. </p> - <section><title>ODBC 2.10.16</title> + <section><title>ODBC 2.10.17</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The format of the xml source for documentation is + corrected in order to conform to the DTDs and to pass + xmllint without errors.</p> + <p> + Own Id: OTP-11193</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Introduced functionality for inspection of system and + build configuration.</p> + <p> + Own Id: OTP-11196</p> + </item> + <item> + <p> + Prevent odbcserver crash if it's executed and supplied + incorrect data to stdin. Thanks to Sergei Golovan.</p> + <p> + Own Id: OTP-11233</p> + </item> + </list> + </section> + +</section> + +<section><title>ODBC 2.10.16</title> <section><title>Improvements and New Features</title> <list> diff --git a/lib/odbc/doc/src/odbc.xml b/lib/odbc/doc/src/odbc.xml index 0e9505390b..99b9bbbe88 100644 --- a/lib/odbc/doc/src/odbc.xml +++ b/lib/odbc/doc/src/odbc.xml @@ -213,12 +213,13 @@ Note that this information is probably of little use when writing database-independent code, but can be of assistance in providing more sophisticated error handling when dealing with a known underlying database. + </p> <list type="bulleted"> <item><c>ODBCErrorCode</c> is the ODBC error string returned by the ODBC driver.</item> <item><c>NativeErrorCode</c> is the numberic error code returned by the underlying database. The possible values and their meanings are dependent on the database being used.</item> <item><c>Reason</c> is as per the <c>Reason</c> field when extended errors are not enabled.</item> - </list></p> + </list> </desc> </func> <func> diff --git a/lib/odbc/test/odbc_connect_SUITE.erl b/lib/odbc/test/odbc_connect_SUITE.erl index 74ae2c96e6..2a16388929 100644 --- a/lib/odbc/test/odbc_connect_SUITE.erl +++ b/lib/odbc/test/odbc_connect_SUITE.erl @@ -77,6 +77,8 @@ end_per_group(_GroupName, Config) -> %% variable, but should NOT alter/remove any existing entries. %%-------------------------------------------------------------------- init_per_suite(Config) when is_list(Config) -> + file:write_file(filename:join([proplists:get_value(priv_dir,Config), + "..","..","..","ignore_core_files"]),""), case odbc_test_lib:skip() of true -> {skip, "ODBC not supported"}; diff --git a/lib/odbc/vsn.mk b/lib/odbc/vsn.mk index 98a9f4ab4a..34c3eff933 100644 --- a/lib/odbc/vsn.mk +++ b/lib/odbc/vsn.mk @@ -1 +1 @@ -ODBC_VSN = 2.10.16 +ODBC_VSN = 2.10.17 diff --git a/lib/orber/test/multi_ORB_SUITE.erl b/lib/orber/test/multi_ORB_SUITE.erl index 3c1ffd59d3..41a309ff16 100644 --- a/lib/orber/test/multi_ORB_SUITE.erl +++ b/lib/orber/test/multi_ORB_SUITE.erl @@ -75,8 +75,6 @@ close_connections_local_interface_ctx_override_api/1, ssl_1_multi_orber_generation_3_api/1, ssl_2_multi_orber_generation_3_api/1, ssl_reconfigure_generation_3_api/1, - ssl_1_multi_orber_generation_3_api_old/1, ssl_2_multi_orber_generation_3_api_old/1, - ssl_reconfigure_generation_3_api_old/1, close_connections_alt_iiop_addr_api/1, close_connections_multiple_profiles_api/1]). @@ -137,13 +135,10 @@ cases() -> setup_multi_connection_timeout_attempts_api, setup_multi_connection_timeout_random_api, ssl_1_multi_orber_api, - ssl_1_multi_orber_generation_3_api_old, ssl_1_multi_orber_generation_3_api, ssl_2_multi_orber_api, - ssl_2_multi_orber_generation_3_api_old, ssl_2_multi_orber_generation_3_api, ssl_reconfigure_api, - ssl_reconfigure_generation_3_api_old, ssl_reconfigure_generation_3_api]. %%----------------------------------------------------------------- @@ -155,10 +150,7 @@ init_per_testcase(TC,Config) TC =:= ssl_reconfigure_api -> init_ssl(Config); init_per_testcase(TC,Config) - when TC =:= ssl_1_multi_orber_generation_3_api_old; - TC =:= ssl_2_multi_orber_generation_3_api_old; - TC =:= ssl_reconfigure_generation_3_api_old; - TC =:= ssl_1_multi_orber_generation_3_api; + when TC =:= ssl_1_multi_orber_generation_3_api; TC =:= ssl_2_multi_orber_generation_3_api; TC =:= ssl_reconfigure_generation_3_api -> init_ssl_3(Config); @@ -1632,22 +1624,6 @@ ssl_1_multi_orber_api(_Config) -> ssl_suite(ServerOptions, ClientOptions). -ssl_1_multi_orber_generation_3_api_old(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)", - "This case set up two secure orbs and test if they can", - "communicate. The case also test to access one of the", - "secure orbs which must raise a NO_PERMISSION exception."]; -ssl_1_multi_orber_generation_3_api_old(suite) -> []; -ssl_1_multi_orber_generation_3_api_old(_Config) -> - - ServerOptions = orber_test_lib:get_options_old(iiop_ssl, server, - 1, [{ssl_generation, 3}, - {iiop_ssl_port, 0}]), - ClientOptions = orber_test_lib:get_options_old(iiop_ssl, client, - 1, [{ssl_generation, 3}, - {iiop_ssl_port, 0}]), - ssl_suite(ServerOptions, ClientOptions). - - ssl_1_multi_orber_generation_3_api(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)", "This case set up two secure orbs and test if they can", "communicate. The case also test to access one of the", @@ -1681,22 +1657,6 @@ ssl_2_multi_orber_api(_Config) -> ssl_suite(ServerOptions, ClientOptions). -ssl_2_multi_orber_generation_3_api_old(doc) -> ["SECURE MULTI ORB API tests (SSL depth 2)", - "This case set up two secure orbs and test if they can", - "communicate. The case also test to access one of the", - "secure orbs which must raise a NO_PERMISSION exception."]; -ssl_2_multi_orber_generation_3_api_old(suite) -> []; -ssl_2_multi_orber_generation_3_api_old(_Config) -> - - ServerOptions = orber_test_lib:get_options_old(iiop_ssl, server, - 2, [{ssl_generation, 3}, - {iiop_ssl_port, 0}]), - ClientOptions = orber_test_lib:get_options_old(iiop_ssl, client, - 2, [{ssl_generation, 3}, - {iiop_ssl_port, 0}]), - ssl_suite(ServerOptions, ClientOptions). - - ssl_2_multi_orber_generation_3_api(doc) -> ["SECURE MULTI ORB API tests (SSL depth 2)", "This case set up two secure orbs and test if they can", "communicate. The case also test to access one of the", @@ -1724,11 +1684,6 @@ ssl_reconfigure_api(_Config) -> ssl_reconfigure_old([]). -ssl_reconfigure_generation_3_api_old(doc) -> ["SECURE MULTI ORB API tests (SSL depth 2)", - "This case set up two secure orbs and test if they can", - "communicate. The case also test to access one of the", - "secure orbs which must raise a NO_PERMISSION exception."]; -ssl_reconfigure_generation_3_api_old(suite) -> []; ssl_reconfigure_generation_3_api_old(_Config) -> ssl_reconfigure_old([{ssl_generation, 3}]). diff --git a/lib/orber/test/orber_nat_SUITE.erl b/lib/orber/test/orber_nat_SUITE.erl index ee31b162c2..a21bd4d499 100644 --- a/lib/orber/test/orber_nat_SUITE.erl +++ b/lib/orber/test/orber_nat_SUITE.erl @@ -57,7 +57,6 @@ nat_ip_address_local/1, nat_ip_address_local_local/1, nat_iiop_port/1, nat_iiop_port_local/1, nat_iiop_port_local_local/1, - nat_iiop_ssl_port_old/1, nat_iiop_ssl_port_local_old/1, nat_iiop_ssl_port/1, nat_iiop_ssl_port_local/1]). @@ -93,8 +92,6 @@ cases() -> nat_iiop_port_local, nat_ip_address_local_local, nat_iiop_port_local_local, - nat_iiop_ssl_port_old, - nat_iiop_ssl_port_local_old, nat_iiop_ssl_port, nat_iiop_ssl_port_local]. @@ -103,9 +100,7 @@ cases() -> %%----------------------------------------------------------------- init_per_testcase(TC, Config) when TC =:= nat_iiop_ssl_port; - TC =:= nat_iiop_ssl_port_local; - TC =:= nat_iiop_ssl_port_old; - TC =:= nat_iiop_ssl_port_local_old -> + TC =:= nat_iiop_ssl_port_local -> case ?config(crypto_started, Config) of true -> case orber_test_lib:ssl_version() of @@ -291,106 +286,6 @@ nat_iiop_port_local_local(_Config) -> %% API tests for ORB to ORB, ssl security depth 1 %%----------------------------------------------------------------- -nat_iiop_ssl_port_old(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)", - "Make sure NAT works for SSL"]; -nat_iiop_ssl_port_old(suite) -> []; -nat_iiop_ssl_port_old(_Config) -> - - IP = orber_test_lib:get_host(), - ServerOptions = orber_test_lib:get_options_old(iiop_ssl, server, - 1, [{iiop_ssl_port, 0}, - {flags, ?ORB_ENV_ENABLE_NAT}, - {ip_address, IP}]), - ClientOptions = orber_test_lib:get_options_old(iiop_ssl, client, - 1, [{iiop_ssl_port, 0}]), - {ok, ServerNode, _ServerHost} = - ?match({ok,_,_}, orber_test_lib:js_node(ServerOptions)), - ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), - SSLServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_ssl_port, []), - NATSSLServerPort = SSLServerPort+1, - {ok, Ref} = ?match({ok, _}, - orber_test_lib:remote_apply(ServerNode, orber, - add_listen_interface, - [IP, ssl, NATSSLServerPort])), - orber_test_lib:remote_apply(ServerNode, orber_env, configure_override, - [nat_iiop_ssl_port, - {local, NATSSLServerPort, [{4001, 43}]}]), - - {ok, ClientNode, _ClientHost} = - ?match({ok,_,_}, orber_test_lib:js_node(ClientOptions)), - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - install_test_data, - [ssl])), - - IOR1 = ?match(#'IOP_IOR'{}, - orber_test_lib:remote_apply(ClientNode, corba, - string_to_object, - ["corbaname::1.2@"++IP++":"++ - integer_to_list(ServerPort)++"/NameService#mamba"])), - - ?match({'external', {_IP, _Port, _ObjectKey, _Counter, _TP, - #host_data{protocol = ssl, - ssl_data = #'SSLIOP_SSL'{port = NATSSLServerPort}}}}, - iop_ior:get_key(IOR1)), - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - uninstall_test_data, - [ssl])), - ?match(ok, - orber_test_lib:remote_apply(ServerNode, orber, - remove_listen_interface, [Ref])), - ok. - -nat_iiop_ssl_port_local_old(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)", - "Make sure NAT works for SSL"]; -nat_iiop_ssl_port_local_old(suite) -> []; -nat_iiop_ssl_port_local_old(_Config) -> - - IP = orber_test_lib:get_host(), - ServerOptions = orber_test_lib:get_options_old(iiop_ssl, server, - 1, [{iiop_ssl_port, 0}, - {flags, - (?ORB_ENV_LOCAL_INTERFACE bor - ?ORB_ENV_ENABLE_NAT)}, - {ip_address, IP}]), - ClientOptions = orber_test_lib:get_options_old(iiop_ssl, client, - 1, [{iiop_ssl_port, 0}]), - {ok, ServerNode, _ServerHost} = - ?match({ok,_,_}, orber_test_lib:js_node(ServerOptions)), - ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), - SSLServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_ssl_port, []), - NATSSLServerPort = SSLServerPort+1, - {ok, Ref} = ?match({ok, _}, - orber_test_lib:remote_apply(ServerNode, orber, - add_listen_interface, - [IP, ssl, NATSSLServerPort])), - orber_test_lib:remote_apply(ServerNode, orber_env, configure_override, - [nat_iiop_ssl_port, - {local, NATSSLServerPort, [{NATSSLServerPort, NATSSLServerPort}]}]), - - {ok, ClientNode, _ClientHost} = - ?match({ok,_,_}, orber_test_lib:js_node(ClientOptions)), - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - install_test_data, - [ssl])), - - IOR1 = ?match(#'IOP_IOR'{}, - orber_test_lib:remote_apply(ClientNode, corba, - string_to_object, - ["corbaname::1.2@"++IP++":"++ - integer_to_list(ServerPort)++"/NameService#mamba"])), - - ?match({'external', {_IP, _Port, _ObjectKey, _Counter, _TP, - #host_data{protocol = ssl, - ssl_data = #'SSLIOP_SSL'{port = NATSSLServerPort}}}}, - iop_ior:get_key(IOR1)), - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - uninstall_test_data, - [ssl])), - ?match(ok, - orber_test_lib:remote_apply(ServerNode, orber, - remove_listen_interface, [Ref])), - ok. - nat_iiop_ssl_port(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)", "Make sure NAT works for SSL"]; diff --git a/lib/os_mon/c_src/Makefile.in b/lib/os_mon/c_src/Makefile.in index 51569f6ec9..f84ccf7c87 100644 --- a/lib/os_mon/c_src/Makefile.in +++ b/lib/os_mon/c_src/Makefile.in @@ -84,6 +84,7 @@ debug opt: $(TARGET_FILES) clean: rm -f $(TARGET_FILES) + rm -rf $(OBJDIR) rm -f core *~ docs: diff --git a/lib/os_mon/c_src/cpu_sup.c b/lib/os_mon/c_src/cpu_sup.c index 7372d5b0e8..e9fd75a32c 100644 --- a/lib/os_mon/c_src/cpu_sup.c +++ b/lib/os_mon/c_src/cpu_sup.c @@ -29,6 +29,7 @@ #include <stdio.h> #include <stdlib.h> #include <unistd.h> +#include <string.h> #if defined(__sun__) #include <kstat.h> @@ -120,7 +121,9 @@ typedef struct { static void util_measure(unsigned int **result_vec, int *result_sz); +#if defined(__sun__) static unsigned int misc_measure(char* name); +#endif static void send(unsigned int data); static void sendv(unsigned int data[], int ints); static void error(char* err_msg); @@ -140,7 +143,9 @@ int main(int argc, char** argv) { int rc; int sz; unsigned int *rv; +#if defined(__linux__) unsigned int no_of_cpus = 0; +#endif #if defined(__sun__) kstat_ctl = kstat_open(); @@ -288,10 +293,10 @@ static unsigned int misc_measure(char* name) { if(!entry) return -1; - if(entry->data_type != KSTAT_DATA_ULONG) + if(entry->data_type != KSTAT_DATA_UINT32) return -1; - return entry->value.ul; + return entry->value.ui32; } diff --git a/lib/os_mon/doc/src/notes.xml b/lib/os_mon/doc/src/notes.xml index a5099a0829..c6b5bc8895 100644 --- a/lib/os_mon/doc/src/notes.xml +++ b/lib/os_mon/doc/src/notes.xml @@ -30,6 +30,43 @@ </header> <p>This document describes the changes made to the OS_Mon application.</p> +<section><title>Os_Mon 2.2.13</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Use 'df -k -l' to query FreeBSD and OpenBSD about + diskspace on local disks. Previously 'df' -k -t ufs' was + used but this will not handle zfs or other disks. Just + use '-l' instead of listing potential filesystems.</p> + <p> + Own Id: OTP-11207</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Fix compilation on Solaris. Thanks to Maciej Malecki.</p> + <p> + Own Id: OTP-11213</p> + </item> + <item> + <p> + Fix broken cpu_sup:nprocs and others on Solaris 64-bit. + Thanks to Simon Cornish.</p> + <p> + Own Id: OTP-11298</p> + </item> + </list> + </section> + +</section> + <section><title>Os_Mon 2.2.12</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/os_mon/test/cpu_sup_SUITE.erl b/lib/os_mon/test/cpu_sup_SUITE.erl index d04adbb6d3..e0382cb0c7 100644 --- a/lib/os_mon/test/cpu_sup_SUITE.erl +++ b/lib/os_mon/test/cpu_sup_SUITE.erl @@ -88,6 +88,7 @@ load_api(Config) when is_list(Config) -> ?line N = cpu_sup:nprocs(), ?line true = is_integer(N), ?line true = N>0, + ?line true = N<1000000, %% avg1() ?line Load1 = cpu_sup:avg1(), diff --git a/lib/os_mon/vsn.mk b/lib/os_mon/vsn.mk index e3acea0258..0af587b9ae 100644 --- a/lib/os_mon/vsn.mk +++ b/lib/os_mon/vsn.mk @@ -1 +1 @@ -OS_MON_VSN = 2.2.12 +OS_MON_VSN = 2.2.13 diff --git a/lib/parsetools/doc/src/leex.xml b/lib/parsetools/doc/src/leex.xml index 0fd5a77e37..7ee0633dac 100644 --- a/lib/parsetools/doc/src/leex.xml +++ b/lib/parsetools/doc/src/leex.xml @@ -38,19 +38,21 @@ Token = tuple()</code> </section> <funcs> <func> - <name>file(FileName) -> ok | error</name> - <name>file(FileName, Options) -> ok | error</name> + <name>file(FileName, [, Options]) -> LeexRet</name> <fsummary>Generate a lexical analyzer</fsummary> <type> <v>FileName = filename()</v> <v>Options = Option | [Option]</v> <v>Option = - see below -</v> - <v>FileReturn = {ok, Scannerfile} - | {ok, Scannerfile, Warnings} - | error - | {error, Warnings, Errors}</v> + <v>LeexRet = {ok, Scannerfile} + | {ok, Scannerfile, Warnings} + | error + | {error, Warnings, Errors}</v> <v>Scannerfile = filename()</v> <v>Warnings = Errors = [{filename(), [ErrorInfo]}]</v> + <v>ErrorInfo = {ErrorLine, module(), Reason}</v> + <v>ErrorLine = integer()</v> + <v>Reason = - formatable by format_error/1 -</v> </type> <desc> <p>Generates a lexical analyzer from the definition in the input diff --git a/lib/parsetools/doc/src/notes.xml b/lib/parsetools/doc/src/notes.xml index bfcc38dedd..929daedf74 100644 --- a/lib/parsetools/doc/src/notes.xml +++ b/lib/parsetools/doc/src/notes.xml @@ -30,6 +30,41 @@ </header> <p>This document describes the changes made to the Parsetools application.</p> +<section><title>Parsetools 2.0.10</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> A bug causing Yecc to generate badly formed parsers + when encountering very simple recursive rules has been + fixed. (Thanks to Eric Pailleau.) </p> + <p> + Own Id: OTP-11269</p> + </item> + <item> + <p> A bug where Unicode filenames combined with Latin-1 + encoding could crash Yecc and Leex has been fixed. </p> + <p> + Own Id: OTP-11286</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Fix leex module`s inability to build unicode-aware + lexers. Thanks to Pierre Fenoll.</p> + <p> + Own Id: OTP-11313</p> + </item> + </list> + </section> + +</section> + <section><title>Parsetools 2.0.9</title> <section><title>Improvements and New Features</title> diff --git a/lib/parsetools/src/leex.erl b/lib/parsetools/src/leex.erl index e531b78a5b..03f864ff03 100644 --- a/lib/parsetools/src/leex.erl +++ b/lib/parsetools/src/leex.erl @@ -436,7 +436,7 @@ parse_defs(_, {eof,L}, St) -> parse_defs(Ifile, {ok,Chars,L}=Line, Ms, St) -> %% This little beauty matches out a macro definition, RE's are so clear. MS = "^[ \t]*([A-Z_][A-Za-z0-9_]*)[ \t]*=[ \t]*([^ \t\r\n]*)[ \t\r\n]*\$", - case re:run(Chars, MS, [{capture,all_but_first,list}]) of + case re:run(Chars, MS, [{capture,all_but_first,list},unicode]) of {match,[Name,Def]} -> %%io:fwrite("~p = ~p\n", [Name,Def]), parse_defs(Ifile, nextline(Ifile, L, St), [{Name,Def}|Ms], St); @@ -491,7 +491,7 @@ parse_rules_end(_, NextLine, REAs, As, St) -> collect_rule(Ifile, Chars, L0) -> %% Erlang strings are 1 based, but re 0 :-( - {match,[{St0,Len}|_]} = re:run(Chars, "[^ \t\r\n]+"), + {match,[{St0,Len}|_]} = re:run(Chars, "[^ \t\r\n]+", [unicode]), St = St0 + 1, %%io:fwrite("RE = ~p~n", [substr(Chars, St, Len)]), case collect_action(Ifile, substr(Chars, St+Len), L0, []) of @@ -548,7 +548,7 @@ var_used(Name, Toks) -> %% here as it uses info in replace string (&). parse_rule_regexp(RE0, [{M,Exp}|Ms], St) -> - Split= re:split(RE0, "\\{" ++ M ++ "\\}", [{return,list}]), + Split= re:split(RE0, "\\{" ++ M ++ "\\}", [{return,list},unicode]), RE1 = string:join(Split, Exp), parse_rule_regexp(RE1, Ms, St); parse_rule_regexp(RE, [], St) -> @@ -1645,10 +1645,14 @@ output_encoding_comment(File, #leex{encoding = Encoding}) -> output_file_directive(File, Filename, Line) -> io:fwrite(File, <<"-file(~ts, ~w).\n">>, - [format_filename(Filename), Line]). + [format_filename(Filename, File), Line]). -format_filename(Filename) -> - io_lib:write_string(filename:flatten(Filename)). +format_filename(Filename0, File) -> + Filename = filename:flatten(Filename0), + case lists:keyfind(encoding, 1, io:getopts(File)) of + {encoding, unicode} -> io_lib:write_string(Filename); + _ -> io_lib:write_string_as_latin1(Filename) + end. quote($^) -> "\\^"; quote($.) -> "\\."; diff --git a/lib/parsetools/src/yecc.erl b/lib/parsetools/src/yecc.erl index f9207d926e..b698beb558 100644 --- a/lib/parsetools/src/yecc.erl +++ b/lib/parsetools/src/yecc.erl @@ -482,7 +482,7 @@ generate(St0) -> F = case member(time, St1#yecc.options) of true -> io:fwrite(<<"Generating parser from grammar in ~ts\n">>, - [format_filename(St1#yecc.infile)]), + [format_filename(St1#yecc.infile, St1)]), fun timeit/3; false -> fun(_Name, Fn, St) -> Fn(St) end @@ -2519,7 +2519,7 @@ output_encoding_comment(#yecc{encoding = Encoding}=St) -> output_file_directive(St, Filename, Line) when St#yecc.file_attrs -> fwrite(St, <<"-file(~ts, ~w).\n">>, - [format_filename(Filename), Line]); + [format_filename(Filename, St), Line]); output_file_directive(St, _Filename, _Line) -> St. @@ -2547,8 +2547,12 @@ nl(#yecc{outport = Outport, line = Line}=St) -> io:nl(Outport), St#yecc{line = Line + 1}. -format_filename(Filename) -> - io_lib:write_string(filename:flatten(Filename)). +format_filename(Filename0, St) -> + Filename = filename:flatten(Filename0), + case lists:keyfind(encoding, 1, io:getopts(St#yecc.outport)) of + {encoding, unicode} -> io_lib:write_string(Filename); + _ -> io_lib:write_string_as_latin1(Filename) + end. format_assoc(left) -> "Left"; diff --git a/lib/parsetools/test/leex_SUITE.erl b/lib/parsetools/test/leex_SUITE.erl index 576c42dd8e..eb15bebf63 100644 --- a/lib/parsetools/test/leex_SUITE.erl +++ b/lib/parsetools/test/leex_SUITE.erl @@ -44,7 +44,7 @@ pt/1, man/1, ex/1, ex2/1, not_yet/1, - otp_10302/1]). + otp_10302/1, otp_11286/1, unicode/1]). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). @@ -65,8 +65,8 @@ all() -> groups() -> [{checks, [], [file, compile, syntax]}, - {examples, [], [pt, man, ex, ex2, not_yet]}, - {tickets, [], [otp_10302]}]. + {examples, [], [pt, man, ex, ex2, not_yet, unicode]}, + {tickets, [], [otp_10302, otp_11286]}]. init_per_suite(Config) -> Config. @@ -400,6 +400,24 @@ pt(Config) when is_list(Config) -> ?line run(Config, Ts), ok. +unicode(suite) -> + []; +unicode(Config) when is_list(Config) -> + Ts = [{unicode_1, + <<"%% -*- coding: utf-8 -*-\n" + "Definitions.\n" + "RTLarrow = (←)\n" + "Rules.\n" + "{RTLarrow} : {token,{'<-',TokenLine}}.\n" + "Erlang code.\n" + "-export([t/0]).\n" + "t() -> {ok, [{'<-', 1}], 1} = string(\"←\"), ok.">>, + default, + ok}], + + ?line run(Config, Ts), + ok. + man(doc) -> "Examples from the manpage."; man(suite) -> []; @@ -982,6 +1000,68 @@ otp_10302(Config) when is_list(Config) -> ok. +otp_11286(doc) -> + "OTP-11286. A Unicode filename bug; both Leex and Yecc."; +otp_11286(suite) -> []; +otp_11286(Config) when is_list(Config) -> + Node = start_node(otp_11286, "+fnu"), + Dir = ?privdir, + UName = [1024] ++ "u", + UDir = filename:join(Dir, UName), + ok = rpc:call(Node, file, make_dir, [UDir]), + + %% Note: Cannot use UName as filename since the filename is used + %% as module name. To be fixed in R18. + Filename = filename:join(UDir, 'OTP-11286.xrl'), + Scannerfile = filename:join(UDir, 'OTP-11286.erl'), + Options = [return, {scannerfile, Scannerfile}], + + Mini1 = <<"%% coding: utf-8\n" + "Definitions.\n" + "D = [0-9]\n" + "Rules.\n" + "{L}+ : {token,{word,TokenLine,TokenChars}}.\n" + "Erlang code.\n">>, + ok = rpc:call(Node, file, write_file, [Filename, Mini1]), + {ok, _, []} = rpc:call(Node, leex, file, [Filename, Options]), + {ok,_,_} = rpc:call(Node, compile, file, + [Scannerfile,[basic_validation,return]]), + + Mini2 = <<"Definitions.\n" + "D = [0-9]\n" + "Rules.\n" + "{L}+ : {token,{word,TokenLine,TokenChars}}.\n" + "Erlang code.\n">>, + ok = rpc:call(Node, file, write_file, [Filename, Mini2]), + {ok, _, []} = rpc:call(Node, leex, file, [Filename, Options]), + {ok,_,_} = rpc:call(Node, compile, file, + [Scannerfile,[basic_validation,return]]), + + Mini3 = <<"%% coding: latin-1\n" + "Definitions.\n" + "D = [0-9]\n" + "Rules.\n" + "{L}+ : {token,{word,TokenLine,TokenChars}}.\n" + "Erlang code.\n">>, + ok = rpc:call(Node, file, write_file, [Filename, Mini3]), + {ok, _, []} = rpc:call(Node, leex, file, [Filename, Options]), + {ok,_,_} = rpc:call(Node, compile, file, + [Scannerfile,[basic_validation,return]]), + + true = test_server:stop_node(Node), + ok. + +start_node(Name, Args) -> + [_,Host] = string:tokens(atom_to_list(node()), "@"), + ct:log("Trying to start ~w@~s~n", [Name,Host]), + case test_server:start_node(Name, peer, [{args,Args}]) of + {error,Reason} -> + test_server:fail(Reason); + {ok,Node} -> + ct:log("Node ~p started~n", [Node]), + Node + end. + unwritable(Fname) -> {ok, Info} = file:read_file_info(Fname), Mode = Info#file_info.mode - 8#00200, @@ -1013,7 +1093,7 @@ run_test(Config, Def, Pre) -> XrlFile = filename:join(DataDir, DefFile), ErlFile = filename:join(DataDir, Filename), Opts = [return, warn_unused_vars,{outdir,DataDir}], - ok = file:write_file(XrlFile, Def), + ok = file:write_file(XrlFile, Def, [{encoding, unicode}]), LOpts = [return, {report, false} | case Pre of default -> diff --git a/lib/parsetools/test/yecc_SUITE.erl b/lib/parsetools/test/yecc_SUITE.erl index 38bcd52ffc..d308d21f82 100644 --- a/lib/parsetools/test/yecc_SUITE.erl +++ b/lib/parsetools/test/yecc_SUITE.erl @@ -48,7 +48,8 @@ otp_5369/1, otp_6362/1, otp_7945/1, otp_8483/1, otp_8486/1, - otp_7292/1, otp_7969/1, otp_8919/1, otp_10302/1, otp_11269/1]). + otp_7292/1, otp_7969/1, otp_8919/1, otp_10302/1, otp_11269/1, + otp_11286/1]). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). @@ -76,7 +77,7 @@ groups() -> {bugs, [], [otp_5369, otp_6362, otp_7945, otp_8483, otp_8486]}, {improvements, [], [otp_7292, otp_7969, otp_8919, otp_10302, - otp_11269]}]. + otp_11269, otp_11286]}]. init_per_suite(Config) -> Config. @@ -1995,6 +1996,64 @@ otp_11269(Config) when is_list(Config) -> {ok,'OTP-11269',_Warnings} = compile:file(ErlFile, Opts), ok. +otp_11286(doc) -> + "OTP-11286. A Unicode filename bug; both Leex and Yecc."; +otp_11286(suite) -> []; +otp_11286(Config) when is_list(Config) -> + Node = start_node(otp_11286, "+fnu"), + Dir = ?privdir, + UName = [1024] ++ "u", + UDir = filename:join(Dir, UName), + ok = rpc:call(Node, file, make_dir, [UDir]), + + %% Note: Cannot use UName as filename since the filename is used + %% as module name. To be fixed in R18. + Filename = filename:join(UDir, 'OTP-11286.yrl'), + Ret = [return, {report, false}, time], + + Mini1 = <<"%% coding: utf-8 + Terminals t. + Nonterminals nt. + Rootsymbol nt. + nt -> t.">>, + ok = rpc:call(Node, file, write_file, [Filename, Mini1]), + {ok,ErlFile,[]} = rpc:call(Node, yecc, file, [Filename, Ret]), + Opts = [return, warn_unused_vars,{outdir,Dir}], + {ok,_,_Warnings} = rpc:call(Node, compile, file, [ErlFile, Opts]), + + Mini2 = <<"Terminals t. + Nonterminals nt. + Rootsymbol nt. + nt -> t.">>, + ok = rpc:call(Node, file, write_file, [Filename, Mini2]), + {ok,ErlFile,[]} = rpc:call(Node, yecc, file, [Filename, Ret]), + Opts = [return, warn_unused_vars,{outdir,Dir}], + {ok,_,_Warnings} = rpc:call(Node, compile, file, [ErlFile, Opts]), + + Mini3 = <<"%% coding: latin-1 + Terminals t. + Nonterminals nt. + Rootsymbol nt. + nt -> t.">>, + ok = rpc:call(Node, file, write_file, [Filename, Mini3]), + {ok,ErlFile,[]} = rpc:call(Node, yecc, file, [Filename, Ret]), + Opts = [return, warn_unused_vars,{outdir,Dir}], + {ok,_,_Warnings} = rpc:call(Node, compile, file, [ErlFile, Opts]), + + true = test_server:stop_node(Node), + ok. + +start_node(Name, Args) -> + [_,Host] = string:tokens(atom_to_list(node()), "@"), + ct:log("Trying to start ~w@~s~n", [Name,Host]), + case test_server:start_node(Name, peer, [{args,Args}]) of + {error,Reason} -> + test_server:fail(Reason); + {ok,Node} -> + ct:log("Node ~p started~n", [Node]), + Node + end. + yeccpre_size() -> yeccpre_size(default_yeccpre()). diff --git a/lib/parsetools/vsn.mk b/lib/parsetools/vsn.mk index 444caf44a1..d62962c54a 100644 --- a/lib/parsetools/vsn.mk +++ b/lib/parsetools/vsn.mk @@ -1 +1 @@ -PARSETOOLS_VSN = 2.0.9 +PARSETOOLS_VSN = 2.0.10 diff --git a/lib/percept/doc/src/notes.xml b/lib/percept/doc/src/notes.xml index 391f4d6d47..3cead186c4 100644 --- a/lib/percept/doc/src/notes.xml +++ b/lib/percept/doc/src/notes.xml @@ -32,6 +32,23 @@ </header> <p>This document describes the changes made to the Percept application.</p> +<section><title>Percept 0.8.8.2</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + The encoding of the <c>notes.xml</c> file has been + changed from latin1 to utf-8 to avoid future merge + problems.</p> + <p> + Own Id: OTP-11310</p> + </item> + </list> + </section> + +</section> + <section><title>Percept 0.8.8.1</title> <section><title>Improvements and New Features</title> diff --git a/lib/percept/vsn.mk b/lib/percept/vsn.mk index 2ea0341ddf..99729c11e2 100644 --- a/lib/percept/vsn.mk +++ b/lib/percept/vsn.mk @@ -1 +1 @@ -PERCEPT_VSN = 0.8.8.1 +PERCEPT_VSN = 0.8.8.2 diff --git a/lib/public_key/asn1/PKCS-7.asn1 b/lib/public_key/asn1/PKCS-7.asn1 index a6dfd57d80..e76f928acb 100644 --- a/lib/public_key/asn1/PKCS-7.asn1 +++ b/lib/public_key/asn1/PKCS-7.asn1 @@ -78,6 +78,49 @@ signingTime ATTRIBUTE ::= { SigningTime ::= Time -- imported from ISO/IEC 9594-8 +-- begin added for VCE SCEP-support +transactionID ATTRIBUTE ::= { + WITH SYNTAX PrintableString + ID id-transId +} + +messageType ATTRIBUTE ::= { + WITH SYNTAX PrintableString + ID id-messageType +} + +pkiStatus ATTRIBUTE ::= { + WITH SYNTAX PrintableString + ID id-pkiStatus +} + +failInfo ATTRIBUTE ::= { + WITH SYNTAX PrintableString + ID id-failInfo +} + +senderNonce ATTRIBUTE ::= { + WITH SYNTAX OCTET STRING + ID id-senderNonce +} + +recipientNonce ATTRIBUTE ::= { + WITH SYNTAX OCTET STRING + ID id-recipientNonce +} + +-- This is the authenticatedAttributes -member from SignerInfo +-- added here to generate decode/encode functions for it which are +-- needed to build the pkcs-7 used by SCEP, the resulting encoding are +-- used to make a signed digest +SignerInfoAuthenticatedAttributes ::= CHOICE { + aaSet [0] IMPLICIT SET OF AttributePKCS-7 {{Authenticated}}, + aaSequence [2] EXPLICIT SEQUENCE OF AttributePKCS-7 {{Authenticated}} + -- Explicit because easier to compute digest on sequence of attributes and then reuse + -- encoded sequence in aaSequence. + } +-- end added for VCE SCEP-support + -- Also defined in X.509 -- Redeclared here as a parameterized type @@ -224,12 +267,9 @@ SignerInfo ::= SEQUENCE { issuerAndSerialNumber IssuerAndSerialNumber, digestAlgorithm DigestAlgorithmIdentifier, - authenticatedAttributes CHOICE { - aaSet [0] IMPLICIT SET OF AttributePKCS-7 {{Authenticated}}, - aaSequence [2] EXPLICIT SEQUENCE OF AttributePKCS-7 {{Authenticated}} - -- Explicit because easier to compute digest on sequence of attributes and then reuse - -- encoded sequence in aaSequence. - } OPTIONAL, + -- Added explicit type for authenticatedAttributes to be able to + -- encode/decode this type separately + authenticatedAttributes SignerInfoAuthenticatedAttributes OPTIONAL, digestEncryptionAlgorithm DigestEncryptionAlgorithmIdentifier, encryptedDigest EncryptedDigest, @@ -247,7 +287,15 @@ SignerInfo ::= SEQUENCE { Authenticated ATTRIBUTE ::= { contentType | - messageDigest, + messageDigest | +-- begin added for VCE SCEP-support + transactionID | + messageType | + pkiStatus | + failInfo | + senderNonce | + recipientNonce, +-- end added for VCE SCEP-support ..., -- add application-specific attributes here signingTime } @@ -384,4 +432,18 @@ signedAndEnvelopedData OBJECT IDENTIFIER ::= { pkcs-7 4 } digestedData OBJECT IDENTIFIER ::= { pkcs-7 5 } encryptedData OBJECT IDENTIFIER ::= { pkcs-7 6 } +-- begin added for VCE SCEP-support +id-VeriSign OBJECT IDENTIFIER ::= {2 16 us(840) 1 veriSign(113733)} +id-pki OBJECT IDENTIFIER ::= {id-VeriSign pki(1)} +id-attributes OBJECT IDENTIFIER ::= {id-pki attributes(9)} +id-messageType OBJECT IDENTIFIER ::= {id-attributes messageType(2)} +id-pkiStatus OBJECT IDENTIFIER ::= {id-attributes pkiStatus(3)} +id-failInfo OBJECT IDENTIFIER ::= {id-attributes failInfo(4)} +id-senderNonce OBJECT IDENTIFIER ::= {id-attributes senderNonce(5)} +id-recipientNonce OBJECT IDENTIFIER ::= {id-attributes recipientNonce(6)} +id-transId OBJECT IDENTIFIER ::= {id-attributes transId(7)} +id-extensionReq OBJECT IDENTIFIER ::= {id-attributes extensionReq(8)} +-- end added for VCE SCEP-support + + END diff --git a/lib/public_key/doc/src/notes.xml b/lib/public_key/doc/src/notes.xml index e18d350dc5..add324dae2 100644 --- a/lib/public_key/doc/src/notes.xml +++ b/lib/public_key/doc/src/notes.xml @@ -34,6 +34,29 @@ <file>notes.xml</file> </header> +<section><title>Public_Key 0.20</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Extend PKCS-7 to support SCEP (Simple Certificate + Enrollment Protocol).</p> + <p> + Own Id: OTP-10874</p> + </item> + <item> + <p> + public_key:pem_entry_decode/2 now handles AES-128-CBC + ciphered keys. Thanks to Simon Cornish.</p> + <p> + Own Id: OTP-11281</p> + </item> + </list> + </section> + +</section> + <section><title>Public_Key 0.19</title> <section><title>Improvements and New Features</title> diff --git a/lib/public_key/doc/src/using_public_key.xml b/lib/public_key/doc/src/using_public_key.xml index 267a76ab65..450bd7e35f 100644 --- a/lib/public_key/doc/src/using_public_key.xml +++ b/lib/public_key/doc/src/using_public_key.xml @@ -350,7 +350,7 @@ ok</code> <p> or </p> - <code>1> PemBin = public_key:pem_entry_encode('SubjectPublicKeyInfo', RSAPubKey). + <code>1> PemEntry = public_key:pem_entry_encode('SubjectPublicKeyInfo', RSAPubKey). {'SubjectPublicKeyInfo', <<48,92...>>, not_encrypted} 2> PemBin = public_key:pem_encode([PemEntry]). diff --git a/lib/public_key/src/pubkey_pbe.erl b/lib/public_key/src/pubkey_pbe.erl index 6f0be53db9..460624163b 100644 --- a/lib/public_key/src/pubkey_pbe.erl +++ b/lib/public_key/src/pubkey_pbe.erl @@ -66,7 +66,13 @@ decode(Data, Password,"DES-EDE3-CBC" = Cipher, KeyDevParams) -> decode(Data, Password,"RC2-CBC"= Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), - crypto:block_decrypt(rc2_cbc, Key, IV, Data). + crypto:block_decrypt(rc2_cbc, Key, IV, Data); + +decode(Data, Password,"AES-128-CBC"= Cipher, IV) -> + %% PKCS5_SALT_LEN is 8 bytes + <<Salt:8/binary,_/binary>> = IV, + {Key, _} = password_to_key_and_iv(Password, Cipher, Salt), + crypto:block_decrypt(aes_cbc128, Key, IV, Data). %%-------------------------------------------------------------------- -spec pbdkdf1(string(), iodata(), integer(), atom()) -> binary(). @@ -200,7 +206,9 @@ derived_key_length(Cipher,_) when (Cipher == ?'rc2CBC') or 16; derived_key_length(Cipher,_) when (Cipher == ?'des-EDE3-CBC') or (Cipher == "DES-EDE3-CBC") -> - 24. + 24; +derived_key_length(Cipher,_) when (Cipher == "AES-128-CBC") -> + 16. cipher(#'PBES2-params_encryptionScheme'{algorithm = ?'desCBC'}) -> "DES-CBC"; diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index cdbfe6e07c..a4b6b8ad15 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -118,6 +118,13 @@ pem_entry_decode({Asn1Type, CryptDer, {Cipher, Salt}} = PemEntry, is_list(Cipher) andalso is_binary(Salt) andalso erlang:byte_size(Salt) == 8 -> + do_pem_entry_decode(PemEntry, Password); +pem_entry_decode({Asn1Type, CryptDer, {"AES-128-CBC"=Cipher, IV}} = PemEntry, + Password) when is_atom(Asn1Type) andalso + is_binary(CryptDer) andalso + is_list(Cipher) andalso + is_binary(IV) andalso + erlang:byte_size(IV) == 16 -> do_pem_entry_decode(PemEntry, Password). %%-------------------------------------------------------------------- diff --git a/lib/public_key/test/pbe_SUITE.erl b/lib/public_key/test/pbe_SUITE.erl index 2c9b17478d..b68ffbd5fd 100644 --- a/lib/public_key/test/pbe_SUITE.erl +++ b/lib/public_key/test/pbe_SUITE.erl @@ -218,6 +218,14 @@ encrypted_private_key_info(Config) when is_list(Config) -> [{'PrivateKeyInfo', _, {"RC2-CBC",_}} = PubEntry2] = PemRc2Entry, KeyInfo = public_key:pem_entry_decode(PubEntry2, "password"), + %% key generated with ssh-keygen -N hello_aes -f aes_128_cbc_enc_key + {ok, PemAesCbc} = file:read_file(filename:join(Datadir, "aes_128_cbc_enc_key")), + + PemAesCbcEntry = public_key:pem_decode(PemAesCbc), + ct:print("Pem entry: ~p" , [PemAesCbcEntry]), + [{'RSAPrivateKey', _, {"AES-128-CBC",_}} = PubAesCbcEntry] = PemAesCbcEntry, + #'RSAPrivateKey'{} = public_key:pem_entry_decode(PubAesCbcEntry, "hello_aes"), + check_key_info(KeyInfo). diff --git a/lib/public_key/test/pbe_SUITE_data/aes_128_cbc_enc_key b/lib/public_key/test/pbe_SUITE_data/aes_128_cbc_enc_key new file mode 100644 index 0000000000..34c7543f30 --- /dev/null +++ b/lib/public_key/test/pbe_SUITE_data/aes_128_cbc_enc_key @@ -0,0 +1,30 @@ +-----BEGIN RSA PRIVATE KEY----- +Proc-Type: 4,ENCRYPTED +DEK-Info: AES-128-CBC,D64FF97327558643763BE17BD50FDDAD + +oS4LbrLbQHPxfQILHl0KPswnkC1QqJ4RX6SkcQGVoYJJkPcavupABDYD1PSJf/MD +aPiN2OHsYAFLHxa1NGEAH6wKSvgdUJyaQ6jbSBNh9we9p2i3tpMnWsJMCZzXsCQh +RJj23/cFhb2UsqPM3OH6x6/VxX5VmD9Dnt1iU9b+WS6KdU45zP+QWpRd54uBrFab +Pw0kW7o84VFH6ahUDnzT8JUIk4P4G43G2F7wrOCbiK6AS0S8sCh5E83MrGEoJ6jB +NIW4xnLdBOLeV65NTgwWEn7bjLz+8IYSg2/wodjj5GL/ciMgiF+/krdQhzbHJhcm +dXV3SB/lTyjYUUGYU/3wm10f0iLJLFZxVU70yfV0eKhdYtWdR+2RxZjHvstBTGoI +BMtcaGwfMBh3wBHjS2M9AVh35DUYQIGW6QATf1VF+chhgESj6Qktkmfe4R9uAhP0 +r8Qkql/lq19K653c6ZIcUIYWvpAQ4Y/Q6Fdd92GY45FQdXYlZ/dXkwdq+ZYAhe6g +GUNmpwHf5N2a6lgXR3YytPYdhQbYMdy29RjXJsFWJh3sKTxgG/Y+FX2Ua7J1G4IW +wO6yZgQc9GyYzNn1TpT/TQ32GuHbw0u/oQqbNOJEjE0BTsQelEPpnNnEmkgPqSlI +3PNtsBvS6antvJ3CiCnmkQlT7/dLR9ym8nU+jo/hrtIStNUrdopCLB4+iUt7tJdz +jpW3Kc5fWmnGbp1UOXHoOghENfjIN+yUxIx9qCgBmWliY1nncUgzEHM34eGqGdek +nf6PowS4gIbJmO5Uc+0MwPld5HFou21da2M48FKolp3+CO1mX5MhvMLGVoFqNiE3 +dXYJG4bcMdxZncdaMn+c6ycA9iFTufF/qZPF/rGO5I+gc9M50bJjewbixqXM/LJ5 +1OnP/x7DN1Td3PTjAfjFX9yLWRMIjbihG43Htk5bOifaBtnOYj1e7WMjN8uBx91x +OCnfC3rngF4B9WmdYEkEvp9QZixbDlp0oh6/4HiRjjDkUfADnKuU/At7dd8sDOGD +NgaWVskJsulp8d9s3CozM7LmowlNpHV9BvAguckx/B7ZqV10mgAKOqZKk4LDlu2Y +MgQvSLJfyJsz/1q4z4jcXhYtSuZXXHk9lX9dgCZbQfVGnlsptNuV5KwupV2cz0Vi +Uh1mwvDXWFNIFwexZi0z27FJ1pKAKK+sf/GFqoAvdmYgYS6d5bmxh68bGZMZ2C6P +eehHkEZm1pv4CVDxrUTk+bNtqhDXglSdfxR0Xm1QDN95hM0dHq1kDZH6HgD6krJ6 +BBfd7mPRExH3+5JSQXoSUDO8LqP5phxLWKS0B8HDburnP/x9QzBOIKvmtDF1lQEk +FAI/6Lv8GJ0R7WYd2vFfGeqS94iw1BpmO/xS6WINOFpfwVCBuuYmLEdEWcXJgvy9 +zyaTX/mk1RMXo7I1X7aWviaIF7ykGxs1dJdrxQonwJ3oyTySNl2xf8bziKlqB/Ml +LDjeMNX91G8fJE0MdKPWd94PUoLN0CutM5sY5yHzwCvJQV9oQ1qvrQYUbnvtCEyQ +xT+bawt+ODgVb/QnyNeiIyEN5lXc8meJFLr1uMeEwX8WaJ7/KBKGk1V0XqVZTmga +-----END RSA PRIVATE KEY----- diff --git a/lib/public_key/test/public_key_SUITE.erl b/lib/public_key/test/public_key_SUITE.erl index c3aa2e2366..f8d167e770 100644 --- a/lib/public_key/test/public_key_SUITE.erl +++ b/lib/public_key/test/public_key_SUITE.erl @@ -46,7 +46,7 @@ all() -> groups() -> [{pem_decode_encode, [], [dsa_pem, rsa_pem, encrypted_pem, - dh_pem, cert_pem, pkcs10_pem]}, + dh_pem, cert_pem, pkcs7_pem, pkcs10_pem]}, {ssh_public_key_decode_encode, [], [ssh_rsa_public_key, ssh_dsa_public_key, ssh_rfc4716_rsa_comment, ssh_rfc4716_dsa_comment, ssh_rfc4716_rsa_subject, ssh_known_hosts, @@ -188,15 +188,9 @@ dh_pem() -> [{doc, "DH parametrs PEM-file decode/encode"}]. dh_pem(Config) when is_list(Config) -> Datadir = ?config(data_dir, Config), - [{'DHParameter', DerDH, not_encrypted} = Entry] = + [{'DHParameter', _DerDH, not_encrypted} = Entry] = erl_make_certs:pem_to_der(filename:join(Datadir, "dh.pem")), - - erl_make_certs:der_to_pem(filename:join(Datadir, "new_dh.pem"), [Entry]), - - DHParameter = public_key:der_decode('DHParameter', DerDH), - DHParameter = public_key:pem_entry_decode(Entry), - - Entry = public_key:pem_entry_encode('DHParameter', DHParameter). + asn1_encode_decode(Entry). %%-------------------------------------------------------------------- @@ -204,57 +198,38 @@ pkcs10_pem() -> [{doc, "PKCS-10 PEM-file decode/encode"}]. pkcs10_pem(Config) when is_list(Config) -> Datadir = ?config(data_dir, Config), - [{'CertificationRequest', DerPKCS10, not_encrypted} = Entry] = + [{'CertificationRequest', _DerPKCS10, not_encrypted} = Entry] = erl_make_certs:pem_to_der(filename:join(Datadir, "req.pem")), - - erl_make_certs:der_to_pem(filename:join(Datadir, "new_req.pem"), [Entry]), - - PKCS10 = public_key:der_decode('CertificationRequest', DerPKCS10), - PKCS10 = public_key:pem_entry_decode(Entry), - - Entry = public_key:pem_entry_encode('CertificationRequest', PKCS10). - + asn1_encode_decode(Entry). %%-------------------------------------------------------------------- pkcs7_pem() -> [{doc, "PKCS-7 PEM-file decode/encode"}]. pkcs7_pem(Config) when is_list(Config) -> Datadir = ?config(data_dir, Config), - [{'ContentInfo', DerPKCS7, not_encrypted} = Entry] = + [{'ContentInfo', _, not_encrypted} = Entry0] = erl_make_certs:pem_to_der(filename:join(Datadir, "pkcs7_cert.pem")), - - erl_make_certs:der_to_pem(filename:join(Datadir, "new_pkcs7_cert.pem"), [Entry]), - - PKCS7 = public_key:der_decode('ContentInfo', DerPKCS7), - PKCS7 = public_key:pem_entry_decode(Entry), - - Entry = public_key:pem_entry_encode('ContentInfo', PKCS7). - + [{'ContentInfo', _, not_encrypted} = Entry1] = + erl_make_certs:pem_to_der(filename:join(Datadir, "pkcs7_ext.pem")), + asn1_encode_decode(Entry0), + asn1_encode_decode(Entry1). + %%-------------------------------------------------------------------- cert_pem() -> [{doc, "Certificate PEM-file decode/encode"}]. cert_pem(Config) when is_list(Config) -> Datadir = ?config(data_dir, Config), - - [Entry0] = - erl_make_certs:pem_to_der(filename:join(Datadir, "dsa.pem")), - - [{'Certificate', DerCert, not_encrypted} = Entry7] = + + [{'Certificate', _, not_encrypted} = Entry0] = erl_make_certs:pem_to_der(filename:join(Datadir, "client_cert.pem")), - Cert = public_key:der_decode('Certificate', DerCert), - Cert = public_key:pem_entry_decode(Entry7), + asn1_encode_decode(Entry0), - CertEntries = [{'Certificate', _, not_encrypted} = CertEntry0, - {'Certificate', _, not_encrypted} = CertEntry1] = + [{'Certificate', _, not_encrypted} = Entry1, + {'Certificate', _, not_encrypted} = Entry2] = erl_make_certs:pem_to_der(filename:join(Datadir, "cacerts.pem")), - - ok = erl_make_certs:der_to_pem(filename:join(Datadir, "wcacerts.pem"), CertEntries), - ok = erl_make_certs:der_to_pem(filename:join(Datadir, "wdsa.pem"), [Entry0]), - NewCertEntries = erl_make_certs:pem_to_der(filename:join(Datadir, "wcacerts.pem")), - true = lists:member(CertEntry0, NewCertEntries), - true = lists:member(CertEntry1, NewCertEntries), - [Entry0] = erl_make_certs:pem_to_der(filename:join(Datadir, "wdsa.pem")). + asn1_encode_decode(Entry1), + asn1_encode_decode(Entry2). %%-------------------------------------------------------------------- ssh_rsa_public_key() -> @@ -720,6 +695,12 @@ pkix_iso_dsa_oid(Config) when is_list(Config) -> %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- +asn1_encode_decode({Asn1Type, Der, not_encrypted} = Entry) -> + Decoded = public_key:der_decode(Asn1Type, Der), + Decoded = public_key:pem_entry_decode(Entry), + Entry = public_key:pem_entry_encode(Asn1Type, Decoded), + ok. + check_countryname({rdnSequence,DirName}) -> do_check_countryname(DirName). do_check_countryname([]) -> diff --git a/lib/public_key/test/public_key_SUITE_data/pkcs7_ext.pem b/lib/public_key/test/public_key_SUITE_data/pkcs7_ext.pem new file mode 100644 index 0000000000..d7a1d01fe1 --- /dev/null +++ b/lib/public_key/test/public_key_SUITE_data/pkcs7_ext.pem @@ -0,0 +1,62 @@ +-----BEGIN PKCS7----- +MIILCAYJKoZIhvcNAQcCoIIK+TCCCvUCAQExDjAMBggqhkiG9w0CBQUAMIIFmwYJ +KoZIhvcNAQcBoIIFjASCBYgwggWEBgkqhkiG9w0BBwOgggV1MIIFcQIBADGCAmQw +ggJgAgEAMEgwPDELMAkGA1UEBhMCU0UxETAPBgNVBAoMCEVyaWNzc29uMRowGAYD +VQQDDBFWQ19SQlNfU3ViQ0FfVjNfMQIIcw3ZS5VSTIwwDQYJKoZIhvcNAQEBBQAE +ggIAFW0vd8wY2FJ87KVyUqcdK5uCmnjwC6uPbypDqnL44Fe4iAAiNOvmqt1Crm46 +pg9gOq50NbrRb+PY+UUM7lEUNNKZ61cul2iwGwp6r41l05EbMqgfsNoJkH+bTM8Y +YhME4sT+AzdmPHIg1PGoM+pAMHzpjcdnaHFSlfSmwq5xfZwWelR2TDz7arO+AKCk +DVIEnG9qHBrUWvDoT23VDVQQXP5Uja0Nml7B7Jt2RW2EKAiCAYDujkjIWcGy3F3X +2Q+Nm4K2nJKnkdMI5kS0Eu9uHp24VHn98sEyqn8rDiLFOaj5BskQIVMDN6npssgr +X4ChmBiVcquaxCoHMqQYGa/Jrd66C8WK2lQH3NpDCsULS+m6Z76bvXDFyL0K6rEP +sOcn8J91LfB5jXeSvS3vi7zk07M/IwAL03fVKvqiKU65D4859AOgbjkGyytWG1iv +t7ENh6GYHGJj71L+OlZZH25cJQ/2gGsYs4IYrT6w4Z1X5TscOL/tBiCDdTwcdT0q ++YdkL9ZONouHvgszb9IFvfFErzmmG7jTHwC/TzR0nC8vPog9+y05G4vnD1h7lzH7 +8xDsGrn86gcjYXXRPfc4AxDZfmaM8S0SFmd+O7B24sUKmSyxF3A7OVnb0/rTMuez +Izoy6RW9WQpCJM5R9k7YFDI5lQI+PiKT8GqzQuFIFXRYwOIwggMCBgkqhkiG9w0B +BwEwEQYFKw4DAgcECLsGKZ/iQ1HBgIIC4J1lxb/gn6EosJyMrTV8KnJxvD+Garzp +zmrDNvl9Q7CHmpNLuW3dngU5JcB5dElq7B+j6+RXNkupcrd2dvllAmwfPpFblmNp +Snsn99TTwDYv4LrpxNCcoIKSm93H28wfszhPv75zD9+/aIy4JK4UwYuv+p5JHfLW +EhvWO4pxUc2YpB8jiUVKTJJcRohry/lwvXu5s8VjmpoADSflHtAA4DUhFKX2fafu +Ux7muxbh7xFViNY6laQ/tuZuxxjs2Eb5aWWizO00cyLP2724vFQL+lnvyAvtSmcD +z2hOeOvvch6sJ4krx/gFznqe/lVksPyJQOj+Or8RTbC26kV4GQwiuGqgp6zhNjYe +4niPvGxVAFz8Qdv8Zu47fSHgI2nz5YlWuE2NiQ1qtCbMsf2k/NnZrTgx2oZxnZvL +B2We2D0u6BRZo4XMvGUqOLlGIV5scusv39/sBblJGOwNjtekG/pIRmiHXuI+RQOX +yr4tLR8clylf/HEMmYn2UVxXXuWsEr6zdBB3u3JhXhq+YmDpYYnTkxZq4nTz7oMY +MicrF0+iUrun6lIAXEU6yOSPehje5PfZW5PqKlpugKYIQSsbuJ4t/8n/MczHbRk9 +CcIX05OeWUdxRPKYa7Jt8umXnuIqWu7s7uZpbiB/tmuW4Cp16xUv53SgrTm4tiMq +b7O3ftMmEiFZ+uXds/ODfh7bTe4YlWdyimkCcyI4dcIjLxe+ifx4T+b4LktIc5Pd +5MHwAN+F1yIWnPxi8Nep9Pnw4HiX/ZkL0jHG0msZgZ60jb1U3LV4w3VI1WrsjvJM +6M+l7HM3xeTl9posjVQPxb7kyX5s6gDe4IaatPrNYcsDJ4t43v/se/nvlrQtkJzv +D4S2a9l833kYIC0MvoT8dqJuwySPZxjK0Io69sd6Af1BTGBoSQL75pOntrQUhICl +/kfjBkG5h6tpJFSZQEReK3Kg9rKIax5VwgQUte2yVu3EYARd3YZ7On+gggMTMIID +DzCCAfegAwIBAgITAkxY3LTPyvVkS5SUobGvznBgQDANBgkqhkiG9w0BAQUFADBC +MQswCQYDVQQGEwJTRTERMA8GA1UEChMIRXJpY3Nzb24xIDAeBgNVBAMTF0M4MjYx +MjQ1ODEuZXJpY3Nzb24uY29tMB4XDTEzMDgyMTE1MTcwM1oXDTE0MDgyMTE1MTcw +M1owQjELMAkGA1UEBhMCU0UxETAPBgNVBAoTCEVyaWNzc29uMSAwHgYDVQQDExdD +ODI2MTI0NTgxLmVyaWNzc29uLmNvbTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCC +AQoCggEBAPgg9zlAP6Z8vDMq+Ux0mq1RPLLtG2kByeauGvKdzbRLxtiyyKlknFQ8 +jdn8w3NrQiXTYSEcR0eDWjpLiwvkW2WC+lARIHUWQjRJWQIaSQ1lu9rDHlMYr2xm +6EF6QDgr/9fqkY1IrF/gEAwnNQhT44qCzSr/jqmf5phd5qslzYlpYY97yeEihiCT +wa/BNl1puS3+ayXI9e73Fpeysd0+TFjgbUwhUZn8kcKnDiynb19cyKzk4F1MQHwu +QDFUkxtFcKMW8GikjEYy0Gw8CJUPl4SedtwoU4PGhWqgA/vYOPhdP6LfSBhTmU3s +tUrFxUuMAiRF24JHdTj2bv+huDotWu0CAwEAATANBgkqhkiG9w0BAQUFAAOCAQEA +PtB1eG9FbriUPD79Kb5uyt15JoROPDBc3voR9HffqDsANyEJ3VPlvAFEyrQzbdnA +V5slZRR7M5AJBha1K3BIR7Cs74BlCXiiuWi358HnPGsHqqJjKVxlTKJksrRLvUr4 +K2bG1kBniQU/PkSZjB1DbSwAqw4So9BKLbzQFE8888/yETeCIEWnG2YMiRe1GB0r +P/88QJctNrsT5oLdZ9E4igcAoGna6UR71PJSFCBoJ5WsnofMf44gZr7bgg2szoZr +KDPnrlsi9SM4nWzTaxSTjEp3397QMwEHosJxwXv/Zy5QyGBDYfynaTRUVS2BwIfo +AqRdylyrbv/+3NBQxdERRjGCAigwggIkAgEBMFkwQjELMAkGA1UEBhMCU0UxETAP +BgNVBAoTCEVyaWNzc29uMSAwHgYDVQQDExdDODI2MTI0NTgxLmVyaWNzc29uLmNv +bQITAkxY3LTPyvVkS5SUobGvznBgQDAMBggqhkiG9w0CBQUAoIGiMBIGCmCGSAGG ++EUBCQIxBBMCMTkwGAYJKoZIhvcNAQkDMQsGCSqGSIb3DQEHATAfBgkqhkiG9w0B +CQQxEgQQaEUDvpv6H163UM7zAQiMvDAgBgpghkgBhvhFAQkFMRIEEN4FI8tal3of +ZTXKi1Ny2cswLwYKYIZIAYb4RQEJBzEhEx8yOUFBQjJFNTY5OUY1QjI1QTJEQUI3 +NDlGN0Q0QTFBMA0GCSqGSIb3DQEBAQUABIIBACnR54LqeHZ0u8bSErSnGupEytHK +xbfShraXl3DFPnIZYs0HUuuriw5/BhkFHBsSXO8Oqm759/UgxOjnCUD2AKHenGoK +LB0yqLGe/USBs0IkBv6lXg7HJhSDNqAPES6a5iUVIRv+M40Ldob570MKjZhERVPN +AVSHMJHKmtVTZGt/VqiVk0qqZeV9nqhaSPFyW9pQU0PKep0lFltnwCHUTZiiqHuk +SIpZFCmIgahAUcl/WrxiW4xC9L5+wBgsuaUU5LqLZwg3AFua0aaDs6NZXpSE0A43 +zm5whhmkVePjnSUUr78AoBRalsBdMkDwLoUZZ1Hhq+/WH+WW7TQ96zm+uzE= +-----END PKCS7----- + diff --git a/lib/public_key/vsn.mk b/lib/public_key/vsn.mk index b820f24d2a..72247f14d8 100644 --- a/lib/public_key/vsn.mk +++ b/lib/public_key/vsn.mk @@ -1 +1 @@ -PUBLIC_KEY_VSN = 0.19 +PUBLIC_KEY_VSN = 0.20 diff --git a/lib/reltool/doc/src/notes.xml b/lib/reltool/doc/src/notes.xml index 8aaf4cc5d3..df81418677 100644 --- a/lib/reltool/doc/src/notes.xml +++ b/lib/reltool/doc/src/notes.xml @@ -37,7 +37,24 @@ thus constitutes one section in this document. The title of each section is the version number of Reltool.</p> - <section><title>Reltool 0.6.4</title> + <section><title>Reltool 0.6.4.1</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + The encoding of the <c>notes.xml</c> file has been + changed from latin1 to utf-8 to avoid future merge + problems.</p> + <p> + Own Id: OTP-11310</p> + </item> + </list> + </section> + +</section> + +<section><title>Reltool 0.6.4</title> <section><title>Fixed Bugs and Malfunctions</title> <list> @@ -61,7 +78,7 @@ even if the application was explicitly excluded in the config. This has been changed and will only produce a warning. If the application is not explicitly excluded it - will still cause reltool to fail. Thanks to H�kan + will still cause reltool to fail. Thanks to Håkan Mattsson!</p> <p> Own Id: OTP-10988</p> diff --git a/lib/reltool/vsn.mk b/lib/reltool/vsn.mk index 412e78f49f..16ec570d22 100644 --- a/lib/reltool/vsn.mk +++ b/lib/reltool/vsn.mk @@ -1 +1 @@ -RELTOOL_VSN = 0.6.4 +RELTOOL_VSN = 0.6.4.1 diff --git a/lib/runtime_tools/doc/src/notes.xml b/lib/runtime_tools/doc/src/notes.xml index db35eba436..b334bdcac2 100644 --- a/lib/runtime_tools/doc/src/notes.xml +++ b/lib/runtime_tools/doc/src/notes.xml @@ -31,6 +31,35 @@ <p>This document describes the changes made to the Runtime_Tools application.</p> +<section><title>Runtime_Tools 1.8.12</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The process trace flag 'silent' is now allowed in call to + dbg:p/2.</p> + <p> + Own Id: OTP-11222</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Introduced functionality for inspection of system and + build configuration.</p> + <p> + Own Id: OTP-11196</p> + </item> + </list> + </section> + +</section> + <section><title>Runtime_Tools 1.8.11</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/runtime_tools/vsn.mk b/lib/runtime_tools/vsn.mk index 5faae06b53..9ee1aba29c 100644 --- a/lib/runtime_tools/vsn.mk +++ b/lib/runtime_tools/vsn.mk @@ -1 +1 @@ -RUNTIME_TOOLS_VSN = 1.8.11 +RUNTIME_TOOLS_VSN = 1.8.12 diff --git a/lib/sasl/doc/src/notes.xml b/lib/sasl/doc/src/notes.xml index 373d732e53..f42657c45e 100644 --- a/lib/sasl/doc/src/notes.xml +++ b/lib/sasl/doc/src/notes.xml @@ -30,6 +30,21 @@ </header> <p>This document describes the changes made to the SASL application.</p> +<section><title>SASL 2.3.3</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Add Fd usage in rb logging. Thanks to Eric Pailleau.</p> + <p> + Own Id: OTP-11252</p> + </item> + </list> + </section> + +</section> + <section><title>SASL 2.3.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/snmp/doc/src/notes.xml b/lib/snmp/doc/src/notes.xml index 9c61bae85a..7514c52dda 100644 --- a/lib/snmp/doc/src/notes.xml +++ b/lib/snmp/doc/src/notes.xml @@ -34,6 +34,73 @@ <section> + <title>SNMP Development Toolkit 4.24.2</title> + <p>Version 4.24.2 supports code replacement in runtime from/to + version 4.24.1, 4.24, 4.23.1 and 4.23. </p> + + <section> + <title>Improvements and new features</title> +<!-- + <p>-</p> +--> + + <list type="bulleted"> + <item> + <p>[agent] Improved documentation for the functions for + loading and unloading mibs, + see <seealso marker="snmpa#load_mibs">load_mibs</seealso> and + <seealso marker="snmpa#unload_mibs">unload_mibs</seealso> for + more info. </p> + <p>Also added new functions for loading and unloading a single mib, + see <seealso marker="snmpa#load_mib">load_mib</seealso> and + <seealso marker="snmpa#unload_mib">unload_mib</seealso> for + more info. </p> + <p>Own Id: OTP-11216</p> + </item> + + </list> + + </section> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <p>-</p> + +<!-- + <list type="bulleted"> + <item> + <p>[agent] + see <seealso marker="snmpa#load_mibs">load_mibs</seealso> and + <seealso marker="snmpa#unload_mibs">unload_mibs</seealso>. </p> + <p>Own Id: OTP-11216</p> + </item> + + </list> +--> + + </section> + + <section> + <title>Incompatibilities</title> + <p>-</p> + +<!-- + <list type="bulleted"> + <item> + <p>[manager] The old Addr-and-Port based API functions, previously + long deprecated and marked for deletion in R16B, has now been + removed. </p> + <p>Own Id: OTP-10027</p> + </item> + + </list> +--> + </section> + + </section> <!-- 4.24.2 --> + + + <section> <title>SNMP Development Toolkit 4.24.1</title> <p>Version 4.24.1 supports code replacement in runtime from/to version 4.24, 4.23.1 and 4.23. </p> @@ -147,7 +214,7 @@ <seealso marker="snmpa_mib_storage">mib storage</seealso>. At present there are three simple modules (<c>snmpa_mib_storage_ets</c>, <c>snmpa_mib_storage_dets</c> and - <c>snmpa_mib_storage_mnesia</c>) implement�ng this behaviour, + <c>snmpa_mib_storage_mnesia</c>) implementing this behaviour, provided with the app. </p> <p>A config option for the (agent) <seealso marker="snmp_config#agent_mib_storage">mib storage</seealso> diff --git a/lib/snmp/doc/src/snmpa.xml b/lib/snmp/doc/src/snmpa.xml index 7133cb08cc..a8b8d06eea 100644 --- a/lib/snmp/doc/src/snmpa.xml +++ b/lib/snmp/doc/src/snmpa.xml @@ -245,29 +245,75 @@ notification_delivery_info() = #snmpa_notification_delivery_info{} This function is used to convert to the old (pre-4.4) info format. </p> + <marker id="load_mib"></marker> + </desc> + </func> + + <func> + <name>load_mib(Mib) -> ok | {error, Reason}</name> + <name>load_mib(Agent, Mib) -> ok | {error, Reason}</name> + <fsummary>Load single MIB into the agent</fsummary> + <type> + <v>Agent = pid() | atom()</v> + <v>MibName = string()</v> + <v>Reason = already_loaded | term()</v> + </type> + <desc> + <p>Load a single <c>Mib</c> into an agent. The <c>MibName</c> + is the name of the Mib, including the path to where the compiled + mib is found. For example: </p> + <code type="none"> + Dir = code:priv_dir(my_app) ++ "/mibs/", + snmpa:load_mib(snmp_master_agent, Dir ++ "MY-MIB"). + </code> + <marker id="load_mibs"></marker> </desc> </func> <func> <name>load_mibs(Mibs) -> ok | {error, Reason}</name> - <name>load_mibs(Agent,Mibs) -> ok | {error, Reason}</name> + <name>load_mibs(Mibs, Force) -> ok | {error, Reason}</name> + <name>load_mibs(Agent, Mibs) -> ok | {error, Reason}</name> + <name>load_mibs(Agent, Mibs, Force) -> ok | {error, Reason}</name> <fsummary>Load MIBs into the agent</fsummary> <type> <v>Agent = pid() | atom()</v> <v>Mibs = [MibName]</v> + <v>Force = boolean()</v> <v>MibName = string()</v> - <v>Reason = term()</v> + <v>Reason = {'load aborted at', MibName, InternalReason}</v> + <v>InternalReason = already_loaded | term()</v> </type> <desc> - <p>Loads <c>Mibs</c> into an agent. If the agent cannot load - all MIBs, it will indicate where loading was aborted. The - <c>MibName</c> is the name of the Mib, including the path to - where the compiled mib is found. For example,</p> - <code type="none"> + <p>Load <c>Mibs</c> into an agent. If the agent cannot load all + MIBs (the default value of the <c>Force</c> argument is <c>false</c>), + it will indicate where loading was aborted. The <c>MibName</c> + is the name of the Mib, including the path to where the compiled + mib is found. For example,</p> + <code type="none"> Dir = code:priv_dir(my_app) ++ "/mibs/", snmpa:load_mibs(snmp_master_agent, [Dir ++ "MY-MIB"]). </code> + <p>If <c>Force = true</c> then the agent will continue attempting + to load each mib even after failing to load a previous mib. Use with + care. </p> + + <marker id="unload_mib"></marker> + </desc> + </func> + + <func> + <name>unload_mib(Mib) -> ok | {error, Reason}</name> + <name>unload_mib(Agent, Mib) -> ok | {error, Reason}</name> + <fsummary>Unload single MIB from the agent</fsummary> + <type> + <v>Agent = pid() | atom()</v> + <v>MibName = string()</v> + <v>Reason = not_loaded | term()</v> + </type> + <desc> + <p>Unload a single <c>Mib</c> from an agent. </p> <marker id="unload_mibs"></marker> </desc> @@ -275,16 +321,25 @@ notification_delivery_info() = #snmpa_notification_delivery_info{} <func> <name>unload_mibs(Mibs) -> ok | {error, Reason}</name> - <name>unload_mibs(Agent,Mibs) -> ok | {error, Reason}</name> + <name>unload_mibs(Mibs, Force) -> ok | {error, Reason}</name> + <name>unload_mibs(Agent, Mibs) -> ok | {error, Reason}</name> + <name>unload_mibs(Agent, Mibs, Force) -> ok | {error, Reason}</name> <fsummary>Unload MIBs from the agent</fsummary> <type> <v>Agent = pid() | atom()</v> <v>Mibs = [MibName]</v> + <v>Force = boolean()</v> <v>MibName = string()</v> + <v>Reason = {'unload aborted at', MibName, InternalReason}</v> + <v>InternalReason = not_loaded | term()</v> </type> <desc> - <p>Unloads MIBs into an agent. If it cannot unload all MIBs, - it will indicate where unloading was aborted. </p> + <p>Unload <c>Mibs</c> from an agent. If it cannot unload all MIBs + (the default value of the <c>Force</c> argument is <c>false</c>), + it will indicate where unloading was aborted. </p> + <p>If <c>Force = true</c> then the agent will continue attempting + to unload each mib even after failing to unload a previous mib. + Use with care. </p> <marker id="which_mibs"></marker> </desc> diff --git a/lib/snmp/doc/src/snmpa_mib_data.xml b/lib/snmp/doc/src/snmpa_mib_data.xml index ff07a03b98..c1ea0a91f9 100644 --- a/lib/snmp/doc/src/snmpa_mib_data.xml +++ b/lib/snmp/doc/src/snmpa_mib_data.xml @@ -380,7 +380,7 @@ <desc> <p>Perform a code-change (upgrade or downgrade). </p> <p>See - <seealso marker="gen_server">gen_server</seealso> + <seealso marker="stdlib:gen_server">gen_server</seealso> for more info regarding the <c>Vsn</c> and <c>Extra</c> arguments. </p> </desc> diff --git a/lib/snmp/src/agent/snmpa.erl b/lib/snmp/src/agent/snmpa.erl index 14b93439df..a95e41ea42 100644 --- a/lib/snmp/src/agent/snmpa.erl +++ b/lib/snmp/src/agent/snmpa.erl @@ -39,8 +39,10 @@ enum_to_int/2, enum_to_int/3, info/0, info/1, old_info_format/1, - load_mibs/1, load_mibs/2, - unload_mibs/1, unload_mibs/2, + load_mib/1, load_mib/2, + load_mibs/1, load_mibs/2, load_mibs/3, + unload_mib/1, unload_mib/2, + unload_mibs/1, unload_mibs/2, unload_mibs/3, which_mibs/0, which_mibs/1, whereis_mib/1, whereis_mib/2, dump_mibs/0, dump_mibs/1, @@ -300,19 +302,75 @@ backup(Agent, BackupDir) -> dump_mibs() -> snmpa_agent:dump_mibs(snmp_master_agent). dump_mibs(File) -> snmpa_agent:dump_mibs(snmp_master_agent, File). + +load_mib(Mib) -> + load_mib(snmp_master_agent, Mib). + +-spec load_mib(Agent :: pid() | atom(), Mib :: string()) -> + ok | {error, Reason :: already_loaded | term()}. + +load_mib(Agent, Mib) -> + case load_mibs(Agent, [Mib]) of + {error, {'load aborted at', Mib, Reason}} -> + {error, Reason}; + Else -> + Else + end. + load_mibs(Mibs) -> - load_mibs(snmp_master_agent, Mibs). + load_mibs(snmp_master_agent, Mibs, false). load_mibs(Agent, Mibs) when is_list(Mibs) -> - snmpa_agent:load_mibs(Agent, Mibs). + snmpa_agent:load_mibs(Agent, Mibs, false); +load_mibs(Mibs, Force) + when is_list(Mibs) andalso ((Force =:= true) orelse (Force =:= false)) -> + load_mibs(snmp_master_agent, Mibs, Force). + +-spec load_mibs(Agent :: pid() | atom(), + Mibs :: [MibName :: string()], + Force :: boolean()) -> + ok | {error, {'load aborted at', MibName :: string(), InternalReason :: already_loaded | term()}}. + +load_mibs(Agent, Mibs, Force) + when is_list(Mibs) andalso ((Force =:= true) orelse (Force =:= false)) -> + snmpa_agent:load_mibs(Agent, Mibs, Force). + + +unload_mib(Mib) -> + unload_mib(snmp_master_agent, Mib). + +-spec unload_mib(Agent :: pid() | atom(), Mib :: string()) -> + ok | {error, Reason :: not_loaded | term()}. + +unload_mib(Agent, Mib) -> + case unload_mibs(Agent, [Mib]) of + {error, {'unload aborted at', Mib, Reason}} -> + {error, Reason}; + Else -> + Else + end. unload_mibs(Mibs) -> - unload_mibs(snmp_master_agent, Mibs). + unload_mibs(snmp_master_agent, Mibs, false). unload_mibs(Agent, Mibs) when is_list(Mibs) -> - snmpa_agent:unload_mibs(Agent, Mibs). + snmpa_agent:unload_mibs(Agent, Mibs); +unload_mibs(Mibs, Force) + when is_list(Mibs) andalso ((Force =:= true) orelse (Force =:= false)) -> + unload_mibs(snmp_master_agent, Mibs, Force). + +-spec unload_mibs(Agent :: pid() | atom(), + Mibs :: [MibName :: string()], + Force :: boolean()) -> + ok | {error, {'unload aborted at', MibName :: string(), InternalReason :: not_loaded | term()}}. + +unload_mibs(Agent, Mibs, Force) + when is_list(Mibs) andalso ((Force =:= true) orelse (Force =:= false)) -> + snmpa_agent:unload_mibs(Agent, Mibs, Force). + which_mibs() -> which_mibs(snmp_master_agent). which_mibs(Agent) -> snmpa_agent:which_mibs(Agent). + whereis_mib(Mib) -> whereis_mib(snmp_master_agent, Mib). whereis_mib(Agent, Mib) when is_atom(Mib) -> diff --git a/lib/snmp/src/agent/snmpa_agent.erl b/lib/snmp/src/agent/snmpa_agent.erl index c267ce5a70..9bed6e554e 100644 --- a/lib/snmp/src/agent/snmpa_agent.erl +++ b/lib/snmp/src/agent/snmpa_agent.erl @@ -28,7 +28,8 @@ %% External exports -export([start_link/4, start_link/5, stop/1]). -export([subagent_set/2, - load_mibs/2, unload_mibs/2, which_mibs/1, whereis_mib/2, info/1, + load_mibs/3, unload_mibs/3, + which_mibs/1, whereis_mib/2, info/1, register_subagent/3, unregister_subagent/2, send_notification/3, register_notification_filter/5, @@ -71,7 +72,8 @@ handle_pdu/8, worker/2, worker_loop/1, do_send_trap/7, do_send_trap/8]). %% <BACKWARD-COMPAT> --export([handle_pdu/7]). +-export([handle_pdu/7, + load_mibs/2, unload_mibs/2]). %% </BACKWARD-COMPAT> -include("snmpa_internal.hrl"). @@ -528,12 +530,22 @@ subagent_set(SubAgent, Arguments) -> %% Called by administrator (not agent; deadlock would occur) +%% <BACKWARD-COMPAT> load_mibs(Agent, Mibs) -> - call(Agent, {load_mibs, Mibs}). + load_mibs(Agent, Mibs, false). +%% </BACKWARD-COMPAT> + +load_mibs(Agent, Mibs, Force) -> + call(Agent, {load_mibs, Mibs, Force}). %% Called by administrator (not agent; deadlock would occur) +%% <BACKWARD-COMPAT> unload_mibs(Agent, Mibs) -> - call(Agent, {unload_mibs, Mibs}). + unload_mibs(Agent, Mibs, false). +%% </BACKWARD-COMPAT> + +unload_mibs(Agent, Mibs, Force) -> + call(Agent, {unload_mibs, Mibs, Force}). which_mibs(Agent) -> call(Agent, which_mibs). @@ -1216,13 +1228,25 @@ handle_call({unregister_subagent, SubTreeOid}, _From, S) -> end, {reply, Reply, S}; +%% <BACKWARD-COMPAT> handle_call({load_mibs, Mibs}, _From, S) -> ?vlog("load mibs ~p", [Mibs]), {reply, snmpa_mib:load_mibs(get(mibserver), Mibs), S}; +%% </BACKWARD-COMPAT> + +handle_call({load_mibs, Mibs, Force}, _From, S) -> + ?vlog("[~w] load mibs ~p", [Force, Mibs]), + {reply, snmpa_mib:load_mibs(get(mibserver), Mibs, Force), S}; +%% <BACKWARD-COMPAT> handle_call({unload_mibs, Mibs}, _From, S) -> ?vlog("unload mibs ~p", [Mibs]), {reply, snmpa_mib:unload_mibs(get(mibserver), Mibs), S}; +%% </BACKWARD-COMPAT> + +handle_call({unload_mibs, Mibs, Force}, _From, S) -> + ?vlog("[~w] unload mibs ~p", [Force, Mibs]), + {reply, snmpa_mib:unload_mibs(get(mibserver), Mibs, Force), S}; handle_call(which_mibs, _From, S) -> ?vlog("which mibs", []), diff --git a/lib/snmp/src/agent/snmpa_mib.erl b/lib/snmp/src/agent/snmpa_mib.erl index 031309b990..5b523447c5 100644 --- a/lib/snmp/src/agent/snmpa_mib.erl +++ b/lib/snmp/src/agent/snmpa_mib.erl @@ -26,7 +26,7 @@ %% External exports -export([start_link/3, stop/1, lookup/2, next/3, which_mib/2, which_mibs/1, whereis_mib/2, - load_mibs/2, unload_mibs/2, + load_mibs/3, unload_mibs/3, register_subagent/3, unregister_subagent/2, info/1, info/2, verbosity/2, dump/1, dump/2, backup/2, @@ -39,6 +39,10 @@ which_cache_size/1 ]). +%% <BACKWARD-COMPAT> +-export([load_mibs/2, unload_mibs/2]). +%% </BACKWARD-COMPAT> + %% Internal exports -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). @@ -182,19 +186,32 @@ next(MibServer, Oid, MibView) -> %%---------------------------------------------------------------------- %% Purpose: Loads mibs into the mib process. %% Args: Mibs is a list of Filenames (compiled mibs). +%% Force is a boolean %% Returns: ok | {error, Reason} %%---------------------------------------------------------------------- + +%% <BACKWARD-COMPAT> load_mibs(MibServer, Mibs) -> - call(MibServer, {load_mibs, Mibs}). + load_mibs(MibServer, Mibs, false). +%% </BACKWARD-COMPAT> + +load_mibs(MibServer, Mibs, Force) -> + call(MibServer, {load_mibs, Mibs, Force}). %%---------------------------------------------------------------------- %% Purpose: Loads mibs into the mib process. %% Args: Mibs is a list of Filenames (compiled mibs). +%% Force is a boolean %% Returns: ok | {error, Reason} %%---------------------------------------------------------------------- +%% <BACKWARD-COMPAT> unload_mibs(MibServer, Mibs) -> - call(MibServer, {unload_mibs, Mibs}). + unload_mibs(MibServer, Mibs, false). +%% </BACKWARD-COMPAT> + +unload_mibs(MibServer, Mibs, Force) -> + call(MibServer, {unload_mibs, Mibs, Force}). %%---------------------------------------------------------------------- @@ -323,10 +340,6 @@ do_init(Prio, Mibs, Opts) -> %% Returns: {ok, NewMibData} | {'aborted at', Mib, NewData, Reason} %% Args: Operation is load_mib | unload_mib. %%---------------------------------------------------------------------- -mib_operations(Mod, Operation, Mibs, Data, MeOverride, TeOverride) -> - mib_operations(Mod, Operation, Mibs, Data, MeOverride, TeOverride, false). - - mib_operations(_Mod, _Operation, [], Data, _MeOverride, _TeOverride, _Force) -> {ok, Data}; mib_operations(Mod, Operation, [Mib|Mibs], Data0, MeOverride, TeOverride, Force) -> @@ -451,18 +464,23 @@ handle_call({next, Oid, MibView}, _From, ?vdebug("next -> Reply: ~p", [Reply]), {reply, Reply, NewState}; -handle_call({load_mibs, Mibs}, _From, +%% <BACKWARD-COMPAT> +handle_call({load_mibs, Mibs}, From, State) -> + handle_call({load_mibs, Mibs, false}, From, State); +%% </BACKWARD-COMPAT> + +handle_call({load_mibs, Mibs, Force}, _From, #state{data = Data, teo = TeOverride, meo = MeOverride, cache = Cache, data_mod = Mod} = State) -> - ?vlog("load mibs ~p",[Mibs]), + ?vlog("[~w] load mibs ~p", [Force, Mibs]), %% Invalidate cache NewCache = maybe_invalidate_cache(Cache), {NData, Reply} = case (catch mib_operations(Mod, load_mib, Mibs, Data, - MeOverride, TeOverride)) of + MeOverride, TeOverride, Force)) of {'aborted at', Mib, NewData, Reason} -> ?vlog("aborted at ~p for reason ~p",[Mib,Reason]), {NewData, {error, {'load aborted at', Mib, Reason}}}; @@ -472,19 +490,24 @@ handle_call({load_mibs, Mibs}, _From, Mod:sync(NData), {reply, Reply, State#state{data = NData, cache = NewCache}}; -handle_call({unload_mibs, Mibs}, _From, +%% <BACKWARD-COMPAT> +handle_call({unload_mibs, Mibs}, From, State) -> + handle_call({unload_mibs, Mibs, false}, From, State); +%% </BACKWARD-COMPAT> + +handle_call({unload_mibs, Mibs, Force}, _From, #state{data = Data, teo = TeOverride, meo = MeOverride, cache = Cache, data_mod = Mod} = State) -> - ?vlog("unload mibs ~p",[Mibs]), + ?vlog("[~w] unload mibs ~p", [Force, Mibs]), %% Invalidate cache NewCache = maybe_invalidate_cache(Cache), %% Unload mib(s) {NData, Reply} = case (catch mib_operations(Mod, unload_mib, Mibs, Data, - MeOverride, TeOverride)) of + MeOverride, TeOverride, Force)) of {'aborted at', Mib, NewData, Reason} -> ?vlog("aborted at ~p for reason ~p", [Mib,Reason]), {NewData, {error, {'unload aborted at', Mib, Reason}}}; diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src index 16b626111b..6edcf7e833 100644 --- a/lib/snmp/src/app/snmp.appup.src +++ b/lib/snmp/src/app/snmp.appup.src @@ -29,12 +29,22 @@ %% {add_module, snmpm_net_if_mt} [ + {"4.24.1", + [ + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_agent]}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []} + ] + }, {"4.24", [ {load_module, snmp_conf, soft_purge, soft_purge, []}, {load_module, snmp_view_based_acm_mib, soft_purge, soft_purge, [snmp_conf]}, - {update, snmpa_local_db, soft, soft_purge, soft_purge, []} + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]}, + {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_agent]}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []} ] }, {"4.23.1", [{restart_application, snmp}]}, @@ -47,12 +57,22 @@ %% {remove, {snmpm_net_if_mt, soft_purge, soft_purge}} [ + {"4.24.1", + [ + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_agent]}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []} + ] + }, {"4.24", [ {load_module, snmp_conf, soft_purge, soft_purge, []}, {load_module, snmp_view_based_acm_mib, soft_purge, soft_purge, [snmp_conf]}, - {update, snmpa_local_db, soft, soft_purge, soft_purge, []} + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]}, + {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_agent]}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []} ] }, {"4.23.1", [{restart_application, snmp}]}, diff --git a/lib/snmp/test/snmp_agent_mibs_test.erl b/lib/snmp/test/snmp_agent_mibs_test.erl index 248fe7d83e..f7dae64e3f 100644 --- a/lib/snmp/test/snmp_agent_mibs_test.erl +++ b/lib/snmp/test/snmp_agent_mibs_test.erl @@ -238,6 +238,8 @@ start_and_stop(Config) when is_list(Config) -> load_unload(suite) -> []; load_unload(Config) when is_list(Config) -> + ?DBG("load_unload -> start", []), + Prio = normal, Verbosity = log, MibDir = ?config(data_dir, Config), @@ -253,8 +255,10 @@ load_unload(Config) when is_list(Config) -> ?line ok = load_mibs(MibsPid, MibDir, ["Test2"]), ?line ok = verify_loaded_mibs(MibsPid, MibDir, ["Test2"]), - ?DBG("load_unload -> load one already loaded mib", []), - ?line {error, _} = load_mibs(MibsPid, MibDir, ["Test2"]), + ?DBG("load_unload -> try load one *already loaded* mib", []), + EMib = join(MibDir, "Test2"), + ?line {error, {'load aborted at', EMib, already_loaded}} = + load_mibs(MibsPid, MibDir, ["Test2"]), ?DBG("load_unload -> load 2 not already loaded mibs", []), ?line ok = load_mibs(MibsPid, MibDir, ["TestTrap", "TestTrapv2"]), @@ -266,7 +270,8 @@ load_unload(Config) when is_list(Config) -> ?line ok = verify_loaded_mibs(MibsPid, MibDir, ["TestTrap", "TestTrapv2"]), ?DBG("load_unload -> try unload two loaded mibs and one not loaded", []), - ?line {error, _} = unload_mibs(MibsPid, ["TestTrap","Test2","TestTrapv2"]), + ?line {error, {'unload aborted at', "Test2", not_loaded}} = + unload_mibs(MibsPid, ["TestTrap","Test2","TestTrapv2"]), ?line ok = verify_loaded_mibs(MibsPid, MibDir, ["TestTrapv2"]), ?DBG("load_unload -> unload the remaining loaded mib", []), @@ -279,6 +284,7 @@ load_unload(Config) when is_list(Config) -> ?DBG("load_unload -> stop symbolic store", []), ?line sym_stop(), + ?DBG("load_unload -> done", []), ok. @@ -691,10 +697,16 @@ mibs_info(Pid) -> load_mibs(Pid, Dir, Mibs0) -> Mibs = [join(Dir, Mib) || Mib <- Mibs0], - snmpa_mib:load_mibs(Pid, Mibs). + Res = snmpa_mib:load_mibs(Pid, Mibs), + %% ?DBG("load_mibs -> " + %% "~n Res: ~p", [Res]), + Res. unload_mibs(Pid, Mibs) -> - snmpa_mib:unload_mibs(Pid, Mibs). + Res = snmpa_mib:unload_mibs(Pid, Mibs), + %% ?DBG("unload_mibs -> " + %% "~n Res: ~p", [Res]), + Res. verify_loaded_mibs(Pid, Dir, ExpectedMibs0) -> ExpectedMibs = [join(Dir, Mib) || Mib <- ExpectedMibs0], diff --git a/lib/snmp/test/snmp_agent_test.erl b/lib/snmp/test/snmp_agent_test.erl index 0bd180513e..8a2abdcdad 100644 --- a/lib/snmp/test/snmp_agent_test.erl +++ b/lib/snmp/test/snmp_agent_test.erl @@ -553,7 +553,7 @@ init_per_suite(Config0) when is_list(Config0) -> %% Mib-dirs MibDir = snmp_test_lib:lookup(data_dir, Config2), - StdMibDir = filename:join([code:priv_dir(snmp), "mibs"]), + StdMibDir = join([code:priv_dir(snmp), "mibs"]), Config3 = [{mib_dir, MibDir}, {std_mib_dir, StdMibDir} | Config2], @@ -747,21 +747,21 @@ init_per_testcase2(Case, Config) -> CaseTopDir = snmp_test_lib:init_testcase_top_dir(Case, Config), %% Create agent top-dir(s) - AgentTopDir = filename:join([CaseTopDir, agent]), + AgentTopDir = join([CaseTopDir, agent]), ok = file:make_dir(AgentTopDir), - AgentConfDir = filename:join([AgentTopDir, config]), + AgentConfDir = join([AgentTopDir, config]), ok = file:make_dir(AgentConfDir), - AgentDbDir = filename:join([AgentTopDir, db]), + AgentDbDir = join([AgentTopDir, db]), ok = file:make_dir(AgentDbDir), - AgentLogDir = filename:join([AgentTopDir, log]), + AgentLogDir = join([AgentTopDir, log]), ok = file:make_dir(AgentLogDir), %% Create sub-agent top-dir(s) - SubAgentTopDir = filename:join([CaseTopDir, sub_agent]), + SubAgentTopDir = join([CaseTopDir, sub_agent]), ok = file:make_dir(SubAgentTopDir), %% Create manager top-dir(s) - ManagerTopDir = filename:join([CaseTopDir, manager]), + ManagerTopDir = join([CaseTopDir, manager]), ok = file:make_dir(ManagerTopDir), [{case_top_dir, CaseTopDir}, @@ -1737,19 +1737,19 @@ init_case(Config) -> load_master(Mib) -> ?DBG("load_master -> entry with" "~n Mib: ~p", [Mib]), - snmpa:unload_mibs(snmp_master_agent, [Mib]), % Unload for safety - ok = snmpa:load_mibs(snmp_master_agent, [get(mib_dir) ++ Mib]). + snmpa:unload_mib(snmp_master_agent, Mib), % Unload for safety + ok = snmpa:load_mib(snmp_master_agent, join(get(mib_dir), Mib)). load_master_std(Mib) -> ?DBG("load_master_std -> entry with" "~n Mib: ~p", [Mib]), - snmpa:unload_mibs(snmp_master_agent, [Mib]), % Unload for safety - ok = snmpa:load_mibs(snmp_master_agent, [get(std_mib_dir) ++ Mib]). + snmpa:unload_mib(snmp_master_agent, Mib), % Unload for safety + ok = snmpa:load_mib(snmp_master_agent, join(get(std_mib_dir), Mib)). unload_master(Mib) -> ?DBG("unload_master -> entry with" "~n Mib: ~p", [Mib]), - ok = snmpa:unload_mibs(snmp_master_agent, [Mib]). + ok = snmpa:unload_mib(snmp_master_agent, Mib). loaded_mibs() -> ?DBG("loaded_mibs -> entry",[]), @@ -2154,11 +2154,11 @@ subagent(Config) when is_list(Config) -> try_test(unreg_test), ?P1("Loading previous subagent mib in master and testing..."), - ?line ok = snmpa:load_mibs(MA, [MibDir ++ "Klas1"]), + ?line ok = snmpa:load_mib(MA, join(MibDir, "Klas1")), try_test(load_test), ?P1("Unloading previous subagent mib in master and testing..."), - ?line ok = snmpa:unload_mibs(MA, [MibDir ++ "Klas1"]), + ?line ok = snmpa:unload_mib(MA, join(MibDir, "Klas1")), try_test(unreg_test), ?P1("Testing register subagent..."), rpc:call(SaNode, snmp, register_subagent, @@ -2354,11 +2354,11 @@ sa_register(Config) when is_list(Config) -> ?P1("Unloading Klas1..."), ?DBG("sa_register -> unload mibs", []), - snmpa:unload_mibs(SA, [MibDir ++ "Klas1"]), + snmpa:unload_mib(SA, join(MibDir, "Klas1")), ?P1("Loading SA-MIB..."), ?DBG("sa_register -> unload mibs", []), - snmpa:load_mibs(SA, [MibDir ++ "SA-MIB"]), + snmpa:load_mib(SA, join(MibDir, "SA-MIB")), ?P1("register subagent..."), ?DBG("sa_register -> register subagent", []), @@ -2577,7 +2577,7 @@ next_across_sa(Config) when is_list(Config) -> ?line {ok, SA} = start_subagent(SaNode, ?sa, "SA-MIB"), ?P1("Loading another subagent mib (Klas1)..."), - ?line ok = snmpa:load_mibs(SA, [MibDir ++ "Klas1"]), + ?line ok = snmpa:load_mib(SA, MibDir ++ "Klas1"), ?P1("register subagent..."), rpc:call(SaNode, snmp, register_subagent, [MA, ?klas1, SA]), @@ -2589,7 +2589,7 @@ next_across_sa(Config) when is_list(Config) -> try_test(next_across_sa_test), ?P1("Unloading mib (Klas1)"), - snmpa:unload_mibs(SA, [MibDir ++ "Klas1"]), + snmpa:unload_mib(SA, join(MibDir, "Klas1")), rpc:call(SaNode, snmp, unregister_subagent, [MA, ?klas1]), try_test(unreg_test), @@ -2630,25 +2630,25 @@ undo(Config) when is_list(Config) -> ?line {ok, SA} = start_subagent(SaNode, ?sa, "SA-MIB"), ?P1("Load Klas3 & Klas4..."), - ?line ok = snmpa:load_mibs(MA, [MibDir ++ "Klas3"]), - ?line ok = snmpa:load_mibs(MA, [MibDir ++ "Klas4"]), + ?line ok = snmpa:load_mib(MA, join(MibDir, "Klas3")), + ?line ok = snmpa:load_mib(MA, join(MibDir, "Klas4")), ?P1("Testing undo phase at master agent..."), try_test(undo_test), try_test(api_test2), ?P1("Unload Klas3..."), - ?line ok = snmpa:unload_mibs(MA, [MibDir ++ "Klas3"]), + ?line ok = snmpa:unload_mib(MA, join(MibDir, "Klas3")), ?P1("Testing bad return values from instrum. funcs..."), try_test(bad_return), ?P1("Unload Klas4..."), - ?line ok = snmpa:unload_mibs(MA, [MibDir ++ "Klas4"]), + ?line ok = snmpa:unload_mib(MA, join(MibDir, "Klas4")), ?P1("Testing undo phase at subagent..."), - ?line ok = snmpa:load_mibs(SA, [MibDir ++ "Klas3"]), - ?line ok = snmpa:load_mibs(SA, [MibDir ++ "Klas4"]), + ?line ok = snmpa:load_mib(SA, join(MibDir, "Klas3")), + ?line ok = snmpa:load_mib(SA, join(MibDir, "Klas4")), ?line ok = snmpa:register_subagent(MA, ?klas3, SA), ?line ok = snmpa:register_subagent(MA, ?klas4, SA), try_test(undo_test), @@ -6246,8 +6246,8 @@ otp_4394_config(AgentConfDir, MgrDir, Ip0) -> "OTP-4394 test"), ?line case update_usm(Vsn, AgentConfDir) of true -> - ?line copy_file(filename:join(AgentConfDir, "usm.conf"), - filename:join(MgrDir, "usm.conf")), + ?line copy_file(join(AgentConfDir, "usm.conf"), + join(MgrDir, "usm.conf")), ?line update_usm_mgr(Vsn, MgrDir); false -> ?line ok @@ -6406,11 +6406,11 @@ otp8395({init, Config}) when is_list(Config) -> %% AgentDbDir = ?config(agent_db_dir, Config), - AgentMnesiaDir = filename:join([AgentDbDir, "mnesia"]), + AgentMnesiaDir = join([AgentDbDir, "mnesia"]), mnesia_init(AgentNode, AgentMnesiaDir), %% SubAgentDir = ?config(sub_agent_dir, Config), - %% SubAgentMnesiaDir = filename:join([SubAgentDir, "mnesia"]), + %% SubAgentMnesiaDir = join([SubAgentDir, "mnesia"]), %% mnesia_init(SubAgentNode, SubAgentMnesiaDir), %% ok = mnesia_create_schema(AgentNode, [AgentNode, SubAgentNode]), @@ -6540,7 +6540,7 @@ otp8395(Config) when is_list(Config) -> ?SLEEP(1000), AgentNode = ?config(agent_node, Config), AgentLogDir = ?config(agent_log_dir, Config), - OutFile = filename:join([AgentLogDir, "otp8395.txt"]), + OutFile = join([AgentLogDir, "otp8395.txt"]), {ok, LogInfo} = rpc:call(AgentNode, snmpa, log_info, []), ?DBG("otp8395 -> LogInfo: ~p", [LogInfo]), @@ -6578,7 +6578,7 @@ otp9884({init, Config}) when is_list(Config) -> %% AgentDbDir = ?config(agent_db_dir, Config), - AgentMnesiaDir = filename:join([AgentDbDir, "mnesia"]), + AgentMnesiaDir = join([AgentDbDir, "mnesia"]), mnesia_init(AgentNode, AgentMnesiaDir), mnesia_create_schema(AgentNode, [AgentNode]), @@ -6608,8 +6608,8 @@ otp9884({init, Config}) when is_list(Config) -> ManagerConfDir = ?config(manager_top_dir, Config), AgentConfDir = ?config(agent_conf_dir, Config), AgentTopDir = ?config(agent_top_dir, Config), - AgentBkpDir1 = filename:join([AgentTopDir, backup1]), - AgentBkpDir2 = filename:join([AgentTopDir, backup2]), + AgentBkpDir1 = join([AgentTopDir, backup1]), + AgentBkpDir2 = join([AgentTopDir, backup2]), ok = file:make_dir(AgentBkpDir1), ok = file:make_dir(AgentBkpDir2), AgentBkpDirs = [AgentBkpDir1, AgentBkpDir2], @@ -7104,7 +7104,7 @@ display_log(Config) -> {value, {_, Node}} -> LogDir = Dir, Mibs = [], - OutFile = filename:join(LogDir, "snmpa_log.txt"), + OutFile = join(LogDir, "snmpa_log.txt"), p("~n" "=========================" " < Audit Trail Log > " @@ -7251,6 +7251,14 @@ lists_key1search(Key, List) when is_atom(Key) -> %% regs() -> %% lists:sort(registered()). +%% ------ + +join(Parts) -> + filename:join(Parts). + +join(Dir, File) -> + filename:join(Dir, File). + %% ------ diff --git a/lib/snmp/test/snmp_agent_test_lib.erl b/lib/snmp/test/snmp_agent_test_lib.erl index 7e4b713e56..122289c28e 100644 --- a/lib/snmp/test/snmp_agent_test_lib.erl +++ b/lib/snmp/test/snmp_agent_test_lib.erl @@ -139,31 +139,31 @@ init_all(Config) when is_list(Config) -> SuiteTopDir = ?config(snmp_suite_top_dir, Config), ?DBG("init_all -> SuiteTopDir ~p", [SuiteTopDir]), - AgentDir = filename:join(SuiteTopDir, "agent/"), + AgentDir = join(SuiteTopDir, "agent/"), ?line ok = file:make_dir(AgentDir), ?DBG("init_all -> AgentDir ~p", [AgentDir]), - AgentDbDir = filename:join(AgentDir, "db/"), + AgentDbDir = join(AgentDir, "db/"), ?line ok = file:make_dir(AgentDbDir), ?DBG("init_all -> AgentDbDir ~p", [AgentDbDir]), - AgentLogDir = filename:join(AgentDir, "log/"), + AgentLogDir = join(AgentDir, "log/"), ?line ok = file:make_dir(AgentLogDir), ?DBG("init_all -> AgentLogDir ~p", [AgentLogDir]), - AgentConfDir = filename:join(AgentDir, "conf/"), + AgentConfDir = join(AgentDir, "conf/"), ?line ok = file:make_dir(AgentConfDir), ?DBG("init_all -> AgentConfDir ~p", [AgentConfDir]), - MgrDir = filename:join(SuiteTopDir, "mgr/"), + MgrDir = join(SuiteTopDir, "mgr/"), ?line ok = file:make_dir(MgrDir), ?DBG("init_all -> MgrDir ~p", [MgrDir]), - SaDir = filename:join(SuiteTopDir, "sa/"), + SaDir = join(SuiteTopDir, "sa/"), ?line ok = file:make_dir(SaDir), ?DBG("init_all -> SaDir ~p", [SaDir]), - SaDbDir = filename:join(SaDir, "db/"), + SaDbDir = join(SaDir, "db/"), ?line ok = file:make_dir(SaDbDir), ?DBG("init_all -> SaDbDir ~p", [SaDbDir]), @@ -183,11 +183,11 @@ init_all(Config) when is_list(Config) -> ?DBG("init_all -> application mnesia: set_env dir",[]), ?line application_controller:set_env(mnesia, dir, - filename:join(AgentDbDir, "Mnesia1")), + join(AgentDbDir, "Mnesia1")), ?DBG("init_all -> application mnesia: set_env dir on node ~p",[SaNode]), ?line rpc:call(SaNode, application_controller, set_env, - [mnesia, dir, filename:join(SaDir, "Mnesia2")]), + [mnesia, dir, join(SaDir, "Mnesia2")]), ?DBG("init_all -> create mnesia schema",[]), ?line ok = mnesia:create_schema([SaNode, node()]), @@ -253,7 +253,7 @@ init_case(Config) when is_list(Config) -> MibDir = ?config(mib_dir, Config), put(mib_dir, MibDir), - StdM = filename:join(code:priv_dir(snmp), "mibs") ++ "/", + StdM = join(code:priv_dir(snmp), "mibs") ++ "/", put(std_mib_dir, StdM), MgrDir = ?config(mgr_dir, Config), @@ -341,7 +341,7 @@ run(Mod, Func, Args, Opts) -> Crypto = ?CRYPTO_START(), ?DBG("run -> Crypto: ~p", [Crypto]), catch snmp_test_mgr:stop(), % If we had a running mgr from a failed case - StdM = filename:join(code:priv_dir(snmp), "mibs") ++ "/", + StdM = join(code:priv_dir(snmp), "mibs") ++ "/", Vsn = get(vsn), ?DBG("run -> config:" "~n M: ~p" @@ -763,7 +763,7 @@ start_subagent(SaNode, RegTree, Mib) -> MA = whereis(snmp_master_agent), ?DBG("start_subagent -> MA: ~p", [MA]), MibDir = get(mib_dir), - Mib1 = join(MibDir,Mib), + Mib1 = join(MibDir, Mib), Mod = snmpa_supervisor, Func = start_sub_agent, Args = [MA, RegTree, [Mib1]], @@ -800,28 +800,25 @@ mibs(StdMibDir,MibDir) -> join(MibDir, "Test2.bin"), join(MibDir, "TestTrapv2.bin")]. -join(D,F) -> - filename:join(D,F). - %% --- various mib load/unload functions --- load_master(Mib) -> ?DBG("load_master -> entry with" "~n Mib: ~p", [Mib]), - snmpa:unload_mibs(snmp_master_agent, [Mib]), % Unload for safety - ok = snmpa:load_mibs(snmp_master_agent, [get(mib_dir) ++ Mib]). + snmpa:unload_mib(snmp_master_agent, Mib), % Unload for safety + ok = snmpa:load_mib(snmp_master_agent, join(get(mib_dir), Mib)). load_master_std(Mib) -> ?DBG("load_master_std -> entry with" "~n Mib: ~p", [Mib]), - snmpa:unload_mibs(snmp_master_agent, [Mib]), % Unload for safety - ok = snmpa:load_mibs(snmp_master_agent, [get(std_mib_dir) ++ Mib]). + snmpa:unload_mib(snmp_master_agent, Mib), % Unload for safety + ok = snmpa:load_mibs(snmp_master_agent, join(get(std_mib_dir), Mib)). unload_master(Mib) -> ?DBG("unload_master -> entry with" "~n Mib: ~p", [Mib]), - ok = snmpa:unload_mibs(snmp_master_agent, [Mib]). + ok = snmpa:unload_mib(snmp_master_agent, Mib). loaded_mibs() -> ?DBG("loaded_mibs -> entry",[]), @@ -1383,8 +1380,8 @@ config(Vsns, MgrDir, AgentConfDir, MIp, AIp) -> "test"), ?line case update_usm(Vsns, AgentConfDir) of true -> - ?line copy_file(filename:join(AgentConfDir, "usm.conf"), - filename:join(MgrDir, "usm.conf")), + ?line copy_file(join(AgentConfDir, "usm.conf"), + join(MgrDir, "usm.conf")), ?line update_usm_mgr(Vsns, MgrDir); false -> ?line ok @@ -1403,9 +1400,9 @@ delete_files(Config) -> delete_files(_AgentFiles, []) -> ok; delete_files(AgentDir, [DirName|DirNames]) -> - Dir = filename:join(AgentDir, DirName), + Dir = join(AgentDir, DirName), {ok, Files} = file:list_dir(Dir), - lists:foreach(fun(FName) -> file:delete(filename:join(Dir, FName)) end, + lists:foreach(fun(FName) -> file:delete(join(Dir, FName)) end, Files), delete_files(AgentDir, DirNames). @@ -1481,8 +1478,8 @@ update_usm_mgr(Vsns, Dir) -> end. rewrite_usm_mgr(Dir, ShaKey, DesKey) -> - ?line ok = file:rename(filename:join(Dir,"usm.conf"), - filename:join(Dir,"usm.old")), + ?line ok = file:rename(join(Dir,"usm.conf"), + join(Dir,"usm.old")), Conf = [{"agentEngine", "newUser", "newUser", zeroDotZero, usmHMACSHAAuthProtocol, "", "", usmDESPrivProtocol, "", "", "", ShaKey, DesKey}, @@ -1492,8 +1489,8 @@ rewrite_usm_mgr(Dir, ShaKey, DesKey) -> ok = snmp_config:write_agent_usm_config(Dir, "", Conf). reset_usm_mgr(Dir) -> - ?line ok = file:rename(filename:join(Dir,"usm.old"), - filename:join(Dir,"usm.conf")). + ?line ok = file:rename(join(Dir,"usm.old"), + join(Dir,"usm.conf")). update_community([v3], _Dir) -> @@ -1526,7 +1523,7 @@ write_target_addr_conf(Dir, ManagerIp, UDP, Vsns) -> rewrite_target_addr_conf(Dir, NewPort) -> ?DBG("rewrite_target_addr_conf -> entry with" "~n NewPort: ~p", [NewPort]), - TAFile = filename:join(Dir, "target_addr.conf"), + TAFile = join(Dir, "target_addr.conf"), case file:read_file_info(TAFile) of {ok, _} -> ok; @@ -1546,8 +1543,8 @@ rewrite_target_addr_conf(Dir, NewPort) -> ?DBG("rewrite_target_addr_conf -> NewAddrs: ~p",[NewAddrs]), - ?line ok = file:rename(filename:join(Dir,"target_addr.conf"), - filename:join(Dir,"target_addr.old")), + ?line ok = file:rename(join(Dir,"target_addr.conf"), + join(Dir,"target_addr.old")), ?line ok = snmp_config:write_agent_target_addr_config(Dir, "", NewAddrs). @@ -1565,8 +1562,8 @@ rewrite_target_addr_conf2(_NewPort,O) -> O. reset_target_addr_conf(Dir) -> - ?line ok = file:rename(filename:join(Dir, "target_addr.old"), - filename:join(Dir, "target_addr.conf")). + ?line ok = file:rename(join(Dir, "target_addr.old"), + join(Dir, "target_addr.conf")). write_target_params_conf(Dir, Vsns) -> F = fun(v1) -> {"target_v1", v1, v1, "all-rights", noAuthNoPriv}; @@ -1578,14 +1575,14 @@ write_target_params_conf(Dir, Vsns) -> rewrite_target_params_conf(Dir, SecName, SecLevel) when is_list(SecName) andalso is_atom(SecLevel) -> - ?line ok = file:rename(filename:join(Dir,"target_params.conf"), - filename:join(Dir,"target_params.old")), + ?line ok = file:rename(join(Dir,"target_params.conf"), + join(Dir,"target_params.old")), Conf = [{"target_v3", v3, usm, SecName, SecLevel}], snmp_config:write_agent_target_params_config(Dir, "", Conf). reset_target_params_conf(Dir) -> - ?line ok = file:rename(filename:join(Dir,"target_params.old"), - filename:join(Dir,"target_params.conf")). + ?line ok = file:rename(join(Dir,"target_params.old"), + join(Dir,"target_params.conf")). write_notify_conf(Dir) -> Conf = [{"standard trap", "std_trap", trap}, @@ -1648,6 +1645,9 @@ rpc(Node, F, A) -> rpc:call(Node, snmpa, F, A). +join(Dir, File) -> + filename:join(Dir, File). + %% await_pdu(To) -> %% await_response(To, pdu). %% diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk index e987649e11..2164121e86 100644 --- a/lib/snmp/vsn.mk +++ b/lib/snmp/vsn.mk @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = snmp -SNMP_VSN = 4.24.1 +SNMP_VSN = 4.24.2 PRE_VSN = APP_VSN = "$(APPLICATION)-$(SNMP_VSN)$(PRE_VSN)" diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index 6b7ff7b238..041f5e54af 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -29,6 +29,41 @@ <file>notes.xml</file> </header> +<section><title>Ssh 2.1.8</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Do not chmod ~/.ssh unnecessarily.</p> + <p> + Own Id: OTP-11189</p> + </item> + <item> + <p> + Make ssh_cli.erl handle CTRL+C. Thanks to Stefan + Zegenhagen.</p> + <p> + Own Id: OTP-11199</p> + </item> + <item> + <p> + Clarified timeout options in documentation.</p> + <p> + Own Id: OTP-11249</p> + </item> + <item> + <p> + Add openssh_zlib compression type to ssh_transport. + Thanks to Louis-Philippe Gauthier.</p> + <p> + Own Id: OTP-11256</p> + </item> + </list> + </section> + +</section> + <section><title>Ssh 2.1.7</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index eb997a8eb5..1e361a4d64 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -141,7 +141,7 @@ <p>Sets the preferred public key algorithm to use for user authentication. If the the preferred algorithm fails for some reason, the other algorithm is tried. The default is - to try <c><![CDATA[ssh_rsa]]></c> first.</p> + to try <c><![CDATA['ssh-rsa']]></c> first.</p> </item> <tag><c><![CDATA[{pref_public_key_algs, list()}]]></c></tag> <item> @@ -248,7 +248,7 @@ requested by the client. Default is to use the erlang shell: <c><![CDATA[{shell, start, []}]]></c> </item> - <tag><c><![CDATA[{ssh_cli,{channel_callback(), + <tag><c><![CDATA[{ssh_cli, {channel_callback(), channel_init_args()}}]]></c></tag> <item> Provides your own cli implementation, i.e. a channel callback diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 231779b75a..90f09471c9 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 2.1.7 +SSH_VSN = 2.1.8 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index fb6b45c904..692d7fd0e1 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -25,7 +25,69 @@ <file>notes.xml</file> </header> <p>This document describes the changes made to the SSL application.</p> - <section><title>SSL 5.3</title> + <section><title>SSL 5.3.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Setopts during renegotiation caused the renegotiation to + be unsuccessful.</p> + <p> + If calling setopts during a renegotiation the FSM state + might change during the handling of the setopts messages, + this is now handled correctly.</p> + <p> + Own Id: OTP-11228</p> + </item> + <item> + <p> + Now handles signature_algorithm field in digitally_signed + properly with proper defaults. Prior to this change some + elliptic curve cipher suites could fail reporting the + error "bad certificate".</p> + <p> + Own Id: OTP-11229</p> + </item> + <item> + <p> + The code emulating the inet header option was changed in + the belief that it made it inet compatible. However the + testing is a bit hairy as the inet option is actually + broken, now the tests are corrected and the header option + should work in the same broken way as inet again, + preferably use the bitsyntax instead.</p> + <p> + Own Id: OTP-11230</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Make the ssl manager name for erlang distribution over + SSL/TLS relative to the module name of the ssl_manager.</p> + <p> + This can be beneficial when making tools that rename + modules for internal processing in the tool.</p> + <p> + Own Id: OTP-11255</p> + </item> + <item> + <p> + Add documentation regarding log_alert option.</p> + <p> + Own Id: OTP-11271</p> + </item> + </list> + </section> + +</section> + +<section><title>SSL 5.3</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile index cf9f7d5001..6744e2f256 100644 --- a/lib/ssl/src/Makefile +++ b/lib/ssl/src/Makefile @@ -58,15 +58,18 @@ MODULES= \ ssl_connection_sup \ tls_handshake \ dtls_handshake\ + ssl_handshake\ ssl_manager \ ssl_session \ ssl_session_cache \ ssl_socket \ tls_record \ dtls_record \ - ssl_ssl2 \ - ssl_ssl3 \ - ssl_tls1 \ + ssl_record \ + ssl_v2 \ + ssl_v3 \ + tls_v1 \ + dtls_v1 \ ssl_tls_dist_proxy INTERNAL_HRL_FILES = \ diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index ac2ee0d09f..fda488501c 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -17,3 +17,325 @@ %% %CopyrightEnd% %% -module(dtls_connection). + +%%-behaviour(gen_fsm). + +%% -include("dtls_handshake.hrl"). +%% -include("ssl_alert.hrl"). +%% -include("dtls_record.hrl"). +%% -include("ssl_cipher.hrl"). +%% -include("ssl_internal.hrl"). +%% -include("ssl_srp.hrl"). +%% -include_lib("public_key/include/public_key.hrl"). + + +%% %% Called by dtls_connection_sup +%% %%-export([start_link/7]). + +%% %% gen_fsm callbacks +%% -export([init/1, hello/2, certify/2, cipher/2, +%% abbreviated/2, connection/2, handle_event/3, +%% handle_sync_event/4, handle_info/3, terminate/3, code_change/4]). + +%% -record(message_sequences, { +%% read = 0, +%% write = 0 +%% }). + +%% -record(state, { +%% role, % client | server +%% user_application, % {MonitorRef, pid()} +%% transport_cb, % atom() - callback module +%% data_tag, % atom() - ex tcp. +%% close_tag, % atom() - ex tcp_closed +%% error_tag, % atom() - ex tcp_error +%% host, % string() | ipadress() +%% port, % integer() +%% socket, % socket() +%% ssl_options, % #ssl_options{} +%% socket_options, % #socket_options{} +%% connection_states, % #connection_states{} from ssl_record.hrl +%% message_sequences = #message_sequences{}, +%% dtls_packets = [], % Not yet handled decode ssl/tls packets. +%% dtls_record_buffer, % binary() buffer of incomplete records +%% dtls_handshake_buffer, % binary() buffer of incomplete handshakes +%% dtls_handshake_history, % tls_handshake_history() +%% dtls_cipher_texts, % list() received but not deciphered yet +%% cert_db, % +%% session, % #session{} from tls_handshake.hrl +%% session_cache, % +%% session_cache_cb, % +%% negotiated_version, % tls_version() +%% client_certificate_requested = false, +%% key_algorithm, % atom as defined by cipher_suite +%% hashsign_algorithm, % atom as defined by cipher_suite +%% public_key_info, % PKIX: {Algorithm, PublicKey, PublicKeyParams} +%% private_key, % PKIX: #'RSAPrivateKey'{} +%% diffie_hellman_params, % PKIX: #'DHParameter'{} relevant for server side +%% diffie_hellman_keys, % {PublicKey, PrivateKey} +%% psk_identity, % binary() - server psk identity hint +%% srp_params, % #srp_user{} +%% srp_keys, % {PublicKey, PrivateKey} +%% premaster_secret, % +%% file_ref_db, % ets() +%% cert_db_ref, % ref() +%% bytes_to_read, % integer(), # bytes to read in passive mode +%% user_data_buffer, % binary() +%% log_alert, % boolean() +%% renegotiation, % {boolean(), From | internal | peer} +%% start_or_recv_from, % "gen_fsm From" +%% timer, % start_or_recv_timer +%% send_queue, % queue() +%% terminated = false, % +%% allow_renegotiate = true, +%% expecting_next_protocol_negotiation = false :: boolean(), +%% next_protocol = undefined :: undefined | binary(), +%% client_ecc, % {Curves, PointFmt} +%% client_cookie = <<>> +%% }). + + + +%% %%==================================================================== +%% %% Internal application API +%% %%==================================================================== + + +%% %%==================================================================== +%% %% State functions +%% %%==================================================================== + +%% -spec hello(start | #hello_request{} | #client_hello{} | #server_hello{} | term(), +%% #state{}) -> gen_fsm_state_return(). +%% %%-------------------------------------------------------------------- +%% hello(start, #state{host = Host, port = Port, role = client, +%% ssl_options = SslOpts, +%% session = #session{own_certificate = Cert} = Session0, +%% session_cache = Cache, session_cache_cb = CacheCb, +%% connection_states = ConnectionStates0, +%% renegotiation = {Renegotiation, _}, +%% client_cookie = Cookie} = State0) -> +%% Hello = dtls_handshake:client_hello(Host, Port, Cookie, ConnectionStates0, SslOpts, +%% Cache, CacheCb, Renegotiation, Cert), + +%% Version = Hello#client_hello.client_version, +%% State1 = State0#state{negotiated_version = Version, %% Requested version +%% session = +%% Session0#session{session_id = Hello#client_hello.session_id}, +%% dtls_handshake_history = ssl_handshake:init_handshake_history()}, + +%% State2 = send_flight(Hello, waiting, State1), + +%% {Record, State} = next_record(State2), +%% next_state(hello, hello, Record, State); + +%% hello(start, #state{role = server} = State0) -> +%% {Record, State} = next_record(State0), +%% next_state(hello, hello, Record, State); + +%% hello(#hello_request{}, #state{role = client} = State0) -> +%% {Record, State} = next_record(State0), +%% next_state(hello, hello, Record, State); + +%% hello(#server_hello{cipher_suite = CipherSuite, +%% compression_method = Compression} = Hello, +%% #state{session = #session{session_id = OldId}, +%% connection_states = ConnectionStates0, +%% role = client, +%% negotiated_version = ReqVersion, +%% renegotiation = {Renegotiation, _}, +%% ssl_options = SslOptions} = State1) -> +%% State0 = flight_done(State1), +%% case ssl_handshake:hello(Hello, SslOptions, ConnectionStates0, Renegotiation) of +%% #alert{} = Alert -> +%% handle_own_alert(Alert, ReqVersion, hello, State0); +%% {Version, NewId, ConnectionStates, NextProtocol} -> +%% {KeyAlgorithm, _, _, _} = +%% ssl_cipher:suite_definition(CipherSuite), + +%% PremasterSecret = make_premaster_secret(ReqVersion, KeyAlgorithm), + +%% NewNextProtocol = case NextProtocol of +%% undefined -> +%% State0#state.next_protocol; +%% _ -> +%% NextProtocol +%% end, + +%% State = State0#state{key_algorithm = KeyAlgorithm, +%% hashsign_algorithm = default_hashsign(Version, KeyAlgorithm), +%% negotiated_version = Version, +%% connection_states = ConnectionStates, +%% premaster_secret = PremasterSecret, +%% expecting_next_protocol_negotiation = NextProtocol =/= undefined, +%% next_protocol = NewNextProtocol}, + +%% case ssl_session:is_new(OldId, NewId) of +%% true -> +%% handle_new_session(NewId, CipherSuite, Compression, +%% State#state{connection_states = ConnectionStates}); +%% false -> +%% handle_resumed_session(NewId, State#state{connection_states = ConnectionStates}) +%% end +%% end; + +%% hello(#hello_verify_request{cookie = Cookie}, +%% #state{host = Host, port = Port, +%% session = #session{own_certificate = Cert}, +%% session_cache = Cache, session_cache_cb = CacheCb, +%% ssl_options = SslOpts, +%% connection_states = ConnectionStates0, +%% renegotiation = {Renegotiation, _}} = State0) -> +%% Hello = ssl_handshake:client_hello(Host, Port, Cookie, ConnectionStates0, SslOpts, +%% Cache, CacheCb, Renegotiation, Cert), +%% State1 = State0#state{ +%% tls_handshake_history = ssl_handshake:init_handshake_history(), +%% client_cookie = Cookie}, +%% State2 = send_flight(Hello, waiting, State1), + +%% {Record, State} = next_record(State2), +%% next_state(hello, hello, Record, State); + +%% hello(Hello = #client_hello{client_version = ClientVersion}, +%% State = #state{connection_states = ConnectionStates0, +%% port = Port, session = #session{own_certificate = Cert} = Session0, +%% renegotiation = {Renegotiation, _}, +%% session_cache = Cache, +%% session_cache_cb = CacheCb, +%% ssl_options = SslOpts}) -> +%% case ssl_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb, +%% ConnectionStates0, Cert}, Renegotiation) of +%% {Version, {Type, Session}, ConnectionStates, ProtocolsToAdvertise, +%% EcPointFormats, EllipticCurves} -> +%% do_server_hello(Type, ProtocolsToAdvertise, +%% EcPointFormats, EllipticCurves, +%% State#state{connection_states = ConnectionStates, +%% negotiated_version = Version, +%% session = Session, +%% client_ecc = {EllipticCurves, EcPointFormats}}); +%% #alert{} = Alert -> +%% handle_own_alert(Alert, ClientVersion, hello, State) +%% end; + +%% hello(timeout, State) -> +%% { next_state, hello, State, hibernate }; + +%% hello(Msg, State) -> +%% handle_unexpected_message(Msg, hello, State). +%% %%-------------------------------------------------------------------- +%% -spec abbreviated(#hello_request{} | #finished{} | term(), +%% #state{}) -> gen_fsm_state_return(). +%% %%-------------------------------------------------------------------- + +%% abbreviated(timeout, State) -> +%% { next_state, abbreviated, State, hibernate }; + +%% abbreviated(Msg, State) -> +%% handle_unexpected_message(Msg, abbreviated, State). + +%% %%-------------------------------------------------------------------- +%% -spec certify(#hello_request{} | #certificate{} | #server_key_exchange{} | +%% #certificate_request{} | #server_hello_done{} | #client_key_exchange{} | term(), +%% #state{}) -> gen_fsm_state_return(). +%% %%-------------------------------------------------------------------- + + +%% certify(timeout, State) -> +%% { next_state, certify, State, hibernate }; + +%% certify(Msg, State) -> +%% handle_unexpected_message(Msg, certify, State). + + +%% %%-------------------------------------------------------------------- +%% -spec cipher(#hello_request{} | #certificate_verify{} | #finished{} | term(), +%% #state{}) -> gen_fsm_state_return(). +%% %%-------------------------------------------------------------------- + +%% cipher(timeout, State) -> +%% { next_state, cipher, State, hibernate }; + +%% cipher(Msg, State) -> +%% handle_unexpected_message(Msg, cipher, State). + +%% %%-------------------------------------------------------------------- +%% -spec connection(#hello_request{} | #client_hello{} | term(), +%% #state{}) -> gen_fsm_state_return(). +%% %%-------------------------------------------------------------------- + +%% connection(timeout, State) -> +%% {next_state, connection, State, hibernate}; + +%% connection(Msg, State) -> +%% handle_unexpected_message(Msg, connection, State). + +%% %%-------------------------------------------------------------------- +%% %%% Internal functions +%% %%-------------------------------------------------------------------- +%% handle_unexpected_message(Msg, Info, #state{negotiated_version = Version} = State) -> +%% Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), +%% handle_own_alert(Alert, Version, {Info, Msg}, State). + +%% send_flight(HandshakeRec, FlightState, State) -> +%% send_flight(FlightState, buffer_flight(HandshakeRec, State)). + +%% send_flight(FlightState, State = #state{negotiated_version = Version, +%% flight_buffer = Buffer}) -> + +%% State1 = do_send_flight(queue:to_list(Buffer), [], State), +%% finish_send_flight(Version, FlightState, State1). + +%% resend_flight(State = #state{negotiated_version = Version, +%% flight_state = FlightState, +%% flight_buffer = Buffer}) +%% when FlightState == finished; FlightState == waiting -> +%% State1 = do_send_flight(queue:to_list(Buffer), [], State), +%% finish_send_flight(Version, FlightState, State1); + +%% resend_flight(State) -> +%% State. + +%% flight_done(State) -> +%% cancel_dtls_retransmit_timer(State#state{flight_state = done, +%% flight_buffer = undefined}). + +%% do_send_flight([], BinMsgs, State = #state{transport_cb = Transport, socket = Socket}) -> +%% Transport:send(Socket, lists:reverse(BinMsgs)), +%% State; +%% do_send_flight([{Epoch, MsgSeq, HandshakeRec}|T], BinMsgs0, +%% State = #state{negotiated_version = Version, +%% connection_states = ConnectionStates0}) -> +%% CS0 = ssl_record:connection_state_by_epoch(ConnectionStates0, Epoch, write), +%% {BinMsgs, CS1} = encode_handshake_rec(HandshakeRec, Version, MsgSeq, BinMsgs0, CS0), +%% ConnectionStates1 = ssl_record:set_connection_state_by_epoch(ConnectionStates0, CS1, write), +%% do_send_flight(T, BinMsgs, State#state{connection_states = ConnectionStates1}). + +%% cancel_dtls_retransmit_timer(State = #state{dtls_retransmit_timer = TimerRef}) -> +%% cancel_timer(TimerRef), +%% State#state{dtls_retransmit_timer = undefined}. + +%% rearm_dtls_retransmit_timer(State = #state{dtls_retransmit_timer = undefined}) -> +%% TimerRef = erlang:start_timer(1000, self(), dtls_retransmit), +%% State#state{dtls_retransmit_timer = TimerRef}; +%% rearm_dtls_retransmit_timer(State) -> +%% State. + +%% finish_send_flight({254, _}, waiting, State) -> +%% TimerRef = erlang:start_timer(1000, self(), dtls_retransmit), +%% State#state{ +%% dtls_retransmit_timer = TimerRef, +%% last_retransmit = timestamp(), +%% flight_state = waiting}; + +%% finish_send_flight(_, FlightState, State) -> +%% State#state{flight_state = FlightState}. + +%% timestamp() -> +%% {Mega, Sec, Micro} = erlang:now(), +%% Mega * 1000000 * 1000 + Sec * 1000 + (Micro div 1000). + +%% encode_handshake_rec(HandshakeRec, Version, MsgSeq, BinMsgs0, CS0) -> +%% {_, Fragments} = ssl_handshake:encode_handshake(HandshakeRec, Version, MsgSeq, 1400), +%% lists:foldl(fun(F, {Bin, C0}) -> +%% {B, C1} = ssl_record:encode_handshake(F, Version, C0), +%% {[B|Bin], C1} end, {BinMsgs0, CS0}, Fragments). diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl index b25daa59d9..26e8ce7503 100644 --- a/lib/ssl/src/dtls_handshake.erl +++ b/lib/ssl/src/dtls_handshake.erl @@ -16,3 +16,413 @@ %% %% %CopyrightEnd% -module(dtls_handshake). + +-include("dtls_handshake.hrl"). +-include("dtls_record.hrl"). +-include("ssl_internal.hrl"). + +-export([client_hello/9, hello/3, get_dtls_handshake/2, + dtls_handshake_new_flight/1, dtls_handshake_new_epoch/1, + encode_handshake/4]). + +%%==================================================================== +%% Internal application API +%%==================================================================== + +%%-------------------------------------------------------------------- +-spec client_hello(host(), inet:port_number(), term(), #connection_states{}, + #ssl_options{}, integer(), atom(), boolean(), der_cert()) -> + #client_hello{}. +%% +%% Description: Creates a client hello message. +%%-------------------------------------------------------------------- +client_hello(Host, Port, Cookie, ConnectionStates, + #ssl_options{versions = Versions, + ciphers = UserSuites + } = SslOpts, + Cache, CacheCb, Renegotiation, OwnCert) -> + Version = dtls_record:highest_protocol_version(Versions), + Pending = ssl_record:pending_connection_state(ConnectionStates, read), + SecParams = Pending#connection_state.security_parameters, + CipherSuites = ssl_handshake:available_suites(UserSuites, Version), + + Extensions = ssl_handshake:client_hello_extensions(Version, CipherSuites, + SslOpts, ConnectionStates, Renegotiation), + + Id = ssl_session:client_id({Host, Port, SslOpts}, Cache, CacheCb, OwnCert), + + #client_hello{session_id = Id, + client_version = Version, + cipher_suites = ssl_handshake:cipher_suites(CipherSuites, Renegotiation), + compression_methods = ssl_record:compressions(), + random = SecParams#security_parameters.client_random, + cookie = Cookie, + extensions = Extensions + }. + +hello(Address, Port, + #ssl_tls{epoch = _Epoch, record_seq = _Seq, + version = Version} = Record) -> + {[{Hello, _}], _, _} = + get_dtls_handshake(Record, + dtls_handshake_new_flight(undefined)), + #client_hello{client_version = {Major, Minor}, + random = Random, + session_id = SessionId, + cipher_suites = CipherSuites, + compression_methods = CompressionMethods} = Hello, + CookieData = [address_to_bin(Address, Port), + <<?BYTE(Major), ?BYTE(Minor)>>, + Random, SessionId, CipherSuites, CompressionMethods], + Cookie = crypto:hmac(sha, <<"secret">>, CookieData), + + case Hello of + #client_hello{cookie = Cookie} -> + accept; + _ -> + %% generate HelloVerifyRequest + HelloVerifyRequest = encode_handshake(#hello_verify_request{protocol_version = Version, + cookie = Cookie}, + Version, 0, 1400), + {reply, HelloVerifyRequest} + end. + +address_to_bin({A,B,C,D}, Port) -> + <<0:80,16#ffff:16,A,B,C,D,Port:16>>; +address_to_bin({A,B,C,D,E,F,G,H}, Port) -> + <<A:16,B:16,C:16,D:16,E:16,F:16,G:16,H:16,Port:16>>. + +%%-------------------------------------------------------------------- +encode_handshake(Package, Version, MsgSeq, Mss) -> + {MsgType, Bin} = enc_hs(Package, Version), + Len = byte_size(Bin), + HsHistory = [MsgType, ?uint24(Len), ?uint16(MsgSeq), ?uint24(0), ?uint24(Len), Bin], + BinMsg = dtls_split_handshake(Mss, MsgType, Len, MsgSeq, Bin, 0, []), + {HsHistory, BinMsg}. + +%-------------------------------------------------------------------- +-spec get_dtls_handshake(#ssl_tls{}, #dtls_hs_state{} | binary()) -> + {[dtls_handshake()], #ssl_tls{}}. +% +% Description: Given a DTLS state and new data from ssl_record, collects +% and returns it as a list of handshake messages, also returns a new +% DTLS state +%-------------------------------------------------------------------- +% get_dtls_handshake(Record, <<>>) -> +% get_dtls_handshake_aux(Record, dtls_hs_state_init()); +get_dtls_handshake(Record, HsState) -> + get_dtls_handshake_aux(Record, HsState). + +%-------------------------------------------------------------------- +-spec dtls_handshake_new_epoch(#dtls_hs_state{}) -> #dtls_hs_state{}. +% +% Description: Reset the DTLS decoder state for a new Epoch +%-------------------------------------------------------------------- +% dtls_handshake_new_epoch(<<>>) -> +% dtls_hs_state_init(); +dtls_handshake_new_epoch(HsState) -> + HsState#dtls_hs_state{highest_record_seq = 0, + starting_read_seq = HsState#dtls_hs_state.current_read_seq, + fragments = gb_trees:empty(), completed = []}. + +%-------------------------------------------------------------------- +-spec dtls_handshake_new_flight(integer() | undefined) -> #dtls_hs_state{}. +% +% Description: Init the DTLS decoder state for a new Flight +dtls_handshake_new_flight(ExpectedReadReq) -> + #dtls_hs_state{current_read_seq = ExpectedReadReq, + highest_record_seq = 0, + starting_read_seq = 0, + fragments = gb_trees:empty(), completed = []}. + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- + +dtls_split_handshake(Mss, MsgType, Len, MsgSeq, Bin, Offset, Acc) + when byte_size(Bin) + 12 < Mss -> + FragmentLen = byte_size(Bin), + BinMsg = [MsgType, ?uint24(Len), ?uint16(MsgSeq), ?uint24(Offset), ?uint24(FragmentLen), Bin], + lists:reverse([BinMsg|Acc]); +dtls_split_handshake(Mss, MsgType, Len, MsgSeq, Bin, Offset, Acc) -> + FragmentLen = Mss - 12, + <<Fragment:FragmentLen/bytes, Rest/binary>> = Bin, + BinMsg = [MsgType, ?uint24(Len), ?uint16(MsgSeq), ?uint24(Offset), ?uint24(FragmentLen), Fragment], + dtls_split_handshake(Mss, MsgType, Len, MsgSeq, Rest, Offset + FragmentLen, [BinMsg|Acc]). + +get_dtls_handshake_aux(#ssl_tls{version = Version, + record_seq = SeqNo, + fragment = Data}, HsState) -> + get_dtls_handshake_aux(Version, SeqNo, Data, HsState). + +get_dtls_handshake_aux(Version, SeqNo, + <<?BYTE(Type), ?UINT24(Length), + ?UINT16(MessageSeq), + ?UINT24(FragmentOffset), ?UINT24(FragmentLength), + Body:FragmentLength/binary, Rest/binary>>, + HsState0) -> + case reassemble_dtls_fragment(SeqNo, Type, Length, MessageSeq, + FragmentOffset, FragmentLength, + Body, HsState0) of + {retransmit, HsState1} -> + case Rest of + <<>> -> + {retransmit, HsState1}; + _ -> + get_dtls_handshake_aux(Version, SeqNo, Rest, HsState1) + end; + {HsState1, HighestSeqNo, MsgBody} -> + HsState2 = dec_dtls_fragment(Version, HighestSeqNo, Type, Length, MessageSeq, MsgBody, HsState1), + HsState3 = process_dtls_fragments(Version, HsState2), + get_dtls_handshake_aux(Version, SeqNo, Rest, HsState3); + HsState2 -> + HsState3 = process_dtls_fragments(Version, HsState2), + get_dtls_handshake_aux(Version, SeqNo, Rest, HsState3) + end; + +get_dtls_handshake_aux(_Version, _SeqNo, <<>>, HsState) -> + {lists:reverse(HsState#dtls_hs_state.completed), + HsState#dtls_hs_state.highest_record_seq, + HsState#dtls_hs_state{completed = []}}. + +dec_dtls_fragment(Version, SeqNo, Type, Length, MessageSeq, MsgBody, + HsState = #dtls_hs_state{highest_record_seq = HighestSeqNo, completed = Acc}) -> + Raw = <<?BYTE(Type), ?UINT24(Length), ?UINT16(MessageSeq), ?UINT24(0), ?UINT24(Length), MsgBody/binary>>, + H = decode_handshake(Version, Type, MsgBody), + HsState#dtls_hs_state{completed = [{H,Raw}|Acc], highest_record_seq = erlang:max(HighestSeqNo, SeqNo)}. + +process_dtls_fragments(Version, + HsState0 = #dtls_hs_state{current_read_seq = CurrentReadSeq, + fragments = Fragments0}) -> + case gb_trees:is_empty(Fragments0) of + true -> + HsState0; + _ -> + case gb_trees:smallest(Fragments0) of + {CurrentReadSeq, {SeqNo, Type, Length, CurrentReadSeq, {Length, [{0, Length}], MsgBody}}} -> + HsState1 = dtls_hs_state_process_seq(HsState0), + HsState2 = dec_dtls_fragment(Version, SeqNo, Type, Length, CurrentReadSeq, MsgBody, HsState1), + process_dtls_fragments(Version, HsState2); + _ -> + HsState0 + end + end. + +dtls_hs_state_process_seq(HsState0 = #dtls_hs_state{current_read_seq = CurrentReadSeq, + fragments = Fragments0}) -> + Fragments1 = gb_trees:delete_any(CurrentReadSeq, Fragments0), + HsState0#dtls_hs_state{current_read_seq = CurrentReadSeq + 1, + fragments = Fragments1}. + +dtls_hs_state_add_fragment(MessageSeq, Fragment, HsState0 = #dtls_hs_state{fragments = Fragments0}) -> + Fragments1 = gb_trees:enter(MessageSeq, Fragment, Fragments0), + HsState0#dtls_hs_state{fragments = Fragments1}. + +reassemble_dtls_fragment(SeqNo, Type, Length, MessageSeq, 0, Length, + Body, HsState0 = #dtls_hs_state{current_read_seq = undefined}) + when Type == ?CLIENT_HELLO; + Type == ?SERVER_HELLO; + Type == ?HELLO_VERIFY_REQUEST -> + %% First message, should be client hello + %% return the current message and set the next expected Sequence + %% + %% Note: this could (should?) be restricted further, ClientHello and + %% HelloVerifyRequest have to have message_seq = 0, ServerHello + %% can have a message_seq of 0 or 1 + %% + {HsState0#dtls_hs_state{current_read_seq = MessageSeq + 1}, SeqNo, Body}; + +reassemble_dtls_fragment(_SeqNo, _Type, Length, _MessageSeq, _, Length, + _Body, HsState = #dtls_hs_state{current_read_seq = undefined}) -> + %% not what we expected, drop it + HsState; + +reassemble_dtls_fragment(SeqNo, _Type, Length, MessageSeq, 0, Length, + Body, HsState0 = + #dtls_hs_state{starting_read_seq = StartingReadSeq}) + when MessageSeq < StartingReadSeq -> + %% this has to be the start of a new flight, let it through + %% + %% Note: this could (should?) be restricted further, the first message of a + %% new flight has to have message_seq = 0 + %% + HsState = dtls_hs_state_process_seq(HsState0), + {HsState, SeqNo, Body}; + +reassemble_dtls_fragment(_SeqNo, _Type, Length, MessageSeq, 0, Length, + _Body, HsState = + #dtls_hs_state{current_read_seq = CurrentReadSeq}) + when MessageSeq < CurrentReadSeq -> + {retransmit, HsState}; + +reassemble_dtls_fragment(_SeqNo, _Type, Length, MessageSeq, 0, Length, + _Body, HsState = #dtls_hs_state{current_read_seq = CurrentReadSeq}) + when MessageSeq < CurrentReadSeq -> + HsState; + +reassemble_dtls_fragment(SeqNo, _Type, Length, MessageSeq, 0, Length, + Body, HsState0 = #dtls_hs_state{current_read_seq = MessageSeq}) -> + %% Message fully contained and it's the current seq + HsState1 = dtls_hs_state_process_seq(HsState0), + {HsState1, SeqNo, Body}; + +reassemble_dtls_fragment(SeqNo, Type, Length, MessageSeq, 0, Length, + Body, HsState) -> + %% Message fully contained and it's the NOT the current seq -> buffer + Fragment = {SeqNo, Type, Length, MessageSeq, + dtls_fragment_init(Length, 0, Length, Body)}, + dtls_hs_state_add_fragment(MessageSeq, Fragment, HsState); + +reassemble_dtls_fragment(_SeqNo, _Type, Length, MessageSeq, FragmentOffset, FragmentLength, + _Body, + HsState = #dtls_hs_state{current_read_seq = CurrentReadSeq}) + when FragmentOffset + FragmentLength == Length andalso MessageSeq == (CurrentReadSeq - 1) -> + {retransmit, HsState}; + +reassemble_dtls_fragment(_SeqNo, _Type, _Length, MessageSeq, _FragmentOffset, _FragmentLength, + _Body, + HsState = #dtls_hs_state{current_read_seq = CurrentReadSeq}) + when MessageSeq < CurrentReadSeq -> + HsState; + +reassemble_dtls_fragment(SeqNo, Type, Length, MessageSeq, + FragmentOffset, FragmentLength, + Body, + HsState = #dtls_hs_state{fragments = Fragments0}) -> + case gb_trees:lookup(MessageSeq, Fragments0) of + {value, Fragment} -> + dtls_fragment_reassemble(SeqNo, Type, Length, MessageSeq, + FragmentOffset, FragmentLength, + Body, Fragment, HsState); + none -> + dtls_fragment_start(SeqNo, Type, Length, MessageSeq, + FragmentOffset, FragmentLength, + Body, HsState) + end. + +dtls_fragment_start(SeqNo, Type, Length, MessageSeq, + FragmentOffset, FragmentLength, + Body, HsState = #dtls_hs_state{fragments = Fragments0}) -> + Fragment = {SeqNo, Type, Length, MessageSeq, + dtls_fragment_init(Length, FragmentOffset, FragmentLength, Body)}, + Fragments1 = gb_trees:insert(MessageSeq, Fragment, Fragments0), + HsState#dtls_hs_state{fragments = Fragments1}. + +dtls_fragment_reassemble(SeqNo, Type, Length, MessageSeq, + FragmentOffset, FragmentLength, + Body, + {LastSeqNo, Type, Length, MessageSeq, FragBuffer0}, + HsState = #dtls_hs_state{fragments = Fragments0}) -> + FragBuffer1 = dtls_fragment_add(FragBuffer0, FragmentOffset, FragmentLength, Body), + Fragment = {erlang:max(SeqNo, LastSeqNo), Type, Length, MessageSeq, FragBuffer1}, + Fragments1 = gb_trees:enter(MessageSeq, Fragment, Fragments0), + HsState#dtls_hs_state{fragments = Fragments1}; + +%% Type, Length or Seq mismatch, drop everything... +%% Note: the RFC is not clear on how to handle this... +dtls_fragment_reassemble(_SeqNo, _Type, _Length, MessageSeq, + _FragmentOffset, _FragmentLength, _Body, _Fragment, + HsState = #dtls_hs_state{fragments = Fragments0}) -> + Fragments1 = gb_trees:delete_any(MessageSeq, Fragments0), + HsState#dtls_hs_state{fragments = Fragments1}. + +dtls_fragment_add({Length, FragmentList0, Bin0}, FragmentOffset, FragmentLength, Body) -> + Bin1 = dtls_fragment_bin_add(FragmentOffset, FragmentLength, Body, Bin0), + FragmentList1 = add_fragment(FragmentList0, {FragmentOffset, FragmentLength}), + {Length, FragmentList1, Bin1}. + +dtls_fragment_init(Length, 0, Length, Body) -> + {Length, [{0, Length}], Body}; +dtls_fragment_init(Length, FragmentOffset, FragmentLength, Body) -> + Bin = dtls_fragment_bin_add(FragmentOffset, FragmentLength, Body, <<0:(Length*8)>>), + {Length, [{FragmentOffset, FragmentLength}], Bin}. + +dtls_fragment_bin_add(FragmentOffset, FragmentLength, Add, Buffer) -> + <<First:FragmentOffset/bytes, _:FragmentLength/bytes, Rest/binary>> = Buffer, + <<First/binary, Add/binary, Rest/binary>>. + +merge_fragment_list([], Fragment, Acc) -> + lists:reverse([Fragment|Acc]); + +merge_fragment_list([H = {_, HEnd}|Rest], Frag = {FStart, _}, Acc) + when FStart > HEnd -> + merge_fragment_list(Rest, Frag, [H|Acc]); + +merge_fragment_list(Rest = [{HStart, _HEnd}|_], Frag = {_FStart, FEnd}, Acc) + when FEnd < HStart -> + lists:reverse(Acc) ++ [Frag|Rest]; + +merge_fragment_list([{HStart, HEnd}|Rest], _Frag = {FStart, FEnd}, Acc) + when + FStart =< HEnd orelse FEnd >= HStart -> + Start = erlang:min(HStart, FStart), + End = erlang:max(HEnd, FEnd), + NewFrag = {Start, End}, + merge_fragment_list(Rest, NewFrag, Acc). + +add_fragment(List, {FragmentOffset, FragmentLength}) -> + merge_fragment_list(List, {FragmentOffset, FragmentOffset + FragmentLength}, []). + +enc_hs(#hello_verify_request{protocol_version = {Major, Minor}, + cookie = Cookie}, _Version) -> + CookieLength = byte_size(Cookie), + {?HELLO_VERIFY_REQUEST, <<?BYTE(Major), ?BYTE(Minor), + ?BYTE(CookieLength), + Cookie/binary>>}; + +enc_hs(#client_hello{client_version = {Major, Minor}, + random = Random, + session_id = SessionID, + cookie = Cookie, + cipher_suites = CipherSuites, + compression_methods = CompMethods, + extensions = HelloExtensions}, Version) -> + SIDLength = byte_size(SessionID), + BinCookie = enc_client_hello_cookie(Version, Cookie), + BinCompMethods = list_to_binary(CompMethods), + CmLength = byte_size(BinCompMethods), + BinCipherSuites = list_to_binary(CipherSuites), + CsLength = byte_size(BinCipherSuites), + ExtensionsBin = ssl_handshake:encode_hello_extensions(HelloExtensions), + + {?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, + ?BYTE(SIDLength), SessionID/binary, + BinCookie/binary, + ?UINT16(CsLength), BinCipherSuites/binary, + ?BYTE(CmLength), BinCompMethods/binary, ExtensionsBin/binary>>}; +enc_hs(HandshakeMsg, Version) -> + ssl_handshake:encode_handshake(HandshakeMsg, Version). + +enc_client_hello_cookie(_, <<>>) -> + <<>>; +enc_client_hello_cookie(_, Cookie) -> + CookieLength = byte_size(Cookie), + <<?BYTE(CookieLength), Cookie/binary>>. + +decode_handshake(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, + ?BYTE(SID_length), Session_ID:SID_length/binary, + ?BYTE(Cookie_length), Cookie:Cookie_length/binary, + ?UINT16(Cs_length), CipherSuites:Cs_length/binary, + ?BYTE(Cm_length), Comp_methods:Cm_length/binary, + Extensions/binary>>) -> + + DecodedExtensions = ssl_handshake:decode_hello_extensions(Extensions), + + #client_hello{ + client_version = {Major,Minor}, + random = Random, + session_id = Session_ID, + cookie = Cookie, + cipher_suites = ssl_handshake:decode_suites('2_bytes', CipherSuites), + compression_methods = Comp_methods, + extensions = DecodedExtensions + }; + +decode_handshake(_Version, ?HELLO_VERIFY_REQUEST, <<?BYTE(Major), ?BYTE(Minor), + ?BYTE(CookieLength), Cookie:CookieLength/binary>>) -> + + #hello_verify_request{ + protocol_version = {Major,Minor}, + cookie = Cookie}; +decode_handshake(Version, Tag, Msg) -> + ssl_handshake:decode_handshake(Version, Tag, Msg). diff --git a/lib/ssl/src/dtls_handshake.hrl b/lib/ssl/src/dtls_handshake.hrl index db7b8596ae..5bdf45f627 100644 --- a/lib/ssl/src/dtls_handshake.hrl +++ b/lib/ssl/src/dtls_handshake.hrl @@ -27,6 +27,8 @@ -include("ssl_handshake.hrl"). %% Common TLS and DTLS records and Constantes +-define(HELLO_VERIFY_REQUEST, 3). + -record(client_hello, { client_version, random, @@ -35,16 +37,22 @@ cipher_suites, % cipher_suites<2..2^16-1> compression_methods, % compression_methods<1..2^8-1>, %% Extensions - renegotiation_info, - hash_signs, % supported combinations of hashes/signature algos - next_protocol_negotiation = undefined % [binary()] + extensions }). --record(hello_verify_request { +-record(hello_verify_request, { protocol_version, cookie }). --define(HELLO_VERIFY_REQUEST, 3). +-record(dtls_hs_state, + {current_read_seq, + starting_read_seq, + highest_record_seq, + fragments, + completed + }). + +-type dtls_handshake() :: #client_hello{} | #hello_verify_request{} | ssl_handshake(). -endif. % -ifdef(dtls_handshake). diff --git a/lib/ssl/src/dtls_record.erl b/lib/ssl/src/dtls_record.erl index 2469a7d26c..f667458a10 100644 --- a/lib/ssl/src/dtls_record.erl +++ b/lib/ssl/src/dtls_record.erl @@ -15,4 +15,370 @@ %% under the License. %% %% %CopyrightEnd% + +%% +%%---------------------------------------------------------------------- +%% Purpose: Handle DTLS record protocol. (Parts that are not shared with SSL/TLS) +%%---------------------------------------------------------------------- -module(dtls_record). + +-include("dtls_record.hrl"). +-include("ssl_internal.hrl"). +-include("ssl_alert.hrl"). +-include("dtls_handshake.hrl"). +-include("ssl_cipher.hrl"). + +%% Handling of incoming data +-export([get_dtls_records/2]). + +%% Decoding +-export([decode_cipher_text/2]). + +%% Encoding +-export([encode_plain_text/4]). + +%% Protocol version handling +-export([protocol_version/1, lowest_protocol_version/2, + highest_protocol_version/1, supported_protocol_versions/0, + is_acceptable_version/2, cipher/4, decipher/2]). + +-export([init_connection_state_seq/2, current_connection_state_epoch/2, + set_connection_state_by_epoch/3, connection_state_by_epoch/3]). + +-compile(inline). + +%%==================================================================== +%% Internal application API +%%==================================================================== + +%%-------------------------------------------------------------------- +-spec get_dtls_records(binary(), binary()) -> {[binary()], binary()} | #alert{}. +%% +%% Description: Given old buffer and new data from UDP/SCTP, packs up a records +%% and returns it as a list of tls_compressed binaries also returns leftover +%% data +%%-------------------------------------------------------------------- +get_dtls_records(Data, <<>>) -> + get_dtls_records_aux(Data, []); +get_dtls_records(Data, Buffer) -> + get_dtls_records_aux(list_to_binary([Buffer, Data]), []). + +get_dtls_records_aux(<<?BYTE(?APPLICATION_DATA),?BYTE(MajVer),?BYTE(MinVer), + ?UINT16(Epoch), ?UINT48(SequenceNumber), + ?UINT16(Length), Data:Length/binary, Rest/binary>>, + Acc) -> + get_dtls_records_aux(Rest, [#ssl_tls{type = ?APPLICATION_DATA, + version = {MajVer, MinVer}, + epoch = Epoch, record_seq = SequenceNumber, + fragment = Data} | Acc]); +get_dtls_records_aux(<<?BYTE(?HANDSHAKE),?BYTE(MajVer),?BYTE(MinVer), + ?UINT16(Epoch), ?UINT48(SequenceNumber), + ?UINT16(Length), + Data:Length/binary, Rest/binary>>, Acc) when MajVer >= 128 -> + get_dtls_records_aux(Rest, [#ssl_tls{type = ?HANDSHAKE, + version = {MajVer, MinVer}, + epoch = Epoch, record_seq = SequenceNumber, + fragment = Data} | Acc]); +get_dtls_records_aux(<<?BYTE(?ALERT),?BYTE(MajVer),?BYTE(MinVer), + ?UINT16(Epoch), ?UINT48(SequenceNumber), + ?UINT16(Length), Data:Length/binary, + Rest/binary>>, Acc) -> + get_dtls_records_aux(Rest, [#ssl_tls{type = ?ALERT, + version = {MajVer, MinVer}, + epoch = Epoch, record_seq = SequenceNumber, + fragment = Data} | Acc]); +get_dtls_records_aux(<<?BYTE(?CHANGE_CIPHER_SPEC),?BYTE(MajVer),?BYTE(MinVer), + ?UINT16(Epoch), ?UINT48(SequenceNumber), + ?UINT16(Length), Data:Length/binary, Rest/binary>>, + Acc) -> + get_dtls_records_aux(Rest, [#ssl_tls{type = ?CHANGE_CIPHER_SPEC, + version = {MajVer, MinVer}, + epoch = Epoch, record_seq = SequenceNumber, + fragment = Data} | Acc]); + +get_dtls_records_aux(<<0:1, _CT:7, ?BYTE(_MajVer), ?BYTE(_MinVer), + ?UINT16(Length), _/binary>>, + _Acc) when Length > ?MAX_CIPHER_TEXT_LENGTH -> + ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW); + +get_dtls_records_aux(<<1:1, Length0:15, _/binary>>,_Acc) + when Length0 > ?MAX_CIPHER_TEXT_LENGTH -> + ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW); + +get_dtls_records_aux(Data, Acc) -> + case size(Data) =< ?MAX_CIPHER_TEXT_LENGTH + ?INITIAL_BYTES of + true -> + {lists:reverse(Acc), Data}; + false -> + ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE) + end. + +encode_plain_text(Type, Version, Data, + #connection_state{ + compression_state = CompS0, + epoch = Epoch, + sequence_number = Seq, + security_parameters= + #security_parameters{compression_algorithm = CompAlg} + }= CS0) -> + {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0), + CS1 = CS0#connection_state{compression_state = CompS1}, + {CipherText, CS2} = cipher(Type, Version, Comp, CS1), + CTBin = encode_tls_cipher_text(Type, Version, Epoch, Seq, CipherText), + {CTBin, CS2}. + +decode_cipher_text(CipherText, ConnnectionStates0) -> + ReadState0 = ConnnectionStates0#connection_states.current_read, + #connection_state{compression_state = CompressionS0, + security_parameters = SecParams} = ReadState0, + CompressAlg = SecParams#security_parameters.compression_algorithm, + case decipher(CipherText, ReadState0) of + {Compressed, ReadState1} -> + {Plain, CompressionS1} = ssl_record:uncompress(CompressAlg, + Compressed, CompressionS0), + ConnnectionStates = ConnnectionStates0#connection_states{ + current_read = ReadState1#connection_state{ + compression_state = CompressionS1}}, + {Plain, ConnnectionStates}; + #alert{} = Alert -> + Alert + end. + +%%-------------------------------------------------------------------- +-spec protocol_version(tls_atom_version() | tls_version()) -> + tls_version() | tls_atom_version(). +%% +%% Description: Creates a protocol version record from a version atom +%% or vice versa. +%%-------------------------------------------------------------------- +protocol_version('dtlsv1.2') -> + {254, 253}; +protocol_version(dtlsv1) -> + {254, 255}; +protocol_version({254, 253}) -> + 'dtlsv1.2'; +protocol_version({254, 255}) -> + dtlsv1. +%%-------------------------------------------------------------------- +-spec lowest_protocol_version(tls_version(), tls_version()) -> tls_version(). +%% +%% Description: Lowes protocol version of two given versions +%%-------------------------------------------------------------------- +lowest_protocol_version(Version = {M, N}, {M, O}) when N > O -> + Version; +lowest_protocol_version({M, _}, Version = {M, _}) -> + Version; +lowest_protocol_version(Version = {M,_}, {N, _}) when M > N -> + Version; +lowest_protocol_version(_,Version) -> + Version. +%%-------------------------------------------------------------------- +-spec highest_protocol_version([tls_version()]) -> tls_version(). +%% +%% Description: Highest protocol version present in a list +%%-------------------------------------------------------------------- +highest_protocol_version([Ver | Vers]) -> + highest_protocol_version(Ver, Vers). + +highest_protocol_version(Version, []) -> + Version; +highest_protocol_version(Version = {N, M}, [{N, O} | Rest]) when M < O -> + highest_protocol_version(Version, Rest); +highest_protocol_version({M, _}, [Version = {M, _} | Rest]) -> + highest_protocol_version(Version, Rest); +highest_protocol_version(Version = {M,_}, [{N,_} | Rest]) when M < N -> + highest_protocol_version(Version, Rest); +highest_protocol_version(_, [Version | Rest]) -> + highest_protocol_version(Version, Rest). + + +%%-------------------------------------------------------------------- +-spec supported_protocol_versions() -> [tls_version()]. +%% +%% Description: Protocol versions supported +%%-------------------------------------------------------------------- +supported_protocol_versions() -> + Fun = fun(Version) -> + protocol_version(Version) + end, + case application:get_env(ssl, dtls_protocol_version) of + undefined -> + lists:map(Fun, supported_protocol_versions([])); + {ok, []} -> + lists:map(Fun, supported_protocol_versions([])); + {ok, Vsns} when is_list(Vsns) -> + supported_protocol_versions(Vsns); + {ok, Vsn} -> + supported_protocol_versions([Vsn]) + end. + +supported_protocol_versions([]) -> + Vsns = supported_connection_protocol_versions([]), + application:set_env(ssl, dtls_protocol_version, Vsns), + Vsns; + +supported_protocol_versions([_|_] = Vsns) -> + Vsns. + +supported_connection_protocol_versions([]) -> + ?ALL_DATAGRAM_SUPPORTED_VERSIONS. + +%%-------------------------------------------------------------------- +-spec is_acceptable_version(tls_version(), Supported :: [tls_version()]) -> boolean(). +%% +%% Description: ssl version 2 is not acceptable security risks are too big. +%% +%%-------------------------------------------------------------------- +is_acceptable_version(Version, Versions) -> + lists:member(Version, Versions). + + +%%-------------------------------------------------------------------- +-spec init_connection_state_seq(tls_version(), #connection_states{}) -> + #connection_state{}. +%% +%% Description: Copy the read sequence number to the write sequence number +%% This is only valid for DTLS in the first client_hello +%%-------------------------------------------------------------------- +init_connection_state_seq({254, _}, + #connection_states{ + current_read = Read = #connection_state{epoch = 0}, + current_write = Write = #connection_state{epoch = 0}} = CS0) -> + CS0#connection_states{current_write = + Write#connection_state{ + sequence_number = Read#connection_state.sequence_number}}; +init_connection_state_seq(_, CS) -> + CS. + +%%-------------------------------------------------------- +-spec current_connection_state_epoch(#connection_states{}, read | write) -> + integer(). +%% +%% Description: Returns the epoch the connection_state record +%% that is currently defined as the current conection state. +%%-------------------------------------------------------------------- +current_connection_state_epoch(#connection_states{current_read = Current}, + read) -> + Current#connection_state.epoch; +current_connection_state_epoch(#connection_states{current_write = Current}, + write) -> + Current#connection_state.epoch. + +%%-------------------------------------------------------------------- + +-spec connection_state_by_epoch(#connection_states{}, integer(), read | write) -> + #connection_state{}. +%% +%% Description: Returns the instance of the connection_state record +%% that is defined by the Epoch. +%%-------------------------------------------------------------------- +connection_state_by_epoch(#connection_states{current_read = CS}, Epoch, read) + when CS#connection_state.epoch == Epoch -> + CS; +connection_state_by_epoch(#connection_states{pending_read = CS}, Epoch, read) + when CS#connection_state.epoch == Epoch -> + CS; +connection_state_by_epoch(#connection_states{current_write = CS}, Epoch, write) + when CS#connection_state.epoch == Epoch -> + CS; +connection_state_by_epoch(#connection_states{pending_write = CS}, Epoch, write) + when CS#connection_state.epoch == Epoch -> + CS. +%%-------------------------------------------------------------------- +-spec set_connection_state_by_epoch(#connection_states{}, + #connection_state{}, read | write) -> ok. +%% +%% Description: Returns the instance of the connection_state record +%% that is defined by the Epoch. +%%-------------------------------------------------------------------- +set_connection_state_by_epoch(ConnectionStates0 = + #connection_states{current_read = CS}, + NewCS = #connection_state{epoch = Epoch}, read) + when CS#connection_state.epoch == Epoch -> + ConnectionStates0#connection_states{current_read = NewCS}; + +set_connection_state_by_epoch(ConnectionStates0 = + #connection_states{pending_read = CS}, + NewCS = #connection_state{epoch = Epoch}, read) + when CS#connection_state.epoch == Epoch -> + ConnectionStates0#connection_states{pending_read = NewCS}; + +set_connection_state_by_epoch(ConnectionStates0 = + #connection_states{current_write = CS}, + NewCS = #connection_state{epoch = Epoch}, write) + when CS#connection_state.epoch == Epoch -> + ConnectionStates0#connection_states{current_write = NewCS}; + +set_connection_state_by_epoch(ConnectionStates0 = + #connection_states{pending_write = CS}, + NewCS = #connection_state{epoch = Epoch}, write) + when CS#connection_state.epoch == Epoch -> + ConnectionStates0#connection_states{pending_write = NewCS}. + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +encode_tls_cipher_text(Type, {MajVer, MinVer}, Epoch, Seq, Fragment) -> + Length = erlang:iolist_size(Fragment), + [<<?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer), ?UINT16(Epoch), + ?UINT48(Seq), ?UINT16(Length)>>, Fragment]. + +cipher(Type, Version, Fragment, CS0) -> + Length = erlang:iolist_size(Fragment), + {MacHash, CS1=#connection_state{cipher_state = CipherS0, + security_parameters= + #security_parameters{bulk_cipher_algorithm = + BCA} + }} = + hash_and_bump_seqno(CS0, Type, Version, Length, Fragment), + {Ciphered, CipherS1} = ssl_cipher:cipher(BCA, CipherS0, MacHash, Fragment, Version), + CS2 = CS1#connection_state{cipher_state=CipherS1}, + {Ciphered, CS2}. + +decipher(TLS=#ssl_tls{type=Type, version=Version={254, _}, + epoch = Epoch, record_seq = SeqNo, + fragment=Fragment}, CS0) -> + SP = CS0#connection_state.security_parameters, + BCA = SP#security_parameters.bulk_cipher_algorithm, + HashSz = SP#security_parameters.hash_size, + CipherS0 = CS0#connection_state.cipher_state, + case ssl_cipher:decipher(BCA, HashSz, CipherS0, Fragment, Version) of + {T, Mac, CipherS1} -> + CS1 = CS0#connection_state{cipher_state = CipherS1}, + TLength = size(T), + MacHash = hash_with_seqno(CS1, Type, Version, Epoch, SeqNo, TLength, T), + case ssl_record:is_correct_mac(Mac, MacHash) of + true -> + {TLS#ssl_tls{fragment = T}, CS1}; + false -> + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) + end; + #alert{} = Alert -> + Alert + end. + +hash_with_seqno(#connection_state{mac_secret = MacSecret, + security_parameters = + SecPars}, + Type, Version = {254, _}, + Epoch, SeqNo, Length, Fragment) -> + mac_hash(Version, + SecPars#security_parameters.mac_algorithm, + MacSecret, (Epoch bsl 48) + SeqNo, Type, + Length, Fragment). + +hash_and_bump_seqno(#connection_state{epoch = Epoch, + sequence_number = SeqNo, + mac_secret = MacSecret, + security_parameters = + SecPars} = CS0, + Type, Version = {254, _}, Length, Fragment) -> + Hash = mac_hash(Version, + SecPars#security_parameters.mac_algorithm, + MacSecret, (Epoch bsl 48) + SeqNo, Type, + Length, Fragment), + {Hash, CS0#connection_state{sequence_number = SeqNo+1}}. + +mac_hash(Version, MacAlg, MacSecret, SeqNo, Type, Length, Fragment) -> + dtls_v1:mac_hash(MacAlg, MacSecret, SeqNo, Type, Version, + Length, Fragment). diff --git a/lib/ssl/src/dtls_v1.erl b/lib/ssl/src/dtls_v1.erl new file mode 100644 index 0000000000..c12e12e424 --- /dev/null +++ b/lib/ssl/src/dtls_v1.erl @@ -0,0 +1,43 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013-2013. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(dtls_v1). + +-include("ssl_cipher.hrl"). + +-export([suites/1, mac_hash/7, ecc_curves/1, corresponding_tls_version/1]). + +-spec suites(Minor:: 253|255) -> [cipher_suite()]. + +suites(Minor) -> + tls_v1:suites(corresponding_minor_tls_version(Minor)). + +mac_hash(Version, MacAlg, MacSecret, SeqNo, Type, Length, Fragment) -> + tls_v1:mac_hash(MacAlg, MacSecret, SeqNo, Type, Version, + Length, Fragment). + +ecc_curves({_Major, Minor}) -> + tls_v1:ecc_curves(corresponding_minor_tls_version(Minor)). + +corresponding_tls_version({254, Minor}) -> + {3, corresponding_minor_tls_version(Minor)}. + +corresponding_minor_tls_version(255) -> + 2; +corresponding_minor_tls_version(253) -> + 3. diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src index 582a60635f..44798f8c12 100644 --- a/lib/ssl/src/ssl.app.src +++ b/lib/ssl/src/ssl.app.src @@ -3,40 +3,44 @@ {vsn, "%VSN%"}, {modules, [ %% TLS/SSL - tls, tls_connection, tls_handshake, tls_record, + tls_v1, + ssl_v3, + ssl_v2, %% DTLS - dtls_record, - dtls_handshake, dtls_connection, - dtls, - %% Backwards compatibility + dtls_handshake, + dtls_record, + dtls_v1, + %% API + tls, %% Future API module + dtls, %% Future API module ssl, + ssl_session_cache_api, %% Both TLS/SSL and DTLS - ssl_app, - ssl_sup, + ssl_handshake, + ssl_record, + ssl_cipher, + ssl_srp_primes, + ssl_alert, + ssl_socket, + %%ssl_connection, + %% Erlang Distribution over SSL/TLS inet_tls_dist, ssl_tls_dist_proxy, ssl_dist_sup, - ssl_tls1, - ssl_ssl3, - ssl_ssl2, + %% SSL/TLS session handling ssl_session, - ssl_session_cache_api, ssl_session_cache, - ssl_socket, - %%ssl_record, ssl_manager, - %%ssl_handshake, - ssl_connection_sup, - %%ssl_connection, - ssl_cipher, - ssl_srp_primes, ssl_pkix_db, ssl_certificate, - ssl_alert + %% App structure + ssl_app, + ssl_sup, + ssl_connection_sup ]}, {registered, [ssl_sup, ssl_manager]}, {applications, [crypto, public_key, kernel, stdlib]}, diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index 9e5bec26f1..c090b6ebfb 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,6 +1,7 @@ %% -*- erlang -*- {"%VSN%", [ + {<<"5.3\\*">>, [{restart_application, ssl}]}, {<<"5.2\\*">>, [{restart_application, ssl}]}, {<<"5.1\\*">>, [{restart_application, ssl}]}, {<<"5.0\\*">>, [{restart_application, ssl}]}, @@ -8,6 +9,7 @@ {<<"3\\.*">>, [{restart_application, ssl}]} ], [ + {<<"5.3\\*">>, [{restart_application, ssl}]}, {<<"5.2\\*">>, [{restart_application, ssl}]}, {<<"5.1\\*">>, [{restart_application, ssl}]}, {<<"5.0\\*">>, [{restart_application, ssl}]}, diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index ec5d793d65..e6ed0d8626 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -32,16 +32,26 @@ -include("ssl_alert.hrl"). -include_lib("public_key/include/public_key.hrl"). --export([security_parameters/3, suite_definition/1, +-export([security_parameters/2, security_parameters/3, suite_definition/1, decipher/5, cipher/5, - suite/1, suites/1, anonymous_suites/0, psk_suites/1, srp_suites/0, + suite/1, suites/1, ec_keyed_suites/0, anonymous_suites/0, psk_suites/1, srp_suites/0, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, - hash_algorithm/1, sign_algorithm/1]). + hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2]). -compile(inline). %%-------------------------------------------------------------------- --spec security_parameters(tls_version(), cipher_suite(), #security_parameters{}) -> +-spec security_parameters(cipher_suite(), #security_parameters{}) -> + #security_parameters{}. +%% Only security_parameters/2 should call security_parameters/3 with undefined as +%% first argument. +%%-------------------------------------------------------------------- + +security_parameters(?TLS_NULL_WITH_NULL_NULL = CipherSuite, SecParams) -> + security_parameters(undefined, CipherSuite, SecParams). + +%%-------------------------------------------------------------------- +-spec security_parameters(tls_version() | undefined, cipher_suite(), #security_parameters{}) -> #security_parameters{}. %% %% Description: Returns a security parameters record where the @@ -195,9 +205,9 @@ block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, %% Description: Returns a list of supported cipher suites. %%-------------------------------------------------------------------- suites({3, 0}) -> - ssl_ssl3:suites(); + ssl_v3:suites(); suites({3, N}) -> - ssl_tls1:suites(N). + tls_v1:suites(N). %%-------------------------------------------------------------------- -spec anonymous_suites() -> [cipher_suite()]. @@ -1009,6 +1019,7 @@ filter(DerCert, Ciphers) -> filter_keyuse(OtpCert, (Ciphers -- rsa_keyed_suites()) -- dsa_signed_suites(), [], ecdhe_ecdsa_suites()) end, + case public_key:pkix_sign_types(SigAlg#'SignatureAlgorithm'.algorithm) of {_, rsa} -> Ciphers1 -- ecdsa_signed_suites(); @@ -1191,15 +1202,15 @@ hash_size(md5) -> hash_size(sha) -> 20; %% Uncomment when adding cipher suite that needs it -%% hash_size(sha224) -> -%% 28; +%hash_size(sha224) -> +% 28; hash_size(sha256) -> 32; hash_size(sha384) -> 48. %% Uncomment when adding cipher suite that needs it -%% hash_size(sha512) -> -%% 64. +%hash_size(sha512) -> +% 64. %% RFC 5246: 6.2.3.2. CBC Block Cipher %% @@ -1259,15 +1270,15 @@ generic_stream_cipher_from_bin(T, HashSz) -> %% SSL 3.0 and TLS 1.0 as it is not strictly required and breaks %% interopability with for instance Google. is_correct_padding(#generic_block_cipher{padding_length = Len, - padding = Padding}, {3, N}) + padding = Padding}, {3, N}) when N == 0; N == 1 -> Len == byte_size(Padding); %% Padding must be check in TLS 1.1 and after is_correct_padding(#generic_block_cipher{padding_length = Len, - padding = Padding}, _) -> + padding = Padding}, _) -> Len == byte_size(Padding) andalso list_to_binary(lists:duplicate(Len, Len)) == Padding. - + get_padding(Length, BlockSize) -> get_padding_aux(BlockSize, Length rem BlockSize). @@ -1291,7 +1302,7 @@ next_iv(Bin, IV) -> rsa_signed_suites() -> dhe_rsa_suites() ++ rsa_suites() ++ psk_rsa_suites() ++ srp_rsa_suites() ++ - ecdh_rsa_suites(). + ecdh_rsa_suites() ++ ecdhe_rsa_suites(). rsa_keyed_suites() -> dhe_rsa_suites() ++ rsa_suites() ++ diff --git a/lib/ssl/src/ssl_cipher.hrl b/lib/ssl/src/ssl_cipher.hrl index c7c71ee1a7..62a5269def 100644 --- a/lib/ssl/src/ssl_cipher.hrl +++ b/lib/ssl/src/ssl_cipher.hrl @@ -28,7 +28,8 @@ -type cipher() :: null |rc4_128 | idea_cbc | des40_cbc | des_cbc | '3des_ede_cbc' | aes_128_cbc | aes_256_cbc. --type hash() :: null | sha | md5 | ssh224 | sha256 | sha384 | sha512. +-type hash() :: null | sha | md5 | sha224 | sha256 | sha384 | sha512. +-type key_algo() :: null | rsa | dhe_rsa | dhe_dss | ecdhe_ecdsa| ecdh_ecdsa | ecdh_rsa| srp_rsa| srp_dss | psk | dhe_psk | rsa_psk | dh_anon | ecdh_anon | srp_anon. -type erl_cipher_suite() :: {key_algo(), cipher(), hash()}. -type int_cipher_suite() :: {key_algo(), cipher(), hash(), hash() | default_prf}. -type cipher_suite() :: binary(). diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl new file mode 100644 index 0000000000..b18452a8f2 --- /dev/null +++ b/lib/ssl/src/ssl_handshake.erl @@ -0,0 +1,1672 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013-2013. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% + +%---------------------------------------------------------------------- +%% Purpose: Help funtions for handling the SSL-handshake protocol (common +%% to SSL/TLS and DTLS +%%---------------------------------------------------------------------- + +-module(ssl_handshake). + +-include("ssl_handshake.hrl"). +-include("ssl_record.hrl"). +-include("ssl_cipher.hrl"). +-include("ssl_alert.hrl"). +-include("ssl_internal.hrl"). +-include("ssl_srp.hrl"). +-include_lib("public_key/include/public_key.hrl"). + +%% Handshake messages +-export([hello_request/0, server_hello_done/0, + certificate/4, certificate_request/4, key_exchange/3, + finished/5, next_protocol/1]). + +%% Handle handshake messages +-export([certify/7, client_certificate_verify/6, certificate_verify/6, verify_signature/5, + master_secret/5, server_key_exchange_hash/2, verify_connection/6]). + +%% Encode/Decode +-export([encode_handshake/2, encode_hello_extensions/1, + encode_client_protocol_negotiation/2, encode_protocols_advertised_on_server/1, + decode_handshake/3, decode_hello_extensions/1, + decode_server_key/3, decode_client_key/3, + decode_suites/2 + ]). + +%% Cipher suites handling +-export([available_suites/2, cipher_suites/2, + select_session/10, supported_ecc/1]). + +%% Extensions handling +-export([client_hello_extensions/5, + handle_client_hello_extensions/8, %% Returns server hello extensions + handle_server_hello_extensions/9, select_curve/2 + ]). + +%% MISC +-export([select_version/3, prf/5, select_hashsign/2, select_cert_hashsign/3, + decrypt_premaster_secret/2]). + +%%==================================================================== +%% Internal application API +%%==================================================================== + +%% ---------- Create handshake messages ---------- + +%%-------------------------------------------------------------------- +-spec hello_request() -> #hello_request{}. +%% +%% Description: Creates a hello request message sent by server to +%% trigger renegotiation. +%%-------------------------------------------------------------------- +hello_request() -> + #hello_request{}. + +%%-------------------------------------------------------------------- +-spec server_hello_done() -> #server_hello_done{}. +%% +%% Description: Creates a server hello done message. +%%-------------------------------------------------------------------- +server_hello_done() -> + #server_hello_done{}. + +client_hello_extensions(Version, CipherSuites, SslOpts, ConnectionStates, Renegotiation) -> + {EcPointFormats, EllipticCurves} = + case advertises_ec_ciphers(lists:map(fun ssl_cipher:suite_definition/1, CipherSuites)) of + true -> + client_ecc_extensions(tls_v1, Version); + false -> + {undefined, undefined} + end, + SRP = srp_user(SslOpts), + + #hello_extensions{ + renegotiation_info = renegotiation_info(tls_record, client, + ConnectionStates, Renegotiation), + srp = SRP, + hash_signs = advertised_hash_signs(Version), + ec_point_formats = EcPointFormats, + elliptic_curves = EllipticCurves, + next_protocol_negotiation = + encode_client_protocol_negotiation(SslOpts#ssl_options.next_protocol_selector, + Renegotiation)}. + +%%-------------------------------------------------------------------- +-spec certificate(der_cert(), db_handle(), certdb_ref(), client | server) -> #certificate{} | #alert{}. +%% +%% Description: Creates a certificate message. +%%-------------------------------------------------------------------- +certificate(OwnCert, CertDbHandle, CertDbRef, client) -> + Chain = + case ssl_certificate:certificate_chain(OwnCert, CertDbHandle, CertDbRef) of + {ok, CertChain} -> + CertChain; + {error, _} -> + %% If no suitable certificate is available, the client + %% SHOULD send a certificate message containing no + %% certificates. (chapter 7.4.6. RFC 4346) + [] + end, + #certificate{asn1_certificates = Chain}; + +certificate(OwnCert, CertDbHandle, CertDbRef, server) -> + case ssl_certificate:certificate_chain(OwnCert, CertDbHandle, CertDbRef) of + {ok, Chain} -> + #certificate{asn1_certificates = Chain}; + {error, _} -> + ?ALERT_REC(?FATAL, ?INTERNAL_ERROR) + end. + +%%-------------------------------------------------------------------- +-spec next_protocol(binary()) -> #next_protocol{}. +%% +%% Description: Creates a next protocol message +%%------------------------------------------------------------------- +next_protocol(SelectedProtocol) -> + #next_protocol{selected_protocol = SelectedProtocol}. + +%%-------------------------------------------------------------------- +-spec client_certificate_verify(undefined | der_cert(), binary(), + tls_version(), term(), private_key(), + tls_handshake_history()) -> + #certificate_verify{} | ignore | #alert{}. +%% +%% Description: Creates a certificate_verify message, called by the client. +%%-------------------------------------------------------------------- +client_certificate_verify(undefined, _, _, _, _, _) -> + ignore; +client_certificate_verify(_, _, _, _, undefined, _) -> + ignore; +client_certificate_verify(OwnCert, MasterSecret, Version, + {HashAlgo, SignAlgo}, + PrivateKey, {Handshake, _}) -> + case public_key:pkix_is_fixed_dh_cert(OwnCert) of + true -> + ?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE); + false -> + Hashes = + calc_certificate_verify(Version, HashAlgo, MasterSecret, Handshake), + Signed = digitally_signed(Version, Hashes, HashAlgo, PrivateKey), + #certificate_verify{signature = Signed, hashsign_algorithm = {HashAlgo, SignAlgo}} + end. + +%%-------------------------------------------------------------------- +-spec certificate_request(erl_cipher_suite(), db_handle(), certdb_ref(), tls_version()) -> + #certificate_request{}. +%% +%% Description: Creates a certificate_request message, called by the server. +%%-------------------------------------------------------------------- +certificate_request(CipherSuite, CertDbHandle, CertDbRef, Version) -> + Types = certificate_types(CipherSuite), + HashSigns = advertised_hash_signs(Version), + Authorities = certificate_authorities(CertDbHandle, CertDbRef), + #certificate_request{ + certificate_types = Types, + hashsign_algorithms = HashSigns, + certificate_authorities = Authorities + }. +%%-------------------------------------------------------------------- +-spec key_exchange(client | server, tls_version(), + {premaster_secret, binary(), public_key_info()} | + {dh, binary()} | + {dh, {binary(), binary()}, #'DHParameter'{}, {HashAlgo::atom(), SignAlgo::atom()}, + binary(), binary(), private_key()} | + {ecdh, #'ECPrivateKey'{}} | + {psk, binary()} | + {dhe_psk, binary(), binary()} | + {srp, {binary(), binary()}, #srp_user{}, {HashAlgo::atom(), SignAlgo::atom()}, + binary(), binary(), private_key()}) -> + #client_key_exchange{} | #server_key_exchange{}. + +%% +%% Description: Creates a keyexchange message. +%%-------------------------------------------------------------------- +key_exchange(client, _Version, {premaster_secret, Secret, {_, PublicKey, _}}) -> + EncPremasterSecret = + encrypted_premaster_secret(Secret, PublicKey), + #client_key_exchange{exchange_keys = EncPremasterSecret}; + +key_exchange(client, _Version, {dh, PublicKey}) -> + #client_key_exchange{ + exchange_keys = #client_diffie_hellman_public{ + dh_public = PublicKey} + }; + +key_exchange(client, _Version, {ecdh, #'ECPrivateKey'{publicKey = {0, ECPublicKey}}}) -> + #client_key_exchange{ + exchange_keys = #client_ec_diffie_hellman_public{ + dh_public = ECPublicKey} + }; + +key_exchange(client, _Version, {psk, Identity}) -> + #client_key_exchange{ + exchange_keys = #client_psk_identity{ + identity = Identity} + }; + +key_exchange(client, _Version, {dhe_psk, Identity, PublicKey}) -> + #client_key_exchange{ + exchange_keys = #client_dhe_psk_identity{ + identity = Identity, + dh_public = PublicKey} + }; + +key_exchange(client, _Version, {psk_premaster_secret, PskIdentity, Secret, {_, PublicKey, _}}) -> + EncPremasterSecret = + encrypted_premaster_secret(Secret, PublicKey), + #client_key_exchange{ + exchange_keys = #client_rsa_psk_identity{ + identity = PskIdentity, + exchange_keys = EncPremasterSecret}}; + +key_exchange(client, _Version, {srp, PublicKey}) -> + #client_key_exchange{ + exchange_keys = #client_srp_public{ + srp_a = PublicKey} + }; + +key_exchange(server, Version, {dh, {PublicKey, _}, + #'DHParameter'{prime = P, base = G}, + HashSign, ClientRandom, ServerRandom, PrivateKey}) -> + ServerDHParams = #server_dh_params{dh_p = int_to_bin(P), + dh_g = int_to_bin(G), dh_y = PublicKey}, + enc_server_key_exchange(Version, ServerDHParams, HashSign, + ClientRandom, ServerRandom, PrivateKey); + +key_exchange(server, Version, {ecdh, #'ECPrivateKey'{publicKey = {0, ECPublicKey}, + parameters = ECCurve}, HashSign, + ClientRandom, ServerRandom, PrivateKey}) -> + ServerECParams = #server_ecdh_params{curve = ECCurve, public = ECPublicKey}, + enc_server_key_exchange(Version, ServerECParams, HashSign, + ClientRandom, ServerRandom, PrivateKey); + +key_exchange(server, Version, {psk, PskIdentityHint, + HashSign, ClientRandom, ServerRandom, PrivateKey}) -> + ServerPSKParams = #server_psk_params{hint = PskIdentityHint}, + enc_server_key_exchange(Version, ServerPSKParams, HashSign, + ClientRandom, ServerRandom, PrivateKey); + +key_exchange(server, Version, {dhe_psk, PskIdentityHint, {PublicKey, _}, + #'DHParameter'{prime = P, base = G}, + HashSign, ClientRandom, ServerRandom, PrivateKey}) -> + ServerEDHPSKParams = #server_dhe_psk_params{ + hint = PskIdentityHint, + dh_params = #server_dh_params{dh_p = int_to_bin(P), + dh_g = int_to_bin(G), dh_y = PublicKey} + }, + enc_server_key_exchange(Version, ServerEDHPSKParams, + HashSign, ClientRandom, ServerRandom, PrivateKey); + +key_exchange(server, Version, {srp, {PublicKey, _}, + #srp_user{generator = Generator, prime = Prime, + salt = Salt}, + HashSign, ClientRandom, ServerRandom, PrivateKey}) -> + ServerSRPParams = #server_srp_params{srp_n = Prime, srp_g = Generator, + srp_s = Salt, srp_b = PublicKey}, + enc_server_key_exchange(Version, ServerSRPParams, HashSign, + ClientRandom, ServerRandom, PrivateKey). + +%%-------------------------------------------------------------------- +-spec finished(tls_version(), client | server, integer(), binary(), tls_handshake_history()) -> + #finished{}. +%% +%% Description: Creates a handshake finished message +%%------------------------------------------------------------------- +finished(Version, Role, PrfAlgo, MasterSecret, {Handshake, _}) -> % use the current handshake + #finished{verify_data = + calc_finished(Version, Role, PrfAlgo, MasterSecret, Handshake)}. + +%% ---------- Handle handshake messages ---------- + +%%-------------------------------------------------------------------- +-spec certificate_verify(binary(), public_key_info(), tls_version(), term(), + binary(), tls_handshake_history()) -> valid | #alert{}. +%% +%% Description: Checks that the certificate_verify message is valid. +%%-------------------------------------------------------------------- +certificate_verify(Signature, PublicKeyInfo, Version, + HashSign = {HashAlgo, _}, MasterSecret, {_, Handshake}) -> + Hash = calc_certificate_verify(Version, HashAlgo, MasterSecret, Handshake), + case verify_signature(Version, Hash, HashSign, Signature, PublicKeyInfo) of + true -> + valid; + _ -> + ?ALERT_REC(?FATAL, ?BAD_CERTIFICATE) + end. +%%-------------------------------------------------------------------- +-spec verify_signature(tls_version(), binary(), {term(), term()}, binary(), + public_key_info()) -> true | false. +%% +%% Description: Checks that a public_key signature is valid. +%%-------------------------------------------------------------------- +verify_signature(_Version, _Hash, {_HashAlgo, anon}, _Signature, _) -> + true; +verify_signature({3, Minor}, Hash, {HashAlgo, rsa}, Signature, {?rsaEncryption, PubKey, _PubKeyParams}) + when Minor >= 3 -> + public_key:verify({digest, Hash}, HashAlgo, Signature, PubKey); +verify_signature(_Version, Hash, _HashAlgo, Signature, {?rsaEncryption, PubKey, _PubKeyParams}) -> + case public_key:decrypt_public(Signature, PubKey, + [{rsa_pad, rsa_pkcs1_padding}]) of + Hash -> true; + _ -> false + end; +verify_signature(_Version, Hash, {HashAlgo, dsa}, Signature, {?'id-dsa', PublicKey, PublicKeyParams}) -> + public_key:verify({digest, Hash}, HashAlgo, Signature, {PublicKey, PublicKeyParams}); +verify_signature(_Version, Hash, {HashAlgo, ecdsa}, Signature, + {?'id-ecPublicKey', PublicKey, PublicKeyParams}) -> + public_key:verify({digest, Hash}, HashAlgo, Signature, {PublicKey, PublicKeyParams}). + +%%-------------------------------------------------------------------- +-spec certify(#certificate{}, db_handle(), certdb_ref(), integer() | nolimit, + verify_peer | verify_none, {fun(), term}, + client | server) -> {der_cert(), public_key_info()} | #alert{}. +%% +%% Description: Handles a certificate handshake message +%%-------------------------------------------------------------------- +certify(#certificate{asn1_certificates = ASN1Certs}, CertDbHandle, CertDbRef, + MaxPathLen, _Verify, VerifyFunAndState, Role) -> + [PeerCert | _] = ASN1Certs, + + ValidationFunAndState = + case VerifyFunAndState of + undefined -> + {fun(OtpCert, ExtensionOrVerifyResult, SslState) -> + ssl_certificate:validate_extension(OtpCert, + ExtensionOrVerifyResult, SslState) + end, Role}; + {Fun, UserState0} -> + {fun(OtpCert, {extension, _} = Extension, {SslState, UserState}) -> + case ssl_certificate:validate_extension(OtpCert, + Extension, + SslState) of + {valid, NewSslState} -> + {valid, {NewSslState, UserState}}; + {fail, Reason} -> + apply_user_fun(Fun, OtpCert, Reason, UserState, + SslState); + {unknown, _} -> + apply_user_fun(Fun, OtpCert, + Extension, UserState, SslState) + end; + (OtpCert, VerifyResult, {SslState, UserState}) -> + apply_user_fun(Fun, OtpCert, VerifyResult, UserState, + SslState) + end, {Role, UserState0}} + end, + + try + {TrustedErlCert, CertPath} = + ssl_certificate:trusted_cert_and_path(ASN1Certs, CertDbHandle, CertDbRef), + case public_key:pkix_path_validation(TrustedErlCert, + CertPath, + [{max_path_length, + MaxPathLen}, + {verify_fun, ValidationFunAndState}]) of + {ok, {PublicKeyInfo,_}} -> + {PeerCert, PublicKeyInfo}; + {error, Reason} -> + path_validation_alert(Reason) + end + catch + error:_ -> + %% ASN-1 decode of certificate somehow failed + ?ALERT_REC(?FATAL, ?CERTIFICATE_UNKNOWN) + end. + +%%-------------------------------------------------------------------- +-spec verify_connection(tls_version(), #finished{}, client | server, integer(), binary(), + tls_handshake_history()) -> verified | #alert{}. +%% +%% Description: Checks the ssl handshake finished message to verify +%% the connection. +%%------------------------------------------------------------------- +verify_connection(Version, #finished{verify_data = Data}, + Role, PrfAlgo, MasterSecret, {_, Handshake}) -> + %% use the previous hashes + case calc_finished(Version, Role, PrfAlgo, MasterSecret, Handshake) of + Data -> + verified; + _ -> + ?ALERT_REC(?FATAL, ?DECRYPT_ERROR) + end. +%%-------------------------------------------------------------------- +-spec decrypt_premaster_secret(binary(), #'RSAPrivateKey'{}) -> binary(). + +%% +%% Description: Public key decryption using the private key. +%%-------------------------------------------------------------------- +decrypt_premaster_secret(Secret, RSAPrivateKey) -> + try public_key:decrypt_private(Secret, RSAPrivateKey, + [{rsa_pad, rsa_pkcs1_padding}]) + catch + _:_ -> + throw(?ALERT_REC(?FATAL, ?DECRYPT_ERROR)) + end. +%%-------------------------------------------------------------------- +-spec server_key_exchange_hash(md5sha | md5 | sha | sha224 |sha256 | sha384 | sha512, binary()) -> binary(). +%% +%% Description: Calculate server key exchange hash +%%-------------------------------------------------------------------- +server_key_exchange_hash(md5sha, Value) -> + MD5 = crypto:hash(md5, Value), + SHA = crypto:hash(sha, Value), + <<MD5/binary, SHA/binary>>; + +server_key_exchange_hash(Hash, Value) -> + crypto:hash(Hash, Value). +%%-------------------------------------------------------------------- +-spec prf(tls_version(), binary(), binary(), [binary()], non_neg_integer()) -> + {ok, binary()} | {error, undefined}. +%% +%% Description: use the TLS PRF to generate key material +%%-------------------------------------------------------------------- +prf({3,0}, _, _, _, _) -> + {error, undefined}; +prf({3,1}, Secret, Label, Seed, WantedLength) -> + {ok, tls_v1:prf(?MD5SHA, Secret, Label, Seed, WantedLength)}; +prf({3,_N}, Secret, Label, Seed, WantedLength) -> + {ok, tls_v1:prf(?SHA256, Secret, Label, Seed, WantedLength)}. +%%-------------------------------------------------------------------- +-spec select_hashsign(#hash_sign_algos{}| undefined, undefined | binary()) -> + [{atom(), atom()}] | undefined. + +%% +%% Description: +%%-------------------------------------------------------------------- +select_hashsign(_, undefined) -> + {null, anon}; +select_hashsign(undefined, Cert) -> + #'OTPCertificate'{tbsCertificate = TBSCert} = public_key:pkix_decode_cert(Cert, otp), + #'OTPSubjectPublicKeyInfo'{algorithm = {_,Algo, _}} = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo, + select_cert_hashsign(undefined, Algo, {undefined, undefined}); +select_hashsign(#hash_sign_algos{hash_sign_algos = HashSigns}, Cert) -> + #'OTPCertificate'{tbsCertificate = TBSCert} =public_key:pkix_decode_cert(Cert, otp), + #'OTPSubjectPublicKeyInfo'{algorithm = {_,Algo, _}} = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo, + DefaultHashSign = {_, Sign} = select_cert_hashsign(undefined, Algo, {undefined, undefined}), + case lists:filter(fun({sha, dsa}) -> + true; + ({_, dsa}) -> + false; + ({Hash, S}) when S == Sign -> + ssl_cipher:is_acceptable_hash(Hash, proplists:get_value(hashs, crypto:supports())); + (_) -> + false + end, HashSigns) of + [] -> + DefaultHashSign; + [HashSign| _] -> + HashSign + end. +%%-------------------------------------------------------------------- +-spec select_cert_hashsign(#hash_sign_algos{}| undefined, oid(), tls_version() | {undefined, undefined}) -> + {atom(), atom()}. + +%% +%% Description: For TLS 1.2 selected cert_hash_sign will be recived +%% in the handshake message, for previous versions use appropriate defaults. +%% This function is also used by select_hashsign to extract +%% the alogrithm of the server cert key. +%%-------------------------------------------------------------------- +select_cert_hashsign(HashSign, _, {Major, Minor}) when HashSign =/= undefined andalso Major >= 3 andalso Minor >= 3 -> + HashSign; +select_cert_hashsign(undefined,?'id-ecPublicKey', _) -> + {sha, ecdsa}; +select_cert_hashsign(undefined, ?rsaEncryption, _) -> + {md5sha, rsa}; +select_cert_hashsign(undefined, ?'id-dsa', _) -> + {sha, dsa}. + +%%-------------------------------------------------------------------- +-spec master_secret(atom(), tls_version(), #session{} | binary(), #connection_states{}, + client | server) -> {binary(), #connection_states{}} | #alert{}. +%% +%% Description: Sets or calculates the master secret and calculate keys, +%% updating the pending connection states. The Mastersecret and the update +%% connection states are returned or an alert if the calculation fails. +%%------------------------------------------------------------------- +master_secret(RecordCB, Version, #session{master_secret = Mastersecret}, + ConnectionStates, Role) -> + ConnectionState = + ssl_record:pending_connection_state(ConnectionStates, read), + SecParams = ConnectionState#connection_state.security_parameters, + try master_secret(RecordCB, Version, Mastersecret, SecParams, + ConnectionStates, Role) + catch + exit:Reason -> + Report = io_lib:format("Key calculation failed due to ~p", + [Reason]), + error_logger:error_report(Report), + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) + end; + +master_secret(RecordCB, Version, PremasterSecret, ConnectionStates, Role) -> + ConnectionState = + ssl_record:pending_connection_state(ConnectionStates, read), + SecParams = ConnectionState#connection_state.security_parameters, + #security_parameters{prf_algorithm = PrfAlgo, + client_random = ClientRandom, + server_random = ServerRandom} = SecParams, + try master_secret(RecordCB, Version, + calc_master_secret(Version,PrfAlgo,PremasterSecret, + ClientRandom, ServerRandom), + SecParams, ConnectionStates, Role) + catch + exit:Reason -> + Report = io_lib:format("Master secret calculation failed" + " due to ~p", [Reason]), + error_logger:error_report(Report), + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) + end. + +%%-------------Encode/Decode -------------------------------- +encode_handshake(#next_protocol{selected_protocol = SelectedProtocol}, _Version) -> + PaddingLength = 32 - ((byte_size(SelectedProtocol) + 2) rem 32), + {?NEXT_PROTOCOL, <<?BYTE((byte_size(SelectedProtocol))), SelectedProtocol/binary, + ?BYTE(PaddingLength), 0:(PaddingLength * 8)>>}; + +encode_handshake(#server_hello{server_version = {Major, Minor}, + random = Random, + session_id = Session_ID, + cipher_suite = CipherSuite, + compression_method = Comp_method, + extensions = #hello_extensions{} = Extensions}, _Version) -> + SID_length = byte_size(Session_ID), + ExtensionsBin = encode_hello_extensions(Extensions), + {?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, + ?BYTE(SID_length), Session_ID/binary, + CipherSuite/binary, ?BYTE(Comp_method), ExtensionsBin/binary>>}; +encode_handshake(#certificate{asn1_certificates = ASN1CertList}, _Version) -> + ASN1Certs = certs_from_list(ASN1CertList), + ACLen = erlang:iolist_size(ASN1Certs), + {?CERTIFICATE, <<?UINT24(ACLen), ASN1Certs:ACLen/binary>>}; +encode_handshake(#server_key_exchange{exchange_keys = Keys}, _Version) -> + {?SERVER_KEY_EXCHANGE, Keys}; +encode_handshake(#server_key_params{params_bin = Keys, hashsign = HashSign, + signature = Signature}, Version) -> + EncSign = enc_sign(HashSign, Signature, Version), + {?SERVER_KEY_EXCHANGE, <<Keys/binary, EncSign/binary>>}; +encode_handshake(#certificate_request{certificate_types = CertTypes, + hashsign_algorithms = #hash_sign_algos{hash_sign_algos = HashSignAlgos}, + certificate_authorities = CertAuths}, + {Major, Minor}) + when Major == 3, Minor >= 3 -> + HashSigns= << <<(ssl_cipher:hash_algorithm(Hash)):8, (ssl_cipher:sign_algorithm(Sign)):8>> || + {Hash, Sign} <- HashSignAlgos >>, + CertTypesLen = byte_size(CertTypes), + HashSignsLen = byte_size(HashSigns), + CertAuthsLen = byte_size(CertAuths), + {?CERTIFICATE_REQUEST, + <<?BYTE(CertTypesLen), CertTypes/binary, + ?UINT16(HashSignsLen), HashSigns/binary, + ?UINT16(CertAuthsLen), CertAuths/binary>> + }; +encode_handshake(#certificate_request{certificate_types = CertTypes, + certificate_authorities = CertAuths}, + _Version) -> + CertTypesLen = byte_size(CertTypes), + CertAuthsLen = byte_size(CertAuths), + {?CERTIFICATE_REQUEST, + <<?BYTE(CertTypesLen), CertTypes/binary, + ?UINT16(CertAuthsLen), CertAuths/binary>> + }; +encode_handshake(#server_hello_done{}, _Version) -> + {?SERVER_HELLO_DONE, <<>>}; +encode_handshake(#client_key_exchange{exchange_keys = ExchangeKeys}, Version) -> + {?CLIENT_KEY_EXCHANGE, encode_client_key(ExchangeKeys, Version)}; +encode_handshake(#certificate_verify{signature = BinSig, hashsign_algorithm = HashSign}, Version) -> + EncSig = enc_sign(HashSign, BinSig, Version), + {?CERTIFICATE_VERIFY, EncSig}; +encode_handshake(#finished{verify_data = VerifyData}, _Version) -> + {?FINISHED, VerifyData}. + +encode_hello_extensions(#hello_extensions{} = Extensions) -> + encode_hello_extensions(hello_extensions_list(Extensions), <<>>). +encode_hello_extensions([], <<>>) -> + <<>>; +encode_hello_extensions([], Acc) -> + Size = byte_size(Acc), + <<?UINT16(Size), Acc/binary>>; + +encode_hello_extensions([#next_protocol_negotiation{extension_data = ExtensionData} | Rest], Acc) -> + Len = byte_size(ExtensionData), + encode_hello_extensions(Rest, <<?UINT16(?NEXTPROTONEG_EXT), ?UINT16(Len), + ExtensionData/binary, Acc/binary>>); +encode_hello_extensions([#renegotiation_info{renegotiated_connection = undefined} | Rest], Acc) -> + encode_hello_extensions(Rest, Acc); +encode_hello_extensions([#renegotiation_info{renegotiated_connection = ?byte(0) = Info} | Rest], Acc) -> + Len = byte_size(Info), + encode_hello_extensions(Rest, <<?UINT16(?RENEGOTIATION_EXT), ?UINT16(Len), Info/binary, Acc/binary>>); + +encode_hello_extensions([#renegotiation_info{renegotiated_connection = Info} | Rest], Acc) -> + InfoLen = byte_size(Info), + Len = InfoLen +1, + encode_hello_extensions(Rest, <<?UINT16(?RENEGOTIATION_EXT), ?UINT16(Len), ?BYTE(InfoLen), + Info/binary, Acc/binary>>); +encode_hello_extensions([#elliptic_curves{elliptic_curve_list = EllipticCurves} | Rest], Acc) -> + + EllipticCurveList = << <<(tls_v1:oid_to_enum(X)):16>> || X <- EllipticCurves>>, + ListLen = byte_size(EllipticCurveList), + Len = ListLen + 2, + encode_hello_extensions(Rest, <<?UINT16(?ELLIPTIC_CURVES_EXT), + ?UINT16(Len), ?UINT16(ListLen), EllipticCurveList/binary, Acc/binary>>); +encode_hello_extensions([#ec_point_formats{ec_point_format_list = ECPointFormats} | Rest], Acc) -> + ECPointFormatList = list_to_binary(ECPointFormats), + ListLen = byte_size(ECPointFormatList), + Len = ListLen + 1, + encode_hello_extensions(Rest, <<?UINT16(?EC_POINT_FORMATS_EXT), + ?UINT16(Len), ?BYTE(ListLen), ECPointFormatList/binary, Acc/binary>>); +encode_hello_extensions([#srp{username = UserName} | Rest], Acc) -> + SRPLen = byte_size(UserName), + Len = SRPLen + 2, + encode_hello_extensions(Rest, <<?UINT16(?SRP_EXT), ?UINT16(Len), ?BYTE(SRPLen), + UserName/binary, Acc/binary>>); +encode_hello_extensions([#hash_sign_algos{hash_sign_algos = HashSignAlgos} | Rest], Acc) -> + SignAlgoList = << <<(ssl_cipher:hash_algorithm(Hash)):8, (ssl_cipher:sign_algorithm(Sign)):8>> || + {Hash, Sign} <- HashSignAlgos >>, + ListLen = byte_size(SignAlgoList), + Len = ListLen + 2, + encode_hello_extensions(Rest, <<?UINT16(?SIGNATURE_ALGORITHMS_EXT), + ?UINT16(Len), ?UINT16(ListLen), SignAlgoList/binary, Acc/binary>>). + +enc_server_key_exchange(Version, Params, {HashAlgo, SignAlgo}, + ClientRandom, ServerRandom, PrivateKey) -> + EncParams = encode_server_key(Params), + case HashAlgo of + null -> + #server_key_params{params = Params, + params_bin = EncParams, + hashsign = {null, anon}, + signature = <<>>}; + _ -> + Hash = + server_key_exchange_hash(HashAlgo, <<ClientRandom/binary, + ServerRandom/binary, + EncParams/binary>>), + Signature = digitally_signed(Version, Hash, HashAlgo, PrivateKey), + #server_key_params{params = Params, + params_bin = EncParams, + hashsign = {HashAlgo, SignAlgo}, + signature = Signature} + end. + +%%-------------------------------------------------------------------- +-spec decode_client_key(binary(), key_algo(), tls_version()) -> + #encrypted_premaster_secret{} + | #client_diffie_hellman_public{} + | #client_ec_diffie_hellman_public{} + | #client_psk_identity{} + | #client_dhe_psk_identity{} + | #client_rsa_psk_identity{} + | #client_srp_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). + +%%-------------------------------------------------------------------- +-spec decode_server_key(binary(), key_algo(), tls_version()) -> + #server_key_params{}. +%% +%% Description: Decode server_key data and return appropriate type +%%-------------------------------------------------------------------- +decode_server_key(ServerKey, Type, Version) -> + dec_server_key(ServerKey, key_exchange_alg(Type), Version). + +encode_client_protocol_negotiation(undefined, _) -> + undefined; +encode_client_protocol_negotiation(_, false) -> + #next_protocol_negotiation{extension_data = <<>>}; +encode_client_protocol_negotiation(_, _) -> + undefined. + +encode_protocols_advertised_on_server(undefined) -> + undefined; + +encode_protocols_advertised_on_server(Protocols) -> + #next_protocol_negotiation{extension_data = lists:foldl(fun encode_protocol/2, <<>>, Protocols)}. + +decode_handshake(_, ?HELLO_REQUEST, <<>>) -> + #hello_request{}; +decode_handshake(_, ?NEXT_PROTOCOL, <<?BYTE(SelectedProtocolLength), + SelectedProtocol:SelectedProtocolLength/binary, + ?BYTE(PaddingLength), _Padding:PaddingLength/binary>>) -> + #next_protocol{selected_protocol = SelectedProtocol}; + +decode_handshake(_Version, ?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, + ?BYTE(SID_length), Session_ID:SID_length/binary, + Cipher_suite:2/binary, ?BYTE(Comp_method)>>) -> + #server_hello{ + server_version = {Major,Minor}, + random = Random, + session_id = Session_ID, + cipher_suite = Cipher_suite, + compression_method = Comp_method, + extensions = #hello_extensions{}}; + +decode_handshake(_Version, ?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>>) -> + + HelloExtensions = decode_hello_extensions(Extensions), + + #server_hello{ + server_version = {Major,Minor}, + random = Random, + session_id = Session_ID, + cipher_suite = Cipher_suite, + compression_method = Comp_method, + extensions = HelloExtensions}; + +decode_handshake(_Version, ?CERTIFICATE, <<?UINT24(ACLen), ASN1Certs:ACLen/binary>>) -> + #certificate{asn1_certificates = certs_to_list(ASN1Certs)}; +decode_handshake(_Version, ?SERVER_KEY_EXCHANGE, Keys) -> + #server_key_exchange{exchange_keys = Keys}; +decode_handshake({Major, Minor}, ?CERTIFICATE_REQUEST, + <<?BYTE(CertTypesLen), CertTypes:CertTypesLen/binary, + ?UINT16(HashSignsLen), HashSigns:HashSignsLen/binary, + ?UINT16(CertAuthsLen), CertAuths:CertAuthsLen/binary>>) + when Major >= 3, Minor >= 3 -> + HashSignAlgos = [{ssl_cipher:hash_algorithm(Hash), ssl_cipher:sign_algorithm(Sign)} || + <<?BYTE(Hash), ?BYTE(Sign)>> <= HashSigns], + #certificate_request{certificate_types = CertTypes, + hashsign_algorithms = #hash_sign_algos{hash_sign_algos = HashSignAlgos}, + certificate_authorities = CertAuths}; +decode_handshake(_Version, ?CERTIFICATE_REQUEST, + <<?BYTE(CertTypesLen), CertTypes:CertTypesLen/binary, + ?UINT16(CertAuthsLen), CertAuths:CertAuthsLen/binary>>) -> + #certificate_request{certificate_types = CertTypes, + certificate_authorities = CertAuths}; +decode_handshake(_Version, ?SERVER_HELLO_DONE, <<>>) -> + #server_hello_done{}; +decode_handshake({Major, Minor}, ?CERTIFICATE_VERIFY,<<HashSign:2/binary, ?UINT16(SignLen), + Signature:SignLen/binary>>) + when Major == 3, Minor >= 3 -> + #certificate_verify{hashsign_algorithm = dec_hashsign(HashSign), signature = Signature}; +decode_handshake(_Version, ?CERTIFICATE_VERIFY,<<?UINT16(SignLen), Signature:SignLen/binary>>)-> + #certificate_verify{signature = Signature}; +decode_handshake(_Version, ?CLIENT_KEY_EXCHANGE, PKEPMS) -> + #client_key_exchange{exchange_keys = PKEPMS}; +decode_handshake(_Version, ?FINISHED, VerifyData) -> + #finished{verify_data = VerifyData}; +decode_handshake(_, _, _) -> + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE)). + +%%-------------------------------------------------------------------- +-spec decode_hello_extensions({client, binary()} | binary()) -> #hello_extensions{}. +%% +%% Description: Decodes TLS hello extensions +%%-------------------------------------------------------------------- +decode_hello_extensions({client, <<>>}) -> + #hello_extensions{}; +decode_hello_extensions({client, <<?UINT16(ExtLen), Extensions:ExtLen/binary>>}) -> + decode_hello_extensions(Extensions); +decode_hello_extensions(Extensions) -> + dec_hello_extensions(Extensions, #hello_extensions{}). + +dec_server_key(<<?UINT16(PLen), P:PLen/binary, + ?UINT16(GLen), G:GLen/binary, + ?UINT16(YLen), Y:YLen/binary, _/binary>> = KeyStruct, + ?KEY_EXCHANGE_DIFFIE_HELLMAN, Version) -> + Params = #server_dh_params{dh_p = P, dh_g = G, dh_y = Y}, + {BinMsg, HashSign, Signature} = dec_server_key_params(PLen + GLen + YLen + 6, KeyStruct, Version), + #server_key_params{params = Params, + params_bin = BinMsg, + hashsign = HashSign, + signature = Signature}; +%% ECParameters with named_curve +%% TODO: explicit curve +dec_server_key(<<?BYTE(?NAMED_CURVE), ?UINT16(CurveID), + ?BYTE(PointLen), ECPoint:PointLen/binary, + _/binary>> = KeyStruct, + ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN, Version) -> + Params = #server_ecdh_params{curve = {namedCurve, tls_v1:enum_to_oid(CurveID)}, + public = ECPoint}, + {BinMsg, HashSign, Signature} = dec_server_key_params(PointLen + 4, KeyStruct, Version), + #server_key_params{params = Params, + params_bin = BinMsg, + hashsign = HashSign, + signature = Signature}; +dec_server_key(<<?UINT16(Len), PskIdentityHint:Len/binary, _/binary>> = KeyStruct, + KeyExchange, Version) + when KeyExchange == ?KEY_EXCHANGE_PSK; KeyExchange == ?KEY_EXCHANGE_RSA_PSK -> + Params = #server_psk_params{ + hint = PskIdentityHint}, + {BinMsg, HashSign, Signature} = dec_server_key_params(Len + 2, KeyStruct, Version), + #server_key_params{params = Params, + params_bin = BinMsg, + hashsign = HashSign, + signature = Signature}; +dec_server_key(<<?UINT16(Len), IdentityHint:Len/binary, + ?UINT16(PLen), P:PLen/binary, + ?UINT16(GLen), G:GLen/binary, + ?UINT16(YLen), Y:YLen/binary, _/binary>> = KeyStruct, + ?KEY_EXCHANGE_DHE_PSK, Version) -> + DHParams = #server_dh_params{dh_p = P, dh_g = G, dh_y = Y}, + Params = #server_dhe_psk_params{ + hint = IdentityHint, + dh_params = DHParams}, + {BinMsg, HashSign, Signature} = dec_server_key_params(Len + PLen + GLen + YLen + 8, KeyStruct, Version), + #server_key_params{params = Params, + params_bin = BinMsg, + hashsign = HashSign, + signature = Signature}; +dec_server_key(<<?UINT16(NLen), N:NLen/binary, + ?UINT16(GLen), G:GLen/binary, + ?BYTE(SLen), S:SLen/binary, + ?UINT16(BLen), B:BLen/binary, _/binary>> = KeyStruct, + ?KEY_EXCHANGE_SRP, Version) -> + Params = #server_srp_params{srp_n = N, srp_g = G, srp_s = S, srp_b = B}, + {BinMsg, HashSign, Signature} = dec_server_key_params(NLen + GLen + SLen + BLen + 7, KeyStruct, Version), + #server_key_params{params = Params, + params_bin = BinMsg, + hashsign = HashSign, + signature = Signature}; +dec_server_key(_, _, _) -> + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE)). + +%%-------------------------------------------------------------------- +-spec decode_suites('2_bytes'|'3_bytes', binary()) -> list(). +%% +%% Description: +%%-------------------------------------------------------------------- +decode_suites('2_bytes', Dec) -> + from_2bytes(Dec); +decode_suites('3_bytes', Dec) -> + from_3bytes(Dec). + +%%-------------Cipeher suite handling -------------------------------- + +available_suites(UserSuites, Version) -> + case UserSuites of + [] -> + ssl_cipher:suites(Version); + _ -> + UserSuites + end. + +available_suites(ServerCert, UserSuites, Version, Curve) -> + ssl_cipher:filter(ServerCert, available_suites(UserSuites, Version)) + -- unavailable_ecc_suites(Curve). + +unavailable_ecc_suites(no_curve) -> + ssl_cipher:ec_keyed_suites(); +unavailable_ecc_suites(_) -> + []. + +cipher_suites(Suites, false) -> + [?TLS_EMPTY_RENEGOTIATION_INFO_SCSV | Suites]; +cipher_suites(Suites, true) -> + Suites. + +select_session(SuggestedSessionId, CipherSuites, Compressions, Port, #session{ecc = ECCCurve} = + Session, Version, + #ssl_options{ciphers = UserSuites} = SslOpts, Cache, CacheCb, Cert) -> + {SessionId, Resumed} = ssl_session:server_id(Port, SuggestedSessionId, + SslOpts, Cert, + Cache, CacheCb), + case Resumed of + undefined -> + Suites = available_suites(Cert, UserSuites, Version, ECCCurve), + CipherSuite = select_cipher_suite(CipherSuites, Suites), + Compression = select_compression(Compressions), + {new, Session#session{session_id = SessionId, + cipher_suite = CipherSuite, + compression_method = Compression}}; + _ -> + {resumed, Resumed} + end. + +supported_ecc(Version) -> + case tls_v1:ecc_curves(Version) of + [] -> + undefined; + Curves -> + #elliptic_curves{elliptic_curve_list = Curves} + end. +%%-------------certificate handling -------------------------------- + +certificate_types({KeyExchange, _, _, _}) + when KeyExchange == rsa; + KeyExchange == dhe_dss; + KeyExchange == dhe_rsa; + KeyExchange == ecdhe_rsa -> + <<?BYTE(?RSA_SIGN), ?BYTE(?DSS_SIGN)>>; + +certificate_types({KeyExchange, _, _, _}) + when KeyExchange == dh_ecdsa; + KeyExchange == dhe_ecdsa -> + <<?BYTE(?ECDSA_SIGN)>>; + +certificate_types(_) -> + <<?BYTE(?RSA_SIGN)>>. + +certificate_authorities(CertDbHandle, CertDbRef) -> + Authorities = certificate_authorities_from_db(CertDbHandle, CertDbRef), + Enc = fun(#'OTPCertificate'{tbsCertificate=TBSCert}) -> + OTPSubj = TBSCert#'OTPTBSCertificate'.subject, + DNEncodedBin = public_key:pkix_encode('Name', OTPSubj, otp), + DNEncodedLen = byte_size(DNEncodedBin), + <<?UINT16(DNEncodedLen), DNEncodedBin/binary>> + end, + list_to_binary([Enc(Cert) || {_, Cert} <- Authorities]). + +certificate_authorities_from_db(CertDbHandle, CertDbRef) -> + ConnectionCerts = fun({{Ref, _, _}, Cert}, Acc) when Ref == CertDbRef -> + [Cert | Acc]; + (_, Acc) -> + Acc + end, + ssl_pkix_db:foldl(ConnectionCerts, [], CertDbHandle). + +%%-------------Extension handling -------------------------------- + +handle_client_hello_extensions(RecordCB, Random, + #hello_extensions{renegotiation_info = Info, + srp = SRP, + ec_point_formats = ECCFormat, + next_protocol_negotiation = NextProtocolNegotiation}, Version, + #ssl_options{secure_renegotiate = SecureRenegotation} = Opts, + #session{cipher_suite = CipherSuite, compression_method = Compression} = Session0, + ConnectionStates0, Renegotiation) -> + Session = handle_srp_extension(SRP, Session0), + ConnectionStates = handle_renegotiation_extension(server, RecordCB, Version, Info, + Random, CipherSuite, Compression, + ConnectionStates0, Renegotiation, SecureRenegotation), + ProtocolsToAdvertise = handle_next_protocol_extension(NextProtocolNegotiation, Renegotiation, Opts), + + ServerHelloExtensions = #hello_extensions{ + renegotiation_info = renegotiation_info(RecordCB, server, + ConnectionStates, Renegotiation), + ec_point_formats = server_ecc_extension(Version, ECCFormat), + next_protocol_negotiation = + encode_protocols_advertised_on_server(ProtocolsToAdvertise) + }, + {Session, ConnectionStates, ServerHelloExtensions}. + +handle_server_hello_extensions(RecordCB, Random, CipherSuite, Compression, + #hello_extensions{renegotiation_info = Info, + next_protocol_negotiation = NextProtocolNegotiation}, Version, + #ssl_options{secure_renegotiate = SecureRenegotation, + next_protocol_selector = NextProtoSelector}, + ConnectionStates0, Renegotiation) -> + ConnectionStates = handle_renegotiation_extension(client, RecordCB, Version, Info, Random, CipherSuite, + Compression, ConnectionStates0, + Renegotiation, SecureRenegotation), + case handle_next_protocol(NextProtocolNegotiation, NextProtoSelector, Renegotiation) of + #alert{} = Alert -> + Alert; + Protocol -> + {ConnectionStates, Protocol} + end. + +select_version(RecordCB, ClientVersion, Versions) -> + ServerVersion = RecordCB:highest_protocol_version(Versions), + RecordCB:lowest_protocol_version(ClientVersion, ServerVersion). + +renegotiation_info(_, client, _, false) -> + #renegotiation_info{renegotiated_connection = undefined}; +renegotiation_info(_RecordCB, server, ConnectionStates, false) -> + CS = ssl_record:current_connection_state(ConnectionStates, read), + case CS#connection_state.secure_renegotiation of + true -> + #renegotiation_info{renegotiated_connection = ?byte(0)}; + false -> + #renegotiation_info{renegotiated_connection = undefined} + end; +renegotiation_info(_RecordCB, client, ConnectionStates, true) -> + CS = ssl_record:current_connection_state(ConnectionStates, read), + case CS#connection_state.secure_renegotiation of + true -> + Data = CS#connection_state.client_verify_data, + #renegotiation_info{renegotiated_connection = Data}; + false -> + #renegotiation_info{renegotiated_connection = undefined} + end; + +renegotiation_info(_RecordCB, server, ConnectionStates, true) -> + CS = ssl_record:current_connection_state(ConnectionStates, read), + case CS#connection_state.secure_renegotiation of + true -> + CData = CS#connection_state.client_verify_data, + SData =CS#connection_state.server_verify_data, + #renegotiation_info{renegotiated_connection = <<CData/binary, SData/binary>>}; + false -> + #renegotiation_info{renegotiated_connection = undefined} + end. + +handle_renegotiation_info(_RecordCB, _, #renegotiation_info{renegotiated_connection = ?byte(0)}, + ConnectionStates, false, _, _) -> + {ok, ssl_record:set_renegotiation_flag(true, ConnectionStates)}; + +handle_renegotiation_info(_RecordCB, server, undefined, ConnectionStates, _, _, CipherSuites) -> + case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of + true -> + {ok, ssl_record:set_renegotiation_flag(true, ConnectionStates)}; + false -> + {ok, ssl_record:set_renegotiation_flag(false, ConnectionStates)} + end; + +handle_renegotiation_info(_RecordCB, _, undefined, ConnectionStates, false, _, _) -> + {ok, ssl_record:set_renegotiation_flag(false, ConnectionStates)}; + +handle_renegotiation_info(_RecordCB, client, #renegotiation_info{renegotiated_connection = ClientServerVerify}, + ConnectionStates, true, _, _) -> + CS = ssl_record:current_connection_state(ConnectionStates, read), + CData = CS#connection_state.client_verify_data, + SData = CS#connection_state.server_verify_data, + case <<CData/binary, SData/binary>> == ClientServerVerify of + true -> + {ok, ConnectionStates}; + false -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) + end; +handle_renegotiation_info(_RecordCB, server, #renegotiation_info{renegotiated_connection = ClientVerify}, + ConnectionStates, true, _, CipherSuites) -> + + case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of + true -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); + false -> + CS = ssl_record:current_connection_state(ConnectionStates, read), + Data = CS#connection_state.client_verify_data, + case Data == ClientVerify of + true -> + {ok, ConnectionStates}; + false -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) + end + end; + +handle_renegotiation_info(RecordCB, client, undefined, ConnectionStates, true, SecureRenegotation, _) -> + handle_renegotiation_info(RecordCB, ConnectionStates, SecureRenegotation); + +handle_renegotiation_info(RecordCB, server, undefined, ConnectionStates, true, SecureRenegotation, CipherSuites) -> + case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of + true -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); + false -> + handle_renegotiation_info(RecordCB, ConnectionStates, SecureRenegotation) + end. + +handle_renegotiation_info(_RecordCB, ConnectionStates, SecureRenegotation) -> + CS = ssl_record:current_connection_state(ConnectionStates, read), + case {SecureRenegotation, CS#connection_state.secure_renegotiation} of + {_, true} -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); + {true, false} -> + ?ALERT_REC(?FATAL, ?NO_RENEGOTIATION); + {false, false} -> + {ok, ConnectionStates} + end. + +hello_extensions_list(#hello_extensions{renegotiation_info = RenegotiationInfo, + srp = SRP, + hash_signs = HashSigns, + ec_point_formats = EcPointFormats, + elliptic_curves = EllipticCurves, + next_protocol_negotiation = NextProtocolNegotiation}) -> + [Ext || Ext <- [RenegotiationInfo, SRP, HashSigns, + EcPointFormats,EllipticCurves, NextProtocolNegotiation], Ext =/= undefined]. + +srp_user(#ssl_options{srp_identity = {UserName, _}}) -> + #srp{username = UserName}; +srp_user(_) -> + undefined. + +client_ecc_extensions(Module, Version) -> + CryptoSupport = proplists:get_value(public_keys, crypto:supports()), + case proplists:get_bool(ecdh, CryptoSupport) of + true -> + EcPointFormats = #ec_point_formats{ec_point_format_list = [?ECPOINT_UNCOMPRESSED]}, + EllipticCurves = #elliptic_curves{elliptic_curve_list = Module:ecc_curves(Version)}, + {EcPointFormats, EllipticCurves}; + _ -> + {undefined, undefined} + end. + +server_ecc_extension(_Version, EcPointFormats) -> + CryptoSupport = proplists:get_value(public_keys, crypto:supports()), + case proplists:get_bool(ecdh, CryptoSupport) of + true -> + handle_ecc_point_fmt_extension(EcPointFormats); + false -> + undefined + end. + +handle_ecc_point_fmt_extension(undefined) -> + undefined; +handle_ecc_point_fmt_extension(_) -> + #ec_point_formats{ec_point_format_list = [?ECPOINT_UNCOMPRESSED]}. + +advertises_ec_ciphers([]) -> + false; +advertises_ec_ciphers([{ecdh_ecdsa, _,_,_} | _]) -> + true; +advertises_ec_ciphers([{ecdhe_ecdsa, _,_,_} | _]) -> + true; +advertises_ec_ciphers([{ecdh_rsa, _,_,_} | _]) -> + true; +advertises_ec_ciphers([{ecdhe_rsa, _,_,_} | _]) -> + true; +advertises_ec_ciphers([{ecdh_anon, _,_,_} | _]) -> + true; +advertises_ec_ciphers([_| Rest]) -> + advertises_ec_ciphers(Rest). +select_curve(#elliptic_curves{elliptic_curve_list = ClientCurves}, + #elliptic_curves{elliptic_curve_list = ServerCurves}) -> + select_curve(ClientCurves, ServerCurves); +select_curve(undefined, _) -> + %% Client did not send ECC extension use default curve if + %% ECC cipher is negotiated + {namedCurve, ?secp256k1}; +select_curve(_, []) -> + no_curve; +select_curve(Curves, [Curve| Rest]) -> + case lists:member(Curve, Curves) of + true -> + {namedCurve, Curve}; + false -> + select_curve(Curves, Rest) + end. + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +apply_user_fun(Fun, OtpCert, ExtensionOrError, UserState0, SslState) -> + case Fun(OtpCert, ExtensionOrError, UserState0) of + {valid, UserState} -> + {valid, {SslState, UserState}}; + {fail, _} = Fail -> + Fail; + {unknown, UserState} -> + {unknown, {SslState, UserState}} + end. +path_validation_alert({bad_cert, cert_expired}) -> + ?ALERT_REC(?FATAL, ?CERTIFICATE_EXPIRED); +path_validation_alert({bad_cert, invalid_issuer}) -> + ?ALERT_REC(?FATAL, ?BAD_CERTIFICATE); +path_validation_alert({bad_cert, invalid_signature}) -> + ?ALERT_REC(?FATAL, ?BAD_CERTIFICATE); +path_validation_alert({bad_cert, name_not_permitted}) -> + ?ALERT_REC(?FATAL, ?BAD_CERTIFICATE); +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, selfsigned_peer}) -> + ?ALERT_REC(?FATAL, ?BAD_CERTIFICATE); +path_validation_alert({bad_cert, unknown_ca}) -> + ?ALERT_REC(?FATAL, ?UNKNOWN_CA); +path_validation_alert(_) -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE). + +encrypted_premaster_secret(Secret, RSAPublicKey) -> + try + PreMasterSecret = public_key:encrypt_public(Secret, RSAPublicKey, + [{rsa_pad, + rsa_pkcs1_padding}]), + #encrypted_premaster_secret{premaster_secret = PreMasterSecret} + catch + _:_-> + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE)) + end. + +digitally_signed({3, Minor}, Hash, HashAlgo, Key) when Minor >= 3 -> + public_key:sign({digest, Hash}, HashAlgo, Key); +digitally_signed(_Version, Hash, HashAlgo, #'DSAPrivateKey'{} = Key) -> + public_key:sign({digest, Hash}, HashAlgo, Key); +digitally_signed(_Version, Hash, _HashAlgo, #'RSAPrivateKey'{} = Key) -> + public_key:encrypt_private(Hash, Key, + [{rsa_pad, rsa_pkcs1_padding}]); +digitally_signed(_Version, Hash, HashAlgo, Key) -> + public_key:sign({digest, Hash}, HashAlgo, Key). + +calc_certificate_verify({3, 0}, HashAlgo, MasterSecret, Handshake) -> + ssl_v3:certificate_verify(HashAlgo, MasterSecret, lists:reverse(Handshake)); +calc_certificate_verify({3, N}, HashAlgo, _MasterSecret, Handshake) -> + tls_v1:certificate_verify(HashAlgo, N, lists:reverse(Handshake)). + +calc_finished({3, 0}, Role, _PrfAlgo, MasterSecret, Handshake) -> + ssl_v3:finished(Role, MasterSecret, lists:reverse(Handshake)); +calc_finished({3, N}, Role, PrfAlgo, MasterSecret, Handshake) -> + tls_v1:finished(Role, N, PrfAlgo, MasterSecret, lists:reverse(Handshake)). + +master_secret(_RecordCB, Version, MasterSecret, + #security_parameters{ + client_random = ClientRandom, + server_random = ServerRandom, + hash_size = HashSize, + prf_algorithm = PrfAlgo, + key_material_length = KML, + expanded_key_material_length = EKML, + iv_size = IVS}, + ConnectionStates, Role) -> + {ClientWriteMacSecret, ServerWriteMacSecret, ClientWriteKey, + ServerWriteKey, ClientIV, ServerIV} = + setup_keys(Version, PrfAlgo, MasterSecret, ServerRandom, + ClientRandom, HashSize, KML, EKML, IVS), + + ConnStates1 = ssl_record:set_master_secret(MasterSecret, ConnectionStates), + ConnStates2 = + ssl_record:set_mac_secret(ClientWriteMacSecret, ServerWriteMacSecret, + Role, ConnStates1), + + ClientCipherState = #cipher_state{iv = ClientIV, key = ClientWriteKey}, + ServerCipherState = #cipher_state{iv = ServerIV, key = ServerWriteKey}, + {MasterSecret, + ssl_record:set_pending_cipher_state(ConnStates2, ClientCipherState, + ServerCipherState, Role)}. + +setup_keys({3,0}, _PrfAlgo, MasterSecret, + ServerRandom, ClientRandom, HashSize, KML, EKML, IVS) -> + ssl_v3:setup_keys(MasterSecret, ServerRandom, + ClientRandom, HashSize, KML, EKML, IVS); + +setup_keys({3,N}, PrfAlgo, MasterSecret, + ServerRandom, ClientRandom, HashSize, KML, _EKML, IVS) -> + tls_v1:setup_keys(N, PrfAlgo, MasterSecret, ServerRandom, ClientRandom, HashSize, + KML, IVS). + +calc_master_secret({3,0}, _PrfAlgo, PremasterSecret, ClientRandom, ServerRandom) -> + ssl_v3:master_secret(PremasterSecret, ClientRandom, ServerRandom); + +calc_master_secret({3,_}, PrfAlgo, PremasterSecret, ClientRandom, ServerRandom) -> + tls_v1:master_secret(PrfAlgo, PremasterSecret, ClientRandom, ServerRandom). + +handle_renegotiation_extension(Role, RecordCB, Version, Info, Random, CipherSuite, Compression, + ConnectionStates0, Renegotiation, SecureRenegotation) -> + case handle_renegotiation_info(RecordCB, Role, Info, ConnectionStates0, + Renegotiation, SecureRenegotation, + [CipherSuite]) of + {ok, ConnectionStates} -> + hello_pending_connection_states(RecordCB, Role, + Version, + CipherSuite, + Random, + Compression, + ConnectionStates); + #alert{} = Alert -> + throw(Alert) + end. + +%% Update pending connection states with parameters exchanged via +%% hello messages +%% NOTE : Role is the role of the receiver of the hello message +%% currently being processed. +hello_pending_connection_states(_RecordCB, Role, Version, CipherSuite, Random, Compression, + ConnectionStates) -> + ReadState = + ssl_record:pending_connection_state(ConnectionStates, read), + WriteState = + ssl_record:pending_connection_state(ConnectionStates, write), + + NewReadSecParams = + hello_security_parameters(Role, Version, ReadState, CipherSuite, + Random, Compression), + + NewWriteSecParams = + hello_security_parameters(Role, Version, WriteState, CipherSuite, + Random, Compression), + + ssl_record:set_security_params(NewReadSecParams, + NewWriteSecParams, + ConnectionStates). + +hello_security_parameters(client, Version, ConnectionState, CipherSuite, Random, + Compression) -> + SecParams = ConnectionState#connection_state.security_parameters, + NewSecParams = ssl_cipher:security_parameters(Version, CipherSuite, SecParams), + NewSecParams#security_parameters{ + server_random = Random, + compression_algorithm = Compression + }; + +hello_security_parameters(server, Version, ConnectionState, CipherSuite, Random, + Compression) -> + SecParams = ConnectionState#connection_state.security_parameters, + NewSecParams = ssl_cipher:security_parameters(Version, CipherSuite, SecParams), + NewSecParams#security_parameters{ + client_random = Random, + compression_algorithm = Compression + }. + +%%-------------Encode/Decode -------------------------------- + +encode_server_key(#server_dh_params{dh_p = P, dh_g = G, dh_y = Y}) -> + PLen = byte_size(P), + GLen = byte_size(G), + YLen = byte_size(Y), + <<?UINT16(PLen), P/binary, ?UINT16(GLen), G/binary, ?UINT16(YLen), Y/binary>>; +encode_server_key(#server_ecdh_params{curve = {namedCurve, ECCurve}, public = ECPubKey}) -> + %%TODO: support arbitrary keys + KLen = size(ECPubKey), + <<?BYTE(?NAMED_CURVE), ?UINT16((tls_v1:oid_to_enum(ECCurve))), + ?BYTE(KLen), ECPubKey/binary>>; +encode_server_key(#server_psk_params{hint = PskIdentityHint}) -> + Len = byte_size(PskIdentityHint), + <<?UINT16(Len), PskIdentityHint/binary>>; +encode_server_key(Params = #server_dhe_psk_params{hint = undefined}) -> + encode_server_key(Params#server_dhe_psk_params{hint = <<>>}); +encode_server_key(#server_dhe_psk_params{ + hint = PskIdentityHint, + dh_params = #server_dh_params{dh_p = P, dh_g = G, dh_y = Y}}) -> + Len = byte_size(PskIdentityHint), + PLen = byte_size(P), + GLen = byte_size(G), + YLen = byte_size(Y), + <<?UINT16(Len), PskIdentityHint/binary, + ?UINT16(PLen), P/binary, ?UINT16(GLen), G/binary, ?UINT16(YLen), Y/binary>>; +encode_server_key(#server_srp_params{srp_n = N, srp_g = G, srp_s = S, srp_b = B}) -> + NLen = byte_size(N), + GLen = byte_size(G), + SLen = byte_size(S), + BLen = byte_size(B), + <<?UINT16(NLen), N/binary, ?UINT16(GLen), G/binary, + ?BYTE(SLen), S/binary, ?UINT16(BLen), B/binary>>. + +encode_client_key(#encrypted_premaster_secret{premaster_secret = PKEPMS},{3, 0}) -> + PKEPMS; +encode_client_key(#encrypted_premaster_secret{premaster_secret = PKEPMS}, _) -> + PKEPMSLen = byte_size(PKEPMS), + <<?UINT16(PKEPMSLen), PKEPMS/binary>>; +encode_client_key(#client_diffie_hellman_public{dh_public = DHPublic}, _) -> + Len = byte_size(DHPublic), + <<?UINT16(Len), DHPublic/binary>>; +encode_client_key(#client_ec_diffie_hellman_public{dh_public = DHPublic}, _) -> + Len = byte_size(DHPublic), + <<?BYTE(Len), DHPublic/binary>>; +encode_client_key(#client_psk_identity{identity = undefined}, _) -> + Id = <<"psk_identity">>, + Len = byte_size(Id), + <<?UINT16(Len), Id/binary>>; +encode_client_key(#client_psk_identity{identity = Id}, _) -> + Len = byte_size(Id), + <<?UINT16(Len), Id/binary>>; +encode_client_key(Identity = #client_dhe_psk_identity{identity = undefined}, Version) -> + encode_client_key(Identity#client_dhe_psk_identity{identity = <<"psk_identity">>}, Version); +encode_client_key(#client_dhe_psk_identity{identity = Id, dh_public = DHPublic}, _) -> + Len = byte_size(Id), + DHLen = byte_size(DHPublic), + <<?UINT16(Len), Id/binary, ?UINT16(DHLen), DHPublic/binary>>; +encode_client_key(Identity = #client_rsa_psk_identity{identity = undefined}, Version) -> + encode_client_key(Identity#client_rsa_psk_identity{identity = <<"psk_identity">>}, Version); +encode_client_key(#client_rsa_psk_identity{identity = Id, exchange_keys = ExchangeKeys}, Version) -> + EncPMS = encode_client_key(ExchangeKeys, Version), + Len = byte_size(Id), + <<?UINT16(Len), Id/binary, EncPMS/binary>>; +encode_client_key(#client_srp_public{srp_a = A}, _) -> + Len = byte_size(A), + <<?UINT16(Len), A/binary>>. + +enc_sign({_, anon}, _Sign, _Version) -> + <<>>; +enc_sign({HashAlg, SignAlg}, Signature, _Version = {Major, Minor}) + when Major == 3, Minor >= 3-> + SignLen = byte_size(Signature), + HashSign = enc_hashsign(HashAlg, SignAlg), + <<HashSign/binary, ?UINT16(SignLen), Signature/binary>>; +enc_sign(_HashSign, Sign, _Version) -> + SignLen = byte_size(Sign), + <<?UINT16(SignLen), Sign/binary>>. + +enc_hashsign(HashAlgo, SignAlgo) -> + Hash = ssl_cipher:hash_algorithm(HashAlgo), + Sign = ssl_cipher:sign_algorithm(SignAlgo), + <<?BYTE(Hash), ?BYTE(Sign)>>. + +encode_protocol(Protocol, Acc) -> + Len = byte_size(Protocol), + <<Acc/binary, ?BYTE(Len), Protocol/binary>>. + +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_client_key(<<>>, ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN, _) -> + throw(?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE)); +dec_client_key(<<?BYTE(DH_YLen), DH_Y:DH_YLen/binary>>, + ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN, _) -> + #client_ec_diffie_hellman_public{dh_public = DH_Y}; +dec_client_key(<<?UINT16(Len), Id:Len/binary>>, + ?KEY_EXCHANGE_PSK, _) -> + #client_psk_identity{identity = Id}; +dec_client_key(<<?UINT16(Len), Id:Len/binary, + ?UINT16(DH_YLen), DH_Y:DH_YLen/binary>>, + ?KEY_EXCHANGE_DHE_PSK, _) -> + #client_dhe_psk_identity{identity = Id, dh_public = DH_Y}; +dec_client_key(<<?UINT16(Len), Id:Len/binary, PKEPMS/binary>>, + ?KEY_EXCHANGE_RSA_PSK, {3, 0}) -> + #client_rsa_psk_identity{identity = Id, + exchange_keys = #encrypted_premaster_secret{premaster_secret = PKEPMS}}; +dec_client_key(<<?UINT16(Len), Id:Len/binary, ?UINT16(_), PKEPMS/binary>>, + ?KEY_EXCHANGE_RSA_PSK, _) -> + #client_rsa_psk_identity{identity = Id, + exchange_keys = #encrypted_premaster_secret{premaster_secret = PKEPMS}}; +dec_client_key(<<?UINT16(ALen), A:ALen/binary>>, + ?KEY_EXCHANGE_SRP, _) -> + #client_srp_public{srp_a = A}. + +dec_server_key_params(Len, Keys, Version) -> + <<Params:Len/bytes, Signature/binary>> = Keys, + dec_server_key_signature(Params, Signature, Version). + +dec_server_key_signature(Params, <<?BYTE(HashAlgo), ?BYTE(SignAlgo), + ?UINT16(0)>>, {Major, Minor}) + when Major == 3, Minor >= 3 -> + HashSign = {ssl_cipher:hash_algorithm(HashAlgo), ssl_cipher:sign_algorithm(SignAlgo)}, + {Params, HashSign, <<>>}; +dec_server_key_signature(Params, <<?BYTE(HashAlgo), ?BYTE(SignAlgo), + ?UINT16(Len), Signature:Len/binary>>, {Major, Minor}) + when Major == 3, Minor >= 3 -> + HashSign = {ssl_cipher:hash_algorithm(HashAlgo), ssl_cipher:sign_algorithm(SignAlgo)}, + {Params, HashSign, Signature}; +dec_server_key_signature(Params, <<>>, _) -> + {Params, {null, anon}, <<>>}; +dec_server_key_signature(Params, <<?UINT16(0)>>, _) -> + {Params, {null, anon}, <<>>}; +dec_server_key_signature(Params, <<?UINT16(Len), Signature:Len/binary>>, _) -> + {Params, undefined, Signature}; +dec_server_key_signature(_, _, _) -> + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE)). + +dec_hello_extensions(<<>>, Acc) -> + Acc; +dec_hello_extensions(<<?UINT16(?NEXTPROTONEG_EXT), ?UINT16(Len), ExtensionData:Len/binary, Rest/binary>>, Acc) -> + NextP = #next_protocol_negotiation{extension_data = ExtensionData}, + dec_hello_extensions(Rest, Acc#hello_extensions{next_protocol_negotiation = NextP}); +dec_hello_extensions(<<?UINT16(?RENEGOTIATION_EXT), ?UINT16(Len), Info:Len/binary, Rest/binary>>, Acc) -> + RenegotiateInfo = case Len of + 1 -> % Initial handshake + Info; % should be <<0>> will be matched in handle_renegotiation_info + _ -> + VerifyLen = Len - 1, + <<?BYTE(VerifyLen), VerifyInfo/binary>> = Info, + VerifyInfo + end, + dec_hello_extensions(Rest, Acc#hello_extensions{renegotiation_info = + #renegotiation_info{renegotiated_connection = + RenegotiateInfo}}); + +dec_hello_extensions(<<?UINT16(?SRP_EXT), ?UINT16(Len), ?BYTE(SRPLen), SRP:SRPLen/binary, Rest/binary>>, Acc) + when Len == SRPLen + 2 -> + dec_hello_extensions(Rest, Acc#hello_extensions{srp = #srp{username = SRP}}); + +dec_hello_extensions(<<?UINT16(?SIGNATURE_ALGORITHMS_EXT), ?UINT16(Len), + ExtData:Len/binary, Rest/binary>>, Acc) -> + SignAlgoListLen = Len - 2, + <<?UINT16(SignAlgoListLen), SignAlgoList/binary>> = ExtData, + HashSignAlgos = [{ssl_cipher:hash_algorithm(Hash), ssl_cipher:sign_algorithm(Sign)} || + <<?BYTE(Hash), ?BYTE(Sign)>> <= SignAlgoList], + dec_hello_extensions(Rest, Acc#hello_extensions{hash_signs = + #hash_sign_algos{hash_sign_algos = HashSignAlgos}}); + +dec_hello_extensions(<<?UINT16(?ELLIPTIC_CURVES_EXT), ?UINT16(Len), + ExtData:Len/binary, Rest/binary>>, Acc) -> + <<?UINT16(_), EllipticCurveList/binary>> = ExtData, + EllipticCurves = [tls_v1:enum_to_oid(X) || <<X:16>> <= EllipticCurveList], + dec_hello_extensions(Rest, Acc#hello_extensions{elliptic_curves = + #elliptic_curves{elliptic_curve_list = + EllipticCurves}}); +dec_hello_extensions(<<?UINT16(?EC_POINT_FORMATS_EXT), ?UINT16(Len), + ExtData:Len/binary, Rest/binary>>, Acc) -> + <<?BYTE(_), ECPointFormatList/binary>> = ExtData, + ECPointFormats = binary_to_list(ECPointFormatList), + dec_hello_extensions(Rest, Acc#hello_extensions{ec_point_formats = + #ec_point_formats{ec_point_format_list = + ECPointFormats}}); +%% Ignore data following the ClientHello (i.e., +%% extensions) if not understood. + +dec_hello_extensions(<<?UINT16(_), ?UINT16(Len), _Unknown:Len/binary, Rest/binary>>, Acc) -> + dec_hello_extensions(Rest, Acc); +%% This theoretically should not happen if the protocol is followed, but if it does it is ignored. +dec_hello_extensions(_, Acc) -> + Acc. + +dec_hashsign(<<?BYTE(HashAlgo), ?BYTE(SignAlgo)>>) -> + {ssl_cipher:hash_algorithm(HashAlgo), ssl_cipher:sign_algorithm(SignAlgo)}. + +decode_next_protocols({next_protocol_negotiation, Protocols}) -> + decode_next_protocols(Protocols, []). +decode_next_protocols(<<>>, Acc) -> + lists:reverse(Acc); +decode_next_protocols(<<?BYTE(Len), Protocol:Len/binary, Rest/binary>>, Acc) -> + case Len of + 0 -> + {error, invalid_next_protocols}; + _ -> + decode_next_protocols(Rest, [Protocol|Acc]) + end; +decode_next_protocols(_Bytes, _Acc) -> + {error, invalid_next_protocols}. + +%% encode/decode stream of certificate data to/from list of certificate data +certs_to_list(ASN1Certs) -> + certs_to_list(ASN1Certs, []). + +certs_to_list(<<?UINT24(CertLen), Cert:CertLen/binary, Rest/binary>>, Acc) -> + certs_to_list(Rest, [Cert | Acc]); +certs_to_list(<<>>, Acc) -> + lists:reverse(Acc, []). + +certs_from_list(ACList) -> + list_to_binary([begin + CertLen = byte_size(Cert), + <<?UINT24(CertLen), Cert/binary>> + end || Cert <- ACList]). +from_3bytes(Bin3) -> + from_3bytes(Bin3, []). + +from_3bytes(<<>>, Acc) -> + lists:reverse(Acc); +from_3bytes(<<?UINT24(N), Rest/binary>>, Acc) -> + from_3bytes(Rest, [?uint16(N) | Acc]). + +from_2bytes(Bin2) -> + from_2bytes(Bin2, []). + +from_2bytes(<<>>, Acc) -> + lists:reverse(Acc); +from_2bytes(<<?UINT16(N), Rest/binary>>, Acc) -> + from_2bytes(Rest, [?uint16(N) | Acc]). +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 -> + ?KEY_EXCHANGE_DIFFIE_HELLMAN; +key_exchange_alg(Alg) when Alg == ecdhe_rsa; Alg == ecdh_rsa; + Alg == ecdhe_ecdsa; Alg == ecdh_ecdsa; + Alg == ecdh_anon -> + ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN; +key_exchange_alg(psk) -> + ?KEY_EXCHANGE_PSK; +key_exchange_alg(dhe_psk) -> + ?KEY_EXCHANGE_DHE_PSK; +key_exchange_alg(rsa_psk) -> + ?KEY_EXCHANGE_RSA_PSK; +key_exchange_alg(Alg) + when Alg == srp_rsa; Alg == srp_dss; Alg == srp_anon -> + ?KEY_EXCHANGE_SRP; +key_exchange_alg(_) -> + ?NULL. + +%%-------------Extension handling -------------------------------- + +handle_next_protocol(undefined, + _NextProtocolSelector, _Renegotiating) -> + undefined; + +handle_next_protocol(#next_protocol_negotiation{} = NextProtocols, + NextProtocolSelector, Renegotiating) -> + + case next_protocol_extension_allowed(NextProtocolSelector, Renegotiating) of + true -> + select_next_protocol(decode_next_protocols(NextProtocols), NextProtocolSelector); + false -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) % unexpected next protocol extension + end. + + +handle_next_protocol_extension(NextProtocolNegotiation, Renegotiation, SslOpts)-> + case handle_next_protocol_on_server(NextProtocolNegotiation, Renegotiation, SslOpts) of + #alert{} = Alert -> + Alert; + ProtocolsToAdvertise -> + ProtocolsToAdvertise + end. + +handle_next_protocol_on_server(undefined, _Renegotiation, _SslOpts) -> + undefined; + +handle_next_protocol_on_server(#next_protocol_negotiation{extension_data = <<>>}, + false, #ssl_options{next_protocols_advertised = Protocols}) -> + Protocols; + +handle_next_protocol_on_server(_Hello, _Renegotiation, _SSLOpts) -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE). % unexpected next protocol extension + +next_protocol_extension_allowed(NextProtocolSelector, Renegotiating) -> + NextProtocolSelector =/= undefined andalso not Renegotiating. + +select_next_protocol({error, _Reason}, _NextProtocolSelector) -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); +select_next_protocol(Protocols, NextProtocolSelector) -> + case NextProtocolSelector(Protocols) of + ?NO_PROTOCOL -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); + Protocol when is_binary(Protocol) -> + Protocol + end. + +handle_srp_extension(undefined, Session) -> + Session; +handle_srp_extension(#srp{username = Username}, Session) -> + Session#session{srp_username = Username}. + +%%-------------Misc -------------------------------- + +select_cipher_suite([], _) -> + no_suite; +select_cipher_suite([Suite | ClientSuites], SupportedSuites) -> + case is_member(Suite, SupportedSuites) of + true -> + Suite; + false -> + select_cipher_suite(ClientSuites, SupportedSuites) + end. + +int_to_bin(I) -> + L = (length(integer_to_list(I, 16)) + 1) div 2, + <<I:(L*8)>>. + +is_member(Suite, SupportedSuites) -> + lists:member(Suite, SupportedSuites). + +select_compression(_CompressionMetodes) -> + ?NULL. + +-define(TLSEXT_SIGALG_RSA(MD), {MD, rsa}). +-define(TLSEXT_SIGALG_DSA(MD), {MD, dsa}). +-define(TLSEXT_SIGALG_ECDSA(MD), {MD, ecdsa}). + +-define(TLSEXT_SIGALG(MD), ?TLSEXT_SIGALG_ECDSA(MD), ?TLSEXT_SIGALG_RSA(MD)). + +advertised_hash_signs({Major, Minor}) when Major >= 3 andalso Minor >= 3 -> + HashSigns = [?TLSEXT_SIGALG(sha512), + ?TLSEXT_SIGALG(sha384), + ?TLSEXT_SIGALG(sha256), + ?TLSEXT_SIGALG(sha224), + ?TLSEXT_SIGALG(sha), + ?TLSEXT_SIGALG_DSA(sha), + ?TLSEXT_SIGALG_RSA(md5)], + CryptoSupport = crypto:supports(), + HasECC = proplists:get_bool(ecdsa, proplists:get_value(public_keys, CryptoSupport)), + Hashs = proplists:get_value(hashs, CryptoSupport), + #hash_sign_algos{hash_sign_algos = + lists:filter(fun({Hash, ecdsa}) -> HasECC andalso proplists:get_bool(Hash, Hashs); + ({Hash, _}) -> proplists:get_bool(Hash, Hashs) end, HashSigns)}; +advertised_hash_signs(_) -> + undefined. + diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl index eb1a1dbf62..f25b0df806 100644 --- a/lib/ssl/src/ssl_handshake.hrl +++ b/lib/ssl/src/ssl_handshake.hrl @@ -28,11 +28,6 @@ -include_lib("public_key/include/public_key.hrl"). --type oid() :: tuple(). --type public_key_params() :: #'Dss-Parms'{} | {namedCurve, oid()} | #'ECParameters'{} | term(). --type public_key_info() :: {oid(), #'RSAPublicKey'{} | integer() | #'ECPoint'{}, public_key_params()}. --type tls_handshake_history() :: {[binary()], [binary()]}. - -define(NO_PROTOCOL, <<>>). %% Signature algorithms @@ -50,7 +45,8 @@ master_secret, srp_username, is_resumable, - time_stamp + time_stamp, + ecc }). -define(NUM_OF_SESSION_ID_BYTES, 32). % TSL 1.1 & SSL 3 @@ -96,17 +92,22 @@ %% client_hello defined in tls_handshake.hrl and dtls_handshake.hrl +-record(hello_extensions, { + renegotiation_info, + hash_signs, % supported combinations of hashes/signature algos + next_protocol_negotiation = undefined, % [binary()] + srp, + ec_point_formats, + elliptic_curves + }). + -record(server_hello, { server_version, random, session_id, % opaque SessionID<0..32> cipher_suite, % cipher_suites compression_method, % compression_method - renegotiation_info, - hash_signs, % supported combinations of hashes/signature algos - ec_point_formats, % supported ec point formats - elliptic_curves, % supported elliptic curver - next_protocol_negotiation = undefined % [binary()] + extensions }). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -337,6 +338,20 @@ -define(EXPLICIT_CHAR2, 2). -define(NAMED_CURVE, 3). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Dialyzer types +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-type oid() :: tuple(). +-type public_key_params() :: #'Dss-Parms'{} | {namedCurve, oid()} | #'ECParameters'{} | term(). +-type public_key_info() :: {oid(), #'RSAPublicKey'{} | integer() | #'ECPoint'{}, public_key_params()}. +-type tls_handshake_history() :: {[binary()], [binary()]}. + +-type ssl_handshake() :: #server_hello{} | #server_hello_done{} | #certificate{} | #certificate_request{} | + #client_key_exchange{} | #finished{} | #certificate_verify{} | + #hello_request{} | #next_protocol{}. + + -endif. % -ifdef(ssl_handshake). diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index de8d20d399..96e3280fb5 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -37,7 +37,6 @@ -type tls_atom_version() :: sslv3 | tlsv1 | 'tlsv1.1' | 'tlsv1.2'. -type certdb_ref() :: reference(). -type db_handle() :: term(). --type key_algo() :: null | rsa | dhe_rsa | dhe_dss | ecdhe_ecdsa| ecdh_ecdsa | ecdh_rsa| srp_rsa| srp_dss | psk | dhe_psk | rsa_psk | dh_anon | ecdh_anon | srp_anon. -type der_cert() :: binary(). -type private_key() :: #'RSAPrivateKey'{} | #'DSAPrivateKey'{} | #'ECPrivateKey'{}. -type issuer() :: tuple(). @@ -50,6 +49,7 @@ -define(UINT16(X), X:16/unsigned-big-integer). -define(UINT24(X), X:24/unsigned-big-integer). -define(UINT32(X), X:32/unsigned-big-integer). +-define(UINT48(X), X:48/unsigned-big-integer). -define(UINT64(X), X:64/unsigned-big-integer). -define(STRING(X), ?UINT32((size(X))), (X)/binary). @@ -57,6 +57,7 @@ -define(uint16(X), << ?UINT16(X) >> ). -define(uint24(X), << ?UINT24(X) >> ). -define(uint32(X), << ?UINT32(X) >> ). +-define(uint48(X), << ?UINT48(X) >> ). -define(uint64(X), << ?UINT64(X) >> ). -define(CDR_MAGIC, "GIOP"). @@ -71,6 +72,8 @@ -define(ALL_SUPPORTED_VERSIONS, ['tlsv1.2', 'tlsv1.1', tlsv1, sslv3]). -define(MIN_SUPPORTED_VERSIONS, ['tlsv1.1', tlsv1, sslv3]). +-define(ALL_DATAGRAM_SUPPORTED_VERSIONS, ['dtlsv1.2', dtlsv1]). +-define(MIN_DATAGRAM_SUPPORTED_VERSIONS, ['dtlsv1.2', dtlsv1]). -record(ssl_options, { versions, % 'tlsv1.2' | 'tlsv1.1' | tlsv1 | sslv3 @@ -124,6 +127,10 @@ active = true }). +-type state_name() :: hello | abbreviated | certify | cipher | connection. +-type gen_fsm_state_return() :: {next_state, state_name(), term()} | + {next_state, state_name(), term(), timeout()} | + {stop, term(), term()}. -endif. % -ifdef(ssl_internal). diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl new file mode 100644 index 0000000000..50a45dc16b --- /dev/null +++ b/lib/ssl/src/ssl_record.erl @@ -0,0 +1,439 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013-2013. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% + +%%---------------------------------------------------------------------- +%% Purpose: Handle TLS/SSL/DTLS record protocol. Note epoch is only +%% used by DTLS but handled here so we can avoid code duplication. +%%---------------------------------------------------------------------- + +-module(ssl_record). + +-include("ssl_record.hrl"). +-include("ssl_internal.hrl"). +-include("ssl_cipher.hrl"). +-include("ssl_alert.hrl"). + +%% Connection state handling +-export([init_connection_states/1, + current_connection_state/2, pending_connection_state/2, + activate_pending_connection_state/2, + set_security_params/3, + set_mac_secret/4, + set_master_secret/2, + set_pending_cipher_state/4, + set_renegotiation_flag/2, + set_client_verify_data/3, + set_server_verify_data/3]). + +%% Encoding records +-export([encode_handshake/3, encode_alert_record/3, + encode_change_cipher_spec/2, encode_data/3]). + +%% Compression +-export([compress/3, uncompress/3, compressions/0]). + +-export([is_correct_mac/2]). + +%%==================================================================== +%% Internal application API +%%==================================================================== + +%%-------------------------------------------------------------------- +-spec init_connection_states(client | server) -> #connection_states{}. +%% +%% Description: Creates a connection_states record with appropriate +%% values for the initial SSL connection setup. +%%-------------------------------------------------------------------- +init_connection_states(Role) -> + ConnectionEnd = record_protocol_role(Role), + Current = initial_connection_state(ConnectionEnd), + Pending = empty_connection_state(ConnectionEnd), + #connection_states{current_read = Current, + pending_read = Pending, + current_write = Current, + pending_write = Pending + }. + +%%-------------------------------------------------------------------- +-spec current_connection_state(#connection_states{}, read | write) -> + #connection_state{}. +%% +%% Description: Returns the instance of the connection_state record +%% that is currently defined as the current conection state. +%%-------------------------------------------------------------------- +current_connection_state(#connection_states{current_read = Current}, + read) -> + Current; +current_connection_state(#connection_states{current_write = Current}, + write) -> + Current. + +%%-------------------------------------------------------------------- +-spec pending_connection_state(#connection_states{}, read | write) -> + term(). +%% +%% Description: Returns the instance of the connection_state record +%% that is currently defined as the pending conection state. +%%-------------------------------------------------------------------- +pending_connection_state(#connection_states{pending_read = Pending}, + read) -> + Pending; +pending_connection_state(#connection_states{pending_write = Pending}, + write) -> + Pending. + + +%%-------------------------------------------------------------------- +-spec activate_pending_connection_state(#connection_states{}, read | write) -> + #connection_states{}. +%% +%% Description: Creates a new instance of the connection_states record +%% where the pending state of <Type> has been activated. +%%-------------------------------------------------------------------- +activate_pending_connection_state(States = + #connection_states{current_read = Current, + pending_read = Pending}, + read) -> + NewCurrent = Pending#connection_state{epoch = dtls_next_epoch(Current), + sequence_number = 0}, + SecParams = Pending#connection_state.security_parameters, + ConnectionEnd = SecParams#security_parameters.connection_end, + EmptyPending = empty_connection_state(ConnectionEnd), + SecureRenegotation = NewCurrent#connection_state.secure_renegotiation, + NewPending = EmptyPending#connection_state{secure_renegotiation = SecureRenegotation}, + States#connection_states{current_read = NewCurrent, + pending_read = NewPending + }; + +activate_pending_connection_state(States = + #connection_states{current_write = Current, + pending_write = Pending}, + write) -> + NewCurrent = Pending#connection_state{epoch = dtls_next_epoch(Current), + sequence_number = 0}, + SecParams = Pending#connection_state.security_parameters, + ConnectionEnd = SecParams#security_parameters.connection_end, + EmptyPending = empty_connection_state(ConnectionEnd), + SecureRenegotation = NewCurrent#connection_state.secure_renegotiation, + NewPending = EmptyPending#connection_state{secure_renegotiation = SecureRenegotation}, + States#connection_states{current_write = NewCurrent, + pending_write = NewPending + }. + + +%%-------------------------------------------------------------------- +-spec set_security_params(#security_parameters{}, #security_parameters{}, + #connection_states{}) -> #connection_states{}. +%% +%% Description: Creates a new instance of the connection_states record +%% where the pending states gets its security parameters updated. +%%-------------------------------------------------------------------- +set_security_params(ReadParams, WriteParams, States = + #connection_states{pending_read = Read, + pending_write = Write}) -> + States#connection_states{pending_read = + Read#connection_state{security_parameters = + ReadParams}, + pending_write = + Write#connection_state{security_parameters = + WriteParams} + }. +%%-------------------------------------------------------------------- +-spec set_mac_secret(binary(), binary(), client | server, + #connection_states{}) -> #connection_states{}. +%% +%% Description: update the mac_secret field in pending connection states +%%-------------------------------------------------------------------- +set_mac_secret(ClientWriteMacSecret, ServerWriteMacSecret, client, States) -> + set_mac_secret(ServerWriteMacSecret, ClientWriteMacSecret, States); +set_mac_secret(ClientWriteMacSecret, ServerWriteMacSecret, server, States) -> + set_mac_secret(ClientWriteMacSecret, ServerWriteMacSecret, States). + +set_mac_secret(ReadMacSecret, WriteMacSecret, + States = #connection_states{pending_read = Read, + pending_write = Write}) -> + States#connection_states{ + pending_read = Read#connection_state{mac_secret = ReadMacSecret}, + pending_write = Write#connection_state{mac_secret = WriteMacSecret} + }. + + +%%-------------------------------------------------------------------- +-spec set_master_secret(binary(), #connection_states{}) -> #connection_states{}. +%% +%% Description: Set master_secret in pending connection states +%%-------------------------------------------------------------------- +set_master_secret(MasterSecret, + States = #connection_states{pending_read = Read, + pending_write = Write}) -> + ReadSecPar = Read#connection_state.security_parameters, + Read1 = Read#connection_state{ + security_parameters = ReadSecPar#security_parameters{ + master_secret = MasterSecret}}, + WriteSecPar = Write#connection_state.security_parameters, + Write1 = Write#connection_state{ + security_parameters = WriteSecPar#security_parameters{ + master_secret = MasterSecret}}, + States#connection_states{pending_read = Read1, pending_write = Write1}. + +%%-------------------------------------------------------------------- +-spec set_renegotiation_flag(boolean(), #connection_states{}) -> #connection_states{}. +%% +%% Description: Set secure_renegotiation in pending connection states +%%-------------------------------------------------------------------- +set_renegotiation_flag(Flag, #connection_states{ + current_read = CurrentRead0, + current_write = CurrentWrite0, + pending_read = PendingRead0, + pending_write = PendingWrite0} + = ConnectionStates) -> + CurrentRead = CurrentRead0#connection_state{secure_renegotiation = Flag}, + CurrentWrite = CurrentWrite0#connection_state{secure_renegotiation = Flag}, + PendingRead = PendingRead0#connection_state{secure_renegotiation = Flag}, + PendingWrite = PendingWrite0#connection_state{secure_renegotiation = Flag}, + ConnectionStates#connection_states{current_read = CurrentRead, + current_write = CurrentWrite, + pending_read = PendingRead, + pending_write = PendingWrite}. + +%%-------------------------------------------------------------------- +-spec set_client_verify_data(current_read | current_write | current_both, + binary(), #connection_states{})-> + #connection_states{}. +%% +%% Description: Set verify data in connection states. +%%-------------------------------------------------------------------- +set_client_verify_data(current_read, Data, + #connection_states{current_read = CurrentRead0, + pending_write = PendingWrite0} + = ConnectionStates) -> + CurrentRead = CurrentRead0#connection_state{client_verify_data = Data}, + PendingWrite = PendingWrite0#connection_state{client_verify_data = Data}, + ConnectionStates#connection_states{current_read = CurrentRead, + pending_write = PendingWrite}; +set_client_verify_data(current_write, Data, + #connection_states{pending_read = PendingRead0, + current_write = CurrentWrite0} + = ConnectionStates) -> + PendingRead = PendingRead0#connection_state{client_verify_data = Data}, + CurrentWrite = CurrentWrite0#connection_state{client_verify_data = Data}, + ConnectionStates#connection_states{pending_read = PendingRead, + current_write = CurrentWrite}; +set_client_verify_data(current_both, Data, + #connection_states{current_read = CurrentRead0, + current_write = CurrentWrite0} + = ConnectionStates) -> + CurrentRead = CurrentRead0#connection_state{client_verify_data = Data}, + CurrentWrite = CurrentWrite0#connection_state{client_verify_data = Data}, + ConnectionStates#connection_states{current_read = CurrentRead, + current_write = CurrentWrite}. +%%-------------------------------------------------------------------- +-spec set_server_verify_data(current_read | current_write | current_both, + binary(), #connection_states{})-> + #connection_states{}. +%% +%% Description: Set verify data in pending connection states. +%%-------------------------------------------------------------------- +set_server_verify_data(current_write, Data, + #connection_states{pending_read = PendingRead0, + current_write = CurrentWrite0} + = ConnectionStates) -> + PendingRead = PendingRead0#connection_state{server_verify_data = Data}, + CurrentWrite = CurrentWrite0#connection_state{server_verify_data = Data}, + ConnectionStates#connection_states{pending_read = PendingRead, + current_write = CurrentWrite}; + +set_server_verify_data(current_read, Data, + #connection_states{current_read = CurrentRead0, + pending_write = PendingWrite0} + = ConnectionStates) -> + CurrentRead = CurrentRead0#connection_state{server_verify_data = Data}, + PendingWrite = PendingWrite0#connection_state{server_verify_data = Data}, + ConnectionStates#connection_states{current_read = CurrentRead, + pending_write = PendingWrite}; + +set_server_verify_data(current_both, Data, + #connection_states{current_read = CurrentRead0, + current_write = CurrentWrite0} + = ConnectionStates) -> + CurrentRead = CurrentRead0#connection_state{server_verify_data = Data}, + CurrentWrite = CurrentWrite0#connection_state{server_verify_data = Data}, + ConnectionStates#connection_states{current_read = CurrentRead, + current_write = CurrentWrite}. +%%-------------------------------------------------------------------- +-spec set_pending_cipher_state(#connection_states{}, #cipher_state{}, + #cipher_state{}, client | server) -> + #connection_states{}. +%% +%% Description: Set the cipher state in the specified pending connection state. +%%-------------------------------------------------------------------- +set_pending_cipher_state(#connection_states{pending_read = Read, + pending_write = Write} = States, + ClientState, ServerState, server) -> + States#connection_states{ + pending_read = Read#connection_state{cipher_state = ClientState}, + pending_write = Write#connection_state{cipher_state = ServerState}}; + +set_pending_cipher_state(#connection_states{pending_read = Read, + pending_write = Write} = States, + ClientState, ServerState, client) -> + States#connection_states{ + pending_read = Read#connection_state{cipher_state = ServerState}, + pending_write = Write#connection_state{cipher_state = ClientState}}. + + +%%-------------------------------------------------------------------- +-spec encode_handshake(iolist(), tls_version(), #connection_states{}) -> + {iolist(), #connection_states{}}. +%% +%% Description: Encodes a handshake message to send on the ssl-socket. +%%-------------------------------------------------------------------- +encode_handshake(Frag, Version, ConnectionStates) -> + encode_plain_text(?HANDSHAKE, Version, Frag, ConnectionStates). + +%%-------------------------------------------------------------------- +-spec encode_alert_record(#alert{}, tls_version(), #connection_states{}) -> + {iolist(), #connection_states{}}. +%% +%% Description: Encodes an alert message to send on the ssl-socket. +%%-------------------------------------------------------------------- +encode_alert_record(#alert{level = Level, description = Description}, + Version, ConnectionStates) -> + encode_plain_text(?ALERT, Version, <<?BYTE(Level), ?BYTE(Description)>>, + ConnectionStates). + +%%-------------------------------------------------------------------- +-spec encode_change_cipher_spec(tls_version(), #connection_states{}) -> + {iolist(), #connection_states{}}. +%% +%% Description: Encodes a change_cipher_spec-message to send on the ssl socket. +%%-------------------------------------------------------------------- +encode_change_cipher_spec(Version, ConnectionStates) -> + encode_plain_text(?CHANGE_CIPHER_SPEC, Version, <<1:8>>, ConnectionStates). + +%%-------------------------------------------------------------------- +-spec encode_data(binary(), tls_version(), #connection_states{}) -> + {iolist(), #connection_states{}}. +%% +%% Description: Encodes data to send on the ssl-socket. +%%-------------------------------------------------------------------- +encode_data(Frag, Version, + #connection_states{current_write = #connection_state{ + security_parameters = + #security_parameters{bulk_cipher_algorithm = BCA}}} = + ConnectionStates) -> + Data = split_bin(Frag, ?MAX_PLAIN_TEXT_LENGTH, Version, BCA), + encode_iolist(?APPLICATION_DATA, Data, Version, ConnectionStates). + +uncompress(?NULL, Data, CS) -> + {Data, CS}. + +compress(?NULL, Data, CS) -> + {Data, CS}. + +%%-------------------------------------------------------------------- +-spec compressions() -> [binary()]. +%% +%% Description: return a list of compressions supported (currently none) +%%-------------------------------------------------------------------- +compressions() -> + [?byte(?NULL)]. + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +empty_connection_state(ConnectionEnd) -> + SecParams = empty_security_params(ConnectionEnd), + #connection_state{security_parameters = SecParams}. + +empty_security_params(ConnectionEnd = ?CLIENT) -> + #security_parameters{connection_end = ConnectionEnd, + client_random = random()}; +empty_security_params(ConnectionEnd = ?SERVER) -> + #security_parameters{connection_end = ConnectionEnd, + server_random = random()}. +random() -> + Secs_since_1970 = calendar:datetime_to_gregorian_seconds( + calendar:universal_time()) - 62167219200, + Random_28_bytes = crypto:rand_bytes(28), + <<?UINT32(Secs_since_1970), Random_28_bytes/binary>>. + +dtls_next_epoch(#connection_state{epoch = undefined}) -> %% SSL/TLS + undefined; +dtls_next_epoch(#connection_state{epoch = Epoch}) -> %% DTLS + Epoch + 1. + +is_correct_mac(Mac, Mac) -> + true; +is_correct_mac(_M,_H) -> + false. + +record_protocol_role(client) -> + ?CLIENT; +record_protocol_role(server) -> + ?SERVER. + +initial_connection_state(ConnectionEnd) -> + #connection_state{security_parameters = + initial_security_params(ConnectionEnd), + sequence_number = 0 + }. + +initial_security_params(ConnectionEnd) -> + SecParams = #security_parameters{connection_end = ConnectionEnd, + compression_algorithm = ?NULL}, + ssl_cipher:security_parameters(?TLS_NULL_WITH_NULL_NULL, SecParams). + + +encode_plain_text(Type, Version, Data, ConnectionStates) -> + RecordCB = protocol_module(Version), + RecordCB:encode_plain_text(Type, Version, Data, ConnectionStates). + +encode_iolist(Type, Data, Version, ConnectionStates0) -> + RecordCB = protocol_module(Version), + {ConnectionStates, EncodedMsg} = + lists:foldl(fun(Text, {CS0, Encoded}) -> + {Enc, CS1} = + RecordCB:encode_plain_text(Type, Version, Text, CS0), + {CS1, [Enc | Encoded]} + end, {ConnectionStates0, []}, Data), + {lists:reverse(EncodedMsg), ConnectionStates}. + +%% 1/n-1 splitting countermeasure Rizzo/Duong-Beast, RC4 chiphers are +%% not vulnerable to this attack. +split_bin(<<FirstByte:8, Rest/binary>>, ChunkSize, Version, BCA) when + BCA =/= ?RC4 andalso ({3, 1} == Version orelse + {3, 0} == Version) -> + do_split_bin(Rest, ChunkSize, [[FirstByte]]); +split_bin(Bin, ChunkSize, _, _) -> + do_split_bin(Bin, ChunkSize, []). + +do_split_bin(<<>>, _, Acc) -> + lists:reverse(Acc); +do_split_bin(Bin, ChunkSize, Acc) -> + case Bin of + <<Chunk:ChunkSize/binary, Rest/binary>> -> + do_split_bin(Rest, ChunkSize, [Chunk | Acc]); + _ -> + lists:reverse(Acc, [Bin]) + end. + +protocol_module({3, _}) -> + tls_record; +protocol_module({254, _}) -> + dtls_record. diff --git a/lib/ssl/src/ssl_record.hrl b/lib/ssl/src/ssl_record.hrl index 2fd17f9c35..c17fa53a62 100644 --- a/lib/ssl/src/ssl_record.hrl +++ b/lib/ssl/src/ssl_record.hrl @@ -29,6 +29,18 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Connection states - RFC 4346 section 6.1 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-record(connection_state, { + security_parameters, + compression_state, + cipher_state, + mac_secret, + epoch, %% Only used by DTLS + sequence_number, + %% RFC 5746 + secure_renegotiation, + client_verify_data, + server_verify_data + }). -record(connection_states, { current_read, @@ -56,17 +68,7 @@ exportable % boolean }). --record(connection_state, { - security_parameters, - compression_state, - cipher_state, - mac_secret, - sequence_number, - %% RFC 5746 - secure_renegotiation, - client_verify_data, - server_verify_data - }). +-define(INITIAL_BYTES, 5). -define(MAX_SEQENCE_NUMBER, 18446744073709552000). %% math:pow(2, 64) - 1 = 1.8446744073709552e19 %% Sequence numbers can not wrap so when max is about to be reached we should renegotiate. diff --git a/lib/ssl/src/ssl_ssl2.erl b/lib/ssl/src/ssl_v2.erl index a9ab6a2678..07876366f1 100644 --- a/lib/ssl/src/ssl_ssl2.erl +++ b/lib/ssl/src/ssl_v2.erl @@ -1,30 +1,30 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-2011. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% %%---------------------------------------------------------------------- -%% Purpose: Handles sslv2 hello as clients supporting sslv2 and higher +%% Purpose: Handles sslv2 hello as clients supporting sslv2 and higher %% will send an sslv2 hello. %%---------------------------------------------------------------------- --module(ssl_ssl2). - +-module(ssl_v2). + -export([client_random/2]). client_random(ChallengeData, 32) -> diff --git a/lib/ssl/src/ssl_ssl3.erl b/lib/ssl/src/ssl_v3.erl index 013c27ebb5..d477b3df81 100644 --- a/lib/ssl/src/ssl_ssl3.erl +++ b/lib/ssl/src/ssl_v3.erl @@ -22,14 +22,14 @@ %% Purpose: Handles sslv3 encryption. %%---------------------------------------------------------------------- --module(ssl_ssl3). +-module(ssl_v3). -include("ssl_cipher.hrl"). -include("ssl_internal.hrl"). -include("ssl_record.hrl"). % MD5 and SHA -export([master_secret/3, finished/3, certificate_verify/3, - mac_hash/6, setup_keys/7, + mac_hash/6, setup_keys/7, suites/0]). -compile(inline). @@ -40,7 +40,7 @@ -spec master_secret(binary(), binary(), binary()) -> binary(). master_secret(PremasterSecret, ClientRandom, ServerRandom) -> - %% draft-ietf-tls-ssl-version3-00 - 6.2.2 + %% draft-ietf-tls-ssl-version3-00 - 6.2.2 %% key_block = %% MD5(master_secret + SHA(`A' + master_secret + %% ServerHello.random + @@ -62,7 +62,7 @@ finished(Role, MasterSecret, Handshake) -> %% opaque md5_hash[16]; %% opaque sha_hash[20]; %% } Finished; - %% + %% %% md5_hash MD5(master_secret + pad2 + %% MD5(handshake_messages + Sender + %% master_secret + pad1)); @@ -95,23 +95,23 @@ certificate_verify(sha, MasterSecret, Handshake) -> handshake_hash(?SHA, MasterSecret, undefined, Handshake). --spec mac_hash(integer(), binary(), integer(), integer(), integer(), binary()) -> binary(). +-spec mac_hash(integer(), binary(), integer(), integer(), integer(), binary()) -> binary(). mac_hash(Method, Mac_write_secret, Seq_num, Type, Length, Fragment) -> - %% draft-ietf-tls-ssl-version3-00 - 5.2.3.1 + %% draft-ietf-tls-ssl-version3-00 - 5.2.3.1 %% hash(MAC_write_secret + pad_2 + %% hash(MAC_write_secret + pad_1 + seq_num + %% SSLCompressed.type + SSLCompressed.length + %% SSLCompressed.fragment)); - Mac = mac_hash(Method, Mac_write_secret, - [<<?UINT64(Seq_num), ?BYTE(Type), + Mac = mac_hash(Method, Mac_write_secret, + [<<?UINT64(Seq_num), ?BYTE(Type), ?UINT16(Length)>>, Fragment]), Mac. --spec setup_keys(binary(), binary(), binary(), - integer(), integer(), term(), integer()) -> - {binary(), binary(), binary(), - binary(), binary(), binary()}. +-spec setup_keys(binary(), binary(), binary(), + integer(), integer(), term(), integer()) -> + {binary(), binary(), binary(), + binary(), binary(), binary()}. setup_keys(MasterSecret, ServerRandom, ClientRandom, HS, KML, _EKML, IVS) -> KeyBlock = generate_keyblock(MasterSecret, ServerRandom, ClientRandom, @@ -133,7 +133,7 @@ setup_keys(MasterSecret, ServerRandom, ClientRandom, HS, KML, _EKML, IVS) -> -spec suites() -> [cipher_suite()]. suites() -> - [ + [ ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA, ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA, ?TLS_RSA_WITH_AES_256_CBC_SHA, @@ -143,7 +143,7 @@ suites() -> ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA, ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, ?TLS_RSA_WITH_AES_128_CBC_SHA, - %%?TLS_RSA_WITH_IDEA_CBC_SHA, + %%?TLS_RSA_WITH_IDEA_CBC_SHA, ?TLS_RSA_WITH_RC4_128_SHA, ?TLS_RSA_WITH_RC4_128_MD5, ?TLS_RSA_WITH_DES_CBC_SHA diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 77f49c5d2a..39595b4f95 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -76,7 +76,8 @@ negotiated_version, % tls_version() client_certificate_requested = false, key_algorithm, % atom as defined by cipher_suite - hashsign_algorithm, % atom as defined by cipher_suite + hashsign_algorithm = {undefined, undefined}, + cert_hashsign_algorithm, public_key_info, % PKIX: {Algorithm, PublicKey, PublicKeyParams} private_key, % PKIX: #'RSAPrivateKey'{} diffie_hellman_params, % PKIX: #'DHParameter'{} relevant for server side @@ -96,8 +97,7 @@ terminated = false, % allow_renegotiate = true, expecting_next_protocol_negotiation = false :: boolean(), - next_protocol = undefined :: undefined | binary(), - client_ecc % {Curves, PointFmt} + next_protocol = undefined :: undefined | binary() }). -define(DEFAULT_DIFFIE_HELLMAN_PARAMS, @@ -105,10 +105,6 @@ base = ?DEFAULT_DIFFIE_HELLMAN_GENERATOR}). -define(WAIT_TO_ALLOW_RENEGOTIATION, 12000). --type state_name() :: hello | abbreviated | certify | cipher | connection. --type gen_fsm_state_return() :: {next_state, state_name(), #state{}} | - {next_state, state_name(), #state{}, timeout()} | - {stop, term(), #state{}}. %%==================================================================== %% Internal application API @@ -388,9 +384,8 @@ hello(#server_hello{cipher_suite = CipherSuite, _ -> NextProtocol end, - + State = State0#state{key_algorithm = KeyAlgorithm, - hashsign_algorithm = default_hashsign(Version, KeyAlgorithm), negotiated_version = Version, connection_states = ConnectionStates, premaster_secret = PremasterSecret, @@ -406,23 +401,27 @@ hello(#server_hello{cipher_suite = CipherSuite, end end; -hello(Hello = #client_hello{client_version = ClientVersion}, +hello(Hello = #client_hello{client_version = ClientVersion, + extensions = #hello_extensions{hash_signs = HashSigns}}, State = #state{connection_states = ConnectionStates0, - port = Port, session = #session{own_certificate = Cert} = Session0, + port = Port, + session = #session{own_certificate = Cert} = Session0, renegotiation = {Renegotiation, _}, - session_cache = Cache, + session_cache = Cache, session_cache_cb = CacheCb, ssl_options = SslOpts}) -> + HashSign = ssl_handshake:select_hashsign(HashSigns, Cert), case tls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb, - ConnectionStates0, Cert}, Renegotiation) of - {Version, {Type, Session}, ConnectionStates, ProtocolsToAdvertise, - EcPointFormats, EllipticCurves} -> - do_server_hello(Type, ProtocolsToAdvertise, - EcPointFormats, EllipticCurves, + ConnectionStates0, Cert}, Renegotiation) of + {Version, {Type, #session{cipher_suite = CipherSuite} = Session}, + ConnectionStates, ServerHelloExt} -> + {KeyAlg, _, _, _} = ssl_cipher:suite_definition(CipherSuite), + NegotiatedHashSign = negotiated_hashsign(HashSign, KeyAlg, Version), + do_server_hello(Type, ServerHelloExt, State#state{connection_states = ConnectionStates, negotiated_version = Version, session = Session, - client_ecc = {EllipticCurves, EcPointFormats}}); + hashsign_algorithm = NegotiatedHashSign}); #alert{} = Alert -> handle_own_alert(Alert, ClientVersion, hello, State) end; @@ -447,11 +446,11 @@ abbreviated(#finished{verify_data = Data} = Finished, session = #session{master_secret = MasterSecret}, connection_states = ConnectionStates0} = State) -> - case tls_handshake:verify_connection(Version, Finished, client, + case ssl_handshake:verify_connection(Version, Finished, client, get_current_connection_state_prf(ConnectionStates0, write), MasterSecret, Handshake) of verified -> - ConnectionStates = tls_record:set_client_verify_data(current_both, Data, ConnectionStates0), + ConnectionStates = ssl_record:set_client_verify_data(current_both, Data, ConnectionStates0), next_state_connection(abbreviated, ack_connection(State#state{connection_states = ConnectionStates})); #alert{} = Alert -> @@ -463,11 +462,11 @@ abbreviated(#finished{verify_data = Data} = Finished, session = #session{master_secret = MasterSecret}, negotiated_version = Version, connection_states = ConnectionStates0} = State) -> - case tls_handshake:verify_connection(Version, Finished, server, + case ssl_handshake:verify_connection(Version, Finished, server, get_pending_connection_state_prf(ConnectionStates0, write), MasterSecret, Handshake0) of verified -> - ConnectionStates1 = tls_record:set_server_verify_data(current_read, Data, ConnectionStates0), + ConnectionStates1 = ssl_record:set_server_verify_data(current_read, Data, ConnectionStates0), {ConnectionStates, Handshake} = finalize_handshake(State#state{connection_states = ConnectionStates1}, abbreviated), next_state_connection(abbreviated, @@ -522,11 +521,11 @@ certify(#certificate{} = Cert, cert_db = CertDbHandle, cert_db_ref = CertDbRef, ssl_options = Opts} = State) -> - case tls_handshake:certify(Cert, CertDbHandle, CertDbRef, Opts#ssl_options.depth, + case ssl_handshake:certify(Cert, CertDbHandle, CertDbRef, Opts#ssl_options.depth, Opts#ssl_options.verify, Opts#ssl_options.verify_fun, Role) of {PeerCert, PublicKeyInfo} -> - handle_peer_cert(PeerCert, PublicKeyInfo, + handle_peer_cert(Role, PeerCert, PublicKeyInfo, State#state{client_certificate_requested = false}); #alert{} = Alert -> handle_own_alert(Alert, Version, certify, State) @@ -552,9 +551,11 @@ certify(#server_key_exchange{} = Msg, #state{role = client, key_algorithm = rsa} = State) -> handle_unexpected_message(Msg, certify_server_keyexchange, State); -certify(#certificate_request{}, State0) -> +certify(#certificate_request{hashsign_algorithms = HashSigns}, + #state{session = #session{own_certificate = Cert}} = State0) -> + HashSign = ssl_handshake:select_hashsign(HashSigns, Cert), {Record, State} = next_record(State0#state{client_certificate_requested = true}), - next_state(certify, certify, Record, State); + next_state(certify, certify, Record, State#state{cert_hashsign_algorithm = HashSign}); %% PSK and RSA_PSK might bypass the Server-Key-Exchange certify(#server_hello_done{}, @@ -602,7 +603,7 @@ certify(#server_hello_done{}, negotiated_version = Version, premaster_secret = undefined, role = client} = State0) -> - case tls_handshake:master_secret(Version, Session, + case ssl_handshake:master_secret(tls_record, Version, Session, ConnectionStates0, client) of {MasterSecret, ConnectionStates} -> State = State0#state{connection_states = ConnectionStates}, @@ -618,7 +619,7 @@ certify(#server_hello_done{}, negotiated_version = Version, premaster_secret = PremasterSecret, role = client} = State0) -> - case tls_handshake:master_secret(Version, PremasterSecret, + case ssl_handshake:master_secret(tls_record, Version, PremasterSecret, ConnectionStates0, client) of {MasterSecret, ConnectionStates} -> Session = Session0#session{master_secret = MasterSecret}, @@ -639,7 +640,7 @@ certify(#client_key_exchange{} = Msg, certify(#client_key_exchange{exchange_keys = Keys}, State = #state{key_algorithm = KeyAlg, negotiated_version = Version}) -> try - certify_client_key_exchange(tls_handshake:decode_client_key(Keys, KeyAlg, Version), State) + certify_client_key_exchange(ssl_handshake:decode_client_key(Keys, KeyAlg, Version), State) catch #alert{} = Alert -> handle_own_alert(Alert, Version, certify, State) @@ -657,8 +658,8 @@ certify_client_key_exchange(#encrypted_premaster_secret{premaster_secret= EncPMS connection_states = ConnectionStates0, session = Session0, private_key = Key} = State0) -> - PremasterSecret = tls_handshake:decrypt_premaster_secret(EncPMS, Key), - case tls_handshake:master_secret(Version, PremasterSecret, + PremasterSecret = ssl_handshake:decrypt_premaster_secret(EncPMS, Key), + case ssl_handshake:master_secret(tls_record, Version, PremasterSecret, ConnectionStates0, server) of {MasterSecret, ConnectionStates} -> Session = Session0#session{master_secret = MasterSecret}, @@ -724,7 +725,7 @@ certify_client_key_exchange(#client_rsa_psk_identity{ #encrypted_premaster_secret{premaster_secret= EncPMS}}, #state{negotiated_version = Version, private_key = Key} = State0) -> - PremasterSecret = tls_handshake:decrypt_premaster_secret(EncPMS, Key), + PremasterSecret = ssl_handshake:decrypt_premaster_secret(EncPMS, Key), case server_rsa_psk_master_secret(PskIdentity, PremasterSecret, State0) of #state{} = State1 -> {Record, State} = next_record(State1), @@ -757,21 +758,18 @@ cipher(#hello_request{}, State0) -> cipher(#certificate_verify{signature = Signature, hashsign_algorithm = CertHashSign}, #state{role = server, - public_key_info = PublicKeyInfo, + public_key_info = {Algo, _, _} =PublicKeyInfo, negotiated_version = Version, session = #session{master_secret = MasterSecret}, - hashsign_algorithm = ConnectionHashSign, tls_handshake_history = Handshake } = State0) -> - HashSign = case CertHashSign of - {_, _} -> CertHashSign; - _ -> ConnectionHashSign - end, - case tls_handshake:certificate_verify(Signature, PublicKeyInfo, + + HashSign = ssl_handshake:select_cert_hashsign(CertHashSign, Algo, Version), + case ssl_handshake:certificate_verify(Signature, PublicKeyInfo, Version, HashSign, MasterSecret, Handshake) of valid -> {Record, State} = next_record(State0), - next_state(cipher, cipher, Record, State); + next_state(cipher, cipher, Record, State#state{cert_hashsign_algorithm = HashSign}); #alert{} = Alert -> handle_own_alert(Alert, Version, cipher, State0) end; @@ -790,7 +788,7 @@ cipher(#finished{verify_data = Data} = Finished, = Session0, connection_states = ConnectionStates0, tls_handshake_history = Handshake0} = State) -> - case tls_handshake:verify_connection(Version, Finished, + case ssl_handshake:verify_connection(Version, Finished, opposite_role(Role), get_current_connection_state_prf(ConnectionStates0, read), MasterSecret, Handshake0) of @@ -1025,7 +1023,7 @@ handle_sync_event({prf, Secret, Label, Seed, WantedLength}, _, StateName, #state{connection_states = ConnectionStates, negotiated_version = Version} = State) -> ConnectionState = - tls_record:current_connection_state(ConnectionStates, read), + ssl_record:current_connection_state(ConnectionStates, read), SecParams = ConnectionState#connection_state.security_parameters, #security_parameters{master_secret = MasterSecret, client_random = ClientRandom, @@ -1040,7 +1038,7 @@ handle_sync_event({prf, Secret, Label, Seed, WantedLength}, _, StateName, (client_random, Acc) -> [ClientRandom|Acc]; (server_random, Acc) -> [ServerRandom|Acc] end, [], Seed)), - tls_handshake:prf(Version, SecretToUse, Label, SeedToUse, WantedLength) + ssl_handshake:prf(Version, SecretToUse, Label, SeedToUse, WantedLength) catch exit:_ -> {error, badarg}; error:Reason -> {error, Reason} @@ -1369,25 +1367,34 @@ sync_send_all_state_event(FsmPid, Event) -> {error, closed} end. -%% We do currently not support cipher suites that use fixed DH. -%% If we want to implement that we should add a code -%% here to extract DH parameters form cert. -handle_peer_cert(PeerCert, PublicKeyInfo, - #state{session = Session} = State0) -> +handle_peer_cert(Role, PeerCert, PublicKeyInfo, + #state{session = #session{cipher_suite = CipherSuite} = Session} = State0) -> State1 = State0#state{session = Session#session{peer_certificate = PeerCert}, public_key_info = PublicKeyInfo}, - State2 = case PublicKeyInfo of - {?'id-ecPublicKey', #'ECPoint'{point = _ECPoint} = PublicKey, PublicKeyParams} -> - ECDHKey = public_key:generate_key(PublicKeyParams), - State3 = State1#state{diffie_hellman_keys = ECDHKey}, - ec_dh_master_secret(ECDHKey, PublicKey, State3); - - _ -> State1 - end, + {KeyAlg,_,_,_} = ssl_cipher:suite_definition(CipherSuite), + State2 = handle_peer_cert_key(Role, PeerCert, PublicKeyInfo, KeyAlg, State1), + {Record, State} = next_record(State2), next_state(certify, certify, Record, State). +handle_peer_cert_key(client, _, + {?'id-ecPublicKey', #'ECPoint'{point = _ECPoint} = PublicKey, PublicKeyParams}, + KeyAlg, State) when KeyAlg == ecdh_rsa; + KeyAlg == ecdh_ecdsa -> + ECDHKey = public_key:generate_key(PublicKeyParams), + ec_dh_master_secret(ECDHKey, PublicKey, State#state{diffie_hellman_keys = ECDHKey}); + +%% We do currently not support cipher suites that use fixed DH. +%% If we want to implement that the following clause can be used +%% to extract DH parameters form cert. +%% handle_peer_cert_key(client, _PeerCert, {?dhpublicnumber, PublicKey, PublicKeyParams}, {_,SignAlg}, +%% #state{diffie_hellman_keys = {_, MyPrivatKey}} = State) when SignAlg == dh_rsa; +%% SignAlg == dh_dss -> +%% dh_master_secret(PublicKeyParams, PublicKey, MyPrivatKey, State); +handle_peer_cert_key(_, _, _, _, State) -> + State. + certify_client(#state{client_certificate_requested = true, role = client, connection_states = ConnectionStates0, transport_cb = Transport, @@ -1397,7 +1404,7 @@ certify_client(#state{client_certificate_requested = true, role = client, session = #session{own_certificate = OwnCert}, socket = Socket, tls_handshake_history = Handshake0} = State) -> - Certificate = tls_handshake:certificate(OwnCert, CertDbHandle, CertDbRef, client), + Certificate = ssl_handshake:certificate(OwnCert, CertDbHandle, CertDbRef, client), {BinCert, ConnectionStates, Handshake} = encode_handshake(Certificate, Version, ConnectionStates0, Handshake0), Transport:send(Socket, BinCert), @@ -1414,11 +1421,10 @@ verify_client_cert(#state{client_certificate_requested = true, role = client, private_key = PrivateKey, session = #session{master_secret = MasterSecret, own_certificate = OwnCert}, - hashsign_algorithm = HashSign, + cert_hashsign_algorithm = HashSign, tls_handshake_history = Handshake0} = State) -> - %%TODO: for TLS 1.2 we can choose a different/stronger HashSign combination for this. - case tls_handshake:client_certificate_verify(OwnCert, MasterSecret, + case ssl_handshake:client_certificate_verify(OwnCert, MasterSecret, Version, HashSign, PrivateKey, Handshake0) of #certificate_verify{} = Verified -> {BinVerified, ConnectionStates, Handshake} = @@ -1435,21 +1441,17 @@ verify_client_cert(#state{client_certificate_requested = true, role = client, verify_client_cert(#state{client_certificate_requested = false} = State) -> State. -do_server_hello(Type, NextProtocolsToSend, - EcPointFormats, EllipticCurves, +do_server_hello(Type, #hello_extensions{next_protocol_negotiation = NextProtocols} = ServerHelloExt, #state{negotiated_version = Version, session = #session{session_id = SessId}, - connection_states = ConnectionStates0, - renegotiation = {Renegotiation, _}} + connection_states = ConnectionStates0} = State0) when is_atom(Type) -> ServerHello = - tls_handshake:server_hello(SessId, Version, - ConnectionStates0, Renegotiation, - NextProtocolsToSend, EcPointFormats, EllipticCurves), + tls_handshake:server_hello(SessId, Version, ConnectionStates0, ServerHelloExt), State = server_hello(ServerHello, State0#state{expecting_next_protocol_negotiation = - NextProtocolsToSend =/= undefined}), + NextProtocols =/= undefined}), case Type of new -> new_server_hello(ServerHello, State); @@ -1480,7 +1482,7 @@ resumed_server_hello(#state{session = Session, connection_states = ConnectionStates0, negotiated_version = Version} = State0) -> - case tls_handshake:master_secret(Version, Session, + case ssl_handshake:master_secret(tls_record, Version, Session, ConnectionStates0, server) of {_, ConnectionStates1} -> State1 = State0#state{connection_states = ConnectionStates1, @@ -1509,7 +1511,7 @@ handle_resumed_session(SessId, #state{connection_states = ConnectionStates0, session_cache = Cache, session_cache_cb = CacheCb} = State0) -> Session = CacheCb:lookup(Cache, {{Host, Port}, SessId}), - case tls_handshake:master_secret(Version, Session, + case ssl_handshake:master_secret(tls_record, Version, Session, ConnectionStates0, client) of {_, ConnectionStates} -> {Record, State} = @@ -1560,8 +1562,7 @@ server_hello(ServerHello, #state{transport_cb = Transport, Transport:send(Socket, BinMsg), State#state{connection_states = ConnectionStates1, tls_handshake_history = Handshake1, - key_algorithm = KeyAlgorithm, - hashsign_algorithm = default_hashsign(Version, KeyAlgorithm)}. + key_algorithm = KeyAlgorithm}. server_hello_done(#state{transport_cb = Transport, socket = Socket, @@ -1569,7 +1570,7 @@ server_hello_done(#state{transport_cb = Transport, connection_states = ConnectionStates0, tls_handshake_history = Handshake0} = State) -> - HelloDone = tls_handshake:server_hello_done(), + HelloDone = ssl_handshake:server_hello_done(), {BinHelloDone, ConnectionStates, Handshake} = encode_handshake(HelloDone, Version, ConnectionStates0, Handshake0), @@ -1589,7 +1590,7 @@ certify_server(#state{transport_cb = Transport, cert_db = CertDbHandle, cert_db_ref = CertDbRef, session = #session{own_certificate = OwnCert}} = State) -> - case tls_handshake:certificate(OwnCert, CertDbHandle, CertDbRef, server) of + case ssl_handshake:certificate(OwnCert, CertDbHandle, CertDbRef, server) of CertMsg = #certificate{} -> {BinCertMsg, ConnectionStates, Handshake} = encode_handshake(CertMsg, Version, ConnectionStates0, Handshake0), @@ -1618,11 +1619,11 @@ key_exchange(#state{role = server, key_algorithm = Algo, Algo == dh_anon -> DHKeys = public_key:generate_key(Params), ConnectionState = - tls_record:pending_connection_state(ConnectionStates0, read), + ssl_record:pending_connection_state(ConnectionStates0, read), SecParams = ConnectionState#connection_state.security_parameters, #security_parameters{client_random = ClientRandom, server_random = ServerRandom} = SecParams, - Msg = tls_handshake:key_exchange(server, Version, {dh, DHKeys, Params, + Msg = ssl_handshake:key_exchange(server, Version, {dh, DHKeys, Params, HashSignAlgo, ClientRandom, ServerRandom, PrivateKey}), @@ -1643,18 +1644,19 @@ key_exchange(#state{role = server, key_algorithm = Algo, negotiated_version = Version, tls_handshake_history = Handshake0, socket = Socket, - transport_cb = Transport + transport_cb = Transport, + session = #session{ecc = Curve} } = State) when Algo == ecdhe_ecdsa; Algo == ecdhe_rsa; Algo == ecdh_anon -> - ECDHKeys = public_key:generate_key(select_curve(State)), + ECDHKeys = public_key:generate_key(Curve), ConnectionState = - tls_record:pending_connection_state(ConnectionStates0, read), + ssl_record:pending_connection_state(ConnectionStates0, read), SecParams = ConnectionState#connection_state.security_parameters, #security_parameters{client_random = ClientRandom, server_random = ServerRandom} = SecParams, - Msg = tls_handshake:key_exchange(server, Version, {ecdh, ECDHKeys, + Msg = ssl_handshake:key_exchange(server, Version, {ecdh, ECDHKeys, HashSignAlgo, ClientRandom, ServerRandom, PrivateKey}), @@ -1679,11 +1681,11 @@ key_exchange(#state{role = server, key_algorithm = psk, transport_cb = Transport } = State) -> ConnectionState = - tls_record:pending_connection_state(ConnectionStates0, read), + ssl_record:pending_connection_state(ConnectionStates0, read), SecParams = ConnectionState#connection_state.security_parameters, #security_parameters{client_random = ClientRandom, server_random = ServerRandom} = SecParams, - Msg = tls_handshake:key_exchange(server, Version, {psk, PskIdentityHint, + Msg = ssl_handshake:key_exchange(server, Version, {psk, PskIdentityHint, HashSignAlgo, ClientRandom, ServerRandom, PrivateKey}), @@ -1706,11 +1708,11 @@ key_exchange(#state{role = server, key_algorithm = dhe_psk, } = State) -> DHKeys = public_key:generate_key(Params), ConnectionState = - tls_record:pending_connection_state(ConnectionStates0, read), + ssl_record:pending_connection_state(ConnectionStates0, read), SecParams = ConnectionState#connection_state.security_parameters, #security_parameters{client_random = ClientRandom, server_random = ServerRandom} = SecParams, - Msg = tls_handshake:key_exchange(server, Version, {dhe_psk, PskIdentityHint, DHKeys, Params, + Msg = ssl_handshake:key_exchange(server, Version, {dhe_psk, PskIdentityHint, DHKeys, Params, HashSignAlgo, ClientRandom, ServerRandom, PrivateKey}), @@ -1735,11 +1737,11 @@ key_exchange(#state{role = server, key_algorithm = rsa_psk, transport_cb = Transport } = State) -> ConnectionState = - tls_record:pending_connection_state(ConnectionStates0, read), + ssl_record:pending_connection_state(ConnectionStates0, read), SecParams = ConnectionState#connection_state.security_parameters, #security_parameters{client_random = ClientRandom, server_random = ServerRandom} = SecParams, - Msg = tls_handshake:key_exchange(server, Version, {psk, PskIdentityHint, + Msg = ssl_handshake:key_exchange(server, Version, {psk, PskIdentityHint, HashSignAlgo, ClientRandom, ServerRandom, PrivateKey}), @@ -1771,11 +1773,11 @@ key_exchange(#state{role = server, key_algorithm = Algo, Keys0 end, ConnectionState = - tls_record:pending_connection_state(ConnectionStates0, read), + ssl_record:pending_connection_state(ConnectionStates0, read), SecParams = ConnectionState#connection_state.security_parameters, #security_parameters{client_random = ClientRandom, server_random = ServerRandom} = SecParams, - Msg = tls_handshake:key_exchange(server, Version, {srp, Keys, SrpParams, + Msg = ssl_handshake:key_exchange(server, Version, {srp, Keys, SrpParams, HashSignAlgo, ClientRandom, ServerRandom, PrivateKey}), @@ -1811,7 +1813,7 @@ key_exchange(#state{role = client, when Algorithm == dhe_dss; Algorithm == dhe_rsa; Algorithm == dh_anon -> - Msg = tls_handshake:key_exchange(client, Version, {dh, DhPubKey}), + Msg = ssl_handshake:key_exchange(client, Version, {dh, DhPubKey}), {BinMsg, ConnectionStates, Handshake} = encode_handshake(Msg, Version, ConnectionStates0, Handshake0), Transport:send(Socket, BinMsg), @@ -1828,7 +1830,7 @@ key_exchange(#state{role = client, when Algorithm == ecdhe_ecdsa; Algorithm == ecdhe_rsa; Algorithm == ecdh_ecdsa; Algorithm == ecdh_rsa; Algorithm == ecdh_anon -> - Msg = tls_handshake:key_exchange(client, Version, {ecdh, Keys}), + Msg = ssl_handshake:key_exchange(client, Version, {ecdh, Keys}), {BinMsg, ConnectionStates, Handshake} = encode_handshake(Msg, Version, ConnectionStates0, Handshake0), Transport:send(Socket, BinMsg), @@ -1842,7 +1844,7 @@ key_exchange(#state{role = client, negotiated_version = Version, socket = Socket, transport_cb = Transport, tls_handshake_history = Handshake0} = State) -> - Msg = tls_handshake:key_exchange(client, Version, {psk, SslOpts#ssl_options.psk_identity}), + Msg = ssl_handshake:key_exchange(client, Version, {psk, SslOpts#ssl_options.psk_identity}), {BinMsg, ConnectionStates, Handshake} = encode_handshake(Msg, Version, ConnectionStates0, Handshake0), Transport:send(Socket, BinMsg), @@ -1857,7 +1859,7 @@ key_exchange(#state{role = client, diffie_hellman_keys = {DhPubKey, _}, socket = Socket, transport_cb = Transport, tls_handshake_history = Handshake0} = State) -> - Msg = tls_handshake:key_exchange(client, Version, {dhe_psk, SslOpts#ssl_options.psk_identity, DhPubKey}), + Msg = ssl_handshake:key_exchange(client, Version, {dhe_psk, SslOpts#ssl_options.psk_identity, DhPubKey}), {BinMsg, ConnectionStates, Handshake} = encode_handshake(Msg, Version, ConnectionStates0, Handshake0), Transport:send(Socket, BinMsg), @@ -1890,7 +1892,7 @@ key_exchange(#state{role = client, when Algorithm == srp_dss; Algorithm == srp_rsa; Algorithm == srp_anon -> - Msg = tls_handshake:key_exchange(client, Version, {srp, ClientPubKey}), + Msg = ssl_handshake:key_exchange(client, Version, {srp, ClientPubKey}), {BinMsg, ConnectionStates, Handshake} = encode_handshake(Msg, Version, ConnectionStates0, Handshake0), Transport:send(Socket, BinMsg), @@ -1907,7 +1909,7 @@ rsa_key_exchange(Version, PremasterSecret, PublicKeyInfo = {Algorithm, _, _}) Algorithm == ?sha384WithRSAEncryption; Algorithm == ?sha512WithRSAEncryption -> - tls_handshake:key_exchange(client, Version, + ssl_handshake:key_exchange(client, Version, {premaster_secret, PremasterSecret, PublicKeyInfo}); rsa_key_exchange(_, _, _) -> @@ -1923,7 +1925,7 @@ rsa_psk_key_exchange(Version, PskIdentity, PremasterSecret, PublicKeyInfo = {Alg Algorithm == ?sha384WithRSAEncryption; Algorithm == ?sha512WithRSAEncryption -> - tls_handshake:key_exchange(client, Version, + ssl_handshake:key_exchange(client, Version, {psk_premaster_secret, PskIdentity, PremasterSecret, PublicKeyInfo}); rsa_psk_key_exchange(_, _, _, _) -> @@ -1937,7 +1939,11 @@ request_client_cert(#state{ssl_options = #ssl_options{verify = verify_peer}, negotiated_version = Version, socket = Socket, transport_cb = Transport} = State) -> - Msg = tls_handshake:certificate_request(ConnectionStates0, CertDbHandle, CertDbRef), + #connection_state{security_parameters = + #security_parameters{cipher_suite = CipherSuite}} = + ssl_record:pending_connection_state(ConnectionStates0, read), + Msg = ssl_handshake:certificate_request(CipherSuite, CertDbHandle, CertDbRef, Version), + {BinMsg, ConnectionStates, Handshake} = encode_handshake(Msg, Version, ConnectionStates0, Handshake0), Transport:send(Socket, BinMsg), @@ -1952,7 +1958,7 @@ finalize_handshake(State, StateName) -> ConnectionStates0 = cipher_protocol(State), ConnectionStates = - tls_record:activate_pending_connection_state(ConnectionStates0, + ssl_record:activate_pending_connection_state(ConnectionStates0, write), State1 = State#state{connection_states = ConnectionStates}, @@ -1970,7 +1976,7 @@ next_protocol(#state{transport_cb = Transport, socket = Socket, next_protocol = NextProtocol, connection_states = ConnectionStates0, tls_handshake_history = Handshake0} = State) -> - NextProtocolMessage = tls_handshake:next_protocol(NextProtocol), + NextProtocolMessage = ssl_handshake:next_protocol(NextProtocol), {BinMsg, ConnectionStates, Handshake} = encode_handshake(NextProtocolMessage, Version, ConnectionStates0, Handshake0), Transport:send(Socket, BinMsg), State#state{connection_states = ConnectionStates, @@ -1992,7 +1998,7 @@ finished(#state{role = Role, socket = Socket, negotiated_version = Version, connection_states = ConnectionStates0, tls_handshake_history = Handshake0}, StateName) -> MasterSecret = Session#session.master_secret, - Finished = tls_handshake:finished(Version, Role, + Finished = ssl_handshake:finished(Version, Role, get_current_connection_state_prf(ConnectionStates0, write), MasterSecret, Handshake0), ConnectionStates1 = save_verify_data(Role, Finished, ConnectionStates0, StateName), @@ -2002,24 +2008,26 @@ finished(#state{role = Role, socket = Socket, negotiated_version = Version, {ConnectionStates, Handshake}. save_verify_data(client, #finished{verify_data = Data}, ConnectionStates, certify) -> - tls_record:set_client_verify_data(current_write, Data, ConnectionStates); + ssl_record:set_client_verify_data(current_write, Data, ConnectionStates); save_verify_data(server, #finished{verify_data = Data}, ConnectionStates, cipher) -> - tls_record:set_server_verify_data(current_both, Data, ConnectionStates); + ssl_record:set_server_verify_data(current_both, Data, ConnectionStates); save_verify_data(client, #finished{verify_data = Data}, ConnectionStates, abbreviated) -> - tls_record:set_client_verify_data(current_both, Data, ConnectionStates); + ssl_record:set_client_verify_data(current_both, Data, ConnectionStates); save_verify_data(server, #finished{verify_data = Data}, ConnectionStates, abbreviated) -> - tls_record:set_server_verify_data(current_write, Data, ConnectionStates). + ssl_record:set_server_verify_data(current_write, Data, ConnectionStates). handle_server_key(#server_key_exchange{exchange_keys = Keys}, #state{key_algorithm = KeyAlg, negotiated_version = Version} = State) -> - Params = tls_handshake:decode_server_key(Keys, KeyAlg, Version), - HashSign = connection_hashsign(Params#server_key_params.hashsign, State), - case HashSign of - {_, SignAlgo} when SignAlgo == anon; SignAlgo == ecdh_anon -> - server_master_secret(Params#server_key_params.params, State); - _ -> - verify_server_key(Params, HashSign, State) + + Params = ssl_handshake:decode_server_key(Keys, KeyAlg, Version), + HashSign = negotiated_hashsign(Params#server_key_params.hashsign, KeyAlg, Version), + case is_anonymous(KeyAlg) of + true -> + server_master_secret(Params#server_key_params.params, + State#state{hashsign_algorithm = HashSign}); + false -> + verify_server_key(Params, HashSign, State#state{hashsign_algorithm = HashSign}) end. verify_server_key(#server_key_params{params = Params, @@ -2030,15 +2038,15 @@ verify_server_key(#server_key_params{params = Params, public_key_info = PubKeyInfo, connection_states = ConnectionStates} = State) -> ConnectionState = - tls_record:pending_connection_state(ConnectionStates, read), + ssl_record:pending_connection_state(ConnectionStates, read), SecParams = ConnectionState#connection_state.security_parameters, #security_parameters{client_random = ClientRandom, server_random = ServerRandom} = SecParams, - Hash = tls_handshake:server_key_exchange_hash(HashAlgo, + Hash = ssl_handshake:server_key_exchange_hash(HashAlgo, <<ClientRandom/binary, ServerRandom/binary, EncParams/binary>>), - case tls_handshake:verify_signature(Version, Hash, HashSign, Signature, PubKeyInfo) of + case ssl_handshake:verify_signature(Version, Hash, HashSign, Signature, PubKeyInfo) of true -> server_master_secret(Params, State); false -> @@ -2074,7 +2082,7 @@ master_from_premaster_secret(PremasterSecret, #state{session = Session, negotiated_version = Version, role = Role, connection_states = ConnectionStates0} = State) -> - case tls_handshake:master_secret(Version, PremasterSecret, + case ssl_handshake:master_secret(tls_record, Version, PremasterSecret, ConnectionStates0, Role) of {MasterSecret, ConnectionStates} -> State#state{ @@ -2227,12 +2235,12 @@ client_srp_master_secret(Generator, Prime, Salt, ServerPub, ClientKeys, end. cipher_role(client, Data, Session, #state{connection_states = ConnectionStates0} = State) -> - ConnectionStates = tls_record:set_server_verify_data(current_both, Data, ConnectionStates0), + ConnectionStates = ssl_record:set_server_verify_data(current_both, Data, ConnectionStates0), next_state_connection(cipher, ack_connection(State#state{session = Session, connection_states = ConnectionStates})); cipher_role(server, Data, Session, #state{connection_states = ConnectionStates0} = State) -> - ConnectionStates1 = tls_record:set_client_verify_data(current_read, Data, ConnectionStates0), + ConnectionStates1 = ssl_record:set_client_verify_data(current_read, Data, ConnectionStates0), {ConnectionStates, Handshake} = finalize_handshake(State#state{connection_states = ConnectionStates1, session = Session}, cipher), @@ -2242,16 +2250,16 @@ cipher_role(server, Data, Session, #state{connection_states = ConnectionStates0 tls_handshake_history = Handshake})). encode_alert(#alert{} = Alert, Version, ConnectionStates) -> - tls_record:encode_alert_record(Alert, Version, ConnectionStates). + ssl_record:encode_alert_record(Alert, Version, ConnectionStates). encode_change_cipher(#change_cipher_spec{}, Version, ConnectionStates) -> - tls_record:encode_change_cipher_spec(Version, ConnectionStates). + ssl_record:encode_change_cipher_spec(Version, ConnectionStates). encode_handshake(HandshakeRec, Version, ConnectionStates0, Handshake0) -> Frag = tls_handshake:encode_handshake(HandshakeRec, Version), Handshake1 = tls_handshake:update_handshake_history(Handshake0, Frag), {E, ConnectionStates1} = - tls_record:encode_handshake(Frag, Version, ConnectionStates0), + ssl_record:encode_handshake(Frag, Version, ConnectionStates0), {E, ConnectionStates1, Handshake1}. encode_packet(Data, #socket_options{packet=Packet}) -> @@ -2346,7 +2354,7 @@ write_application_data(Data0, From, #state{socket = Socket, renegotiate(State#state{send_queue = queue:in_r({From, Data}, SendQueue), renegotiation = {true, internal}}); false -> - {Msgs, ConnectionStates} = tls_record:encode_data(Data, Version, ConnectionStates0), + {Msgs, ConnectionStates} = ssl_record:encode_data(Data, Version, ConnectionStates0), Result = Transport:send(Socket, Msgs), {reply, Result, connection, State#state{connection_states = ConnectionStates}, get_timeout(State)} @@ -2551,7 +2559,7 @@ next_state(Current, Next, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = <<1>>} _ChangeCipher, #state{connection_states = ConnectionStates0} = State0) -> ConnectionStates1 = - tls_record:activate_pending_connection_state(ConnectionStates0, read), + ssl_record:activate_pending_connection_state(ConnectionStates0, read), {Record, State} = next_record(State0#state{connection_states = ConnectionStates1}), next_state(Current, Next, Record, State); next_state(Current, Next, #ssl_tls{type = _Unknown}, State0) -> @@ -2603,7 +2611,7 @@ next_state_connection(StateName, #state{send_queue = Queue0, case queue:out(Queue0) of {{value, {From, Data}}, Queue} -> {Msgs, ConnectionStates} = - tls_record:encode_data(Data, Version, ConnectionStates0), + ssl_record:encode_data(Data, Version, ConnectionStates0), Result = Transport:send(Socket, Msgs), gen_fsm:reply(From, Result), next_state_connection(StateName, @@ -2648,7 +2656,7 @@ invalidate_session(server, _, Port, Session) -> initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User, {CbModule, DataTag, CloseTag, ErrorTag}) -> - ConnectionStates = tls_record:init_connection_states(Role), + ConnectionStates = ssl_record:init_connection_states(Role), SessionCacheCb = case application:get_env(ssl, session_cb) of {ok, Cb} when is_atom(Cb) -> @@ -2910,11 +2918,11 @@ renegotiate(#state{role = server, transport_cb = Transport, negotiated_version = Version, connection_states = ConnectionStates0} = State0) -> - HelloRequest = tls_handshake:hello_request(), + HelloRequest = ssl_handshake:hello_request(), Frag = tls_handshake:encode_handshake(HelloRequest, Version), Hs0 = tls_handshake:init_handshake_history(), {BinMsg, ConnectionStates} = - tls_record:encode_handshake(Frag, Version, ConnectionStates0), + ssl_record:encode_handshake(Frag, Version, ConnectionStates0), Transport:send(Socket, BinMsg), {Record, State} = next_record(State0#state{connection_states = ConnectionStates, @@ -2989,15 +2997,43 @@ handle_trusted_certs_db(#state{cert_db_ref = Ref, end. get_current_connection_state_prf(CStates, Direction) -> - CS = tls_record:current_connection_state(CStates, Direction), + CS = ssl_record:current_connection_state(CStates, Direction), CS#connection_state.security_parameters#security_parameters.prf_algorithm. get_pending_connection_state_prf(CStates, Direction) -> - CS = tls_record:pending_connection_state(CStates, Direction), + CS = ssl_record:pending_connection_state(CStates, Direction), CS#connection_state.security_parameters#security_parameters.prf_algorithm. -connection_hashsign(HashSign = {_, _}, _State) -> - HashSign; -connection_hashsign(_, #state{hashsign_algorithm = HashSign}) -> +start_or_recv_cancel_timer(infinity, _RecvFrom) -> + undefined; +start_or_recv_cancel_timer(Timeout, RecvFrom) -> + erlang:send_after(Timeout, self(), {cancel_start_or_recv, RecvFrom}). + +cancel_timer(undefined) -> + ok; +cancel_timer(Timer) -> + erlang:cancel_timer(Timer), + ok. + +handle_unrecv_data(StateName, #state{socket = Socket, transport_cb = Transport} = State) -> + ssl_socket:setopts(Transport, Socket, [{active, false}]), + case Transport:recv(Socket, 0, 0) of + {error, closed} -> + ok; + {ok, Data} -> + handle_close_alert(Data, StateName, State) + end. + +handle_close_alert(Data, StateName, State0) -> + case next_tls_record(Data, State0) of + {#ssl_tls{type = ?ALERT, fragment = EncAlerts}, State} -> + [Alert|_] = decode_alerts(EncAlerts), + handle_normal_shutdown(Alert, StateName, State); + _ -> + ok + end. +negotiated_hashsign(undefined, Algo, Version) -> + default_hashsign(Version, Algo); +negotiated_hashsign(HashSign = {_, _}, _, _) -> HashSign. %% RFC 5246, Sect. 7.4.1.4.1. Signature Algorithms @@ -3015,11 +3051,12 @@ connection_hashsign(_, #state{hashsign_algorithm = HashSign}) -> %% ECDHE_ECDSA), behave as if the client had sent value {sha1,ecdsa}. default_hashsign(_Version = {Major, Minor}, KeyExchange) - when Major == 3 andalso Minor >= 3 andalso + when Major >= 3 andalso Minor >= 3 andalso (KeyExchange == rsa orelse KeyExchange == dhe_rsa orelse KeyExchange == dh_rsa orelse KeyExchange == ecdhe_rsa orelse + KeyExchange == ecdh_rsa orelse KeyExchange == srp_rsa) -> {sha, rsa}; default_hashsign(_Version, KeyExchange) @@ -3027,12 +3064,12 @@ default_hashsign(_Version, KeyExchange) KeyExchange == dhe_rsa; KeyExchange == dh_rsa; KeyExchange == ecdhe_rsa; + KeyExchange == ecdh_rsa; KeyExchange == srp_rsa -> {md5sha, rsa}; default_hashsign(_Version, KeyExchange) when KeyExchange == ecdhe_ecdsa; - KeyExchange == ecdh_ecdsa; - KeyExchange == ecdh_rsa -> + KeyExchange == ecdh_ecdsa -> {sha, ecdsa}; default_hashsign(_Version, KeyExchange) when KeyExchange == dhe_dss; @@ -3047,37 +3084,13 @@ default_hashsign(_Version, KeyExchange) KeyExchange == rsa_psk; KeyExchange == srp_anon -> {null, anon}. - -start_or_recv_cancel_timer(infinity, _RecvFrom) -> - undefined; -start_or_recv_cancel_timer(Timeout, RecvFrom) -> - erlang:send_after(Timeout, self(), {cancel_start_or_recv, RecvFrom}). - -cancel_timer(undefined) -> - ok; -cancel_timer(Timer) -> - erlang:cancel_timer(Timer), - ok. - -handle_unrecv_data(StateName, #state{socket = Socket, transport_cb = Transport} = State) -> - ssl_socket:setopts(Transport, Socket, [{active, false}]), - case Transport:recv(Socket, 0, 0) of - {error, closed} -> - ok; - {ok, Data} -> - handle_close_alert(Data, StateName, State) - end. - -handle_close_alert(Data, StateName, State0) -> - case next_tls_record(Data, State0) of - {#ssl_tls{type = ?ALERT, fragment = EncAlerts}, State} -> - [Alert|_] = decode_alerts(EncAlerts), - handle_normal_shutdown(Alert, StateName, State); - _ -> - ok - end. - -select_curve(#state{client_ecc = {[Curve|_], _}}) -> - {namedCurve, Curve}; -select_curve(_) -> - {namedCurve, ?secp256k1}. + +is_anonymous(Algo) when Algo == dh_anon; + Algo == ecdh_anon; + Algo == psk; + Algo == dhe_psk; + Algo == rsa_psk; + Algo == srp_anon -> + true; +is_anonymous(_) -> + false. diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index 51fd2e1dc9..ecbca83e10 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -18,7 +18,8 @@ %% %%---------------------------------------------------------------------- -%% Purpose: Help funtions for handling the SSL-handshake protocol +%% Purpose: Help funtions for handling the TLS (specific parts of) +%%% SSL/TLS/DTLS handshake protocol %%---------------------------------------------------------------------- -module(tls_handshake). @@ -31,23 +32,9 @@ -include("ssl_srp.hrl"). -include_lib("public_key/include/public_key.hrl"). --export([master_secret/4, client_hello/8, server_hello/7, hello/4, - hello_request/0, certify/7, certificate/4, - client_certificate_verify/6, certificate_verify/6, verify_signature/5, - certificate_request/3, key_exchange/3, server_key_exchange_hash/2, - finished/5, verify_connection/6, get_tls_handshake/3, - decode_client_key/3, decode_server_key/3, server_hello_done/0, - encode_handshake/2, init_handshake_history/0, update_handshake_history/2, - decrypt_premaster_secret/2, prf/5, next_protocol/1]). - --export([dec_hello_extensions/2]). - --type tls_handshake() :: #client_hello{} | #server_hello{} | - #server_hello_done{} | #certificate{} | #certificate_request{} | - #client_key_exchange{} | #finished{} | #certificate_verify{} | - #hello_request{} | #next_protocol{}. - --define(NAMED_CURVE_TYPE, 3). +-export([client_hello/8, server_hello/4, hello/4, + get_tls_handshake/3, encode_handshake/2, decode_handshake/3, + init_handshake_history/0, update_handshake_history/2]). %%==================================================================== %% Internal application API @@ -65,517 +52,104 @@ client_hello(Host, Port, ConnectionStates, } = SslOpts, Cache, CacheCb, Renegotiation, OwnCert) -> Version = tls_record:highest_protocol_version(Versions), - Pending = tls_record:pending_connection_state(ConnectionStates, read), + Pending = ssl_record:pending_connection_state(ConnectionStates, read), SecParams = Pending#connection_state.security_parameters, - Ciphers = available_suites(UserSuites, Version), - SRP = srp_user(SslOpts), - {EcPointFormats, EllipticCurves} = default_ecc_extensions(Version), + CipherSuites = ssl_handshake:available_suites(UserSuites, Version), + + Extensions = ssl_handshake:client_hello_extensions(Version, CipherSuites, + SslOpts, ConnectionStates, Renegotiation), Id = ssl_session:client_id({Host, Port, SslOpts}, Cache, CacheCb, OwnCert), #client_hello{session_id = Id, client_version = Version, - cipher_suites = cipher_suites(Ciphers, Renegotiation), - compression_methods = tls_record:compressions(), + cipher_suites = ssl_handshake:cipher_suites(CipherSuites, Renegotiation), + compression_methods = ssl_record:compressions(), random = SecParams#security_parameters.client_random, - - renegotiation_info = - renegotiation_info(client, ConnectionStates, Renegotiation), - srp = SRP, - hash_signs = default_hash_signs(), - ec_point_formats = EcPointFormats, - elliptic_curves = EllipticCurves, - next_protocol_negotiation = - encode_client_protocol_negotiation(SslOpts#ssl_options.next_protocol_selector, Renegotiation) + extensions = Extensions }. -encode_protocol(Protocol, Acc) -> - Len = byte_size(Protocol), - <<Acc/binary, ?BYTE(Len), Protocol/binary>>. - -encode_protocols_advertised_on_server(undefined) -> - undefined; - -encode_protocols_advertised_on_server(Protocols) -> - #next_protocol_negotiation{extension_data = lists:foldl(fun encode_protocol/2, <<>>, Protocols)}. - %%-------------------------------------------------------------------- --spec server_hello(session_id(), tls_version(), #connection_states{}, - boolean(), [binary()] | undefined, - #ec_point_formats{} | undefined, - #elliptic_curves{} | undefined) -> #server_hello{}. +-spec server_hello(binary(), tls_version(), #connection_states{}, + #hello_extensions{}) -> #server_hello{}. %% %% Description: Creates a server hello message. %%-------------------------------------------------------------------- -server_hello(SessionId, Version, ConnectionStates, Renegotiation, - ProtocolsAdvertisedOnServer, EcPointFormats, EllipticCurves) -> - Pending = tls_record:pending_connection_state(ConnectionStates, read), +server_hello(SessionId, Version, ConnectionStates, Extensions) -> + Pending = ssl_record:pending_connection_state(ConnectionStates, read), SecParams = Pending#connection_state.security_parameters, + #server_hello{server_version = Version, cipher_suite = SecParams#security_parameters.cipher_suite, compression_method = SecParams#security_parameters.compression_algorithm, random = SecParams#security_parameters.server_random, session_id = SessionId, - renegotiation_info = - renegotiation_info(server, ConnectionStates, Renegotiation), - ec_point_formats = EcPointFormats, - elliptic_curves = EllipticCurves, - next_protocol_negotiation = encode_protocols_advertised_on_server(ProtocolsAdvertisedOnServer) + extensions = Extensions }. %%-------------------------------------------------------------------- --spec hello_request() -> #hello_request{}. -%% -%% Description: Creates a hello request message sent by server to -%% trigger renegotiation. -%%-------------------------------------------------------------------- -hello_request() -> - #hello_request{}. - -%%-------------------------------------------------------------------- -spec hello(#server_hello{} | #client_hello{}, #ssl_options{}, #connection_states{} | {inet:port_number(), #session{}, db_handle(), - atom(), #connection_states{}, binary()}, + atom(), #connection_states{}, binary() | undefined}, boolean()) -> {tls_version(), session_id(), #connection_states{}, binary() | undefined}| - {tls_version(), {resumed | new, #session{}}, #connection_states{}, [binary()] | undefined, + {tls_version(), {resumed | new, #session{}}, #connection_states{}, + [binary()] | undefined, [oid()] | undefined, [oid()] | undefined} | #alert{}. %% %% Description: Handles a recieved hello message %%-------------------------------------------------------------------- -hello(#server_hello{cipher_suite = CipherSuite, server_version = Version, - compression_method = Compression, random = Random, - session_id = SessionId, renegotiation_info = Info, - hash_signs = _HashSigns} = Hello, - #ssl_options{secure_renegotiate = SecureRenegotation, next_protocol_selector = NextProtocolSelector, - versions = SupportedVersions}, +hello(#server_hello{server_version = Version, random = Random, + cipher_suite = CipherSuite, + compression_method = Compression, + session_id = SessionId, extensions = HelloExt}, + #ssl_options{versions = SupportedVersions} = SslOpt, ConnectionStates0, Renegotiation) -> - %%TODO: select hash and signature algorigthm case tls_record:is_acceptable_version(Version, SupportedVersions) of true -> - case handle_renegotiation_info(client, Info, ConnectionStates0, - Renegotiation, SecureRenegotation, []) of - {ok, ConnectionStates1} -> - ConnectionStates = - hello_pending_connection_states(client, Version, CipherSuite, Random, - Compression, ConnectionStates1), - case handle_next_protocol(Hello, NextProtocolSelector, Renegotiation) of - #alert{} = Alert -> - Alert; - Protocol -> - {Version, SessionId, ConnectionStates, Protocol} - end; - #alert{} = Alert -> - Alert - end; + handle_hello_extensions(Version, SessionId, Random, CipherSuite, + Compression, HelloExt, SslOpt, ConnectionStates0, Renegotiation); false -> ?ALERT_REC(?FATAL, ?PROTOCOL_VERSION) end; -hello(#client_hello{client_version = ClientVersion} = Hello, +hello(#client_hello{client_version = ClientVersion, + session_id = SugesstedId, + cipher_suites = CipherSuites, + compression_methods = Compressions, + random = Random, + extensions = #hello_extensions{elliptic_curves = Curves} = HelloExt}, #ssl_options{versions = Versions} = SslOpts, {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert}, Renegotiation) -> - %% TODO: select hash and signature algorithm - Version = select_version(ClientVersion, Versions), + Version = ssl_handshake:select_version(tls_record, ClientVersion, Versions), case tls_record:is_acceptable_version(Version, Versions) of true -> - %% TODO: need to take supported Curves into Account when selecting the CipherSuite.... - %% if whe have an ECDSA cert with an unsupported curve, we need to drop ECDSA ciphers + ECCCurve = ssl_handshake:select_curve(Curves, ssl_handshake:supported_ecc(Version)), {Type, #session{cipher_suite = CipherSuite} = Session1} - = select_session(Hello, Port, Session0, Version, - SslOpts, Cache, CacheCb, Cert), + = ssl_handshake:select_session(SugesstedId, CipherSuites, Compressions, + Port, Session0#session{ecc = ECCCurve}, Version, + SslOpts, Cache, CacheCb, Cert), case CipherSuite of no_suite -> ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY); _ -> - try handle_hello_extensions(Hello, Version, SslOpts, Session1, ConnectionStates0, Renegotiation) of - {Session, ConnectionStates, ProtocolsToAdvertise, ECPointFormats, EllipticCurves} -> - {Version, {Type, Session}, ConnectionStates, - ProtocolsToAdvertise, ECPointFormats, EllipticCurves} - catch throw:Alert -> - Alert - end + handle_hello_extensions(Version, Type, Random, HelloExt, + SslOpts, Session1, ConnectionStates0, + Renegotiation) end; false -> ?ALERT_REC(?FATAL, ?PROTOCOL_VERSION) end. %%-------------------------------------------------------------------- --spec certify(#certificate{}, db_handle(), certdb_ref(), integer() | nolimit, - verify_peer | verify_none, {fun(), term}, - client | server) -> {der_cert(), public_key_info()} | #alert{}. -%% -%% Description: Handles a certificate handshake message -%%-------------------------------------------------------------------- -certify(#certificate{asn1_certificates = ASN1Certs}, CertDbHandle, CertDbRef, - MaxPathLen, _Verify, VerifyFunAndState, Role) -> - [PeerCert | _] = ASN1Certs, - - ValidationFunAndState = - case VerifyFunAndState of - undefined -> - {fun(OtpCert, ExtensionOrVerifyResult, SslState) -> - ssl_certificate:validate_extension(OtpCert, - ExtensionOrVerifyResult, SslState) - end, Role}; - {Fun, UserState0} -> - {fun(OtpCert, {extension, _} = Extension, {SslState, UserState}) -> - case ssl_certificate:validate_extension(OtpCert, - Extension, - SslState) of - {valid, NewSslState} -> - {valid, {NewSslState, UserState}}; - {fail, Reason} -> - apply_user_fun(Fun, OtpCert, Reason, UserState, - SslState); - {unknown, _} -> - apply_user_fun(Fun, OtpCert, - Extension, UserState, SslState) - end; - (OtpCert, VerifyResult, {SslState, UserState}) -> - apply_user_fun(Fun, OtpCert, VerifyResult, UserState, - SslState) - end, {Role, UserState0}} - end, - - try - {TrustedErlCert, CertPath} = - ssl_certificate:trusted_cert_and_path(ASN1Certs, CertDbHandle, CertDbRef), - case public_key:pkix_path_validation(TrustedErlCert, - CertPath, - [{max_path_length, - MaxPathLen}, - {verify_fun, ValidationFunAndState}]) of - {ok, {PublicKeyInfo,_}} -> - {PeerCert, PublicKeyInfo}; - {error, Reason} -> - path_validation_alert(Reason) - end - catch - error:_ -> - %% ASN-1 decode of certificate somehow failed - ?ALERT_REC(?FATAL, ?CERTIFICATE_UNKNOWN) - end. - -%%-------------------------------------------------------------------- --spec certificate(der_cert(), db_handle(), certdb_ref(), client | server) -> #certificate{} | #alert{}. -%% -%% Description: Creates a certificate message. -%%-------------------------------------------------------------------- -certificate(OwnCert, CertDbHandle, CertDbRef, client) -> - Chain = - case ssl_certificate:certificate_chain(OwnCert, CertDbHandle, CertDbRef) of - {ok, CertChain} -> - CertChain; - {error, _} -> - %% If no suitable certificate is available, the client - %% SHOULD send a certificate message containing no - %% certificates. (chapter 7.4.6. RFC 4346) - [] - end, - #certificate{asn1_certificates = Chain}; - -certificate(OwnCert, CertDbHandle, CertDbRef, server) -> - case ssl_certificate:certificate_chain(OwnCert, CertDbHandle, CertDbRef) of - {ok, Chain} -> - #certificate{asn1_certificates = Chain}; - {error, _} -> - ?ALERT_REC(?FATAL, ?INTERNAL_ERROR) - end. - -%%-------------------------------------------------------------------- --spec client_certificate_verify(undefined | der_cert(), binary(), - tls_version(), term(), private_key(), - tls_handshake_history()) -> - #certificate_verify{} | ignore | #alert{}. -%% -%% Description: Creates a certificate_verify message, called by the client. -%%-------------------------------------------------------------------- -client_certificate_verify(undefined, _, _, _, _, _) -> - ignore; -client_certificate_verify(_, _, _, _, undefined, _) -> - ignore; -client_certificate_verify(OwnCert, MasterSecret, Version, - {HashAlgo, SignAlgo}, - PrivateKey, {Handshake, _}) -> - case public_key:pkix_is_fixed_dh_cert(OwnCert) of - true -> - ?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE); - false -> - Hashes = - calc_certificate_verify(Version, HashAlgo, MasterSecret, Handshake), - Signed = digitally_signed(Version, Hashes, HashAlgo, PrivateKey), - #certificate_verify{signature = Signed, hashsign_algorithm = {HashAlgo, SignAlgo}} - end. - -%%-------------------------------------------------------------------- --spec certificate_verify(binary(), public_key_info(), tls_version(), term(), - binary(), tls_handshake_history()) -> valid | #alert{}. -%% -%% Description: Checks that the certificate_verify message is valid. -%%-------------------------------------------------------------------- -certificate_verify(Signature, PublicKeyInfo, Version, - HashSign = {HashAlgo, _}, MasterSecret, {_, Handshake}) -> - Hash = calc_certificate_verify(Version, HashAlgo, MasterSecret, Handshake), - case verify_signature(Version, Hash, HashSign, Signature, PublicKeyInfo) of - true -> - valid; - _ -> - ?ALERT_REC(?FATAL, ?BAD_CERTIFICATE) - end. - -%%-------------------------------------------------------------------- --spec verify_signature(tls_version(), binary(), {term(), term()}, binary(), - public_key_info()) -> true | false. -%% -%% Description: Checks that a public_key signature is valid. -%%-------------------------------------------------------------------- -verify_signature(_Version, _Hash, {_HashAlgo, anon}, _Signature, _) -> - true; -verify_signature({3, Minor}, Hash, {HashAlgo, rsa}, Signature, {?rsaEncryption, PubKey, _PubKeyParams}) - when Minor >= 3 -> - public_key:verify({digest, Hash}, HashAlgo, Signature, PubKey); -verify_signature(_Version, Hash, _HashAlgo, Signature, {?rsaEncryption, PubKey, _PubKeyParams}) -> - case public_key:decrypt_public(Signature, PubKey, - [{rsa_pad, rsa_pkcs1_padding}]) of - Hash -> true; - _ -> false - end; -verify_signature(_Version, Hash, {HashAlgo, dsa}, Signature, {?'id-dsa', PublicKey, PublicKeyParams}) -> - public_key:verify({digest, Hash}, HashAlgo, Signature, {PublicKey, PublicKeyParams}); -verify_signature(_Version, Hash, {HashAlgo, ecdsa}, Signature, {?'id-ecPublicKey', PublicKey, PublicKeyParams}) -> - public_key:verify({digest, Hash}, HashAlgo, Signature, {PublicKey, PublicKeyParams}). - -%%-------------------------------------------------------------------- --spec certificate_request(#connection_states{}, db_handle(), certdb_ref()) -> - #certificate_request{}. -%% -%% Description: Creates a certificate_request message, called by the server. -%%-------------------------------------------------------------------- -certificate_request(ConnectionStates, CertDbHandle, CertDbRef) -> - #connection_state{security_parameters = - #security_parameters{cipher_suite = CipherSuite}} = - tls_record:pending_connection_state(ConnectionStates, read), - Types = certificate_types(CipherSuite), - HashSigns = default_hash_signs(), - Authorities = certificate_authorities(CertDbHandle, CertDbRef), - #certificate_request{ - certificate_types = Types, - hashsign_algorithms = HashSigns, - certificate_authorities = Authorities - }. - -%%-------------------------------------------------------------------- --spec key_exchange(client | server, tls_version(), - {premaster_secret, binary(), public_key_info()} | - {dh, binary()} | - {dh, {binary(), binary()}, #'DHParameter'{}, {HashAlgo::atom(), SignAlgo::atom()}, - binary(), binary(), private_key()} | - {ecdh, #'ECPrivateKey'{}} | - {psk, binary()} | - {dhe_psk, binary(), binary()} | - {srp, {binary(), binary()}, #srp_user{}, {HashAlgo::atom(), SignAlgo::atom()}, - binary(), binary(), private_key()}) -> - #client_key_exchange{} | #server_key_exchange{}. -%% -%% Description: Creates a keyexchange message. -%%-------------------------------------------------------------------- -key_exchange(client, _Version, {premaster_secret, Secret, {_, PublicKey, _}}) -> - EncPremasterSecret = - encrypted_premaster_secret(Secret, PublicKey), - #client_key_exchange{exchange_keys = EncPremasterSecret}; - -key_exchange(client, _Version, {dh, PublicKey}) -> - #client_key_exchange{ - exchange_keys = #client_diffie_hellman_public{ - dh_public = PublicKey} - }; - -key_exchange(client, _Version, {ecdh, #'ECPrivateKey'{publicKey = {0, ECPublicKey}}}) -> - #client_key_exchange{ - exchange_keys = #client_ec_diffie_hellman_public{ - dh_public = ECPublicKey} - }; - -key_exchange(client, _Version, {psk, Identity}) -> - #client_key_exchange{ - exchange_keys = #client_psk_identity{ - identity = Identity} - }; - -key_exchange(client, _Version, {dhe_psk, Identity, PublicKey}) -> - #client_key_exchange{ - exchange_keys = #client_dhe_psk_identity{ - identity = Identity, - dh_public = PublicKey} - }; - -key_exchange(client, _Version, {psk_premaster_secret, PskIdentity, Secret, {_, PublicKey, _}}) -> - EncPremasterSecret = - encrypted_premaster_secret(Secret, PublicKey), - #client_key_exchange{ - exchange_keys = #client_rsa_psk_identity{ - identity = PskIdentity, - exchange_keys = EncPremasterSecret}}; - -key_exchange(client, _Version, {srp, PublicKey}) -> - #client_key_exchange{ - exchange_keys = #client_srp_public{ - srp_a = PublicKey} - }; - -key_exchange(server, Version, {dh, {PublicKey, _}, - #'DHParameter'{prime = P, base = G}, - HashSign, ClientRandom, ServerRandom, PrivateKey}) -> - ServerDHParams = #server_dh_params{dh_p = int_to_bin(P), - dh_g = int_to_bin(G), dh_y = PublicKey}, - enc_server_key_exchange(Version, ServerDHParams, HashSign, - ClientRandom, ServerRandom, PrivateKey); - -key_exchange(server, Version, {ecdh, #'ECPrivateKey'{publicKey = {0, ECPublicKey}, - parameters = ECCurve}, HashSign, ClientRandom, ServerRandom, - PrivateKey}) -> - ServerECParams = #server_ecdh_params{curve = ECCurve, public = ECPublicKey}, - enc_server_key_exchange(Version, ServerECParams, HashSign, - ClientRandom, ServerRandom, PrivateKey); - -key_exchange(server, Version, {psk, PskIdentityHint, - HashSign, ClientRandom, ServerRandom, PrivateKey}) -> - ServerPSKParams = #server_psk_params{hint = PskIdentityHint}, - enc_server_key_exchange(Version, ServerPSKParams, HashSign, - ClientRandom, ServerRandom, PrivateKey); - -key_exchange(server, Version, {dhe_psk, PskIdentityHint, {PublicKey, _}, - #'DHParameter'{prime = P, base = G}, - HashSign, ClientRandom, ServerRandom, PrivateKey}) -> - ServerEDHPSKParams = #server_dhe_psk_params{ - hint = PskIdentityHint, - dh_params = #server_dh_params{dh_p = int_to_bin(P), - dh_g = int_to_bin(G), dh_y = PublicKey} - }, - enc_server_key_exchange(Version, ServerEDHPSKParams, - HashSign, ClientRandom, ServerRandom, PrivateKey); - -key_exchange(server, Version, {srp, {PublicKey, _}, - #srp_user{generator = Generator, prime = Prime, - salt = Salt}, - HashSign, ClientRandom, ServerRandom, PrivateKey}) -> - ServerSRPParams = #server_srp_params{srp_n = Prime, srp_g = Generator, - srp_s = Salt, srp_b = PublicKey}, - enc_server_key_exchange(Version, ServerSRPParams, HashSign, - ClientRandom, ServerRandom, PrivateKey). - -enc_server_key_exchange(Version, Params, {HashAlgo, SignAlgo}, - ClientRandom, ServerRandom, PrivateKey) -> - EncParams = enc_server_key(Params), - case HashAlgo of - null -> - #server_key_params{params = Params, - params_bin = EncParams, - hashsign = {null, anon}, - signature = <<>>}; - _ -> - Hash = - server_key_exchange_hash(HashAlgo, <<ClientRandom/binary, - ServerRandom/binary, - EncParams/binary>>), - Signature = digitally_signed(Version, Hash, HashAlgo, PrivateKey), - #server_key_params{params = Params, - params_bin = EncParams, - hashsign = {HashAlgo, SignAlgo}, - signature = Signature} - end. - -%%-------------------------------------------------------------------- --spec master_secret(tls_version(), #session{} | binary(), #connection_states{}, - client | server) -> {binary(), #connection_states{}} | #alert{}. -%% -%% Description: Sets or calculates the master secret and calculate keys, -%% updating the pending connection states. The Mastersecret and the update -%% connection states are returned or an alert if the calculation fails. -%%------------------------------------------------------------------- -master_secret(Version, #session{master_secret = Mastersecret}, - ConnectionStates, Role) -> - ConnectionState = - tls_record:pending_connection_state(ConnectionStates, read), - SecParams = ConnectionState#connection_state.security_parameters, - try master_secret(Version, Mastersecret, SecParams, - ConnectionStates, Role) - catch - exit:Reason -> - Report = io_lib:format("Key calculation failed due to ~p", - [Reason]), - error_logger:error_report(Report), - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) - end; - -master_secret(Version, PremasterSecret, ConnectionStates, Role) -> - ConnectionState = - tls_record:pending_connection_state(ConnectionStates, read), - SecParams = ConnectionState#connection_state.security_parameters, - #security_parameters{prf_algorithm = PrfAlgo, - client_random = ClientRandom, - server_random = ServerRandom} = SecParams, - try master_secret(Version, - calc_master_secret(Version,PrfAlgo,PremasterSecret, - ClientRandom, ServerRandom), - SecParams, ConnectionStates, Role) - catch - exit:Reason -> - Report = io_lib:format("Master secret calculation failed" - " due to ~p", [Reason]), - error_logger:error_report(Report), - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) - end. - --spec next_protocol(binary()) -> #next_protocol{}. - -next_protocol(SelectedProtocol) -> - #next_protocol{selected_protocol = SelectedProtocol}. - -%%-------------------------------------------------------------------- --spec finished(tls_version(), client | server, integer(), binary(), tls_handshake_history()) -> - #finished{}. -%% -%% Description: Creates a handshake finished message -%%------------------------------------------------------------------- -finished(Version, Role, PrfAlgo, MasterSecret, {Handshake, _}) -> % use the current handshake - #finished{verify_data = - calc_finished(Version, Role, PrfAlgo, MasterSecret, Handshake)}. - -%%-------------------------------------------------------------------- --spec verify_connection(tls_version(), #finished{}, client | server, integer(), binary(), - tls_handshake_history()) -> verified | #alert{}. -%% -%% Description: Checks the ssl handshake finished message to verify -%% the connection. -%%------------------------------------------------------------------- -verify_connection(Version, #finished{verify_data = Data}, - Role, PrfAlgo, MasterSecret, {_, Handshake}) -> - %% use the previous hashes - case calc_finished(Version, Role, PrfAlgo, MasterSecret, Handshake) of - Data -> - verified; - _ -> - ?ALERT_REC(?FATAL, ?DECRYPT_ERROR) - end. -%%-------------------------------------------------------------------- --spec server_hello_done() -> #server_hello_done{}. -%% -%% Description: Creates a server hello done message. -%%-------------------------------------------------------------------- -server_hello_done() -> - #server_hello_done{}. - -%%-------------------------------------------------------------------- -spec encode_handshake(tls_handshake(), tls_version()) -> iolist(). %% -%% Description: Encode a handshake packet to binary +%% Description: Encode a handshake packet %%--------------------------------------------------------------------x encode_handshake(Package, Version) -> - {MsgType, Bin} = enc_hs(Package, Version), + {MsgType, Bin} = enc_handshake(Package, Version), Len = byte_size(Bin), [MsgType, ?uint24(Len), Bin]. @@ -593,30 +167,6 @@ get_tls_handshake(Version, Data, Buffer) -> get_tls_handshake_aux(Version, list_to_binary([Buffer, Data]), []). %%-------------------------------------------------------------------- --spec decode_client_key(binary(), key_algo(), tls_version()) -> - #encrypted_premaster_secret{} - | #client_diffie_hellman_public{} - | #client_ec_diffie_hellman_public{} - | #client_psk_identity{} - | #client_dhe_psk_identity{} - | #client_rsa_psk_identity{} - | #client_srp_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). - -%%-------------------------------------------------------------------- --spec decode_server_key(binary(), key_algo(), tls_version()) -> - #server_key_params{}. -%% -%% Description: Decode server_key data and return appropriate type -%%-------------------------------------------------------------------- -decode_server_key(ServerKey, Type, Version) -> - dec_server_key(ServerKey, key_exchange_alg(Type), Version). - -%%-------------------------------------------------------------------- -spec init_handshake_history() -> tls_handshake_history(). %% @@ -646,1182 +196,99 @@ update_handshake_history(Handshake, % special-case SSL2 client hello update_handshake_history({Handshake0, _Prev}, Data) -> {[Data|Handshake0], Handshake0}. -%%-------------------------------------------------------------------- --spec decrypt_premaster_secret(binary(), #'RSAPrivateKey'{}) -> binary(). -%% -%% Description: Public key decryption using the private key. -%%-------------------------------------------------------------------- -decrypt_premaster_secret(Secret, RSAPrivateKey) -> - try public_key:decrypt_private(Secret, RSAPrivateKey, - [{rsa_pad, rsa_pkcs1_padding}]) - catch - _:_ -> - io:format("decrypt_premaster_secret error"), - throw(?ALERT_REC(?FATAL, ?DECRYPT_ERROR)) - end. - -%%-------------------------------------------------------------------- --spec server_key_exchange_hash(md5sha | md5 | sha | sha224 |sha256 | sha384 | sha512, binary()) -> binary(). -%% -%% Description: Calculate server key exchange hash -%%-------------------------------------------------------------------- -server_key_exchange_hash(md5sha, Value) -> - MD5 = crypto:hash(md5, Value), - SHA = crypto:hash(sha, Value), - <<MD5/binary, SHA/binary>>; - -server_key_exchange_hash(Hash, Value) -> - crypto:hash(Hash, Value). - -%%-------------------------------------------------------------------- --spec prf(tls_version(), binary(), binary(), [binary()], non_neg_integer()) -> - {ok, binary()} | {error, undefined}. -%% -%% Description: use the TLS PRF to generate key material -%%-------------------------------------------------------------------- -prf({3,0}, _, _, _, _) -> - {error, undefined}; -prf({3,1}, Secret, Label, Seed, WantedLength) -> - {ok, ssl_tls1:prf(?MD5SHA, Secret, Label, Seed, WantedLength)}; -prf({3,_N}, Secret, Label, Seed, WantedLength) -> - {ok, ssl_tls1:prf(?SHA256, Secret, Label, Seed, WantedLength)}. - -%%-------------------------------------------------------------------- -%%% Internal functions -%%-------------------------------------------------------------------- get_tls_handshake_aux(Version, <<?BYTE(Type), ?UINT24(Length), Body:Length/binary,Rest/binary>>, Acc) -> Raw = <<?BYTE(Type), ?UINT24(Length), Body/binary>>, - H = dec_hs(Version, Type, Body), - get_tls_handshake_aux(Version, Rest, [{H,Raw} | Acc]); + Handshake = decode_handshake(Version, Type, Body), + get_tls_handshake_aux(Version, Rest, [{Handshake,Raw} | Acc]); get_tls_handshake_aux(_Version, Data, Acc) -> {lists:reverse(Acc), Data}. -path_validation_alert({bad_cert, cert_expired}) -> - ?ALERT_REC(?FATAL, ?CERTIFICATE_EXPIRED); -path_validation_alert({bad_cert, invalid_issuer}) -> - ?ALERT_REC(?FATAL, ?BAD_CERTIFICATE); -path_validation_alert({bad_cert, invalid_signature}) -> - ?ALERT_REC(?FATAL, ?BAD_CERTIFICATE); -path_validation_alert({bad_cert, name_not_permitted}) -> - ?ALERT_REC(?FATAL, ?BAD_CERTIFICATE); -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, selfsigned_peer}) -> - ?ALERT_REC(?FATAL, ?BAD_CERTIFICATE); -path_validation_alert({bad_cert, unknown_ca}) -> - ?ALERT_REC(?FATAL, ?UNKNOWN_CA); -path_validation_alert(_) -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE). - -select_session(Hello, Port, Session, Version, - #ssl_options{ciphers = UserSuites} = SslOpts, Cache, CacheCb, Cert) -> - SuggestedSessionId = Hello#client_hello.session_id, - {SessionId, Resumed} = ssl_session:server_id(Port, SuggestedSessionId, - SslOpts, Cert, - Cache, CacheCb), - Suites = available_suites(Cert, UserSuites, Version), - case Resumed of - undefined -> - CipherSuite = select_cipher_suite(Hello#client_hello.cipher_suites, Suites), - Compressions = Hello#client_hello.compression_methods, - Compression = select_compression(Compressions), - {new, Session#session{session_id = SessionId, - cipher_suite = CipherSuite, - compression_method = Compression}}; - _ -> - {resumed, Resumed} - end. - -available_suites(UserSuites, Version) -> - case UserSuites of - [] -> - ssl_cipher:suites(Version); - _ -> - UserSuites - end. - -available_suites(ServerCert, UserSuites, Version) -> - ssl_cipher:filter(ServerCert, available_suites(UserSuites, Version)). - -cipher_suites(Suites, false) -> - [?TLS_EMPTY_RENEGOTIATION_INFO_SCSV | Suites]; -cipher_suites(Suites, true) -> - Suites. - -srp_user(#ssl_options{srp_identity = {UserName, _}}) -> - #srp{username = UserName}; -srp_user(_) -> - undefined. - -renegotiation_info(client, _, false) -> - #renegotiation_info{renegotiated_connection = undefined}; -renegotiation_info(server, ConnectionStates, false) -> - CS = tls_record:current_connection_state(ConnectionStates, read), - case CS#connection_state.secure_renegotiation of - true -> - #renegotiation_info{renegotiated_connection = ?byte(0)}; - false -> - #renegotiation_info{renegotiated_connection = undefined} - end; -renegotiation_info(client, ConnectionStates, true) -> - CS = tls_record:current_connection_state(ConnectionStates, read), - case CS#connection_state.secure_renegotiation of - true -> - Data = CS#connection_state.client_verify_data, - #renegotiation_info{renegotiated_connection = Data}; - false -> - #renegotiation_info{renegotiated_connection = undefined} - end; - -renegotiation_info(server, ConnectionStates, true) -> - CS = tls_record:current_connection_state(ConnectionStates, read), - case CS#connection_state.secure_renegotiation of - true -> - CData = CS#connection_state.client_verify_data, - SData =CS#connection_state.server_verify_data, - #renegotiation_info{renegotiated_connection = <<CData/binary, SData/binary>>}; - false -> - #renegotiation_info{renegotiated_connection = undefined} - end. - -decode_next_protocols({next_protocol_negotiation, Protocols}) -> - decode_next_protocols(Protocols, []). -decode_next_protocols(<<>>, Acc) -> - lists:reverse(Acc); -decode_next_protocols(<<?BYTE(Len), Protocol:Len/binary, Rest/binary>>, Acc) -> - case Len of - 0 -> - {error, invalid_next_protocols}; - _ -> - decode_next_protocols(Rest, [Protocol|Acc]) - end; -decode_next_protocols(_Bytes, _Acc) -> - {error, invalid_next_protocols}. - -next_protocol_extension_allowed(NextProtocolSelector, Renegotiating) -> - NextProtocolSelector =/= undefined andalso not Renegotiating. - -handle_next_protocol_on_server(#client_hello{next_protocol_negotiation = undefined}, _Renegotiation, _SslOpts) -> - undefined; - -handle_next_protocol_on_server(#client_hello{next_protocol_negotiation = {next_protocol_negotiation, <<>>}}, - false, #ssl_options{next_protocols_advertised = Protocols}) -> - Protocols; - -handle_next_protocol_on_server(_Hello, _Renegotiation, _SSLOpts) -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE). % unexpected next protocol extension - -handle_next_protocol(#server_hello{next_protocol_negotiation = undefined}, - _NextProtocolSelector, _Renegotiating) -> - undefined; - -handle_next_protocol(#server_hello{next_protocol_negotiation = Protocols}, - NextProtocolSelector, Renegotiating) -> - - case next_protocol_extension_allowed(NextProtocolSelector, Renegotiating) of - true -> - select_next_protocol(decode_next_protocols(Protocols), NextProtocolSelector); - false -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) % unexpected next protocol extension - end. - -select_next_protocol({error, _Reason}, _NextProtocolSelector) -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); -select_next_protocol(Protocols, NextProtocolSelector) -> - case NextProtocolSelector(Protocols) of - ?NO_PROTOCOL -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); - Protocol when is_binary(Protocol) -> - Protocol - end. - -default_ecc_extensions(Version) -> - CryptoSupport = proplists:get_value(public_keys, crypto:supports()), - case proplists:get_bool(ecdh, CryptoSupport) of - true -> - EcPointFormats = #ec_point_formats{ec_point_format_list = [?ECPOINT_UNCOMPRESSED]}, - EllipticCurves = #elliptic_curves{elliptic_curve_list = ssl_tls1:ecc_curves(Version)}, - {EcPointFormats, EllipticCurves}; - _ -> - {undefined, undefined} - end. - -handle_ecc_extensions(Version, EcPointFormats0, EllipticCurves0) -> - CryptoSupport = proplists:get_value(public_keys, crypto:supports()), - case proplists:get_bool(ecdh, CryptoSupport) of - true -> - EcPointFormats1 = handle_ecc_point_fmt_extension(EcPointFormats0), - EllipticCurves1 = handle_ecc_curves_extension(Version, EllipticCurves0), - {EcPointFormats1, EllipticCurves1}; - _ -> - {undefined, undefined} - end. - -handle_ecc_point_fmt_extension(undefined) -> - undefined; -handle_ecc_point_fmt_extension(_) -> - #ec_point_formats{ec_point_format_list = [?ECPOINT_UNCOMPRESSED]}. - -handle_ecc_curves_extension(_Version, undefined) -> - undefined; -handle_ecc_curves_extension(Version, _) -> - #elliptic_curves{elliptic_curve_list = ssl_tls1:ecc_curves(Version)}. - -handle_renegotiation_info(_, #renegotiation_info{renegotiated_connection = ?byte(0)}, - ConnectionStates, false, _, _) -> - {ok, tls_record:set_renegotiation_flag(true, ConnectionStates)}; - -handle_renegotiation_info(server, undefined, ConnectionStates, _, _, CipherSuites) -> - case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of - true -> - {ok, tls_record:set_renegotiation_flag(true, ConnectionStates)}; - false -> - {ok, tls_record:set_renegotiation_flag(false, ConnectionStates)} - end; - -handle_renegotiation_info(_, undefined, ConnectionStates, false, _, _) -> - {ok, tls_record:set_renegotiation_flag(false, ConnectionStates)}; - -handle_renegotiation_info(client, #renegotiation_info{renegotiated_connection = ClientServerVerify}, - ConnectionStates, true, _, _) -> - CS = tls_record:current_connection_state(ConnectionStates, read), - CData = CS#connection_state.client_verify_data, - SData = CS#connection_state.server_verify_data, - case <<CData/binary, SData/binary>> == ClientServerVerify of - true -> - {ok, ConnectionStates}; - false -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) - end; -handle_renegotiation_info(server, #renegotiation_info{renegotiated_connection = ClientVerify}, - ConnectionStates, true, _, CipherSuites) -> - - case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of - true -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); - false -> - CS = tls_record:current_connection_state(ConnectionStates, read), - Data = CS#connection_state.client_verify_data, - case Data == ClientVerify of - true -> - {ok, ConnectionStates}; - false -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) - end - end; - -handle_renegotiation_info(client, undefined, ConnectionStates, true, SecureRenegotation, _) -> - handle_renegotiation_info(ConnectionStates, SecureRenegotation); - -handle_renegotiation_info(server, undefined, ConnectionStates, true, SecureRenegotation, CipherSuites) -> - case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of - true -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); - false -> - handle_renegotiation_info(ConnectionStates, SecureRenegotation) - end. - -handle_renegotiation_info(ConnectionStates, SecureRenegotation) -> - CS = tls_record:current_connection_state(ConnectionStates, read), - case {SecureRenegotation, CS#connection_state.secure_renegotiation} of - {_, true} -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); - {true, false} -> - ?ALERT_REC(?FATAL, ?NO_RENEGOTIATION); - {false, false} -> - {ok, ConnectionStates} - end. - -%% Update pending connection states with parameters exchanged via -%% hello messages -%% NOTE : Role is the role of the receiver of the hello message -%% currently being processed. -hello_pending_connection_states(Role, Version, CipherSuite, Random, Compression, - ConnectionStates) -> - ReadState = - tls_record:pending_connection_state(ConnectionStates, read), - WriteState = - tls_record:pending_connection_state(ConnectionStates, write), - - NewReadSecParams = - hello_security_parameters(Role, Version, ReadState, CipherSuite, - Random, Compression), - - NewWriteSecParams = - hello_security_parameters(Role, Version, WriteState, CipherSuite, - Random, Compression), - - tls_record:update_security_params(NewReadSecParams, - NewWriteSecParams, - ConnectionStates). - -hello_security_parameters(client, Version, ConnectionState, CipherSuite, Random, - Compression) -> - SecParams = ConnectionState#connection_state.security_parameters, - NewSecParams = ssl_cipher:security_parameters(Version, CipherSuite, SecParams), - NewSecParams#security_parameters{ - server_random = Random, - compression_algorithm = Compression - }; - -hello_security_parameters(server, Version, ConnectionState, CipherSuite, Random, - Compression) -> - SecParams = ConnectionState#connection_state.security_parameters, - NewSecParams = ssl_cipher:security_parameters(Version, CipherSuite, SecParams), - NewSecParams#security_parameters{ - client_random = Random, - compression_algorithm = Compression - }. - -select_version(ClientVersion, Versions) -> - ServerVersion = tls_record:highest_protocol_version(Versions), - tls_record:lowest_protocol_version(ClientVersion, ServerVersion). - -select_cipher_suite([], _) -> - no_suite; -select_cipher_suite([Suite | ClientSuites], SupportedSuites) -> - case is_member(Suite, SupportedSuites) of - true -> - Suite; - false -> - select_cipher_suite(ClientSuites, SupportedSuites) - end. - -is_member(Suite, SupportedSuites) -> - lists:member(Suite, SupportedSuites). - -select_compression(_CompressionMetodes) -> - ?NULL. - -master_secret(Version, MasterSecret, #security_parameters{ - client_random = ClientRandom, - server_random = ServerRandom, - hash_size = HashSize, - prf_algorithm = PrfAlgo, - key_material_length = KML, - expanded_key_material_length = EKML, - iv_size = IVS}, - ConnectionStates, Role) -> - {ClientWriteMacSecret, ServerWriteMacSecret, ClientWriteKey, - ServerWriteKey, ClientIV, ServerIV} = - setup_keys(Version, PrfAlgo, MasterSecret, ServerRandom, - ClientRandom, HashSize, KML, EKML, IVS), - - ConnStates1 = tls_record:set_master_secret(MasterSecret, ConnectionStates), - ConnStates2 = - tls_record:set_mac_secret(ClientWriteMacSecret, ServerWriteMacSecret, - Role, ConnStates1), - - ClientCipherState = #cipher_state{iv = ClientIV, key = ClientWriteKey}, - ServerCipherState = #cipher_state{iv = ServerIV, key = ServerWriteKey}, - {MasterSecret, - tls_record:set_pending_cipher_state(ConnStates2, ClientCipherState, - ServerCipherState, Role)}. - - -dec_hs(_, ?NEXT_PROTOCOL, <<?BYTE(SelectedProtocolLength), SelectedProtocol:SelectedProtocolLength/binary, - ?BYTE(PaddingLength), _Padding:PaddingLength/binary>>) -> - #next_protocol{selected_protocol = SelectedProtocol}; +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- -dec_hs(_, ?HELLO_REQUEST, <<>>) -> +decode_handshake(_, ?HELLO_REQUEST, <<>>) -> #hello_request{}; %% Client hello v2. %% The server must be able to receive such messages, from clients that %% are willing to use ssl v3 or higher, but have ssl v2 compatibility. -dec_hs(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), +decode_handshake(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), ?UINT16(CSLength), ?UINT16(0), ?UINT16(CDLength), CipherSuites:CSLength/binary, ChallengeData:CDLength/binary>>) -> #client_hello{client_version = {Major, Minor}, - random = ssl_ssl2:client_random(ChallengeData, CDLength), + random = ssl_v2:client_random(ChallengeData, CDLength), session_id = 0, - cipher_suites = from_3bytes(CipherSuites), + cipher_suites = ssl_handshake:decode_suites('3_bytes', CipherSuites), compression_methods = [?NULL], - renegotiation_info = undefined + extensions = #hello_extensions{} }; -dec_hs(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, +decode_handshake(_Version, ?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>>) -> - DecodedExtensions = dec_hello_extensions(Extensions), - RenegotiationInfo = proplists:get_value(renegotiation_info, DecodedExtensions, undefined), - SRP = proplists:get_value(srp, DecodedExtensions, undefined), - HashSigns = proplists:get_value(hash_signs, DecodedExtensions, undefined), - EllipticCurves = proplists:get_value(elliptic_curves, DecodedExtensions, - undefined), - NextProtocolNegotiation = proplists:get_value(next_protocol_negotiation, DecodedExtensions, undefined), + DecodedExtensions = ssl_handshake:decode_hello_extensions({client, Extensions}), #client_hello{ client_version = {Major,Minor}, random = Random, session_id = Session_ID, - cipher_suites = from_2bytes(CipherSuites), + cipher_suites = ssl_handshake:decode_suites('2_bytes', CipherSuites), compression_methods = Comp_methods, - renegotiation_info = RenegotiationInfo, - srp = SRP, - hash_signs = HashSigns, - elliptic_curves = EllipticCurves, - next_protocol_negotiation = NextProtocolNegotiation + extensions = DecodedExtensions }; -dec_hs(_Version, ?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, - ?BYTE(SID_length), Session_ID:SID_length/binary, - Cipher_suite:2/binary, ?BYTE(Comp_method)>>) -> - #server_hello{ - server_version = {Major,Minor}, - random = Random, - session_id = Session_ID, - cipher_suite = Cipher_suite, - compression_method = Comp_method, - renegotiation_info = undefined, - hash_signs = undefined, - elliptic_curves = undefined}; - -dec_hs(_Version, ?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>>) -> - - HelloExtensions = dec_hello_extensions(Extensions, []), - RenegotiationInfo = proplists:get_value(renegotiation_info, HelloExtensions, - undefined), - HashSigns = proplists:get_value(hash_signs, HelloExtensions, - undefined), - EllipticCurves = proplists:get_value(elliptic_curves, HelloExtensions, - undefined), - NextProtocolNegotiation = proplists:get_value(next_protocol_negotiation, HelloExtensions, undefined), - - #server_hello{ - server_version = {Major,Minor}, - random = Random, - session_id = Session_ID, - cipher_suite = Cipher_suite, - compression_method = Comp_method, - renegotiation_info = RenegotiationInfo, - hash_signs = HashSigns, - elliptic_curves = EllipticCurves, - next_protocol_negotiation = NextProtocolNegotiation}; -dec_hs(_Version, ?CERTIFICATE, <<?UINT24(ACLen), ASN1Certs:ACLen/binary>>) -> - #certificate{asn1_certificates = certs_to_list(ASN1Certs)}; -dec_hs(_Version, ?SERVER_KEY_EXCHANGE, Keys) -> - #server_key_exchange{exchange_keys = Keys}; -dec_hs({Major, Minor}, ?CERTIFICATE_REQUEST, - <<?BYTE(CertTypesLen), CertTypes:CertTypesLen/binary, - ?UINT16(HashSignsLen), HashSigns:HashSignsLen/binary, - ?UINT16(CertAuthsLen), CertAuths:CertAuthsLen/binary>>) - when Major == 3, Minor >= 3 -> - HashSignAlgos = [{ssl_cipher:hash_algorithm(Hash), ssl_cipher:sign_algorithm(Sign)} || - <<?BYTE(Hash), ?BYTE(Sign)>> <= HashSigns], - #certificate_request{certificate_types = CertTypes, - hashsign_algorithms = #hash_sign_algos{hash_sign_algos = HashSignAlgos}, - certificate_authorities = CertAuths}; -dec_hs(_Version, ?CERTIFICATE_REQUEST, - <<?BYTE(CertTypesLen), CertTypes:CertTypesLen/binary, - ?UINT16(CertAuthsLen), CertAuths:CertAuthsLen/binary>>) -> - #certificate_request{certificate_types = CertTypes, - certificate_authorities = CertAuths}; -dec_hs(_Version, ?SERVER_HELLO_DONE, <<>>) -> - #server_hello_done{}; -dec_hs({Major, Minor}, ?CERTIFICATE_VERIFY,<<HashSign:2/binary, ?UINT16(SignLen), Signature:SignLen/binary>>) - when Major == 3, Minor >= 3 -> - #certificate_verify{hashsign_algorithm = hashsign_dec(HashSign), signature = Signature}; -dec_hs(_Version, ?CERTIFICATE_VERIFY,<<?UINT16(SignLen), Signature:SignLen/binary>>)-> - #certificate_verify{signature = Signature}; -dec_hs(_Version, ?CLIENT_KEY_EXCHANGE, PKEPMS) -> - #client_key_exchange{exchange_keys = PKEPMS}; -dec_hs(_Version, ?FINISHED, VerifyData) -> - #finished{verify_data = VerifyData}; -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_client_key(<<>>, ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN, _) -> - throw(?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE)); -dec_client_key(<<?BYTE(DH_YLen), DH_Y:DH_YLen/binary>>, - ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN, _) -> - #client_ec_diffie_hellman_public{dh_public = DH_Y}; -dec_client_key(<<?UINT16(Len), Id:Len/binary>>, - ?KEY_EXCHANGE_PSK, _) -> - #client_psk_identity{identity = Id}; -dec_client_key(<<?UINT16(Len), Id:Len/binary, - ?UINT16(DH_YLen), DH_Y:DH_YLen/binary>>, - ?KEY_EXCHANGE_DHE_PSK, _) -> - #client_dhe_psk_identity{identity = Id, dh_public = DH_Y}; -dec_client_key(<<?UINT16(Len), Id:Len/binary, PKEPMS/binary>>, - ?KEY_EXCHANGE_RSA_PSK, {3, 0}) -> - #client_rsa_psk_identity{identity = Id, exchange_keys = #encrypted_premaster_secret{premaster_secret = PKEPMS}}; -dec_client_key(<<?UINT16(Len), Id:Len/binary, ?UINT16(_), PKEPMS/binary>>, - ?KEY_EXCHANGE_RSA_PSK, _) -> - #client_rsa_psk_identity{identity = Id, exchange_keys = #encrypted_premaster_secret{premaster_secret = PKEPMS}}; -dec_client_key(<<?UINT16(ALen), A:ALen/binary>>, - ?KEY_EXCHANGE_SRP, _) -> - #client_srp_public{srp_a = A}. - -dec_ske_params(Len, Keys, Version) -> - <<Params:Len/bytes, Signature/binary>> = Keys, - dec_ske_signature(Params, Signature, Version). - -dec_ske_signature(Params, <<?BYTE(HashAlgo), ?BYTE(SignAlgo), - ?UINT16(0)>>, {Major, Minor}) - when Major == 3, Minor >= 3 -> - HashSign = {ssl_cipher:hash_algorithm(HashAlgo), ssl_cipher:sign_algorithm(SignAlgo)}, - {Params, HashSign, <<>>}; -dec_ske_signature(Params, <<?BYTE(HashAlgo), ?BYTE(SignAlgo), - ?UINT16(Len), Signature:Len/binary>>, {Major, Minor}) - when Major == 3, Minor >= 3 -> - HashSign = {ssl_cipher:hash_algorithm(HashAlgo), ssl_cipher:sign_algorithm(SignAlgo)}, - {Params, HashSign, Signature}; -dec_ske_signature(Params, <<>>, _) -> - {Params, {null, anon}, <<>>}; -dec_ske_signature(Params, <<?UINT16(0)>>, _) -> - {Params, {null, anon}, <<>>}; -dec_ske_signature(Params, <<?UINT16(Len), Signature:Len/binary>>, _) -> - {Params, undefined, Signature}; -dec_ske_signature(_, _, _) -> - throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE)). - -dec_server_key(<<?UINT16(PLen), P:PLen/binary, - ?UINT16(GLen), G:GLen/binary, - ?UINT16(YLen), Y:YLen/binary, _/binary>> = KeyStruct, - ?KEY_EXCHANGE_DIFFIE_HELLMAN, Version) -> - Params = #server_dh_params{dh_p = P, dh_g = G, dh_y = Y}, - {BinMsg, HashSign, Signature} = dec_ske_params(PLen + GLen + YLen + 6, KeyStruct, Version), - #server_key_params{params = Params, - params_bin = BinMsg, - hashsign = HashSign, - signature = Signature}; -%% ECParameters with named_curve -%% TODO: explicit curve -dec_server_key(<<?BYTE(?NAMED_CURVE), ?UINT16(CurveID), - ?BYTE(PointLen), ECPoint:PointLen/binary, - _/binary>> = KeyStruct, - ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN, Version) -> - Params = #server_ecdh_params{curve = {namedCurve, ssl_tls1:enum_to_oid(CurveID)}, - public = ECPoint}, - {BinMsg, HashSign, Signature} = dec_ske_params(PointLen + 4, KeyStruct, Version), - #server_key_params{params = Params, - params_bin = BinMsg, - hashsign = HashSign, - signature = Signature}; -dec_server_key(<<?UINT16(Len), PskIdentityHint:Len/binary>> = KeyStruct, - KeyExchange, Version) - when KeyExchange == ?KEY_EXCHANGE_PSK; KeyExchange == ?KEY_EXCHANGE_RSA_PSK -> - Params = #server_psk_params{ - hint = PskIdentityHint}, - {BinMsg, HashSign, Signature} = dec_ske_params(Len + 2, KeyStruct, Version), - #server_key_params{params = Params, - params_bin = BinMsg, - hashsign = HashSign, - signature = Signature}; -dec_server_key(<<?UINT16(Len), IdentityHint:Len/binary, - ?UINT16(PLen), P:PLen/binary, - ?UINT16(GLen), G:GLen/binary, - ?UINT16(YLen), Y:YLen/binary, _/binary>> = KeyStruct, - ?KEY_EXCHANGE_DHE_PSK, Version) -> - DHParams = #server_dh_params{dh_p = P, dh_g = G, dh_y = Y}, - Params = #server_dhe_psk_params{ - hint = IdentityHint, - dh_params = DHParams}, - {BinMsg, HashSign, Signature} = dec_ske_params(Len + PLen + GLen + YLen + 8, KeyStruct, Version), - #server_key_params{params = Params, - params_bin = BinMsg, - hashsign = HashSign, - signature = Signature}; -dec_server_key(<<?UINT16(NLen), N:NLen/binary, - ?UINT16(GLen), G:GLen/binary, - ?BYTE(SLen), S:SLen/binary, - ?UINT16(BLen), B:BLen/binary, _/binary>> = KeyStruct, - ?KEY_EXCHANGE_SRP, Version) -> - Params = #server_srp_params{srp_n = N, srp_g = G, srp_s = S, srp_b = B}, - {BinMsg, HashSign, Signature} = dec_ske_params(NLen + GLen + SLen + BLen + 7, KeyStruct, Version), - #server_key_params{params = Params, - params_bin = BinMsg, - hashsign = HashSign, - signature = Signature}; -dec_server_key(_, _, _) -> - throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE)). - -dec_hello_extensions(<<>>) -> - []; -dec_hello_extensions(<<?UINT16(ExtLen), Extensions:ExtLen/binary>>) -> - dec_hello_extensions(Extensions, []); -dec_hello_extensions(_) -> - []. - -dec_hello_extensions(<<>>, Acc) -> - Acc; -dec_hello_extensions(<<?UINT16(?NEXTPROTONEG_EXT), ?UINT16(Len), ExtensionData:Len/binary, Rest/binary>>, Acc) -> - Prop = {next_protocol_negotiation, #next_protocol_negotiation{extension_data = ExtensionData}}, - dec_hello_extensions(Rest, [Prop | Acc]); -dec_hello_extensions(<<?UINT16(?RENEGOTIATION_EXT), ?UINT16(Len), Info:Len/binary, Rest/binary>>, Acc) -> - RenegotiateInfo = case Len of - 1 -> % Initial handshake - Info; % should be <<0>> will be matched in handle_renegotiation_info - _ -> - VerifyLen = Len - 1, - <<?BYTE(VerifyLen), VerifyInfo/binary>> = Info, - VerifyInfo - end, - dec_hello_extensions(Rest, [{renegotiation_info, - #renegotiation_info{renegotiated_connection = RenegotiateInfo}} | Acc]); +decode_handshake(Version, Tag, Msg) -> + ssl_handshake:decode_handshake(Version, Tag, Msg). -dec_hello_extensions(<<?UINT16(?SRP_EXT), ?UINT16(Len), ?BYTE(SRPLen), SRP:SRPLen/binary, Rest/binary>>, Acc) - when Len == SRPLen + 2 -> - dec_hello_extensions(Rest, [{srp, - #srp{username = SRP}} | Acc]); - -dec_hello_extensions(<<?UINT16(?SIGNATURE_ALGORITHMS_EXT), ?UINT16(Len), - ExtData:Len/binary, Rest/binary>>, Acc) -> - SignAlgoListLen = Len - 2, - <<?UINT16(SignAlgoListLen), SignAlgoList/binary>> = ExtData, - HashSignAlgos = [{ssl_cipher:hash_algorithm(Hash), ssl_cipher:sign_algorithm(Sign)} || - <<?BYTE(Hash), ?BYTE(Sign)>> <= SignAlgoList], - dec_hello_extensions(Rest, [{hash_signs, - #hash_sign_algos{hash_sign_algos = HashSignAlgos}} | Acc]); - -dec_hello_extensions(<<?UINT16(?ELLIPTIC_CURVES_EXT), ?UINT16(Len), - ExtData:Len/binary, Rest/binary>>, Acc) -> - EllipticCurveListLen = Len - 2, - <<?UINT16(EllipticCurveListLen), EllipticCurveList/binary>> = ExtData, - EllipticCurves = [ssl_tls1:enum_to_oid(X) || <<X:16>> <= EllipticCurveList], - dec_hello_extensions(Rest, [{elliptic_curves, - #elliptic_curves{elliptic_curve_list = EllipticCurves}} | Acc]); - -dec_hello_extensions(<<?UINT16(?EC_POINT_FORMATS_EXT), ?UINT16(Len), - ExtData:Len/binary, Rest/binary>>, Acc) -> - ECPointFormatListLen = Len - 1, - <<?BYTE(ECPointFormatListLen), ECPointFormatList/binary>> = ExtData, - ECPointFormats = binary_to_list(ECPointFormatList), - dec_hello_extensions(Rest, [{ec_point_formats, - #ec_point_formats{ec_point_format_list = ECPointFormats}} | Acc]); - -%% Ignore data following the ClientHello (i.e., -%% extensions) if not understood. - -dec_hello_extensions(<<?UINT16(_), ?UINT16(Len), _Unknown:Len/binary, Rest/binary>>, Acc) -> - dec_hello_extensions(Rest, Acc); -%% This theoretically should not happen if the protocol is followed, but if it does it is ignored. -dec_hello_extensions(_, Acc) -> - Acc. - -encrypted_premaster_secret(Secret, RSAPublicKey) -> - try - PreMasterSecret = public_key:encrypt_public(Secret, RSAPublicKey, - [{rsa_pad, - rsa_pkcs1_padding}]), - #encrypted_premaster_secret{premaster_secret = PreMasterSecret} - catch - _:_-> - throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE)) - end. - -%% encode/decode stream of certificate data to/from list of certificate data -certs_to_list(ASN1Certs) -> - certs_to_list(ASN1Certs, []). - -certs_to_list(<<?UINT24(CertLen), Cert:CertLen/binary, Rest/binary>>, Acc) -> - certs_to_list(Rest, [Cert | Acc]); -certs_to_list(<<>>, Acc) -> - lists:reverse(Acc, []). - -certs_from_list(ACList) -> - list_to_binary([begin - CertLen = byte_size(Cert), - <<?UINT24(CertLen), Cert/binary>> - end || Cert <- ACList]). - -enc_hs(#next_protocol{selected_protocol = SelectedProtocol}, _Version) -> - PaddingLength = 32 - ((byte_size(SelectedProtocol) + 2) rem 32), - - {?NEXT_PROTOCOL, <<?BYTE((byte_size(SelectedProtocol))), SelectedProtocol/binary, - ?BYTE(PaddingLength), 0:(PaddingLength * 8)>>}; -enc_hs(#hello_request{}, _Version) -> +enc_handshake(#hello_request{}, _Version) -> {?HELLO_REQUEST, <<>>}; -enc_hs(#client_hello{client_version = {Major, Minor}, +enc_handshake(#client_hello{client_version = {Major, Minor}, random = Random, session_id = SessionID, cipher_suites = CipherSuites, compression_methods = CompMethods, - renegotiation_info = RenegotiationInfo, - srp = SRP, - hash_signs = HashSigns, - ec_point_formats = EcPointFormats, - elliptic_curves = EllipticCurves, - next_protocol_negotiation = NextProtocolNegotiation}, _Version) -> + extensions = HelloExtensions}, _Version) -> SIDLength = byte_size(SessionID), BinCompMethods = list_to_binary(CompMethods), CmLength = byte_size(BinCompMethods), BinCipherSuites = list_to_binary(CipherSuites), CsLength = byte_size(BinCipherSuites), - Extensions0 = hello_extensions(RenegotiationInfo, SRP, NextProtocolNegotiation) - ++ ec_hello_extensions(lists:map(fun ssl_cipher:suite_definition/1, CipherSuites), EcPointFormats) - ++ ec_hello_extensions(lists:map(fun ssl_cipher:suite_definition/1, CipherSuites), EllipticCurves), - Extensions1 = if - Major == 3, Minor >=3 -> Extensions0 ++ hello_extensions(HashSigns); - true -> Extensions0 - end, - ExtensionsBin = enc_hello_extensions(Extensions1), - - {?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, - ?BYTE(SIDLength), SessionID/binary, - ?UINT16(CsLength), BinCipherSuites/binary, - ?BYTE(CmLength), BinCompMethods/binary, ExtensionsBin/binary>>}; - -enc_hs(#server_hello{server_version = {Major, Minor}, - random = Random, - session_id = Session_ID, - cipher_suite = CipherSuite, - compression_method = Comp_method, - renegotiation_info = RenegotiationInfo, - ec_point_formats = EcPointFormats, - elliptic_curves = EllipticCurves, - next_protocol_negotiation = NextProtocolNegotiation}, _Version) -> - SID_length = byte_size(Session_ID), - CipherSuites = [ssl_cipher:suite_definition(CipherSuite)], - Extensions = hello_extensions(RenegotiationInfo, NextProtocolNegotiation) - ++ ec_hello_extensions(CipherSuites, EcPointFormats) - ++ ec_hello_extensions(CipherSuites, EllipticCurves), - ExtensionsBin = enc_hello_extensions(Extensions), - {?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, - ?BYTE(SID_length), Session_ID/binary, - CipherSuite/binary, ?BYTE(Comp_method), ExtensionsBin/binary>>}; -enc_hs(#certificate{asn1_certificates = ASN1CertList}, _Version) -> - ASN1Certs = certs_from_list(ASN1CertList), - ACLen = erlang:iolist_size(ASN1Certs), - {?CERTIFICATE, <<?UINT24(ACLen), ASN1Certs:ACLen/binary>>}; -enc_hs(#server_key_exchange{exchange_keys = Keys}, _Version) -> - {?SERVER_KEY_EXCHANGE, Keys}; -enc_hs(#server_key_params{params_bin = Keys, hashsign = HashSign, - signature = Signature}, Version) -> - EncSign = enc_sign(HashSign, Signature, Version), - {?SERVER_KEY_EXCHANGE, <<Keys/binary, EncSign/binary>>}; -enc_hs(#certificate_request{certificate_types = CertTypes, - hashsign_algorithms = #hash_sign_algos{hash_sign_algos = HashSignAlgos}, - certificate_authorities = CertAuths}, - {Major, Minor}) - when Major == 3, Minor >= 3 -> - HashSigns= << <<(ssl_cipher:hash_algorithm(Hash)):8, (ssl_cipher:sign_algorithm(Sign)):8>> || - {Hash, Sign} <- HashSignAlgos >>, - CertTypesLen = byte_size(CertTypes), - HashSignsLen = byte_size(HashSigns), - CertAuthsLen = byte_size(CertAuths), - {?CERTIFICATE_REQUEST, - <<?BYTE(CertTypesLen), CertTypes/binary, - ?UINT16(HashSignsLen), HashSigns/binary, - ?UINT16(CertAuthsLen), CertAuths/binary>> - }; -enc_hs(#certificate_request{certificate_types = CertTypes, - certificate_authorities = CertAuths}, - _Version) -> - CertTypesLen = byte_size(CertTypes), - CertAuthsLen = byte_size(CertAuths), - {?CERTIFICATE_REQUEST, - <<?BYTE(CertTypesLen), CertTypes/binary, - ?UINT16(CertAuthsLen), CertAuths/binary>> - }; -enc_hs(#server_hello_done{}, _Version) -> - {?SERVER_HELLO_DONE, <<>>}; -enc_hs(#client_key_exchange{exchange_keys = ExchangeKeys}, Version) -> - {?CLIENT_KEY_EXCHANGE, enc_cke(ExchangeKeys, Version)}; -enc_hs(#certificate_verify{signature = BinSig, hashsign_algorithm = HashSign}, Version) -> - EncSig = enc_sign(HashSign, BinSig, Version), - {?CERTIFICATE_VERIFY, EncSig}; -enc_hs(#finished{verify_data = VerifyData}, _Version) -> - {?FINISHED, VerifyData}. - -enc_cke(#encrypted_premaster_secret{premaster_secret = PKEPMS},{3, 0}) -> - PKEPMS; -enc_cke(#encrypted_premaster_secret{premaster_secret = PKEPMS}, _) -> - PKEPMSLen = byte_size(PKEPMS), - <<?UINT16(PKEPMSLen), PKEPMS/binary>>; -enc_cke(#client_diffie_hellman_public{dh_public = DHPublic}, _) -> - Len = byte_size(DHPublic), - <<?UINT16(Len), DHPublic/binary>>; -enc_cke(#client_ec_diffie_hellman_public{dh_public = DHPublic}, _) -> - Len = byte_size(DHPublic), - <<?BYTE(Len), DHPublic/binary>>; -enc_cke(#client_psk_identity{identity = undefined}, _) -> - Id = <<"psk_identity">>, - Len = byte_size(Id), - <<?UINT16(Len), Id/binary>>; -enc_cke(#client_psk_identity{identity = Id}, _) -> - Len = byte_size(Id), - <<?UINT16(Len), Id/binary>>; -enc_cke(Identity = #client_dhe_psk_identity{identity = undefined}, Version) -> - enc_cke(Identity#client_dhe_psk_identity{identity = <<"psk_identity">>}, Version); -enc_cke(#client_dhe_psk_identity{identity = Id, dh_public = DHPublic}, _) -> - Len = byte_size(Id), - DHLen = byte_size(DHPublic), - <<?UINT16(Len), Id/binary, ?UINT16(DHLen), DHPublic/binary>>; -enc_cke(Identity = #client_rsa_psk_identity{identity = undefined}, Version) -> - enc_cke(Identity#client_rsa_psk_identity{identity = <<"psk_identity">>}, Version); -enc_cke(#client_rsa_psk_identity{identity = Id, exchange_keys = ExchangeKeys}, Version) -> - EncPMS = enc_cke(ExchangeKeys, Version), - Len = byte_size(Id), - <<?UINT16(Len), Id/binary, EncPMS/binary>>; -enc_cke(#client_srp_public{srp_a = A}, _) -> - Len = byte_size(A), - <<?UINT16(Len), A/binary>>. - -enc_server_key(#server_dh_params{dh_p = P, dh_g = G, dh_y = Y}) -> - PLen = byte_size(P), - GLen = byte_size(G), - YLen = byte_size(Y), - <<?UINT16(PLen), P/binary, ?UINT16(GLen), G/binary, ?UINT16(YLen), Y/binary>>; -enc_server_key(#server_ecdh_params{curve = {namedCurve, ECCurve}, public = ECPubKey}) -> - %%TODO: support arbitrary keys - KLen = size(ECPubKey), - <<?BYTE(?NAMED_CURVE_TYPE), ?UINT16((ssl_tls1:oid_to_enum(ECCurve))), - ?BYTE(KLen), ECPubKey/binary>>; -enc_server_key(#server_psk_params{hint = PskIdentityHint}) -> - Len = byte_size(PskIdentityHint), - <<?UINT16(Len), PskIdentityHint/binary>>; -enc_server_key(Params = #server_dhe_psk_params{hint = undefined}) -> - enc_server_key(Params#server_dhe_psk_params{hint = <<>>}); -enc_server_key(#server_dhe_psk_params{ - hint = PskIdentityHint, - dh_params = #server_dh_params{dh_p = P, dh_g = G, dh_y = Y}}) -> - Len = byte_size(PskIdentityHint), - PLen = byte_size(P), - GLen = byte_size(G), - YLen = byte_size(Y), - <<?UINT16(Len), PskIdentityHint/binary, - ?UINT16(PLen), P/binary, ?UINT16(GLen), G/binary, ?UINT16(YLen), Y/binary>>; -enc_server_key(#server_srp_params{srp_n = N, srp_g = G, srp_s = S, srp_b = B}) -> - NLen = byte_size(N), - GLen = byte_size(G), - SLen = byte_size(S), - BLen = byte_size(B), - <<?UINT16(NLen), N/binary, ?UINT16(GLen), G/binary, - ?BYTE(SLen), S/binary, ?UINT16(BLen), B/binary>>. - -enc_sign({_, anon}, _Sign, _Version) -> - <<>>; -enc_sign({HashAlg, SignAlg}, Signature, _Version = {Major, Minor}) - when Major == 3, Minor >= 3-> - SignLen = byte_size(Signature), - HashSign = hashsign_enc(HashAlg, SignAlg), - <<HashSign/binary, ?UINT16(SignLen), Signature/binary>>; -enc_sign(_HashSign, Sign, _Version) -> - SignLen = byte_size(Sign), - <<?UINT16(SignLen), Sign/binary>>. - - -ec_hello_extensions(CipherSuites, #elliptic_curves{} = Info) -> - case advertises_ec_ciphers(CipherSuites) of - true -> - [Info]; - false -> - [] - end; -ec_hello_extensions(CipherSuites, #ec_point_formats{} = Info) -> - case advertises_ec_ciphers(CipherSuites) of - true -> - [Info]; - false -> - [] - end; -ec_hello_extensions(_, undefined) -> - []. - -hello_extensions(RenegotiationInfo, NextProtocolNegotiation) -> - hello_extensions(RenegotiationInfo) ++ next_protocol_extension(NextProtocolNegotiation). - -hello_extensions(RenegotiationInfo, SRP, NextProtocolNegotiation) -> - hello_extensions(RenegotiationInfo) - ++ hello_extensions(SRP) - ++ next_protocol_extension(NextProtocolNegotiation). - -advertises_ec_ciphers([]) -> - false; -advertises_ec_ciphers([{ecdh_ecdsa, _,_,_} | _]) -> - true; -advertises_ec_ciphers([{ecdhe_ecdsa, _,_,_} | _]) -> - true; -advertises_ec_ciphers([{ecdh_rsa, _,_,_} | _]) -> - true; -advertises_ec_ciphers([{ecdhe_rsa, _,_,_} | _]) -> - true; -advertises_ec_ciphers([{ecdh_anon, _,_,_} | _]) -> - true; -advertises_ec_ciphers([_| Rest]) -> - advertises_ec_ciphers(Rest). - -%% Renegotiation info -hello_extensions(#renegotiation_info{renegotiated_connection = undefined}) -> - []; -hello_extensions(#renegotiation_info{} = Info) -> - [Info]; -hello_extensions(#srp{} = Info) -> - [Info]; -hello_extensions(#hash_sign_algos{} = Info) -> - [Info]; -hello_extensions(undefined) -> - []. + ExtensionsBin = ssl_handshake:encode_hello_extensions(HelloExtensions), -next_protocol_extension(undefined) -> - []; -next_protocol_extension(#next_protocol_negotiation{} = Info) -> - [Info]. + {?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, + ?BYTE(SIDLength), SessionID/binary, + ?UINT16(CsLength), BinCipherSuites/binary, + ?BYTE(CmLength), BinCompMethods/binary, ExtensionsBin/binary>>}; -enc_hello_extensions(Extensions) -> - enc_hello_extensions(Extensions, <<>>). -enc_hello_extensions([], <<>>) -> - <<>>; -enc_hello_extensions([], Acc) -> - Size = byte_size(Acc), - <<?UINT16(Size), Acc/binary>>; +enc_handshake(HandshakeMsg, Version) -> + ssl_handshake:encode_handshake(HandshakeMsg, Version). -enc_hello_extensions([#next_protocol_negotiation{extension_data = ExtensionData} | Rest], Acc) -> - Len = byte_size(ExtensionData), - enc_hello_extensions(Rest, <<?UINT16(?NEXTPROTONEG_EXT), ?UINT16(Len), ExtensionData/binary, Acc/binary>>); -enc_hello_extensions([#renegotiation_info{renegotiated_connection = ?byte(0) = Info} | Rest], Acc) -> - Len = byte_size(Info), - enc_hello_extensions(Rest, <<?UINT16(?RENEGOTIATION_EXT), ?UINT16(Len), Info/binary, Acc/binary>>); -enc_hello_extensions([#renegotiation_info{renegotiated_connection = Info} | Rest], Acc) -> - InfoLen = byte_size(Info), - Len = InfoLen +1, - enc_hello_extensions(Rest, <<?UINT16(?RENEGOTIATION_EXT), ?UINT16(Len), ?BYTE(InfoLen), Info/binary, Acc/binary>>); -enc_hello_extensions([#elliptic_curves{elliptic_curve_list = EllipticCurves} | Rest], Acc) -> - EllipticCurveList = << <<(ssl_tls1:oid_to_enum(X)):16>> || X <- EllipticCurves>>, - ListLen = byte_size(EllipticCurveList), - Len = ListLen + 2, - enc_hello_extensions(Rest, <<?UINT16(?ELLIPTIC_CURVES_EXT), - ?UINT16(Len), ?UINT16(ListLen), EllipticCurveList/binary, Acc/binary>>); -enc_hello_extensions([#ec_point_formats{ec_point_format_list = ECPointFormats} | Rest], Acc) -> - ECPointFormatList = list_to_binary(ECPointFormats), - ListLen = byte_size(ECPointFormatList), - Len = ListLen + 1, - enc_hello_extensions(Rest, <<?UINT16(?EC_POINT_FORMATS_EXT), - ?UINT16(Len), ?BYTE(ListLen), ECPointFormatList/binary, Acc/binary>>); -enc_hello_extensions([#srp{username = UserName} | Rest], Acc) -> - SRPLen = byte_size(UserName), - Len = SRPLen + 2, - enc_hello_extensions(Rest, <<?UINT16(?SRP_EXT), ?UINT16(Len), ?BYTE(SRPLen), UserName/binary, Acc/binary>>); -enc_hello_extensions([#hash_sign_algos{hash_sign_algos = HashSignAlgos} | Rest], Acc) -> - SignAlgoList = << <<(ssl_cipher:hash_algorithm(Hash)):8, (ssl_cipher:sign_algorithm(Sign)):8>> || - {Hash, Sign} <- HashSignAlgos >>, - ListLen = byte_size(SignAlgoList), - Len = ListLen + 2, - enc_hello_extensions(Rest, <<?UINT16(?SIGNATURE_ALGORITHMS_EXT), - ?UINT16(Len), ?UINT16(ListLen), SignAlgoList/binary, Acc/binary>>). - -encode_client_protocol_negotiation(undefined, _) -> - undefined; -encode_client_protocol_negotiation(_, false) -> - #next_protocol_negotiation{extension_data = <<>>}; -encode_client_protocol_negotiation(_, _) -> - undefined. - -from_3bytes(Bin3) -> - from_3bytes(Bin3, []). - -from_3bytes(<<>>, Acc) -> - lists:reverse(Acc); -from_3bytes(<<?UINT24(N), Rest/binary>>, Acc) -> - from_3bytes(Rest, [?uint16(N) | Acc]). - -from_2bytes(Bin2) -> - from_2bytes(Bin2, []). - -from_2bytes(<<>>, Acc) -> - lists:reverse(Acc); -from_2bytes(<<?UINT16(N), Rest/binary>>, Acc) -> - from_2bytes(Rest, [?uint16(N) | Acc]). - -certificate_types({KeyExchange, _, _, _}) - when KeyExchange == rsa; - KeyExchange == dhe_dss; - KeyExchange == dhe_rsa; - KeyExchange == ecdhe_rsa -> - <<?BYTE(?RSA_SIGN), ?BYTE(?DSS_SIGN)>>; - -certificate_types({KeyExchange, _, _, _}) - when KeyExchange == dh_ecdsa; - KeyExchange == dhe_ecdsa -> - <<?BYTE(?ECDSA_SIGN)>>; - -certificate_types(_) -> - <<?BYTE(?RSA_SIGN)>>. - -hashsign_dec(<<?BYTE(HashAlgo), ?BYTE(SignAlgo)>>) -> - {ssl_cipher:hash_algorithm(HashAlgo), ssl_cipher:sign_algorithm(SignAlgo)}. - -hashsign_enc(HashAlgo, SignAlgo) -> - Hash = ssl_cipher:hash_algorithm(HashAlgo), - Sign = ssl_cipher:sign_algorithm(SignAlgo), - <<?BYTE(Hash), ?BYTE(Sign)>>. - -certificate_authorities(CertDbHandle, CertDbRef) -> - Authorities = certificate_authorities_from_db(CertDbHandle, CertDbRef), - Enc = fun(#'OTPCertificate'{tbsCertificate=TBSCert}) -> - OTPSubj = TBSCert#'OTPTBSCertificate'.subject, - DNEncodedBin = public_key:pkix_encode('Name', OTPSubj, otp), - DNEncodedLen = byte_size(DNEncodedBin), - <<?UINT16(DNEncodedLen), DNEncodedBin/binary>> - end, - list_to_binary([Enc(Cert) || {_, Cert} <- Authorities]). - -certificate_authorities_from_db(CertDbHandle, CertDbRef) -> - ConnectionCerts = fun({{Ref, _, _}, Cert}, Acc) when Ref == CertDbRef -> - [Cert | Acc]; - (_, Acc) -> - Acc - end, - ssl_pkix_db:foldl(ConnectionCerts, [], CertDbHandle). - - -digitally_signed({3, Minor}, Hash, HashAlgo, Key) when Minor >= 3 -> - public_key:sign({digest, Hash}, HashAlgo, Key); -digitally_signed(_Version, Hash, HashAlgo, #'DSAPrivateKey'{} = Key) -> - public_key:sign({digest, Hash}, HashAlgo, Key); -digitally_signed(_Version, Hash, _HashAlgo, #'RSAPrivateKey'{} = Key) -> - public_key:encrypt_private(Hash, Key, - [{rsa_pad, rsa_pkcs1_padding}]); -digitally_signed(_Version, Hash, HashAlgo, Key) -> - public_key:sign({digest, Hash}, HashAlgo, Key). - -calc_master_secret({3,0}, _PrfAlgo, PremasterSecret, ClientRandom, ServerRandom) -> - ssl_ssl3:master_secret(PremasterSecret, ClientRandom, ServerRandom); - -calc_master_secret({3,_}, PrfAlgo, PremasterSecret, ClientRandom, ServerRandom) -> - ssl_tls1:master_secret(PrfAlgo, PremasterSecret, ClientRandom, ServerRandom). - -setup_keys({3,0}, _PrfAlgo, MasterSecret, - ServerRandom, ClientRandom, HashSize, KML, EKML, IVS) -> - ssl_ssl3:setup_keys(MasterSecret, ServerRandom, - ClientRandom, HashSize, KML, EKML, IVS); - -setup_keys({3,N}, PrfAlgo, MasterSecret, - ServerRandom, ClientRandom, HashSize, KML, _EKML, IVS) -> - ssl_tls1:setup_keys(N, PrfAlgo, MasterSecret, ServerRandom, ClientRandom, HashSize, - KML, IVS). - -calc_finished({3, 0}, Role, _PrfAlgo, MasterSecret, Handshake) -> - ssl_ssl3:finished(Role, MasterSecret, lists:reverse(Handshake)); -calc_finished({3, N}, Role, PrfAlgo, MasterSecret, Handshake) -> - ssl_tls1:finished(Role, N, PrfAlgo, MasterSecret, lists:reverse(Handshake)). - -calc_certificate_verify({3, 0}, HashAlgo, MasterSecret, Handshake) -> - ssl_ssl3:certificate_verify(HashAlgo, MasterSecret, lists:reverse(Handshake)); -calc_certificate_verify({3, N}, HashAlgo, _MasterSecret, Handshake) -> - ssl_tls1:certificate_verify(HashAlgo, N, lists:reverse(Handshake)). - -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 -> - ?KEY_EXCHANGE_DIFFIE_HELLMAN; -key_exchange_alg(Alg) when Alg == ecdhe_rsa; Alg == ecdh_rsa; - Alg == ecdhe_ecdsa; Alg == ecdh_ecdsa; - Alg == ecdh_anon -> - ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN; -key_exchange_alg(psk) -> - ?KEY_EXCHANGE_PSK; -key_exchange_alg(dhe_psk) -> - ?KEY_EXCHANGE_DHE_PSK; -key_exchange_alg(rsa_psk) -> - ?KEY_EXCHANGE_RSA_PSK; -key_exchange_alg(Alg) - when Alg == srp_rsa; Alg == srp_dss; Alg == srp_anon -> - ?KEY_EXCHANGE_SRP; -key_exchange_alg(_) -> - ?NULL. - -apply_user_fun(Fun, OtpCert, ExtensionOrError, UserState0, SslState) -> - case Fun(OtpCert, ExtensionOrError, UserState0) of - {valid, UserState} -> - {valid, {SslState, UserState}}; - {fail, _} = Fail -> - Fail; - {unknown, UserState} -> - {unknown, {SslState, UserState}} +handle_hello_extensions(Version, Type, Random, HelloExt, SslOpts, Session0, ConnectionStates0, Renegotiation) -> + try ssl_handshake:handle_client_hello_extensions(tls_record, Random, HelloExt, Version, SslOpts, + Session0, ConnectionStates0, Renegotiation) of + {Session, ConnectionStates, ServerHelloExt} -> + {Version, {Type, Session}, ConnectionStates, ServerHelloExt} + catch throw:Alert -> + Alert end. --define(TLSEXT_SIGALG_RSA(MD), {MD, rsa}). --define(TLSEXT_SIGALG_DSA(MD), {MD, dsa}). --define(TLSEXT_SIGALG_ECDSA(MD), {MD, ecdsa}). - --define(TLSEXT_SIGALG(MD), ?TLSEXT_SIGALG_ECDSA(MD), ?TLSEXT_SIGALG_RSA(MD)). -default_hash_signs() -> - HashSigns = [?TLSEXT_SIGALG(sha512), - ?TLSEXT_SIGALG(sha384), - ?TLSEXT_SIGALG(sha256), - ?TLSEXT_SIGALG(sha224), - ?TLSEXT_SIGALG(sha), - ?TLSEXT_SIGALG_DSA(sha), - ?TLSEXT_SIGALG_RSA(md5)], - CryptoSupport = proplists:get_value(public_keys, crypto:supports()), - HasECC = proplists:get_bool(ecdsa, CryptoSupport), - #hash_sign_algos{hash_sign_algos = - lists:filter(fun({_, ecdsa}) -> HasECC; - (_) -> true end, HashSigns)}. - -handle_hello_extensions(#client_hello{random = Random, - cipher_suites = CipherSuites, - renegotiation_info = Info, - srp = SRP, - ec_point_formats = EcPointFormats0, - elliptic_curves = EllipticCurves0} = Hello, Version, - #ssl_options{secure_renegotiate = SecureRenegotation} = Opts, - Session0, ConnectionStates0, Renegotiation) -> - Session = handle_srp_extension(SRP, Session0), - ConnectionStates = handle_renegotiation_extension(Version, Info, Random, Session, ConnectionStates0, - Renegotiation, SecureRenegotation, CipherSuites), - ProtocolsToAdvertise = handle_next_protocol_extension(Hello, Renegotiation, Opts), - {EcPointFormats, EllipticCurves} = handle_ecc_extensions(Version, EcPointFormats0, EllipticCurves0), - %%TODO make extensions compund data structure - {Session, ConnectionStates, ProtocolsToAdvertise, EcPointFormats, EllipticCurves}. - - -handle_renegotiation_extension(Version, Info, Random, #session{cipher_suite = CipherSuite, - compression_method = Compression}, - ConnectionStates0, Renegotiation, SecureRenegotation, CipherSuites) -> - case handle_renegotiation_info(server, Info, ConnectionStates0, - Renegotiation, SecureRenegotation, - CipherSuites) of - {ok, ConnectionStates1} -> - hello_pending_connection_states(server, - Version, - CipherSuite, - Random, - Compression, - ConnectionStates1); +handle_hello_extensions(Version, SessionId, Random, CipherSuite, + Compression, HelloExt, SslOpt, ConnectionStates0, Renegotiation) -> + case ssl_handshake:handle_server_hello_extensions(tls_record, Random, CipherSuite, + Compression, HelloExt, Version, + SslOpt, ConnectionStates0, Renegotiation) of #alert{} = Alert -> - throw(Alert) + Alert; + {ConnectionStates, Protocol} -> + {Version, SessionId, ConnectionStates, Protocol} end. -handle_next_protocol_extension(Hello, Renegotiation, SslOpts)-> - case handle_next_protocol_on_server(Hello, Renegotiation, SslOpts) of - #alert{} = Alert -> - throw(Alert); - ProtocolsToAdvertise -> - ProtocolsToAdvertise - end. - -handle_srp_extension(undefined, Session) -> - Session; -handle_srp_extension(#srp{username = Username}, Session) -> - Session#session{srp_username = Username}. - -int_to_bin(I) -> - L = (length(integer_to_list(I, 16)) + 1) div 2, - <<I:(L*8)>>. diff --git a/lib/ssl/src/tls_handshake.hrl b/lib/ssl/src/tls_handshake.hrl index abf1b5abb6..dbe930cb90 100644 --- a/lib/ssl/src/tls_handshake.hrl +++ b/lib/ssl/src/tls_handshake.hrl @@ -34,12 +34,9 @@ cipher_suites, % cipher_suites<2..2^16-1> compression_methods, % compression_methods<1..2^8-1>, %% Extensions - renegotiation_info, - hash_signs, % supported combinations of hashes/signature algos - next_protocol_negotiation = undefined, % [binary()] - srp, - ec_point_formats, - elliptic_curves + extensions }). +-type tls_handshake() :: #client_hello{} | ssl_handshake(). + -endif. % -ifdef(tls_handshake). diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl index 1409a04763..54cf8d0b80 100644 --- a/lib/ssl/src/tls_record.erl +++ b/lib/ssl/src/tls_record.erl @@ -19,8 +19,7 @@ %% %%---------------------------------------------------------------------- -%% Purpose: Help functions for handling the SSL-Record protocol -%% +%% Purpose: Handle TLS/SSL record protocol. (Parts that are not shared with DTLS) %%---------------------------------------------------------------------- -module(tls_record). @@ -31,282 +30,27 @@ -include("tls_handshake.hrl"). -include("ssl_cipher.hrl"). -%% Connection state handling --export([init_connection_states/1, - current_connection_state/2, pending_connection_state/2, - update_security_params/3, - set_mac_secret/4, - set_master_secret/2, - activate_pending_connection_state/2, - set_pending_cipher_state/4, - set_renegotiation_flag/2, - set_client_verify_data/3, - set_server_verify_data/3]). - %% Handling of incoming data -export([get_tls_records/2]). -%% Encoding records --export([encode_handshake/3, encode_alert_record/3, - encode_change_cipher_spec/2, encode_data/3]). - %% Decoding -export([decode_cipher_text/2]). -%% Misc. +%% Encoding +-export([encode_plain_text/4]). + +%% Protocol version handling -export([protocol_version/1, lowest_protocol_version/2, highest_protocol_version/1, supported_protocol_versions/0, is_acceptable_version/1, is_acceptable_version/2]). --export([compressions/0]). - -compile(inline). --define(INITIAL_BYTES, 5). - %%==================================================================== %% Internal application API %%==================================================================== %%-------------------------------------------------------------------- --spec init_connection_states(client | server) -> #connection_states{}. -%% -%% Description: Creates a connection_states record with appropriate -%% values for the initial SSL connection setup. -%%-------------------------------------------------------------------- -init_connection_states(Role) -> - ConnectionEnd = record_protocol_role(Role), - Current = initial_connection_state(ConnectionEnd), - Pending = empty_connection_state(ConnectionEnd), - #connection_states{current_read = Current, - pending_read = Pending, - current_write = Current, - pending_write = Pending - }. - -%%-------------------------------------------------------------------- --spec current_connection_state(#connection_states{}, read | write) -> - #connection_state{}. -%% -%% Description: Returns the instance of the connection_state record -%% that is currently defined as the current conection state. -%%-------------------------------------------------------------------- -current_connection_state(#connection_states{current_read = Current}, - read) -> - Current; -current_connection_state(#connection_states{current_write = Current}, - write) -> - Current. - -%%-------------------------------------------------------------------- --spec pending_connection_state(#connection_states{}, read | write) -> - #connection_state{}. -%% -%% Description: Returns the instance of the connection_state record -%% that is currently defined as the pending conection state. -%%-------------------------------------------------------------------- -pending_connection_state(#connection_states{pending_read = Pending}, - read) -> - Pending; -pending_connection_state(#connection_states{pending_write = Pending}, - write) -> - Pending. - -%%-------------------------------------------------------------------- --spec update_security_params(#security_parameters{}, #security_parameters{}, - #connection_states{}) -> #connection_states{}. -%% -%% Description: Creates a new instance of the connection_states record -%% where the pending states gets its security parameters updated. -%%-------------------------------------------------------------------- -update_security_params(ReadParams, WriteParams, States = - #connection_states{pending_read = Read, - pending_write = Write}) -> - States#connection_states{pending_read = - Read#connection_state{security_parameters = - ReadParams}, - pending_write = - Write#connection_state{security_parameters = - WriteParams} - }. -%%-------------------------------------------------------------------- --spec set_mac_secret(binary(), binary(), client | server, - #connection_states{}) -> #connection_states{}. -%% -%% Description: update the mac_secret field in pending connection states -%%-------------------------------------------------------------------- -set_mac_secret(ClientWriteMacSecret, ServerWriteMacSecret, client, States) -> - set_mac_secret(ServerWriteMacSecret, ClientWriteMacSecret, States); -set_mac_secret(ClientWriteMacSecret, ServerWriteMacSecret, server, States) -> - set_mac_secret(ClientWriteMacSecret, ServerWriteMacSecret, States). - -set_mac_secret(ReadMacSecret, WriteMacSecret, - States = #connection_states{pending_read = Read, - pending_write = Write}) -> - States#connection_states{ - pending_read = Read#connection_state{mac_secret = ReadMacSecret}, - pending_write = Write#connection_state{mac_secret = WriteMacSecret} - }. - - -%%-------------------------------------------------------------------- --spec set_master_secret(binary(), #connection_states{}) -> #connection_states{}. -%% -%% Description: Set master_secret in pending connection states -%%-------------------------------------------------------------------- -set_master_secret(MasterSecret, - States = #connection_states{pending_read = Read, - pending_write = Write}) -> - ReadSecPar = Read#connection_state.security_parameters, - Read1 = Read#connection_state{ - security_parameters = ReadSecPar#security_parameters{ - master_secret = MasterSecret}}, - WriteSecPar = Write#connection_state.security_parameters, - Write1 = Write#connection_state{ - security_parameters = WriteSecPar#security_parameters{ - master_secret = MasterSecret}}, - States#connection_states{pending_read = Read1, pending_write = Write1}. - -%%-------------------------------------------------------------------- --spec set_renegotiation_flag(boolean(), #connection_states{}) -> #connection_states{}. -%% -%% Description: Set secure_renegotiation in pending connection states -%%-------------------------------------------------------------------- -set_renegotiation_flag(Flag, #connection_states{ - current_read = CurrentRead0, - current_write = CurrentWrite0, - pending_read = PendingRead0, - pending_write = PendingWrite0} - = ConnectionStates) -> - CurrentRead = CurrentRead0#connection_state{secure_renegotiation = Flag}, - CurrentWrite = CurrentWrite0#connection_state{secure_renegotiation = Flag}, - PendingRead = PendingRead0#connection_state{secure_renegotiation = Flag}, - PendingWrite = PendingWrite0#connection_state{secure_renegotiation = Flag}, - ConnectionStates#connection_states{current_read = CurrentRead, - current_write = CurrentWrite, - pending_read = PendingRead, - pending_write = PendingWrite}. - -%%-------------------------------------------------------------------- --spec set_client_verify_data(current_read | current_write | current_both, - binary(), #connection_states{})-> - #connection_states{}. -%% -%% Description: Set verify data in connection states. -%%-------------------------------------------------------------------- -set_client_verify_data(current_read, Data, - #connection_states{current_read = CurrentRead0, - pending_write = PendingWrite0} - = ConnectionStates) -> - CurrentRead = CurrentRead0#connection_state{client_verify_data = Data}, - PendingWrite = PendingWrite0#connection_state{client_verify_data = Data}, - ConnectionStates#connection_states{current_read = CurrentRead, - pending_write = PendingWrite}; -set_client_verify_data(current_write, Data, - #connection_states{pending_read = PendingRead0, - current_write = CurrentWrite0} - = ConnectionStates) -> - PendingRead = PendingRead0#connection_state{client_verify_data = Data}, - CurrentWrite = CurrentWrite0#connection_state{client_verify_data = Data}, - ConnectionStates#connection_states{pending_read = PendingRead, - current_write = CurrentWrite}; -set_client_verify_data(current_both, Data, - #connection_states{current_read = CurrentRead0, - current_write = CurrentWrite0} - = ConnectionStates) -> - CurrentRead = CurrentRead0#connection_state{client_verify_data = Data}, - CurrentWrite = CurrentWrite0#connection_state{client_verify_data = Data}, - ConnectionStates#connection_states{current_read = CurrentRead, - current_write = CurrentWrite}. -%%-------------------------------------------------------------------- --spec set_server_verify_data(current_read | current_write | current_both, - binary(), #connection_states{})-> - #connection_states{}. -%% -%% Description: Set verify data in pending connection states. -%%-------------------------------------------------------------------- -set_server_verify_data(current_write, Data, - #connection_states{pending_read = PendingRead0, - current_write = CurrentWrite0} - = ConnectionStates) -> - PendingRead = PendingRead0#connection_state{server_verify_data = Data}, - CurrentWrite = CurrentWrite0#connection_state{server_verify_data = Data}, - ConnectionStates#connection_states{pending_read = PendingRead, - current_write = CurrentWrite}; - -set_server_verify_data(current_read, Data, - #connection_states{current_read = CurrentRead0, - pending_write = PendingWrite0} - = ConnectionStates) -> - CurrentRead = CurrentRead0#connection_state{server_verify_data = Data}, - PendingWrite = PendingWrite0#connection_state{server_verify_data = Data}, - ConnectionStates#connection_states{current_read = CurrentRead, - pending_write = PendingWrite}; - -set_server_verify_data(current_both, Data, - #connection_states{current_read = CurrentRead0, - current_write = CurrentWrite0} - = ConnectionStates) -> - CurrentRead = CurrentRead0#connection_state{server_verify_data = Data}, - CurrentWrite = CurrentWrite0#connection_state{server_verify_data = Data}, - ConnectionStates#connection_states{current_read = CurrentRead, - current_write = CurrentWrite}. - -%%-------------------------------------------------------------------- --spec activate_pending_connection_state(#connection_states{}, read | write) -> - #connection_states{}. -%% -%% Description: Creates a new instance of the connection_states record -%% where the pending state of <Type> has been activated. -%%-------------------------------------------------------------------- -activate_pending_connection_state(States = - #connection_states{pending_read = Pending}, - read) -> - NewCurrent = Pending#connection_state{sequence_number = 0}, - SecParams = Pending#connection_state.security_parameters, - ConnectionEnd = SecParams#security_parameters.connection_end, - EmptyPending = empty_connection_state(ConnectionEnd), - SecureRenegotation = NewCurrent#connection_state.secure_renegotiation, - NewPending = EmptyPending#connection_state{secure_renegotiation = SecureRenegotation}, - States#connection_states{current_read = NewCurrent, - pending_read = NewPending - }; - -activate_pending_connection_state(States = - #connection_states{pending_write = Pending}, - write) -> - NewCurrent = Pending#connection_state{sequence_number = 0}, - SecParams = Pending#connection_state.security_parameters, - ConnectionEnd = SecParams#security_parameters.connection_end, - EmptyPending = empty_connection_state(ConnectionEnd), - SecureRenegotation = NewCurrent#connection_state.secure_renegotiation, - NewPending = EmptyPending#connection_state{secure_renegotiation = SecureRenegotation}, - States#connection_states{current_write = NewCurrent, - pending_write = NewPending - }. - -%%-------------------------------------------------------------------- --spec set_pending_cipher_state(#connection_states{}, #cipher_state{}, - #cipher_state{}, client | server) -> - #connection_states{}. -%% -%% Description: Set the cipher state in the specified pending connection state. -%%-------------------------------------------------------------------- -set_pending_cipher_state(#connection_states{pending_read = Read, - pending_write = Write} = States, - ClientState, ServerState, server) -> - States#connection_states{ - pending_read = Read#connection_state{cipher_state = ClientState}, - pending_write = Write#connection_state{cipher_state = ServerState}}; - -set_pending_cipher_state(#connection_states{pending_read = Read, - pending_write = Write} = States, - ClientState, ServerState, client) -> - States#connection_states{ - pending_read = Read#connection_state{cipher_state = ServerState}, - pending_write = Write#connection_state{cipher_state = ClientState}}. - -%%-------------------------------------------------------------------- -spec get_tls_records(binary(), binary()) -> {[binary()], binary()} | #alert{}. %% %% Description: Given old buffer and new data from TCP, packs up a records @@ -376,6 +120,43 @@ get_tls_records_aux(Data, Acc) -> false -> ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE) end. + +encode_plain_text(Type, Version, Data, ConnectionStates) -> + #connection_states{current_write=#connection_state{ + compression_state=CompS0, + security_parameters= + #security_parameters{compression_algorithm=CompAlg} + }=CS0} = ConnectionStates, + {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0), + CS1 = CS0#connection_state{compression_state = CompS1}, + {CipherFragment, CS2} = cipher(Type, Version, Comp, CS1), + CTBin = encode_tls_cipher_text(Type, Version, CipherFragment), + {CTBin, ConnectionStates#connection_states{current_write = CS2}}. + +%%-------------------------------------------------------------------- +-spec decode_cipher_text(#ssl_tls{}, #connection_states{}) -> + {#ssl_tls{}, #connection_states{}}| #alert{}. +%% +%% Description: Decode cipher text +%%-------------------------------------------------------------------- +decode_cipher_text(#ssl_tls{type = Type, version = Version, + fragment = CipherFragment} = CipherText, ConnnectionStates0) -> + ReadState0 = ConnnectionStates0#connection_states.current_read, + #connection_state{compression_state = CompressionS0, + security_parameters = SecParams} = ReadState0, + CompressAlg = SecParams#security_parameters.compression_algorithm, + case decipher(Type, Version, CipherFragment, ReadState0) of + {PlainFragment, ReadState1} -> + {Plain, CompressionS1} = ssl_record:uncompress(CompressAlg, + PlainFragment, CompressionS0), + ConnnectionStates = ConnnectionStates0#connection_states{ + current_read = ReadState1#connection_state{ + compression_state = CompressionS1}}, + {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; + #alert{} = Alert -> + Alert + end. + %%-------------------------------------------------------------------- -spec protocol_version(tls_atom_version() | tls_version()) -> tls_version() | tls_atom_version(). @@ -493,183 +274,39 @@ is_acceptable_version(_,_) -> false. %%-------------------------------------------------------------------- --spec compressions() -> [binary()]. -%% -%% Description: return a list of compressions supported (currently none) -%%-------------------------------------------------------------------- -compressions() -> - [?byte(?NULL)]. - -%%-------------------------------------------------------------------- --spec decode_cipher_text(#ssl_tls{}, #connection_states{}) -> - {#ssl_tls{}, #connection_states{}}| #alert{}. -%% -%% Description: Decode cipher text -%%-------------------------------------------------------------------- -decode_cipher_text(CipherText, ConnnectionStates0) -> - ReadState0 = ConnnectionStates0#connection_states.current_read, - #connection_state{compression_state = CompressionS0, - security_parameters = SecParams} = ReadState0, - CompressAlg = SecParams#security_parameters.compression_algorithm, - case decipher(CipherText, ReadState0) of - {Compressed, ReadState1} -> - {Plain, CompressionS1} = uncompress(CompressAlg, - Compressed, CompressionS0), - ConnnectionStates = ConnnectionStates0#connection_states{ - current_read = ReadState1#connection_state{ - compression_state = CompressionS1}}, - {Plain, ConnnectionStates}; - #alert{} = Alert -> - Alert - end. -%%-------------------------------------------------------------------- --spec encode_data(binary(), tls_version(), #connection_states{}) -> - {iolist(), #connection_states{}}. -%% -%% Description: Encodes data to send on the ssl-socket. -%%-------------------------------------------------------------------- -encode_data(Frag, Version, - #connection_states{current_write = #connection_state{ - security_parameters = - #security_parameters{bulk_cipher_algorithm = BCA}}} = - ConnectionStates) -> - Data = split_bin(Frag, ?MAX_PLAIN_TEXT_LENGTH, Version, BCA), - encode_iolist(?APPLICATION_DATA, Data, Version, ConnectionStates). - -%%-------------------------------------------------------------------- --spec encode_handshake(iolist(), tls_version(), #connection_states{}) -> - {iolist(), #connection_states{}}. -%% -%% Description: Encodes a handshake message to send on the ssl-socket. -%%-------------------------------------------------------------------- -encode_handshake(Frag, Version, ConnectionStates) -> - encode_plain_text(?HANDSHAKE, Version, Frag, ConnectionStates). - -%%-------------------------------------------------------------------- --spec encode_alert_record(#alert{}, tls_version(), #connection_states{}) -> - {iolist(), #connection_states{}}. -%% -%% Description: Encodes an alert message to send on the ssl-socket. -%%-------------------------------------------------------------------- -encode_alert_record(#alert{level = Level, description = Description}, - Version, ConnectionStates) -> - encode_plain_text(?ALERT, Version, <<?BYTE(Level), ?BYTE(Description)>>, - ConnectionStates). - -%%-------------------------------------------------------------------- --spec encode_change_cipher_spec(tls_version(), #connection_states{}) -> - {iolist(), #connection_states{}}. -%% -%% Description: Encodes a change_cipher_spec-message to send on the ssl socket. -%%-------------------------------------------------------------------- -encode_change_cipher_spec(Version, ConnectionStates) -> - encode_plain_text(?CHANGE_CIPHER_SPEC, Version, <<1:8>>, ConnectionStates). - -%%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -encode_iolist(Type, Data, Version, ConnectionStates0) -> - {ConnectionStates, EncodedMsg} = - lists:foldl(fun(Text, {CS0, Encoded}) -> - {Enc, CS1} = encode_plain_text(Type, Version, Text, CS0), - {CS1, [Enc | Encoded]} - end, {ConnectionStates0, []}, Data), - {lists:reverse(EncodedMsg), ConnectionStates}. - -highest_protocol_version() -> - highest_protocol_version(supported_protocol_versions()). - -initial_connection_state(ConnectionEnd) -> - #connection_state{security_parameters = - initial_security_params(ConnectionEnd), - sequence_number = 0 - }. - -initial_security_params(ConnectionEnd) -> - SecParams = #security_parameters{connection_end = ConnectionEnd, - compression_algorithm = ?NULL}, - ssl_cipher:security_parameters(highest_protocol_version(), ?TLS_NULL_WITH_NULL_NULL, - SecParams). - -empty_connection_state(ConnectionEnd) -> - SecParams = empty_security_params(ConnectionEnd), - #connection_state{security_parameters = SecParams}. - -empty_security_params(ConnectionEnd = ?CLIENT) -> - #security_parameters{connection_end = ConnectionEnd, - client_random = random()}; -empty_security_params(ConnectionEnd = ?SERVER) -> - #security_parameters{connection_end = ConnectionEnd, - server_random = random()}. -random() -> - Secs_since_1970 = calendar:datetime_to_gregorian_seconds( - calendar:universal_time()) - 62167219200, - Random_28_bytes = crypto:rand_bytes(28), - <<?UINT32(Secs_since_1970), Random_28_bytes/binary>>. - -record_protocol_role(client) -> - ?CLIENT; -record_protocol_role(server) -> - ?SERVER. - -%% 1/n-1 splitting countermeasure Rizzo/Duong-Beast, RC4 chiphers are not vulnerable to this attack. -split_bin(<<FirstByte:8, Rest/binary>>, ChunkSize, Version, BCA) when BCA =/= ?RC4 andalso ({3, 1} == Version orelse - {3, 0} == Version) -> - do_split_bin(Rest, ChunkSize, [[FirstByte]]); -split_bin(Bin, ChunkSize, _, _) -> - do_split_bin(Bin, ChunkSize, []). - -do_split_bin(<<>>, _, Acc) -> - lists:reverse(Acc); -do_split_bin(Bin, ChunkSize, Acc) -> - case Bin of - <<Chunk:ChunkSize/binary, Rest/binary>> -> - do_split_bin(Rest, ChunkSize, [Chunk | Acc]); - _ -> - lists:reverse(Acc, [Bin]) - end. - -encode_plain_text(Type, Version, Data, ConnectionStates) -> - #connection_states{current_write=#connection_state{ - compression_state=CompS0, - security_parameters= - #security_parameters{compression_algorithm=CompAlg} - }=CS0} = ConnectionStates, - {Comp, CompS1} = compress(CompAlg, Data, CompS0), - CS1 = CS0#connection_state{compression_state = CompS1}, - {CipherText, CS2} = cipher(Type, Version, Comp, CS1), - CTBin = encode_tls_cipher_text(Type, Version, CipherText), - {CTBin, ConnectionStates#connection_states{current_write = CS2}}. - encode_tls_cipher_text(Type, {MajVer, MinVer}, Fragment) -> Length = erlang:iolist_size(Fragment), [<<?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer), ?UINT16(Length)>>, Fragment]. -cipher(Type, Version, Fragment, CS0) -> - Length = erlang:iolist_size(Fragment), - {MacHash, CS1=#connection_state{cipher_state = CipherS0, - security_parameters= - #security_parameters{bulk_cipher_algorithm = +cipher(Type, Version, Fragment, + #connection_state{cipher_state = CipherS0, + sequence_number = SeqNo, + security_parameters= + #security_parameters{bulk_cipher_algorithm = BCA} - }} = - hash_and_bump_seqno(CS0, Type, Version, Length, Fragment), - {Ciphered, CipherS1} = ssl_cipher:cipher(BCA, CipherS0, MacHash, Fragment, Version), - CS2 = CS1#connection_state{cipher_state=CipherS1}, - {Ciphered, CS2}. - -decipher(TLS=#ssl_tls{type=Type, version=Version, fragment=Fragment}, CS0) -> - SP = CS0#connection_state.security_parameters, + } = WriteState0) -> + MacHash = calc_mac_hash(Type, Version, Fragment, WriteState0), + {CipherFragment, CipherS1} = + ssl_cipher:cipher(BCA, CipherS0, MacHash, Fragment, Version), + WriteState = WriteState0#connection_state{cipher_state=CipherS1}, + {CipherFragment, WriteState#connection_state{sequence_number = SeqNo+1}}. + +decipher(Type, Version, CipherFragment, + #connection_state{sequence_number = SeqNo} = ReadState) -> + SP = ReadState#connection_state.security_parameters, BCA = SP#security_parameters.bulk_cipher_algorithm, HashSz = SP#security_parameters.hash_size, - CipherS0 = CS0#connection_state.cipher_state, - case ssl_cipher:decipher(BCA, HashSz, CipherS0, Fragment, Version) of - {T, Mac, CipherS1} -> - CS1 = CS0#connection_state{cipher_state = CipherS1}, - TLength = size(T), - {MacHash, CS2} = hash_and_bump_seqno(CS1, Type, Version, TLength, T), - case is_correct_mac(Mac, MacHash) of - true -> - {TLS#ssl_tls{fragment = T}, CS2}; + CipherS0 = ReadState#connection_state.cipher_state, + case ssl_cipher:decipher(BCA, HashSz, CipherS0, CipherFragment, Version) of + {PlainFragment, Mac, CipherS1} -> + CS1 = ReadState#connection_state{cipher_state = CipherS1}, + MacHash = calc_mac_hash(Type, Version, PlainFragment, ReadState), + case ssl_record:is_correct_mac(Mac, MacHash) of + true -> + {PlainFragment, + CS1#connection_state{sequence_number = SeqNo+1}}; false -> ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) end; @@ -677,40 +314,29 @@ decipher(TLS=#ssl_tls{type=Type, version=Version, fragment=Fragment}, CS0) -> Alert end. -uncompress(?NULL, Data = #ssl_tls{type = _Type, - version = _Version, - fragment = _Fragment}, CS) -> - {Data, CS}. - -compress(?NULL, Data, CS) -> - {Data, CS}. - -hash_and_bump_seqno(#connection_state{sequence_number = SeqNo, - mac_secret = MacSecret, - security_parameters = - SecPars} = CS0, - Type, Version, Length, Fragment) -> - Hash = mac_hash(Version, - SecPars#security_parameters.mac_algorithm, - MacSecret, SeqNo, Type, - Length, Fragment), - {Hash, CS0#connection_state{sequence_number = SeqNo+1}}. - -is_correct_mac(Mac, Mac) -> - true; -is_correct_mac(_M,_H) -> - false. - mac_hash({_,_}, ?NULL, _MacSecret, _SeqNo, _Type, _Length, _Fragment) -> <<>>; mac_hash({3, 0}, MacAlg, MacSecret, SeqNo, Type, Length, Fragment) -> - ssl_ssl3:mac_hash(MacAlg, MacSecret, SeqNo, Type, Length, Fragment); + ssl_v3:mac_hash(MacAlg, MacSecret, SeqNo, Type, Length, Fragment); mac_hash({3, N} = Version, MacAlg, MacSecret, SeqNo, Type, Length, Fragment) when N =:= 1; N =:= 2; N =:= 3 -> - ssl_tls1:mac_hash(MacAlg, MacSecret, SeqNo, Type, Version, + tls_v1:mac_hash(MacAlg, MacSecret, SeqNo, Type, Version, Length, Fragment). +highest_protocol_version() -> + highest_protocol_version(supported_protocol_versions()). + sufficient_tlsv1_2_crypto_support() -> CryptoSupport = crypto:supports(), proplists:get_bool(sha256, proplists:get_value(hashs, CryptoSupport)). + +calc_mac_hash(Type, Version, + PlainFragment, #connection_state{sequence_number = SeqNo, + mac_secret = MacSecret, + security_parameters = + SecPars}) -> + Length = erlang:iolist_size(PlainFragment), + mac_hash(Version, SecPars#security_parameters.mac_algorithm, + MacSecret, SeqNo, Type, + Length, PlainFragment). diff --git a/lib/ssl/src/tls_record.hrl b/lib/ssl/src/tls_record.hrl index c9350fa137..30d7343074 100644 --- a/lib/ssl/src/tls_record.hrl +++ b/lib/ssl/src/tls_record.hrl @@ -29,7 +29,6 @@ -include("ssl_record.hrl"). %% Common TLS and DTLS records and Constantes %% Used to handle tls_plain_text, tls_compressed and tls_cipher_text - -record(ssl_tls, { type, version, diff --git a/lib/ssl/src/ssl_tls1.erl b/lib/ssl/src/tls_v1.erl index 8ab66d0627..2395e98642 100644 --- a/lib/ssl/src/ssl_tls1.erl +++ b/lib/ssl/src/tls_v1.erl @@ -22,7 +22,7 @@ %% Purpose: Handles tls1 encryption. %%---------------------------------------------------------------------- --module(ssl_tls1). +-module(tls_v1). -include("ssl_cipher.hrl"). -include("ssl_internal.hrl"). @@ -86,7 +86,7 @@ certificate_verify(HashAlgo, _Version, Handshake) -> -spec setup_keys(integer(), integer(), binary(), binary(), binary(), integer(), integer(), integer()) -> {binary(), binary(), binary(), - binary(), binary(), binary()}. + binary(), binary(), binary()}. setup_keys(Version, _PrfAlgo, MasterSecret, ServerRandom, ClientRandom, HashSize, KeyMatLen, IVSize) @@ -106,7 +106,7 @@ setup_keys(Version, _PrfAlgo, MasterSecret, ServerRandom, ClientRandom, HashSize WantedLength = 2 * (HashSize + KeyMatLen + IVSize), KeyBlock = prf(?MD5SHA, MasterSecret, "key expansion", [ServerRandom, ClientRandom], WantedLength), - <<ClientWriteMacSecret:HashSize/binary, + <<ClientWriteMacSecret:HashSize/binary, ServerWriteMacSecret:HashSize/binary, ClientWriteKey:KeyMatLen/binary, ServerWriteKey:KeyMatLen/binary, ClientIV:IVSize/binary, ServerIV:IVSize/binary>> = KeyBlock, @@ -167,22 +167,22 @@ setup_keys(Version, PrfAlgo, MasterSecret, ServerRandom, ClientRandom, HashSize, ServerWriteKey, ClientIV, ServerIV}. -spec mac_hash(integer(), binary(), integer(), integer(), tls_version(), - integer(), binary()) -> binary(). + integer(), binary()) -> binary(). -mac_hash(Method, Mac_write_secret, Seq_num, Type, {Major, Minor}, +mac_hash(Method, Mac_write_secret, Seq_num, Type, {Major, Minor}, Length, Fragment) -> %% RFC 2246 & 4346 - 6.2.3.1. %% HMAC_hash(MAC_write_secret, seq_num + TLSCompressed.type + %% TLSCompressed.version + TLSCompressed.length + %% TLSCompressed.fragment)); - Mac = hmac_hash(Method, Mac_write_secret, - [<<?UINT64(Seq_num), ?BYTE(Type), - ?BYTE(Major), ?BYTE(Minor), ?UINT16(Length)>>, + Mac = hmac_hash(Method, Mac_write_secret, + [<<?UINT64(Seq_num), ?BYTE(Type), + ?BYTE(Major), ?BYTE(Minor), ?UINT16(Length)>>, Fragment]), Mac. -spec suites(1|2|3) -> [cipher_suite()]. - + suites(Minor) when Minor == 1; Minor == 2-> case sufficent_ec_support() of true -> @@ -199,8 +199,8 @@ suites(Minor) when Minor == 3 -> no_ec_suites(3) ++ no_ec_suites(2) end. -all_suites(Minor) when Minor == 1; Minor == 2-> - [ +all_suites(Minor) when Minor == 1; Minor == 2-> + [ ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA, ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA, ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA, @@ -224,7 +224,7 @@ all_suites(Minor) when Minor == 1; Minor == 2-> ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA, ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA, ?TLS_RSA_WITH_AES_128_CBC_SHA, - + ?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA, ?TLS_ECDHE_RSA_WITH_RC4_128_SHA, ?TLS_RSA_WITH_RC4_128_SHA, @@ -232,32 +232,32 @@ all_suites(Minor) when Minor == 1; Minor == 2-> ?TLS_DHE_RSA_WITH_DES_CBC_SHA, ?TLS_ECDH_ECDSA_WITH_RC4_128_SHA, ?TLS_ECDH_RSA_WITH_RC4_128_SHA, - + ?TLS_RSA_WITH_DES_CBC_SHA ]; -all_suites(3) -> +all_suites(3) -> [ ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384, ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384, ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384, ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384, - + ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256, ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256, ?TLS_RSA_WITH_AES_256_CBC_SHA256, - + ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256, ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256, ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256, ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256, - + ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256, ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256, ?TLS_RSA_WITH_AES_128_CBC_SHA256 ]. -no_ec_suites(Minor) when Minor == 1; Minor == 2-> - [ +no_ec_suites(Minor) when Minor == 1; Minor == 2-> + [ ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA, ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA, ?TLS_RSA_WITH_AES_256_CBC_SHA, @@ -272,7 +272,7 @@ no_ec_suites(Minor) when Minor == 1; Minor == 2-> ?TLS_DHE_RSA_WITH_DES_CBC_SHA, ?TLS_RSA_WITH_DES_CBC_SHA ]; -no_ec_suites(3) -> +no_ec_suites(3) -> [ ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256, ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256, @@ -323,7 +323,7 @@ p_hash(Secret, Seed, WantedLength, Method, N, Acc) -> %% ... Where A(0) = seed %% A(i) = HMAC_hash(secret, A(i-1)) -%% a(0, _Secret, Seed, _Method) -> +%% a(0, _Secret, Seed, _Method) -> %% Seed. %% a(N, Secret, Seed, Method) -> %% hmac_hash(Method, Secret, a(N-1, Secret, Seed, Method)). diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index 39aa22ffb4..cb919baf4e 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -47,6 +47,7 @@ MODULES = \ ssl_payload_SUITE \ ssl_session_cache_SUITE \ ssl_to_openssl_SUITE \ + ssl_ECC_SUITE \ make_certs\ erl_make_certs diff --git a/lib/ssl/test/ssl_ECC_SUITE.erl b/lib/ssl/test/ssl_ECC_SUITE.erl new file mode 100644 index 0000000000..608f2f11c3 --- /dev/null +++ b/lib/ssl/test/ssl_ECC_SUITE.erl @@ -0,0 +1,225 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% 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/.2 +%% +%% 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(ssl_ECC_SUITE). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("public_key/include/public_key.hrl"). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [ + {group, 'tlsv1.2'}, + {group, 'tlsv1.1'}, + {group, 'tlsv1'} + ]. + +groups() -> + [ + {'tlsv1.2', [], all_versions_groups()}, + {'tlsv1.1', [], all_versions_groups()}, + {'tlsv1', [], all_versions_groups()}, + {'erlang_server', [], key_cert_combinations()}, + {'erlang_client', [], key_cert_combinations()}, + {'erlang', [], key_cert_combinations()} + ]. + +all_versions_groups ()-> + [{group, 'erlang_server'}, + {group, 'erlang_client'}, + {group, 'erlang'} + ]. + +key_cert_combinations() -> + [client_ec_server_ec, + client_rsa_server_ec, + client_ec_server_rsa, + client_rsa_server_rsa]. + +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + catch crypto:stop(), + try crypto:start() of + ok -> + ssl:start(), + Config + catch _:_ -> + {skip, "Crypto did not start"} + end. + +end_per_suite(_Config) -> + ssl:stop(), + application:stop(crypto). + +%%-------------------------------------------------------------------- +init_per_group(erlang_client, Config) -> + case ssl_test_lib:is_sane_ecc(openssl) of + true -> + common_init_per_group(erlang_client, [{server_type, openssl}, + {client_type, erlang} | Config]); + false -> + {skip, "Known ECC bug in openssl"} + end; + +init_per_group(erlang_server, Config) -> + case ssl_test_lib:is_sane_ecc(openssl) of + true -> + common_init_per_group(erlang_client, [{server_type, erlang}, + {client_type, openssl} | Config]); + false -> + {skip, "Known ECC bug in openssl"} + end; + +init_per_group(erlang = Group, Config) -> + case ssl_test_lib:sufficient_crypto_support(Group) of + true -> + common_init_per_group(erlang, [{server_type, erlang}, + {client_type, erlang} | Config]); + false -> + {skip, "Crypto does not support ECC"} + end; +init_per_group(Group, Config) -> + common_init_per_group(Group, Config). + +common_init_per_group(GroupName, Config) -> + case ssl_test_lib:is_tls_version(GroupName) of + true -> + ssl_test_lib:init_tls_version(GroupName), + [{tls_version, GroupName} | Config]; + _ -> + openssl_check(GroupName, Config) + end. + +end_per_group(_GroupName, Config) -> + Config. + +%%-------------------------------------------------------------------- + +init_per_testcase(_TestCase, Config) -> + ct:log("TLS/SSL version ~p~n ", [tls_record:supported_protocol_versions()]), + ct:log("Ciphers: ~p~n ", [ ssl:cipher_suites()]), + Config. + +end_per_testcase(_TestCase, Config) -> + Config. + +%%-------------------------------------------------------------------- +%% Test Cases -------------------------------------------------------- +%%-------------------------------------------------------------------- + +client_ec_server_ec(Config) when is_list(Config) -> + basic_test("ec1.crt", "ec1.key", "ec2.crt", "ec2.key", Config). + +client_ec_server_rsa(Config) when is_list(Config) -> + basic_test("ec1.crt", "ec1.key", "rsa1.crt", "rsa1.key", Config). + +client_rsa_server_ec(Config) when is_list(Config) -> + basic_test("rsa1.crt", "rsa1.key", "ec2.crt", "ec2.key", Config). + +client_rsa_server_rsa(Config) when is_list(Config) -> + basic_test("rsa1.crt", "rsa1.key", "rsa2.crt", "rsa2.key", Config). + +%%-------------------------------------------------------------------- +%% Internal functions ------------------------------------------------ +%%-------------------------------------------------------------------- +basic_test(ClientCert, ClientKey, ServerCert, ServerKey, Config) -> + DataDir = ?config(data_dir, Config), + SType = ?config(server_type, Config), + CType = ?config(client_type, Config), + {Server, Port} = start_server(SType, + filename:join(DataDir, "CA.pem"), + filename:join(DataDir, ServerCert), + filename:join(DataDir, ServerKey), + Config), + Client = start_client(CType, Port, filename:join(DataDir, "CA.pem"), + filename:join(DataDir, ClientCert), + filename:join(DataDir, ClientKey), Config), + check_result(Server, SType, Client, CType). + +start_client(openssl, Port, CA, Cert, Key, _) -> + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), + Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ + " -cert " ++ Cert ++ " -CAfile " ++ CA + ++ " -key " ++ Key ++ " -host localhost -msg", + OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + true = port_command(OpenSslPort, "Hello world"), + OpenSslPort; +start_client(erlang, Port, CA, Cert, Key, Config) -> + {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), + ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, [{verify, verify_peer}, {cacertfile, CA}, + {certfile, Cert}, {keyfile, Key}]}]). + +start_server(openssl, CA, Cert, Key, _) -> + Port = ssl_test_lib:inet_port(node()), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), + Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ + " -cert " ++ Cert ++ " -CAfile " ++ CA + ++ " -key " ++ Key ++ " -Verify 2 -msg", + OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + ssl_test_lib:wait_for_openssl_server(), + true = port_command(OpenSslPort, "Hello world"), + {OpenSslPort, Port}; + +start_server(erlang, CA, Cert, Key, Config) -> + {_, ServerNode, _} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, + send_recv_result_active, + []}}, + {options, + [{verify, verify_peer}, {cacertfile, CA}, + {certfile, Cert}, {keyfile, Key}]}]), + {Server, ssl_test_lib:inet_port(Server)}. + +check_result(Server, erlang, Client, erlang) -> + ssl_test_lib:check_result(Server, ok, Client, ok); +check_result(Server, erlang, _, _) -> + ssl_test_lib:check_result(Server, ok); +check_result(_, _, Client, erlang) -> + ssl_test_lib:check_result(Client, ok); +check_result(_,openssl, _, openssl) -> + ok. + +openssl_check(erlang, Config) -> + Config; +openssl_check(_, Config) -> + TLSVersion = ?config(tls_version, Config), + case ssl_test_lib:check_sane_openssl_version(TLSVersion) of + true -> + ssl:start(), + Config; + false -> + {skip, "TLS version not supported by openssl"} + end. + diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/CA.pem b/lib/ssl/test/ssl_ECC_SUITE_data/CA.pem new file mode 100644 index 0000000000..f82efdefc5 --- /dev/null +++ b/lib/ssl/test/ssl_ECC_SUITE_data/CA.pem @@ -0,0 +1,14 @@ +-----BEGIN CERTIFICATE----- +MIICGjCCAYegAwIBAgIQZIIqq4RXfpBKJXV69Jc4BjAJBgUrDgMCHQUAMB0xGzAZ +BgNVBAMTEklTQSBUZXN0IEF1dGhvcml0eTAeFw0xMjAzMjAxNzEzMjFaFw0zOTEy +MzEyMzU5NTlaMB0xGzAZBgNVBAMTEklTQSBUZXN0IEF1dGhvcml0eTCBnzANBgkq +hkiG9w0BAQEFAAOBjQAwgYkCgYEAqnt6FSyFQVSDyP7mY63IhCzgysTxBEg1qDb8 +nBHj9REReZA5UQ5iyEOdTbdLyOaSk2rJyA2wdTjYkNnLzK49nZFlpf89r3/bakAM +wZv69S3FJi9W2z9m4JPv/5+QCYnFNRSnnHw3maNElwoQyknx96I3W7EuVOvKtKhh +4DaD0WsCAwEAAaNjMGEwDwYDVR0TAQH/BAUwAwEB/zBOBgNVHQEERzBFgBBCHwn2 +8AmbN+cvJl1iJ1bsoR8wHTEbMBkGA1UEAxMSSVNBIFRlc3QgQXV0aG9yaXR5ghBk +giqrhFd+kEoldXr0lzgGMAkGBSsOAwIdBQADgYEAIlVecua5Cr1z/cdwQ8znlgOU +U+y/uzg0nupKkopzVnRYhwV4hxZt3izAz4C/SJZB7eL0bUKlg1ceGjbQsGEm0fzF +LEV3vym4G51bxv03Iecwo96G4NgjJ7+9/7ciBVzfxZyfuCpYG1M2LyrbOyuevtTy +2+vIueT0lv6UftgBfIE= +-----END CERTIFICATE----- diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/ec1.crt b/lib/ssl/test/ssl_ECC_SUITE_data/ec1.crt new file mode 100644 index 0000000000..7d2b9cde9d --- /dev/null +++ b/lib/ssl/test/ssl_ECC_SUITE_data/ec1.crt @@ -0,0 +1,11 @@ +-----BEGIN CERTIFICATE----- +MIIBhjCB8AIBBjANBgkqhkiG9w0BAQUFADAdMRswGQYDVQQDExJJU0EgVGVzdCBB +dXRob3JpdHkwHhcNMTMwODA4MTAxNDI3WhcNMjMwODA2MTAxNDI3WjBFMQswCQYD +VQQGEwJVUzERMA8GA1UECBMIVmlyZ2luaWExFTATBgNVBAcTDEZvcnQgQmVsdm9p +cjEMMAoGA1UEAxMDZWMxMFYwEAYHKoZIzj0CAQYFK4EEAAoDQgAEpiRIxUCESROR +P8IByg+vBv1fDdAg7yXfAh95GxFtvhBqZs6ATwaRKyLmZYgUm/4NUAyUeqmTBb7s +2msKo5mnNzANBgkqhkiG9w0BAQUFAAOBgQAmwzoB1DVO69FQOUdBVnyups4t0c1c +8h+1z/5P4EtPltk4o3mRn0AZogqdXCpNbuSGbSJh+dep5xW30VLxNHdc+tZSLK6j +pT7A3hymMk8qbi13hxeH/VpEP25y1EjHowow9Wmb6ebtT/v7qFQ9AAHD9ONcIM4I +FCC8vdFo7M5GgQ== +-----END CERTIFICATE----- diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/ec1.key b/lib/ssl/test/ssl_ECC_SUITE_data/ec1.key new file mode 100644 index 0000000000..2dc9508b3c --- /dev/null +++ b/lib/ssl/test/ssl_ECC_SUITE_data/ec1.key @@ -0,0 +1,8 @@ +-----BEGIN EC PARAMETERS----- +BgUrgQQACg== +-----END EC PARAMETERS----- +-----BEGIN EC PRIVATE KEY----- +MHQCAQEEIOO0WK8znNzLyZIoGRIlaKnCNr2Wy8uk9i+GGFIhDGNAoAcGBSuBBAAK +oUQDQgAEpiRIxUCESRORP8IByg+vBv1fDdAg7yXfAh95GxFtvhBqZs6ATwaRKyLm +ZYgUm/4NUAyUeqmTBb7s2msKo5mnNw== +-----END EC PRIVATE KEY----- diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/ec2.crt b/lib/ssl/test/ssl_ECC_SUITE_data/ec2.crt new file mode 100644 index 0000000000..b0558a0ebc --- /dev/null +++ b/lib/ssl/test/ssl_ECC_SUITE_data/ec2.crt @@ -0,0 +1,11 @@ +-----BEGIN CERTIFICATE----- +MIIBhjCB8AIBBzANBgkqhkiG9w0BAQUFADAdMRswGQYDVQQDExJJU0EgVGVzdCBB +dXRob3JpdHkwHhcNMTMwODA4MTAxNDM0WhcNMjMwODA2MTAxNDM0WjBFMQswCQYD +VQQGEwJVUzERMA8GA1UECBMIVmlyZ2luaWExFTATBgNVBAcTDEZvcnQgQmVsdm9p +cjEMMAoGA1UEAxMDZWMyMFYwEAYHKoZIzj0CAQYFK4EEAAoDQgAEzXaYReUyvoYl +FwGOe0MJEXWCUncMfr2xG4GMjGYlfZsvLGEokefsJIvW+I+9jgUT2UFjxFXYNAvm +uD1A1iWVWjANBgkqhkiG9w0BAQUFAAOBgQBFa6iIlrT9DWptIdB8uSYvp7qwiHxN +hiVH5YhGIHHqjGZqtRHrSxqNEYMXXrgH9Hxc6gDbk9PsHZyVVoh/HgVWddqW1inh +tStZm420PAKCuH4T6Cfsk76GE2m7FRzJvw9TM1f2A5nIy9abyrpup8lZGcIL4Kmq +1Fix1LRtrmLNTA== +-----END CERTIFICATE----- diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/ec2.key b/lib/ssl/test/ssl_ECC_SUITE_data/ec2.key new file mode 100644 index 0000000000..366d13648b --- /dev/null +++ b/lib/ssl/test/ssl_ECC_SUITE_data/ec2.key @@ -0,0 +1,8 @@ +-----BEGIN EC PARAMETERS----- +BgUrgQQACg== +-----END EC PARAMETERS----- +-----BEGIN EC PRIVATE KEY----- +MHQCAQEEIPR3ORUpAFMTQhUJ0jllN38LKWziG8yP2H54Y/9vh1PwoAcGBSuBBAAK +oUQDQgAEzXaYReUyvoYlFwGOe0MJEXWCUncMfr2xG4GMjGYlfZsvLGEokefsJIvW ++I+9jgUT2UFjxFXYNAvmuD1A1iWVWg== +-----END EC PRIVATE KEY----- diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/rsa1.crt b/lib/ssl/test/ssl_ECC_SUITE_data/rsa1.crt new file mode 100644 index 0000000000..ed9beacf68 --- /dev/null +++ b/lib/ssl/test/ssl_ECC_SUITE_data/rsa1.crt @@ -0,0 +1,20 @@ +-----BEGIN CERTIFICATE----- +MIIDVjCCAr8CAQkwDQYJKoZIhvcNAQEFBQAwHTEbMBkGA1UEAxMSSVNBIFRlc3Qg +QXV0aG9yaXR5MB4XDTEzMDgwODEwMTUzNFoXDTQwMTIyNDEwMTUzNFowRjELMAkG +A1UEBhMCVVMxETAPBgNVBAgTCFZpcmdpbmlhMRUwEwYDVQQHEwxGb3J0IEJlbHZv +aXIxDTALBgNVBAMTBHJzYTEwggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoIC +AQC62v40w1AjV3oJuyYC2Fw6XhTOi1il6xZFnB9J1WhCmuxAB/VMhBcNypx38mNk +eQ7a/ERQ5ddhZey29DYeFYU8oqfDURgWx5USHufb90xBen9KPmX3VNuQ8ZFP2q8Q +b01/oRHBJQRBuaCtFHzpGIVBjC6dD5yeQgJsYaF4u+PBbonsIGROXMybcvUzXmjU +dwpy2NhjGQL5sWcOdIeRP43APSyRYvq4tuBUZk2XxWfBcvA8LpcoYPMlRTf6jGL1 +/fAAcCYJ9lh3h92w0NZ/7ZRa/ebTplxK6yqCftuSKui1KdL69m0WZqHl79AUSfs9 +lsOwx9lHkyYvJeMofyeDbZ+3OYLmVqEBG1fza2aV2XVh9zJ8fAwmXy/c2IDhw/oD +HAe/rSg/Sgt03ydIKqtZHbl3v0EexQQRlJRULIzdtON02dJMUd4EFUgQ9OUtEmC2 +Psj9Jdu1g5cevU7Mymu8Ot+fjHiGTcBUsXNuXFCbON3Gw7cIDl4+iv+cpDHHVC9L +HK3PMEq3vu3qOGXSz+LDOoqkfROcLG7BclBuN2zoVSsMHFkB4aJhwy7eHhGz0z2W +c6LTVd+GAApdY80kmjOjT//QxHEsX/n1useHza3OszQqZiArr4ub4rtq+l1DxAS/ +DWrZ/JGsbKL8cjWso6qBF94xTi8WhjkKuUYhsm+qLAbNOQIDAQABMA0GCSqGSIb3 +DQEBBQUAA4GBAIcuzqRkfypV/9Z85ZQCCoejPm5Urhv7dfg1/B3QtazogPBZLgL5 +e60fG1uAw5GmqTViHLvW06z73oQvJrFkrCLVvadDNtrKYKXnXqdkgVyk36F/B737 +A43HGnMfSxCfRhIOuKZB9clP5PiNlhw36yi3DratqT6TUvI69hg8a7jA +-----END CERTIFICATE----- diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/rsa1.key b/lib/ssl/test/ssl_ECC_SUITE_data/rsa1.key new file mode 100644 index 0000000000..6e0d913d79 --- /dev/null +++ b/lib/ssl/test/ssl_ECC_SUITE_data/rsa1.key @@ -0,0 +1,51 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIJKAIBAAKCAgEAutr+NMNQI1d6CbsmAthcOl4UzotYpesWRZwfSdVoQprsQAf1 +TIQXDcqcd/JjZHkO2vxEUOXXYWXstvQ2HhWFPKKnw1EYFseVEh7n2/dMQXp/Sj5l +91TbkPGRT9qvEG9Nf6ERwSUEQbmgrRR86RiFQYwunQ+cnkICbGGheLvjwW6J7CBk +TlzMm3L1M15o1HcKctjYYxkC+bFnDnSHkT+NwD0skWL6uLbgVGZNl8VnwXLwPC6X +KGDzJUU3+oxi9f3wAHAmCfZYd4fdsNDWf+2UWv3m06ZcSusqgn7bkirotSnS+vZt +Fmah5e/QFEn7PZbDsMfZR5MmLyXjKH8ng22ftzmC5lahARtX82tmldl1YfcyfHwM +Jl8v3NiA4cP6AxwHv60oP0oLdN8nSCqrWR25d79BHsUEEZSUVCyM3bTjdNnSTFHe +BBVIEPTlLRJgtj7I/SXbtYOXHr1OzMprvDrfn4x4hk3AVLFzblxQmzjdxsO3CA5e +Por/nKQxx1QvSxytzzBKt77t6jhl0s/iwzqKpH0TnCxuwXJQbjds6FUrDBxZAeGi +YcMu3h4Rs9M9lnOi01XfhgAKXWPNJJozo0//0MRxLF/59brHh82tzrM0KmYgK6+L +m+K7avpdQ8QEvw1q2fyRrGyi/HI1rKOqgRfeMU4vFoY5CrlGIbJvqiwGzTkCAwEA +AQKCAgBkXyaWKSRvF5pSh9lPRfGk2MzMdkXUOofoNIkKHDy5KocljiDSTVIk8mVC +eU2ytuSn9UKtQgmEJEAXtu8rEdxUSftcC7+o3OTSqw9ZNWoc8jRWKVaUmVyoa1rn +Tk0jwuYaXOcwnTXAKHqK/qpqe+V45FhVvgEfcc3jcj5OoH8jdMFZubyn62ltRz83 +rMsa9icCskDqWpEil40IUshP2ZfHYBUEs+qCNpoiPCIKGNw3KgqqCUzhP9LcfmYn +jCnMge/eDGAikdXLv4vyYvwWFATRK/pGTuLcy542IvbHeY0vY5wVezH2CoOFBGD9 +xQ/UcZwE5hVtQToNsYhoRIVxL/3Of0qDk1M6W2Plh2MAstyejIHE3ct0pPfW3rsu +j/9Z/H0P9Q5ghSjarwOp2qGrrz6/4LVbbTDY8V1L928l4SqbUMtEQxcxTBN8YFoD +mPV3Jc3zls9wiiEX53RcH8MK5tjrcRwWqurTZvi/pkLfXlGDgKGCOaa3HgWVQyU+ +L6jVZM+u1nwN+jNXQYGeLEro/6tvG8WQbRMHQoxLG+rm4V3/SwH0DcfrVFDTg+i6 +3wMU1GC/aQEdTFWXvHAkpwrf4M9QWvjtheiaSxtBUoAY6l+ixCVHKrIk6glKLEjx +92HxmcJdopQScFETAyg8eVKV0kOGfVeFEpIqwq7hVedmTflpQQKCAQEA44h4dAta +cYeBqBr8eljWcgs79gmgwBEQxQUnwE/zuzLKn5NxAW324Kh25V/n/MupUzBlLPWn +91UHfw9PCXT8/HvgYQ4S5sXbKRbGmuPSsTmz4Rfe2ix6RggVNUOwORVNDyM7SQh7 +USdzZH5dMxKfF5L/b4Byx7eQZaoeKlfaXcqgikNZZ6pkhVCNxUKi9vvjS9r2wwCd +xtgu5MfTpdEci0zH1+uuRisVRcEbcRX9umUTCiZrmEeddZXNiwTAS3FtX7qGzuq9 +LKIeETwcOZrWj0E48UvbSfK4Axn7sf5J0n7/Qo7I089S5QQEI6ZDP501i71dNFhn +qfcY30c1k3TC7QKCAQEA0juuVHExKNLLNmQejNPfuHYoH0Uk2BH/8x96/Mkj6k6K +SUCHDS3iWOljXGw8YtpS8v5mGBGgMhJ+s/vCRM6R9eXYTc8u2ktY/kjyW0PgW8/Z +vb9VrQpn5svTNwj2Q8qYsTqXnQKO7YuL+hnQpQNAcID6FTeOASVLGObEf810qRfN +4y3RqCWUnYXXTyXj+cJdbXTxfF7HVZPIAQKqE7J5Qo9ynYILY62oSmUGC6m8VKyE +rrvDMK1IVi0X4w+Jx4HX0IC2+DBKxCaLWT69bE1IwjB06Q5zoTQPVi6c6qQp7K0H +kqSyLJ/ctwcEubu0DPNmvMlgWtAbAsoESA5GbIit/QKCAQEAxRzp9OYNAUM6AK74 +QOmLRZsT4+6tUxa1p2jy6fiZlnfG731kra9c630mG0n9iJPK6aWIUO20CGGiL+HM +P84YiIaseIgfucp4NV1kyrRJR31MptjuF6Xme5ru/IjaNmmMq2uDJZ7ybfi2T73k +8aTVLDANl8P4K6qLrnc00MvxAcXTVFRKNLN5h8CkQNqcoUjPvVxA3+g9xxBrd4jh +gsnoZ4kpq5WiEWmrcRV8t3gsqfh8CRQFrBOGhmIzgZapG/J0pTTLKqBTKEJ9t8KS +VRkdfVcshGWJ4MMjxJQS5zz7KR8Z9cgKlOwLzRiwmU2k/owr4hY3k2xuyeClrHBd +KpRBdQKCAQBvDk/dE55gbloi9WieBB6eluxC+IeqDHgkunCBsM9kKvEqGQg+kgqL +5V4zqImNvr8q1fCgrk7tpI+CDHBnYKgCOdS15cheUIdGbMp6I7UVSws/DR/5NRIF +/Y4p+HX/Abr/hHAq5PsTyS+8gn6RbNJRnBB/vMUrHcQ5902+JY6G9KgyZjXmmVOU +kutWSDHR8jbgZ3JZvMeYEWUKA5pMpW8hFh35zoStt0K7afpzlsqCAFBm7ZEC2cbo +nxGLRN4HojObVSNSoFAepi3eiyINYBYbXvWjV5sFgTbI0/7YhLgQ6qahdJcas6go +l3CLnPhUDxAqkkZwMpbSNl1kowXYt6sRAoIBAAOWnXgf9Bdb9OWKGgt42gVfC4cz +zj2JoLpbDTtbEdHNn8XQvPhGbpdtgnsuEMijIMy1UTlmv17jbFWdZTDeN31EUJrC +smgKX0OlVFKD90AI0BiIREK0hJUBV0pV4JoUjwnQBHGvranD06/wAtHEqgqF1Ipp +DCAKwxggM7qtB1R1vkrc/aLQej+mlwA8N6q92rnEsg+EnEbhtLDDZQcV/q5cSDCN +MMcnM+QdyjKwEeCVXHaqNfeSqKg/Ab2eZbS9VxA+XZD73+eUY/JeJsg7LfZrRz0T +ij5LCS7A+nVB5/B5tGkk4fcNhk2n356be6l46S98BEgtuwGLC9pqXf7zyp4= +-----END RSA PRIVATE KEY----- diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/rsa2.crt b/lib/ssl/test/ssl_ECC_SUITE_data/rsa2.crt new file mode 100644 index 0000000000..06ca92dda3 --- /dev/null +++ b/lib/ssl/test/ssl_ECC_SUITE_data/rsa2.crt @@ -0,0 +1,20 @@ +-----BEGIN CERTIFICATE----- +MIIDVjCCAr8CAQowDQYJKoZIhvcNAQEFBQAwHTEbMBkGA1UEAxMSSVNBIFRlc3Qg +QXV0aG9yaXR5MB4XDTEzMDgwODEwMTYwMloXDTQwMTIyNDEwMTYwMlowRjELMAkG +A1UEBhMCVVMxETAPBgNVBAgTCFZpcmdpbmlhMRUwEwYDVQQHEwxGb3J0IEJlbHZv +aXIxDTALBgNVBAMTBHJzYTIwggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoIC +AQCjQUe0BGOpULjOAmLbXM4SSQzJvxJbCFi3tryyd+OARq6Fdp6/fslVhsr0PhWE +X8yRbAugIjseTpLwz+1OC6LavOGV1ixzGTI/9HDXGKbf8qoCrSdh28sqQJnmqGT4 +UCKLn6Rqjg2iyBBcSK3LrtKEPI4C7NaSOZUtANkppvziEMwm+0r16sgHh2Xx6mxd +22q01kq1lJqwEnIDPMSz3+ESUVQQ4T3ka7yFIhc9PYmILIXkZi0x7AiDeRkIILul +GQrduTWSPGY3prXeDAbmQNazxrHp8fcR2AfFSI6HYxMALq9jWxc4xDIkss6BO2Et +riJOIgXFpbyVsYCbkI1kXhEWFDt3uJBIcmtJKGzro4xv+XLG6BbUeTJgSHXMc7Cb +fX87+CBIFR5a/aqkEKh/mcvsDdaV+kpNKdr7q4wAuIQb8g7IyXEDuAm1VZjQs9WC +KFRGSq9sergEw9gna0iThRZjD+dzNzB17XmlAK4wa98a7MntwqpAt/GsCFOiPM8E +c+8gpuo8WqC0kP8OpImyw9cQhlZ3dca1qkr2cyKyAOGxUxyA67FgiHSsxJJ2Xhse +o49qeKTjMZd8zhSokM2TH6qEf7YfOePU51YRfAHUhzRmE31N/MExqDjFjklksEtM +iHhbPo+cOoxV8x1u13umdUvtTaAUSBA/DpvzWdnORvnaqQIDAQABMA0GCSqGSIb3 +DQEBBQUAA4GBAFD+O7h+5R5S1rIN9eC+oEGpvRhMG4v4G3pJp+c7bbtO7ifFx1WP +bta1b5YtiQYcKP0ORABm/3Kcvsb3VbaMH/zkxWEbASZsmIcBY3ml4f2kkn6WT2hD +Wc6VMIAR3N6Mj1b30yI1qYVIid+zIouiykMB+zqllm+Uar0SPNjKxDU/ +-----END CERTIFICATE----- diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/rsa2.key b/lib/ssl/test/ssl_ECC_SUITE_data/rsa2.key new file mode 100644 index 0000000000..d415ef0391 --- /dev/null +++ b/lib/ssl/test/ssl_ECC_SUITE_data/rsa2.key @@ -0,0 +1,51 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIJJwIBAAKCAgEAo0FHtARjqVC4zgJi21zOEkkMyb8SWwhYt7a8snfjgEauhXae +v37JVYbK9D4VhF/MkWwLoCI7Hk6S8M/tTgui2rzhldYscxkyP/Rw1xim3/KqAq0n +YdvLKkCZ5qhk+FAii5+kao4NosgQXEity67ShDyOAuzWkjmVLQDZKab84hDMJvtK +9erIB4dl8epsXdtqtNZKtZSasBJyAzzEs9/hElFUEOE95Gu8hSIXPT2JiCyF5GYt +MewIg3kZCCC7pRkK3bk1kjxmN6a13gwG5kDWs8ax6fH3EdgHxUiOh2MTAC6vY1sX +OMQyJLLOgTthLa4iTiIFxaW8lbGAm5CNZF4RFhQ7d7iQSHJrSShs66OMb/lyxugW +1HkyYEh1zHOwm31/O/ggSBUeWv2qpBCof5nL7A3WlfpKTSna+6uMALiEG/IOyMlx +A7gJtVWY0LPVgihURkqvbHq4BMPYJ2tIk4UWYw/nczcwde15pQCuMGvfGuzJ7cKq +QLfxrAhTojzPBHPvIKbqPFqgtJD/DqSJssPXEIZWd3XGtapK9nMisgDhsVMcgOux +YIh0rMSSdl4bHqOPanik4zGXfM4UqJDNkx+qhH+2Hznj1OdWEXwB1Ic0ZhN9TfzB +Mag4xY5JZLBLTIh4Wz6PnDqMVfMdbtd7pnVL7U2gFEgQPw6b81nZzkb52qkCAwEA +AQKCAgBORLHXwHL3bdfsDIDQooG5ioQzBQQL2MiP63A0L/5GNZzeJ6ycKnDkLCeJ +SWqPeE5fOemo8EBfm1QfV9BxpmqBbCTK7U+KLv5EYzDmLs9ydqjDd7h11iZlL2uZ +hgpCckjdn7/3xfsLm9ccJ0wLZtlOxKlhBaMpn6nBVbLHoWOEDoGR/tBFbjZQRb2+ +aaFirhtOb56Jx6ER4QYAP1Ye1qrVWWBwZ0yBApXzThDOL36MZqwagFISqRK71YcG +uoq78HGhM3ZXkdV/wNFYj3OPWG6W6h/KBVNqnqO7FbofdoRZhghYHgfYE1fm+ELA ++nLwr5eK1gzmYTs0mVELRBZFlEOkCfYNOnuRgysFezEklS+ICp3HzIhYXza3kyTf +B2ZBwZZVCv/94MKyibyANErmv1a5ugY5Hsn9/WKC8qTto+qLYoyFCvBjzj0PSaVX +/3cty2DY0SK16K1Y4AOPtJMYTXYB3tVX8Akgjz1F6REBtZSOXrSQ3Vhy1ORl3Hzf +WCBYDqL8K0hJiBVgkvneIyIjmFHsdM60Nr7EldBEnJ/UrPzsl2VuWFPZlnasfUaW +x+vq1H4Dfz+bHt8coBRHDjKgUvwkfFeBQOBR5DG3vMrxguVRA1EYYMRR5C3yxk2m +ARAtdh4VxUQDQjjrmr7Dl/y1rU34aInXIrrFWpuvIhl8Ht09sQKCAQEA1pXKK5f0 +HkKfM/qk5xzF+WdHClBrPXi0XwLN6UQ+WWMMNhkGZ+FMPXl/6IJDT91s6DA3tPhr +OZF64n9ZFaGgHNBXNiB+Txjv5vZeSBMFt3hSonqt42aijx6gXfmLnkA+TYpa6Wex +YCeEgdH8LocJa7Gj2vzrYliPYk3deh6SnZZ6N8bI+ciwK3ZGF/pkWaTX83dIFq3w +YyZ+0dEpNGbA9812wNVourPg3OfqG3/CdnTfvY1M9KCC3JalpyzQL4Zm5soXF0wj +36C2yTxA02AyFz3TvUIBrvsN6i0gmGfE79+UIp29JYrFRsIgBDt+ze2vQWUz2MX5 +GeX6/yCBgiTXtwKCAQEAwsNf6k2m5Cw+WtuLzzUfBBJCN+t1lrnYJ6lF0HubW6TZ +vX1kBWyc+Rpo4ljr/+f4R9aC/gTEQOmV/hNVZy1RU2dAI8cH+r6JWG9lgif+8h// +5R81txE7gnuK1Na7PmvnQPPN661zsQZ5e1ENPXS3TJmUW/M01JxAMqEQjvAPa/II +H2KjL5NX28k9Hiw9rP6n+qXAfG/LEwXgoVCcehPwfANqQ1l95UgOdKDmjG94dipI +h2DEK70ZbrsgQbT60Wd8I5h0yhiQsik2/bVkqLmcG4SSg0/5cf2vZMApgoH/adUz +rJFdthm7iGPLhwS6fbhXew17Af96FvzfkifUV+cgnwKCAQBNUlYyFSQKz1jMgxFu +kciokNVhWw75bIgaAEmwNz38OZuJ1sSfI+iz8hbr8hxNJ+15UP6RwD3q1YghG2A/ +Uij+mPgD8ftxhvvTDo10jR4vOTUVhP0phq8mwRNqKWRs1ptcl3Egz5NzoWm22bJ0 +FYaIfs8bNq2el2i7NHGM8n1EOZe6h2+dyfno/0pMk5YbUzHZce7Q9UY8g/+InUSq +tCfuYuPaokuFkxGAqDSMSiIJSx3gEI1dTIU69TGlppkxts1XdhSR+YanqyKSKpr1 +T6FdDJNCjAlNQvuFmVM4d5PYF4kqXApu/60MTSD6RXHwxCe1ecEP6G5VLbCew9jG +y33LAoIBAGsWyC9pwQEm/qYwn4AwYjx32acrtX1J9HtiTLvkqzjJvNu/DXcaEHm7 +tr32TNVp9A9z+JS5hDt49Hs+oC/aMCRe2lqRvmZ1y8kvfy4A1eLGC4stDPj65bDK +QzziURRyejYxmCElPz6wI63VlCUdfwgEThn88SiSPY5ZF2SwxJoC+8peDwJCzwVP +cmabxtHPOAfOibciNRPhoHCyhUdunUVjD1O26k1ewGwKaJoBVMgMWdLuNw8hq9FB +3OukGmF3uD9OPbE9rpn3pX/89Dr9y8MpsvG20J6H8Z/BNVHILus/SmlxiIhvP7kv +viIgTHaCHL/RWrhvg+8N3dRcSBqJQFsCggEAFe2TMEq2AlnBn4gsuAOIuZPYKQCg +2a+tl1grQzmNth6AGGQcIqShadICD6SnVMIS64HHV/m18Cuz7GhJ06ZVjXJsHueG +UpTE9wAmI2LxnNkupkLJu+SVcW3N86PujWmQBFpHkd+IRPLS51xjD9W5zLJ7HL4/ +fnKO+B+ZK6Imxbe5C5vJezkGfeOSyQoVtt6MT/XtSKNEGPBX+M6fLKgUMMg2H2Mt +/SsD7DkOzFteKXzaEg/K8oOTpsOPkVDwNl2KErlEqbJv0k7yEVw50mYmsn/OLjh8 ++9EibISwCODbPxB+PhV6u2ue1IvGLRqtsN60lFOvbGn+kSewy9EUVHHQDQ== +-----END RSA PRIVATE KEY----- diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index b5cf6d1212..b8849d5cbd 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -212,21 +212,20 @@ end_per_suite(_Config) -> %%-------------------------------------------------------------------- init_per_group(GroupName, Config) -> - case ssl_test_lib:is_tls_version(GroupName) of + case ssl_test_lib:is_tls_version(GroupName) andalso ssl_test_lib:sufficient_crypto_support(GroupName) of true -> + ssl_test_lib:init_tls_version(GroupName), + Config; + _ -> case ssl_test_lib:sufficient_crypto_support(GroupName) of true -> - ssl_test_lib:init_tls_version(GroupName), + ssl:start(), Config; false -> {skip, "Missing crypto support"} - end; - _ -> - ssl:start(), - Config + end end. - end_per_group(_GroupName, Config) -> Config. diff --git a/lib/ssl/test/ssl_handshake_SUITE.erl b/lib/ssl/test/ssl_handshake_SUITE.erl index a40f07fd07..9695710230 100644 --- a/lib/ssl/test/ssl_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_handshake_SUITE.erl @@ -32,43 +32,44 @@ %%-------------------------------------------------------------------- suite() -> [{ct_hooks,[ts_install_cth]}]. -all() -> [ - decode_hello_handshake, - decode_single_hello_extension_correctly, - decode_unknown_hello_extension_correctly]. +all() -> [decode_hello_handshake, + decode_single_hello_extension_correctly, + decode_unknown_hello_extension_correctly]. %%-------------------------------------------------------------------- %% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- decode_hello_handshake(_Config) -> - HelloPacket = <<16#02, 16#00, 16#00, - 16#44, 16#03, 16#03, 16#4e, 16#7f, 16#c1, 16#03, 16#35, - 16#c2, 16#07, 16#b9, 16#4a, 16#58, 16#af, 16#34, 16#07, - 16#a6, 16#7e, 16#ef, 16#52, 16#cb, 16#e0, 16#ea, 16#b7, - 16#aa, 16#47, 16#c8, 16#c2, 16#2c, 16#66, 16#fa, 16#f8, - 16#09, 16#42, 16#cf, 16#00, 16#c0, 16#30, 16#00, 16#00, - 16#1c, - 16#00, 16#0b, 16#00, 16#04, 16#03, 16#00, 16#01, 16#02, % ec_point_formats - 16#ff, 16#01, 16#00, 16#01, 16#00, %% renegotiate - 16#00, 16#23, - 16#00, 16#00, 16#33, 16#74, 16#00, 16#07, 16#06, 16#73, - 16#70, 16#64, 16#79, 16#2f, 16#32>>, - - Version = {3, 0}, - {Records, _Buffer} = tls_handshake:get_tls_handshake(Version, HelloPacket, <<>>), - - {Hello, _Data} = hd(Records), - #renegotiation_info{renegotiated_connection = <<0>>} = Hello#server_hello.renegotiation_info. + HelloPacket = <<16#02, 16#00, 16#00, + 16#44, 16#03, 16#03, 16#4e, 16#7f, 16#c1, 16#03, 16#35, + 16#c2, 16#07, 16#b9, 16#4a, 16#58, 16#af, 16#34, 16#07, + 16#a6, 16#7e, 16#ef, 16#52, 16#cb, 16#e0, 16#ea, 16#b7, + 16#aa, 16#47, 16#c8, 16#c2, 16#2c, 16#66, 16#fa, 16#f8, + 16#09, 16#42, 16#cf, 16#00, 16#c0, 16#30, 16#00, 16#00, + 16#1c, + 16#00, 16#0b, 16#00, 16#04, 16#03, 16#00, 16#01, 16#02, % ec_point_formats + 16#ff, 16#01, 16#00, 16#01, 16#00, %% renegotiate + 16#00, 16#23, + 16#00, 16#00, 16#33, 16#74, 16#00, 16#07, 16#06, 16#73, + 16#70, 16#64, 16#79, 16#2f, 16#32>>, + Version = {3, 0}, + {Records, _Buffer} = tls_handshake:get_tls_handshake(Version, HelloPacket, <<>>), + + {Hello, _Data} = hd(Records), + #renegotiation_info{renegotiated_connection = <<0>>} + = (Hello#server_hello.extensions)#hello_extensions.renegotiation_info. + decode_single_hello_extension_correctly(_Config) -> - Renegotiation = <<?UINT16(?RENEGOTIATION_EXT), ?UINT16(1), 0>>, - Extensions = tls_handshake:dec_hello_extensions(Renegotiation, []), - [{renegotiation_info,#renegotiation_info{renegotiated_connection = <<0>>}}] = Extensions. - + Renegotiation = <<?UINT16(?RENEGOTIATION_EXT), ?UINT16(1), 0>>, + Extensions = ssl_handshake:decode_hello_extensions(Renegotiation), + #renegotiation_info{renegotiated_connection = <<0>>} + = Extensions#hello_extensions.renegotiation_info. + decode_unknown_hello_extension_correctly(_Config) -> - FourByteUnknown = <<16#CA,16#FE, ?UINT16(4), 3, 0, 1, 2>>, - Renegotiation = <<?UINT16(?RENEGOTIATION_EXT), ?UINT16(1), 0>>, - Extensions = tls_handshake:dec_hello_extensions(<<FourByteUnknown/binary, Renegotiation/binary>>, []), - [{renegotiation_info,#renegotiation_info{renegotiated_connection = <<0>>}}] = Extensions. - + FourByteUnknown = <<16#CA,16#FE, ?UINT16(4), 3, 0, 1, 2>>, + Renegotiation = <<?UINT16(?RENEGOTIATION_EXT), ?UINT16(1), 0>>, + Extensions = ssl_handshake:decode_hello_extensions(<<FourByteUnknown/binary, Renegotiation/binary>>), + #renegotiation_info{renegotiated_connection = <<0>>} + = Extensions#hello_extensions.renegotiation_info. diff --git a/lib/ssl/test/ssl_npn_hello_SUITE.erl b/lib/ssl/test/ssl_npn_hello_SUITE.erl index ef5a02abef..27e1090114 100644 --- a/lib/ssl/test/ssl_npn_hello_SUITE.erl +++ b/lib/ssl/test/ssl_npn_hello_SUITE.erl @@ -52,7 +52,7 @@ encode_and_decode_client_hello_test(_Config) -> Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), {[{DecodedHandshakeMessage, _Raw}], _} = tls_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>), - NextProtocolNegotiation = DecodedHandshakeMessage#client_hello.next_protocol_negotiation, + NextProtocolNegotiation = (DecodedHandshakeMessage#client_hello.extensions)#hello_extensions.next_protocol_negotiation, NextProtocolNegotiation = undefined. %%-------------------------------------------------------------------- encode_and_decode_npn_client_hello_test(_Config) -> @@ -60,7 +60,7 @@ encode_and_decode_npn_client_hello_test(_Config) -> Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), {[{DecodedHandshakeMessage, _Raw}], _} = tls_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>), - NextProtocolNegotiation = DecodedHandshakeMessage#client_hello.next_protocol_negotiation, + NextProtocolNegotiation = (DecodedHandshakeMessage#client_hello.extensions)#hello_extensions.next_protocol_negotiation, NextProtocolNegotiation = #next_protocol_negotiation{extension_data = <<>>}. %%-------------------------------------------------------------------- encode_and_decode_server_hello_test(_Config) -> @@ -68,7 +68,7 @@ encode_and_decode_server_hello_test(_Config) -> Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), {[{DecodedHandshakeMessage, _Raw}], _} = tls_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>), - NextProtocolNegotiation = DecodedHandshakeMessage#server_hello.next_protocol_negotiation, + NextProtocolNegotiation = (DecodedHandshakeMessage#server_hello.extensions)#hello_extensions.next_protocol_negotiation, NextProtocolNegotiation = undefined. %%-------------------------------------------------------------------- encode_and_decode_npn_server_hello_test(_Config) -> @@ -76,56 +76,59 @@ encode_and_decode_npn_server_hello_test(_Config) -> Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), {[{DecodedHandshakeMessage, _Raw}], _} = tls_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>), - NextProtocolNegotiation = DecodedHandshakeMessage#server_hello.next_protocol_negotiation, + NextProtocolNegotiation = (DecodedHandshakeMessage#server_hello.extensions)#hello_extensions.next_protocol_negotiation, ct:log("~p ~n", [NextProtocolNegotiation]), NextProtocolNegotiation = #next_protocol_negotiation{extension_data = <<6, "spdy/2">>}. %%-------------------------------------------------------------------- create_server_hello_with_no_advertised_protocols_test(_Config) -> - Hello = tls_handshake:server_hello(<<>>, {3, 0}, create_connection_states(), false, undefined, undefined, undefined), - undefined = Hello#server_hello.next_protocol_negotiation. + Hello = tls_handshake:server_hello(<<>>, {3, 0}, create_connection_states(), #hello_extensions{}), + undefined = (Hello#server_hello.extensions)#hello_extensions.next_protocol_negotiation. %%-------------------------------------------------------------------- create_server_hello_with_advertised_protocols_test(_Config) -> Hello = tls_handshake:server_hello(<<>>, {3, 0}, create_connection_states(), - false, [<<"spdy/1">>, <<"http/1.0">>, <<"http/1.1">>], undefined, undefined), - #next_protocol_negotiation{extension_data = <<6, "spdy/1", 8, "http/1.0", 8, "http/1.1">>} = - Hello#server_hello.next_protocol_negotiation. + #hello_extensions{next_protocol_negotiation = [<<"spdy/1">>, <<"http/1.0">>, <<"http/1.1">>]}), + [<<"spdy/1">>, <<"http/1.0">>, <<"http/1.1">>] = + (Hello#server_hello.extensions)#hello_extensions.next_protocol_negotiation. %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- create_client_handshake(Npn) -> + Vsn = {1, 2}, tls_handshake:encode_handshake(#client_hello{ - client_version = {1, 2}, - random = <<1:256>>, - session_id = <<>>, - cipher_suites = [?TLS_DHE_DSS_WITH_DES_CBC_SHA], - compression_methods = "", - next_protocol_negotiation = Npn, - renegotiation_info = #renegotiation_info{} - }, vsn). + client_version = Vsn, + random = <<1:256>>, + session_id = <<>>, + cipher_suites = [?TLS_DHE_DSS_WITH_DES_CBC_SHA], + compression_methods = "", + extensions = #hello_extensions{ + next_protocol_negotiation = Npn, + renegotiation_info = #renegotiation_info{}} + }, Vsn). create_server_handshake(Npn) -> + Vsn = {1, 2}, tls_handshake:encode_handshake(#server_hello{ - server_version = {1, 2}, - random = <<1:256>>, - session_id = <<>>, - cipher_suite = ?TLS_DHE_DSS_WITH_DES_CBC_SHA, - compression_method = 1, - next_protocol_negotiation = Npn, - renegotiation_info = #renegotiation_info{} - }, vsn). + server_version = Vsn, + random = <<1:256>>, + session_id = <<>>, + cipher_suite = ?TLS_DHE_DSS_WITH_DES_CBC_SHA, + compression_method = 1, + extensions = #hello_extensions{ + next_protocol_negotiation = Npn, + renegotiation_info = #renegotiation_info{}} + }, Vsn). create_connection_states() -> #connection_states{ - pending_read = #connection_state{ - security_parameters = #security_parameters{ - server_random = <<1:256>>, - compression_algorithm = 1, - cipher_suite = ?TLS_DHE_DSS_WITH_DES_CBC_SHA - } - }, - - current_read = #connection_state { - secure_renegotiation = false - } - }. + pending_read = #connection_state{ + security_parameters = #security_parameters{ + server_random = <<1:256>>, + compression_algorithm = 1, + cipher_suite = ?TLS_DHE_DSS_WITH_DES_CBC_SHA + } + }, + current_read = #connection_state { + secure_renegotiation = false + } + }. diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 34c52b10b3..74fadc0cc7 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -27,6 +27,7 @@ -compile(export_all). -record(sslsocket, { fd = nil, pid = nil}). +-define(SLEEP, 1000). %% For now always run locally run_where(_) -> @@ -949,7 +950,10 @@ init_tls_version(Version) -> sufficient_crypto_support('tlsv1.2') -> CryptoSupport = crypto:supports(), proplists:get_bool(sha256, proplists:get_value(hashs, CryptoSupport)); -sufficient_crypto_support(ciphers_ec) -> +sufficient_crypto_support(Group) when Group == ciphers_ec; %% From ssl_basic_SUITE + Group == erlang_server; %% From ssl_ECC_SUITE + Group == erlang_client; %% From ssl_ECC_SUITE + Group == erlang -> %% From ssl_ECC_SUITE CryptoSupport = crypto:supports(), proplists:get_bool(ecdh, proplists:get_value(public_keys, CryptoSupport)); sufficient_crypto_support(_) -> @@ -1026,3 +1030,39 @@ cipher_restriction(Config0) -> true -> Config0 end. + +check_sane_openssl_version(Version) -> + case {Version, os:cmd("openssl version")} of + {_, "OpenSSL 1.0.1" ++ _} -> + true; + {'tlsv1.2', "OpenSSL 1.0" ++ _} -> + false; + {'tlsv1.1', "OpenSSL 1.0" ++ _} -> + false; + {'tlsv1.2', "OpenSSL 0" ++ _} -> + false; + {'tlsv1.1', "OpenSSL 0" ++ _} -> + false; + {_, _} -> + true + end. + +wait_for_openssl_server() -> + receive + {Port, {data, Debug}} when is_port(Port) -> + ct:log("openssl ~s~n",[Debug]), + %% openssl has started make sure + %% it will be in accept. Parsing + %% output is too error prone. (Even + %% more so than sleep!) + ct:sleep(?SLEEP) + end. + +version_flag(tlsv1) -> + " -tls1 "; +version_flag('tlsv1.1') -> + " -tls1_1 "; +version_flag('tlsv1.2') -> + " -tls1_2 "; +version_flag(sslv3) -> + " -ssl3 ". diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 019ed58b1b..b576b8f70d 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -120,7 +120,7 @@ end_per_suite(_Config) -> init_per_group(GroupName, Config) -> case ssl_test_lib:is_tls_version(GroupName) of true -> - case check_sane_openssl_version(GroupName) of + case ssl_test_lib:check_sane_openssl_version(GroupName) of true -> ssl_test_lib:init_tls_version(GroupName), Config; @@ -204,7 +204,7 @@ basic_erlang_client_openssl_server(Config) when is_list(Config) -> OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - wait_for_openssl_server(), + ssl_test_lib:wait_for_openssl_server(), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -269,14 +269,14 @@ erlang_client_openssl_server(Config) when is_list(Config) -> CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++ + Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ " -cert " ++ CertFile ++ " -key " ++ KeyFile, ct:log("openssl cmd: ~p~n", [Cmd]), OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - wait_for_openssl_server(), + ssl_test_lib:wait_for_openssl_server(), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -311,7 +311,7 @@ erlang_server_openssl_client(Config) when is_list(Config) -> Port = ssl_test_lib:inet_port(Server), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ version_flag(Version) ++ + Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ " -host localhost", ct:log("openssl cmd: ~p~n", [Cmd]), @@ -345,7 +345,7 @@ erlang_client_openssl_server_dsa_cert(Config) when is_list(Config) -> KeyFile = proplists:get_value(keyfile, ServerOpts), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++ + Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ " -cert " ++ CertFile ++ " -CAfile " ++ CaCertFile ++ " -key " ++ KeyFile ++ " -Verify 2 -msg", @@ -353,7 +353,7 @@ erlang_client_openssl_server_dsa_cert(Config) when is_list(Config) -> OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - wait_for_openssl_server(), + ssl_test_lib:wait_for_openssl_server(), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -392,7 +392,7 @@ erlang_server_openssl_client_dsa_cert(Config) when is_list(Config) -> {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ version_flag(Version) ++ + Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ " -host localhost " ++ " -cert " ++ CertFile ++ " -CAfile " ++ CaCertFile ++ " -key " ++ KeyFile ++ " -msg", @@ -428,7 +428,7 @@ erlang_server_openssl_client_reuse_session(Config) when is_list(Config) -> {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ version_flag(Version) ++ + Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ " -host localhost -reconnect", ct:log("openssl cmd: ~p~n", [Cmd]), @@ -464,14 +464,14 @@ erlang_client_openssl_server_renegotiate(Config) when is_list(Config) -> KeyFile = proplists:get_value(keyfile, ServerOpts), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++ + Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ " -cert " ++ CertFile ++ " -key " ++ KeyFile ++ " -msg", ct:log("openssl cmd: ~p~n", [Cmd]), OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - wait_for_openssl_server(), + ssl_test_lib:wait_for_openssl_server(), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -513,14 +513,14 @@ erlang_client_openssl_server_nowrap_seqnum(Config) when is_list(Config) -> CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++ + Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ " -cert " ++ CertFile ++ " -key " ++ KeyFile ++ " -msg", ct:log("openssl cmd: ~p~n", [Cmd]), OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - wait_for_openssl_server(), + ssl_test_lib:wait_for_openssl_server(), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -559,7 +559,7 @@ erlang_server_openssl_client_nowrap_seqnum(Config) when is_list(Config) -> {options, [{renegotiate_at, N}, {reuse_sessions, false} | ServerOpts]}]), Port = ssl_test_lib:inet_port(Server), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ version_flag(Version) ++ + Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ " -host localhost -msg", ct:log("openssl cmd: ~p~n", [Cmd]), @@ -594,14 +594,14 @@ erlang_client_openssl_server_no_server_ca_cert(Config) when is_list(Config) -> CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++ + Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ " -cert " ++ CertFile ++ " -key " ++ KeyFile ++ " -msg", ct:log("openssl cmd: ~p~n", [Cmd]), OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - wait_for_openssl_server(), + ssl_test_lib:wait_for_openssl_server(), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -636,7 +636,7 @@ erlang_client_openssl_server_client_cert(Config) when is_list(Config) -> CaCertFile = proplists:get_value(cacertfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++ + Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ " -cert " ++ CertFile ++ " -CAfile " ++ CaCertFile ++ " -key " ++ KeyFile ++ " -Verify 2", @@ -644,7 +644,7 @@ erlang_client_openssl_server_client_cert(Config) when is_list(Config) -> OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - wait_for_openssl_server(), + ssl_test_lib:wait_for_openssl_server(), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -688,7 +688,7 @@ erlang_server_openssl_client_client_cert(Config) when is_list(Config) -> KeyFile = proplists:get_value(keyfile, ClientOpts), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Cmd = "openssl s_client -cert " ++ CertFile ++ " -CAfile " ++ CaCertFile - ++ " -key " ++ KeyFile ++ " -port " ++ integer_to_list(Port) ++ version_flag(Version) ++ + ++ " -key " ++ KeyFile ++ " -port " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ " -host localhost", ct:log("openssl cmd: ~p~n", [Cmd]), @@ -776,14 +776,14 @@ erlang_client_bad_openssl_server(Config) when is_list(Config) -> CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++ + Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ " -cert " ++ CertFile ++ " -key " ++ KeyFile ++ "", ct:log("openssl cmd: ~p~n", [Cmd]), OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - wait_for_openssl_server(), + ssl_test_lib:wait_for_openssl_server(), Client0 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -839,7 +839,7 @@ expired_session(Config) when is_list(Config) -> OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - wait_for_openssl_server(), + ssl_test_lib:wait_for_openssl_server(), Client0 = ssl_test_lib:start_client([{node, ClientNode}, @@ -1033,14 +1033,14 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), - Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++ + Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ " -cert " ++ CertFile ++ " -key " ++ KeyFile ++ "", ct:log("openssl cmd: ~p~n", [Cmd]), OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - wait_for_openssl_server(), + ssl_test_lib:wait_for_openssl_server(), ConnectionInfo = {ok, {Version, CipherSuite}}, @@ -1097,14 +1097,14 @@ start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, Opens Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Cmd = "openssl s_server " ++ OpensslServerOpts ++ " -accept " ++ - integer_to_list(Port) ++ version_flag(Version) ++ + integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ " -cert " ++ CertFile ++ " -key " ++ KeyFile, ct:log("openssl cmd: ~p~n", [Cmd]), OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - wait_for_openssl_server(), + ssl_test_lib:wait_for_openssl_server(), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -1136,14 +1136,14 @@ start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callbac KeyFile = proplists:get_value(keyfile, ServerOpts), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - Cmd = "openssl s_server -msg -nextprotoneg http/1.1,spdy/2 -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++ + Cmd = "openssl s_server -msg -nextprotoneg http/1.1,spdy/2 -accept " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ " -cert " ++ CertFile ++ " -key " ++ KeyFile, ct:log("openssl cmd: ~p~n", [Cmd]), OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - wait_for_openssl_server(), + ssl_test_lib:wait_for_openssl_server(), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -1174,7 +1174,7 @@ start_erlang_server_and_openssl_client_for_npn_negotiation(Config, Data, Callbac {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - Cmd = "openssl s_client -nextprotoneg http/1.0,spdy/2 -msg -port " ++ integer_to_list(Port) ++ version_flag(Version) ++ + Cmd = "openssl s_client -nextprotoneg http/1.0,spdy/2 -msg -port " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ " -host localhost", ct:log("openssl cmd: ~p~n", [Cmd]), @@ -1203,7 +1203,7 @@ start_erlang_server_and_openssl_client_with_opts(Config, ErlangServerOpts, OpenS {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - Cmd = "openssl s_client " ++ OpenSSLClientOpts ++ " -msg -port " ++ integer_to_list(Port) ++ version_flag(Version) ++ + Cmd = "openssl s_client " ++ OpenSSLClientOpts ++ " -msg -port " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ " -host localhost", ct:log("openssl cmd: ~p~n", [Cmd]), @@ -1302,25 +1302,6 @@ server_sent_garbage(Socket) -> end. -wait_for_openssl_server() -> - receive - {Port, {data, Debug}} when is_port(Port) -> - ct:log("openssl ~s~n",[Debug]), - %% openssl has started make sure - %% it will be in accept. Parsing - %% output is too error prone. (Even - %% more so than sleep!) - ct:sleep(?SLEEP) - end. - -version_flag(tlsv1) -> - " -tls1 "; -version_flag('tlsv1.1') -> - " -tls1_1 "; -version_flag('tlsv1.2') -> - " -tls1_2 "; -version_flag(sslv3) -> - " -ssl3 ". check_openssl_npn_support(Config) -> HelpText = os:cmd("openssl s_client --help"), @@ -1365,18 +1346,3 @@ supports_sslv2(Port) -> true end. -check_sane_openssl_version(Version) -> - case {Version, os:cmd("openssl version")} of - {_, "OpenSSL 1.0.1" ++ _} -> - true; - {'tlsv1.2', "OpenSSL 1.0" ++ _} -> - false; - {'tlsv1.1', "OpenSSL 1.0" ++ _} -> - false; - {'tlsv1.2', "OpenSSL 0" ++ _} -> - false; - {'tlsv1.1', "OpenSSL 0" ++ _} -> - false; - {_, _} -> - true - end. diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index 9dd151553c..78424ee578 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 5.3 +SSL_VSN = 5.3.1 diff --git a/lib/stdlib/doc/src/notes.xml b/lib/stdlib/doc/src/notes.xml index 2c1daf10ba..2f404523dd 100644 --- a/lib/stdlib/doc/src/notes.xml +++ b/lib/stdlib/doc/src/notes.xml @@ -30,6 +30,86 @@ </header> <p>This document describes the changes made to the STDLIB application.</p> +<section><title>STDLIB 1.19.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> The functions <c>dets:foldl/3</c>, + <c>dets:foldr/3</c>, and <c>dets:traverse/2</c> did not + release the table after having traversed the table to the + end. The bug was introduced in R16B. (Thanks to Manuel + Duran Aguete.) </p> + <p> + Own Id: OTP-11245</p> + </item> + <item> + <p> If the <c>fun M:F/A</c> construct was used + erroneously the linter could crash. (Thanks to Mikhail + Sobolev.) </p> + <p> + Own Id: OTP-11254</p> + </item> + <item> + <p> The specifications of <c>io_lib:fread/2,3</c> have + been corrected. (Thanks to Chris King and Kostis Sagonas + for pinpointing the bug.) </p> + <p> + Own Id: OTP-11261</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Fixed type typo in gen_server.</p> + <p> + Own Id: OTP-11200</p> + </item> + <item> + <p> + Update type specs in filelib and io_prompt. Thanks to + Jose Valim.</p> + <p> + Own Id: OTP-11208</p> + </item> + <item> + <p> + Fix typo in abcast() function comment. Thanks to Johannes + Weissl.</p> + <p> + Own Id: OTP-11219</p> + </item> + <item> + <p> + Make edlin understand a few important control keys. + Thanks to Stefan Zegenhagen.</p> + <p> + Own Id: OTP-11251</p> + </item> + <item> + <p> + Export the edge/0 type from the digraph module. Thanks to + Alex Ronne Petersen.</p> + <p> + Own Id: OTP-11266</p> + </item> + <item> + <p> + Fix variable usage tracking in erl_lint and fixed unsafe + variable tracking in try expressions. Thanks to Anthony + Ramine.</p> + <p> + Own Id: OTP-11268</p> + </item> + </list> + </section> + +</section> + <section><title>STDLIB 1.19.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/stdlib/src/dict.erl b/lib/stdlib/src/dict.erl index e67433ffb7..7e198a2469 100644 --- a/lib/stdlib/src/dict.erl +++ b/lib/stdlib/src/dict.erl @@ -391,7 +391,7 @@ merge(F, D1, D2) -> update(K, fun (V1) -> F(K, V1, V2) end, V2, D) end, D1, D2). - + %% get_slot(Hashdb, Key) -> Slot. %% Get the slot. First hash on the new range, if we hit a bucket %% which has not been split use the unsplit buddy bucket. diff --git a/lib/stdlib/src/erl_compile.erl b/lib/stdlib/src/erl_compile.erl index 8c3d59467b..ed8fea5d78 100644 --- a/lib/stdlib/src/erl_compile.erl +++ b/lib/stdlib/src/erl_compile.erl @@ -21,10 +21,12 @@ -include("erl_compile.hrl"). -include("file.hrl"). --export([compile_cmdline/1]). +-export([compile_cmdline/0]). -export_type([cmd_line_arg/0]). +-define(STDERR, standard_error). %Macro to avoid misspellings. + %% Mapping from extension to {M,F} to run the correct compiler. compiler(".erl") -> {compile, compile}; @@ -47,9 +49,10 @@ compiler(_) -> no. -type cmd_line_arg() :: atom() | string(). --spec compile_cmdline([cmd_line_arg()]) -> no_return(). +-spec compile_cmdline() -> no_return(). -compile_cmdline(List) -> +compile_cmdline() -> + List = init:get_plain_arguments(), case compile(List) of ok -> my_halt(0); error -> my_halt(1); @@ -67,8 +70,12 @@ compile(List) -> receive {'EXIT', Pid, {compiler_result, Result}} -> Result; + {'EXIT', Pid, {compiler_error, Error}} -> + io:put_chars(?STDERR, Error), + io:nl(?STDERR), + error; {'EXIT', Pid, Reason} -> - io:format("Runtime error: ~tp~n", [Reason]), + io:format(?STDERR, "Runtime error: ~tp~n", [Reason]), error end. @@ -83,66 +90,178 @@ compiler_runner(List) -> %% Parses the first part of the option list. -compile1(['@cwd', Cwd|Rest]) -> - CwdL = atom_to_list(Cwd), - compile1(Rest, CwdL, #options{outdir=CwdL, cwd=CwdL}); compile1(Args) -> - %% From R13B02, the @cwd argument is optional. {ok, Cwd} = file:get_cwd(), - compile1(Args, Cwd, #options{outdir=Cwd, cwd=Cwd}). + compile1(Args, #options{outdir=Cwd,cwd=Cwd}). %% Parses all options. -compile1(['@i', Dir|Rest], Cwd, Opts) -> +compile1(["--"|Files], Opts) -> + compile2(Files, Opts); +compile1(["-"++Option|T], Opts) -> + parse_generic_option(Option, T, Opts); +compile1(["+"++Option|Rest], Opts) -> + Term = make_term(Option), + Specific = Opts#options.specific, + compile1(Rest, Opts#options{specific=[Term|Specific]}); +compile1(Files, Opts) -> + compile2(Files, Opts). + +parse_generic_option("b"++Opt, T0, Opts) -> + {OutputType,T} = get_option("b", Opt, T0), + compile1(T, Opts#options{output_type=list_to_atom(OutputType)}); +parse_generic_option("D"++Opt, T0, #options{defines=Defs}=Opts) -> + {Val0,T} = get_option("D", Opt, T0), + {Key0,Val1} = split_at_equals(Val0, []), + Key = list_to_atom(Key0), + case Val1 of + [] -> + compile1(T, Opts#options{defines=[Key|Defs]}); + Val2 -> + Val = make_term(Val2), + compile1(T, Opts#options{defines=[{Key,Val}|Defs]}) + end; +parse_generic_option("help", _, _Opts) -> + usage(); +parse_generic_option("I"++Opt, T0, #options{cwd=Cwd}=Opts) -> + {Dir,T} = get_option("I", Opt, T0), AbsDir = filename:absname(Dir, Cwd), - compile1(Rest, Cwd, Opts#options{includes=[AbsDir|Opts#options.includes]}); -compile1(['@outdir', Dir|Rest], Cwd, Opts) -> + compile1(T, Opts#options{includes=[AbsDir|Opts#options.includes]}); +parse_generic_option("M"++Opt, T0, #options{specific=Spec}=Opts) -> + case parse_dep_option(Opt, T0) of + error -> + error; + {SpecOpts,T} -> + compile1(T, Opts#options{specific=SpecOpts++Spec}) + end; +parse_generic_option("o"++Opt, T0, #options{cwd=Cwd}=Opts) -> + {Dir,T} = get_option("o", Opt, T0), AbsName = filename:absname(Dir, Cwd), case file_or_directory(AbsName) of file -> - compile1(Rest, Cwd, Opts#options{outfile=AbsName}); + compile1(T, Opts#options{outfile=AbsName}); directory -> - compile1(Rest, Cwd, Opts#options{outdir=AbsName}) + compile1(T, Opts#options{outdir=AbsName}) end; -compile1(['@d', Name|Rest], Cwd, Opts) -> - Defines = Opts#options.defines, - compile1(Rest, Cwd, Opts#options{defines=[Name|Defines]}); -compile1(['@dv', Name, Term|Rest], Cwd, Opts) -> - Defines = Opts#options.defines, - Value = make_term(atom_to_list(Term)), - compile1(Rest, Cwd, Opts#options{defines=[{Name, Value}|Defines]}); -compile1(['@warn', Level0|Rest], Cwd, Opts) -> - case catch list_to_integer(atom_to_list(Level0)) of - Level when is_integer(Level) -> - compile1(Rest, Cwd, Opts#options{warning=Level}); +parse_generic_option("O"++Opt, T, Opts) -> + case Opt of + "" -> + compile1(T, Opts#options{optimize=1}); _ -> - compile1(Rest, Cwd, Opts) + Term = make_term(Opt), + compile1(T, Opts#options{optimize=Term}) end; -compile1(['@verbose', false|Rest], Cwd, Opts) -> - compile1(Rest, Cwd, Opts#options{verbose=false}); -compile1(['@verbose', true|Rest], Cwd, Opts) -> - compile1(Rest, Cwd, Opts#options{verbose=true}); -compile1(['@optimize', Atom|Rest], Cwd, Opts) -> - Term = make_term(atom_to_list(Atom)), - compile1(Rest, Cwd, Opts#options{optimize=Term}); -compile1(['@option', Atom|Rest], Cwd, Opts) -> - Term = make_term(atom_to_list(Atom)), - Specific = Opts#options.specific, - compile1(Rest, Cwd, Opts#options{specific=[Term|Specific]}); -compile1(['@output_type', OutputType|Rest], Cwd, Opts) -> - compile1(Rest, Cwd, Opts#options{output_type=OutputType}); -compile1(['@files'|Rest], Cwd, Opts) -> - Includes = lists:reverse(Opts#options.includes), - compile2(Rest, Cwd, Opts#options{includes=Includes}). - -compile2(Files, Cwd, Opts) -> - case {Opts#options.outfile, length(Files)} of +parse_generic_option("v", T, Opts) -> + compile1(T, Opts#options{verbose=true}); +parse_generic_option("W"++Warn, T, #options{specific=Spec}=Opts) -> + case Warn of + "all" -> + compile1(T, Opts#options{warning=999}); + "error" -> + compile1(T, Opts#options{specific=[warnings_as_errors|Spec]}); + "" -> + compile1(T, Opts#options{warning=1}); + _ -> + try list_to_integer(Warn) of + Level -> + compile1(T, Opts#options{warning=Level}) + catch + error:badarg -> + usage() + end + end; +parse_generic_option("E", T, #options{specific=Spec}=Opts) -> + compile1(T, Opts#options{specific=['E'|Spec]}); +parse_generic_option("P", T, #options{specific=Spec}=Opts) -> + compile1(T, Opts#options{specific=['P'|Spec]}); +parse_generic_option("S", T, #options{specific=Spec}=Opts) -> + compile1(T, Opts#options{specific=['S'|Spec]}); +parse_generic_option(Option, _T, _Opts) -> + io:format(?STDERR, "Unknown option: -~s\n", [Option]), + usage(). + +parse_dep_option("", T) -> + {[makedep,{makedep_output,standard_io}],T}; +parse_dep_option("D", T) -> + {[makedep],T}; +parse_dep_option("F"++Opt, T0) -> + {File,T} = get_option("MF", Opt, T0), + {[makedep,{makedep_output,File}],T}; +parse_dep_option("G", T) -> + {[makedep_add_missing],T}; +parse_dep_option("P", T) -> + {[makedep_phony],T}; +parse_dep_option("Q"++Opt, T0) -> + {Target,T} = get_option("MT", Opt, T0), + {[makedep_quote_target,{makedep_target,Target}],T}; +parse_dep_option("T"++Opt, T0) -> + {Target,T} = get_option("MT", Opt, T0), + {[{makedep_target,Target}],T}; +parse_dep_option(Opt, _T) -> + io:format(?STDERR, "Unknown option: -M~s\n", [Opt]), + usage(). + +usage() -> + H = [{"-b type","type of output file (e.g. beam)"}, + {"-d","turn on debugging of erlc itself"}, + {"-Dname","define name"}, + {"-Dname=value","define name to have value"}, + {"-help","shows this help text"}, + {"-I path","where to search for include files"}, + {"-M","generate a rule for make(1) describing the dependencies"}, + {"-MF file","write the dependencies to 'file'"}, + {"-MT target","change the target of the rule emitted by dependency " + "generation"}, + {"-MQ target","same as -MT but quote characters special to make(1)"}, + {"-MG","consider missing headers as generated files and add them to " + "the dependencies"}, + {"-MP","add a phony target for each dependency"}, + {"-MD","same as -M -MT file (with default 'file')"}, + {"-o name","name output directory or file"}, + {"-pa path","add path to the front of Erlang's code path"}, + {"-pz path","add path to the end of Erlang's code path"}, + {"-smp","compile using SMP emulator"}, + {"-v","verbose compiler output"}, + {"-Werror","make all warnings into errors"}, + {"-W0","disable warnings"}, + {"-Wnumber","set warning level to number"}, + {"-Wall","enable all warnings"}, + {"-W","enable warnings (default; same as -W1)"}, + {"-E","generate listing of expanded code (Erlang compiler)"}, + {"-S","generate assembly listing (Erlang compiler)"}, + {"-P","generate listing of preprocessed code (Erlang compiler)"}, + {"+term","pass the Erlang term unchanged to the compiler"}], + io:put_chars(?STDERR, + ["Usage: erlc [Options] file.ext ...\n", + "Options:\n", + [io_lib:format("~-14s ~s\n", [K,D]) || {K,D} <- H]]), + error. + +get_option(_Name, [], [[C|_]=Option|T]) when C =/= $- -> + {Option,T}; +get_option(_Name, [_|_]=Option, T) -> + {Option,T}; +get_option(Name, _, _) -> + exit({compiler_error,"No value given to -"++Name++" option"}). + +split_at_equals([$=|T], Acc) -> + {lists:reverse(Acc),T}; +split_at_equals([H|T], Acc) -> + split_at_equals(T, [H|Acc]); +split_at_equals([], Acc) -> + {lists:reverse(Acc),[]}. + +compile2(Files, #options{cwd=Cwd,includes=Incl,outfile=Outfile}=Opts0) -> + Opts = Opts0#options{includes=lists:reverse(Incl)}, + case {Outfile,length(Files)} of {"", _} -> compile3(Files, Cwd, Opts); {[_|_], 1} -> compile3(Files, Cwd, Opts); {[_|_], _N} -> - io:format("Output file name given, but more than one input file.~n"), + io:put_chars(?STDERR, + "Output file name given, " + "but more than one input file.\n"), error end. @@ -170,23 +289,25 @@ compile3([], _Cwd, _Options) -> ok. %% Invokes the appropriate compiler, depending on the file extension. compile_file("", Input, _Output, _Options) -> - io:format("File has no extension: ~ts~n", [Input]), + io:format(?STDERR, "File has no extension: ~ts~n", [Input]), error; compile_file(Ext, Input, Output, Options) -> case compiler(Ext) of no -> - io:format("Unknown extension: '~ts'\n", [Ext]), + io:format(?STDERR, "Unknown extension: '~ts'\n", [Ext]), error; {M, F} -> case catch M:F(Input, Output, Options) of ok -> ok; error -> error; {'EXIT',Reason} -> - io:format("Compiler function ~w:~w/3 failed:\n~p~n", + io:format(?STDERR, + "Compiler function ~w:~w/3 failed:\n~p~n", [M,F,Reason]), error; Other -> - io:format("Compiler function ~w:~w/3 returned:\n~p~n", + io:format(?STDERR, + "Compiler function ~w:~w/3 returned:\n~p~n", [M,F,Other]), error end @@ -215,10 +336,10 @@ make_term(Str) -> case erl_parse:parse_term(Tokens ++ [{dot, 1}]) of {ok, Term} -> Term; {error, {_,_,Reason}} -> - io:format("~ts: ~ts~n", [Reason, Str]), + io:format(?STDERR, "~ts: ~ts~n", [Reason, Str]), throw(error) end; {error, {_,_,Reason}, _} -> - io:format("~ts: ~ts~n", [Reason, Str]), + io:format(?STDERR, "~ts: ~ts~n", [Reason, Str]), throw(error) end. diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 73b8da335a..ca6a4b5c58 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -912,7 +912,7 @@ type_test(binary) -> is_binary; type_test(record) -> is_record; type_test(Test) -> Test. - + %% match(Pattern, Term, Bindings) -> %% {match,NewBindings} | nomatch %% or erlang:error({illegal_pattern, Pattern}). @@ -1051,7 +1051,7 @@ match_list([], [], Bs, _BBs) -> {match,Bs}; match_list(_, _, _Bs, _BBs) -> nomatch. - + %% new_bindings() %% bindings(Bindings) %% binding(Name, Bindings) diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index b6ab39251a..bcf3ccef3b 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -1955,12 +1955,10 @@ expr({string,_Line,_S}, _Vt, St) -> {[],St}; expr({nil,_Line}, _Vt, St) -> {[],St}; expr({cons,_Line,H,T}, Vt, St) -> expr_list([H,T], Vt, St); -expr({lc,_Line,E,Qs}, Vt0, St0) -> - {Vt,St} = handle_comprehension(E, Qs, Vt0, St0), - {vtold(Vt, Vt0),St}; %Don't export local variables -expr({bc,_Line,E,Qs}, Vt0, St0) -> - {Vt,St} = handle_comprehension(E, Qs, Vt0, St0), - {vtold(Vt,Vt0),St}; %Don't export local variables +expr({lc,_Line,E,Qs}, Vt, St) -> + handle_comprehension(E, Qs, Vt, St); +expr({bc,_Line,E,Qs}, Vt, St) -> + handle_comprehension(E, Qs, Vt, St); expr({tuple,_Line,Es}, Vt, St) -> expr_list(Es, Vt, St); expr({record_index,Line,Name,Field}, _Vt, St) -> @@ -2014,8 +2012,7 @@ expr({'fun',Line,Body}, Vt, St) -> %%No one can think funs export! case Body of {clauses,Cs} -> - {Bvt, St1} = fun_clauses(Cs, Vt, St), - {vtupdate(Bvt, Vt), St1}; + fun_clauses(Cs, Vt, St); {function,F,A} -> %% BifClash - Fun expression %% N.B. Only allows BIFs here as well, NO IMPORTS!! @@ -2113,12 +2110,12 @@ expr({'try',Line,Es,Scs,Ccs,As}, Vt, St0) -> {Evt0,St1} = exprs(Es, Vt, St0), TryLine = {'try',Line}, Uvt = vtunsafe(vtnames(vtnew(Evt0, Vt)), TryLine, []), - Evt1 = vtupdate(Uvt, vtupdate(Evt0, Vt)), - {Sccs,St2} = icrt_clauses(Scs++Ccs, TryLine, Evt1, St1), + Evt1 = vtupdate(Uvt, vtsubtract(Evt0, Uvt)), + {Sccs,St2} = icrt_clauses(Scs++Ccs, TryLine, vtupdate(Evt1, Vt), St1), Rvt0 = Sccs, Rvt1 = vtupdate(vtunsafe(vtnames(vtnew(Rvt0, Vt)), TryLine, []), Rvt0), Evt2 = vtmerge(Evt1, Rvt1), - {Avt0,St} = exprs(As, Evt2, St2), + {Avt0,St} = exprs(As, vtupdate(Evt2, Vt), St2), Avt1 = vtupdate(vtunsafe(vtnames(vtnew(Avt0, Vt)), TryLine, []), Avt0), Avt = vtmerge(Evt2, Avt1), {Avt,St}; @@ -2152,10 +2149,11 @@ expr({remote,Line,_M,_F}, _Vt, St) -> %% {UsedVarTable,State} expr_list(Es, Vt, St) -> - foldl(fun (E, {Esvt,St0}) -> - {Evt,St1} = expr(E, Vt, St0), - {vtmerge(Evt, Esvt),St1} - end, {[],St}, Es). + {Vt1,St1} = foldl(fun (E, {Esvt,St0}) -> + {Evt,St1} = expr(E, Vt, St0), + {vtmerge_pat(Evt, Esvt),St1} + end, {[],St}, Es), + {vtmerge(vtnew(Vt1, Vt), vtold(Vt1, Vt)),St1}. record_expr(Line, Rec, Vt, St0) -> St1 = warn_invalid_record(Line, Rec, St0), @@ -2312,7 +2310,7 @@ check_fields(Fs, Name, Fields, Vt, St0, CheckFun) -> check_field({record_field,Lf,{atom,La,F},Val}, Name, Fields, Vt, St, Sfs, CheckFun) -> case member(F, Sfs) of - true -> {Sfs,{Vt,add_error(Lf, {redefine_field,Name,F}, St)}}; + true -> {Sfs,{[],add_error(Lf, {redefine_field,Name,F}, St)}}; false -> {[F|Sfs], case find_field(F, Fields) of @@ -2845,7 +2843,9 @@ icrt_export(Csvt, Vt, In, St) -> Uvt = vtmerge(Evt, Unused), %% Make exported and unsafe unused variables unused in subsequent code: Vt2 = vtmerge(Uvt, vtsubtract(Vt1, Uvt)), - {Vt2,St}. + %% Forget about old variables which were not used: + Vt3 = vtmerge(vtnew(Vt2, Vt), vt_no_unused(vtold(Vt2, Vt))), + {Vt3,St}. handle_comprehension(E, Qs, Vt0, St0) -> {Vt1, Uvt, St1} = lc_quals(Qs, Vt0, St0), @@ -2858,7 +2858,11 @@ handle_comprehension(E, Qs, Vt0, St0) -> %% Local variables that have not been shadowed. {_,St} = check_unused_vars(Vt2, Vt0, St4), Vt3 = vtmerge(vtsubtract(Vt2, Uvt), Uvt), - {Vt3,St}. + %% Don't export local variables. + Vt4 = vtold(Vt3, Vt0), + %% Forget about old variables which were not used. + Vt5 = vt_no_unused(Vt4), + {Vt5,St}. %% lc_quals(Qualifiers, ImportVarTable, State) -> %% {VarTable,ShadowedVarTable,State} @@ -2939,7 +2943,7 @@ fun_clauses(Cs, Vt, St) -> {Cvt,St1} = fun_clause(C, Vt, St0), {vtmerge(Cvt, Bvt0),St1} end, {[],St#lint{recdef_top = false}}, Cs), - {Bvt,St2#lint{recdef_top = OldRecDef}}. + {vt_no_unused(vtold(Bvt, Vt)),St2#lint{recdef_top = OldRecDef}}. fun_clause({clause,_Line,H,G,B}, Vt0, St0) -> {Hvt,Binvt,St1} = head(H, Vt0, [], St0), % No imported pattern variables @@ -3200,6 +3204,8 @@ vt_no_unsafe(Vt) -> [V || {_,{S,_U,_L}}=V <- Vt, _ -> true end]. +vt_no_unused(Vt) -> [V || {_,{_,U,_L}}=V <- Vt, U =/= unused]. + %% vunion(VarTable1, VarTable2) -> [VarName]. %% vunion([VarTable]) -> [VarName]. %% vintersection(VarTable1, VarTable2) -> [VarName]. diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl index f49c2a64f4..40b48d7999 100644 --- a/lib/stdlib/src/erl_tar.erl +++ b/lib/stdlib/src/erl_tar.erl @@ -219,7 +219,7 @@ format_error(Atom) when is_atom(Atom) -> format_error(Term) -> lists:flatten(io_lib:format("~tp", [Term])). - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% Useful definitions (also start of implementation). @@ -409,7 +409,7 @@ split_filename([Comp|Rest], Prefix, Suffix, Len) -> split_filename([], Prefix, Suffix, _) -> {filename:join(Prefix),filename:join(Suffix)}. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% Retrieving files from a tape archive. diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl index 5b7bc0ab21..a266daa084 100644 --- a/lib/stdlib/src/filelib.erl +++ b/lib/stdlib/src/filelib.erl @@ -248,7 +248,7 @@ ensure_dir(F) -> end end. - + %%% %%% Pattern matching using a compiled wildcard. %%% @@ -360,7 +360,7 @@ do_alt([], _File) -> do_list_dir(Dir, Mod) -> eval_list_dir(Dir, Mod). - + %%% Compiling a wildcard. %% Only for debugging. diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index 6776f3deaa..5f14e48b0a 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -393,7 +393,7 @@ decode_msg(Msg, Parent, Name, State, Mod, Time, Debug, Hib) -> end. %%% --------------------------------------------------- -%%% Send/recive functions +%%% Send/receive functions %%% --------------------------------------------------- do_send(Dest, Msg) -> case catch erlang:send(Dest, Msg, [noconnect]) of diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index 53781e97f1..375d05f359 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -582,7 +582,7 @@ printable_unicode_list(_) -> false. %Everything else is false nl() -> "\n". - + %% %% Utilities for collecting characters in input files %% diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl index b5577165f4..d6a9f4645d 100644 --- a/lib/stdlib/src/lists.erl +++ b/lib/stdlib/src/lists.erl @@ -630,7 +630,7 @@ flatlength([H|T], L) when is_list(H) -> flatlength([_|T], L) -> flatlength(T, L + 1); flatlength([], L) -> L. - + %% keymember(Key, Index, [Tuple]) Now a BIF! %% keyfind(Key, Index, [Tuple]) A BIF! %% keysearch(Key, Index, [Tuple]) Now a BIF! @@ -1163,7 +1163,7 @@ rumerge(T1, []) -> T1; rumerge(T1, [H2 | T2]) -> lists:reverse(rumerge2_1(T1, T2, [], H2), []). - + %% all(Predicate, List) %% any(Predicate, List) %% map(Function, List) diff --git a/lib/stdlib/src/string.erl b/lib/stdlib/src/string.erl index 0675afb877..f9b083a56d 100644 --- a/lib/stdlib/src/string.erl +++ b/lib/stdlib/src/string.erl @@ -256,7 +256,7 @@ chars(C, N, Tail) when N > 0 -> chars(C, N-1, [C|Tail]); chars(C, 0, Tail) when is_integer(C) -> Tail. - + %% Torbjörn's bit. %%% COPIES %%% @@ -460,7 +460,7 @@ sub_string(String, Start) -> substr(String, Start). Stop :: pos_integer(). sub_string(String, Start, Stop) -> substr(String, Start, Stop - Start + 1). - + %% ISO/IEC 8859-1 (latin1) letters are converted, others are ignored %% diff --git a/lib/stdlib/test/binary_module_SUITE.erl b/lib/stdlib/test/binary_module_SUITE.erl index d6886ba1e5..d5a0fe21b4 100644 --- a/lib/stdlib/test/binary_module_SUITE.erl +++ b/lib/stdlib/test/binary_module_SUITE.erl @@ -248,6 +248,10 @@ badargs(Config) when is_list(Config) -> binary:matches(<<1,2,3>>, {ac,ets:match_spec_compile([{'_',[],['$_']}])}, [{scope,{0,1}}])), + %% OTP-11350 + badarg = ?MASK_ERROR( + binary:matches(<<"foo">>, + [<<>>, <<"f">>])), ?line badarg = ?MASK_ERROR(binary:longest_common_prefix( [<<0:10000,1,2,4,1:3>>, diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index fdaab2ee30..6bf87adf14 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -153,7 +153,16 @@ unused_vars_warn_basic(Config) when is_list(Config) -> {22,erl_lint,{unused_var,'N'}}, {23,erl_lint,{shadowed_var,'N','fun'}}, {28,erl_lint,{unused_var,'B'}}, - {29,erl_lint,{unused_var,'B'}}]}}], + {29,erl_lint,{unused_var,'B'}}]}}, + {basic2, + <<"-record(r, {x,y}). + f({X,Y}) -> {Z=X,Z=Y}; + f([H|T]) -> [Z=H|Z=T]; + f(#r{x=X,y=Y}) -> #r{x=A=X,y=A=Y}. + g({M, F}) -> (Z=M):(Z=F)(); + g({M, F, Arg}) -> (Z=M):F(Z=Arg). + h(X, Y) -> (Z=X) + (Z=Y).">>, + [warn_unused_vars], []}], ?line [] = run(Config, Ts), ok. @@ -539,7 +548,29 @@ unused_vars_warn_rec(Config) when is_list(Config) -> end. ">>, [warn_unused_vars], - {warnings,[{22,erl_lint,{unused_var,'Same'}}]}}], + {warnings,[{22,erl_lint,{unused_var,'Same'}}]}}, + {rec2, + <<"-record(r, {a,b}). + f(X, Y) -> #r{a=[K || K <- Y], b=[K || K <- Y]}. + g(X, Y) -> #r{a=lists:map(fun (K) -> K end, Y), + b=lists:map(fun (K) -> K end, Y)}. + h(X, Y) -> #r{a=case Y of _ when is_list(Y) -> Y end, + b=case Y of _ when is_list(Y) -> Y end}. + i(X, Y) -> #r{a=if is_list(Y) -> Y end, b=if is_list(Y) -> Y end}. + ">>, + [warn_unused_vars], + {warnings,[{2,erl_lint,{unused_var,'X'}}, + {3,erl_lint,{unused_var,'X'}}, + {5,erl_lint,{unused_var,'X'}}, + {7,erl_lint,{unused_var,'X'}}]}}, + {rec3, + <<"-record(r, {a}). + t() -> X = 1, #r{a=foo, a=bar, a=qux}. + ">>, + [warn_unused_vars], + {error,[{2,erl_lint,{redefine_field,r,a}}, + {2,erl_lint,{redefine_field,r,a}}], + [{2,erl_lint,{unused_var,'X'}}]}}], ?line [] = run(Config, Ts), ok. @@ -1077,7 +1108,24 @@ unsafe_vars_try(Config) when is_list(Config) -> {10,erl_lint,{unsafe_var,'Ra',{'try',3}}}, {10,erl_lint,{unsafe_var,'Rc',{'try',3}}}, {10,erl_lint,{unsafe_var,'Ro',{'try',3}}}], - []}}], + []}}, + {unsafe_try5, + <<"bang() -> + case 1 of + nil -> + Acc = 2; + _ -> + try + Acc = 3, + Acc + catch _:_ -> + ok + end + end, + Acc. + ">>, + [], + {errors,[{13,erl_lint,{unsafe_var,'Acc',{'try',6}}}],[]}}], ?line [] = run(Config, Ts), ok. diff --git a/lib/stdlib/test/slave_SUITE.erl b/lib/stdlib/test/slave_SUITE.erl index 37fc694083..1d6a3ac90d 100644 --- a/lib/stdlib/test/slave_SUITE.erl +++ b/lib/stdlib/test/slave_SUITE.erl @@ -230,7 +230,7 @@ rsh_test(ResultTo) -> link(ResultTo), ?line {error, no_rsh} = slave:start(super, slave3). - + %%% Utilities. diff --git a/lib/test_server/doc/src/notes.xml b/lib/test_server/doc/src/notes.xml index f3d4bc201a..bc83231950 100644 --- a/lib/test_server/doc/src/notes.xml +++ b/lib/test_server/doc/src/notes.xml @@ -32,6 +32,62 @@ <file>notes.xml</file> </header> +<section><title>Test_Server 3.6.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Test Server installed an error handler (test_server_h) + only to be able to write the name of the current test + case to stdout whenever it received an error- or progress + report. This functionality was not useful and has been + removed. The built-in Common Test hook, cth_log_redirect, + has instead been improved to now also tag all error- and + progress reports in the log with suite-, group-, and/or + test case name.</p> + <p> + Own Id: OTP-11263 Aux Id: seq12251 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + A new log, the "Pre- and Post Test I/O Log", has been + introduced, which makes it possible to capture error- and + progress reports, as well as printouts made with ct:log/2 + and ct:pal/2, before and after a test run. (Some minor + improvements of the logging system have been made at the + same time). Links to the new log are found on the Common + Test Framework Log page. The Common Test User's Guide has + been updated with information about the new log and also + with a new section on how to synchronize external + applications with Common Test by means of the CT Hook + init and terminate functions.</p> + <p> + Own Id: OTP-11272</p> + </item> + </list> + </section> + + + <section><title>Known Bugs and Problems</title> + <list> + <item> + <p> + Test Server: Report auto_skipped in major log.</p> + <p> + Own Id: OTP-11297</p> + </item> + </list> + </section> + +</section> + <section><title>Test_Server 3.6.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/test_server/src/Makefile b/lib/test_server/src/Makefile index ebc5f5b71b..ab4dd4d95d 100644 --- a/lib/test_server/src/Makefile +++ b/lib/test_server/src/Makefile @@ -45,7 +45,6 @@ MODULES= test_server_ctrl \ test_server_node \ test_server \ test_server_sup \ - test_server_h \ erl2html2 TS_MODULES= \ diff --git a/lib/test_server/src/test_server.app.src b/lib/test_server/src/test_server.app.src index 163f370a47..42e78ed279 100644 --- a/lib/test_server/src/test_server.app.src +++ b/lib/test_server/src/test_server.app.src @@ -23,7 +23,6 @@ erl2html2, test_server_ctrl, test_server, - test_server_h, test_server_io, test_server_node, test_server_sup diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index c350f758ce..6ddb2b615f 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -389,7 +389,6 @@ run_test_case_apply({CaseNum,Mod,Func,Args,Name, os:putenv("VALGRIND_LOGFILE_INFIX",atom_to_list(Mod)++"."++ atom_to_list(Func)++"-") end, - test_server_h:testcase({Mod,Func,1}), ProcBef = erlang:system_info(process_count), Result = run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData), diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl index ffa21d054c..d0f31af198 100644 --- a/lib/test_server/src/test_server_ctrl.erl +++ b/lib/test_server/src/test_server_ctrl.erl @@ -479,12 +479,6 @@ init([]) -> test_server_sup:call_trace(TraceSpec) end, process_flag(trap_exit, true), - case lists:keysearch(sasl, 1, application:which_applications()) of - {value,_} -> - test_server_h:install(); - false -> - ok - end, %% copy format_exception setting from init arg to application environment case init:get_argument(test_server_format_exception) of {ok,[[TSFE]]} -> @@ -1067,12 +1061,6 @@ terminate(_Reason, State) -> end, kill_all_jobs(State#state.jobs), test_server_node:kill_nodes(), - case lists:keysearch(sasl, 1, application:which_applications()) of - {value,_} -> - test_server_h:restore(); - _ -> - ok - end, ok. kill_all_jobs([{_Name,JobPid}|Jobs]) -> @@ -1183,7 +1171,13 @@ init_tester(Mod, Func, Args, Dir, Name, {_,_,MinLev}=Levels, "<td>~.3fs</td><td><b>~ts</b></td><td>~w Ok, ~w Failed~ts of ~w</td></tr>\n" "</tfoot>\n", [Time,SuccessStr,OkN,FailedN,SkipStr,OkN+FailedN+SkippedN]), - test_server_io:stop([major,html,unexpected_io]). + + test_server_io:stop([major,html,unexpected_io]), + {UnexpectedIoName,UnexpectedIoFooter} = get(test_server_unexpected_footer), + {ok,UnexpectedIoFd} = open_html_file(UnexpectedIoName, [append]), + io:put_chars(UnexpectedIoFd, "\n</pre>\n"++UnexpectedIoFooter), + file:close(UnexpectedIoFd), + ok. report_severe_error(Reason) -> test_server_sup:framework_call(report, [severe_error,Reason]). @@ -1642,15 +1636,13 @@ start_log_file() -> FilenameMode), ok = write_file(?last_file, TestDir1 ++ "\n", FilenameMode), put(test_server_log_dir_base,TestDir1), + MajorName = filename:join(TestDir1, ?suitelog_name), HtmlName = MajorName ++ ?html_ext, UnexpectedName = filename:join(TestDir1, ?unexpected_io_log), + {ok,Major} = open_utf8_file(MajorName), {ok,Html} = open_html_file(HtmlName), - {ok,Unexpected} = open_html_file(UnexpectedName), - test_server_io:set_fd(major, Major), - test_server_io:set_fd(html, Html), - test_server_io:set_fd(unexpected_io, Unexpected), {UnexpHeader,UnexpFooter} = case test_server_sup:framework_call(get_html_wrapper, @@ -1663,8 +1655,17 @@ start_log_file() -> {xhtml,UH,UF} -> {UH,UF} end, - io:put_chars(Unexpected, UnexpHeader++"\n<pre>\n"), - put(test_server_unexpected_footer,UnexpFooter), + + {ok,Unexpected} = open_html_file(UnexpectedName), + io:put_chars(Unexpected, [UnexpHeader, + xhtml("<br>\n<h2>Unexpected I/O</h2>", + "<br />\n<h3>Unexpected I/O</h3>"), + "\n<pre>\n"]), + put(test_server_unexpected_footer,{UnexpectedName,UnexpFooter}), + + test_server_io:set_fd(major, Major), + test_server_io:set_fd(html, Html), + test_server_io:set_fd(unexpected_io, Unexpected), make_html_link(filename:absname(?last_test ++ ?html_ext), HtmlName, filename:basename(Dir)), @@ -5299,6 +5300,9 @@ html_header(Title) -> open_html_file(File) -> open_utf8_file(File). +open_html_file(File,Opts) -> + open_utf8_file(File,Opts). + write_html_file(File,Content) -> write_file(File,Content,utf8). @@ -5307,6 +5311,9 @@ write_html_file(File,Content) -> open_utf8_file(File) -> file:open(File,[write,{encoding,utf8}]). +open_utf8_file(File,Opts) -> + file:open(File,[{encoding,utf8}|Opts]). + %% Write a file with specified encoding write_file(File,Content,latin1) -> file:write_file(File,Content); diff --git a/lib/test_server/src/test_server_h.erl b/lib/test_server/src/test_server_h.erl deleted file mode 100644 index 24063ddb10..0000000000 --- a/lib/test_server/src/test_server_h.erl +++ /dev/null @@ -1,148 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2005-2013. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - --module(test_server_h). --behaviour(gen_event). - -%% API --export([install/0, restore/0]). --export([testcase/1]). - -%% gen_event callbacks --export([init/1, handle_event/2, handle_call/2, - handle_info/2, terminate/2, code_change/3]). - --record(state, {kernel, sasl, testcase}). - -%%==================================================================== -%% API -%%==================================================================== - -install() -> - case gen_event:add_handler(error_logger, ?MODULE, []) of - ok -> - error_logger:delete_report_handler(sasl_report_tty_h), - gen_event:delete_handler(error_logger, error_logger_tty_h, []), - ok; - Error -> - Error - end. - -restore() -> - gen_event:add_handler(error_logger, error_logger_tty_h, []), - error_logger:add_report_handler(sasl_report_tty_h, all), - gen_event:delete_handler(error_logger, ?MODULE, []). - -testcase(Testcase) -> - gen_event:call(error_logger, ?MODULE, {set_testcase, Testcase}, 10*60*1000). - -%%==================================================================== -%% gen_event callbacks -%%==================================================================== - -init([]) -> - - %% error_logger_tty_h initialization - User = set_group_leader(), - - %% sasl_report_tty_h initialization - Type = all, - - {ok, #state{kernel={User, []}, sasl=Type}}. - -set_group_leader() -> - case whereis(user) of - User when is_pid(User) -> - link(User), - group_leader(User, self()), - User; - _ -> - false - end. - -handle_event({_Type, GL, _Msg}, State) when node(GL)/=node() -> - {ok, State}; -handle_event({Tag, _GL, {_Pid, Type, _Report}} = Event, State) -> - SASL = lists:keyfind(sasl, 1, application:which_applications()), - case report_receiver(Tag, Type) of - sasl when SASL /= false -> - {ok,ErrLogType} = application:get_env(sasl, errlog_type), - SReport = sasl_report:format_report(group_leader(), ErrLogType, - tag_event(Event)), - if is_list(SReport) -> - tag(State#state.testcase), - sasl_report_tty_h:handle_event(Event, - State#state.sasl); - true -> %% Report is an atom if no logging is to be done - ignore - end; - sasl -> %% SASL not running - ignore; - kernel -> - tag(State#state.testcase), - error_logger_tty_h:handle_event(Event, State#state.kernel); - none -> - ignore - end, - {ok, State}; -handle_event(_Event, State) -> - {ok, State}. - -handle_call({set_testcase, Testcase}, State) -> - {ok, ok, State#state{testcase=Testcase}}; -handle_call(_Query, _State) -> - {error, bad_query}. - -handle_info({emulator,GL,_Chars}=Event, State) when node(GL)==node() -> - tag(State#state.testcase), - error_logger_tty_h:handle_info(Event, State#state.kernel), - {ok, State}; -handle_info(_Msg, State) -> - {ok, State}. - -terminate(_Reason, _State) -> - ok. - -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - -report_receiver(error_report, supervisor_report) -> sasl; -report_receiver(error_report, crash_report) -> sasl; -report_receiver(info_report, progress) -> sasl; -report_receiver(error, _) -> kernel; -report_receiver(error_report, _) -> kernel; -report_receiver(warning_msg, _) -> kernel; -report_receiver(warning_report, _) -> kernel; -report_receiver(info, _) -> kernel; -report_receiver(info_msg, _) -> kernel; -report_receiver(info_report,Tuple) - when is_tuple(Tuple) andalso - (element(1,Tuple)==ct_connection orelse - element(1,Tuple)==conn_log) -> - none; -report_receiver(info_report, _) -> kernel; -report_receiver(_, _) -> none. - -tag({M,F,A}) when is_atom(M), is_atom(F), is_integer(A) -> - io:format(user, "~n=TESTCASE: ~w:~w/~w", [M,F,A]); -tag(Testcase) -> - io:format(user, "~n=TESTCASE: ~p", [Testcase]). - -tag_event(Event) -> - {calendar:local_time(), Event}. diff --git a/lib/test_server/src/test_server_io.erl b/lib/test_server/src/test_server_io.erl index 73d4468bda..62af3d5b28 100644 --- a/lib/test_server/src/test_server_io.erl +++ b/lib/test_server/src/test_server_io.erl @@ -32,27 +32,39 @@ -export([start_link/0,stop/1,get_gl/1,set_fd/2, start_transaction/0,end_transaction/0, print_buffered/1,print/3,print_unexpected/1, - set_footer/1,set_job_name/1,set_gl_props/1]). + set_footer/1,set_job_name/1,set_gl_props/1, + reset_state/0,finish/0]). -export([init/1,handle_call/3,handle_info/2,terminate/2]). --record(st, {fds, %Singleton fds (gb_tree) - shared_gl :: pid(), %Shared group leader - gls, %Group leaders (gb_set) - io_buffering=false, %I/O buffering - buffered, %Buffered I/O requests - html_footer, %HTML footer - job_name, %Name of current job. - gl_props, %Properties for GL. - stopping +-record(st, {fds, % Singleton fds (gb_tree) + tags=[], % Known tag types + shared_gl :: pid(), % Shared group leader + gls, % Group leaders (gb_set) + io_buffering=false, % I/O buffering + buffered, % Buffered I/O requests + html_footer, % HTML footer + job_name, % Name of current job. + gl_props, % Properties for GL + phase, % Indicates current mode + offline_buffer, % Buffer I/O during startup + stopping, % Reply to when process stopped + pending_ops % Perform when process idle }). start_link() -> - case gen_server:start_link({local,?MODULE}, ?MODULE, [], []) of - {ok,Pid} -> - {ok,Pid}; - Other -> - Other + case whereis(?MODULE) of + undefined -> + case gen_server:start_link({local,?MODULE}, ?MODULE, [], []) of + {ok,Pid} -> + {ok,Pid}; + Other -> + Other + end; + Pid -> + %% already running, reset the state + reset_state(), + {ok,Pid} end. stop(FilesToClose) -> @@ -62,6 +74,9 @@ stop(FilesToClose) -> group_leader(OldGL, self()), ok. +finish() -> + req(finish). + %% get_gl(Shared) -> Pid %% Shared = boolean() %% Pid = pid() @@ -142,19 +157,27 @@ set_footer(Footer) -> req({set_footer,Footer}). %% set_job_name(Name) +%% %% Set a name for the currently running job. The name will be used %% when printing to 'stdout'. %% + set_job_name(Name) -> req({set_job_name,Name}). %% set_gl_props(PropList) +%% %% Set properties for group leader processes. When a group_leader process %% is created, test_server_gl:set_props(PropList) will be called. set_gl_props(PropList) -> req({set_gl_props,PropList}). +%% reset_state +%% +%% Reset the initial state +reset_state() -> + req(reset_state). %%% Internal functions. @@ -167,7 +190,10 @@ init([]) -> buffered=Empty, html_footer="</body>\n</html>\n", job_name="<name not set>", - gl_props=[]}}. + gl_props=[], + phase=starting, + offline_buffer=[], + pending_ops=[]}}. req(Req) -> gen_server:call(?MODULE, Req, infinity). @@ -178,9 +204,24 @@ handle_call({get_gl,false}, _From, #st{gls=Gls,gl_props=Props}=St) -> {reply,Pid,St#st{gls=gb_sets:insert(Pid, Gls)}}; handle_call({get_gl,true}, _From, #st{shared_gl=Shared}=St) -> {reply,Shared,St}; -handle_call({set_fd,Tag,Fd}, _From, #st{fds=Fds0}=St) -> +handle_call({set_fd,Tag,Fd}, _From, #st{fds=Fds0,tags=Tags0, + offline_buffer=OfflineBuff}=St) -> Fds = gb_trees:enter(Tag, Fd, Fds0), - {reply,ok,St#st{fds=Fds}}; + St1 = St#st{fds=Fds,tags=[Tag|lists:delete(Tag, Tags0)]}, + OfflineBuff1 = + if OfflineBuff == [] -> + []; + true -> + %% Fd ready, print anything buffered for associated Tag + lists:filtermap(fun({T,From,Str}) when T == Tag -> + output(From, Tag, Str, St1), + false; + (_) -> + true + end, lists:reverse(OfflineBuff)) + end, + {reply,ok,St1#st{phase=started, + offline_buffer=lists:reverse(OfflineBuff1)}}; handle_call({start_transaction,Pid}, _From, #st{io_buffering=Buffer0, buffered=Buf0}=St) -> Buf = case gb_trees:is_defined(Pid, Buf0) of @@ -213,12 +254,15 @@ handle_call({set_job_name,Name}, _From, St) -> handle_call({set_gl_props,Props}, _From, #st{shared_gl=Shared}=St) -> test_server_gl:set_props(Shared, Props), {reply,ok,St#st{gl_props=Props}}; -handle_call({stop,FdTags}, From, #st{fds=Fds,shared_gl=SGL,gls=Gls0}=St0) -> - St = St0#st{gls=gb_sets:insert(SGL, Gls0),stopping=From}, - gc(St), - %% Give the users of the surviving group leaders some - %% time to finish. - erlang:send_after(2000, self(), stop_group_leaders), +handle_call(reset_state, From, #st{phase=stopping,pending_ops=Ops}=St) -> + %% can't reset during stopping phase, save op for later + Op = fun(NewSt) -> + {_,Result,NewSt1} = handle_call(reset_state, From, NewSt), + {Result,NewSt1} + end, + {noreply,St#st{pending_ops=[{From,Op}|Ops]}}; +handle_call(reset_state, _From, #st{fds=Fds,tags=Tags,gls=Gls, + offline_buffer=OfflineBuff}) -> %% close open log files lists:foreach(fun(Tag) -> case gb_trees:lookup(Tag, Fds) of @@ -227,8 +271,50 @@ handle_call({stop,FdTags}, From, #st{fds=Fds,shared_gl=SGL,gls=Gls0}=St0) -> {value,Fd} -> file:close(Fd) end - end, FdTags), - {noreply,St}. + end, Tags), + GlList = gb_sets:to_list(Gls), + [test_server_gl:stop(GL) || GL <- GlList], + timer:sleep(100), + case lists:filter(fun(GlPid) -> is_process_alive(GlPid) end, GlList) of + [] -> + ok; + _ -> + timer:sleep(2000), + [exit(GL, kill) || GL <- GlList] + end, + Empty = gb_trees:empty(), + {ok,Shared} = test_server_gl:start_link(), + {reply,ok,#st{fds=Empty,shared_gl=Shared,gls=gb_sets:empty(), + io_buffering=gb_sets:empty(), + buffered=Empty, + html_footer="</body>\n</html>\n", + job_name="<name not set>", + gl_props=[], + phase=starting, + offline_buffer=OfflineBuff, + pending_ops=[]}}; +handle_call({stop,FdTags}, From, #st{fds=Fds0,tags=Tags0, + shared_gl=SGL,gls=Gls0}=St0) -> + St = St0#st{gls=gb_sets:insert(SGL, Gls0),phase=stopping,stopping=From}, + gc(St), + %% close open log files + {Fds1,Tags1} = lists:foldl(fun(Tag, {Fds,Tags}) -> + case gb_trees:lookup(Tag, Fds) of + none -> + {Fds,Tags}; + {value,Fd} -> + file:close(Fd), + {gb_trees:delete(Tag, Fds), + lists:delete(Tag, Tags)} + end + end, {Fds0,Tags0}, FdTags), + %% Give the users of the surviving group leaders some + %% time to finish. + erlang:send_after(1000, self(), stop_group_leaders), + {noreply,St#st{fds=Fds1,tags=Tags1}}; +handle_call(finish, From, St) -> + gen_server:reply(From, ok), + {stop,normal,St}. handle_info({'EXIT',Pid,normal}, #st{gls=Gls0,stopping=From}=St) -> Gls = gb_sets:delete_any(Pid, Gls0), @@ -236,22 +322,40 @@ handle_info({'EXIT',Pid,normal}, #st{gls=Gls0,stopping=From}=St) -> true -> %% No more group leaders left. gen_server:reply(From, ok), - {stop,normal,St#st{gls=Gls,stopping=undefined}}; + {noreply,St#st{gls=Gls,phase=stopping,stopping=undefined}}; false -> %% Wait for more group leaders to finish. - {noreply,St#st{gls=Gls}} + {noreply,St#st{gls=Gls,phase=stopping}} end; handle_info({'EXIT',_Pid,Reason}, _St) -> exit(Reason); handle_info(stop_group_leaders, #st{gls=Gls}=St) -> %% Stop the remaining group leaders. - [test_server_gl:stop(GL) || GL <- gb_sets:to_list(Gls)], - erlang:send_after(2000, self(), kill_group_leaders), + GlPids = gb_sets:to_list(Gls), + [test_server_gl:stop(GL) || GL <- GlPids], + timer:sleep(100), + Wait = + case lists:filter(fun(GlPid) -> is_process_alive(GlPid) end, GlPids) of + [] -> 0; + _ -> 2000 + end, + erlang:send_after(Wait, self(), kill_group_leaders), {noreply,St}; -handle_info(kill_group_leaders, #st{gls=Gls,stopping=From}=St) -> +handle_info(kill_group_leaders, #st{gls=Gls,stopping=From, + pending_ops=Ops}=St) -> [exit(GL, kill) || GL <- gb_sets:to_list(Gls)], - gen_server:reply(From, ok), - {stop,normal,St}; + if From /= undefined -> + gen_server:reply(From, ok); + true -> % reply has been sent already + ok + end, + %% we're idle, check if any ops are pending + St1 = lists:foldr(fun({ReplyTo,Op},NewSt) -> + {Result,NewSt1} = Op(NewSt), + gen_server:reply(ReplyTo, Result), + NewSt1 + end, St#st{phase=idle,pending_ops=[]}, Ops), + {noreply,St1}; handle_info(Other, St) -> io:format("Ignoring: ~p\n", [Other]), {noreply,St}. @@ -259,11 +363,19 @@ handle_info(Other, St) -> terminate(_, _) -> ok. -output(From, Tag, Str, #st{io_buffering=Buffered,buffered=Buf0}=St) -> +output(From, Tag, Str, #st{io_buffering=Buffered,buffered=Buf0, + phase=Phase,offline_buffer=OfflineBuff}=St) -> case gb_sets:is_member(From, Buffered) of false -> - do_output(Tag, Str, St), - St; + case do_output(Tag, Str, Phase, St) of + buffer when length(OfflineBuff)>500 -> + %% something's wrong, clear buffer + St#st{offline_buffer=[]}; + buffer -> + St#st{offline_buffer=[{Tag,From,Str}|OfflineBuff]}; + _ -> + St + end; true -> Q0 = gb_trees:get(From, Buf0), Q = queue:in({Tag,Str}, Q0), @@ -271,17 +383,19 @@ output(From, Tag, Str, #st{io_buffering=Buffered,buffered=Buf0}=St) -> St#st{buffered=Buf} end. -do_output(stdout, Str, #st{job_name=undefined}) -> +do_output(stdout, Str, _, #st{job_name=undefined}) -> io:put_chars(Str); -do_output(stdout, Str0, #st{job_name=Name}) -> +do_output(stdout, Str0, _, #st{job_name=Name}) -> Str = io_lib:format("Testing ~ts: ~ts\n", [Name,Str0]), io:put_chars(Str); -do_output(Tag, Str, #st{fds=Fds}=St) -> +do_output(Tag, Str, Phase, #st{fds=Fds}=St) -> case gb_trees:lookup(Tag, Fds) of + none when Phase /= started -> + buffer; none -> S = io_lib:format("\n*** ERROR: ~w, line ~w: No known '~p' log file\n", [?MODULE,?LINE,Tag]), - do_output(stdout, [S,Str], St); + do_output(stdout, [S,Str], Phase, St); {value,Fd} -> try io:put_chars(Fd, Str), @@ -293,14 +407,14 @@ do_output(Tag, Str, #st{fds=Fds}=St) -> S = io_lib:format("\n*** ERROR: ~w, line ~w: Error writing to " "log file '~p': ~p\n", [?MODULE,?LINE,Tag,Error]), - do_output(stdout, [S,Str], St) + do_output(stdout, [S,Str], Phase, St) end end. finalise_table(Fd, #st{html_footer=Footer}) -> case file:position(Fd, {cur,0}) of {ok,Pos} -> - %% We are writing to a seekable file. Finalise so + %% We are writing to a seekable file. Finalise so %% we get complete valid (and viewable) HTML code. %% Then rewind to overwrite the finalising code. io:put_chars(Fd, ["\n</table>\n",Footer]), @@ -319,7 +433,7 @@ do_print_buffered(Q0, St) -> eot -> Q; {Tag,Str} -> - do_output(Tag, Str, St), + do_output(Tag, Str, undefined, St), do_print_buffered(Q, St) end. diff --git a/lib/test_server/src/ts.erl b/lib/test_server/src/ts.erl index 8e71c69d35..189a71a8ce 100644 --- a/lib/test_server/src/ts.erl +++ b/lib/test_server/src/ts.erl @@ -622,7 +622,7 @@ run_test(File, Args, Options) -> run_test(File, Args, Options, Vars) -> ts_run:run(File, Args, Options, Vars). - + %% This module provides some convenient shortcuts to running %% the test server from within a started Erlang shell. %% (This are here for backwards compatibility.) diff --git a/lib/test_server/vsn.mk b/lib/test_server/vsn.mk index 1753bbb913..0e37512dc2 100644 --- a/lib/test_server/vsn.mk +++ b/lib/test_server/vsn.mk @@ -1 +1 @@ -TEST_SERVER_VSN = 3.6.2 +TEST_SERVER_VSN = 3.6.3 diff --git a/lib/tools/doc/src/notes.xml b/lib/tools/doc/src/notes.xml index 422d4538a6..d8239460b3 100644 --- a/lib/tools/doc/src/notes.xml +++ b/lib/tools/doc/src/notes.xml @@ -30,6 +30,37 @@ </header> <p>This document describes the changes made to the Tools application.</p> +<section><title>Tools 2.6.12</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Remove trailing spaces in Emacs templates. Thanks to + Roberto Aloi.</p> + <p> + Own Id: OTP-11198</p> + </item> + <item> + <p> + Fixed the Emacs erlang-mode to accommodate the coding + style where lists written across several lines have each + line starting with a comma. Thanks to Magnus Henoch.</p> + <p> + Own Id: OTP-11242</p> + </item> + <item> + <p> + Make the Emacs Erlang mode TRAMP-aware when compiling. + Thanks to Tomas Abrahamsson.</p> + <p> + Own Id: OTP-11270</p> + </item> + </list> + </section> + +</section> + <section><title>Tools 2.6.11</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/tools/emacs/erlang-start.el b/lib/tools/emacs/erlang-start.el index e1dc86621e..76e0575e68 100644 --- a/lib/tools/emacs/erlang-start.el +++ b/lib/tools/emacs/erlang-start.el @@ -52,7 +52,7 @@ ;; ;; To set the variable you can use the following command: ;; M-x set-variable RET debug-on-error RET t RET - + ;;; Code: ;; diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 624042204c..b8699a616d 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -1025,7 +1025,7 @@ behaviour.") (defvar erlang-mode-syntax-table nil "Syntax table in use in Erlang-mode buffers.") - + (defvar erlang-skel-file "erlang-skels" "The type of erlang-skeletons that should be used, default @@ -1272,7 +1272,7 @@ Unfortunately, XEmacs hasn't got support for a special Font Lock syntax table. The effect is that `apply' in the atom `foo_apply' will be highlighted as a bif.") - + ;;; Avoid errors while compiling this file. ;; `eval-when-compile' is not defined in Emacs 18. We define it as a @@ -1321,7 +1321,7 @@ Lock syntax table. The effect is that `apply' in the atom (require 'tempo) (require 'compile)))) - + (defun erlang-version () "Return the current version of Erlang mode." (interactive) @@ -1516,7 +1516,7 @@ Other commands: (set (make-local-variable 'outline-level) (lambda () 1)) (set (make-local-variable 'add-log-current-defun-function) 'erlang-current-defun)) - + (defun erlang-font-lock-init () "Initialize Font Lock for Erlang mode." (or erlang-font-lock-syntax-table @@ -1686,7 +1686,7 @@ plus variables, macros and records." (font-lock-mode 1) (funcall (symbol-function 'font-lock-fontify-buffer))) - + (defun erlang-menu-init () "Init menus for Erlang mode. @@ -1905,7 +1905,7 @@ Example: The new menu is returned. No guarantee is given that the original menu is left unchanged." (delq entry items)) - + ;; Man code: (defun erlang-man-init () @@ -2228,7 +2228,7 @@ For example: After installing the line, kill and restart Emacs, or restart Erlang mode with the command `M-x erlang-mode RET'."))) - + ;; Skeleton code: ;; This code is based on the package `tempo' which is part of modern @@ -2349,7 +2349,7 @@ The first character of DD is space if the value is less than 10." (erlang-string-to-int (substring date 8 10)) (substring date 4 7) (substring date -4)))) - + ;; Indentation code: (defun erlang-indent-command (&optional whole-exp) @@ -3132,7 +3132,7 @@ commands." (skip-chars-backward " \t") (max (if (bolp) 0 (1+ (current-column))) comment-column))))) - + ;;; Erlang movement commands ;; All commands below work as movement commands. I.e. if the point is @@ -3336,7 +3336,7 @@ With negative argument go towards the beginning of the buffer." (forward-sexp 1) (buffer-substring start (point))))) - + ;;; Miscellaneous (defun erlang-fill-paragraph (&optional justify) @@ -3445,7 +3445,7 @@ at the end." (error "Can't clone argument list")) (insert args) (set-mark p))) - + ;;; Information retrieval functions. (defun erlang-buffer-substring (beg end) @@ -3772,7 +3772,7 @@ exported function." (store-match-data old-match-data) (member (cons name arity) exports)))) - + ;;; Check module name ;; The function `write-file', bound to C-x C-w, calls @@ -3835,7 +3835,7 @@ This function is normally placed in the hook `local-write-file-hooks'." ;; Must return nil since it is added to `local-write-file-hook'. nil) - + ;;; Electric functions. (defun erlang-electric-semicolon (&optional arg) @@ -4229,7 +4229,7 @@ This function is designed to be a member of a criteria list." (erlang-skip-blank) (looking-at "end[^_a-zA-Z0-9]"))) - + ;; Erlang tags support which is aware of erlang modules. ;; ;; Not yet implemented under XEmacs. (Hint: The Emacs 19 etags @@ -4539,7 +4539,7 @@ Tags can be given on the forms `tag', `module:', `module:tag'." (or default (error "There is no default tag")) spec))))) - + ;; Search tag functions which are aware of Erlang modules. The tactic ;; is to store new search functions into the local variables of the ;; TAGS buffers. The variables are restored directly after the @@ -4715,7 +4715,7 @@ for a tag on the form `module:tag'." (string= mod (erlang-get-module-from-file-name (file-of-tag))))))) - + ;;; Tags completion, Emacs 19 `etags' specific. ;;; ;;; The basic idea is to create a second completion table `erlang-tags- @@ -4834,7 +4834,7 @@ about Erlang modules." ;; Only the first one will be stored in the table. (intern (concat module ":") table)))))) table)) - + ;;; ;;; Prepare for other methods to run an Erlang slave process. ;;; @@ -4916,7 +4916,7 @@ future, a new shell on an already running host will be started." (call-interactively erlang-next-error-function)) - + ;;; ;;; Erlang Shell Mode -- Major mode used for Erlang shells. ;;; @@ -5052,7 +5052,7 @@ Selects Comint or Compilation mode command as appropriate." (define-key map "\M-\C-m" 'compile-goto-error) (unless inferior-erlang-use-cmm (define-key map "\C-x`" 'erlang-next-error))) - + ;;; ;;; Inferior Erlang -- Run an Erlang shell as a subprocess. ;;; diff --git a/lib/tools/src/tags.erl b/lib/tools/src/tags.erl index 1c72ef8db5..e3cc51cdb2 100644 --- a/lib/tools/src/tags.erl +++ b/lib/tools/src/tags.erl @@ -292,7 +292,7 @@ word_char(C) when C >= $0, C =< $9 -> true; word_char($_) -> true; word_char(_) -> false. - + %%% Output routines %% Check the options `outfile' and `outdir'. @@ -323,7 +323,7 @@ genout(Os, Name, Entries) -> io:put_chars(Os, lists:reverse(Entries)). - + %%% help routines %% Flatten and reverse a nested list. diff --git a/lib/tools/test/eprof_SUITE_data/eed.erl b/lib/tools/test/eprof_SUITE_data/eed.erl index 520c5f3dd1..5f2a21aa60 100644 --- a/lib/tools/test/eprof_SUITE_data/eed.erl +++ b/lib/tools/test/eprof_SUITE_data/eed.erl @@ -146,7 +146,7 @@ format_error({'EXIT', {Code, {Mod, Func, Args}}}) -> [{Code, {Mod, Func, length(Args)}}])); format_error(A) -> atom_to_list(A). - + %%% Parsing commands. @@ -327,7 +327,7 @@ when 0 =< Num1, Num1 =< Num2, Num2 =< State#state.lines -> check_lines(_, _, _, _) -> error(bad_linenum). - + %%% Executing commands. %% ($)= - print line number @@ -657,7 +657,7 @@ undo_command(_, _, _) -> write_command(_Cmd, [_First, _Last], _St) -> error(not_implemented). - + %%% Primitive buffer operations. print_current(St) -> @@ -717,7 +717,7 @@ wrap_next_line(State) when State#state.dot == State#state.lines -> wrap_next_line(State) -> next_line(State). - + %%% Utilities. get_pattern(End, Cmd, State) -> diff --git a/lib/tools/vsn.mk b/lib/tools/vsn.mk index a30b16fc49..c51b833dd0 100644 --- a/lib/tools/vsn.mk +++ b/lib/tools/vsn.mk @@ -1 +1 @@ -TOOLS_VSN = 2.6.11 +TOOLS_VSN = 2.6.12 diff --git a/lib/wx/vsn.mk b/lib/wx/vsn.mk index 1c406ccec6..869ed99f16 100644 --- a/lib/wx/vsn.mk +++ b/lib/wx/vsn.mk @@ -1 +1 @@ -WX_VSN = 1.0 +WX_VSN = 1.1 diff --git a/lib/xmerl/doc/src/notes.xml b/lib/xmerl/doc/src/notes.xml index 90b633d1eb..a126f476bb 100644 --- a/lib/xmerl/doc/src/notes.xml +++ b/lib/xmerl/doc/src/notes.xml @@ -31,6 +31,22 @@ <p>This document describes the changes made to the Xmerl application.</p> +<section><title>Xmerl 1.3.4</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Fixed various typos in xmerl documentation. Thanks to + David Welton.</p> + <p> + Own Id: OTP-11224</p> + </item> + </list> + </section> + +</section> + <section><title>Xmerl 1.3.3</title> <section><title>Improvements and New Features</title> diff --git a/lib/xmerl/src/xmerl_regexp.erl b/lib/xmerl/src/xmerl_regexp.erl index 0c53e6f34a..9303bdb125 100644 --- a/lib/xmerl/src/xmerl_regexp.erl +++ b/lib/xmerl/src/xmerl_regexp.erl @@ -593,7 +593,7 @@ sub_first_match(S, {regexp,RE}) -> nomatch -> nomatch end. - + %% This is the regular expression grammar used. It is equivalent to the %% one used in AWK, except that we allow ^ $ to be used anywhere and fail %% in the matching. @@ -961,7 +961,7 @@ re_apply_or(never_match, R2) -> R2; re_apply_or(R1, never_match) -> R1; re_apply_or(nomatch, R2) -> R2; re_apply_or(R1, nomatch) -> R1. - + %% Record definitions for the NFA, DFA and compiler. -record(nfa_state, {no,edges=[],accept=no}). @@ -1026,7 +1026,7 @@ parse_reas([{RegExp,A}|REAs], S) -> {error,E} -> {error,E} end; parse_reas([], Stack) -> {ok,reverse(Stack)}. - + %% build_combined_nfa(RegExpActionList) -> {NFA,StartState}. %% Build the combined NFA using Thompson's construction straight out %% of the book. Build the separate NFAs in the same order as the @@ -1147,7 +1147,7 @@ nfa_comp_class(Cc) -> comp_crs([{C1,C2}|Crs], Last) -> [{Last,C1-1}|comp_crs(Crs, C2+1)]; comp_crs([], Last) -> [{Last,maxchar}]. - + %% build_dfa(NFA, NfaStartState) -> {DFA,DfaStartState}. %% Build a DFA from an NFA using "subset construction". The major %% difference from the book is that we keep the marked and unmarked @@ -1282,7 +1282,7 @@ accept([St|Sts], NFA) -> #nfa_state{accept=no} -> accept(Sts, NFA) end; accept([], _NFA) -> no. - + %% minimise_dfa(DFA, StartState, FirstState) -> {DFA,StartState}. %% Minimise the DFA by removing equivalent states. We consider a %% state if both the transitions and the their accept state is the @@ -1331,7 +1331,7 @@ pack_dfa([D|DFA], NewN, Rs, PDFA) -> pack_dfa(DFA, NewN+1, [{D#dfa_state.no,NewN}|Rs], [D#dfa_state{no=NewN}|PDFA]); pack_dfa([], _NewN, Rs, PDFA) -> {PDFA,Rs}. - + %% comp_apply(String, StartPos, DFAReg) -> {match,RestPos,Rest} | nomatch. %% Apply the DFA of a regular expression to a string. If %% there is a match return the position of the remaining string and diff --git a/lib/xmerl/vsn.mk b/lib/xmerl/vsn.mk index de809e8ce0..af372d8248 100644 --- a/lib/xmerl/vsn.mk +++ b/lib/xmerl/vsn.mk @@ -1 +1 @@ -XMERL_VSN = 1.3.3 +XMERL_VSN = 1.3.4 |