aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/Makefile44
-rw-r--r--lib/asn1/src/Makefile5
-rw-r--r--lib/asn1/src/asn1_db.erl116
-rw-r--r--lib/asn1/src/asn1ct.erl69
-rw-r--r--lib/asn1/src/asn1ct_check.erl67
-rw-r--r--lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl46
-rw-r--r--lib/asn1/src/asn1ct_constructed_per.erl1125
-rw-r--r--lib/asn1/src/asn1ct_eval_per.funcs2
-rw-r--r--lib/asn1/src/asn1ct_eval_uper.funcs2
-rw-r--r--lib/asn1/src/asn1ct_func.erl65
-rw-r--r--lib/asn1/src/asn1ct_gen.erl53
-rw-r--r--lib/asn1/src/asn1ct_gen_ber_bin_v2.erl38
-rw-r--r--lib/asn1/src/asn1ct_gen_per.erl921
-rw-r--r--lib/asn1/src/asn1ct_gen_per_rt2ct.erl461
-rw-r--r--lib/asn1/src/asn1ct_imm.erl1470
-rw-r--r--lib/asn1/src/asn1ct_value.erl8
-rw-r--r--lib/asn1/src/asn1rtt_ber.erl3
-rw-r--r--lib/asn1/src/asn1rtt_per.erl876
-rw-r--r--lib/asn1/src/asn1rtt_per_common.erl333
-rw-r--r--lib/asn1/src/asn1rtt_real_common.erl6
-rw-r--r--lib/asn1/src/asn1rtt_uper.erl915
-rw-r--r--lib/asn1/test/Makefile1
-rw-r--r--lib/asn1/test/asn1_SUITE.erl79
-rw-r--r--lib/asn1/test/asn1_SUITE_data/Fragmented.asn124
-rw-r--r--lib/asn1/test/asn1_SUITE_data/InfObj.asn47
-rw-r--r--lib/asn1/test/asn1_SUITE_data/Param.asn122
-rw-r--r--lib/asn1/test/asn1_SUITE_data/SeqOf.asn139
-rw-r--r--lib/asn1/test/asn1_SUITE_data/TConstr.asn134
-rw-r--r--lib/asn1/test/error_SUITE.erl47
-rw-r--r--lib/asn1/test/testDeepTConstr.erl28
-rw-r--r--lib/asn1/test/testFragmented.erl42
-rw-r--r--lib/asn1/test/testInfObj.erl62
-rw-r--r--lib/asn1/test/testParameterizedInfObj.erl10
-rw-r--r--lib/asn1/test/testPrimStrings.erl51
-rw-r--r--lib/asn1/test/testSeqOf.erl26
-rw-r--r--lib/common_test/src/ct_hooks.erl7
-rw-r--r--lib/common_test/src/ct_logs.erl74
-rw-r--r--lib/common_test/src/ct_run.erl2
-rw-r--r--lib/common_test/src/ct_util.erl54
-rw-r--r--lib/common_test/src/cth_log_redirect.erl141
-rw-r--r--lib/common_test/test/Makefile1
-rw-r--r--lib/common_test/test/ct_gen_conn_SUITE_data/proto.erl25
-rw-r--r--lib/common_test/test/ct_hooks_SUITE.erl49
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_SUITE.erl124
-rw-r--r--lib/common_test/test/ct_pre_post_test_io_SUITE.erl252
-rw-r--r--lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl104
-rw-r--r--lib/common_test/test/ct_pre_post_test_io_SUITE_data/dummy_SUITE.erl132
-rw-r--r--lib/common_test/test/ct_test_support.erl21
-rwxr-xr-x[-rw-r--r--]lib/compiler/src/genop.tab244
-rw-r--r--lib/erl_interface/src/Makefile.in4
-rw-r--r--lib/erl_interface/test/ei_decode_encode_SUITE.erl2
-rw-r--r--lib/ic/c_src/Makefile.in4
-rw-r--r--lib/inets/test/Makefile2
-rw-r--r--lib/inets/test/httpc_SUITE_data/ssl_client_cert.pem45
-rw-r--r--lib/inets/test/httpc_SUITE_data/ssl_server_cert.pem45
-rw-r--r--lib/inets/test/httpd_SUITE.erl2
-rw-r--r--lib/inets/test/httpd_SUITE_data/server_root/ssl/ssl_client.pem45
-rw-r--r--lib/inets/test/httpd_SUITE_data/server_root/ssl/ssl_server.pem45
-rw-r--r--lib/inets/test/httpd_basic_SUITE.erl63
l---------lib/inets/test/httpd_basic_SUITE_data/printenv.bat1
l---------lib/inets/test/httpd_basic_SUITE_data/printenv.sh1
-rw-r--r--lib/inets/test/httpd_mod.erl15
-rw-r--r--lib/inets/test/httpd_test_lib.erl2
-rw-r--r--lib/kernel/doc/src/inet.xml53
-rw-r--r--lib/kernel/src/inet.erl105
-rw-r--r--lib/kernel/src/inet_int.hrl1
-rw-r--r--lib/kernel/test/inet_SUITE.erl99
-rw-r--r--lib/odbc/test/odbc_connect_SUITE.erl2
-rw-r--r--lib/parsetools/doc/src/leex.xml16
-rw-r--r--lib/parsetools/src/leex.erl10
-rw-r--r--lib/parsetools/src/yecc.erl12
-rw-r--r--lib/parsetools/test/leex_SUITE.erl66
-rw-r--r--lib/parsetools/test/yecc_SUITE.erl63
-rw-r--r--lib/public_key/asn1/PKCS-7.asn176
-rw-r--r--lib/public_key/src/pubkey_pbe.erl12
-rw-r--r--lib/public_key/src/public_key.erl7
-rw-r--r--lib/public_key/test/pbe_SUITE.erl8
-rw-r--r--lib/public_key/test/pbe_SUITE_data/aes_128_cbc_enc_key30
-rw-r--r--lib/public_key/test/public_key_SUITE.erl67
-rw-r--r--lib/public_key/test/public_key_SUITE_data/pkcs7_ext.pem62
-rw-r--r--lib/ssl/src/ssl_cipher.erl21
-rw-r--r--lib/ssl/src/tls_connection.erl121
-rw-r--r--lib/ssl/src/tls_handshake.erl130
-rw-r--r--lib/ssl/test/Makefile1
-rw-r--r--lib/ssl/test/ssl_ECC_SUITE.erl225
-rw-r--r--lib/ssl/test/ssl_ECC_SUITE_data/CA.pem14
-rw-r--r--lib/ssl/test/ssl_ECC_SUITE_data/ec1.crt11
-rw-r--r--lib/ssl/test/ssl_ECC_SUITE_data/ec1.key8
-rw-r--r--lib/ssl/test/ssl_ECC_SUITE_data/ec2.crt11
-rw-r--r--lib/ssl/test/ssl_ECC_SUITE_data/ec2.key8
-rw-r--r--lib/ssl/test/ssl_ECC_SUITE_data/rsa1.crt20
-rw-r--r--lib/ssl/test/ssl_ECC_SUITE_data/rsa1.key51
-rw-r--r--lib/ssl/test/ssl_ECC_SUITE_data/rsa2.crt20
-rw-r--r--lib/ssl/test/ssl_ECC_SUITE_data/rsa2.key51
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl13
-rw-r--r--lib/ssl/test/ssl_test_lib.erl42
-rw-r--r--lib/ssl/test/ssl_to_openssl_SUITE.erl94
-rw-r--r--lib/stdlib/src/erl_lint.erl44
-rw-r--r--lib/stdlib/test/erl_lint_SUITE.erl54
-rw-r--r--lib/test_server/src/Makefile1
-rw-r--r--lib/test_server/src/test_server.app.src1
-rw-r--r--lib/test_server/src/test_server.erl1
-rw-r--r--lib/test_server/src/test_server_ctrl.erl45
-rw-r--r--lib/test_server/src/test_server_h.erl148
-rw-r--r--lib/test_server/src/test_server_io.erl200
105 files changed, 6126 insertions, 4541 deletions
diff --git a/lib/Makefile b/lib/Makefile
index 9ddf3a0544..47a6d5f9aa 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 BOOTSTRAP
@@ -45,13 +57,17 @@ 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
+# 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/src/Makefile b/lib/asn1/src/Makefile
index 33cd3cc4c3..3f24e15c04 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 \
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..eddcda0018 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,[]).
@@ -6798,7 +6826,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 +6895,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..8359b81b33 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}})
@@ -1213,22 +1209,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..8d4afc0a0b 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,13 @@ 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'{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, _) ->
lists:reverse(Acc).
%%%%%%%%%%%%%%%%%%%%%%
@@ -858,33 +836,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 +869,48 @@ 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} ->
+ asn1ct_imm:enc_absent(Element, [asn1_DEFAULT,Def], 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}.
+
+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 +918,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 +1174,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'{
@@ -1350,25 +1353,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 +1385,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 +1417,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 +1437,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 +1468,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 +1510,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 +1661,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 +1674,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 +1741,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..e6ec0cb12b 100644
--- a/lib/asn1/src/asn1ct_gen.erl
+++ b/lib/asn1/src/asn1ct_gen.erl
@@ -798,7 +798,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 +824,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 +835,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(),
@@ -916,15 +923,23 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) ->
{["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,
+ "try ",Call," of",nl,
+ case erule(Erules) of
+ ber ->
+ [" {Bytes,_Len} ->",nl,
+ " {ok,",BytesAsBinary,"}",nl];
+ per ->
+ [" Bytes ->",nl,
+ " {ok,",BytesAsBinary,"}",nl]
+ end,
+ " 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.",nl,nl]),
Return_rest = lists:member(undec_rest,get(encoding_options)),
@@ -999,7 +1014,7 @@ 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}).
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..892178f61b 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,285 @@ 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,Def}, _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_DEFAULT},Zero],
+ [{eq,Val,Def},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, AbsVals, Body) ->
+ {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 +952,1164 @@ 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(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) ->
+ 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_value.erl b/lib/asn1/src/asn1ct_value.erl
index ecdfa3f645..992210232f 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);
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_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..9e9fd87ec3 100644
--- a/lib/asn1/src/asn1rtt_per_common.erl
+++ b/lib/asn1/src/asn1rtt_per_common.erl
@@ -28,7 +28,16 @@
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,
+ extension_bitmap/3]).
-define('16K',16384).
@@ -90,6 +99,182 @@ 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).
+
+
+extension_bitmap(Val, Pos, Limit) ->
+ extension_bitmap(Val, Pos, Limit, 0).
+
%%%
%%% Internal functions.
%%%
@@ -124,3 +309,149 @@ 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).
+
+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/test/Makefile b/lib/asn1/test/Makefile
index 15b97df972..a3fa4f2968 100644
--- a/lib/asn1/test/Makefile
+++ b/lib/asn1/test/Makefile
@@ -82,6 +82,7 @@ MODULES= \
testInfObjectClass \
testInfObj \
testParameterizedInfObj \
+ testFragmented \
testMergeCompile \
testMultipleLevels \
testDeepTConstr \
diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl
index f00b23a8b2..9a149a495a 100644
--- a/lib/asn1/test/asn1_SUITE.erl
+++ b/lib/asn1/test/asn1_SUITE.erl
@@ -150,6 +150,7 @@ groups() ->
per_open_type,
testInfObjectClass,
testParameterizedInfObj,
+ testFragmented,
testMergeCompile,
testobj,
testDeepTConstr,
@@ -186,8 +187,7 @@ groups() ->
{performance, [],
[testTimer_ber,
testTimer_per,
- testTimer_uper,
- smp]}].
+ testTimer_uper]}].
parallel(Options) ->
case erlang:system_info(smp_support) andalso
@@ -360,7 +360,8 @@ testPrimStrings_cases(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) ->
@@ -452,7 +453,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",
@@ -830,6 +831,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",
@@ -1230,70 +1237,6 @@ ticket_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,[],[]) ->
- ok.
-
-record('InitiatingMessage',{procedureCode,criticality,value}).
-record('Iu-ReleaseCommand',{first,second}).
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/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/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/testDeepTConstr.erl b/lib/asn1/test/testDeepTConstr.erl
index f17dedc043..620b5f3356 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,6 +69,21 @@ 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.
@@ -77,3 +91,13 @@ roundtrip(M, T, V) ->
{ok,E} = M:encode(T, V),
{ok,V} = M:decode(T, E),
ok.
+
+%% 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/testFragmented.erl b/lib/asn1/test/testFragmented.erl
new file mode 100644
index 0000000000..c391ba8305
--- /dev/null
+++ b/lib/asn1/test/testFragmented.erl
@@ -0,0 +1,42 @@
+%%
+%% %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) ->
+ {ok,E} = 'Fragmented':encode(T, V),
+ {ok,V} = 'Fragmented':decode(T, E),
+ ok.
diff --git a/lib/asn1/test/testInfObj.erl b/lib/asn1/test/testInfObj.erl
index c7b19a0cbb..76f216fdad 100644
--- a/lib/asn1/test/testInfObj.erl
+++ b/lib/asn1/test/testInfObj.erl
@@ -59,13 +59,73 @@ 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),
{ok,V} = M:decode(T, Enc),
ok.
+
+enc_dec(M, T, V0) ->
+ {ok,Enc} = M:encode(T, V0),
+ {ok,V} = M:decode(T, Enc),
+ V.
diff --git a/lib/asn1/test/testParameterizedInfObj.erl b/lib/asn1/test/testParameterizedInfObj.erl
index 1dfa52f401..02847e502b 100644
--- a/lib/asn1/test/testParameterizedInfObj.erl
+++ b/lib/asn1/test/testParameterizedInfObj.erl
@@ -86,8 +86,18 @@ param(Erule) ->
asn1_wrapper:encode('Param','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) ->
+ {ok,Enc} = 'Param':encode(T, V),
+ {ok,V} = 'Param':decode(T, Enc),
ok.
+
ranap(_Erule) ->
PIEVal2 = [{'ProtocolIE-Field',4,ignore,{radioNetwork,'rab-pre-empted'}}],
?line Val2 =
diff --git a/lib/asn1/test/testPrimStrings.erl b/lib/asn1/test/testPrimStrings.erl
index e2322c92a9..1762e34599 100644
--- a/lib/asn1/test/testPrimStrings.erl
+++ b/lib/asn1/test/testPrimStrings.erl
@@ -28,9 +28,46 @@
-export([bmp_string/1]).
-export([times/1]).
-export([utf8_string/1]).
+-export([fragmented/1]).
-include_lib("test_server/include/test_server.hrl").
+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) ->
%%==========================================================
@@ -311,8 +348,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 +359,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),
diff --git a/lib/asn1/test/testSeqOf.erl b/lib/asn1/test/testSeqOf.erl
index db537b1478..c50cc27f6f 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'{}]}),
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..11af1aa346 100644
--- a/lib/common_test/src/cth_log_redirect.erl
+++ b/lib/common_test/src/cth_log_redirect.erl
@@ -25,16 +25,29 @@
%% 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]).
+%% Other
+-export([handle_remote_events/1]).
+
-include("ct.hrl").
+-record(eh_state, {log_func,
+ curr_suite,
+ curr_group,
+ curr_func,
+ parallel_tcs = false,
+ handle_remote_events = false}).
+
id(_Opts) ->
?MODULE.
@@ -42,36 +55,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 +119,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,20 +128,50 @@ 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(_,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}.
+
+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(_State) ->
error_logger:delete_report_handler(?MODULE),
@@ -110,5 +180,48 @@ terminate(_State) ->
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]).
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..84341a0b99
--- /dev/null
+++ b/lib/common_test/test/ct_pre_post_test_io_SUITE.erl
@@ -0,0 +1,252 @@
+%%
+%% %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() ->
+ %% --- test run 1 ---
+ ct:sleep(3000),
+ ct_test_support:ct_rpc({cth_log_redirect,
+ handle_remote_events,
+ [true]}, Config),
+ ct:sleep(2000),
+ io:format(user, "Starting test run!~n", []),
+ ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config),
+ ct:sleep(6000),
+ io:format(user, "Finishing off!~n", []),
+ ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config),
+ %% --- test run 2 ---
+ ct:sleep(3000),
+ ct_test_support:ct_rpc({cth_log_redirect,
+ handle_remote_events,
+ [true]}, Config),
+ ct:sleep(2000),
+ io:format(user, "Starting test run!~n", []),
+ ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config),
+ ct:sleep(6000),
+ io:format(user, "Finishing off!~n", []),
+ 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..a9ea7b14dd
--- /dev/null
+++ b/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl
@@ -0,0 +1,104 @@
+%%
+%% %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]).
+
+%%%===================================================================
+%%% API
+%%%===================================================================
+
+proceed() ->
+ ?MODULE ! proceed.
+
+%%--------------------------------------------------------------------
+%% Hook functions
+%%--------------------------------------------------------------------
+init(_Id, _Opts) ->
+ case lists:keyfind(sasl, 1, application:which_applications()) of
+ false ->
+ exit(sasl_not_started);
+ _Else ->
+ ok
+ end,
+ WhoAmI = self(),
+ DispPid = spawn_link(fun() -> dispatcher(WhoAmI) end),
+ register(?MODULE, DispPid),
+ io:format(user,
+ "~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) ->
+ io:format(user,
+ "~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/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/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/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/ic/c_src/Makefile.in b/lib/ic/c_src/Makefile.in
index 856823b1b3..6e65f06114 100644
--- a/lib/ic/c_src/Makefile.in
+++ b/lib/ic/c_src/Makefile.in
@@ -149,9 +149,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/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_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..b1fe373cff 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,6 +36,7 @@ all() ->
uri_too_long_414,
header_too_long_413,
erl_script_nocache_opt,
+ script_nocache,
escaped_url_in_error_body,
slowdose
].
@@ -63,6 +65,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 +78,18 @@ DUMMY
</HTML>",
DummyFile = filename:join([PrivDir,"dummy.html"]),
+ CgiDir = filename:join(PrivDir, "cgi-bin"),
+ ok = file:make_dir(CgiDir),
+ Cgi = case test_server:os_type() of
+ {win32, _} ->
+ "printenv.bat";
+ _ ->
+ "printenv.sh"
+ end,
+ 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}),
{ok, Fd} = file:open(DummyFile, [write]),
ok = file:write(Fd, Dummy),
ok = file:close(Fd),
@@ -85,7 +100,7 @@ DUMMY
{document_root, PrivDir},
{bind_address, "localhost"}],
- [{httpd_conf, HttpdConf} | Config].
+ [{httpd_conf, HttpdConf}, {cgi_dir, CgiDir}, {cgi_script, Cgi} | Config].
%%--------------------------------------------------------------------
%% Function: end_per_suite(Config) -> _
@@ -205,6 +220,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_script, 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) ->
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/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml
index 254dfbf034..fd62f778a2 100644
--- a/lib/kernel/doc/src/inet.xml
+++ b/lib/kernel/doc/src/inet.xml
@@ -722,6 +722,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/src/inet.erl b/lib/kernel/src/inet.erl
index 5749027acd..27f085c3aa 100644
--- a/lib/kernel/src/inet.erl
+++ b/lib/kernel/src/inet.erl
@@ -200,7 +200,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 +216,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()}.
@@ -641,6 +659,14 @@ 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;
{Name,Val} when is_atom(Name) -> con_add(Name, Val, R, Opts, As);
_ -> {error, badarg}
end;
@@ -699,6 +725,14 @@ 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;
{Name,Val} when is_atom(Name) -> list_add(Name, Val, R, Opts, As);
_ -> {error, badarg}
end;
@@ -745,6 +779,14 @@ 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;
{Name,Val} when is_atom(Name) -> udp_add(Name, Val, R, Opts, As);
_ -> {error, badarg}
end;
@@ -814,6 +856,17 @@ 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;
{Name,Val} -> sctp_opt (Opts, Mod, R, As, Name, Val);
_ -> {error,badarg}
end;
@@ -858,6 +911,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 +1156,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 +1166,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 +1196,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..18a4a61b2f 100644
--- a/lib/kernel/src/inet_int.hrl
+++ b/lib/kernel/src/inet_int.hrl
@@ -143,6 +143,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/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/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/parsetools/doc/src/leex.xml b/lib/parsetools/doc/src/leex.xml
index d5c24c303d..b4e2af6857 100644
--- a/lib/parsetools/doc/src/leex.xml
+++ b/lib/parsetools/doc/src/leex.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>2009</year><year>2011</year>
+ <year>2009</year><year>2013</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -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 =&nbsp;-&nbsp;see below&nbsp;-</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 =&nbsp;-&nbsp;formatable by format_error/1&nbsp;-</v>
</type>
<desc>
<p>Generates a lexical analyzer from the definition in the input
diff --git a/lib/parsetools/src/leex.erl b/lib/parsetools/src/leex.erl
index e531b78a5b..7039aea1ae 100644
--- a/lib/parsetools/src/leex.erl
+++ b/lib/parsetools/src/leex.erl
@@ -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 afedd79a4e..7cbc72accb 100644
--- a/lib/parsetools/test/leex_SUITE.erl
+++ b/lib/parsetools/test/leex_SUITE.erl
@@ -45,7 +45,7 @@
pt/1, man/1, ex/1, ex2/1, not_yet/1,
- otp_10302/1]).
+ otp_10302/1, otp_11286/1]).
% Default timetrap timeout (set in init_per_testcase).
-define(default_timeout, ?t:minutes(1)).
@@ -67,7 +67,7 @@ all() ->
groups() ->
[{checks, [], [file, compile, syntax]},
{examples, [], [pt, man, ex, ex2, not_yet]},
- {tickets, [], [otp_10302]}].
+ {tickets, [], [otp_10302, otp_11286]}].
init_per_suite(Config) ->
Config.
@@ -983,6 +983,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,
diff --git a/lib/parsetools/test/yecc_SUITE.erl b/lib/parsetools/test/yecc_SUITE.erl
index 9c865a1ec6..c7ac9fd232 100644
--- a/lib/parsetools/test/yecc_SUITE.erl
+++ b/lib/parsetools/test/yecc_SUITE.erl
@@ -49,7 +49,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)).
@@ -77,7 +78,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.
@@ -1996,6 +1997,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/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/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/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl
index ec5d793d65..09aad8e414 100644
--- a/lib/ssl/src/ssl_cipher.erl
+++ b/lib/ssl/src/ssl_cipher.erl
@@ -36,7 +36,7 @@
decipher/5, cipher/5,
suite/1, suites/1, 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).
@@ -1009,6 +1009,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 +1192,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.
+ 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 +1260,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 +1292,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/tls_connection.erl b/lib/ssl/src/tls_connection.erl
index 77f49c5d2a..0415ea6ecc 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
@@ -366,6 +367,7 @@ hello(#hello_request{}, #state{role = client} = State0) ->
next_state(hello, hello, Record, State);
hello(#server_hello{cipher_suite = CipherSuite,
+ hash_signs = HashSign,
compression_method = Compression} = Hello,
#state{session = #session{session_id = OldId},
connection_states = ConnectionStates0,
@@ -388,9 +390,10 @@ hello(#server_hello{cipher_suite = CipherSuite,
_ ->
NextProtocol
end,
-
+
State = State0#state{key_algorithm = KeyAlgorithm,
- hashsign_algorithm = default_hashsign(Version, KeyAlgorithm),
+ hashsign_algorithm =
+ negotiated_hashsign(HashSign, KeyAlgorithm, Version),
negotiated_version = Version,
connection_states = ConnectionStates,
premaster_secret = PremasterSecret,
@@ -406,22 +409,28 @@ hello(#server_hello{cipher_suite = CipherSuite,
end
end;
-hello(Hello = #client_hello{client_version = ClientVersion},
+hello(Hello = #client_hello{client_version = ClientVersion,
+ hash_signs = HashSigns},
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}) ->
+
+ HashSign = tls_handshake:select_hashsign(HashSigns, Cert),
case tls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb,
ConnectionStates0, Cert}, Renegotiation) of
- {Version, {Type, Session}, ConnectionStates, ProtocolsToAdvertise,
+ {Version, {Type, #session{cipher_suite = CipherSuite} = Session}, ConnectionStates, ProtocolsToAdvertise,
EcPointFormats, EllipticCurves} ->
+ {KeyAlgorithm, _, _, _} = ssl_cipher:suite_definition(CipherSuite),
+ NH = negotiated_hashsign(HashSign, KeyAlgorithm, Version),
do_server_hello(Type, ProtocolsToAdvertise,
EcPointFormats, EllipticCurves,
State#state{connection_states = ConnectionStates,
negotiated_version = Version,
session = Session,
+ hashsign_algorithm = NH,
client_ecc = {EllipticCurves, EcPointFormats}});
#alert{} = Alert ->
handle_own_alert(Alert, ClientVersion, hello, State)
@@ -526,7 +535,7 @@ certify(#certificate{} = Cert,
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 +561,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 = tls_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{},
@@ -757,21 +768,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,
+
+ HashSign = tls_handshake:select_cert_hashsign(CertHashSign, Algo, Version),
case tls_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;
@@ -1369,25 +1377,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,
@@ -1414,10 +1431,9 @@ 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,
Version, HashSign, PrivateKey, Handshake0) of
#certificate_verify{} = Verified ->
@@ -1560,8 +1576,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,
@@ -1937,7 +1952,7 @@ 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),
+ Msg = tls_handshake:certificate_request(ConnectionStates0, CertDbHandle, CertDbRef, Version),
{BinMsg, ConnectionStates, Handshake} =
encode_handshake(Msg, Version, ConnectionStates0, Handshake0),
Transport:send(Socket, BinMsg),
@@ -2014,12 +2029,13 @@ 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)
+ 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,
@@ -2995,11 +3011,6 @@ get_pending_connection_state_prf(CStates, Direction) ->
CS = tls_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}) ->
- HashSign.
-
%% RFC 5246, Sect. 7.4.1.4.1. Signature Algorithms
%% If the client does not send the signature_algorithms extension, the
%% server MUST do the following:
@@ -3014,12 +3025,18 @@ connection_hashsign(_, #state{hashsign_algorithm = HashSign}) ->
%% - If the negotiated key exchange algorithm is one of (ECDH_ECDSA,
%% ECDHE_ECDSA), behave as if the client had sent value {sha1,ecdsa}.
+negotiated_hashsign(undefined, Algo, Version) ->
+ default_hashsign(Version, Algo);
+negotiated_hashsign(HashSign = {_, _}, _, _) ->
+ HashSign.
+
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 +3044,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;
@@ -3081,3 +3098,13 @@ 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..6cc6e9e885 100644
--- a/lib/ssl/src/tls_handshake.erl
+++ b/lib/ssl/src/tls_handshake.erl
@@ -34,11 +34,12 @@
-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,
+ certificate_request/4, 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]).
+ decrypt_premaster_secret/2, prf/5, next_protocol/1, select_hashsign/2,
+ select_cert_hashsign/3]).
-export([dec_hello_extensions/2]).
@@ -82,7 +83,7 @@ client_hello(Host, Port, ConnectionStates,
renegotiation_info =
renegotiation_info(client, ConnectionStates, Renegotiation),
srp = SRP,
- hash_signs = default_hash_signs(),
+ hash_signs = advertised_hash_signs(Version),
ec_point_formats = EcPointFormats,
elliptic_curves = EllipticCurves,
next_protocol_negotiation =
@@ -152,7 +153,6 @@ hello(#server_hello{cipher_suite = CipherSuite, server_version = Version,
#ssl_options{secure_renegotiate = SecureRenegotation, next_protocol_selector = NextProtocolSelector,
versions = SupportedVersions},
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,
@@ -177,7 +177,6 @@ hello(#server_hello{cipher_suite = CipherSuite, server_version = Version,
hello(#client_hello{client_version = ClientVersion} = Hello,
#ssl_options{versions = Versions} = SslOpts,
{Port, Session0, Cache, CacheCb, ConnectionStates0, Cert}, Renegotiation) ->
- %% TODO: select hash and signature algorithm
Version = select_version(ClientVersion, Versions),
case tls_record:is_acceptable_version(Version, Versions) of
true ->
@@ -298,7 +297,7 @@ client_certificate_verify(undefined, _, _, _, _, _) ->
client_certificate_verify(_, _, _, _, undefined, _) ->
ignore;
client_certificate_verify(OwnCert, MasterSecret, Version,
- {HashAlgo, SignAlgo},
+ {HashAlgo, _} = HashSign,
PrivateKey, {Handshake, _}) ->
case public_key:pkix_is_fixed_dh_cert(OwnCert) of
true ->
@@ -307,7 +306,7 @@ client_certificate_verify(OwnCert, MasterSecret, Version,
Hashes =
calc_certificate_verify(Version, HashAlgo, MasterSecret, Handshake),
Signed = digitally_signed(Version, Hashes, HashAlgo, PrivateKey),
- #certificate_verify{signature = Signed, hashsign_algorithm = {HashAlgo, SignAlgo}}
+ #certificate_verify{signature = Signed, hashsign_algorithm = HashSign}
end.
%%--------------------------------------------------------------------
@@ -349,17 +348,17 @@ verify_signature(_Version, Hash, {HashAlgo, ecdsa}, Signature, {?'id-ecPublicKey
public_key:verify({digest, Hash}, HashAlgo, Signature, {PublicKey, PublicKeyParams}).
%%--------------------------------------------------------------------
--spec certificate_request(#connection_states{}, db_handle(), certdb_ref()) ->
+-spec certificate_request(#connection_states{}, db_handle(), certdb_ref(), tls_version()) ->
#certificate_request{}.
%%
%% Description: Creates a certificate_request message, called by the server.
%%--------------------------------------------------------------------
-certificate_request(ConnectionStates, CertDbHandle, CertDbRef) ->
+certificate_request(ConnectionStates, CertDbHandle, CertDbRef, Version) ->
#connection_state{security_parameters =
#security_parameters{cipher_suite = CipherSuite}} =
tls_record:pending_connection_state(ConnectionStates, read),
Types = certificate_types(CipherSuite),
- HashSigns = default_hash_signs(),
+ HashSigns = advertised_hash_signs(Version),
Authorities = certificate_authorities(CertDbHandle, CertDbRef),
#certificate_request{
certificate_types = Types,
@@ -687,6 +686,54 @@ prf({3,1}, Secret, Label, Seed, WantedLength) ->
prf({3,_N}, Secret, Label, Seed, WantedLength) ->
{ok, ssl_tls1:prf(?SHA256, Secret, Label, Seed, WantedLength)}.
+
+%%--------------------------------------------------------------------
+-spec select_hashsign(#hash_sign_algos{}| undefined, undefined | term()) ->
+ [{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()) ->
+ [{atom(), atom()}].
+
+%%
+%% Description:
+%%--------------------------------------------------------------------
+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}.
+
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
@@ -1066,7 +1113,7 @@ dec_hs(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary,
cipher_suites = from_2bytes(CipherSuites),
compression_methods = Comp_methods,
renegotiation_info = RenegotiationInfo,
- srp = SRP,
+ srp = SRP,
hash_signs = HashSigns,
elliptic_curves = EllipticCurves,
next_protocol_negotiation = NextProtocolNegotiation
@@ -1179,12 +1226,12 @@ dec_ske_params(Len, Keys, Version) ->
dec_ske_signature(Params, <<?BYTE(HashAlgo), ?BYTE(SignAlgo),
?UINT16(0)>>, {Major, Minor})
- when Major == 3, Minor >= 3 ->
+ 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 ->
+ when Major >= 3, Minor >= 3 ->
HashSign = {ssl_cipher:hash_algorithm(HashAlgo), ssl_cipher:sign_algorithm(SignAlgo)},
{Params, HashSign, Signature};
dec_ske_signature(Params, <<>>, _) ->
@@ -1219,11 +1266,11 @@ dec_server_key(<<?BYTE(?NAMED_CURVE), ?UINT16(CurveID),
params_bin = BinMsg,
hashsign = HashSign,
signature = Signature};
-dec_server_key(<<?UINT16(Len), PskIdentityHint:Len/binary>> = KeyStruct,
+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},
+ hint = PskIdentityHint},
{BinMsg, HashSign, Signature} = dec_ske_params(Len + 2, KeyStruct, Version),
#server_key_params{params = Params,
params_bin = BinMsg,
@@ -1236,8 +1283,8 @@ dec_server_key(<<?UINT16(Len), IdentityHint:Len/binary,
?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},
+ 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,
@@ -1297,16 +1344,14 @@ dec_hello_extensions(<<?UINT16(?SIGNATURE_ALGORITHMS_EXT), ?UINT16(Len),
dec_hello_extensions(<<?UINT16(?ELLIPTIC_CURVES_EXT), ?UINT16(Len),
ExtData:Len/binary, Rest/binary>>, Acc) ->
- EllipticCurveListLen = Len - 2,
- <<?UINT16(EllipticCurveListLen), EllipticCurveList/binary>> = ExtData,
+ <<?UINT16(_), 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,
+ <<?BYTE(_), ECPointFormatList/binary>> = ExtData,
ECPointFormats = binary_to_list(ECPointFormatList),
dec_hello_extensions(Rest, [{ec_point_formats,
#ec_point_formats{ec_point_format_list = ECPointFormats}} | Acc]);
@@ -1755,26 +1800,6 @@ apply_user_fun(Fun, OtpCert, ExtensionOrError, UserState0, SslState) ->
{unknown, {SslState, UserState}}
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,
@@ -1825,3 +1850,26 @@ handle_srp_extension(#srp{username = Username}, Session) ->
int_to_bin(I) ->
L = (length(integer_to_list(I, 16)) + 1) div 2,
<<I:(L*8)>>.
+
+-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/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_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/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl
index 8f07750b9b..f599881c07 100644
--- a/lib/stdlib/src/erl_lint.erl
+++ b/lib/stdlib/src/erl_lint.erl
@@ -1953,12 +1953,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) ->
@@ -2012,8 +2010,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!!
@@ -2111,12 +2108,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};
@@ -2150,10 +2147,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),
@@ -2310,7 +2308,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
@@ -2843,7 +2841,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),
@@ -2856,7 +2856,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}
@@ -2920,7 +2924,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
@@ -3181,6 +3185,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/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl
index 4dc7a44064..48ddeac478 100644
--- a/lib/stdlib/test/erl_lint_SUITE.erl
+++ b/lib/stdlib/test/erl_lint_SUITE.erl
@@ -151,7 +151,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.
@@ -537,7 +546,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.
@@ -1075,7 +1106,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/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.