diff options
Diffstat (limited to 'lib')
862 files changed, 32389 insertions, 17189 deletions
diff --git a/lib/asn1/doc/src/fascicules.xml b/lib/asn1/doc/src/fascicules.xml deleted file mode 100644 index 837b4f57f4..0000000000 --- a/lib/asn1/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/asn1/doc/src/notes.xml b/lib/asn1/doc/src/notes.xml index ae6660c143..1abe983221 100644 --- a/lib/asn1/doc/src/notes.xml +++ b/lib/asn1/doc/src/notes.xml @@ -32,6 +32,31 @@ <p>This document describes the changes made to the asn1 application.</p> +<section><title>Asn1 5.0.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + There was a issue with BER encoding and the + <c>undec_rest</c> option in generated decoders. An + exception could be thrown instead of returning an error + tuple.</p> + <p> + Own Id: OTP-14786 Aux Id: ERL-518 </p> + </item> + <item> + <p> + The asn1ct:test functions crashed on decoders generated + with options <c>no_ok_wrapper</c>, <c>undec_rest</c>.</p> + <p> + Own Id: OTP-14787 Aux Id: ERL-518 </p> + </item> + </list> + </section> + +</section> + <section><title>Asn1 5.0.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index f36d71a601..81a2735a0d 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -1335,25 +1335,39 @@ test_value(Module, Type, Value) -> in_process(fun() -> case catch Module:encode(Type, Value) of {ok, Bytes} -> - NewBytes = prepare_bytes(Bytes), - case Module:decode(Type, NewBytes) of - {ok, Value} -> - {ok, {Module, Type, Value}}; - {ok, Res} -> - {error, {asn1, - {encode_decode_mismatch, - {{Module, Type, Value}, Res}}}}; - Error -> - {error, {asn1, - {{decode, - {Module, Type, Value}, Error}}}} - end; + test_value_decode(Module, Type, Value, Bytes); + Bytes when is_binary(Bytes) -> + test_value_decode(Module, Type, Value, Bytes); Error -> {error, {asn1, {encode, {{Module, Type, Value}, Error}}}} end end). + +test_value_decode(Module, Type, Value, Bytes) -> + NewBytes = prepare_bytes(Bytes), + case Module:decode(Type, NewBytes) of + {ok,Value} -> {ok, {Module,Type,Value}}; + {ok,Value,<<>>} -> {ok, {Module,Type,Value}}; + Value -> {ok, {Module,Type,Value}}; + {Value,<<>>} -> {ok, {Module,Type,Value}}; + + %% Errors: + {ok, Res} -> + {error, {asn1, + {encode_decode_mismatch, + {{Module, Type, Value}, Res}}}}; + {ok, Res, Rest} -> + {error, {asn1, + {encode_decode_mismatch, + {{Module, Type, Value}, {Res,Rest}}}}}; + Error -> + {error, {asn1, + {{decode, + {Module, Type, Value}, Error}}}} + end. + value(Module, Type) -> value(Module, Type, []). value(Module, Type, Includes) -> diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 83d12600b7..321980e5e4 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -1576,13 +1576,15 @@ printable_string_1(#'Externalvaluereference'{value=Type}) -> printable_string_1({Atom,Line}) when is_atom(Atom), is_integer(Line) -> q(Atom); printable_string_1({object,definedsyntax,L}) -> - q(string:join([printable_string_1(Item) || Item <- L], " ")); + Str = lists:join($\s, [printable_string_1(Item) || Item <- L]), + q(lists:flatten(Str)); printable_string_1([_|_]=Def) -> case lists:all(fun is_integer/1, Def) of true -> lists:flatten(io_lib:format("~p", [Def])); false -> - q(string:join([printable_string_1(Item) || Item <- Def], " ")) + Str = lists:join($\s, [printable_string_1(Item) || Item <- Def]), + q(lists:flatten(Str)) end; printable_string_1(Def) -> lists:flatten(io_lib:format("~p", [Def])). diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index 806f8420ec..efbc6d6380 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -707,6 +707,7 @@ gen_exports([_|_]=L0, Prefix, Arity) -> pgen_dispatcher(Erules, []) -> gen_info_functions(Erules); pgen_dispatcher(Gen, Types) -> + %% MODULE HEAD emit(["-export([encode/2,decode/2]).",nl,nl]), gen_info_functions(Gen), @@ -714,6 +715,7 @@ pgen_dispatcher(Gen, Types) -> NoFinalPadding = lists:member(no_final_padding, Options), NoOkWrapper = proplists:get_bool(no_ok_wrapper, Options), + %% ENCODER Call = case Gen of #gen{erule=per,aligned=true} -> asn1ct_func:need({per,complete,1}), @@ -740,6 +742,7 @@ pgen_dispatcher(Gen, Types) -> end, emit([nl,nl]), + %% DECODER ReturnRest = proplists:get_bool(undec_rest, Gen#gen.options), Data = case Gen#gen.erule =:= ber andalso ReturnRest of true -> "Data0"; @@ -747,6 +750,12 @@ pgen_dispatcher(Gen, Types) -> end, emit(["decode(Type, ",Data,") ->",nl]), + + case NoOkWrapper of + false -> emit(["try",nl]); + true -> ok + end, + DecWrap = case {Gen,ReturnRest} of {#gen{erule=ber},false} -> @@ -754,32 +763,38 @@ pgen_dispatcher(Gen, Types) -> "element(1, ber_decode_nif(Data))"; {#gen{erule=ber},true} -> asn1ct_func:need({ber,ber_decode_nif,1}), - emit(["{Data,Rest} = ber_decode_nif(Data0),",nl]), + emit([" {Data,Rest} = ber_decode_nif(Data0),",nl]), "Data"; {_,_} -> "Data" end, - emit([case NoOkWrapper of - false -> "try"; - true -> "case" - end, " decode_disp(Type, ",DecWrap,") of",nl]), - case Gen of - #gen{erule=ber} -> - emit([" Result ->",nl]); - #gen{erule=per} -> - emit([" {Result,Rest} ->",nl]) - end, - case ReturnRest of - false -> result_line(NoOkWrapper, ["Result"]); - true -> result_line(NoOkWrapper, ["Result","Rest"]) + + DecodeDisp = ["decode_disp(Type, ",DecWrap,")"], + case {Gen,ReturnRest} of + {#gen{erule=ber},true} -> + emit([" Result = ",DecodeDisp,",",nl]), + result_line(NoOkWrapper, ["Result","Rest"]); + {#gen{erule=ber},false} -> + emit([" Result = ",DecodeDisp,",",nl]), + result_line(NoOkWrapper, ["Result"]); + + + {#gen{erule=per},true} -> + emit([" {Result,Rest} = ",DecodeDisp,",",nl]), + result_line(NoOkWrapper, ["Result","Rest"]); + {#gen{erule=per},false} -> + emit([" {Result,_Rest} = ",DecodeDisp,",",nl]), + result_line(NoOkWrapper, ["Result"]) end, + case NoOkWrapper of false -> emit([nl,try_catch(),nl,nl]); true -> - emit([nl,"end.",nl,nl]) + emit([".",nl,nl]) end, + %% REST of MODULE gen_decode_partial_incomplete(Gen), gen_partial_inc_dispatcher(Gen), @@ -787,7 +802,7 @@ pgen_dispatcher(Gen, Types) -> gen_dispatcher(Types, "decode_disp", "dec_"). result_line(NoOkWrapper, Items) -> - S = [" "|case NoOkWrapper of + S = [" "|case NoOkWrapper of false -> result_line_1(["ok"|Items]); true -> result_line_1(Items) end], @@ -796,7 +811,7 @@ result_line(NoOkWrapper, Items) -> result_line_1([SingleItem]) -> SingleItem; result_line_1(Items) -> - ["{",string:join(Items, ","),"}"]. + ["{",lists:join(",",Items),"}"]. try_catch() -> [" catch",nl, @@ -943,7 +958,7 @@ open_hrl(OutFile,Module) -> hrl_protector(OutFile) -> BaseName = filename:basename(OutFile), - P = "_" ++ string:to_upper(BaseName) ++ "_HRL_", + P = "_" ++ string:uppercase(BaseName) ++ "_HRL_", [if $A =< C, C =< $Z -> C; $a =< C, C =< $a -> C; diff --git a/lib/asn1/src/asn1rtt_real_common.erl b/lib/asn1/src/asn1rtt_real_common.erl index 3a79209015..81c1f54d74 100644 --- a/lib/asn1/src/asn1rtt_real_common.erl +++ b/lib/asn1/src/asn1rtt_real_common.erl @@ -125,7 +125,7 @@ encode_real(_C, {_,Base,_}) -> encode_real(C, Real) when is_list(Real) -> %% The Real string may come in as a NR1, NR2 or NR3 string. {Mantissa, Exponent} = - case string:tokens(Real,"Ee") of + case string:lexemes(Real,"Ee") of [NR2] -> {NR2,0}; [NR3MB,NR3E] -> @@ -144,7 +144,7 @@ encode_real(C, Real) when is_list(Real) -> NewMan = remove_trailing_zeros(Dec), {NewMan,length(ZeroDecimal(NewMan))}; _ -> - case string:tokens(Mantissa,",.") of + case string:lexemes(Mantissa,",.") of [Num] -> %% No decimal-mark {integer_to_list(list_to_integer(Num)),0}; [Num,Dec] -> diff --git a/lib/asn1/vsn.mk b/lib/asn1/vsn.mk index ef83b9e3dc..4cd89089e9 100644 --- a/lib/asn1/vsn.mk +++ b/lib/asn1/vsn.mk @@ -1 +1 @@ -ASN1_VSN = 5.0.3 +ASN1_VSN = 5.0.4 diff --git a/lib/common_test/doc/src/Makefile b/lib/common_test/doc/src/Makefile index faa2d58a06..293ef591cb 100644 --- a/lib/common_test/doc/src/Makefile +++ b/lib/common_test/doc/src/Makefile @@ -57,11 +57,10 @@ XML_REF3_FILES = ct.xml \ ct_testspec.xml XML_REF6_FILES = common_test_app.xml -XML_PART_FILES = part.xml -# part_notes.xml \ -# part_notes_history.xml +XML_PART_FILES = part.xml XML_CHAPTER_FILES = \ + introduction.xml \ basics_chapter.xml \ getting_started_chapter.xml \ install_chapter.xml \ @@ -76,8 +75,7 @@ XML_CHAPTER_FILES = \ event_handler_chapter.xml \ ct_hooks_chapter.xml \ dependencies_chapter.xml \ - notes.xml \ - notes_history.xml + notes.xml BOOK_FILES = book.xml @@ -111,10 +109,10 @@ SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml) TOP_SPECS_FILE = specs.xml # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += +XML_FLAGS += +DVIPS_FLAGS += SPECS_FLAGS = -I../../include -I../../../snmp/include \ -I../../../kernel/include @@ -131,14 +129,14 @@ $(TOP_PDF_FILE): $(XML_FILES) pdf: $(TOP_PDF_FILE) -html: gifs $(HTML_REF_MAN_FILE) +html: gifs $(HTML_REF_MAN_FILE) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) man: $(MAN6_FILES) $(MAN3_FILES) $(MAN1_FILES) -debug opt: +debug opt: clean clean_docs: rm -rf $(HTMLDIR)/* @@ -147,11 +145,11 @@ clean clean_docs: rm -f $(MAN6DIR)/* rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f $(SPECDIR)/* - rm -f errs core *~ + rm -f errs core *~ # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk diff --git a/lib/common_test/doc/src/ct.xml b/lib/common_test/doc/src/ct.xml index 1a3cfdb0c5..afd8741cd1 100644 --- a/lib/common_test/doc/src/ct.xml +++ b/lib/common_test/doc/src/ct.xml @@ -1060,6 +1060,42 @@ </desc> </func> + <func> + <name>remaining_test_procs() -> {TestProcs,SharedGL,OtherGLs}</name> + <fsummary>>This function will return the identity of test- and group + leader processes that are still running at the time of this call.</fsummary> + <type> + <v>TestProcs = [{pid(),GL}]</v> + <v>GL = pid()</v> + <v>SharedGL = pid()</v> + <v>OtherGLs = [pid()]</v> + </type> + <desc><marker id="remaining_test_procs-0"/> + <p>This function will return the identity of test- and group + leader processes that are still running at the time of this call. + <c>TestProcs</c> are processes in the system that have a Common Test IO + process as group leader. <c>SharedGL</c> is the central Common Test + IO process, responsible for printing to log files for configuration + functions and sequentially executing test cases. <c>OtherGLs</c> are + Common Test IO processes that print to log files for test cases + in parallel test case groups.</p> + <p>The process information returned by this function may be + used to locate and terminate remaining processes after tests have + finished executing. The function would typically by called from + Common Test Hook functions.</p> + <p>Note that processes that execute configuration functions or + test cases are never included in <c>TestProcs</c>. It is therefore safe + to use post configuration hook functions (such as post_end_per_suite, + post_end_per_group, post_end_per_testcase) to terminate all processes + in <c>TestProcs</c> that have the current group leader process as its group + leader.</p> + <p>Note also that the shared group leader (<c>SharedGL</c>) must never be + terminated by the user, only by Common Test. Group leader processes + for parallel test case groups (<c>OtherGLs</c>) may however be terminated + in post_end_per_group hook functions.</p> + </desc> + </func> + <func> <name>remove_config(Callback, Config) -> ok</name> <fsummary>Removes configuration variables (together with diff --git a/lib/common_test/doc/src/fascicules.xml b/lib/common_test/doc/src/fascicules.xml deleted file mode 100644 index c4a28a699a..0000000000 --- a/lib/common_test/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/common_test/doc/src/notes.xml b/lib/common_test/doc/src/notes.xml index b039023e0f..c6b928bb5d 100644 --- a/lib/common_test/doc/src/notes.xml +++ b/lib/common_test/doc/src/notes.xml @@ -33,6 +33,33 @@ <file>notes.xml</file> </header> +<section><title>Common_Test 1.15.3</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + A new function, <c>ct:remaining_test_procs/0</c>, returns + the identity of test- and group leader processes that are + still running at the time of the call.</p> + <p> + Own Id: OTP-13832</p> + </item> + <item> + <p> + A "latest test result" link is now displayed in the + footer of each test index page, which performs a jump to + the most recently generated test index. This is useful + for making quick comparisons of results between test runs + without having to traverse the log file tree.</p> + <p> + Own Id: OTP-14281</p> + </item> + </list> + </section> + +</section> + <section><title>Common_Test 1.15.2</title> <section><title>Improvements and New Features</title> diff --git a/lib/common_test/doc/src/part_notes.xml b/lib/common_test/doc/src/part_notes.xml deleted file mode 100644 index 360c535e96..0000000000 --- a/lib/common_test/doc/src/part_notes.xml +++ /dev/null @@ -1,41 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2004</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>Common Test</title> - <prepared>Peter Andersson</prepared> - <docno></docno> - <date>2007-12-01</date> - <rev></rev> - <file>part_notes.xml</file> - </header> - <description> - <p>Common Test - tool for automated testing, based on the Erlang/OTP Test Server.</p> - <p>For information about older versions see - <url href="part_notes_history_frame.html">release notes - history</url>.</p> - </description> - <xi:include href="notes.xml"/> -</part> - - diff --git a/lib/common_test/doc/src/part_notes_history.xml b/lib/common_test/doc/src/part_notes_history.xml deleted file mode 100644 index d13bb858db..0000000000 --- a/lib/common_test/doc/src/part_notes_history.xml +++ /dev/null @@ -1,35 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part> - <header> - <copyright> - <year>2004</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>Common Test</title> - <prepared>Peter Andersson</prepared> - <docno></docno> - <date>2007-12-01</date> - <rev></rev> - <file>part_notes.xml</file> - </header> - <include file="notes_history"></include> -</part> - - diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl index a12c0c9101..69e371a30f 100644 --- a/lib/common_test/src/ct.erl +++ b/lib/common_test/src/ct.erl @@ -89,6 +89,8 @@ -export([get_target_name/1]). -export([parse_table/1, listenv/1]). +-export([remaining_test_procs/0]). + %%---------------------------------------------------------------------- %% Exported types %%---------------------------------------------------------------------- @@ -1030,7 +1032,7 @@ make_and_load(Dir, Suite) -> EnvInclude = case os:getenv("CT_INCLUDE_PATH") of false -> []; - CtInclPath -> string:tokens(CtInclPath, [$:,$ ,$,]) + CtInclPath -> string:lexemes(CtInclPath, [$:,$ ,$,]) end, StartInclude = case init:get_argument(include) of @@ -1474,3 +1476,36 @@ continue() -> %%% in order to let the test case proceed.</p> continue(TestCase) -> test_server:continue(TestCase). + + +%%%----------------------------------------------------------------- +%%% @spec remaining_test_procs() -> {TestProcs,SharedGL,OtherGLs} +%%% TestProcs = [{pid(),GL}] +%%% GL = SharedGL = pid() +%%% OtherGLs = [pid()] +%%% +%%% @doc <p>This function will return the identity of test- and group +%%% leader processes that are still running at the time of this call. +%%% TestProcs are processes in the system that have a Common Test IO +%%% process as group leader. SharedGL is the central Common Test +%%% IO process, responsible for printing to log files for configuration +%%% functions and sequentially executing test cases. OtherGLs are +%%% Common Test IO processes that print to log files for test cases +%%% in parallel test case groups.</p> +%%% <p>The process information returned by this function may be +%%% used to locate and terminate remaining processes after tests have +%%% finished executing. The function would typically by called from +%%% Common Test Hook functions.</p> +%%% <p>Note that processes that execute configuration functions or +%%% test cases are never included in TestProcs. It is therefore safe +%%% to use post configuration hook functions (such as post_end_per_suite, +%%% post_end_per_group, post_end_per_testcase) to terminate all processes +%%% in TestProcs that have the current group leader process as its group +%%% leader.</p> +%%% <p>Note also that the shared group leader (SharedGL) must never be +%%% terminated by the user, only by Common Test. Group leader processes +%%% for parallel test case groups (OtherGLs) may however be terminated +%%% in post_end_per_group hook functions.</p> +%%% +remaining_test_procs() -> + ct_util:remaining_test_procs(). diff --git a/lib/common_test/src/ct_config.erl b/lib/common_test/src/ct_config.erl index d48ae830bb..6c87b11f8d 100644 --- a/lib/common_test/src/ct_config.erl +++ b/lib/common_test/src/ct_config.erl @@ -81,6 +81,7 @@ start(Mode) -> do_start(Parent) -> process_flag(trap_exit,true), + ct_util:mark_process(), register(ct_config_server,self()), ct_util:create_table(?attr_table,bag,#ct_conf.key), {ok,StartDir} = file:get_cwd(), @@ -659,7 +660,7 @@ decrypt_config_file(EncryptFileName, TargetFileName, {key,Key}) -> get_crypt_key_from_file(File) -> case file:read_file(File) of {ok,Bin} -> - case catch string:tokens(binary_to_list(Bin), [$\n,$\r]) of + case catch string:lexemes(binary_to_list(Bin), [$\n,$\r]) of [Key] -> Key; _ -> @@ -693,7 +694,7 @@ get_crypt_key_from_file() -> noent -> Result; _ -> - case catch string:tokens(binary_to_list(Result), [$\n,$\r]) of + case catch string:lexemes(binary_to_list(Result), [$\n,$\r]) of [Key] -> io:format("~nCrypt key file: ~ts~n", [FullName]), Key; diff --git a/lib/common_test/src/ct_config_plain.erl b/lib/common_test/src/ct_config_plain.erl index e72b55971b..e77381d7cf 100644 --- a/lib/common_test/src/ct_config_plain.erl +++ b/lib/common_test/src/ct_config_plain.erl @@ -106,7 +106,7 @@ read_config_terms1({done,{eof,EL},_}, L, _, _) -> read_config_terms1({done,{error,Info,EL},_}, L, _, _) -> {error,{Info,{L,EL}}}; read_config_terms1({more,_}, L, Terms, Rest) -> - case string:tokens(Rest, [$\n,$\r,$\t]) of + case string:lexemes(Rest, [$\n,$\r,$\t]) of [] -> lists:reverse(Terms); _ -> diff --git a/lib/common_test/src/ct_conn_log_h.erl b/lib/common_test/src/ct_conn_log_h.erl index cf0a228e1b..3e83020f45 100644 --- a/lib/common_test/src/ct_conn_log_h.erl +++ b/lib/common_test/src/ct_conn_log_h.erl @@ -224,7 +224,7 @@ now_to_time({_,_,MicroS}=Now) -> {calendar:now_to_local_time(Now),MicroS}. pretty_head({{{Y,Mo,D},{H,Mi,S}},MicroS},ConnMod,Text0) -> - Text = string:to_upper(atom_to_list(ConnMod) ++ Text0), + Text = string:uppercase(atom_to_list(ConnMod) ++ Text0), io_lib:format("= ~s ==== ~s-~s-~w::~s:~s:~s,~s ", [Text,t(D),month(Mo),Y,t(H),t(Mi),t(S), micro2milli(MicroS)]). @@ -275,7 +275,7 @@ pad0(N,Str) -> lists:duplicate(N-M,$0) ++ Str. pad_char_end(N,Str,Char) -> - case length(lists:flatten(Str)) of + case string:length(Str) of M when M<N -> Str ++ lists:duplicate(N-M,Char); _ -> Str end. diff --git a/lib/common_test/src/ct_default_gl.erl b/lib/common_test/src/ct_default_gl.erl index d1b52e5f4f..9ae430c546 100644 --- a/lib/common_test/src/ct_default_gl.erl +++ b/lib/common_test/src/ct_default_gl.erl @@ -55,6 +55,7 @@ stop() -> init([ParentGL]) -> register(?MODULE, self()), + ct_util:mark_process(), {ok,#{parent_gl_pid => ParentGL, parent_gl_monitor => erlang:monitor(process,ParentGL)}}. diff --git a/lib/common_test/src/ct_event.erl b/lib/common_test/src/ct_event.erl index 1a0ee4f3cd..8b5bba7600 100644 --- a/lib/common_test/src/ct_event.erl +++ b/lib/common_test/src/ct_event.erl @@ -137,6 +137,7 @@ is_alive() -> %% this function is called to initialize the event handler. %%-------------------------------------------------------------------- init(RecvPids) -> + ct_util:mark_process(), %% RecvPids = [{RecvTag,Pid}] {ok,#state{receivers=RecvPids}}. diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index 6066470233..7f7e9ae6f9 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -921,9 +921,10 @@ error_notification(Mod,Func,_Args,{Error,Loc}) -> end, ErrorStr = case ErrorSpec of {badmatch,Descr} -> - Descr1 = lists:flatten(io_lib:format("~tP",[Descr,10])), - if length(Descr1) > 50 -> - Descr2 = string:substr(Descr1,1,50), + Descr1 = io_lib:format("~tP",[Descr,10]), + DescrLength = string:length(Descr1), + if DescrLength > 50 -> + Descr2 = string:slice(Descr1,0,50), io_lib:format("{badmatch,~ts...}",[Descr2]); true -> io_lib:format("{badmatch,~ts}",[Descr1]) diff --git a/lib/common_test/src/ct_ftp.erl b/lib/common_test/src/ct_ftp.erl index 8effb06e7e..ee4a6a6c45 100644 --- a/lib/common_test/src/ct_ftp.erl +++ b/lib/common_test/src/ct_ftp.erl @@ -285,7 +285,7 @@ init(KeyOrName,{IP,Port},{Username,Password}) -> {ok,FtpPid} -> log(heading(init,KeyOrName), "Opened ftp connection:\nIP: ~tp\nUsername: ~tp\nPassword: ~p\n", - [IP,Username,lists:duplicate(length(Password),$*)]), + [IP,Username,lists:duplicate(string:length(Password),$*)]), {ok,FtpPid,#state{ftp_pid=FtpPid,target_name=KeyOrName}}; Error -> Error diff --git a/lib/common_test/src/ct_gen_conn.erl b/lib/common_test/src/ct_gen_conn.erl index badb7c52ae..456bfd8bd1 100644 --- a/lib/common_test/src/ct_gen_conn.erl +++ b/lib/common_test/src/ct_gen_conn.erl @@ -186,9 +186,11 @@ end_log() -> do_within_time(Fun,Timeout) -> Self = self(), Silent = get(silent), - TmpPid = spawn_link(fun() -> put(silent,Silent), - R = Fun(), - Self ! {self(),R} + TmpPid = spawn_link(fun() -> + ct_util:mark_process(), + put(silent,Silent), + R = Fun(), + Self ! {self(),R} end), ConnPid = get(conn_pid), receive @@ -301,6 +303,7 @@ return({To,Ref},Result) -> init_gen(Parent,Opts) -> process_flag(trap_exit,true), + ct_util:mark_process(), put(silent,false), try (Opts#gen_opts.callback):init(Opts#gen_opts.name, Opts#gen_opts.address, diff --git a/lib/common_test/src/ct_hooks_lock.erl b/lib/common_test/src/ct_hooks_lock.erl index fea298e535..a82be288e1 100644 --- a/lib/common_test/src/ct_hooks_lock.erl +++ b/lib/common_test/src/ct_hooks_lock.erl @@ -78,6 +78,7 @@ release() -> %% @doc Initiates the server init(Id) -> + ct_util:mark_process(), {ok, #state{ id = Id }}. %% @doc Handling call messages diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index ba7660fe6a..9861b1e521 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -666,6 +666,7 @@ log_timestamp({MS,S,US}) -> logger(Parent, Mode, Verbosity) -> register(?MODULE,self()), + ct_util:mark_process(), %%! Below is a temporary workaround for the limitation of %%! max one test run per second. %%! ---> @@ -1004,6 +1005,7 @@ print_to_log(async, FromPid, Category, TCGL, Content, EscChars, State) -> if FromPid /= TCGL -> IoFun = create_io_fun(FromPid, CtLogFd, EscChars), fun() -> + ct_util:mark_process(), test_server:permit_io(TCGL, self()), %% Since asynchronous io gets can get buffered if @@ -1035,6 +1037,7 @@ print_to_log(async, FromPid, Category, TCGL, Content, EscChars, State) -> end; true -> fun() -> + ct_util:mark_process(), unexpected_io(FromPid, Category, ?MAX_IMPORTANCE, Content, CtLogFd, EscChars) end @@ -1188,26 +1191,23 @@ print_style(Fd, IoFormat, StyleSheet) -> case file:read_file(StyleSheet) of {ok,Bin} -> Str = b2s(Bin,encoding(StyleSheet)), - Pos0 = case string:str(Str,"<style>") of - 0 -> string:str(Str,"<STYLE>"); - N0 -> N0 - end, - Pos1 = case string:str(Str,"</style>") of - 0 -> string:str(Str,"</STYLE>"); - N1 -> N1 - end, - if (Pos0 == 0) and (Pos1 /= 0) -> - print_style_error(Fd, IoFormat, - StyleSheet, missing_style_start_tag); - (Pos0 /= 0) and (Pos1 == 0) -> - print_style_error(Fd, IoFormat, - StyleSheet,missing_style_end_tag); - Pos0 /= 0 -> - Style = string:sub_string(Str,Pos0,Pos1+7), - IoFormat(Fd,"~ts\n",[Style]); - Pos0 == 0 -> - IoFormat(Fd,"<style>\n~ts</style>\n",[Str]) - end; + case re:run(Str,"<style>.*</style>", + [dotall,caseless,{capture,all,list}]) of + nomatch -> + case re:run(Str,"</?style>",[caseless,{capture,all,list}]) of + nomatch -> + IoFormat(Fd,"<style>\n~ts</style>\n",[Str]); + {match,["</"++_]} -> + print_style_error(Fd, IoFormat, + StyleSheet, + missing_style_start_tag); + {match,[_]} -> + print_style_error(Fd, IoFormat, + StyleSheet,missing_style_end_tag) + end; + {match,[Style]} -> + IoFormat(Fd,"~ts\n",[Style]) + end; {error,Reason} -> print_style_error(Fd,IoFormat,StyleSheet,Reason) end. @@ -1414,9 +1414,9 @@ make_one_index_entry1(SuiteName, Link, Label, Success, Fail, UserSkip, AutoSkip, {Lbl,Timestamp,Node,AllInfo} = case All of {true,OldRuns} -> - [_Prefix,NodeOrDate|_] = string:tokens(Link,"."), - Node1 = case string:chr(NodeOrDate,$@) of - 0 -> "-"; + [_Prefix,NodeOrDate|_] = string:lexemes(Link,"."), + Node1 = case string:find(NodeOrDate,[$@]) of + nomatch -> "-"; _ -> NodeOrDate end, @@ -1523,7 +1523,7 @@ not_built(BaseName,_LogDir,_All,Missing) -> %% Top.ObjDir | Top.ObjDir.suites | Top.ObjDir.Suite | %% Top.ObjDir.Suite.cases | Top.ObjDir.Suite.Case Failed = - case string:tokens(BaseName,".") of + case string:lexemes(BaseName,".") of [T,O] when is_list(T) -> % all under Top.ObjDir locate_info({T,O},all,Missing); [T,O,"suites"] -> @@ -2051,9 +2051,9 @@ sort_all_runs(Dirs) -> %% "YYYY-MM-DD_HH.MM.SS" lists:sort(fun(Dir1,Dir2) -> [SS1,MM1,HH1,Date1|_] = - lists:reverse(string:tokens(Dir1,[$.,$_])), + lists:reverse(string:lexemes(Dir1,[$.,$_])), [SS2,MM2,HH2,Date2|_] = - lists:reverse(string:tokens(Dir2,[$.,$_])), + lists:reverse(string:lexemes(Dir2,[$.,$_])), {Date1,HH1,MM1,SS1} > {Date2,HH2,MM2,SS2} end, Dirs). @@ -2063,9 +2063,9 @@ sort_ct_runs(Dirs) -> lists:sort( fun(Dir1,Dir2) -> [SS1,MM1,DateHH1 | _] = - lists:reverse(string:tokens(filename:dirname(Dir1),[$.])), + lists:reverse(string:lexemes(filename:dirname(Dir1),[$.])), [SS2,MM2,DateHH2 | _] = - lists:reverse(string:tokens(filename:dirname(Dir2),[$.])), + lists:reverse(string:lexemes(filename:dirname(Dir2),[$.])), {DateHH1,MM1,SS1} =< {DateHH2,MM2,SS2} end, Dirs). @@ -2211,27 +2211,15 @@ runentry(Dir, Totals={Node,Label,Logs, 0 -> "-"; N -> integer_to_list(N) end, - StripExt = - fun(File) -> - string:sub_string(File,1, - length(File)- - length(?logdir_ext)) ++ ", " - end, - Polish = fun(S) -> case lists:reverse(S) of - [32,$,|Rev] -> lists:reverse(Rev); - [$,|Rev] -> lists:reverse(Rev); - _ -> S - end - end, - TestNames = Polish(lists:flatten(lists:map(StripExt,Logs))), + + RootNames = lists:map(fun(F) -> filename:rootname(F,?logdir_ext) end, Logs), + TestNames = lists:flatten(lists:join(", ", RootNames)), TestNamesTrunc = - if TestNames=="" -> - ""; - length(TestNames) < ?testname_width -> + if length(TestNames) < ?testname_width -> TestNames; true -> - Trunc = Polish(string:substr(TestNames,1, - ?testname_width-3)), + Trunc = string:trim(string:slice(TestNames,0,?testname_width-3), + trailing,",\s"), lists:flatten(io_lib:format("~ts...",[Trunc])) end, TotMissingStr = @@ -2374,7 +2362,7 @@ force_rename(From,To,Number) -> timestamp(Dir) -> - TsR = lists:reverse(string:tokens(Dir,".-_")), + TsR = lists:reverse(string:lexemes(Dir,".-_")), [S,Min,H,D,M,Y] = [list_to_integer(N) || N <- lists:sublist(TsR,6)], format_time({{Y,M,D},{H,Min,S}}). @@ -2923,7 +2911,7 @@ cache_vsn() -> VSNfile = filename:join([EbinDir,"..","vsn.mk"]), case file:read_file(VSNfile) of {ok,Bin} -> - [_,VSN] = string:tokens(binary_to_list(Bin),[$=,$\n,$ ]), + [_,VSN] = string:lexemes(binary_to_list(Bin),[$=,$\n,$ ]), VSN; _ -> undefined @@ -3017,6 +3005,7 @@ simulate() -> S = self(), Pid = spawn(fun() -> register(?MODULE,self()), + ct_util:mark_process(), S ! {self(),started}, simulate_logger_loop() end), @@ -3144,8 +3133,8 @@ locate_priv_file(FileName) -> filename:join(get(ct_run_dir), FileName); _ -> %% executed on other process than ct_logs - {ok,RunDir} = get_log_dir(true), - filename:join(RunDir, FileName) + {ok,LogDir} = get_log_dir(true), + filename:join(LogDir, FileName) end, case filelib:is_file(PrivResultFile) of true -> @@ -3227,6 +3216,10 @@ get_ts_html_wrapper(TestName, Logdir, PrintLabel, Cwd, TableCols, Encoding) -> ?all_runs_name), Cwd), TestIndex = make_relative(filename:join(filename:dirname(CtLogdir), ?index_name), Cwd), + LatestTest = make_relative(filename:join(filename:dirname(CtLogdir), + ?suitelog_name++".latest.html"), + Cwd), + case Basic of true -> TileFile = filename:join(filename:join(CTPath,"priv"),"tile1.jpg"), @@ -3253,7 +3246,9 @@ get_ts_html_wrapper(TestName, Logdir, PrintLabel, Cwd, TableCols, Encoding) -> "<a href=\"", uri(AllRuns), "\">Test run history\n</a> | ", "<a href=\"", uri(TestIndex), - "\">Top level test index\n</a>\n</p>\n", + "\">Top level test index\n</a> | ", + "<a href=\"", uri(LatestTest), + "\">Latest test result</a>\n</p>\n", Copyright,"</center>\n</body>\n</html>\n"]}; _ -> Copyright = @@ -3300,7 +3295,9 @@ get_ts_html_wrapper(TestName, Logdir, PrintLabel, Cwd, TableCols, Encoding) -> "<a href=\"", uri(AllRuns), "\">Test run history\n</a> | ", "<a href=\"", uri(TestIndex), - "\">Top level test index\n</a>\n</p>\n", + "\">Top level test index\n</a> | ", + "<a href=\"", uri(LatestTest), + "\">Latest test result</a>\n</p>\n", Copyright,"</center>\n</body>\n</html>\n"]} end. @@ -3320,7 +3317,7 @@ insert_javascript({tablesorter,TableName, end, [{"CTDateSorter",DateCols}, {"CTTextSorter",TextCols}, {"CTValSorter",ValCols}]))), - Headers1 = string:substr(Headers, 1, length(Headers)-2), + Headers1 = string:trim(Headers, trailing, ",\n"), ["<script type=\"text/javascript\">\n", "// Parser for date format, e.g: Wed Jul 4 2012 11:24:15\n", diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl index 6e6d1879c2..e2ea525cdd 100644 --- a/lib/common_test/src/ct_master.erl +++ b/lib/common_test/src/ct_master.erl @@ -346,6 +346,7 @@ init_master(Parent,NodeOptsList,EvHandlers,MasterLogDir,LogDirs, case whereis(ct_master) of undefined -> register(ct_master,self()), + ct_util:mark_process(), ok; _Pid -> io:format("~nWarning: ct_master already running!~n"), @@ -690,6 +691,7 @@ refresh_logs([],Refreshed) -> init_node_ctrl(MasterPid,Cookie,Opts) -> %% make sure tests proceed even if connection to master is lost process_flag(trap_exit, true), + ct_util:mark_process(), MasterNode = node(MasterPid), group_leader(whereis(user),self()), io:format("~n********** node_ctrl process ~w started on ~w **********~n", @@ -807,7 +809,7 @@ filter_accessible(InitOptions, Inaccessible)-> start_nodes(InitOptions)-> lists:foreach(fun({NodeName, Options})-> - [NodeS,HostS]=string:tokens(atom_to_list(NodeName), "@"), + [NodeS,HostS]=string:lexemes(atom_to_list(NodeName), "@"), Node=list_to_atom(NodeS), Host=list_to_atom(HostS), HasNodeStart = lists:keymember(node_start, 1, Options), diff --git a/lib/common_test/src/ct_master_event.erl b/lib/common_test/src/ct_master_event.erl index d535d1274e..bd4d1efc92 100644 --- a/lib/common_test/src/ct_master_event.erl +++ b/lib/common_test/src/ct_master_event.erl @@ -116,6 +116,7 @@ sync_notify(Event) -> %% this function is called to initialize the event handler. %%-------------------------------------------------------------------- init(_) -> + ct_util:mark_process(), ct_master_logs:log("CT Master Event Handler started","",[]), {ok,#state{}}. diff --git a/lib/common_test/src/ct_master_logs.erl b/lib/common_test/src/ct_master_logs.erl index d8ecd641ed..1308720823 100644 --- a/lib/common_test/src/ct_master_logs.erl +++ b/lib/common_test/src/ct_master_logs.erl @@ -88,6 +88,7 @@ stop() -> init(Parent,LogDir,Nodes) -> register(?MODULE,self()), + ct_util:mark_process(), Time = calendar:local_time(), RunDir = make_dirname(Time), RunDirAbs = filename:join(LogDir,RunDir), @@ -297,7 +298,7 @@ sort_all_runs(Dirs) -> %% "YYYY-MM-DD_HH.MM.SS" KeyList = lists:map(fun(Dir) -> - case lists:reverse(string:tokens(Dir,[$.,$_])) of + case lists:reverse(string:lexemes(Dir,[$.,$_])) of [SS,MM,HH,Date|_] -> {{Date,HH,MM,SS},Dir}; _Other -> @@ -312,18 +313,8 @@ runentry(Dir) -> {MasterStr,NodesStr} = case read_details_file(Dir) of {Master,Nodes} when is_list(Nodes) -> - [_,Host] = string:tokens(atom_to_list(Master),"@"), - NodesList = - lists:reverse(lists:map(fun(N) -> - atom_to_list(N) ++ ", " - end,Nodes)), - case NodesList of - [N|NListR] -> - N1 = string:sub_string(N,1,length(N)-2), - {Host,lists:flatten(lists:reverse([N1|NListR]))}; - [] -> - {Host,""} - end; + [_,Host] = string:lexemes(atom_to_list(Master),"@"), + {Host,lists:concat(lists:join(", ",Nodes))}; _Error -> {"unknown",""} end, @@ -348,7 +339,7 @@ all_runs_header() -> xhtml("", "</tr></thead>\n<tbody>\n")]]. timestamp(Dir) -> - [S,Min,H,D,M,Y|_] = lists:reverse(string:tokens(Dir,".-_")), + [S,Min,H,D,M,Y|_] = lists:reverse(string:lexemes(Dir,".-_")), [S1,Min1,H1,D1,M1,Y1] = [list_to_integer(N) || N <- [S,Min,H,D,M,Y]], format_time({{Y1,M1,D1},{H1,Min1,S1}}). diff --git a/lib/common_test/src/ct_netconfc.erl b/lib/common_test/src/ct_netconfc.erl index 2c4b97df20..29188a648e 100644 --- a/lib/common_test/src/ct_netconfc.erl +++ b/lib/common_test/src/ct_netconfc.erl @@ -1467,7 +1467,7 @@ decode_data(Other) -> {error,{unexpected_rpc_reply,Other}}. get_qualified_name(Tag) -> - case string:tokens(atom_to_list(Tag),":") of + case string:lexemes(atom_to_list(Tag),":") of [TagStr] -> {[],TagStr}; [PrefixStr,TagStr] -> {PrefixStr,TagStr} end. diff --git a/lib/common_test/src/ct_release_test.erl b/lib/common_test/src/ct_release_test.erl index 551a7e06d7..4af9afb45b 100644 --- a/lib/common_test/src/ct_release_test.erl +++ b/lib/common_test/src/ct_release_test.erl @@ -817,7 +817,7 @@ get_runtime_deps([App|Apps],StartApps,Acc,Visited) -> RuntimeDeps = lists:flatmap( fun(Str) -> - [RuntimeAppStr,_] = string:tokens(Str,"-"), + [RuntimeAppStr,_] = string:lexemes(Str,"-"), RuntimeApp = list_to_atom(RuntimeAppStr), case {lists:keymember(RuntimeApp,1,Acc), lists:member(RuntimeApp,StartApps)} of diff --git a/lib/common_test/src/ct_repeat.erl b/lib/common_test/src/ct_repeat.erl index c043c9846c..177ef37d1f 100644 --- a/lib/common_test/src/ct_repeat.erl +++ b/lib/common_test/src/ct_repeat.erl @@ -70,6 +70,7 @@ loop_test(If,Args) when is_list(Args) -> CtrlPid = self(), spawn( fun() -> + ct_util:mark_process(), stop_after(CtrlPid,Secs,ForceStop) end) end, @@ -134,6 +135,7 @@ spawn_tester(script,Ctrl,Args) -> spawn_tester(func,Ctrl,Opts) -> Tester = fun() -> + ct_util:mark_process(), case catch ct_run:run_test2(Opts) of {'EXIT',Reason} -> exit(Reason); diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index 14f28f9ca3..8c401cf3f5 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -147,7 +147,7 @@ script_start(Args) -> CTVsn = case filename:basename(code:lib_dir(common_test)) of CTBase when is_list(CTBase) -> - case string:tokens(CTBase, "-") of + case string:lexemes(CTBase, "-") of ["common_test",Vsn] -> " v"++Vsn; _ -> "" end @@ -250,6 +250,8 @@ finish(Tracing, ExitStatus, Args) -> end. script_start1(Parent, Args) -> + %% tag this process + ct_util:mark_process(), %% read general start flags Label = get_start_opt(label, fun([Lbl]) -> Lbl end, Args), Profile = get_start_opt(profile, fun([Prof]) -> Prof end, Args), @@ -315,7 +317,7 @@ script_start1(Parent, Args) -> {undefined,InclDirs}; CtInclPath -> AllInclDirs = - string:tokens(CtInclPath,[$:,$ ,$,]) ++ InclDirs, + string:lexemes(CtInclPath,[$:,$ ,$,]) ++ InclDirs, application:set_env(common_test, include, AllInclDirs), {undefined,AllInclDirs} end; @@ -956,7 +958,10 @@ run_test(StartOpts) when is_list(StartOpts) -> -spec run_test1_fun(_) -> fun(() -> no_return()). run_test1_fun(StartOpts) -> - fun() -> run_test1(StartOpts) end. + fun() -> + ct_util:mark_process(), + run_test1(StartOpts) + end. run_test1(StartOpts) when is_list(StartOpts) -> case proplists:get_value(refresh_logs, StartOpts) of @@ -1096,7 +1101,7 @@ run_test2(StartOpts) -> application:set_env(common_test, include, InclDirs), {undefined,InclDirs}; CtInclPath -> - InclDirs1 = string:tokens(CtInclPath, [$:,$ ,$,]), + InclDirs1 = string:lexemes(CtInclPath, [$:,$ ,$,]), AllInclDirs = InclDirs1++InclDirs, application:set_env(common_test, include, AllInclDirs), {undefined,AllInclDirs} @@ -1447,7 +1452,10 @@ run_testspec(TestSpec) -> -spec run_testspec1_fun(_) -> fun(() -> no_return()). run_testspec1_fun(TestSpec) -> - fun() -> run_testspec1(TestSpec) end. + fun() -> + ct_util:mark_process(), + run_testspec1(TestSpec) + end. run_testspec1(TestSpec) -> {ok,Cwd} = file:get_cwd(), @@ -1482,7 +1490,7 @@ run_testspec2(TestSpec) -> false -> Opts#opts.include; CtInclPath -> - EnvInclude = string:tokens(CtInclPath, [$:,$ ,$,]), + EnvInclude = string:lexemes(CtInclPath, [$:,$ ,$,]), EnvInclude++Opts#opts.include end, application:set_env(common_test, include, AllInclude), @@ -1906,10 +1914,12 @@ possibly_spawn(true, Tests, Skip, Opts) -> CTUtilSrv = whereis(ct_util_server), Supervisor = fun() -> + ct_util:mark_process(), process_flag(trap_exit, true), link(CTUtilSrv), TestRun = fun() -> + ct_util:mark_process(), TestResult = (catch do_run_test(Tests, Skip, Opts)), case TestResult of {EType,_} = Error when EType == user_error; diff --git a/lib/common_test/src/ct_slave.erl b/lib/common_test/src/ct_slave.erl index 4188bd7c3b..0c16ad5980 100644 --- a/lib/common_test/src/ct_slave.erl +++ b/lib/common_test/src/ct_slave.erl @@ -38,7 +38,8 @@ -record(options, {username, password, boot_timeout, init_timeout, startup_timeout, startup_functions, monitor_master, - kill_if_fail, erl_flags, env, ssh_port, ssh_opts}). + kill_if_fail, erl_flags, env, ssh_port, ssh_opts, + stop_timeout}). %%%----------------------------------------------------------------- %%% @spec start(Node) -> Result @@ -198,6 +199,7 @@ start(Host, Node, Opts) -> end end. +%%%----------------------------------------------------------------- %%% @spec stop(Node) -> Result %%% Node = atom() %%% Result = {ok, NodeName} | @@ -205,16 +207,41 @@ start(Host, Node, Opts) -> %%% Reason = not_started | %%% not_connected | %%% stop_timeout - %%% NodeName = atom() %%% @doc Stops the running Erlang node with name <code>Node</code> on %%% the localhost. stop(Node) -> stop(gethostname(), Node). -%%% @spec stop(Host, Node) -> Result +%%%----------------------------------------------------------------- +%%% @spec stop(HostOrNode, NodeOrOpts) -> Result +%%% HostOrNode = atom() +%%% NodeOrOpts = atom() | list() +%%% Result = {ok, NodeName} | +%%% {error, Reason, NodeName} +%%% Reason = not_started | +%%% not_connected | +%%% stop_timeout +%%% NodeName = atom() +%%% @doc Stops the running Erlang node with default options on a specified +%%% host, or on the local host with specified options. That is, +%%% the call is interpreted as <code>stop(Host, Node)</code> when the +%%% second argument is atom-valued and <code>stop(Node, Opts)</code> +%%% when it's list-valued. +%%% @see stop/3 +stop(_HostOrNode = Node, _NodeOrOpts = Opts) %% match to satiate edoc + when is_list(Opts) -> + stop(gethostname(), Node, Opts); + +stop(Host, Node) -> + stop(Host, Node, []). + +%%% @spec stop(Host, Node, Opts) -> Result %%% Host = atom() %%% Node = atom() +%%% Opts = [OptTuples] +%%% OptTuples = {stop_timeout, StopTimeout} +%%% StopTimeout = integer() %%% Result = {ok, NodeName} | %%% {error, Reason, NodeName} %%% Reason = not_started | @@ -222,12 +249,19 @@ stop(Node) -> %%% stop_timeout %%% NodeName = atom() %%% @doc Stops the running Erlang node with name <code>Node</code> on -%%% host <code>Host</code>. -stop(Host, Node) -> +%%% host <code>Host</code> as specified by options <code>Opts</code>. +%%% +%%% <p>Option <code>stop_timeout</code> specifies, in seconds, +%%% the time to wait until the node is disconnected. +%%% Defaults to 5 seconds. If this timeout occurs, +%%% the result <code>{error, stop_timeout, NodeName}</code> is returned. +%%% +stop(Host, Node, Opts) -> ENode = enodename(Host, Node), case is_started(ENode) of {true, connected}-> - do_stop(ENode); + OptionsRec = fetch_options(Opts), + do_stop(ENode, OptionsRec); {true, not_connected}-> {error, not_connected, ENode}; false-> @@ -257,11 +291,13 @@ fetch_options(Options) -> EnvVars = get_option_value(env, Options, []), SSHPort = get_option_value(ssh_port, Options, []), SSHOpts = get_option_value(ssh_opts, Options, []), + StopTimeout = get_option_value(stop_timeout, Options, 5), #options{username=UserName, password=Password, boot_timeout=BootTimeout, init_timeout=InitTimeout, startup_timeout=StartupTimeout, startup_functions=StartupFunctions, monitor_master=Monitor, kill_if_fail=KillIfFail, - erl_flags=ErlFlags, env=EnvVars, ssh_port=SSHPort, ssh_opts=SSHOpts}. + erl_flags=ErlFlags, env=EnvVars, ssh_port=SSHPort, ssh_opts=SSHOpts, + stop_timeout=StopTimeout}. % send a message when slave node is started % @hidden @@ -282,6 +318,7 @@ monitor_master(MasterNode) -> % code of the masterdeath-waiter process monitor_master_int(MasterNode) -> + ct_util:mark_process(), erlang:monitor_node(MasterNode, true), receive {nodedown, MasterNode}-> @@ -461,6 +498,8 @@ wait_for_node_alive(Node, N) -> % call init:stop on a remote node do_stop(ENode) -> + do_stop(ENode, fetch_options([])). +do_stop(ENode, Options) -> {Cover,MainCoverNode} = case test_server:is_cover() of true -> @@ -471,7 +510,8 @@ do_stop(ENode) -> {false,undefined} end, spawn(ENode, init, stop, []), - case wait_for_node_dead(ENode, 5) of + StopTimeout = Options#options.stop_timeout, + case wait_for_node_dead(ENode, StopTimeout) of {ok,ENode} -> if Cover -> %% To avoid that cover is started again if a node diff --git a/lib/common_test/src/ct_ssh.erl b/lib/common_test/src/ct_ssh.erl index ca62357e1c..491d56dfc1 100644 --- a/lib/common_test/src/ct_ssh.erl +++ b/lib/common_test/src/ct_ssh.erl @@ -996,7 +996,8 @@ init(KeyOrName, {ConnType,Addr,Port}, AllOpts) -> try_log(heading(init,KeyOrName), "Opened ~w connection:\n" "Host: ~tp (~p)\nUser: ~tp\nPassword: ~p\n", - [ConnType,Addr,Port,User,lists:duplicate(length(Password),$*)]), + [ConnType,Addr,Port,User, + lists:duplicate(string:length(Password),$*)]), {ok,SSHRef,#state{ssh_ref=SSHRef, conn_type=ConnType, target=KeyOrName}} end. diff --git a/lib/common_test/src/ct_telnet_client.erl b/lib/common_test/src/ct_telnet_client.erl index c8d217cd2a..76e4b9ea70 100644 --- a/lib/common_test/src/ct_telnet_client.erl +++ b/lib/common_test/src/ct_telnet_client.erl @@ -118,6 +118,7 @@ get_data(Pid) -> %%%----------------------------------------------------------------- %%% Internal functions init(Parent, Server, Port, Timeout, KeepAlive, NoDelay, ConnName) -> + ct_util:mark_process(), case gen_tcp:connect(Server, Port, [list,{packet,0},{nodelay,NoDelay}], Timeout) of {ok,Sock} -> dbg("~tp connected to: ~tp (port: ~w, keep_alive: ~w)\n", diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl index abf131f4df..10a06d5c88 100644 --- a/lib/common_test/src/ct_util.erl +++ b/lib/common_test/src/ct_util.erl @@ -65,6 +65,9 @@ -export([warn_duplicates/1]). +-export([mark_process/0, mark_process/1, is_marked/1, is_marked/2, + remaining_test_procs/0]). + -export([get_profile_data/0, get_profile_data/1, get_profile_data/2, open_url/3]). @@ -126,6 +129,7 @@ start(Mode, LogDir, Verbosity) -> do_start(Parent, Mode, LogDir, Verbosity) -> process_flag(trap_exit,true), register(ct_util_server,self()), + mark_process(), create_table(?conn_table,#conn.handle), create_table(?board_table,2), create_table(?suite_table,#suite_data.key), @@ -795,25 +799,25 @@ parse_table(Data) -> {Heading,Lines}. get_headings(["|" ++ Headings | Rest]) -> - {remove_space(string:tokens(Headings, "|"),[]), Rest}; + {remove_space(string:lexemes(Headings, "|"),[]), Rest}; get_headings([_ | Rest]) -> get_headings(Rest); get_headings([]) -> {{},[]}. parse_row(["|" ++ _ = Row | T], Rows, NumCols) when NumCols > 1 -> - case string:tokens(Row, "|") of + case string:lexemes(Row, "|") of Values when length(Values) =:= NumCols -> parse_row(T,[remove_space(Values,[])|Rows], NumCols); Values when length(Values) < NumCols -> parse_row([Row ++"\n"++ hd(T) | tl(T)], Rows, NumCols) end; -parse_row(["|" ++ _ = Row | T], Rows, 1 = NumCols) -> - case string:rchr(Row, $|) of - 1 -> +parse_row(["|" ++ X = Row | T], Rows, 1 = NumCols) -> + case string:find(X, [$|]) of + nomatch -> parse_row([Row ++"\n"++hd(T) | tl(T)], Rows, NumCols); _Else -> - parse_row(T, [remove_space(string:tokens(Row,"|"),[])|Rows], + parse_row(T, [remove_space(string:lexemes(Row,"|"),[])|Rows], NumCols) end; parse_row([_Skip | T], Rows, NumCols) -> @@ -822,7 +826,7 @@ parse_row([], Rows, _NumCols) -> lists:reverse(Rows). remove_space([Str|Rest],Acc) -> - remove_space(Rest,[string:strip(string:strip(Str),both,$')|Acc]); + remove_space(Rest,[string:trim(string:trim(Str,both,[$\s]),both,[$'])|Acc]); remove_space([],Acc) -> list_to_tuple(lists:reverse(Acc)). @@ -832,7 +836,7 @@ remove_space([],Acc) -> %%% %%% @doc is_test_dir(Dir) -> - lists:last(string:tokens(filename:basename(Dir), "_")) == "test". + lists:last(string:lexemes(filename:basename(Dir), "_")) == "test". %%%----------------------------------------------------------------- %%% @spec @@ -934,6 +938,70 @@ warn_duplicates(Suites) -> %%% @spec %%% %%% @doc +mark_process() -> + mark_process(system). + +mark_process(Type) -> + put(ct_process_type, Type). + +is_marked(Pid) -> + is_marked(Pid, system). + +is_marked(Pid, Type) -> + case process_info(Pid, dictionary) of + {dictionary,List} -> + Type == proplists:get_value(ct_process_type, List); + undefined -> + false + end. + +remaining_test_procs() -> + Procs = processes(), + {SharedGL,OtherGLs,Procs2} = + lists:foldl( + fun(Pid, ProcTypes = {Shared,Other,Procs1}) -> + case is_marked(Pid, group_leader) of + true -> + if not is_pid(Shared) -> + case test_server_io:get_gl(true) of + Pid -> + {Pid,Other, + lists:delete(Pid,Procs1)}; + _ -> + {Shared,[Pid|Other],Procs1} + end; + true -> % SharedGL already found + {Shared,[Pid|Other],Procs1} + end; + false -> + case is_marked(Pid) of + true -> + {Shared,Other,lists:delete(Pid,Procs1)}; + false -> + ProcTypes + end + end + end, {undefined,[],Procs}, Procs), + + AllGLs = [SharedGL | OtherGLs], + TestProcs = + lists:flatmap(fun(Pid) -> + case process_info(Pid, group_leader) of + {group_leader,GL} -> + case lists:member(GL, AllGLs) of + true -> [{Pid,GL}]; + false -> [] + end; + undefined -> + [] + end + end, Procs2), + {TestProcs, SharedGL, OtherGLs}. + +%%%----------------------------------------------------------------- +%%% @spec +%%% +%%% @doc get_profile_data() -> get_profile_data(all). @@ -1077,7 +1145,7 @@ open_url(iexplore, Args, URL) -> _ = case win32reg:values(R) of {ok, Paths} -> Path = proplists:get_value(default, Paths), - [Cmd | _] = string:tokens(Path, "%"), + [Cmd | _] = string:lexemes(Path, "%"), Cmd1 = Cmd ++ " " ++ Args ++ " " ++ URL, io:format(?def_gl, "~nOpening ~ts with command:~n ~ts~n", [URL,Cmd1]), open_port({spawn,Cmd1}, []); diff --git a/lib/common_test/src/ct_webtool.erl b/lib/common_test/src/ct_webtool.erl index 9016aca899..82aa78fc4b 100644 --- a/lib/common_test/src/ct_webtool.erl +++ b/lib/common_test/src/ct_webtool.erl @@ -343,6 +343,7 @@ code_change(_,State,_)-> % Start the gen_server %---------------------------------------------------------------------- init({Path,Config})-> + ct_util:mark_process(), case filelib:is_dir(Path) of true -> {ok, Table} = get_tool_files_data(), diff --git a/lib/common_test/src/ct_webtool_sup.erl b/lib/common_test/src/ct_webtool_sup.erl index c02ec69d04..6c6dbde0a6 100644 --- a/lib/common_test/src/ct_webtool_sup.erl +++ b/lib/common_test/src/ct_webtool_sup.erl @@ -46,6 +46,7 @@ stop(Pid)-> %% {error, Reason} %%---------------------------------------------------------------------- init(_StartArgs) -> + ct_util:mark_process(), %%Child1 = %%Child2 ={webcover_backend,{webcover_backend,start_link,[]},permanent,2000,worker,[webcover_backend]}, %%{ok,{{simple_one_for_one,5,10},[Child1]}}. diff --git a/lib/common_test/src/cth_log_redirect.erl b/lib/common_test/src/cth_log_redirect.erl index 8b29d0f96d..b05f0bd28b 100644 --- a/lib/common_test/src/cth_log_redirect.erl +++ b/lib/common_test/src/cth_log_redirect.erl @@ -56,6 +56,7 @@ id(_Opts) -> ?MODULE. init(?MODULE, _Opts) -> + ct_util:mark_process(), error_logger:add_report_handler(?MODULE), tc_log_async. @@ -121,8 +122,8 @@ handle_event({_Type,GL,_Msg}, #eh_state{handle_remote_events = false} = State) when node(GL) /= node() -> {ok, State}; handle_event(Event, #eh_state{log_func = LogFunc} = State) -> - case lists:keyfind(sasl, 1, application:which_applications()) of - false -> + case whereis(sasl_sup) of + undefined -> sasl_not_started; _Else -> {ok, ErrLogType} = application:get_env(sasl, errlog_type), diff --git a/lib/common_test/src/cth_surefire.erl b/lib/common_test/src/cth_surefire.erl index da68bd105e..4407ff56c1 100644 --- a/lib/common_test/src/cth_surefire.erl +++ b/lib/common_test/src/cth_surefire.erl @@ -184,15 +184,14 @@ end_tc(Name, _Config, _Res, State = #state{ curr_suite = Suite, Log = case Log0 of "" -> - LowerSuiteName = string:to_lower(atom_to_list(Suite)), + LowerSuiteName = string:lowercase(atom_to_list(Suite)), filename:join(CurrLogDir,LowerSuiteName++"."++Name++".html"); _ -> Log0 end, Url = make_url(UrlBase,Log), ClassName = atom_to_list(Suite), - PGroup = string:join([ atom_to_list(Group)|| - Group <- lists:reverse(Groups)],"."), + PGroup = lists:concat(lists:join(".",lists:reverse(Groups))), TimeTakes = io_lib:format("~f",[timer:now_diff(?now,TS) / 1000000]), State#state{ test_cases = [#testcase{ log = Log, url = Url, @@ -317,9 +316,9 @@ make_url(undefined,_) -> make_url(_,[]) -> undefined; make_url(UrlBase0,Log) -> - UrlBase = string:strip(UrlBase0,right,$/), + UrlBase = string:trim(UrlBase0,trailing,[$/]), RelativeLog = get_relative_log_url(Log), - string:join([UrlBase,RelativeLog],"/"). + lists:flatten(lists:join($/,[UrlBase,RelativeLog])). get_test_root(Log) -> LogParts = filename:split(Log), @@ -329,7 +328,7 @@ get_relative_log_url(Log) -> LogParts = filename:split(Log), Start = length(LogParts)-?log_depth, Length = ?log_depth+1, - string:join(lists:sublist(LogParts,Start,Length),"/"). + lists:flatten(lists:join($/,lists:sublist(LogParts,Start,Length))). count_tcs([#testcase{name=ConfCase}|TCs],Ok,F,S) when ConfCase=="init_per_suite"; diff --git a/lib/common_test/src/test_server.erl b/lib/common_test/src/test_server.erl index dc6b7a536c..7250041e13 100644 --- a/lib/common_test/src/test_server.erl +++ b/lib/common_test/src/test_server.erl @@ -415,6 +415,7 @@ run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> St = #st{ref=Ref,pid=Pid,mf={Mod,Func},last_known_loc=unknown, status=starting,ret_val=[],comment="",timeout=infinity, config=hd(Args)}, + ct_util:mark_process(), run_test_case_msgloop(St). %% Ugly bug (pre R5A): @@ -462,11 +463,12 @@ run_test_case_msgloop(#st{ref=Ref,pid=Pid,end_conf_pid=EndConfPid0}=St0) -> %% it as a comment, potentially replacing user data Error = lists:flatten(io_lib:format("Aborted: ~tp", [Reason])), - Error1 = lists:flatten([string:strip(S,left) || - S <- string:tokens(Error, - [$\n])]), - Comment = if length(Error1) > 63 -> - string:substr(Error1,1,60) ++ "..."; + Error1 = lists:flatten([string:trim(S,leading,"\s") || + S <- string:lexemes(Error, + [$\n])]), + ErrorLength = string:length(Error1), + Comment = if ErrorLength > 63 -> + string:slice(Error1,0,60) ++ "..."; true -> Error1 end, @@ -784,6 +786,7 @@ spawn_fw_call(Mod,IPTC={init_per_testcase,Func},CurrConf,Pid, Why,Loc,SendTo) -> FwCall = fun() -> + ct_util:mark_process(), Skip = {skip,{failed,{Mod,init_per_testcase,Why}}}, %% if init_per_testcase fails, the test case %% should be skipped @@ -814,6 +817,7 @@ spawn_fw_call(Mod,EPTC={end_per_testcase,Func},EndConf,Pid, Why,_Loc,SendTo) -> FwCall = fun() -> + ct_util:mark_process(), {RetVal,Report} = case proplists:get_value(tc_status, EndConf) of undefined -> @@ -863,6 +867,7 @@ spawn_fw_call(Mod,EPTC={end_per_testcase,Func},EndConf,Pid, spawn_fw_call(FwMod,FwFunc,_,_Pid,{framework_error,FwError},_,SendTo) -> FwCall = fun() -> + ct_util:mark_process(), test_server_sup:framework_call(report, [framework_error, {{FwMod,FwFunc}, FwError}]), @@ -879,6 +884,7 @@ spawn_fw_call(FwMod,FwFunc,_,_Pid,{framework_error,FwError},_,SendTo) -> spawn_link(FwCall); spawn_fw_call(Mod,Func,CurrConf,Pid,Error,Loc,SendTo) -> + ct_util:mark_process(), {Func1,EndTCFunc} = case Func of CF when CF == init_per_suite; CF == end_per_suite; CF == init_per_group; CF == end_per_group -> @@ -917,6 +923,7 @@ start_job_proxy() -> %% The io_reply_proxy is not the most satisfying solution but it works... io_reply_proxy(ReplyTo) -> + ct_util:mark_process(), receive IoReply when is_tuple(IoReply), element(1, IoReply) == io_reply -> @@ -926,6 +933,7 @@ io_reply_proxy(ReplyTo) -> end. job_proxy_msgloop() -> + ct_util:mark_process(), receive %% @@ -1803,6 +1811,7 @@ break(CBM, TestCase, Comment) -> spawn_break_process(Pid, PName) -> spawn(fun() -> register(PName, self()), + ct_util:mark_process(), receive continue -> continue(Pid); cancel -> ok @@ -2000,6 +2009,7 @@ time_ms_apply(Func, TCPid, MultAndScale) -> user_timetrap_supervisor(Func, Spawner, TCPid, GL, T0, MultAndScale) -> process_flag(trap_exit, true), + ct_util:mark_process(), Spawner ! {self(),infinity}, MonRef = monitor(process, TCPid), UserTTSup = self(), @@ -2570,6 +2580,7 @@ run_on_shielded_node(Fun, CArgs) when is_function(Fun), is_list(CArgs) -> -spec start_job_proxy_fun(_, _) -> fun(() -> no_return()). start_job_proxy_fun(Master, Fun) -> fun () -> + ct_util:mark_process(), _ = start_job_proxy(), receive Ref -> @@ -2697,9 +2708,9 @@ is_cover() -> is_debug() -> case catch erlang:system_info(debug_compiled) of {'EXIT', _} -> - case string:str(erlang:system_info(system_version), "debug") of - Int when is_integer(Int), Int > 0 -> true; - _ -> false + case string:find(erlang:system_info(system_version), "debug") of + nomatch -> false; + _ -> true end; Res -> Res @@ -2735,9 +2746,9 @@ has_superfluous_schedulers() -> %% We might want to do more tests on a commercial platform, for instance %% ensuring that all applications have documentation). is_commercial() -> - case string:str(erlang:system_info(system_version), "source") of - Int when is_integer(Int), Int > 0 -> false; - _ -> true + case string:find(erlang:system_info(system_version), "source") of + nomatch -> true; + _ -> false end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/common_test/src/test_server_ctrl.erl b/lib/common_test/src/test_server_ctrl.erl index 71978c7267..3a454a1e84 100644 --- a/lib/common_test/src/test_server_ctrl.erl +++ b/lib/common_test/src/test_server_ctrl.erl @@ -89,6 +89,7 @@ -define(logdir_ext, ".logs"). -define(data_dir_suffix, "_data/"). -define(suitelog_name, "suite.log"). +-define(suitelog_latest_name, "suite.log.latest"). -define(coverlog_name, "cover.html"). -define(raw_coverlog_name, "cover.log"). -define(cross_coverlog_name, "cross_cover.html"). @@ -1126,6 +1127,7 @@ init_tester(Mod, Func, Args, Dir, Name, {_,_,MinLev}=Levels, RejectIoReqs, CreatePrivDir, TCCallback, ExtraTools) -> process_flag(trap_exit, true), _ = test_server_io:start_link(), + put(app, common_test), put(test_server_name, Name), put(test_server_dir, Dir), put(test_server_total_time, 0), @@ -1150,6 +1152,12 @@ init_tester(Mod, Func, Args, Dir, Name, {_,_,MinLev}=Levels, end, %% before first print, read and set logging options + FWLogDir = + case test_server_sup:framework_call(get_log_dir, [], []) of + {ok,FwDir} -> FwDir; + _ -> filename:dirname(Dir) + end, + put(test_server_framework_logdir, FWLogDir), LogOpts = test_server_sup:framework_call(get_logopts, [], []), put(test_server_logopts, LogOpts), @@ -1464,13 +1472,14 @@ get_suites([], Mods) -> lists:reverse(Mods). add_mod(Mod, Mods) -> - case string:rstr(atom_to_list(Mod), "_SUITE") of - 0 -> false; - _ -> % test suite + case lists:reverse(atom_to_list(Mod)) of + "ETIUS_" ++ _ -> % test suite case lists:member(Mod, Mods) of true -> false; false -> true - end + end; + _ -> + false end. @@ -1711,6 +1720,12 @@ start_log_file() -> test_server_io:set_fd(html, Html), test_server_io:set_fd(unexpected_io, Unexpected), + %% we must assume the redirection file (to the latest suite index) can + %% be stored on the level above the log directory of the current test + TopDir = filename:dirname(get(test_server_framework_logdir)), + RedirectLink = filename:join(TopDir, ?suitelog_latest_name ++ ?html_ext), + make_html_link(RedirectLink, HtmlName, redirect), + make_html_link(filename:absname(?last_test ++ ?html_ext), HtmlName, filename:basename(Dir)), LinkName = filename:join(Dir, ?last_link), @@ -1739,11 +1754,18 @@ make_html_link(LinkName, Target, Explanation) -> false -> "file:" ++ uri_encode(Target) end, - H = [html_header(Explanation), - "<h1>Last test</h1>\n" - "<a href=\"",Href,"\">",Explanation,"</a>\n" - "</body>\n</html>\n"], + H = if Explanation == redirect -> + Meta = ["<meta http-equiv=\"refresh\" " + "content=\"0; url=", Href, "\" />\n"], + [html_header("redirect", Meta), "</html>\n"]; + true -> + [html_header(Explanation), + "<h1>Last test</h1>\n" + "<a href=\"",Href,"\">",Explanation,"</a>\n" + "</body>\n</html>\n"] + end, ok = write_html_file(LinkName, H). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% start_minor_log_file(Mod, Func, ParallelTC) -> AbsName @@ -2611,7 +2633,7 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, NumStr -> %% Ex: "123 456 789" or "123,456,789" -> {123,456,789} list_to_tuple([list_to_integer(NS) || - NS <- string:tokens(NumStr, [$ ,$:,$,])]) + NS <- string:lexemes(NumStr, [$ ,$:,$,])]) end, {shuffle_cases(Ref, Cs0, UseSeed),{shuffle,UseSeed}} end; @@ -3704,6 +3726,7 @@ run_test_case(Ref, Num, Mod, Func, Args, RunInit, TimetrapData, Mode) -> spawn_link( fun() -> process_flag(trap_exit, true), + ct_util:mark_process(), _ = [put(Key, Val) || {Key,Val} <- Dictionary], set_io_buffering({tc,Main}), run_test_case1(Ref, Num, Mod, Func, Args, RunInit, @@ -3979,11 +4002,12 @@ progress(skip, CaseNum, Mod, Func, GrName, Loc, Reason, Time, true -> "~w" end, [Time]), ReasonStr = escape_chars(reason_to_string(Reason1)), - ReasonStr1 = lists:flatten([string:strip(S,left) || - S <- string:tokens(ReasonStr,[$\n])]), + ReasonStr1 = lists:flatten([string:trim(S,leading,"\s") || + S <- string:lexemes(ReasonStr,[$\n])]), + ReasonLength = string:length(ReasonStr1), ReasonStr2 = - if length(ReasonStr1) > 80 -> - string:substr(ReasonStr1, 1, 77) ++ "..."; + if ReasonLength > 80 -> + string:slice(ReasonStr1, 0, 77) ++ "..."; true -> ReasonStr1 end, @@ -4067,11 +4091,12 @@ progress(failed, CaseNum, Mod, Func, GrName, unknown, Reason, Time, true -> "~w" end, [Time]), ErrorReason = escape_chars(lists:flatten(io_lib:format("~tp", [Reason]))), - ErrorReason1 = lists:flatten([string:strip(S,left) || - S <- string:tokens(ErrorReason,[$\n])]), + ErrorReason1 = lists:flatten([string:trim(S,leading,"\s") || + S <- string:lexemes(ErrorReason,[$\n])]), + ErrorReasonLength = string:length(ErrorReason1), ErrorReason2 = - if length(ErrorReason1) > 63 -> - string:substr(ErrorReason1, 1, 60) ++ "..."; + if ErrorReasonLength > 63 -> + string:slice(ErrorReason1, 0, 60) ++ "..."; true -> ErrorReason1 end, @@ -5655,6 +5680,13 @@ html_header(Title) -> "<body bgcolor=\"white\" text=\"black\" " "link=\"blue\" vlink=\"purple\" alink=\"red\">\n"]. +html_header(Title, Meta) -> + ["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n" + "<!-- autogenerated by '", atom_to_list(?MODULE), "'. -->\n" + "<html>\n" + "<head>\n" + "<title>", Title, "</title>\n"] ++ Meta ++ ["</head>\n"]. + open_html_file(File) -> open_utf8_file(File). diff --git a/lib/common_test/src/test_server_gl.erl b/lib/common_test/src/test_server_gl.erl index ce7682d101..24dd5cd54c 100644 --- a/lib/common_test/src/test_server_gl.erl +++ b/lib/common_test/src/test_server_gl.erl @@ -132,6 +132,7 @@ set_props(GL, PropList) -> %%% Internal functions. init([TSIO]) -> + ct_util:mark_process(group_leader), EscChars = case application:get_env(test_server, esc_chars) of {ok,ECBool} -> ECBool; _ -> true diff --git a/lib/common_test/src/test_server_io.erl b/lib/common_test/src/test_server_io.erl index 062e3bd8ff..ef31521950 100644 --- a/lib/common_test/src/test_server_io.erl +++ b/lib/common_test/src/test_server_io.erl @@ -184,6 +184,7 @@ reset_state() -> init([]) -> process_flag(trap_exit, true), + ct_util:mark_process(), Empty = gb_trees:empty(), {ok,Shared} = test_server_gl:start_link(self()), {ok,#st{fds=Empty,shared_gl=Shared,gls=gb_sets:empty(), @@ -262,7 +263,7 @@ handle_call(reset_state, From, #st{phase=stopping,pending_ops=Ops}=St) -> {Result,NewSt1} end, {noreply,St#st{pending_ops=[{From,Op}|Ops]}}; -handle_call(reset_state, _From, #st{fds=Fds,tags=Tags,gls=Gls, +handle_call(reset_state, _From, #st{fds=Fds,tags=Tags,shared_gl=Shared0,gls=Gls, offline_buffer=OfflineBuff}) -> %% close open log files lists:foreach(fun(Tag) -> @@ -273,6 +274,7 @@ handle_call(reset_state, _From, #st{fds=Fds,tags=Tags,gls=Gls, file:close(Fd) end end, Tags), + test_server_gl:stop(Shared0), GlList = gb_sets:to_list(Gls), _ = [test_server_gl:stop(GL) || GL <- GlList], timer:sleep(100), @@ -320,7 +322,7 @@ handle_call(finish, From, St) -> handle_info({'EXIT',Pid,normal}, #st{gls=Gls0,stopping=From}=St) -> Gls = gb_sets:delete_any(Pid, Gls0), - case gb_sets:is_empty(Gls) andalso stopping =/= undefined of + case gb_sets:is_empty(Gls) andalso From =/= undefined of true -> %% No more group leaders left. gen_server:reply(From, ok), @@ -329,6 +331,9 @@ handle_info({'EXIT',Pid,normal}, #st{gls=Gls0,stopping=From}=St) -> %% Wait for more group leaders to finish. {noreply,St#st{gls=Gls,phase=stopping}} end; +handle_info({'EXIT',Pid,killed}, #st{gls=Gls0}=St) -> + %% forced termination of group leader + {noreply,St#st{gls=gb_sets:delete_any(Pid, Gls0)}}; handle_info({'EXIT',_Pid,Reason}, _St) -> exit(Reason); handle_info(stop_group_leaders, #st{gls=Gls}=St) -> diff --git a/lib/common_test/src/test_server_node.erl b/lib/common_test/src/test_server_node.erl index c0d7e12721..b2d4f199c3 100644 --- a/lib/common_test/src/test_server_node.erl +++ b/lib/common_test/src/test_server_node.erl @@ -315,9 +315,11 @@ start_node_peer(SlaveName, OptList, From, TI) -> Prog0 = start_node_get_option_value(erl, OptList, default), Prog = quote_progname(pick_erl_program(Prog0)), Args = - case string:str(SuppliedArgs,"-setcookie") of - 0 -> "-setcookie " ++ TI#target_info.cookie ++ " " ++ SuppliedArgs; - _ -> SuppliedArgs + case string:find(SuppliedArgs,"-setcookie") of + nomatch -> + "-setcookie " ++ TI#target_info.cookie ++ " " ++ SuppliedArgs; + _ -> + SuppliedArgs end, Cmd = lists:concat([Prog, " -detached ", @@ -612,7 +614,7 @@ pick_erl_program(L) -> %% emulator and flags as the test node. The return from lib:progname() %% could then typically be '/<full_path_to>/cerl -gcov'). quote_progname(Progname) -> - do_quote_progname(string:tokens(Progname," ")). + do_quote_progname(string:lexemes(Progname," ")). do_quote_progname([Prog]) -> "\""++Prog++"\""; @@ -747,6 +749,7 @@ unpack(Bin) -> id(I) -> I. print_data(Port) -> + ct_util:mark_process(), receive {Port, {data, Bytes}} -> io:put_chars(Bytes), diff --git a/lib/common_test/src/test_server_sup.erl b/lib/common_test/src/test_server_sup.erl index 21f4be22fe..6ddbf1ad27 100644 --- a/lib/common_test/src/test_server_sup.erl +++ b/lib/common_test/src/test_server_sup.erl @@ -56,6 +56,7 @@ timetrap(Timeout0, Scale, Pid) -> timetrap(Timeout0, ReportTVal, Scale, Pid) -> process_flag(priority, max), + ct_util:mark_process(), Timeout = if not Scale -> Timeout0; true -> test_server:timetrap_scale_factor() * Timeout0 end, @@ -773,6 +774,7 @@ framework_call(Callback,Func,Args,DefaultReturn) -> false -> ok end, + ct_util:mark_process(), try apply(Mod,Func,Args) of Result -> Result @@ -850,6 +852,7 @@ util_start() -> undefined -> spawn_link(fun() -> register(?MODULE, self()), + put(app, common_test), util_loop(#util_state{starter=Starter}) end), ok; diff --git a/lib/common_test/src/unix_telnet.erl b/lib/common_test/src/unix_telnet.erl index 8ac467014c..5992f26e6d 100644 --- a/lib/common_test/src/unix_telnet.erl +++ b/lib/common_test/src/unix_telnet.erl @@ -121,7 +121,8 @@ connect1(Name,Ip,Port,Timeout,KeepAlive,TCPNoDelay,Username,Password) -> prompt,?prx,[]) of {ok,{prompt,?password},_} -> ok = ct_telnet_client:send_data(Pid,Password), - Stars = lists:duplicate(length(Password),$*), + Stars = + lists:duplicate(string:length(Password),$*), log(Name,send,"Password: ~s",[Stars]), % ok = ct_telnet_client:send_data(Pid,""), case ct_telnet:silent_teln_expect(Name,Pid,[], diff --git a/lib/common_test/src/vts.erl b/lib/common_test/src/vts.erl index 99a109cfe8..83fcde2f48 100644 --- a/lib/common_test/src/vts.erl +++ b/lib/common_test/src/vts.erl @@ -157,6 +157,7 @@ test_info(_VtsPid,Type,Data) -> init(Parent) -> register(?MODULE,self()), process_flag(trap_exit,true), + ct_util:mark_process(), Parent ! {self(),started}, {ok,Cwd} = file:get_cwd(), InitState = #state{start_dir=Cwd}, @@ -284,6 +285,7 @@ run_test1(State=#state{tests=Tests,current_log_dir=LogDir, logopts=LogOpts}) -> Self=self(), RunTest = fun() -> + ct_util:mark_process(), case ct_run:do_run(Tests,[],LogDir,LogOpts) of {error,_Reason} -> aborted(); diff --git a/lib/common_test/test/Makefile b/lib/common_test/test/Makefile index 0d9149f489..ecd1f727a2 100644 --- a/lib/common_test/test/Makefile +++ b/lib/common_test/test/Makefile @@ -73,7 +73,8 @@ MODULES= \ ct_log_SUITE \ ct_SUITE \ ct_keep_logs_SUITE \ - ct_unicode_SUITE + ct_unicode_SUITE \ + ct_auto_clean_SUITE ERL_FILES= $(MODULES:%=%.erl) HRL_FILES= test_server_test_lib.hrl diff --git a/lib/common_test/test/ct_auto_clean_SUITE.erl b/lib/common_test/test/ct_auto_clean_SUITE.erl new file mode 100644 index 0000000000..fd81430d0d --- /dev/null +++ b/lib/common_test/test/ct_auto_clean_SUITE.erl @@ -0,0 +1,262 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(ct_auto_clean_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). + +%%-------------------------------------------------------------------- +%% Function: init_per_suite(Config0) -> Config1 | {skip,Reason} +%% +%% Config0 = Config1 = [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% Reason = term() +%% The reason for skipping the suite. +%% +%% 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), + CTHs = filelib:wildcard(filename:join(DataDir,"cth_*.erl")), + ct:pal("CTHs: ~p",[CTHs]), + [ct:pal("Compiling ~p: ~p", + [FileName,compile:file(FileName,[{outdir,DataDir},debug_info])]) || + FileName <- CTHs], + ct_test_support:init_per_suite([{path_dirs,[DataDir]} | Config]). + +%%-------------------------------------------------------------------- +%% Function: end_per_suite(Config) -> void() +%% +%% Config = [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% +%% Description: Cleanup after the suite. +%%-------------------------------------------------------------------- +end_per_suite(Config) -> + ct_test_support:end_per_suite(Config). + +%%-------------------------------------------------------------------- +%% Function: init_per_testcase(TestCase, Config0) -> Config1 | +%% {skip,Reason} +%% TestCase = atom() +%% Name of the test case that is about to run. +%% Config0 = Config1 = [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% Reason = term() +%% The reason for skipping the test case. +%% +%% Description: Initialization before each test case. +%% +%% Note: This function is free to add any key/value pairs to the Config +%% variable, but should NOT alter/remove any existing entries. +%%-------------------------------------------------------------------- +init_per_testcase(TestCase, Config) -> + ct_test_support:init_per_testcase(TestCase, Config). + +%%-------------------------------------------------------------------- +%% Function: end_per_testcase(TestCase, Config) -> void() +%% +%% TestCase = atom() +%% Name of the test case that is finished. +%% Config = [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% +%% Description: Cleanup after each test case. +%%-------------------------------------------------------------------- +end_per_testcase(TestCase, Config) -> + ct_test_support:end_per_testcase(TestCase, Config). + +%%-------------------------------------------------------------------- +%% Function: all(Clause) -> Descr | TestCases | {skip,Reason} +%% +%% Clause = doc | suite +%% Indicates expected return value. +%% Descr = [string()] | [] +%% String that describes the test suite. +%% TestCases = [TestCase] +%% TestCase = atom() +%% Name of a test case. +%% Reason = term() +%% The reason for skipping the test suite. +%% +%% Description: Returns a description of the test suite (doc) and a +%% list of all test cases in the suite (suite). +%%-------------------------------------------------------------------- +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [clean]. + +groups() -> + []. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +%%-------------------------------------------------------------------- +%% TEST CASES +%%-------------------------------------------------------------------- + +%%-------------------------------------------------------------------- +%% Function: TestCase(Arg) -> Descr | Spec | ok | exit() | {skip,Reason} +%% +%% Arg = doc | suite | Config +%% Indicates expected behaviour and return value. +%% Config = [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% Descr = [string()] | [] +%% String that describes the test case. +%% Spec = [tuple()] | [] +%% A test specification. +%% Reason = term() +%% The reason for skipping the test case. +%% +%% Description: Test case function. Returns a description of the test +%% case (doc), then returns a test specification (suite), +%% or performs the actual test (Config). +%%-------------------------------------------------------------------- + +%%%----------------------------------------------------------------- +%%% + +clean(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + + ACSuite = filename:join(DataDir, "ac_SUITE"), + Opts0 = ct_test_support:get_opts(Config), + Opts = eh_opts(Config) ++ Opts0 ++ [{suite,ACSuite}, + {ct_hooks,[cth_auto_clean]}], + + ERPid = ct_test_support:start_event_receiver(Config), + + ok = ct_test_support:run(Opts, Config), + + Events = ct_test_support:get_events(ERPid, Config), + ct_test_support:log_events(?FUNCTION_NAME, + ct_test_support:reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), + TestEvents = events_to_check(?FUNCTION_NAME), + ok = ct_test_support:verify_events(TestEvents, Events, Config). + + +%%%----------------------------------------------------------------- +%%% HELP FUNCTIONS +%%%----------------------------------------------------------------- + +eh_opts(Config) -> + Level = ?config(trace_level, Config), + [{event_handler,{?eh,[{cbm,ct_test_support},{trace_level,Level}]}}]. + +events_to_check(Test) -> + %% 2 tests (ct:run_test + script_start) is default + events_to_check(Test, 2). + +events_to_check(_, 0) -> + []; +events_to_check(Test, N) -> + events(Test) ++ events_to_check(Test, N-1). + +events(clean) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,9}}, + + {?eh,tc_start,{ac_SUITE,init_per_suite}}, + {?eh,tc_done,{ac_SUITE,init_per_suite,ok}}, + + {?eh,tc_start,{ac_SUITE,tc1}}, + {?eh,tc_done,{ac_SUITE,tc1,ok}}, + + {?eh,test_stats,{1,0,{0,0}}}, + + {?eh,tc_start,{ac_SUITE,tc2}}, + {?eh,tc_done,{ac_SUITE,tc2,ok}}, + + {?eh,test_stats,{2,0,{0,0}}}, + + [{?eh,tc_start,{ac_SUITE,{init_per_group,s1,[]}}}, + {?eh,tc_done,{ac_SUITE,{init_per_group,s1,[]},ok}}, + + {?eh,tc_start,{ac_SUITE,stc1}}, + {?eh,tc_done,{ac_SUITE,stc1,ok}}, + + {?eh,test_stats,{3,0,{0,0}}}, + + {?eh,tc_start,{ac_SUITE,stc2}}, + {?eh,tc_done,{ac_SUITE,stc2,ok}}, + + {?eh,test_stats,{4,0,{0,0}}}, + + {?eh,tc_start,{ac_SUITE,{end_per_group,s1,[]}}}, + {?eh,tc_done,{ac_SUITE,{end_per_group,s1,[]},ok}}], + + {parallel, + [{?eh,tc_start,{ac_SUITE,{init_per_group,p1,[parallel]}}}, + {?eh,tc_done,{ac_SUITE,{init_per_group,p1,[parallel]},ok}}, + + {?eh,tc_start,{ac_SUITE,ptc1}}, + {?eh,tc_start,{ac_SUITE,ptc2}}, + {?eh,tc_done,{ac_SUITE,ptc1,ok}}, + {?eh,test_stats,{5,0,{0,0}}}, + {?eh,tc_done,{ac_SUITE,ptc2,ok}}, + {?eh,test_stats,{6,0,{0,0}}}, + + {?eh,tc_start,{ac_SUITE,{end_per_group,p1,[parallel]}}}, + {?eh,tc_done,{ac_SUITE,{end_per_group,p1,[parallel]},ok}}]}, + + [{?eh,tc_start,{ac_SUITE,{init_per_group,s2,[]}}}, + {?eh,tc_done,{ac_SUITE,{init_per_group,s2,[]},ok}}, + + {?eh,tc_start,{ac_SUITE,stc1}}, + {?eh,tc_done,{ac_SUITE,stc1,ok}}, + + {?eh,test_stats,{7,0,{0,0}}}, + + {?eh,tc_start,{ac_SUITE,stc2}}, + {?eh,tc_done,{ac_SUITE,stc2,ok}}, + + {?eh,test_stats,{8,0,{0,0}}}, + + {?eh,tc_start,{ac_SUITE,{end_per_group,s2,[]}}}, + {?eh,tc_done,{ac_SUITE,{end_per_group,s2,[]},ok}}], + + {?eh,tc_start,{ac_SUITE,tc1}}, + {?eh,tc_done,{ac_SUITE,tc1,ok}}, + + {?eh,test_stats,{9,0,{0,0}}}, + + {?eh,tc_start,{ac_SUITE,end_per_suite}}, + {?eh,tc_done,{ac_SUITE,end_per_suite,ok}}, + + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]. diff --git a/lib/common_test/test/ct_auto_clean_SUITE_data/ac_SUITE.erl b/lib/common_test/test/ct_auto_clean_SUITE_data/ac_SUITE.erl new file mode 100644 index 0000000000..dae7c1e22c --- /dev/null +++ b/lib/common_test/test/ct_auto_clean_SUITE_data/ac_SUITE.erl @@ -0,0 +1,181 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(ac_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) -> + start_processes(), + Config. + +%%-------------------------------------------------------------------- +%% @spec end_per_suite(Config0) -> term() | {save_config,Config1} +%% Config0 = Config1 = [tuple()] +%% @end +%%-------------------------------------------------------------------- +end_per_suite(_Config) -> + start_processes(), + 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) -> + start_processes(), + Config. + +%%-------------------------------------------------------------------- +%% @spec end_per_group(GroupName, Config0) -> +%% term() | {save_config,Config1} +%% GroupName = atom() +%% Config0 = Config1 = [tuple()] +%% @end +%%-------------------------------------------------------------------- +end_per_group(_GroupName, _Config) -> + start_processes(), + 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) -> + start_processes(), + Config. + +%%-------------------------------------------------------------------- +%% @spec end_per_testcase(TestCase, Config0) -> +%% term() | {save_config,Config1} | {fail,Reason} +%% TestCase = atom() +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +end_per_testcase(_TestCase, _Config) -> + start_processes(), + 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() -> + [{s1,[],[stc1,stc2]}, + {p1,[parallel],[ptc1,ptc2]}, + {s2,[],[stc1,stc2]}]. + +%%! What about nested groups?? + +%%-------------------------------------------------------------------- +%% @spec all() -> GroupsAndTestCases | {skip,Reason} +%% GroupsAndTestCases = [{group,GroupName} | TestCase] +%% GroupName = atom() +%% TestCase = atom() +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +all() -> + [ + [tc1,tc2], + {group,s1}, + {group,p1}, + {group,s2}, + tc1 + ]. + +tc1(_Config) -> + start_processes(), + ok. + +tc2(_Config) -> + start_processes(), + ok. + +stc1(_Config) -> + start_processes(), + ok. + +stc2(_Config) -> + start_processes(), + ok. + +ptc1(_Config) -> + start_processes(), + ok. + +ptc2(_Config) -> + start_processes(), + ok. + + +%%%----------------------------------------------------------------- +%%% + +start_processes() -> + Init = fun() -> + process_flag(trap_exit, true), + do_spawn(fun() -> receive _ -> ok end end), + receive _ -> + ok + end + end, + do_spawn(Init). + +do_spawn(Fun) -> + Pid = spawn(Fun), + ct:log("Process ~w started with group leader ~w", + [Pid,element(2, process_info(Pid, group_leader))]), + Pid. diff --git a/lib/common_test/test/ct_auto_clean_SUITE_data/cth_auto_clean.erl b/lib/common_test/test/ct_auto_clean_SUITE_data/cth_auto_clean.erl new file mode 100644 index 0000000000..137c81969d --- /dev/null +++ b/lib/common_test/test/ct_auto_clean_SUITE_data/cth_auto_clean.erl @@ -0,0 +1,214 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(cth_auto_clean). + +%% CTH Callbacks +-export([id/1, init/2, + pre_init_per_suite/3, post_init_per_suite/4, + pre_end_per_suite/3, post_end_per_suite/4, + pre_init_per_group/4, post_init_per_group/5, + pre_end_per_group/4, post_end_per_group/5, + pre_init_per_testcase/4, post_init_per_testcase/5, + pre_end_per_testcase/4, post_end_per_testcase/5]). + +id(_Opts) -> + ?MODULE. + +init(?MODULE, _Opts) -> + ok. + +pre_init_per_suite(_Suite, Config, State) -> + identify(?FUNCTION_NAME), + SharedGL = test_server_io:get_gl(true), + SharedGL = find_and_kill(), + do_until(fun() -> ct:remaining_test_procs() end, {[],SharedGL,[]}), + %% get status of processes at startup, to be compared with end result + {Config, [{all_procs,processes()} | State]}. + +post_init_per_suite(_Suite, _Config, Return, State) -> + identify(?FUNCTION_NAME), + SharedGL = find_and_kill(), + do_until(fun() -> ct:remaining_test_procs() end, {[],SharedGL,[]}), + {Return, State}. + +pre_end_per_suite(_Suite, Config, State) -> + identify(?FUNCTION_NAME), + SharedGL = find_and_kill(), + do_until(fun() -> ct:remaining_test_procs() end, {[],SharedGL,[]}), + {Config, State}. + +post_end_per_suite(_Suite, _Config, Return, State) -> + identify(?FUNCTION_NAME), + SharedGL = find_and_kill(), + do_until(fun() -> ct:remaining_test_procs() end, {[],SharedGL,[]}), + AllProcs = processes(), + Remaining = AllProcs--proplists:get_value(all_procs, State), + ct:pal("Final remaining processes = ~p", [Remaining]), + %% only the end_per_suite process shoud remain at this point! + Remaining = [self()], + {Return, State}. + +pre_init_per_group(_Suite, _Group, Config, State) -> + identify(?FUNCTION_NAME), + SharedGL = find_and_kill(procs_and_gls), + do_until(fun() -> ct:remaining_test_procs() end, {[],SharedGL,[]}), + {Config, State}. + +post_init_per_group(_Suite, _Group, _Config, Result, State) -> + identify(?FUNCTION_NAME), + SharedGL = find_and_kill(procs_and_gls), + do_until(fun() -> ct:remaining_test_procs() end, {[],SharedGL,[]}), + {Result, State}. + +pre_init_per_testcase(_Suite, _TC, Config, State) -> + identify(?FUNCTION_NAME), + ThisGL = group_leader(), + find_and_kill(proc, ThisGL), + case proplists:get_value(tc_group_properties, Config) of + [{name,_},parallel] -> + timer:sleep(1000); + _ -> + do_until(fun() -> element(1,ct:remaining_test_procs()) end, []) + end, + {Config, State}. + +post_init_per_testcase(_Suite, _TC, Config, Return, State) -> + identify(?FUNCTION_NAME), + ThisGL = group_leader(), + find_and_kill(proc, ThisGL), + case proplists:get_value(tc_group_properties, Config) of + [{name,_},parallel] -> + timer:sleep(1000); + _ -> + do_until(fun() -> element(1,ct:remaining_test_procs()) end, []) + end, + {Return, State}. + +pre_end_per_testcase(_Suite, _TC, Config, State) -> + identify(?FUNCTION_NAME), + ThisGL = group_leader(), + find_and_kill(proc, ThisGL), + case proplists:get_value(tc_group_properties, Config) of + [{name,_},parallel] -> + timer:sleep(1000); + _ -> + do_until(fun() -> element(1,ct:remaining_test_procs()) end, []) + end, + {Config, State}. + +post_end_per_testcase(_Suite, _TC, Config, Result, State) -> + identify(?FUNCTION_NAME), + ThisGL = group_leader(), + find_and_kill(proc, ThisGL), + case proplists:get_value(tc_group_properties, Config) of + [{name,_},parallel] -> + timer:sleep(1000); + _ -> + do_until(fun() -> element(1,ct:remaining_test_procs()) end, []) + end, + {Result, State}. + +pre_end_per_group(_Suite, _Group, Config, State) -> + identify(?FUNCTION_NAME), + SharedGL = find_and_kill(procs_and_gls), + do_until(fun() -> ct:remaining_test_procs() end, {[],SharedGL,[]}), + {Config, State}. + +post_end_per_group(_Suite, _Group, _Config, Return, State) -> + identify(?FUNCTION_NAME), + SharedGL = find_and_kill(procs_and_gls), + do_until(fun() -> ct:remaining_test_procs() end, {[],SharedGL,[]}), + {Return, State}. + + +%%%----------------------------------------------------------------- +%%% HELP FUNCTIONS +%%%----------------------------------------------------------------- + +identify(Func) -> + ct:pal("********** THIS IS ~w on ~w", [Func, self()]), + ok. + +find_and_kill() -> + find_and_kill(procs). + +find_and_kill(procs) -> + {Procs,SharedGL,_ParallelGLs} = ct:remaining_test_procs(), + ct:pal("Remaining test processes = ~p", [pi(Procs)]), + [pkill(P, kill) || {P,_GL} <- Procs], + SharedGL; + +find_and_kill(procs_and_gls) -> + {Procs,SharedGL,GLs} = ct:remaining_test_procs(), + ct:pal("Remaining test processes = ~p", [pi(Procs)]), + [pkill(P, kill) || {P,_GL} <- Procs], + ct:pal("Remaining group leaders = ~p", [pi(GLs)]), + [pkill(GL, kill) || GL <- GLs, GL /= SharedGL], + SharedGL. + +find_and_kill(proc, ProcGL) -> + {Procs,SharedGL,GLs} = ct:remaining_test_procs(), + ct:pal("Remaining test processes = ~p", [pi(Procs++GLs)]), + [pkill(P, kill) || {P,GL} <- Procs, GL == ProcGL], + SharedGL. + +pi([{P,_GL}|Ps]) -> + pi([P|Ps]); +pi([P|Ps]) -> + case node() == node(P) of + true -> + {_,GL} = process_info(P,group_leader), + {_,CF} = process_info(P,current_function), + {_,IC} = process_info(P,initial_call), + {_,D} = process_info(P,dictionary), + Shared = test_server_io:get_gl(true), + User = whereis(user), + if (GL /= P) and (GL /= Shared) and (GL /= User) -> + [{P,GL,CF,IC,D} | pi([GL|Ps])]; + true -> + [{P,GL,CF,IC,D} | pi(Ps)] + end; + false -> + pi(Ps) + end; +pi([]) -> + []. + +do_until(Fun, Until) -> + io:format("Will do until ~p~n", [Until]), + do_until(Fun, Until, 1000). + +do_until(_, Until, 0) -> + io:format("Couldn't get ~p~n", [Until]), + exit({not_reached,Until}); + +do_until(Fun, Until, N) -> + case Fun() of + Until -> + ok; + _Tmp -> + do_until(Fun, Until, N-1) + end. + +pkill(P, How) -> + ct:pal("KILLING ~w NOW!", [P]), + exit(P, How). + diff --git a/lib/common_test/test/ct_config_SUITE.erl b/lib/common_test/test/ct_config_SUITE.erl index 250700741c..5ffc735d6a 100644 --- a/lib/common_test/test/ct_config_SUITE.erl +++ b/lib/common_test/test/ct_config_SUITE.erl @@ -213,8 +213,8 @@ reformat_events(Events, EH) -> skip_dynamic() -> case os:getenv("TS_EXTRA_PLATFORM_LABEL") of TSExtraPlatformLabel when is_list(TSExtraPlatformLabel) -> - case string:str(TSExtraPlatformLabel,"TimeWarpingOS") of - 0 -> false; + case string:find(TSExtraPlatformLabel,"TimeWarpingOS") of + nomatch -> false; _ -> true end; _ -> diff --git a/lib/common_test/test/ct_hooks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE.erl index 8ba14e63bc..3c1e887f65 100644 --- a/lib/common_test/test/ct_hooks_SUITE.erl +++ b/lib/common_test/test/ct_hooks_SUITE.erl @@ -257,7 +257,7 @@ cth_log(Config) when is_list(Config) -> lists:foreach( fun(UnexpIoLog) -> {ok,Bin} = file:read_file(UnexpIoLog), - Ts = string:tokens(binary_to_list(Bin),[$\n]), + Ts = string:lexemes(binary_to_list(Bin),[$\n]), Matches = lists:foldl(fun([$=,$E,$R,$R,$O,$R|_], N) -> N+1; ([$L,$o,$g,$g,$e,$r|_], N) -> diff --git a/lib/common_test/test/ct_log_SUITE.erl b/lib/common_test/test/ct_log_SUITE.erl index 93affda398..9655b6f09a 100644 --- a/lib/common_test/test/ct_log_SUITE.erl +++ b/lib/common_test/test/ct_log_SUITE.erl @@ -174,7 +174,7 @@ verify(Config) -> TcLogFile = proplists:get_value(the_logfile, SavedCfg), Pid = proplists:get_value(the_pid, SavedCfg), StrPid = lists:flatten(io_lib:format("~p",[Pid])), - EscPid = "<" ++ string:substr(StrPid, 2, length(StrPid)-2) ++ ">", + EscPid = "<" ++ string:slice(StrPid, 1, length(StrPid)-2) ++ ">", String = proplists:get_value(the_string, SavedCfg), ct:log("Read from prev testcase: ~p & ~p", [TcLogFile,Pid]), {ok,Dev} = file:open(TcLogFile, [read]), 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 index 7ffe6f045b..0b85392009 100644 --- a/lib/common_test/test/ct_pre_post_test_io_SUITE.erl +++ b/lib/common_test/test/ct_pre_post_test_io_SUITE.erl @@ -164,7 +164,7 @@ pre_post_io(Config) -> 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]), + Ts = string:lexemes(binary_to_list(Bin),[$\n]), PrePostIOEntries = lists:foldl(fun([$L,$o,$g,$g,$e,$r|_], {pre,PreLogN,PreErrN,0,0}) -> @@ -203,7 +203,7 @@ pre_post_io(Config) -> 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]), + Ts = string:lexemes(binary_to_list(Bin),[$\n]), UnexpIOEntries = lists:foldl(fun([$L,$o,$g,$g,$e,$r|_], [LogN,ErrN]) -> [LogN+1,ErrN]; diff --git a/lib/common_test/test/ct_priv_dir_SUITE_data/priv_dir_SUITE.erl b/lib/common_test/test/ct_priv_dir_SUITE_data/priv_dir_SUITE.erl index 1b171801a3..b1d191873d 100644 --- a/lib/common_test/test/ct_priv_dir_SUITE_data/priv_dir_SUITE.erl +++ b/lib/common_test/test/ct_priv_dir_SUITE_data/priv_dir_SUITE.erl @@ -126,12 +126,12 @@ default(Config) -> auto_per_tc(Config) -> PrivDir = proplists:get_value(priv_dir, Config), - ["log_private",_] = string:tokens(filename:basename(PrivDir), "."), + ["log_private",_] = string:lexemes(filename:basename(PrivDir), "."), {ok,_} = file:list_dir(PrivDir). manual_per_tc(Config) -> PrivDir = proplists:get_value(priv_dir, Config), - ["log_private",_] = string:tokens(filename:basename(PrivDir), "."), + ["log_private",_] = string:lexemes(filename:basename(PrivDir), "."), {error,_} = file:list_dir(PrivDir), ok = ct:make_priv_dir(), {ok,_} = file:list_dir(PrivDir). diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl index 44c27e54c2..2ba7c7c13f 100644 --- a/lib/common_test/test/ct_test_support.erl +++ b/lib/common_test/test/ct_test_support.erl @@ -88,7 +88,7 @@ start_slave(Config, Level) -> start_slave(ct, Config, Level). start_slave(NodeName, Config, Level) -> - [_,Host] = string:tokens(atom_to_list(node()), "@"), + [_,Host] = string:lexemes(atom_to_list(node()), "@"), test_server:format(0, "Trying to start ~s~n", [atom_to_list(NodeName)++"@"++Host]), PR = proplists:get_value(printable_range,Config,io:printable_range()), @@ -1088,8 +1088,8 @@ locate({TEH,Name,{'DEF','RUNDIR'}}, Node, [Ev|Evs], Config) -> {TEH,#event{name=Name, node=Node, data=EvData}} -> {_,{_,LogDir}} = lists:keysearch(logdir, 1, get_opts(Config)), D = filename:join(LogDir, "ct_run." ++ atom_to_list(Node)), - case string:str(EvData, D) of - 0 -> exit({badmatch,EvData}); + case string:find(EvData, D) of + nomatch -> exit({badmatch,EvData}); _ -> ok end, {Config,Evs}; @@ -1104,8 +1104,8 @@ locate({TEH,Name,{'DEF',{'START_TIME','LOGDIR'}}}, Node, [Ev|Evs], Config) -> {DT={{_,_,_},{_,_,_}},Dir} when is_list(Dir) -> {_,{_,LogDir}} = lists:keysearch(logdir, 1, get_opts(Config)), D = filename:join(LogDir, "ct_run." ++ atom_to_list(Node)), - case string:str(Dir, D) of - 0 -> exit({badmatch,Dir}); + case string:find(Dir, D) of + nomatch -> exit({badmatch,Dir}); _ -> ok end, {[{start_time,DT}|Config],Evs}; @@ -1373,7 +1373,7 @@ delete_dirs(LogDir) -> Dirs2Del = lists:foldl(fun(Dir, Del) -> [S,Mi,H,D,Mo,Y|_] = - lists:reverse(string:tokens(Dir, [$.,$-,$_])), + lists:reverse(string:lexemes(Dir, [$.,$-,$_])), S2I = fun(Str) -> list_to_integer(Str) end, DT = {{S2I(Y),S2I(Mo),S2I(D)}, {S2I(H),S2I(Mi),S2I(S)}}, Then = calendar:datetime_to_gregorian_seconds(DT), diff --git a/lib/common_test/test/ct_unicode_SUITE.erl b/lib/common_test/test/ct_unicode_SUITE.erl index 355503a5dc..6f6ec97ceb 100644 --- a/lib/common_test/test/ct_unicode_SUITE.erl +++ b/lib/common_test/test/ct_unicode_SUITE.erl @@ -191,7 +191,7 @@ check_logs(Dirs) -> [] -> ok; Match -> - MatchStr = string:join(Match,"\n"), + MatchStr = lists:join("\n",Match), ct:log("ERROR: Escaped unicode characters found in:~n~ts",[MatchStr]), ct:fail(escaped_unicode_characters_found) end. diff --git a/lib/common_test/test/ct_userconfig_callback.erl b/lib/common_test/test/ct_userconfig_callback.erl index c723f4ca1c..14e3d9a688 100644 --- a/lib/common_test/test/ct_userconfig_callback.erl +++ b/lib/common_test/test/ct_userconfig_callback.erl @@ -21,7 +21,7 @@ -export([check_parameter/1, read_config/1]). read_config(Str) -> - KeyVals = string:tokens(Str, " "), + KeyVals = string:lexemes(Str, " "), {ok,read_config1(KeyVals)}. read_config1([Key,Val | KeyVals]) -> diff --git a/lib/common_test/test/erl2html2_SUITE.erl b/lib/common_test/test/erl2html2_SUITE.erl index 53a63578b2..b2336ff0bc 100644 --- a/lib/common_test/test/erl2html2_SUITE.erl +++ b/lib/common_test/test/erl2html2_SUITE.erl @@ -214,10 +214,10 @@ check_line_number(Last,Line,OrigLine) -> [$>|Rest] = lists:dropwhile(fun($>) -> false; (_) -> true end,Line), check_line_number(Last,Rest,OrigLine); _ -> - [N |_] = string:tokens(Line,":"), + [N |_] = string:lexemes(Line,":"), % erlang:display(N), Num = - try list_to_integer(string:strip(N)) + try list_to_integer(string:trim(N,both,"\s")) catch _:_ -> ct:fail({no_line_number_after,Last,OrigLine}) end, if Num == Last+1 -> diff --git a/lib/common_test/test/telnet_server.erl b/lib/common_test/test/telnet_server.erl index 65300b0bdf..cef7784333 100644 --- a/lib/common_test/test/telnet_server.erl +++ b/lib/common_test/test/telnet_server.erl @@ -249,7 +249,7 @@ do_handle_data("echo " ++ Data,State) -> send(Data++"\r\n> ",State), {ok,State}; do_handle_data("echo_sep " ++ Data,State) -> - Msgs = string:tokens(Data," "), + Msgs = string:lexemes(Data," "), lists:foreach(fun(Msg) -> send(Msg,State), timer:sleep(10) @@ -260,28 +260,28 @@ do_handle_data("echo_no_prompt " ++ Data,State) -> send(Data,State), {ok,State}; do_handle_data("echo_ml " ++ Data,State) -> - Lines = string:tokens(Data," "), - ReturnData = string:join(Lines,"\n"), + Lines = string:lexemes(Data," "), + ReturnData = lists:flatten(lists:join("\n",Lines)), send(ReturnData++"\r\n> ",State), {ok,State}; do_handle_data("echo_ml_no_prompt " ++ Data,State) -> - Lines = string:tokens(Data," "), - ReturnData = string:join(Lines,"\n"), + Lines = string:lexemes(Data," "), + ReturnData = lists:flatten(lists:join("\n",Lines)), send(ReturnData,State), {ok,State}; do_handle_data("echo_loop " ++ Data,State) -> - [TStr|Lines] = string:tokens(Data," "), - ReturnData = string:join(Lines,"\n"), + [TStr|Lines] = string:lexemes(Data," "), + ReturnData = lists:flatten(lists:join("\n",Lines)), send_loop(list_to_integer(TStr),ReturnData,State), {ok,State}; do_handle_data("echo_delayed_prompt "++Data,State) -> - [MsStr|EchoData] = string:tokens(Data, " "), - send(string:join(EchoData,"\n"),State), + [MsStr|EchoData] = string:lexemes(Data, " "), + send(lists:flatten(lists:join("\n",EchoData)),State), timer:sleep(list_to_integer(MsStr)), send("\r\n> ",State), {ok,State}; do_handle_data("disconnect_after " ++WaitStr,State) -> - Wait = list_to_integer(string:strip(WaitStr,right,$\n)), + Wait = list_to_integer(string:trim(WaitStr,trailing,"\n")), dbg("Server will close connection in ~w ms...", [Wait]), erlang:send_after(Wait,self(),disconnect), {ok,State}; diff --git a/lib/common_test/test/test_server_SUITE.erl b/lib/common_test/test/test_server_SUITE.erl index 50d8bdd1ac..edfaea1d08 100644 --- a/lib/common_test/test/test_server_SUITE.erl +++ b/lib/common_test/test/test_server_SUITE.erl @@ -71,7 +71,7 @@ init_per_testcase(_TestCase, Config) -> %% @spec end_per_testcase(TestCase, Config0) -> %% void() | {save_config,Config1} | {fail,Reason} end_per_testcase(test_server_unicode, _Config) -> - [_,Host] = string:tokens(atom_to_list(node()), "@"), + [_,Host] = string:lexemes(atom_to_list(node()), "@"), N1 = list_to_atom("test_server_tester_latin1" ++ "@" ++ Host), N2 = list_to_atom("test_server_tester_utf8" ++ "@" ++ Host), test_server:stop_node(N1), @@ -347,7 +347,7 @@ generate_and_run_unicode_test(Config0,Encoding) -> RunDir = get_latest_run_dir(LogDir), true = filelib:is_dir(RunDir), - LowerModStr = string:to_lower(ModStr), + LowerModStr = string:lowercase(ModStr), SuiteHtml = translate_filename(LowerModStr++".src.html",Encoding), true = filelib:is_regular(filename:join(RunDir,SuiteHtml)), @@ -362,7 +362,7 @@ generate_and_run_unicode_test(Config0,Encoding) -> %% remote file system on master - i.e. they will use same file name %% mode as the master. start_node(Config,Name,Args) -> - [_,Host] = string:tokens(atom_to_list(node()), "@"), + [_,Host] = string:lexemes(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} -> diff --git a/lib/common_test/test/test_server_test_lib.erl b/lib/common_test/test/test_server_test_lib.erl index c18b89b178..9ee946af0b 100644 --- a/lib/common_test/test/test_server_test_lib.erl +++ b/lib/common_test/test/test_server_test_lib.erl @@ -43,7 +43,7 @@ pre_init_per_testcase(_TC,Config,State) -> {start_slave(Config, 50),State}. start_slave(Config,_Level) -> - [_,Host] = string:tokens(atom_to_list(node()), "@"), + [_,Host] = string:lexemes(atom_to_list(node()), "@"), ct:log("Trying to start ~s~n", ["test_server_tester@"++Host]), @@ -121,7 +121,7 @@ parse_suite(FileName) -> end. fline(Fd) -> - case prim_file:read_line(Fd) of + case file:read_line(Fd) of eof -> eof; {ok, Line} -> Line end. diff --git a/lib/common_test/test_server/ts.erl b/lib/common_test/test_server/ts.erl index 5bfea9f4de..330652e73f 100644 --- a/lib/common_test/test_server/ts.erl +++ b/lib/common_test/test_server/ts.erl @@ -583,7 +583,7 @@ is_list_of_suites(List) -> S = if is_atom(Suite) -> atom_to_list(Suite); true -> Suite end, - try lists:last(string:tokens(S,"_")) of + try lists:last(string:lexemes(S,"_")) of "SUITE" -> true; "suite" -> true; _ -> false diff --git a/lib/common_test/test_server/ts_autoconf_win32.erl b/lib/common_test/test_server/ts_autoconf_win32.erl index 52e5ac8e69..6f6caaeb70 100644 --- a/lib/common_test/test_server/ts_autoconf_win32.erl +++ b/lib/common_test/test_server/ts_autoconf_win32.erl @@ -228,7 +228,7 @@ make(Vars) -> end. find_make(MakeCmd, Vars) -> - [Make|_] = string:tokens(MakeCmd, " \t"), + [Make|_] = string:lexemes(MakeCmd, " \t"), case os:find_executable(Make) of false -> {no, Vars}; @@ -248,9 +248,9 @@ javac(Vars) -> end. is_debug_build() -> - case catch string:str(erlang:system_info(system_version), "debug") of - Int when is_integer(Int), Int > 0 -> - true; - _ -> - false + case catch string:find(erlang:system_info(system_version), "debug") of + nomatch -> + false; + _Else -> + true end. diff --git a/lib/common_test/test_server/ts_erl_config.erl b/lib/common_test/test_server/ts_erl_config.erl index 032593bdda..c7fe4ccf83 100644 --- a/lib/common_test/test_server/ts_erl_config.erl +++ b/lib/common_test/test_server/ts_erl_config.erl @@ -311,7 +311,7 @@ lib_dir(Vars, Lib) -> end, CLibDir = filename:join(CLibDirList), Cmd = "ls -d " ++ CLibDir ++ "*", - XLibDir = lists:last(string:tokens(os:cmd(Cmd),"\n")), + XLibDir = lists:last(string:lexemes(os:cmd(Cmd),"\n")), case file:list_dir(XLibDir) of {error, enoent} -> []; @@ -361,15 +361,11 @@ emu_vars(Vars) -> {erl_name, atom_to_list(lib:progname())}|Vars]. is_source_build() -> - string:str(erlang:system_info(system_version), "[source]") > 0. + string:find(erlang:system_info(system_version), "source") =/= nomatch. is_debug_build() -> - case catch string:str(erlang:system_info(system_version), "debug") of - Int when is_integer(Int), Int > 0 -> - true; - _ -> - false - end. + string:find(erlang:system_info(system_version), "debug") =/= nomatch. + %% %% ssl_libdir %% diff --git a/lib/common_test/test_server/ts_install.erl b/lib/common_test/test_server/ts_install.erl index c4e0223ac7..048e5493d2 100644 --- a/lib/common_test/test_server/ts_install.erl +++ b/lib/common_test/test_server/ts_install.erl @@ -115,7 +115,7 @@ get_vars(_, _, _, _) -> config_flags() -> case os:getenv("CONFIG_FLAGS") of false -> []; - CF -> string:tokens(CF, " \t\n") + CF -> string:lexemes(CF, " \t\n") end. unix_autoconf(XConf) -> @@ -127,7 +127,7 @@ unix_autoconf(XConf) -> Threads = [" --enable-shlib-thread-safety" || erlang:system_info(threads) /= false], Debug = [" --enable-debug-mode" || - string:str(erlang:system_info(system_version),"debug") > 0], + string:find(erlang:system_info(system_version),"debug") =/= nomatch], MXX_Build = [Y || Y <- config_flags(), Y == "--enable-m64-build" orelse Y == "--enable-m32-build"], @@ -159,10 +159,8 @@ assign_vars([]) -> assign_vars([{VAR,FlagsStr} | VARs]) -> [{VAR,assign_vars(FlagsStr)} | assign_vars(VARs)]; assign_vars(FlagsStr) -> - Flags = [assign_all_vars(Str,[]) || Str <- string:tokens(FlagsStr, [$ ])], - string:strip(lists:flatten(lists:map(fun(Flag) -> - Flag ++ " " - end, Flags)), right). + Flags = [assign_all_vars(Str,[]) || Str <- string:lexemes(FlagsStr, [$\s])], + lists:flatten(lists:join(" ", Flags)). assign_all_vars([$$ | Rest], FlagSoFar) -> {VarName,Rest1} = get_var_name(Rest, []), @@ -292,7 +290,7 @@ add_vars(Vars0, Opts0) -> get_testcase_callback() -> case os:getenv("TS_TESTCASE_CALLBACK") of ModFunc when is_list(ModFunc), ModFunc /= "" -> - case string:tokens(ModFunc, " ") of + case string:lexemes(ModFunc, " ") of [_Mod,_Func] -> ModFunc; _ -> "" end; @@ -408,17 +406,13 @@ off_heap_msgq() -> end. schedulers() -> - case catch erlang:system_info(smp_support) of - true -> - case {erlang:system_info(schedulers), - erlang:system_info(schedulers_online)} of - {S,S} -> - "/S"++integer_to_list(S); - {S,O} -> - "/S"++integer_to_list(S) ++ ":" ++ - integer_to_list(O) - end; - _ -> "" + case {erlang:system_info(schedulers), + erlang:system_info(schedulers_online)} of + {S,S} -> + "/S"++integer_to_list(S); + {S,O} -> + "/S"++integer_to_list(S) ++ ":" ++ + integer_to_list(O) end. bind_type() -> @@ -434,8 +428,8 @@ bind_type() -> debug() -> - case string:str(erlang:system_info(system_version), "debug") of - 0 -> ""; + case string:find(erlang:system_info(system_version), "debug") of + nomatch -> ""; _ -> "/Debug" end. diff --git a/lib/common_test/test_server/ts_lib.erl b/lib/common_test/test_server/ts_lib.erl index ea039a2c2b..da8d676b18 100644 --- a/lib/common_test/test_server/ts_lib.erl +++ b/lib/common_test/test_server/ts_lib.erl @@ -99,7 +99,7 @@ specialized_specs(Dir,PostFix) -> sort_tests([begin DirPart = filename:dirname(Name), AppTest = hd(lists:reverse(filename:split(DirPart))), - list_to_atom(string:substr(AppTest, 1, length(AppTest)-5)) + list_to_atom(string:slice(AppTest, 0, string:length(AppTest)-5)) end || Name <- Specs]). specs(Dir) -> @@ -111,9 +111,9 @@ specs(Dir) -> [Spec,TestDir|_] = lists:reverse(filename:split(FullName)), [_TestSuffix|TDParts] = - lists:reverse(string:tokens(TestDir,[$_,$.])), + lists:reverse(string:lexemes(TestDir,[$_,$.])), [_SpecSuffix|SParts] = - lists:reverse(string:tokens(Spec,[$_,$.])), + lists:reverse(string:lexemes(Spec,[$_,$.])), if TDParts == SParts -> [filename_to_atom(FullName)]; true -> @@ -273,7 +273,7 @@ do_test(Rest, Vars, Test) -> get_arg([$(|Rest], Vars, Stop, _) -> get_arg(Rest, Vars, Stop, []); get_arg([Stop|Rest], Vars, Stop, Acc) -> - Arg = string:strip(lists:reverse(Acc)), + Arg = string:trim(lists:reverse(Acc),both,[$\s]), Subst = subst(Arg, Vars), {Subst,Rest}; get_arg([C|Rest], Vars, Stop, Acc) -> diff --git a/lib/common_test/test_server/ts_run.erl b/lib/common_test/test_server/ts_run.erl index e22fa8d196..3f594236bc 100644 --- a/lib/common_test/test_server/ts_run.erl +++ b/lib/common_test/test_server/ts_run.erl @@ -207,11 +207,7 @@ make_command(Vars, Spec, State) -> _ -> ok end, - "cerl -valgrind" ++ - case erlang:system_info(smp_support) of - true -> " -smp"; - false -> "" - end + "cerl -valgrind" end, Naming = case ts_lib:var(longnames, Vars) of @@ -468,4 +464,4 @@ split_one(Path) -> filename:split(Path). split_path(Path) -> - string:tokens(Path,";"). + string:lexemes(Path,";"). diff --git a/lib/common_test/vsn.mk b/lib/common_test/vsn.mk index 7b959ebfe3..96fdc89853 100644 --- a/lib/common_test/vsn.mk +++ b/lib/common_test/vsn.mk @@ -1 +1 @@ -COMMON_TEST_VSN = 1.15.2 +COMMON_TEST_VSN = 1.15.3 diff --git a/lib/compiler/doc/src/Makefile b/lib/compiler/doc/src/Makefile index c6864cb835..13210de040 100644 --- a/lib/compiler/doc/src/Makefile +++ b/lib/compiler/doc/src/Makefile @@ -1,8 +1,8 @@ # # %CopyrightBegin% -# -# Copyright Ericsson AB 1997-2016. All Rights Reserved. -# +# +# Copyright Ericsson AB 1997-2017. All Rights Reserved. +# # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at @@ -14,7 +14,7 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. -# +# # %CopyrightEnd% # include $(ERL_TOP)/make/target.mk @@ -38,13 +38,12 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) XML_APPLICATION_FILES = ref_man.xml XML_REF3_FILES = compile.xml -XML_PART_FILES = part_notes.xml part_notes_history.xml -XML_CHAPTER_FILES = notes.xml notes_history.xml +XML_PART_FILES = +XML_CHAPTER_FILES = notes.xml BOOK_FILES = book.xml -GIF_FILES = \ - warning.gif +GIF_FILES = XML_FILES = \ $(BOOK_FILES) $(XML_CHAPTER_FILES) \ @@ -64,9 +63,9 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += +XML_FLAGS += # ---------------------------------------------------- # Targets @@ -86,17 +85,17 @@ man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) -debug opt: +debug opt: clean clean_docs: rm -rf $(HTMLDIR)/* rm -f $(MAN3DIR)/* rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ + rm -f errs core *~ # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs @@ -110,4 +109,3 @@ release_docs_spec: docs $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" release_spec: - diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml index 10164890f2..b398871ddf 100644 --- a/lib/compiler/doc/src/compile.xml +++ b/lib/compiler/doc/src/compile.xml @@ -123,6 +123,17 @@ in the Efficiency Guide.</p> </item> + <tag><c>{compile_info, [{atom(), term()}]}</c></tag> + <item> + <p>Allows compilers built on top of <c>compile</c> to attach + extra compilation metadata to the <c>compile_info</c> chunk + in the generated beam file.</p> + + <p>It is advised for compilers to remove all non-deterministic + information if the <c>deterministic</c> option is supported and + it was supplied by the user.</p> + </item> + <tag><c>compressed</c></tag> <item> <p>The compiler will compress the generated object code, diff --git a/lib/compiler/doc/src/fascicules.xml b/lib/compiler/doc/src/fascicules.xml deleted file mode 100644 index fadd37eefb..0000000000 --- a/lib/compiler/doc/src/fascicules.xml +++ /dev/null @@ -1,15 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/compiler/doc/src/note.gif b/lib/compiler/doc/src/note.gif Binary files differdeleted file mode 100644 index 6fffe30419..0000000000 --- a/lib/compiler/doc/src/note.gif +++ /dev/null diff --git a/lib/compiler/doc/src/notes.xml b/lib/compiler/doc/src/notes.xml index bd095c422a..f4a3f9875b 100644 --- a/lib/compiler/doc/src/notes.xml +++ b/lib/compiler/doc/src/notes.xml @@ -32,6 +32,22 @@ <p>This document describes the changes made to the Compiler application.</p> +<section><title>Compiler 7.1.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>The '<c>deterministic</c>' option was not recognized + when given in a <c>-compile()</c> attribute in the source + code.</p> + <p> + Own Id: OTP-14773 Aux Id: ERL-498 </p> + </item> + </list> + </section> + +</section> + <section><title>Compiler 7.1.3</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -294,6 +310,23 @@ </section> +<section><title>Compiler 7.0.4.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Fail labels on guard BIFs weren't taken into account + during an optimization pass, and a bug in the validation + pass sometimes prevented this from being noticed when a + fault occurred.</p> + <p> + Own Id: OTP-14522 Aux Id: ERIERL-48 </p> + </item> + </list> + </section> + +</section> + <section><title>Compiler 7.0.4</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -493,6 +526,22 @@ </section> + +<section><title>Compiler 6.0.3.1</title> + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Fail labels on guard BIFs weren't taken into account + during an optimization pass, and a bug in the validation + pass sometimes prevented this from being noticed when a + fault occurred.</p> + <p> + Own Id: OTP-14522 Aux Id: ERIERL-48 </p> + </item> + </list> + </section> +</section> + <section><title>Compiler 6.0.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/compiler/doc/src/part_notes.xml b/lib/compiler/doc/src/part_notes.xml deleted file mode 100644 index c1f0ff3861..0000000000 --- a/lib/compiler/doc/src/part_notes.xml +++ /dev/null @@ -1,40 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2004</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>Compiler Release Notes</title> - <prepared></prepared> - <docno></docno> - <date>2004-09-07</date> - <rev>1.0</rev> - </header> - <description> - <p>The <em>Compiler</em> application compiles Erlang - code to byte-code. The highly compact byte-code is executed by - the Erlang emulator.</p> - <p>For information about older versions, see - <url href="part_notes_history_frame.html">Release Notes History</url>.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/compiler/doc/src/part_notes_history.xml b/lib/compiler/doc/src/part_notes_history.xml deleted file mode 100644 index 4019676b83..0000000000 --- a/lib/compiler/doc/src/part_notes_history.xml +++ /dev/null @@ -1,40 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part> - <header> - <copyright> - <year>2006</year> - <year>2016</year> - <holder>Ericsson AB, All Rights Reserved</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>Compiler Release Notes History</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p>The <em>Compiler</em> application compiles Erlang - code to byte-code. The highly compact byte-code is executed by - the Erlang emulator.</p> - </description> - <include file="notes_history"></include> -</part> - diff --git a/lib/compiler/doc/src/user_guide.gif b/lib/compiler/doc/src/user_guide.gif Binary files differdeleted file mode 100644 index e6275a803d..0000000000 --- a/lib/compiler/doc/src/user_guide.gif +++ /dev/null diff --git a/lib/compiler/doc/src/warning.gif b/lib/compiler/doc/src/warning.gif Binary files differdeleted file mode 100644 index 96af52360e..0000000000 --- a/lib/compiler/doc/src/warning.gif +++ /dev/null diff --git a/lib/compiler/internal_doc/cerl-notes.md b/lib/compiler/internal_doc/cerl-notes.md new file mode 100644 index 0000000000..705fe8f42d --- /dev/null +++ b/lib/compiler/internal_doc/cerl-notes.md @@ -0,0 +1,75 @@ +Some notes on the cerl modules +============================== + +Maps in cerl_clauses:match/3 +---------------------------- + +Not much optimization is done for maps in `cerl_clauses:match/3`. + +The reason is that the inliner (`cerl_inline`) was not designed for +data types that depend on variables bound in the enclosing environment +(for example, the keys for maps). If we attempt to extend the +optimizations for maps similar to the optimizations for the other data +types, the inliner will crash for certain code. Here is an example of +code that would crash the inliner: + + t() -> + f(key). + + f(K) -> + case #{K => value} of + #{key := V} -> V + end. + +The reason for the crash is that the inliner works in several +passes and calls `cerl_clauses:match/3` twice. The inliner will +assume that the same result will be returned both times, but +for this example different bindings will be returned. + +Here is the rough outline of what happens: + +* The first time `cerl_clauses:match/3` will be asked to match the +pattern `#{K := V}` against `#{key => value}`. It cannot say more +than that the pattern *may* match. + +* Now the inliner will add the bindings to body of the clause (which +is simply `V`). In this case, the bindings are still empty, so +nothing is added. + +* The inliner will now do some substitutions and renaming. The +variable `K` will be replaced with `key`. + +* The next time `cerl_clauses:match/3` is called, it will be asked to +match the pattern `#{key := V}` against `#{key => value#}`. In this +case, there will be a match and the bindings can be extended with +`{V,value}`. + +* The inliner will see that the entire case can be removed. Only +the body for the clause needs to be kept. + +Thus, after inlining the function `t/0` will look like this: + + t() -> + V. + +The problem here is that the inliner assumed that the bindings from +the first and second call to `cer_clauses:match/3` would be the same. +It used the empty bindings from the first call for the body. + +The correct way would be to add the bindings from the second call: + + t() -> + let V = value in V. + +### How to fix this ### + +The inliner will need to call `cerl_clauses:match/3` after doing +all substitutions and renaming. It is not clear to me how difficult +that would be. I assume that the inliner is written the way it is +for a good reason. That means that switching the order things are +done would lead to correctness and/or performance problems. + +### What must also be done to fix this ### + +`cerl_inline:make_template/3` must be extended to create a template +for maps. That is relatively straightforward. diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index ef6db66ff6..9e96147787 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -83,6 +83,7 @@ MODULES = \ core_scan \ erl_bifs \ rec_env \ + sys_core_alias \ sys_core_bsm \ sys_core_dsetel \ sys_core_fold \ @@ -92,16 +93,14 @@ MODULES = \ v3_codegen \ v3_core \ v3_kernel \ - v3_kernel_pp \ - v3_life + v3_kernel_pp BEAM_H = $(wildcard ../priv/beam_h/*.h) HRL_FILES= \ beam_disasm.hrl \ core_parse.hrl \ - v3_kernel.hrl \ - v3_life.hrl + v3_kernel.hrl YRL_FILE = core_parse.yrl @@ -186,7 +185,7 @@ release_docs_spec: # ---------------------------------------------------- $(EBIN)/beam_disasm.beam: $(EGEN)/beam_opcodes.hrl beam_disasm.hrl -$(EBIN)/beam_listing.beam: v3_life.hrl +$(EBIN)/beam_listing.beam: core_parse.hrl v3_kernel.hrl $(EBIN)/beam_validator.beam: beam_disasm.hrl $(EBIN)/cerl.beam: core_parse.hrl $(EBIN)/compile.beam: core_parse.hrl ../../stdlib/include/erl_compile.hrl @@ -194,12 +193,12 @@ $(EBIN)/core_lib.beam: core_parse.hrl $(EBIN)/core_lint.beam: core_parse.hrl $(EBIN)/core_parse.beam: core_parse.hrl $(EGEN)/core_parse.erl $(EBIN)/core_pp.beam: core_parse.hrl +$(EBIN)/sys_core_alias.beam: core_parse.hrl $(EBIN)/sys_core_dsetel.beam: core_parse.hrl $(EBIN)/sys_core_fold.beam: core_parse.hrl $(EBIN)/sys_core_fold_lists.beam: core_parse.hrl $(EBIN)/sys_core_inline.beam: core_parse.hrl -$(EBIN)/v3_codegen.beam: v3_life.hrl +$(EBIN)/v3_codegen.beam: v3_kernel.hrl $(EBIN)/v3_core.beam: core_parse.hrl $(EBIN)/v3_kernel.beam: core_parse.hrl v3_kernel.hrl $(EBIN)/v3_kernel_pp.beam: v3_kernel.hrl -$(EBIN)/v3_life.beam: v3_kernel.hrl v3_life.hrl diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl index cdb32d5d55..6f09dc4be4 100644 --- a/lib/compiler/src/beam_a.erl +++ b/lib/compiler/src/beam_a.erl @@ -42,8 +42,7 @@ function({function,Name,Arity,CLabel,Is0}) -> Is = beam_jump:remove_unused_labels(Is1), {function,Name,Arity,CLabel,Is} catch - Class:Error -> - Stack = erlang:get_stacktrace(), + Class:Error:Stack -> io:fwrite("Function: ~w/~w\n", [Name,Arity]), erlang:raise(Class, Error, Stack) end. diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index c35efdfc9d..453e00fce3 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -21,10 +21,10 @@ -module(beam_asm). --export([module/5]). +-export([module/4]). -export([encode/2]). --export_type([fail/0,label/0,reg/0,src/0,module_code/0,function_name/0]). +-export_type([fail/0,label/0,reg/0,reg_num/0,src/0,module_code/0,function_name/0]). -import(lists, [map/2,member/2,keymember/3,duplicate/2,splitwith/2]). -include("beam_opcodes.hrl"). @@ -55,20 +55,20 @@ -type module_code() :: {module(),[_],[_],[asm_function()],pos_integer()}. --spec module(module_code(), [{binary(), binary()}], [_], [compile:option()], [compile:option()]) -> +-spec module(module_code(), [{binary(), binary()}], [{atom(),term()}], [compile:option()]) -> {'ok',binary()}. -module(Code, ExtraChunks, SourceFile, Opts, CompilerOpts) -> - {ok,assemble(Code, ExtraChunks, SourceFile, Opts, CompilerOpts)}. +module(Code, ExtraChunks, CompileInfo, CompilerOpts) -> + {ok,assemble(Code, ExtraChunks, CompileInfo, CompilerOpts)}. -assemble({Mod,Exp0,Attr0,Asm0,NumLabels}, ExtraChunks, SourceFile, Opts, CompilerOpts) -> +assemble({Mod,Exp0,Attr0,Asm0,NumLabels}, ExtraChunks, CompileInfo, CompilerOpts) -> {1,Dict0} = beam_dict:atom(Mod, beam_dict:new()), {0,Dict1} = beam_dict:fname(atom_to_list(Mod) ++ ".erl", Dict0), NumFuncs = length(Asm0), {Asm,Attr} = on_load(Asm0, Attr0), Exp = cerl_sets:from_list(Exp0), {Code,Dict2} = assemble_1(Asm, Exp, Dict1, []), - build_file(Code, Attr, Dict2, NumLabels, NumFuncs, ExtraChunks, SourceFile, Opts, CompilerOpts). + build_file(Code, Attr, Dict2, NumLabels, NumFuncs, ExtraChunks, CompileInfo, CompilerOpts). on_load(Fs0, Attr0) -> case proplists:get_value(on_load, Attr0) of @@ -111,7 +111,7 @@ assemble_function([H|T], Acc, Dict0) -> assemble_function([], Code, Dict) -> {Code, Dict}. -build_file(Code, Attr, Dict, NumLabels, NumFuncs, ExtraChunks, SourceFile, Opts, CompilerOpts) -> +build_file(Code, Attr, Dict, NumLabels, NumFuncs, ExtraChunks, CompileInfo, CompilerOpts) -> %% Create the code chunk. CodeChunk = chunk(<<"Code">>, @@ -182,7 +182,7 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, ExtraChunks, SourceFile, Opts, Essentials1 = [iolist_to_binary(C) || C <- Essentials0], MD5 = module_md5(Essentials1), Essentials = finalize_fun_table(Essentials1, MD5), - {Attributes,Compile} = build_attributes(Opts, SourceFile, Attr, MD5), + {Attributes,Compile} = build_attributes(Attr, CompileInfo, MD5), AttrChunk = chunk(<<"Attr">>, Attributes), CompileChunk = chunk(<<"CInf">>, Compile), @@ -192,7 +192,7 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, ExtraChunks, SourceFile, Opts, %% Create IFF chunk. - Chunks = case member(slim, Opts) of + Chunks = case member(slim, CompilerOpts) of true -> [Essentials,AttrChunk]; false -> @@ -240,9 +240,7 @@ build_form(Id, Chunks0) when byte_size(Id) =:= 4, is_list(Chunks0) -> chunk(Id, Contents) when byte_size(Id) =:= 4, is_binary(Contents) -> Size = byte_size(Contents), - [<<Id/binary,Size:32>>,Contents|pad(Size)]; -chunk(Id, Contents) when is_list(Contents) -> - chunk(Id, list_to_binary(Contents)). + [<<Id/binary,Size:32>>,Contents|pad(Size)]. %% Build a correctly padded chunk (with a sub-header). @@ -264,22 +262,10 @@ flatten_exports(Exps) -> flatten_imports(Imps) -> list_to_binary(map(fun({M,F,A}) -> <<M:32,F:32,A:32>> end, Imps)). -build_attributes(Opts, SourceFile, Attr, MD5) -> - Misc0 = case SourceFile of - [] -> []; - [_|_] -> [{source,SourceFile}] - end, - Misc = case member(slim, Opts) of - false -> Misc0; - true -> [] - end, - Compile = case member(deterministic, Opts) of - false -> - [{options,Opts},{version,?COMPILER_VSN}|Misc]; - true -> - [{version,?COMPILER_VSN}] - end, - {term_to_binary(set_vsn_attribute(Attr, MD5)),term_to_binary(Compile)}. +build_attributes(Attr, Compile, MD5) -> + AttrBinary = term_to_binary(set_vsn_attribute(Attr, MD5)), + CompileBinary = term_to_binary([{version,?COMPILER_VSN}|Compile]), + {AttrBinary,CompileBinary}. build_line_table(Dict) -> {NumLineInstrs,NumFnames0,Fnames0,NumLines,Lines0} = diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 6543e05e20..79c4b651db 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -45,8 +45,7 @@ function({function,Name,Arity,CLabel,Is0}) -> %% Done. {function,Name,Arity,CLabel,Is6} catch - Class:Error -> - Stack = erlang:get_stacktrace(), + Class:Error:Stack -> io:fwrite("Function: ~w/~w\n", [Name,Arity]), erlang:raise(Class, Error, Stack) end. @@ -219,11 +218,20 @@ alloc_may_pass({set,_,_,{set_tuple_element,_}}) -> false; alloc_may_pass({set,_,_,put_list}) -> false; alloc_may_pass({set,_,_,put}) -> false; alloc_may_pass({set,_,_,_}) -> true. - + %% opt([Instruction]) -> [Instruction] %% Optimize the instruction stream inside a basic block. opt([{set,[X],[X],move}|Is]) -> opt(Is); +opt([{set,[X],_,move},{set,[X],_,move}=I|Is]) -> + opt([I|Is]); +opt([{set,[{x,0}],[S1],move}=I1,{set,[D2],[{x,0}],move}|Is]) -> + opt([I1,{set,[D2],[S1],move}|Is]); +opt([{set,[{x,0}],[S1],move}=I1,{set,[D2],[S2],move}|Is0]) when S1 =/= D2 -> + %% Place move S x0 at the end of move sequences so that + %% loader can merge with the following instruction + {Ds,Is} = opt_moves([D2], Is0), + [{set,Ds,[S2],move}|opt([I1|Is])]; opt([{set,_,_,{line,_}}=Line1, {set,[D1],[{integer,Idx1},Reg],{bif,element,{f,0}}}=I1, {set,_,_,{line,_}}=Line2, diff --git a/lib/compiler/src/beam_bs.erl b/lib/compiler/src/beam_bs.erl index beb055b23d..14cedbb582 100644 --- a/lib/compiler/src/beam_bs.erl +++ b/lib/compiler/src/beam_bs.erl @@ -38,8 +38,7 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) -> {Is,Lc} = bsm_opt(Is1, Lc0), {{function,Name,Arity,CLabel,Is},Lc} catch - Class:Error -> - Stack = erlang:get_stacktrace(), + Class:Error:Stack -> io:fwrite("Function: ~w/~w\n", [Name,Arity]), erlang:raise(Class, Error, Stack) end. diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index 9a4e7fb133..9ea5a3eb92 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -105,8 +105,7 @@ function({function,Name,Arity,Entry,Is}, FIndex) -> D = #btb{f=FIndex,index=Index}, {function,Name,Arity,Entry,btb_opt_1(Is, D, [])} catch - Class:Error -> - Stack = erlang:get_stacktrace(), + Class:Error:Stack -> io:fwrite("Function: ~w/~w\n", [Name,Arity]), erlang:raise(Class, Error, Stack) end. diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index b736d39f9c..e094c2c320 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -24,7 +24,7 @@ -export([module/2]). -export([bs_clean_saves/1]). -export([clean_labels/1]). --import(lists, [map/2,foldl/3,reverse/1,filter/2]). +-import(lists, [foldl/3,reverse/1,filter/2]). -spec module(beam_utils:module_code(), [compile:option()]) -> {'ok',beam_utils:module_code()}. @@ -118,7 +118,7 @@ add_to_work_list(F, {Fs,Used}=Sets) -> clean_labels(Fs0) -> St0 = #st{lmap=[],entry=1,lc=1}, {Fs1,#st{lmap=Lmap0,lc=Lc}} = function_renumber(Fs0, St0, []), - Lmap = gb_trees:from_orddict(ordsets:from_list(Lmap0)), + Lmap = maps:from_list(Lmap0), Fs = function_replace(Fs1, Lmap, []), {Fs,Lc}. @@ -187,7 +187,8 @@ is_record_tuple(_, _, _) -> no. function_replace([{function,Name,Arity,Entry,Asm0}|Fs], Dict, Acc) -> Asm = try - replace(Asm0, [], Dict) + Fb = fun(Old) -> throw({error,{undefined_label,Old}}) end, + beam_utils:replace_labels(Asm0, [], Dict, Fb) catch throw:{error,{undefined_label,Lbl}=Reason} -> io:format("Function ~s/~w refers to undefined label ~w\n", @@ -197,57 +198,6 @@ function_replace([{function,Name,Arity,Entry,Asm0}|Fs], Dict, Acc) -> function_replace(Fs, Dict, [{function,Name,Arity,Entry,Asm}|Acc]); function_replace([], _, Acc) -> Acc. -replace([{test,Test,{f,Lbl},Ops}|Is], Acc, D) -> - replace(Is, [{test,Test,{f,label(Lbl, D)},Ops}|Acc], D); -replace([{test,Test,{f,Lbl},Live,Ops,Dst}|Is], Acc, D) -> - replace(Is, [{test,Test,{f,label(Lbl, D)},Live,Ops,Dst}|Acc], D); -replace([{select,I,R,{f,Fail0},Vls0}|Is], Acc, D) -> - Vls = map(fun ({f,L}) -> {f,label(L, D)}; - (Other) -> Other - end, Vls0), - Fail = label(Fail0, D), - replace(Is, [{select,I,R,{f,Fail},Vls}|Acc], D); -replace([{'try',R,{f,Lbl}}|Is], Acc, D) -> - replace(Is, [{'try',R,{f,label(Lbl, D)}}|Acc], D); -replace([{'catch',R,{f,Lbl}}|Is], Acc, D) -> - replace(Is, [{'catch',R,{f,label(Lbl, D)}}|Acc], D); -replace([{jump,{f,Lbl}}|Is], Acc, D) -> - replace(Is, [{jump,{f,label(Lbl, D)}}|Acc], D); -replace([{loop_rec,{f,Lbl},R}|Is], Acc, D) -> - replace(Is, [{loop_rec,{f,label(Lbl, D)},R}|Acc], D); -replace([{loop_rec_end,{f,Lbl}}|Is], Acc, D) -> - replace(Is, [{loop_rec_end,{f,label(Lbl, D)}}|Acc], D); -replace([{wait,{f,Lbl}}|Is], Acc, D) -> - replace(Is, [{wait,{f,label(Lbl, D)}}|Acc], D); -replace([{wait_timeout,{f,Lbl},To}|Is], Acc, D) -> - replace(Is, [{wait_timeout,{f,label(Lbl, D)},To}|Acc], D); -replace([{bif,Name,{f,Lbl},As,R}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bif,Name,{f,label(Lbl, D)},As,R}|Acc], D); -replace([{gc_bif,Name,{f,Lbl},Live,As,R}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{gc_bif,Name,{f,label(Lbl, D)},Live,As,R}|Acc], D); -replace([{call,Ar,{f,Lbl}}|Is], Acc, D) -> - replace(Is, [{call,Ar,{f,label(Lbl,D)}}|Acc], D); -replace([{make_fun2,{f,Lbl},U1,U2,U3}|Is], Acc, D) -> - replace(Is, [{make_fun2,{f,label(Lbl, D)},U1,U2,U3}|Acc], D); -replace([{bs_init,{f,Lbl},Info,Live,Ss,Dst}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_init,{f,label(Lbl, D)},Info,Live,Ss,Dst}|Acc], D); -replace([{bs_put,{f,Lbl},Info,Ss}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_put,{f,label(Lbl, D)},Info,Ss}|Acc], D); -replace([{put_map=I,{f,Lbl},Op,Src,Dst,Live,List}|Is], Acc, D) - when Lbl =/= 0 -> - replace(Is, [{I,{f,label(Lbl, D)},Op,Src,Dst,Live,List}|Acc], D); -replace([{get_map_elements=I,{f,Lbl},Src,List}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{I,{f,label(Lbl, D)},Src,List}|Acc], D); -replace([I|Is], Acc, D) -> - replace(Is, [I|Acc], D); -replace([], Acc, _) -> Acc. - -label(Old, D) -> - case gb_trees:lookup(Old, D) of - {value,Val} -> Val; - none -> throw({error,{undefined_label,Old}}) - end. - %%% %%% Final fixup of bs_start_match2/5,bs_save2/bs_restore2 instructions for %%% new bit syntax matching (introduced in R11B). diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index d379fdc4eb..da944f3ce6 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -56,8 +56,7 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) -> Is = move_move_into_block(Is3, []), {{function,Name,Arity,CLabel,Is},Lc} catch - Class:Error -> - Stack = erlang:get_stacktrace(), + Class:Error:Stack -> io:fwrite("Function: ~w/~w\n", [Name,Arity]), erlang:raise(Class, Error, Stack) end. @@ -272,7 +271,8 @@ backward([{jump,{f,To0}},{move,Src,Reg}=Move|Is], D, Acc) -> end; backward([{jump,{f,To}}=J|[{bif,Op,{f,BifFail},Ops,Reg}|Is]=Is0], D, Acc) -> try replace_comp_op(To, Reg, Op, Ops, D) of - I -> backward(Is, D, I++Acc) + {Test,Jump} -> + backward([Jump,Test|Is], D, Acc) catch throw:not_possible -> case To =:= BifFail of @@ -446,7 +446,7 @@ prune_redundant([], _) -> []. replace_comp_op(To, Reg, Op, Ops, D) -> False = comp_op_find_shortcut(To, Reg, {atom,false}, D), True = comp_op_find_shortcut(To, Reg, {atom,true}, D), - [bif_to_test(Op, Ops, False),{jump,{f,True}}]. + {bif_to_test(Op, Ops, False),{jump,{f,True}}}. comp_op_find_shortcut(To0, Reg, Val, D) -> case shortcut_select_label(To0, Reg, Val, D) of @@ -483,15 +483,22 @@ not_possible() -> throw(not_possible). %% F1: is_eq_exact F2 Reg Lit2 F1: is_eq_exact F2 Reg Lit2 %% L2: .... L2: %% -combine_eqs(To, [Reg,{Type,_}=Lit1]=Ops, D, [{label,L1}|_]) - when Type =:= atom; Type =:= integer -> +combine_eqs(To, [Reg,{Type,_}=Lit1]=Ops, D, Acc) + when Type =:= atom; Type =:= integer -> + Next = case Acc of + [{label,Lbl}|_] -> Lbl; + [{jump,{f,Lbl}}|_] -> Lbl + end, case beam_utils:code_at(To, D) of [{test,is_eq_exact,{f,F2},[Reg,{Type,_}=Lit2]}, {label,L2}|_] when Lit1 =/= Lit2 -> - {select,select_val,Reg,{f,F2},[Lit1,{f,L1},Lit2,{f,L2}]}; + {select,select_val,Reg,{f,F2},[Lit1,{f,Next},Lit2,{f,L2}]}; + [{test,is_eq_exact,{f,F2},[Reg,{Type,_}=Lit2]}, + {jump,{f,L2}}|_] when Lit1 =/= Lit2 -> + {select,select_val,Reg,{f,F2},[Lit1,{f,Next},Lit2,{f,L2}]}; [{select,select_val,Reg,{f,F2},[{Type,_}|_]=List0}|_] -> List = remove_from_list(Lit1, List0), - {select,select_val,Reg,{f,F2},[Lit1,{f,L1}|List]}; + {select,select_val,Reg,{f,F2},[Lit1,{f,Next}|List]}; _Is -> {test,is_eq_exact,{f,To},Ops} end; diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl index 8fd0b36d05..dc4865487f 100644 --- a/lib/compiler/src/beam_disasm.erl +++ b/lib/compiler/src/beam_disasm.erl @@ -163,8 +163,8 @@ pp_instr(I) -> file(File) -> try process_chunks(File) - catch error:Reason -> - {error,?MODULE,{internal,{Reason,erlang:get_stacktrace()}}} + catch error:Reason:Stack -> + {error,?MODULE,{internal,{Reason,Stack}}} end. %%----------------------------------------------------------------------- @@ -1165,6 +1165,13 @@ resolve_inst({get_map_elements,Args0},_,_,_) -> {get_map_elements,FLbl,Src,{list,List}}; %% +%% OTP 21. +%% + +resolve_inst({build_stacktrace,[]},_,_,_) -> + build_stacktrace; + +%% %% Catches instructions that are not yet handled. %% resolve_inst(X,_,_,_) -> ?exit({resolve_inst,X}). diff --git a/lib/compiler/src/beam_disasm.hrl b/lib/compiler/src/beam_disasm.hrl index d968cd9587..8cc0bcf99b 100644 --- a/lib/compiler/src/beam_disasm.hrl +++ b/lib/compiler/src/beam_disasm.hrl @@ -26,7 +26,8 @@ %% IT SHOULD BE MOVED TO A FILE THAT DEFINES (AND EXPORTS) %% PROPER TYPES FOR THE SET OF BEAM INSTRUCTIONS. %% --type beam_instr() :: 'bs_init_writable' | 'fclearerror' | 'if_end' +-type beam_instr() :: 'bs_init_writable' | 'build_stacktrace' + | 'fclearerror' | 'if_end' | 'remove_message' | 'return' | 'send' | 'timeout' | tuple(). %% XXX: Very underspecified - FIX THIS diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl index 9801c68ee2..abd39c661d 100644 --- a/lib/compiler/src/beam_except.erl +++ b/lib/compiler/src/beam_except.erl @@ -45,8 +45,7 @@ function({function,Name,Arity,CLabel,Is0}) -> Is = function_1(Is0), {function,Name,Arity,CLabel,Is} catch - Class:Error -> - Stack = erlang:get_stacktrace(), + Class:Error:Stack -> io:fwrite("Function: ~w/~w\n", [Name,Arity]), erlang:raise(Class, Error, Stack) end. diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index 4365451356..c33de217bd 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -71,9 +71,9 @@ %%% %%% jump L2 %%% . . . -%%% L1: %%% L2: ... %%% +%%% and all preceding uses of L1 renamed to L2. %%% If the jump is unreachable, it will be removed according to (1). %%% %%% (5) In @@ -156,41 +156,46 @@ function({function,Name,Arity,CLabel,Asm0}) -> %%% share(Is0) -> - %% We will get more sharing if we never fall through to a label. - Is = eliminate_fallthroughs(Is0, []), - share_1(Is, #{}, [], []). + Is1 = eliminate_fallthroughs(Is0, []), + Is2 = find_fixpoint(fun(Is) -> + share_1(Is, #{}, #{}, [], []) + end, Is1), + reverse(Is2). -share_1([{label,L}=Lbl|Is], Dict0, [_|_]=Seq, Acc) -> +share_1([{label,L}=Lbl|Is], Dict0, Lbls0, [_|_]=Seq, Acc) -> case maps:find(Seq, Dict0) of error -> Dict = maps:put(Seq, L, Dict0), - share_1(Is, Dict, [], [Lbl|Seq ++ Acc]); + share_1(Is, Dict, Lbls0, [], [Lbl|Seq ++ Acc]); {ok,Label} -> - share_1(Is, Dict0, [], [Lbl,{jump,{f,Label}}|Acc]) + Lbls = maps:put(L, Label, Lbls0), + share_1(Is, Dict0, Lbls, [], [Lbl,{jump,{f,Label}}|Acc]) end; -share_1([{func_info,_,_,_}=I|Is], _, [], Acc) -> - reverse(Is, [I|Acc]); -share_1([{'catch',_,_}=I|Is], Dict0, Seq, Acc) -> - Dict = clean_non_sharable(Dict0), - share_1(Is, Dict, [I|Seq], Acc); -share_1([{'try',_,_}=I|Is], Dict0, Seq, Acc) -> - Dict = clean_non_sharable(Dict0), - share_1(Is, Dict, [I|Seq], Acc); -share_1([{try_case,_}=I|Is], Dict0, Seq, Acc) -> - Dict = clean_non_sharable(Dict0), - share_1(Is, Dict, [I|Seq], Acc); -share_1([{catch_end,_}=I|Is], Dict0, Seq, Acc) -> - Dict = clean_non_sharable(Dict0), - share_1(Is, Dict, [I|Seq], Acc); -share_1([I|Is], Dict, Seq, Acc) -> +share_1([{func_info,_,_,_}|_]=Is, _, Lbls, [], Acc) when Lbls =/= #{} -> + beam_utils:replace_labels(Acc, Is, Lbls, fun(Old) -> Old end); +share_1([{func_info,_,_,_}|_]=Is, _, Lbls, [], Acc) when Lbls =:= #{} -> + reverse(Acc, Is); +share_1([{'catch',_,_}=I|Is], Dict0, Lbls0, Seq, Acc) -> + {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0), + share_1(Is, Dict, Lbls, [I|Seq], Acc); +share_1([{'try',_,_}=I|Is], Dict0, Lbls0, Seq, Acc) -> + {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0), + share_1(Is, Dict, Lbls, [I|Seq], Acc); +share_1([{try_case,_}=I|Is], Dict0, Lbls0, Seq, Acc) -> + {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0), + share_1(Is, Dict, Lbls, [I|Seq], Acc); +share_1([{catch_end,_}=I|Is], Dict0, Lbls0, Seq, Acc) -> + {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0), + share_1(Is, Dict, Lbls, [I|Seq], Acc); +share_1([I|Is], Dict, Lbls, Seq, Acc) -> case is_unreachable_after(I) of false -> - share_1(Is, Dict, [I|Seq], Acc); + share_1(Is, Dict, Lbls, [I|Seq], Acc); true -> - share_1(Is, Dict, [I], Acc) + share_1(Is, Dict, Lbls, [I], Acc) end. -clean_non_sharable(Dict) -> +clean_non_sharable(Dict0, Lbls0) -> %% We are passing in or out of a 'catch' or 'try' block. Remove %% sequences that should not be shared over the boundaries of the %% block. Since the end of the sequence must match, the only @@ -198,7 +203,17 @@ clean_non_sharable(Dict) -> %% the 'catch'/'try' block is a sequence that ends with an %% instruction that causes an exception. Any sequence that causes %% an exception must contain a line/1 instruction. - maps:filter(fun(K, _V) -> sharable_with_try(K) end, Dict). + Dict1 = maps:to_list(Dict0), + Lbls1 = maps:to_list(Lbls0), + {Dict2,Lbls2} = foldl(fun({K, V}, {Dict,Lbls}) -> + case sharable_with_try(K) of + true -> + {[{K,V}|Dict],lists:keydelete(V, 2, Lbls)}; + false -> + {Dict,Lbls} + end + end, {[],Lbls1}, Dict1), + {maps:from_list(Dict2),maps:from_list(Lbls2)}. sharable_with_try([{line,_}|_]) -> %% This sequence may cause an exception and may potentially @@ -275,14 +290,15 @@ extract_seq_1(_, _) -> no. -record(st, { entry :: beam_asm:label(), %Entry label (must not be moved). - mlbl :: #{beam_asm:label() := [beam_asm:label()]}, %Moved labels. - labels :: cerl_sets:set() %Set of referenced labels. + replace :: #{beam_asm:label() := beam_asm:label()}, %Labels to replace. + labels :: cerl_sets:set(), %Set of referenced labels. + index :: beam_utils:code_index() | {lazy,[beam_utils:instruction()]} %Index built lazily only if needed }). opt(Is0, CLabel) -> find_fixpoint(fun(Is) -> Lbls = initial_labels(Is), - St = #st{entry=CLabel,mlbl=#{},labels=Lbls}, + St = #st{entry=CLabel,replace=#{},labels=Lbls,index={lazy,Is}}, opt(Is, [], St) end, Is0). @@ -292,7 +308,7 @@ find_fixpoint(OptFun, Is0) -> Is -> find_fixpoint(OptFun, Is) end. -opt([{test,_,{f,L}=Lbl,_}=I|[{jump,{f,L}}|_]=Is], Acc, St) -> +opt([{test,_,{f,L}=Lbl,_}=I|[{jump,{f,L}}|_]=Is], Acc0, St0) -> %% We have %% Test Label Ops %% jump Label @@ -301,10 +317,23 @@ opt([{test,_,{f,L}=Lbl,_}=I|[{jump,{f,L}}|_]=Is], Acc, St) -> case beam_utils:is_pure_test(I) of false -> %% Test is not pure; we must keep it. - opt(Is, [I|Acc], label_used(Lbl, St)); + opt(Is, [I|Acc0], label_used(Lbl, St0)); true -> %% The test is pure and its failure label is the same %% as in the jump that follows -- thus it is not needed. + %% Check if any of the previous instructions could also be eliminated. + {Acc,St} = opt_useless_loads(Acc0, L, St0), + opt(Is, Acc, St) + end; +opt([{test,_,{f,L}=Lbl,_}=I|[{label,L}|_]=Is], Acc0, St0) -> + %% Similar to the above, except we have a fall-through rather than jump + %% Test Label Ops + %% label Label + case beam_utils:is_pure_test(I) of + false -> + opt(Is, [I|Acc0], label_used(Lbl, St0)); + true -> + {Acc,St} = opt_useless_loads(Acc0, L, St0), opt(Is, Acc, St) end; opt([{test,Test0,{f,L}=Lbl,Ops}=I|[{jump,To}|Is]=Is0], Acc, St) -> @@ -326,30 +355,16 @@ opt([{test,_,{f,_}=Lbl,_,_,_}=I|Is], Acc, St) -> opt(Is, [I|Acc], label_used(Lbl, St)); opt([{select,_,_R,Fail,Vls}=I|Is], Acc, St) -> skip_unreachable(Is, [I|Acc], label_used([Fail|Vls], St)); -opt([{label,Lbl}=I|Is], Acc, #st{mlbl=Mlbl}=St0) -> - case maps:find(Lbl, Mlbl) of - {ok,Lbls} -> - %% Essential to remove the list of labels from the dictionary, - %% since we will rescan the inserted labels. We MUST rescan. - St = St0#st{mlbl=maps:remove(Lbl, Mlbl)}, - insert_labels([Lbl|Lbls], Is, Acc, St); - error -> - opt(Is, [I|Acc], St0) - end; +opt([{label,From}=I,{label,To}|Is], Acc, #st{replace=Replace}=St) -> + opt([I|Is], Acc, St#st{replace=Replace#{To => From}}); opt([{jump,{f,_}=X}|[{label,_},{jump,X}|_]=Is], Acc, St) -> opt(Is, Acc, St); opt([{jump,{f,Lbl}}|[{label,Lbl}|_]=Is], Acc, St) -> opt(Is, Acc, St); -opt([{jump,{f,L}=Lbl}=I|Is], Acc0, #st{mlbl=Mlbl0}=St0) -> - %% All labels before this jump instruction should now be - %% moved to the location of the jump's target. - {Lbls,Acc} = collect_labels(Acc0, St0), - St = case Lbls of - [] -> St0; - [_|_] -> - Mlbl = maps_append_list(L, Lbls, Mlbl0), - St0#st{mlbl=Mlbl} - end, +opt([{jump,{f,L}=Lbl}=I|Is], Acc0, St0) -> + %% Replace all labels before this jump instruction into the + %% location of the jump's target. + {Acc,St} = collect_labels(Acc0, L, St0), skip_unreachable(Is, [I|Acc], label_used(Lbl, St)); %% Optimization: quickly handle some common instructions that don't %% have any failure labels and where is_unreachable_after(I) =:= false. @@ -369,36 +384,72 @@ opt([I|Is], Acc, #st{labels=Used0}=St0) -> true -> skip_unreachable(Is, [I|Acc], St); false -> opt(Is, [I|Acc], St) end; -opt([], Acc, #st{mlbl=Mlbl}) -> - Code = reverse(Acc), - insert_fc_labels(Code, Mlbl). - -insert_fc_labels([{label,L}=I|Is0], Mlbl) -> - case maps:find(L, Mlbl) of - error -> - [I|insert_fc_labels(Is0, Mlbl)]; - {ok,Lbls} -> - Is = [{label,Lb} || Lb <- Lbls] ++ Is0, - [I|insert_fc_labels(Is, maps:remove(L, Mlbl))] +opt([], Acc, #st{replace=Replace0}) when Replace0 =/= #{} -> + Replace = normalize_replace(maps:to_list(Replace0), Replace0, []), + beam_utils:replace_labels(Acc, [], Replace, fun(Old) -> Old end); +opt([], Acc, #st{replace=Replace}) when Replace =:= #{} -> + reverse(Acc). + +normalize_replace([{From,To0}|Rest], Replace, Acc) -> + case Replace of + #{To0 := To} -> + normalize_replace([{From,To}|Rest], Replace, Acc); + _ -> + normalize_replace(Rest, Replace, [{From,To0}|Acc]) end; -insert_fc_labels([_|_]=Is, _) -> Is. - -maps_append_list(K,Vs,M) -> - case M of - #{K:=Vs0} -> M#{K:=Vs0++Vs}; % same order as dict - _ -> M#{K => Vs} - end. +normalize_replace([], _Replace, Acc) -> + maps:from_list(Acc). + +%% After eliminating a test, it might happen, that a register was only used +%% in this test. Let's check if that was the case and if it was so, we can +%% eliminate the load into the register completely. +opt_useless_loads([{block,_}|_]=Is, L, #st{index={lazy,FIs}}=St) -> + opt_useless_loads(Is, L, St#st{index=beam_utils:index_labels(FIs)}); +opt_useless_loads([{block,Block0}|Is], L, #st{index=Index}=St) -> + case opt_useless_block_loads(Block0, L, Index) of + [] -> + opt_useless_loads(Is, L, St); + [_|_]=Block -> + {[{block,Block}|Is],St} + end; +%% After eliminating the test and useless blocks, it might happen, +%% that the previous test could also be eliminated. +%% It might be that the label was already marked as used, even if ultimately, +%% it never will be - we can't do much about it at that point, though +opt_useless_loads([{test,_,{f,L},_}=I|Is], L, St) -> + case beam_utils:is_pure_test(I) of + false -> + {[I|Is],St}; + true -> + opt_useless_loads(Is, L, St) + end; +opt_useless_loads(Is, _L, St) -> + {Is,St}. + +opt_useless_block_loads([{set,[Dst],_,_}=I|Is], L, Index) -> + BlockJump = [{block,Is},{jump,{f,L}}], + case beam_utils:is_killed(Dst, BlockJump, Index) of + true -> + %% The register is killed and not used, we can remove the load + opt_useless_block_loads(Is, L, Index); + false -> + [I|opt_useless_block_loads(Is, L, Index)] + end; +opt_useless_block_loads([I|Is], L, Index) -> + [I|opt_useless_block_loads(Is, L, Index)]; +opt_useless_block_loads([], _L, _Index) -> + []. -collect_labels(Is, #st{entry=Entry}) -> - collect_labels_1(Is, Entry, []). +collect_labels(Is, Label, #st{entry=Entry,replace=Replace} = St) -> + collect_labels_1(Is, Label, Entry, Replace, St). -collect_labels_1([{label,Entry}|_]=Is, Entry, Acc) -> +collect_labels_1([{label,Entry}|_]=Is, _Label, Entry, Acc, St) -> %% Never move the entry label. - {Acc,Is}; -collect_labels_1([{label,L}|Is], Entry, Acc) -> - collect_labels_1(Is, Entry, [L|Acc]); -collect_labels_1(Is, _Entry, Acc) -> - {Acc,Is}. + {Is,St#st{replace=Acc}}; +collect_labels_1([{label,L}|Is], Label, Entry, Acc, St) -> + collect_labels_1(Is, Label, Entry, Acc#{L => Label}, St); +collect_labels_1(Is, _Label, _Entry, Acc, St) -> + {Is,St#st{replace=Acc}}. %% label_defined(Is, Label) -> true | false. %% Test whether the label Label is defined at the start of the instruction @@ -418,13 +469,6 @@ invert_test(is_eq_exact) -> is_ne_exact; invert_test(is_ne_exact) -> is_eq_exact; invert_test(_) -> not_possible. -insert_labels([L|Ls], Is, [{jump,{f,L}}|Acc], St) -> - insert_labels(Ls, [{label,L}|Is], Acc, St); -insert_labels([L|Ls], Is, Acc, St) -> - insert_labels(Ls, [{label,L}|Is], Acc, St); -insert_labels([], Is, Acc, St) -> - opt(Is, Acc, St). - %% skip_unreachable([Instruction], St). %% Remove all instructions (including definitions of labels %% that have not been referenced yet) up to the next diff --git a/lib/compiler/src/beam_listing.erl b/lib/compiler/src/beam_listing.erl index 94b47cf568..73c6501fe5 100644 --- a/lib/compiler/src/beam_listing.erl +++ b/lib/compiler/src/beam_listing.erl @@ -23,14 +23,13 @@ -include("core_parse.hrl"). -include("v3_kernel.hrl"). --include("v3_life.hrl"). +-include("beam_disasm.hrl"). -import(lists, [foreach/2]). -type code() :: cerl:c_module() | beam_utils:module_code() | #k_mdef{} - | {module(),_,_,_} %v3_life | [_]. %form-based format -spec module(file:io_device(), code()) -> 'ok'. @@ -42,13 +41,9 @@ module(File, #k_mdef{}=Kern) -> %% This is a kernel module. io:put_chars(File, v3_kernel_pp:format(Kern)); %%io:put_chars(File, io_lib:format("~p~n", [Kern])); -module(File, {Mod,Exp,Attr,Kern}) -> - %% This is output from beam_life (v3). - io:fwrite(File, "~w.~n~p.~n~p.~n", [Mod,Exp,Attr]), - foreach(fun (F) -> function(File, F) end, Kern); module(Stream, {Mod,Exp,Attr,Code,NumLabels}) -> - %% This is output from beam_codegen. - io:format(Stream, "{module, ~p}. %% version = ~w\n", + %% This is output from v3_codegen. + io:format(Stream, "{module, ~p}. %% version = ~w\n", [Mod, beam_opcodes:format_number()]), io:format(Stream, "\n{exports, ~p}.\n", [Exp]), io:format(Stream, "\n{attributes, ~p}.\n", [Attr]), @@ -68,60 +63,3 @@ format_asm([{label,L}|Is]) -> format_asm([I|Is]) -> [io_lib:format(" ~p", [I]),".\n"|format_asm(Is)]; format_asm([]) -> []. - -function(File, {function,Name,Arity,Args,Body,Vdb,_Anno}) -> - io:nl(File), - io:format(File, "function ~p/~p.\n", [Name,Arity]), - io:format(File, " ~p.\n", [Args]), - print_vdb(File, Vdb), - put(beam_listing_nl, false), - nl(File), - foreach(fun(F) -> format(File, F, []) end, Body), - nl(File), - erase(beam_listing_nl). - -format(File, #l{ke=Ke,i=I,vdb=Vdb}, Ind) -> - nl(File), - ind_format(File, Ind, "~p ", [I]), - print_vdb(File, Vdb), - nl(File), - format(File, Ke, Ind); -format(File, Tuple, Ind) when is_tuple(Tuple) -> - ind_format(File, Ind, "{", []), - format_list(File, tuple_to_list(Tuple), [$\s|Ind]), - ind_format(File, Ind, "}", []); -format(File, List, Ind) when is_list(List) -> - ind_format(File, Ind, "[", []), - format_list(File, List, [$\s|Ind]), - ind_format(File, Ind, "]", []); -format(File, F, Ind) -> - ind_format(File, Ind, "~p", [F]). - -format_list(File, [F], Ind) -> - format(File, F, Ind); -format_list(File, [F|Fs], Ind) -> - format(File, F, Ind), - ind_format(File, Ind, ",", []), - format_list(File, Fs, Ind); -format_list(_, [], _) -> ok. - - -print_vdb(File, [{Var,F,E}|Vs]) -> - io:format(File, "~p:~p..~p ", [Var,F,E]), - print_vdb(File, Vs); -print_vdb(_, []) -> ok. - -ind_format(File, Ind, Format, Args) -> - case get(beam_listing_nl) of - true -> - put(beam_listing_nl, false), - io:put_chars(File, Ind); - false -> ok - end, - io:format(File, Format, Args). - -nl(File) -> - case put(beam_listing_nl, true) of - true -> ok; - false -> io:nl(File) - end. diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl index 6df5c02334..eb3192fe8f 100644 --- a/lib/compiler/src/beam_peep.erl +++ b/lib/compiler/src/beam_peep.erl @@ -41,8 +41,7 @@ function({function,Name,Arity,CLabel,Is0}) -> Is = beam_jump:remove_unused_labels(Is1), {function,Name,Arity,CLabel,Is} catch - Class:Error -> - Stack = erlang:get_stacktrace(), + Class:Error:Stack -> io:fwrite("Function: ~w/~w\n", [Name,Arity]), erlang:raise(Class, Error, Stack) end. @@ -89,15 +88,37 @@ peep([{gc_bif,_,_,_,_,Dst}=I|Is], SeenTests0, Acc) -> peep([{jump,{f,L}},{label,L}=I|Is], _, Acc) -> %% Sometimes beam_jump has missed this optimization. peep(Is, gb_sets:empty(), [I|Acc]); -peep([{select,Op,R,F,Vls0}|Is], _, Acc) -> +peep([{select,Op,R,F,Vls0}|Is], SeenTests0, Acc0) -> case prune_redundant_values(Vls0, F) of [] -> %% No values left. Must convert to plain jump. I = {jump,F}, - peep(Is, gb_sets:empty(), [I|Acc]); + peep([I|Is], gb_sets:empty(), Acc0); + [{atom,_}=Value,Lbl] when Op =:= select_val -> + %% Single value left. Convert to regular test and pop redundant tests. + Is1 = [{test,is_eq_exact,F,[R,Value]},{jump,Lbl}|Is], + case Acc0 of + [{test,is_atom,F,[R]}|Acc] -> + peep(Is1, SeenTests0, Acc); + _ -> + peep(Is1, SeenTests0, Acc0) + end; + [{integer,_}=Value,Lbl] when Op =:= select_val -> + %% Single value left. Convert to regular test and pop redundant tests. + Is1 = [{test,is_eq_exact,F,[R,Value]},{jump,Lbl}|Is], + case Acc0 of + [{test,is_integer,F,[R]}|Acc] -> + peep(Is1, SeenTests0, Acc); + _ -> + peep(Is1, SeenTests0, Acc0) + end; + [Arity,Lbl] when Op =:= select_tuple_arity -> + %% Single value left. Convert to regular test + Is1 = [{test,test_arity,F,[R,Arity]},{jump,Lbl}|Is], + peep(Is1, SeenTests0, Acc0); [_|_]=Vls -> I = {select,Op,R,F,Vls}, - peep(Is, gb_sets:empty(), [I|Acc]) + peep(Is, gb_sets:empty(), [I|Acc0]) end; peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) -> case beam_utils:is_pure_test(I) of diff --git a/lib/compiler/src/beam_receive.erl b/lib/compiler/src/beam_receive.erl index 1403e1e05e..3c8efa577c 100644 --- a/lib/compiler/src/beam_receive.erl +++ b/lib/compiler/src/beam_receive.erl @@ -82,8 +82,7 @@ function({function,Name,Arity,Entry,Is}) -> D = beam_utils:index_labels(Is), {function,Name,Arity,Entry,opt(Is, D, [])} catch - Class:Error -> - Stack = erlang:get_stacktrace(), + Class:Error:Stack -> io:fwrite("Function: ~w/~w\n", [Name,Arity]), erlang:raise(Class, Error, Stack) end. @@ -207,6 +206,8 @@ opt_update_regs({label,Lbl}, R, L) -> %% A catch label for a previously seen catch instruction is OK. {R,L} end; +opt_update_regs({'try',_,{f,Lbl}}, R, L) -> + {R,gb_sets:add(Lbl, L)}; opt_update_regs({try_end,_}, R, L) -> {R,L}; opt_update_regs({line,_}, R, L) -> diff --git a/lib/compiler/src/beam_record.erl b/lib/compiler/src/beam_record.erl index 419089b1bc..e4775ca6a4 100644 --- a/lib/compiler/src/beam_record.erl +++ b/lib/compiler/src/beam_record.erl @@ -56,8 +56,7 @@ function({function,Name,Arity,CLabel,Is}) -> Idx = beam_utils:index_labels(Is), {function,Name,Arity,CLabel,rewrite(Is,Idx)} catch - Class:Error -> - Stack = erlang:get_stacktrace(), + Class:Error:Stack -> io:fwrite("Function: ~w/~w\n", [Name,Arity]), erlang:raise(Class, Error, Stack) end. diff --git a/lib/compiler/src/beam_reorder.erl b/lib/compiler/src/beam_reorder.erl index 910b7f6b0a..63bb57a1ac 100644 --- a/lib/compiler/src/beam_reorder.erl +++ b/lib/compiler/src/beam_reorder.erl @@ -35,8 +35,7 @@ function({function,Name,Arity,CLabel,Is0}) -> Is = reorder(Is0), {function,Name,Arity,CLabel,Is} catch - Class:Error -> - Stack = erlang:get_stacktrace(), + Class:Error:Stack -> io:fwrite("Function: ~w/~w\n", [Name,Arity]), erlang:raise(Class, Error, Stack) end. diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 3d842a6fd3..16d5a36447 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -43,8 +43,7 @@ function({function,Name,Arity,CLabel,Asm0}) -> Asm = beam_utils:delete_live_annos(Asm3), {function,Name,Arity,CLabel,Asm} catch - Class:Error -> - Stack = erlang:get_stacktrace(), + Class:Error:Stack -> io:fwrite("Function: ~w/~w\n", [Name,Arity]), erlang:raise(Class, Error, Stack) end. diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index e39fbdc3b7..1b2a2827cb 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -23,14 +23,20 @@ -module(beam_utils). -export([is_killed_block/2,is_killed/3,is_killed_at/3, is_not_used/3, - empty_label_index/0,index_label/3,index_labels/1, + empty_label_index/0,index_label/3,index_labels/1,replace_labels/4, code_at/2,bif_to_test/3,is_pure_test/1, live_opt/1,delete_live_annos/1,combine_heap_needs/2, split_even/1]). -export_type([code_index/0,module_code/0,instruction/0]). --import(lists, [member/2,sort/1,reverse/1,splitwith/2]). +-import(lists, [map/2,member/2,sort/1,reverse/1,splitwith/2]). + +-define(is_const(Val), (Val =:= nil orelse + element(1, Val) =:= integer orelse + element(1, Val) =:= float orelse + element(1, Val) =:= atom orelse + element(1, Val) =:= literal)). %% instruction() describes all instructions that are used during optimzation %% (from beam_a to beam_z). @@ -160,6 +166,18 @@ index_label(Lbl, Is0, Acc) -> code_at(L, Ll) -> gb_trees:get(L, Ll). +%% replace_labels(FunctionIs, Tail, ReplaceDb, Fallback) -> FunctionIs. +%% Replace all labels in instructions according to the ReplaceDb. +%% If label is not found the Fallback is called with the label to +%% produce a new one. + +-spec replace_labels([instruction()], + [instruction()], + #{beam_asm:label() => beam_asm:label()}, + fun((beam_asm:label()) -> term())) -> [instruction()]. +replace_labels(Is, Acc, D, Fb) -> + replace_labels_1(Is, Acc, D, Fb). + %% bif_to_test(Bif, [Op], Fail) -> {test,Test,Fail,[Op]} %% Convert a BIF to a test. Fail if not possible. @@ -185,10 +203,20 @@ bif_to_test('>', [A,B], Fail) -> {test,is_lt,Fail,[B,A]}; bif_to_test('<', [_,_]=Ops, Fail) -> {test,is_lt,Fail,Ops}; bif_to_test('>=', [_,_]=Ops, Fail) -> {test,is_ge,Fail,Ops}; bif_to_test('==', [A,nil], Fail) -> {test,is_nil,Fail,[A]}; +bif_to_test('==', [nil,A], Fail) -> {test,is_nil,Fail,[A]}; +bif_to_test('==', [C,A], Fail) when ?is_const(C) -> + {test,is_eq,Fail,[A,C]}; bif_to_test('==', [_,_]=Ops, Fail) -> {test,is_eq,Fail,Ops}; +bif_to_test('/=', [C,A], Fail) when ?is_const(C) -> + {test,is_ne,Fail,[A,C]}; bif_to_test('/=', [_,_]=Ops, Fail) -> {test,is_ne,Fail,Ops}; bif_to_test('=:=', [A,nil], Fail) -> {test,is_nil,Fail,[A]}; +bif_to_test('=:=', [nil,A], Fail) -> {test,is_nil,Fail,[A]}; +bif_to_test('=:=', [C,A], Fail) when ?is_const(C) -> + {test,is_eq_exact,Fail,[A,C]}; bif_to_test('=:=', [_,_]=Ops, Fail) -> {test,is_eq_exact,Fail,Ops}; +bif_to_test('=/=', [C,A], Fail) when ?is_const(C) -> + {test,is_ne_exact,Fail,[A,C]}; bif_to_test('=/=', [_,_]=Ops, Fail) -> {test,is_ne_exact,Fail,Ops}; bif_to_test(is_record, [_,_,_]=Ops, Fail) -> {test,is_record,Fail,Ops}. @@ -643,6 +671,58 @@ index_labels_1([], Acc) -> gb_trees:from_orddict(sort(Acc)). drop_labels([{label,_}|Is]) -> drop_labels(Is); drop_labels(Is) -> Is. + +replace_labels_1([{test,Test,{f,Lbl},Ops}|Is], Acc, D, Fb) -> + replace_labels_1(Is, [{test,Test,{f,label(Lbl, D, Fb)},Ops}|Acc], D, Fb); +replace_labels_1([{test,Test,{f,Lbl},Live,Ops,Dst}|Is], Acc, D, Fb) -> + replace_labels_1(Is, [{test,Test,{f,label(Lbl, D, Fb)},Live,Ops,Dst}|Acc], D, Fb); +replace_labels_1([{select,I,R,{f,Fail0},Vls0}|Is], Acc, D, Fb) -> + Vls = map(fun ({f,L}) -> {f,label(L, D, Fb)}; + (Other) -> Other + end, Vls0), + Fail = label(Fail0, D, Fb), + replace_labels_1(Is, [{select,I,R,{f,Fail},Vls}|Acc], D, Fb); +replace_labels_1([{'try',R,{f,Lbl}}|Is], Acc, D, Fb) -> + replace_labels_1(Is, [{'try',R,{f,label(Lbl, D, Fb)}}|Acc], D, Fb); +replace_labels_1([{'catch',R,{f,Lbl}}|Is], Acc, D, Fb) -> + replace_labels_1(Is, [{'catch',R,{f,label(Lbl, D, Fb)}}|Acc], D, Fb); +replace_labels_1([{jump,{f,Lbl}}|Is], Acc, D, Fb) -> + replace_labels_1(Is, [{jump,{f,label(Lbl, D, Fb)}}|Acc], D, Fb); +replace_labels_1([{loop_rec,{f,Lbl},R}|Is], Acc, D, Fb) -> + replace_labels_1(Is, [{loop_rec,{f,label(Lbl, D, Fb)},R}|Acc], D, Fb); +replace_labels_1([{loop_rec_end,{f,Lbl}}|Is], Acc, D, Fb) -> + replace_labels_1(Is, [{loop_rec_end,{f,label(Lbl, D, Fb)}}|Acc], D, Fb); +replace_labels_1([{wait,{f,Lbl}}|Is], Acc, D, Fb) -> + replace_labels_1(Is, [{wait,{f,label(Lbl, D, Fb)}}|Acc], D, Fb); +replace_labels_1([{wait_timeout,{f,Lbl},To}|Is], Acc, D, Fb) -> + replace_labels_1(Is, [{wait_timeout,{f,label(Lbl, D, Fb)},To}|Acc], D, Fb); +replace_labels_1([{bif,Name,{f,Lbl},As,R}|Is], Acc, D, Fb) when Lbl =/= 0 -> + replace_labels_1(Is, [{bif,Name,{f,label(Lbl, D, Fb)},As,R}|Acc], D, Fb); +replace_labels_1([{gc_bif,Name,{f,Lbl},Live,As,R}|Is], Acc, D, Fb) when Lbl =/= 0 -> + replace_labels_1(Is, [{gc_bif,Name,{f,label(Lbl, D, Fb)},Live,As,R}|Acc], D, Fb); +replace_labels_1([{call,Ar,{f,Lbl}}|Is], Acc, D, Fb) -> + replace_labels_1(Is, [{call,Ar,{f,label(Lbl, D, Fb)}}|Acc], D, Fb); +replace_labels_1([{make_fun2,{f,Lbl},U1,U2,U3}|Is], Acc, D, Fb) -> + replace_labels_1(Is, [{make_fun2,{f,label(Lbl, D, Fb)},U1,U2,U3}|Acc], D, Fb); +replace_labels_1([{bs_init,{f,Lbl},Info,Live,Ss,Dst}|Is], Acc, D, Fb) when Lbl =/= 0 -> + replace_labels_1(Is, [{bs_init,{f,label(Lbl, D, Fb)},Info,Live,Ss,Dst}|Acc], D, Fb); +replace_labels_1([{bs_put,{f,Lbl},Info,Ss}|Is], Acc, D, Fb) when Lbl =/= 0 -> + replace_labels_1(Is, [{bs_put,{f,label(Lbl, D, Fb)},Info,Ss}|Acc], D, Fb); +replace_labels_1([{put_map=I,{f,Lbl},Op,Src,Dst,Live,List}|Is], Acc, D, Fb) + when Lbl =/= 0 -> + replace_labels_1(Is, [{I,{f,label(Lbl, D, Fb)},Op,Src,Dst,Live,List}|Acc], D, Fb); +replace_labels_1([{get_map_elements=I,{f,Lbl},Src,List}|Is], Acc, D, Fb) when Lbl =/= 0 -> + replace_labels_1(Is, [{I,{f,label(Lbl, D, Fb)},Src,List}|Acc], D, Fb); +replace_labels_1([I|Is], Acc, D, Fb) -> + replace_labels_1(Is, [I|Acc], D, Fb); +replace_labels_1([], Acc, _, _) -> Acc. + +label(Old, D, Fb) -> + case D of + #{Old := New} -> New; + _ -> Fb(Old) + end. + %% Help functions for combine_heap_needs. combine_alloc_lists(Al1, Al2) -> @@ -701,6 +781,8 @@ live_opt([{block,Bl0}|Is], Regs0, D, Acc) -> {Bl,Regs} = live_opt_block(reverse(Bl0), Regs0, D, [Live0]), Live = {'%live',live_regs(Regs),Regs}, live_opt(Is, Regs, D, [{block,[Live|Bl]}|Acc]); +live_opt([build_stacktrace=I|Is], _, D, Acc) -> + live_opt(Is, live_call(1), D, [I|Acc]); live_opt([{label,L}=I|Is], Regs, D0, Acc) -> D = gb_trees:insert(L, Regs, D0), live_opt(Is, Regs, D, [I|Acc]); @@ -746,8 +828,14 @@ live_opt([{select,_,Src,Fail,List}=I|Is], Regs0, D, Acc) -> Regs1 = x_live([Src], Regs0), Regs = live_join_labels([Fail|List], D, Regs1), live_opt(Is, Regs, D, [I|Acc]); -live_opt([{try_case,_}=I|Is], _, D, Acc) -> - live_opt(Is, live_call(1), D, [I|Acc]); +live_opt([{try_case,Y}=I|Is], Regs0, D, Acc) -> + Regs = live_call(1), + case Regs0 of + 0 -> + live_opt(Is, Regs, D, [{try_end,Y}|Acc]); + _ -> + live_opt(Is, live_call(1), D, [I|Acc]) + end; live_opt([{loop_rec,_Fail,_Dst}=I|Is], _, D, Acc) -> live_opt(Is, 0, D, [I|Acc]); live_opt([timeout=I|Is], _, D, Acc) -> diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index be8908dd6b..2ad9747940 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -130,9 +130,8 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> throw:Error -> %% Controlled error. [Error|validate_0(Module, Fs, Ft)]; - Class:Error -> + Class:Error:Stack -> %% Crash. - Stack = erlang:get_stacktrace(), io:fwrite("Function: ~w/~w\n", [Name,Ar]), erlang:raise(Class, Error, Stack) end. @@ -294,6 +293,8 @@ valfun_1({bs_context_to_binary,Ctx}, #vst{current=#st{x=Xs}}=Vst) -> end; valfun_1(bs_init_writable=I, Vst) -> call(I, 1, Vst); +valfun_1(build_stacktrace=I, Vst) -> + call(I, 1, Vst); valfun_1({move,{y,_}=Src,{y,_}=Dst}, Vst) -> %% The stack trimming optimization may generate a move from an initialized %% but unassigned Y register to another Y register. diff --git a/lib/compiler/src/beam_z.erl b/lib/compiler/src/beam_z.erl index 787e33c142..1c56b95a9e 100644 --- a/lib/compiler/src/beam_z.erl +++ b/lib/compiler/src/beam_z.erl @@ -38,8 +38,7 @@ function({function,Name,Arity,CLabel,Is0}) -> Is = undo_renames(Is0), {function,Name,Arity,CLabel,Is} catch - Class:Error -> - Stack = erlang:get_stacktrace(), + Class:Error:Stack -> io:fwrite("Function: ~w/~w\n", [Name,Arity]), erlang:raise(Class, Error, Stack) end. diff --git a/lib/compiler/src/cerl_clauses.erl b/lib/compiler/src/cerl_clauses.erl index 7d6518c3c6..fa5104c01b 100644 --- a/lib/compiler/src/cerl_clauses.erl +++ b/lib/compiler/src/cerl_clauses.erl @@ -353,6 +353,8 @@ match(P, E, Bs) -> map -> %% The most we can do is to say "definitely no match" if a %% map pattern is matched against non-map data. + %% (Note: See the document internal_doc/cerl-notes.md for + %% information why we don't try to do more here.) case E of any -> {false, Bs}; diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index aa2d224bb4..f963d9a480 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -706,14 +706,16 @@ core_passes() -> [{unless,no_copt, [{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/2}, {iff,doldinline,{listing,"oldinline"}}, - {pass,sys_core_fold}, + {unless,no_fold,{pass,sys_core_fold}}, {iff,dcorefold,{listing,"corefold"}}, {core_inline_module,fun test_core_inliner/1,fun core_inline_module/2}, {iff,dinline,{listing,"inline"}}, {core_fold_after_inlining,fun test_any_inliner/1, fun core_fold_module_after_inlining/2}, + {iff,dcopt,{listing,"copt"}}, + {unless,no_alias,{pass,sys_core_alias}}, + {iff,dalias,{listing,"core_alias"}}, ?pass(core_transforms)]}, - {iff,dcopt,{listing,"copt"}}, {iff,'to_core',{done,"core"}}]} | kernel_passes()]. @@ -731,8 +733,6 @@ kernel_passes() -> ?pass(v3_kernel), {iff,dkern,{listing,"kernel"}}, {iff,'to_kernel',{done,"kernel"}}, - {pass,v3_life}, - {iff,dlife,{listing,"life"}}, {pass,v3_codegen}, {iff,dcg,{listing,"codegen"}} | asm_passes()]. @@ -787,8 +787,10 @@ asm_passes() -> | binary_passes()]. binary_passes() -> - [{native_compile,fun test_native/1,fun native_compile/2}, - {unless,binary,?pass(save_binary,not_werror)}]. + [{iff,'to_dis',?pass(to_dis)}, + {native_compile,fun test_native/1,fun native_compile/2}, + {unless,binary,?pass(save_binary,not_werror)} + ]. %%% %%% Compiler passes. @@ -1446,15 +1448,33 @@ save_core_code(Code, St) -> beam_asm(Code0, #compile{ifile=File,extra_chunks=ExtraChunks,options=CompilerOpts}=St) -> case debug_info(St) of {ok,DebugInfo,Opts0} -> - Source = paranoid_absname(File), Opts1 = [O || O <- Opts0, effects_code_generation(O)], Chunks = [{<<"Dbgi">>, DebugInfo} | ExtraChunks], - {ok,Code} = beam_asm:module(Code0, Chunks, Source, Opts1, CompilerOpts), + CompileInfo = compile_info(File, CompilerOpts, Opts1), + {ok,Code} = beam_asm:module(Code0, Chunks, CompileInfo, CompilerOpts), {ok,Code,St#compile{abstract_code=[]}}; {error,Es} -> {error,St#compile{errors=St#compile.errors ++ [{File,Es}]}} end. +compile_info(File, CompilerOpts, Opts) -> + IsSlim = member(slim, CompilerOpts), + IsDeterministic = member(deterministic, CompilerOpts), + Info0 = proplists:get_value(compile_info, Opts, []), + Info1 = + case paranoid_absname(File) of + [_|_] = Source when not IsSlim, not IsDeterministic -> + [{source,Source} | Info0]; + _ -> + Info0 + end, + Info2 = + case IsDeterministic of + false -> [{options,proplists:delete(compile_info, Opts)} | Info1]; + true -> Info1 + end, + Info2. + paranoid_absname(""=File) -> File; paranoid_absname(File) -> @@ -1510,15 +1530,14 @@ native_compile_1(Code, St) -> {error,St#compile{errors=St#compile.errors ++ Es}} end catch - Class:R -> - Stk = erlang:get_stacktrace(), + Class:R:Stack -> case IgnoreErrors of true -> Ws = [{St#compile.ifile, - [{none,?MODULE,{native_crash,R,Stk}}]}], + [{none,?MODULE,{native_crash,R,Stack}}]}], {ok,St#compile{warnings=St#compile.warnings ++ Ws}}; false -> - erlang:raise(Class, R, Stk) + erlang:raise(Class, R, Stack) end end. @@ -1746,6 +1765,21 @@ listing(LFun, Ext, Code, St) -> {error,St#compile{errors=St#compile.errors ++ Es}} end. +to_dis(Code, #compile{module=Module,ofile=Outfile}=St) -> + Loaded = code:is_loaded(Module), + Sticky = code:is_sticky(Module), + _ = [code:unstick_mod(Module) || Sticky], + + {module,Module} = code:load_binary(Module, "", Code), + DestDir = filename:dirname(Outfile), + DisFile = filename:join(DestDir, atom_to_list(Module) ++ ".dis"), + ok = erts_debug:dis_to_file(Module, DisFile), + + %% Restore loaded module + _ = [{module, Module} = code:load_file(Module) || Loaded =/= false], + [code:stick_mod(Module) || Sticky], + {ok,Code,St}. + output_encoding(F, #compile{encoding = none}) -> ok = io:setopts(F, [{encoding, epp:default_encoding()}]); output_encoding(F, #compile{encoding = Encoding}) -> @@ -1921,12 +1955,12 @@ pre_load() -> erl_lint, erl_parse, erl_scan, + sys_core_alias, sys_core_bsm, sys_core_dsetel, sys_core_fold, v3_codegen, v3_core, - v3_kernel, - v3_life], + v3_kernel], _ = code:ensure_modules_loaded(L), ok. diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index 3139d68902..cf32fd251c 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -58,6 +58,7 @@ core_lib, erl_bifs, rec_env, + sys_core_alias, sys_core_bsm, sys_core_dsetel, sys_core_fold, @@ -67,8 +68,7 @@ v3_codegen, v3_core, v3_kernel, - v3_kernel_pp, - v3_life + v3_kernel_pp ]}, {registered, []}, {applications, [kernel, stdlib]}, diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl index 7d3513c0ba..6e2114be56 100644 --- a/lib/compiler/src/core_lint.erl +++ b/lib/compiler/src/core_lint.erl @@ -353,12 +353,6 @@ expr(#c_case{arg=Arg,clauses=Cs}, Def, Rt, St0) -> Pc = case_patcount(Cs), St1 = body(Arg, Def, Pc, St0), clauses(Cs, Def, Pc, Rt, St1); -expr(#c_receive{clauses=Cs,timeout=#c_literal{val=infinity}, - action=#c_literal{}}, - Def, Rt, St) -> - %% If the timeout is 'infinity', the after code can never - %% be reached. We don't care if the return count is wrong. - clauses(Cs, Def, 1, Rt, St); expr(#c_receive{clauses=Cs,timeout=T,action=A}, Def, Rt, St0) -> St1 = expr(T, Def, 1, St0), St2 = body(A, Def, Rt, St1), diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl index cff6c7098b..2516a9a1e1 100644 --- a/lib/compiler/src/core_pp.erl +++ b/lib/compiler/src/core_pp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% Copyright Ericsson AB 1999-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -464,7 +464,7 @@ indent(#ctxt{indent=N}) -> N =< 0 -> ""; true -> - string:chars($\t, N div ?TAB_WIDTH, spaces(N rem ?TAB_WIDTH)) + lists:duplicate(N div ?TAB_WIDTH, $\t) ++ spaces(N rem ?TAB_WIDTH) end. nl_indent(Ctxt) -> [$\n|indent(Ctxt)]. diff --git a/lib/compiler/src/core_scan.erl b/lib/compiler/src/core_scan.erl index 9f0676538f..a50a2ffa8d 100644 --- a/lib/compiler/src/core_scan.erl +++ b/lib/compiler/src/core_scan.erl @@ -200,8 +200,8 @@ pre_string(eof, Q, _, Sp, SoFar, Pos) -> pre_string_error(Q, Sp, SoFar, Pos). pre_string_error(Q, Sp, SoFar, Pos) -> - S = reverse(string:substr(SoFar, 1, string:chr(SoFar, Q)-1)), - pre_error({string,Q,string:substr(S, 1, 16)}, Sp, Pos). + [S,_] = string:split(SoFar, [Q]), + pre_error({string,Q,string:slice(string:reverse(S), 0, 16)}, Sp, Pos). pre_char([C|Cs], SoFar) -> pre_char(C, Cs, SoFar); pre_char([], _) -> more; diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab index b5688de339..397e478e1e 100755 --- a/lib/compiler/src/genop.tab +++ b/lib/compiler/src/genop.tab @@ -545,3 +545,12 @@ BEAM_FORMAT_NUMBER=0 ## Test the arity of Reg and jumps to Lbl if it is not N. ## Test the first element of the tuple and jumps to Lbl if it is not Atom. 159: is_tagged_tuple/4 + +# OTP 21 + +## @spec build_stacktrace +## @doc Given the raw stacktrace in x(0), build a cooked stacktrace suitable +## for human consumption. Store it in x(0). Destroys all other registers. +## Do a garbage collection if necessary to allocate space on the heap +## for the result. +160: build_stacktrace/0 diff --git a/lib/compiler/src/sys_core_alias.erl b/lib/compiler/src/sys_core_alias.erl new file mode 100644 index 0000000000..1bce1577d1 --- /dev/null +++ b/lib/compiler/src/sys_core_alias.erl @@ -0,0 +1,307 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +%% Purpose : Replace values by aliases from patterns optimisation for Core + +%% Replace expressions by aliases from patterns. For example: +%% +%% example({ok, Val}) -> +%% {ok, Val}. +%% +%% will become: +%% +%% example({ok, Val} = Tuple) -> +%% Tuple. +%% +%% Currently this pass aliases tuple and cons nodes made of literals, +%% variables and other cons. The tuple/cons may appear anywhere in the +%% pattern and it will be aliased if used later on. +%% +%% Notice a tuple/cons made only of literals is not aliased as it may +%% be part of the literal pool. + +-module(sys_core_alias). + +-export([module/2]). + +-include("core_parse.hrl"). + +-define(NOTSET, 0). + +-record(sub, {p=#{} :: #{term() => ?NOTSET | atom()}, %% Found pattern substitutions + v=cerl_sets:new() :: cerl_sets:set(cerl:var_name()), %% Variables used by patterns + t=undefined :: term()}). %% Temporary information from pre to post + +-type sub() :: #sub{}. + +-spec module(cerl:c_module(), [compile:option()]) -> + {'ok',cerl:c_module(),[]}. + +module(#c_module{defs=Ds0}=Mod, _Opts) -> + Ds1 = [def(D) || D <- Ds0], + {ok,Mod#c_module{defs=Ds1},[]}. + +def({#c_var{name={F,Arity}}=Name,B0}) -> + try + put(new_var_num, 0), + {B1,_} = cerl_trees:mapfold(fun pre/2, fun post/2, sub_new(undefined), B0), + erase(new_var_num), + {Name,B1} + catch + Class:Error:Stack -> + io:fwrite("Function: ~w/~w\n", [F,Arity]), + erlang:raise(Class, Error, Stack) + end. + +pre(#c_let{vars=Vars}=Node, Sub) -> + {Node,sub_fold(get_variables(Vars), Sub)}; + +pre(#c_fun{vars=Vars}=Node, Sub) -> + {Node,sub_fold(get_variables(Vars), Sub)}; + +pre(#c_clause{pats=Pats}=Node, Sub0) -> + VarNames = get_variables(Pats), + Sub1 = sub_fold(VarNames, Sub0), + Keys = get_pattern_keys(Pats), + Sub2 = sub_add_keys(Keys, Sub1), + + #sub{v=SubNames,t=Temp} = Sub2, + Sub3 = Sub2#sub{v=merge_variables(VarNames, SubNames), + t={clause,Pats,Keys,SubNames,Temp}}, + + {Node#c_clause{pats=[]},Sub3}; + +pre(Node, Sub0) -> + %% We cache only tuples and cons. + case cerl:is_data(Node) andalso not cerl:is_literal(Node) of + false -> + {Node,Sub0}; + true -> + Kind = cerl:data_type(Node), + Es = cerl:data_es(Node), + case sub_cache_nodes(Kind, Es, Sub0) of + {Name,Sub1} -> + {cerl:ann_c_var(cerl:get_ann(Node), Name),Sub1}; + error -> + {Node,Sub0} + end + end. + +post(#c_let{}=Node, Sub) -> + {Node,sub_unfold(Sub)}; + +post(#c_fun{}=Node, Sub) -> + {Node,sub_unfold(Sub)}; + +post(#c_clause{}=Node, #sub{t={clause,Pats0,Keys,V,T}}=Sub0) -> + {Sub1,PostKeys} = sub_take_keys(Keys, Sub0), + Pats1 = put_pattern_keys(Pats0, PostKeys), + Sub2 = sub_unfold(Sub1#sub{v=V,t=T}), + {Node#c_clause{pats=Pats1},Sub2}; + +post(Node, Sub) -> + {Node,Sub}. + +%% sub_new/1 +%% sub_add_keys/2 +%% sub_take_keys/3 +%% sub_cache_nodes/3 +%% +%% Manages the substitutions record. + +%% Builds a new sub. +-spec sub_new(term()) -> sub(). +sub_new(Temp) -> + #sub{t=Temp}. + +%% Folds the sub into a new one if the variables in nodes are not disjoint +sub_fold(VarNames, #sub{v=SubNames}=Sub) -> + case is_disjoint_variables(VarNames, SubNames) of + true -> Sub#sub{t={temp,Sub#sub.t}}; + false -> sub_new({sub,Sub}) + end. + +%% Unfolds the sub in case one was folded in the previous step +sub_unfold(#sub{t={temp,Temp}}=Sub) -> + Sub#sub{t=Temp}; +sub_unfold(#sub{t={sub,Sub}}) -> + Sub. + +%% Adds the keys extracted from patterns to the state. +-spec sub_add_keys([term()], sub()) -> sub(). +sub_add_keys(Keys, #sub{p=Pat0}=Sub) -> + Pat1 = + lists:foldl(fun(Key, Acc) -> + false = maps:is_key(Key, Acc), %Assertion. + maps:put(Key, ?NOTSET, Acc) + end, Pat0, Keys), + Sub#sub{p=Pat1}. + +%% Take the keys from the map taking into account the keys +%% that have changed as those must become aliases in the pattern. +-spec sub_take_keys([term()], sub()) -> {sub(), [{term(), atom()}]}. +sub_take_keys(Keys, #sub{p=Pat0}=Sub) -> + {Pat1,Acc} = sub_take_keys(Keys, Pat0, []), + {Sub#sub{p=Pat1},Acc}. + +sub_take_keys([K|T], Sub0, Acc) -> + case maps:take(K, Sub0) of + {?NOTSET,Sub1} -> + sub_take_keys(T, Sub1, Acc); + {Name,Sub1} -> + sub_take_keys(T, Sub1, [{K,Name}|Acc]) + end; +sub_take_keys([], Sub, Acc) -> + {Sub,Acc}. + +%% Check if the node can be cached based on the state information. +%% If it can be cached and it does not have an alias for it, we +%% build one. +-spec sub_cache_nodes(atom(), [cerl:cerl()], sub()) -> {atom(), sub()} | error. +sub_cache_nodes(Kind, Nodes, #sub{p=Pat}=Sub) -> + case nodes_to_key(Kind, Nodes) of + {ok, Key} -> + case Pat of + #{Key := ?NOTSET} -> + new_var_name(Key, Sub); + #{Key := Name} -> + {Name,Sub}; + #{} -> + error + end; + error -> + error + end. + +new_var_name(Key, #sub{p=Pat}=Sub) -> + Counter = get(new_var_num), + Name = list_to_atom("@r" ++ integer_to_list(Counter)), + put(new_var_num, Counter + 1), + {Name,Sub#sub{p=maps:put(Key, Name, Pat)}}. + +%% get_variables/1 +%% is_disjoint_variables/2 +%% merge_variables/2 + +get_variables(NodesList) -> + cerl_sets:from_list([Var || Node <- NodesList, Var <- cerl_trees:variables(Node)]). + +is_disjoint_variables(Vars1, Vars2) -> + cerl_sets:is_disjoint(Vars1, Vars2). + +merge_variables(Vars1, Vars2) -> + cerl_sets:union(Vars1, Vars2). + +%% get_pattern_keys/2 +%% put_pattern_keys/2 +%% +%% Gets keys from patterns or add them as aliases. + +get_pattern_keys(Patterns) -> + lists:foldl(fun get_pattern_keys/2, [], Patterns). + +get_pattern_keys(#c_tuple{es=Es}, Acc0) -> + Acc1 = accumulate_pattern_keys(tuple, Es, Acc0), + lists:foldl(fun get_pattern_keys/2, Acc1, Es); +get_pattern_keys(#c_cons{hd=Hd,tl=Tl}, Acc0) -> + Acc1 = accumulate_pattern_keys(cons, [Hd, Tl], Acc0), + get_pattern_keys(Tl, get_pattern_keys(Hd, Acc1)); +get_pattern_keys(#c_alias{pat=Pat}, Acc0) -> + get_pattern_keys(Pat, Acc0); +get_pattern_keys(#c_map{es=Es}, Acc0) -> + lists:foldl(fun get_pattern_keys/2, Acc0, Es); +get_pattern_keys(#c_map_pair{val=Val}, Acc0) -> + get_pattern_keys(Val, Acc0); +get_pattern_keys(_, Acc) -> + Acc. + +accumulate_pattern_keys(Kind, Nodes, Acc) -> + case nodes_to_key(Kind, Nodes) of + {ok,Key} -> [Key|Acc]; + error -> Acc + end. + +put_pattern_keys(Patterns, []) -> + Patterns; +put_pattern_keys(Patterns, Keys) -> + {NewPatterns,Map} = + lists:mapfoldl(fun alias_pattern_keys/2, maps:from_list(Keys), Patterns), + %% Check all aliases have been consumed from the map. + 0 = map_size(Map), + NewPatterns. + +alias_pattern_keys(#c_tuple{anno=Anno,es=Es0}=Node, Acc0) -> + {Es1,Acc1} = lists:mapfoldl(fun alias_pattern_keys/2, Acc0, Es0), + nodes_to_alias(tuple, Es0, Anno, Node#c_tuple{es=Es1}, Acc1); +alias_pattern_keys(#c_cons{anno=Anno,hd=Hd0,tl=Tl0}=Node, Acc0) -> + {Hd1,Acc1} = alias_pattern_keys(Hd0, Acc0), + {Tl1,Acc2} = alias_pattern_keys(Tl0, Acc1), + nodes_to_alias(cons, [Hd0, Tl0], Anno, Node#c_cons{hd=Hd1,tl=Tl1}, Acc2); +alias_pattern_keys(#c_alias{pat=Pat0}=Node, Acc0) -> + {Pat1,Acc1} = alias_pattern_keys(Pat0, Acc0), + {Node#c_alias{pat=Pat1}, Acc1}; +alias_pattern_keys(#c_map{es=Es0}=Node, Acc0) -> + {Es1,Acc1} = lists:mapfoldl(fun alias_pattern_keys/2, Acc0, Es0), + {Node#c_map{es=Es1}, Acc1}; +alias_pattern_keys(#c_map_pair{val=Val0}=Node, Acc0) -> + {Val1,Acc1} = alias_pattern_keys(Val0, Acc0), + {Node#c_map_pair{val=Val1}, Acc1}; +alias_pattern_keys(Pattern, Acc) -> + {Pattern,Acc}. + +%% Check if a node must become an alias because +%% its pattern was used later on as an expression. +nodes_to_alias(Kind, Inner, Anno, Node, Keys0) -> + case nodes_to_key(Kind, Inner) of + {ok,Key} -> + case maps:take(Key, Keys0) of + {Name,Keys1} -> + Var = cerl:ann_c_var(Anno, Name), + {cerl:ann_c_alias(Anno, Var, Node), Keys1}; + error -> + {Node,Keys0} + end; + error -> + {Node,Keys0} + end. + +%% Builds the key used to check if a value can be +%% replaced by an alias. It considers literals, +%% aliases, variables, tuples and cons recursively. +nodes_to_key(Kind, Nodes) -> + nodes_to_key(Nodes, [], Kind). + +nodes_to_key([#c_alias{var=Var}|T], Acc, Kind) -> + nodes_to_key([Var|T], Acc, Kind); +nodes_to_key([#c_var{name=Name}|T], Acc, Kind) -> + nodes_to_key(T, [[var,Name]|Acc], Kind); +nodes_to_key([Node|T], Acc0, Kind) -> + case cerl:is_data(Node) of + false -> + error; + true -> + case nodes_to_key(cerl:data_es(Node), [], cerl:data_type(Node)) of + {ok,Key} -> + nodes_to_key(T, [Key|Acc0], Kind); + error -> + error + end + end; +nodes_to_key([], Acc, Kind) -> + {ok,[Kind|Acc]}. diff --git a/lib/compiler/src/sys_core_bsm.erl b/lib/compiler/src/sys_core_bsm.erl index 3e04cc33df..37e071fafa 100644 --- a/lib/compiler/src/sys_core_bsm.erl +++ b/lib/compiler/src/sys_core_bsm.erl @@ -44,8 +44,7 @@ function([{#c_var{name={F,Arity}}=Name,B0}|Fs], FsAcc, Ws0) -> {B,Ws} -> function(Fs, [{Name,B}|FsAcc], Ws) catch - Class:Error -> - Stack = erlang:get_stacktrace(), + Class:Error:Stack -> io:fwrite("Function: ~w/~w\n", [F,Arity]), erlang:raise(Class, Error, Stack) end; diff --git a/lib/compiler/src/sys_core_dsetel.erl b/lib/compiler/src/sys_core_dsetel.erl index bd3eeae238..9e2df69b33 100644 --- a/lib/compiler/src/sys_core_dsetel.erl +++ b/lib/compiler/src/sys_core_dsetel.erl @@ -81,8 +81,7 @@ visit_module_1([{Name,F0}|Fs], Env, Acc) -> {F,_} -> visit_module_1(Fs, Env, [{Name,F}|Acc]) catch - Class:Error -> - Stack = erlang:get_stacktrace(), + Class:Error:Stack -> #c_var{name={Func,Arity}} = Name, io:fwrite("Function: ~w/~w\n", [Func,Arity]), erlang:raise(Class, Error, Stack) diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index d73060fb7e..e28d48acf5 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -125,8 +125,7 @@ function_1({#c_var{name={F,Arity}}=Name,B0}) -> end, B0, 20), {Name,B} catch - Class:Error -> - Stack = erlang:get_stacktrace(), + Class:Error:Stack -> io:fwrite("Function: ~w/~w\n", [F,Arity]), erlang:raise(Class, Error, Stack) end. @@ -415,9 +414,20 @@ expr(#c_call{module=M0,name=N0}=Call0, Ctxt, Sub) -> no -> call(Call, M1, N1, Sub); {yes,Seq} -> expr(Seq, Ctxt, Sub) end; +expr(#c_primop{name=#c_literal{val=build_stacktrace}}, effect, _Sub) -> + void(); expr(#c_primop{args=As0}=Prim, _, Sub) -> As1 = expr_list(As0, value, Sub), Prim#c_primop{args=As1}; +expr(#c_catch{anno=Anno,body=B}, effect, Sub) -> + %% When the return value of the 'catch' is ignored, we can replace it + %% with a try/catch to avoid building a stack trace when an exception + %% occurs. + Var = #c_var{name='catch_value'}, + Evs = [#c_var{name='Class'},#c_var{name='Reason'},#c_var{name='Stk'}], + Try = #c_try{anno=Anno,arg=B,vars=[Var],body=Var, + evars=Evs,handler=void()}, + expr(Try, effect, Sub); expr(#c_catch{body=B0}=Catch, _, Sub) -> %% We can remove catch if the value is simple B1 = body(B0, value, Sub), @@ -2422,16 +2432,10 @@ move_let_into_expr(#c_let{vars=InnerVs0,body=InnerBody0}=Inner, Outer#c_let{vars=OuterVs,arg=Arg, body=Inner#c_let{vars=InnerVs,arg=OuterBody,body=InnerBody}}; move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let, - #c_case{arg=Cexpr0,clauses=[Ca0,Cb0|Cs]}=Case, Sub0) -> - %% Test if there are no more clauses than Ca0 and Cb0, or if - %% Cb0 is guaranteed to match. - TwoClauses = Cs =:= [] orelse - case Cb0 of - #c_clause{pats=[#c_var{}],guard=#c_literal{val=true}} -> true; - _ -> false - end, - case {TwoClauses,is_failing_clause(Ca0),is_failing_clause(Cb0)} of - {true,false,true} -> + #c_case{arg=Cexpr0,clauses=[Ca0|Cs0]}=Case, Sub0) -> + case not is_failing_clause(Ca0) andalso + are_all_failing_clauses(Cs0) of + true -> %% let <Lvars> = case <Case-expr> of %% <Cpats> -> <Clause-body>; %% <OtherCpats> -> erlang:error(...) @@ -2467,8 +2471,8 @@ move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let, body=Lbody}, Ca = Ca0#c_clause{pats=CaPats,guard=G,body=B}, - Cb = clause(Cb0, Cexpr, value, Sub0), - Case#c_case{arg=Cexpr,clauses=[Ca,Cb]} + Cs = [clause(C, Cexpr, value, Sub0) || C <- Cs0], + Case#c_case{arg=Cexpr,clauses=[Ca|Cs]} catch nomatch -> %% This is not a defeat. The code will eventually @@ -2476,7 +2480,7 @@ move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let, %% optimizations done in this module. impossible end; - {_,_,_} -> impossible + false -> impossible end; move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let, #c_seq{arg=Sarg0,body=Sbody0}=Seq, Sub0) -> @@ -2499,6 +2503,9 @@ move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let, body=Lbody}}; move_let_into_expr(_Let, _Expr, _Sub) -> impossible. +are_all_failing_clauses(Cs) -> + all(fun is_failing_clause/1, Cs). + is_failing_clause(#c_clause{body=B}) -> will_fail(B). @@ -2616,9 +2623,13 @@ delay_build_expr_1(#c_receive{clauses=Cs0, timeout=Timeout, action=A0}=Rec, TypeSig) -> Cs = delay_build_cs(Cs0, TypeSig), - A = case Timeout of - #c_literal{val=infinity} -> A0; - _ -> delay_build_expr(A0, TypeSig) + A = case {Timeout,A0} of + {#c_literal{val=infinity},#c_literal{}} -> + {_Type,Arity} = TypeSig, + Es = lists:duplicate(Arity, A0), + core_lib:make_values(Es); + _ -> + delay_build_expr(A0, TypeSig) end, Rec#c_receive{clauses=Cs,action=A}; delay_build_expr_1(#c_seq{body=B0}=Seq, TypeSig) -> diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 47c1567f10..8189420c1c 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -19,25 +19,6 @@ %% %% Purpose : Code generator for Beam. -%% The following assumptions have been made: -%% -%% 1. Matches, i.e. things with {match,M,Ret} wrappers, only return -%% values; no variables are exported. If the match would have returned -%% extra variables then these have been transformed to multiple return -%% values. -%% -%% 2. All BIF's called in guards are gc-safe so there is no need to -%% put thing on the stack in the guard. While this would in principle -%% work it would be difficult to keep track of the stack depth when -%% trimming. -%% -%% The code generation uses variable lifetime information added by -%% the v3_life module to save variables, allocate registers and -%% move registers to the stack when necessary. -%% -%% We try to use a consistent variable name scheme throughout. The -%% StackReg record is always called Bef,Int<n>,Aft. - -module(v3_codegen). %% The main interface. @@ -45,12 +26,14 @@ -import(lists, [member/2,keymember/3,keysort/2,keydelete/3, append/1,flatmap/2,filter/2,foldl/3,foldr/3,mapfoldl/3, - sort/1,reverse/1,reverse/2]). --import(v3_life, [vdb_find/2]). + sort/1,reverse/1,reverse/2,map/2]). +-import(ordsets, [add_element/2,intersection/2,union/2]). -%%-compile([export_all]). +-include("v3_kernel.hrl"). --include("v3_life.hrl"). +%% These are not defined in v3_kernel.hrl. +get_kanno(Kthing) -> element(2, Kthing). +set_kanno(Kthing, Anno) -> setelement(2, Kthing, Anno). %% Main codegen structure. -record(cg, {lcount=1, %Label counter @@ -61,38 +44,376 @@ functable=#{}, %Map of local functions: {Name,Arity}=>Label in_catch=false, %Inside a catch or not. need_frame, %Need a stack frame. - ultimate_failure %Label for ultimate match failure. - }). + ultimate_failure, %Label for ultimate match failure. + ctx %Match context. + }). %% Stack/register state record. -record(sr, {reg=[], %Register table stk=[], %Stack table - res=[]}). %Reserved regs: [{reserved,I,V}] + res=[]}). %Registers to reserve + +%% Internal records. +-record(cg_need_heap, {anno=[] :: term(), + h=0 :: integer()}). +-record(cg_block, {anno=[] :: term(), + es=[] :: [term()]}). + +-type vdb_entry() :: {atom(),non_neg_integer(),non_neg_integer()}. --type life_module() :: {module(),_,_,[_]}. +-record(l, {i=0 :: non_neg_integer(), %Op number + vdb=[] :: [vdb_entry()], %Variable database + a=[] :: [term()]}). %Core annotation --spec module(life_module(), [compile:option()]) -> {'ok',beam_asm:module_code()}. +-spec module(#k_mdef{}, [compile:option()]) -> {'ok',beam_asm:module_code()}. -module({Mod,Exp,Attr,Forms}, _Options) -> - {Fs,St} = functions(Forms, {atom,Mod}), - {ok,{Mod,Exp,Attr,Fs,St#cg.lcount}}. +module(#k_mdef{name=Mod,exports=Es,attributes=Attr,body=Forms}, _Opts) -> + {Asm,St} = functions(Forms, {atom,Mod}), + {ok,{Mod,Es,Attr,Asm,St#cg.lcount}}. functions(Forms, AtomMod) -> mapfoldl(fun (F, St) -> function(F, AtomMod, St) end, #cg{lcount=1}, Forms). -function({function,Name,Arity,Asm0,Vb,Vdb,Anno}, AtomMod, St0) -> +function(#k_fdef{anno=#k{a=Anno},func=Name,arity=Arity, + vars=As,body=Kb}, AtomMod, St0) -> try - {Asm,EntryLabel,St} = cg_fun(Vb, Asm0, Vdb, AtomMod, - {Name,Arity}, Anno, St0), - Func = {function,Name,Arity,EntryLabel,Asm}, - {Func,St} + #k_match{} = Kb, %Assertion. + + %% Try to suppress the stack frame unless it is + %% really needed. + Body0 = avoid_stack_frame(Kb), + + %% Annotate kernel records with variable usage. + Vdb0 = init_vars(As), + {Body,_,Vdb} = body(Body0, 1, Vdb0), + + %% Generate the BEAM assembly code. + {Asm,EntryLabel,St} = cg_fun(Body, As, Vdb, AtomMod, + {Name,Arity}, Anno, St0), + Func = {function,Name,Arity,EntryLabel,Asm}, + {Func,St} + catch + Class:Error:Stack -> + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + + +%% avoid_stack_frame(Kernel) -> Kernel' +%% If possible, avoid setting up a stack frame. Functions +%% that only do matching, calls to guard BIFs, and tail-recursive +%% calls don't need a stack frame. + +avoid_stack_frame(#k_match{body=Body}=M) -> + try + M#k_match{body=avoid_stack_frame_1(Body)} catch - Class:Error -> - Stack = erlang:get_stacktrace(), - io:fwrite("Function: ~w/~w\n", [Name,Arity]), - erlang:raise(Class, Error, Stack) + impossible -> + M end. +avoid_stack_frame_1(#k_alt{first=First0,then=Then0}=Alt) -> + First = avoid_stack_frame_1(First0), + Then = avoid_stack_frame_1(Then0), + Alt#k_alt{first=First,then=Then}; +avoid_stack_frame_1(#k_bif{op=Op}=Bif) -> + case Op of + #k_internal{} -> + %% Most internal BIFs clobber the X registers. + throw(impossible); + _ -> + Bif + end; +avoid_stack_frame_1(#k_break{anno=Anno,args=Args}) -> + #k_guard_break{anno=Anno,args=Args}; +avoid_stack_frame_1(#k_guard_break{}=Break) -> + Break; +avoid_stack_frame_1(#k_enter{}=Enter) -> + %% Tail-recursive calls don't need a stack frame. + Enter; +avoid_stack_frame_1(#k_guard{clauses=Cs0}=Guard) -> + Cs = avoid_stack_frame_list(Cs0), + Guard#k_guard{clauses=Cs}; +avoid_stack_frame_1(#k_guard_clause{guard=G0,body=B0}=C) -> + G = avoid_stack_frame_1(G0), + B = avoid_stack_frame_1(B0), + C#k_guard_clause{guard=G,body=B}; +avoid_stack_frame_1(#k_match{anno=A,vars=Vs,body=B0,ret=Ret}) -> + %% Use #k_guard_match{} instead to avoid saving the X registers + %% to the stack before matching. + B = avoid_stack_frame_1(B0), + #k_guard_match{anno=A,vars=Vs,body=B,ret=Ret}; +avoid_stack_frame_1(#k_guard_match{body=B0}=M) -> + B = avoid_stack_frame_1(B0), + M#k_guard_match{body=B}; +avoid_stack_frame_1(#k_protected{arg=Arg0}=Prot) -> + Arg = avoid_stack_frame_1(Arg0), + Prot#k_protected{arg=Arg}; +avoid_stack_frame_1(#k_put{}=Put) -> + Put; +avoid_stack_frame_1(#k_return{}=Ret) -> + Ret; +avoid_stack_frame_1(#k_select{var=#k_var{anno=Vanno},types=Types0}=Select) -> + case member(reuse_for_context, Vanno) of + false -> + Types = avoid_stack_frame_list(Types0), + Select#k_select{types=Types}; + true -> + %% Including binary patterns that overwrite the register containing + %% the binary with the match context may not be safe. For example, + %% bs_match_SUITE:bin_tail_e/1 with inlining will be rejected by + %% beam_validator. + %% + %% Essentially the following code is produced: + %% + %% bs_match {x,0} => {x,0} + %% ... + %% bs_match {x,0} => {x,1} %% ILLEGAL + %% + %% A bs_match instruction will only accept a match context as the + %% source operand if the source and destination registers are the + %% the same (as in the first bs_match instruction above). + %% The second bs_match instruction is therefore illegal. + %% + %% This situation is avoided if there is a stack frame: + %% + %% move {x,0} => {y,0} + %% bs_match {x,0} => {x,0} + %% ... + %% bs_match {y,0} => {x,1} %% LEGAL + %% + throw(impossible) + end; +avoid_stack_frame_1(#k_seq{arg=A0,body=B0}=Seq) -> + A = avoid_stack_frame_1(A0), + B = avoid_stack_frame_1(B0), + Seq#k_seq{arg=A,body=B}; +avoid_stack_frame_1(#k_test{}=Test) -> + Test; +avoid_stack_frame_1(#k_type_clause{values=Values0}=TC) -> + Values = avoid_stack_frame_list(Values0), + TC#k_type_clause{values=Values}; +avoid_stack_frame_1(#k_val_clause{body=B0}=VC) -> + B = avoid_stack_frame_1(B0), + VC#k_val_clause{body=B}; +avoid_stack_frame_1(_Body) -> + throw(impossible). + +avoid_stack_frame_list([H|T]) -> + [avoid_stack_frame_1(H)|avoid_stack_frame_list(T)]; +avoid_stack_frame_list([]) -> []. + + +%% This pass creates beam format annotated with variable lifetime +%% information. Each thing is given an index and for each variable we +%% store the first and last index for its occurrence. The variable +%% database, VDB, attached to each thing is only relevant internally +%% for that thing. +%% +%% For nested things like matches the numbering continues locally and +%% the VDB for that thing refers to the variable usage within that +%% thing. Variables which live through a such a thing are internally +%% given a very large last index. Internally the indexes continue +%% after the index of that thing. This creates no problems as the +%% internal variable info never escapes and externally we only see +%% variable which are alive both before or after. +%% +%% This means that variables never "escape" from a thing and the only +%% way to get values from a thing is to "return" them, with 'break' or +%% 'return'. Externally these values become the return values of the +%% thing. This is no real limitation as most nested things have +%% multiple threads so working out a common best variable usage is +%% difficult. + +%% body(Kbody, I, Vdb) -> {[Expr],MaxI,Vdb}. +%% Handle a body. + +body(#k_seq{arg=Ke,body=Kb}, I, Vdb0) -> + %%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]), + A = get_kanno(Ke), + Vdb1 = use_vars(union(A#k.us, A#k.ns), I, Vdb0), + {Es,MaxI,Vdb2} = body(Kb, I+1, Vdb1), + E = expr(Ke, I, Vdb2), + {[E|Es],MaxI,Vdb2}; +body(Ke, I, Vdb0) -> + %%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]), + A = get_kanno(Ke), + Vdb1 = use_vars(union(A#k.us, A#k.ns), I, Vdb0), + E = expr(Ke, I, Vdb1), + {[E],I,Vdb1}. + +%% expr(Kexpr, I, Vdb) -> Expr. + +expr(#k_test{anno=A}=Test, I, _Vdb) -> + Test#k_test{anno=#l{i=I,a=A#k.a}}; +expr(#k_call{anno=A}=Call, I, _Vdb) -> + Call#k_call{anno=#l{i=I,a=A#k.a}}; +expr(#k_enter{anno=A}=Enter, I, _Vdb) -> + Enter#k_enter{anno=#l{i=I,a=A#k.a}}; +expr(#k_bif{anno=A}=Bif, I, _Vdb) -> + Bif#k_bif{anno=#l{i=I,a=A#k.a}}; +expr(#k_match{anno=A,body=Kb,ret=Rs}, I, Vdb) -> + %% Work out imported variables which need to be locked. + Mdb = vdb_sub(I, I+1, Vdb), + M = match(Kb, A#k.us, I+1, Mdb), + L = #l{i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a}, + #k_match{anno=L,body=M,ret=Rs}; +expr(#k_guard_match{anno=A,body=Kb,ret=Rs}, I, Vdb) -> + %% Work out imported variables which need to be locked. + Mdb = vdb_sub(I, I+1, Vdb), + M = match(Kb, A#k.us, I+1, Mdb), + L = #l{i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a}, + #k_guard_match{anno=L,body=M,ret=Rs}; +expr(#k_protected{}=Protected, I, Vdb) -> + protected(Protected, I, Vdb); +expr(#k_try{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh}=Try, I, Vdb) -> + %% Lock variables that are alive before the catch and used afterwards. + %% Don't lock variables that are only used inside the try. + Tdb0 = vdb_sub(I, I+1, Vdb), + %% This is the tricky bit. Lock variables in Arg that are used in + %% the body and handler. Add try tag 'variable'. + Ab = get_kanno(Kb), + Ah = get_kanno(Kh), + Tdb1 = use_vars(union(Ab#k.us, Ah#k.us), I+3, Tdb0), + Tdb2 = vdb_sub(I, I+2, Tdb1), + Vnames = fun (Kvar) -> Kvar#k_var.name end, %Get the variable names + {Aes,_,Adb} = body(Ka, I+2, add_var({catch_tag,I+1}, I+1, locked, Tdb2)), + {Bes,_,Bdb} = body(Kb, I+4, new_vars(sort(map(Vnames, Vs)), I+3, Tdb2)), + {Hes,_,Hdb} = body(Kh, I+4, new_vars(sort(map(Vnames, Evs)), I+3, Tdb2)), + L = #l{i=I,vdb=Tdb1,a=A#k.a}, + Try#k_try{anno=L, + arg=#cg_block{es=Aes,anno=#l{i=I+1,vdb=Adb,a=[]}}, + vars=Vs,body=#cg_block{es=Bes,anno=#l{i=I+3,vdb=Bdb,a=[]}}, + evars=Evs,handler=#cg_block{es=Hes,anno=#l{i=I+3,vdb=Hdb,a=[]}}}; +expr(#k_try_enter{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh}, I, Vdb) -> + %% Lock variables that are alive before the catch and used afterwards. + %% Don't lock variables that are only used inside the try. + Tdb0 = vdb_sub(I, I+1, Vdb), + %% This is the tricky bit. Lock variables in Arg that are used in + %% the body and handler. Add try tag 'variable'. + Ab = get_kanno(Kb), + Ah = get_kanno(Kh), + Tdb1 = use_vars(union(Ab#k.us, Ah#k.us), I+3, Tdb0), + Tdb2 = vdb_sub(I, I+2, Tdb1), + Vnames = fun (Kvar) -> Kvar#k_var.name end, %Get the variable names + {Aes,_,Adb} = body(Ka, I+2, add_var({catch_tag,I+1}, I+1, 1000000, Tdb2)), + {Bes,_,Bdb} = body(Kb, I+4, new_vars(sort(map(Vnames, Vs)), I+3, Tdb2)), + {Hes,_,Hdb} = body(Kh, I+4, new_vars(sort(map(Vnames, Evs)), I+3, Tdb2)), + L = #l{i=I,vdb=Tdb1,a=A#k.a}, + #k_try_enter{anno=L, + arg=#cg_block{es=Aes,anno=#l{i=I+1,vdb=Adb,a=[]}}, + vars=Vs,body=#cg_block{es=Bes,anno=#l{i=I+3,vdb=Bdb,a=[]}}, + evars=Evs,handler=#cg_block{es=Hes,anno=#l{i=I+3,vdb=Hdb,a=[]}}}; +expr(#k_catch{anno=A,body=Kb}=Catch, I, Vdb) -> + %% Lock variables that are alive before the catch and used afterwards. + %% Don't lock variables that are only used inside the catch. + %% Add catch tag 'variable'. + Cdb0 = vdb_sub(I, I+1, Vdb), + {Es,_,Cdb1} = body(Kb, I+1, add_var({catch_tag,I}, I, locked, Cdb0)), + L = #l{i=I,vdb=Cdb1,a=A#k.a}, + Catch#k_catch{anno=L,body=#cg_block{es=Es}}; +expr(#k_receive{anno=A,var=V,body=Kb,action=Ka}=Recv, I, Vdb) -> + %% Work out imported variables which need to be locked. + Rdb = vdb_sub(I, I+1, Vdb), + M = match(Kb, add_element(V#k_var.name, A#k.us), I+1, + new_vars([V#k_var.name], I, Rdb)), + {Tes,_,Adb} = body(Ka, I+1, Rdb), + Le = #l{i=I,vdb=use_vars(A#k.us, I+1, Vdb),a=A#k.a}, + Recv#k_receive{anno=Le,body=M, + action=#cg_block{anno=#l{i=I+1,vdb=Adb,a=[]},es=Tes}}; +expr(#k_receive_accept{anno=A}, I, _Vdb) -> + #k_receive_accept{anno=#l{i=I,a=A#k.a}}; +expr(#k_receive_next{anno=A}, I, _Vdb) -> + #k_receive_next{anno=#l{i=I,a=A#k.a}}; +expr(#k_put{anno=A}=Put, I, _Vdb) -> + Put#k_put{anno=#l{i=I,a=A#k.a}}; +expr(#k_break{anno=A}=Break, I, _Vdb) -> + Break#k_break{anno=#l{i=I,a=A#k.a}}; +expr(#k_guard_break{anno=A}=Break, I, _Vdb) -> + Break#k_guard_break{anno=#l{i=I,a=A#k.a}}; +expr(#k_return{anno=A}=Ret, I, _Vdb) -> + Ret#k_return{anno=#l{i=I,a=A#k.a}}. + +%% protected(Kprotected, I, Vdb) -> Protected. +%% Only used in guards. + +protected(#k_protected{anno=A,arg=Ts}=Prot, I, Vdb) -> + %% Lock variables that are alive before try and used afterwards. + %% Don't lock variables that are only used inside the protected + %% expression. + Pdb0 = vdb_sub(I, I+1, Vdb), + {T,MaxI,Pdb1} = body(Ts, I+1, Pdb0), + Pdb2 = use_vars(A#k.ns, MaxI+1, Pdb1), %Save "return" values + Prot#k_protected{arg=T,anno=#l{i=I,a=A#k.a,vdb=Pdb2}}. + +%% match(Kexpr, [LockVar], I, Vdb) -> Expr. +%% Convert match tree to old format. + +match(#k_alt{anno=A,first=Kf,then=Kt}, Ls, I, Vdb0) -> + Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0), + F = match(Kf, Ls, I+1, Vdb1), + T = match(Kt, Ls, I+1, Vdb1), + #k_alt{anno=[],first=F,then=T}; +match(#k_select{anno=A,types=Kts}=Select, Ls, I, Vdb0) -> + Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0), + Ts = [type_clause(Tc, Ls, I+1, Vdb1) || Tc <- Kts], + Select#k_select{anno=[],types=Ts}; +match(#k_guard{anno=A,clauses=Kcs}, Ls, I, Vdb0) -> + Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0), + Cs = [guard_clause(G, Ls, I+1, Vdb1) || G <- Kcs], + #k_guard{anno=[],clauses=Cs}; +match(Other, Ls, I, Vdb0) -> + Vdb1 = use_vars(Ls, I, Vdb0), + {B,_,Vdb2} = body(Other, I+1, Vdb1), + Le = #l{i=I,vdb=Vdb2,a=[]}, + #cg_block{anno=Le,es=B}. + +type_clause(#k_type_clause{anno=A,type=T,values=Kvs}, Ls, I, Vdb0) -> + %%ok = io:format("life ~w: ~p~n", [?LINE,{T,Kvs}]), + Vdb1 = use_vars(union(A#k.us, Ls), I+1, Vdb0), + Vs = [val_clause(Vc, Ls, I+1, Vdb1) || Vc <- Kvs], + #k_type_clause{anno=[],type=T,values=Vs}. + +val_clause(#k_val_clause{anno=A,val=V,body=Kb}, Ls0, I, Vdb0) -> + New = (get_kanno(V))#k.ns, + Bus = (get_kanno(Kb))#k.us, + %%ok = io:format("Ls0 = ~p, Used=~p\n New=~p, Bus=~p\n", [Ls0,Used,New,Bus]), + Ls1 = union(intersection(New, Bus), Ls0), %Lock for safety + Vdb1 = use_vars(union(A#k.us, Ls1), I+1, new_vars(New, I, Vdb0)), + B = match(Kb, Ls1, I+1, Vdb1), + Le = #l{i=I,vdb=use_vars(Bus, I+1, Vdb1),a=A#k.a}, + #k_val_clause{anno=Le,val=V,body=B}. + +guard_clause(#k_guard_clause{anno=A,guard=Kg,body=Kb}, Ls, I, Vdb0) -> + Vdb1 = use_vars(union(A#k.us, Ls), I+2, Vdb0), + Gdb = vdb_sub(I+1, I+2, Vdb1), + G = protected(Kg, I+1, Gdb), + B = match(Kb, Ls, I+2, Vdb1), + Le = #l{i=I,vdb=use_vars((get_kanno(Kg))#k.us, I+2, Vdb1),a=A#k.a}, + #k_guard_clause{anno=Le,guard=G,body=B}. + + +%% Here follows the code generator pass. +%% +%% The following assumptions have been made: +%% +%% 1. Matches, i.e. things with {match,M,Ret} wrappers, only return +%% values; no variables are exported. If the match would have returned +%% extra variables then these have been transformed to multiple return +%% values. +%% +%% 2. All BIF's called in guards are gc-safe so there is no need to +%% put thing on the stack in the guard. While this would in principle +%% work it would be difficult to keep track of the stack depth when +%% trimming. +%% +%% The code generation uses variable lifetime information added by +%% the previous pass to save variables, allocate registers and +%% move registers to the stack when necessary. +%% +%% We try to use a consistent variable name scheme throughout. The +%% StackReg record is always called Bef,Int<n>,Aft. + %% cg_fun([Lkexpr], [HeadVar], Vdb, State) -> {[Ainstr],State} cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, Anno, St0) -> @@ -114,14 +435,14 @@ cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, Anno, St0) -> %% Note that and 'if_end' instruction does not need any %% live x registers, so it will always be safe to jump to %% it. (We never ever expect the jump to be taken, and in - %% must functions there will never be any references to + %% most functions there will never be any references to %% the label in the first place.) %% {UltimateMatchFail,St3} = new_label(St2), %% Create initial stack/register state, clear unused arguments. - Bef = clear_dead(#sr{reg=foldl(fun ({var,V}, Reg) -> + Bef = clear_dead(#sr{reg=foldl(fun (#k_var{name=V}, Reg) -> put_reg(V, Reg) end, [], Hvs), stk=[]}, 0, Vdb), @@ -136,45 +457,43 @@ cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, Anno, St0) -> %% cg(Lkexpr, Vdb, StackReg, State) -> {[Ainstr],StackReg,State}. %% Generate code for a kexpr. -%% Split function into two steps for clarity, not efficiency. -cg(Le, Vdb, Bef, St) -> - cg(Le#l.ke, Le, Vdb, Bef, St). - -cg({block,Es}, Le, Vdb, Bef, St) -> +cg(#cg_block{anno=Le,es=Es}, Vdb, Bef, St) -> block_cg(Es, Le, Vdb, Bef, St); -cg({match,M,Rs}, Le, Vdb, Bef, St) -> +cg(#k_match{anno=Le,body=M,ret=Rs}, Vdb, Bef, St) -> match_cg(M, Rs, Le, Vdb, Bef, St); -cg({guard_match,M,Rs}, Le, Vdb, Bef, St) -> +cg(#k_guard_match{anno=Le,body=M,ret=Rs}, Vdb, Bef, St) -> guard_match_cg(M, Rs, Le, Vdb, Bef, St); -cg({call,Func,As,Rs}, Le, Vdb, Bef, St) -> +cg(#k_call{anno=Le,op=Func,args=As,ret=Rs}, Vdb, Bef, St) -> call_cg(Func, As, Rs, Le, Vdb, Bef, St); -cg({enter,Func,As}, Le, Vdb, Bef, St) -> +cg(#k_enter{anno=Le,op=Func,args=As}, Vdb, Bef, St) -> enter_cg(Func, As, Le, Vdb, Bef, St); -cg({bif,Bif,As,Rs}, Le, Vdb, Bef, St) -> - bif_cg(Bif, As, Rs, Le, Vdb, Bef, St); -cg({gc_bif,Bif,As,Rs}, Le, Vdb, Bef, St) -> - gc_bif_cg(Bif, As, Rs, Le, Vdb, Bef, St); -cg({internal,Bif,As,Rs}, Le, Vdb, Bef, St) -> - internal_cg(Bif, As, Rs, Le, Vdb, Bef, St); -cg({receive_loop,Te,Rvar,Rm,Tes,Rs}, Le, Vdb, Bef, St) -> +cg(#k_bif{anno=Le}=Bif, Vdb, Bef, St) -> + bif_cg(Bif, Le, Vdb, Bef, St); +cg(#k_receive{anno=Le,timeout=Te,var=Rvar,body=Rm,action=Tes,ret=Rs}, + Vdb, Bef, St) -> recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, Vdb, Bef, St); -cg(receive_next, Le, Vdb, Bef, St) -> +cg(#k_receive_next{anno=Le}, Vdb, Bef, St) -> recv_next_cg(Le, Vdb, Bef, St); -cg(receive_accept, _Le, _Vdb, Bef, St) -> {[remove_message],Bef,St}; -cg({'try',Ta,Vs,Tb,Evs,Th,Rs}, Le, Vdb, Bef, St) -> +cg(#k_receive_accept{}, _Vdb, Bef, St) -> + {[remove_message],Bef,St}; +cg(#k_try{anno=Le,arg=Ta,vars=Vs,body=Tb,evars=Evs,handler=Th,ret=Rs}, + Vdb, Bef, St) -> try_cg(Ta, Vs, Tb, Evs, Th, Rs, Le, Vdb, Bef, St); -cg({try_enter,Ta,Vs,Tb,Evs,Th}, Le, Vdb, Bef, St) -> +cg(#k_try_enter{anno=Le,arg=Ta,vars=Vs,body=Tb,evars=Evs,handler=Th}, + Vdb, Bef, St) -> try_enter_cg(Ta, Vs, Tb, Evs, Th, Le, Vdb, Bef, St); -cg({'catch',Cb,R}, Le, Vdb, Bef, St) -> +cg(#k_catch{anno=Le,body=Cb,ret=[R]}, Vdb, Bef, St) -> catch_cg(Cb, R, Le, Vdb, Bef, St); -cg({set,Var,Con}, Le, Vdb, Bef, St) -> - set_cg(Var, Con, Le, Vdb, Bef, St); -cg({return,Rs}, Le, Vdb, Bef, St) -> return_cg(Rs, Le, Vdb, Bef, St); -cg({break,Bs}, Le, Vdb, Bef, St) -> break_cg(Bs, Le, Vdb, Bef, St); -cg({guard_break,Bs,N}, Le, Vdb, Bef, St) -> - guard_break_cg(Bs, N, Le, Vdb, Bef, St); -cg({need_heap,H}, _Le, _Vdb, Bef, St) -> +cg(#k_put{anno=Le,arg=Con,ret=Var}, Vdb, Bef, St) -> + put_cg(Var, Con, Le, Vdb, Bef, St); +cg(#k_return{anno=Le,args=Rs}, Vdb, Bef, St) -> + return_cg(Rs, Le, Vdb, Bef, St); +cg(#k_break{anno=Le,args=Bs}, Vdb, Bef, St) -> + break_cg(Bs, Le, Vdb, Bef, St); +cg(#k_guard_break{anno=Le,args=Bs}, Vdb, Bef, St) -> + guard_break_cg(Bs, Le, Vdb, Bef, St); +cg(#cg_need_heap{h=H}, _Vdb, Bef, St) -> {[{test_heap,H,max_reg(Bef#sr.reg)}],Bef,St}. %% cg_list([Kexpr], FirstI, Vdb, StackReg, St) -> {[Ainstr],StackReg,St}. @@ -191,11 +510,11 @@ cg_list(Kes, I, Vdb, Bef, St0) -> %% Insert need_heap instructions in Kexpr list. Try to be smart and %% collect them together as much as possible. -need_heap(Kes0, I) -> +need_heap(Kes0, _I) -> {Kes,H} = need_heap_0(reverse(Kes0), 0, []), %% Prepend need_heap if necessary. - need_heap_need(I, H) ++ Kes. + need_heap_need(H) ++ Kes. need_heap_0([Ke|Kes], H0, Acc) -> {Ns,H} = need_heap_1(Ke, H0), @@ -203,27 +522,54 @@ need_heap_0([Ke|Kes], H0, Acc) -> need_heap_0([], H, Acc) -> {Acc,H}. -need_heap_1(#l{ke={set,_,{binary,_}},i=I}, H) -> - {need_heap_need(I, H),0}; -need_heap_1(#l{ke={set,_,{map,_,_,_}},i=I}, H) -> - {need_heap_need(I, H),0}; -need_heap_1(#l{ke={set,_,Val}}, H) -> +need_heap_1(#k_put{arg=#k_binary{}}, H) -> + {need_heap_need(H),0}; +need_heap_1(#k_put{arg=#k_map{}}, H) -> + {need_heap_need(H),0}; +need_heap_1(#k_put{arg=Val}, H) -> %% Just pass through adding to needed heap. {[],H + case Val of - {cons,_} -> 2; - {tuple,Es} -> 1 + length(Es); + #k_cons{} -> 2; + #k_tuple{es=Es} -> 1 + length(Es); _Other -> 0 end}; -need_heap_1(#l{ke={bif,_Bif,_As,_Rs}}, H) -> - {[],H}; -need_heap_1(#l{i=I}, H) -> +need_heap_1(#k_bif{}=Bif, H) -> + case is_gc_bif(Bif) of + false -> + {[],H}; + true -> + {need_heap_need(H),0} + end; +need_heap_1(_Ke, H) -> %% Call or call-like instruction such as set_tuple_element/3. - {need_heap_need(I, H),0}. - -need_heap_need(_I, 0) -> []; -need_heap_need(I, H) -> [#l{ke={need_heap,H},i=I}]. - -%% match_cg(Match, [Ret], Le, Vdb, StackReg, State) -> + {need_heap_need(H),0}. + +need_heap_need(0) -> []; +need_heap_need(H) -> [#cg_need_heap{h=H}]. + +%% is_gc_bif(#k_bif{}) -> true|false. +%% is_gc_bif(Name, Arity) -> true|false. +%% Determines whether the BIF Name/Arity might do a GC. + +is_gc_bif(#k_bif{op=#k_remote{name=#k_atom{val=Name}},args=Args}) -> + is_gc_bif(Name, length(Args)); +is_gc_bif(#k_bif{op=#k_internal{}}) -> + true. + +is_gc_bif(hd, 1) -> false; +is_gc_bif(tl, 1) -> false; +is_gc_bif(self, 0) -> false; +is_gc_bif(node, 0) -> false; +is_gc_bif(node, 1) -> false; +is_gc_bif(element, 2) -> false; +is_gc_bif(get, 1) -> false; +is_gc_bif(tuple_size, 1) -> false; +is_gc_bif(Bif, Arity) -> + not (erl_internal:bool_op(Bif, Arity) orelse + erl_internal:new_type_test(Bif, Arity) orelse + erl_internal:comp_op(Bif, Arity)). + +%% match_cg(Matc, [Ret], Le, Vdb, StackReg, State) -> %% {[Ainstr],StackReg,State}. %% Generate code for a match. First save all variables on the stack %% that are to survive after the match. We leave saved variables in @@ -244,7 +590,10 @@ match_cg(M, Rs, Le, Vdb, Bef, St0) -> guard_match_cg(M, Rs, Le, Vdb, Bef, St0) -> I = Le#l.i, {B,St1} = new_label(St0), - #cg{bfail=Fail} = St1, + Fail = case St0 of + #cg{bfail=0,ultimate_failure=Fail0} -> Fail0; + #cg{bfail=Fail0} -> Fail0 + end, {Mis,Aft,St2} = match_cg(M, Fail, Bef, St1#cg{break=B}), %% Update the register descriptors for the return registers. Reg = guard_match_regs(Aft#sr.reg, Rs), @@ -252,7 +601,7 @@ guard_match_cg(M, Rs, Le, Vdb, Bef, St0) -> clear_dead(Aft#sr{reg=Reg}, I, Vdb), St2#cg{break=St1#cg.break}}. -guard_match_regs([{I,gbreakvar}|Rs], [{var,V}|Vs]) -> +guard_match_regs([{I,gbreakvar}|Rs], [#k_var{name=V}|Vs]) -> [{I,V}|guard_match_regs(Rs, Vs)]; guard_match_regs([R|Rs], Vs) -> [R|guard_match_regs(Rs, Vs)]; @@ -264,17 +613,14 @@ guard_match_regs([], []) -> []. %% down as each level which uses this takes its own internal Vdb not %% the outer one. -match_cg(Le, Fail, Bef, St) -> - match_cg(Le#l.ke, Le, Fail, Bef, St). - -match_cg({alt,F,S}, _Le, Fail, Bef, St0) -> +match_cg(#k_alt{first=F,then=S}, Fail, Bef, St0) -> {Tf,St1} = new_label(St0), {Fis,Faft,St2} = match_cg(F, Tf, Bef, St1), {Sis,Saft,St3} = match_cg(S, Fail, Bef, St2), Aft = sr_merge(Faft, Saft), {Fis ++ [{label,Tf}] ++ Sis,Aft,St3}; -match_cg({select,{var,Vname}=V,Scs0}, #l{a=Anno}, Fail, Bef, St) -> - ReuseForContext = member(reuse_for_context, Anno) andalso +match_cg(#k_select{var=#k_var{anno=Vanno,name=Vname}=V,types=Scs0}, Fail, Bef, St) -> + ReuseForContext = member(reuse_for_context, Vanno) andalso find_reg(Vname, Bef#sr.reg) =/= error, Scs = case ReuseForContext of false -> Scs0; @@ -283,10 +629,10 @@ match_cg({select,{var,Vname}=V,Scs0}, #l{a=Anno}, Fail, Bef, St) -> match_fmf(fun (S, F, Sta) -> select_cg(S, V, F, Fail, Bef, Sta) end, Fail, St, Scs); -match_cg({guard,Gcs}, _Le, Fail, Bef, St) -> +match_cg(#k_guard{clauses=Gcs}, Fail, Bef, St) -> match_fmf(fun (G, F, Sta) -> guard_clause_cg(G, F, Bef, Sta) end, Fail, St, Gcs); -match_cg({block,Es}, Le, _Fail, Bef, St) -> +match_cg(#cg_block{anno=Le,es=Es}, _Fail, Bef, St) -> %% Must clear registers and stack of dead variables. Int = clear_dead(Bef, Le#l.i, Le#l.vdb), block_cg(Es, Le, Int, St). @@ -294,8 +640,8 @@ match_cg({block,Es}, Le, _Fail, Bef, St) -> %% bsm_rename_ctx([Clause], Var) -> [Clause] %% We know from an annotation that the register for a binary can %% be reused for the match context because the two are not truly -%% alive at the same time (even though the conservative life time -%% information calculated by v3_life says so). +%% alive at the same time (even though the life time information +%% says so). %% %% The easiest way to have those variables share the same register is %% to rename the variable with the shortest life-span (the match @@ -306,12 +652,14 @@ match_cg({block,Es}, Le, _Fail, Bef, St) -> %% We must also remove all information about the match context %% variable from all life-time information databases (Vdb). -bsm_rename_ctx([#l{ke={type_clause,binary, - [#l{ke={val_clause,{binary,{var,Old}},Ke0}}=L2]}}=L1|Cs], New) -> +bsm_rename_ctx([#k_type_clause{type=k_binary,values=Vcs}=TC|Cs], New) -> + [#k_val_clause{val=#k_binary{segs=#k_var{name=Old}}=Bin, + body=Ke0}=VC0] = Vcs, Ke = bsm_rename_ctx(Ke0, Old, New, false), - [L1#l{ke={type_clause,binary, - [L2#l{ke={val_clause,{binary,{var,New}},Ke}}]}}|bsm_rename_ctx(Cs, New)]; -bsm_rename_ctx([C|Cs], New) -> + VC = VC0#k_val_clause{val=Bin#k_binary{segs=#k_var{name=New}}, + body=Ke}, + [TC#k_type_clause{values=[VC]}|bsm_rename_ctx(Cs, New)]; +bsm_rename_ctx([C|Cs], New) -> [C|bsm_rename_ctx(Cs, New)]; bsm_rename_ctx([], _) -> []. @@ -321,34 +669,24 @@ bsm_rename_ctx([], _) -> []. %% only complicatate things to recurse into blocks not in a protected %% (the match context variable is not live inside them). -bsm_rename_ctx(#l{ke={select,{var,V},Cs0}}=L, Old, New, InProt) -> +bsm_rename_ctx(#k_select{var=#k_var{name=V},types=Cs0}=Sel, + Old, New, InProt) -> Cs = bsm_rename_ctx_list(Cs0, Old, New, InProt), - L#l{ke={select,{var,bsm_rename_var(V, Old, New)},Cs}}; -bsm_rename_ctx(#l{ke={type_clause,Type,Cs0}}=L, Old, New, InProt) -> + Sel#k_select{var=#k_var{name=bsm_rename_var(V, Old, New)},types=Cs}; +bsm_rename_ctx(#k_type_clause{values=Cs0}=TC, Old, New, InProt) -> Cs = bsm_rename_ctx_list(Cs0, Old, New, InProt), - L#l{ke={type_clause,Type,Cs}}; -bsm_rename_ctx(#l{ke={val_clause,{bin_end,V},Ke0}}=L, Old, New, InProt) -> - Ke = bsm_rename_ctx(Ke0, Old, New, InProt), - L#l{ke={val_clause,{bin_end,bsm_rename_var(V, Old, New)},Ke}}; -bsm_rename_ctx(#l{ke={val_clause,{bin_seg,V,Sz,U,Type,Fl,Vs},Ke0}}=L, - Old, New, InProt) -> - Ke = bsm_rename_ctx(Ke0, Old, New, InProt), - L#l{ke={val_clause,{bin_seg,bsm_rename_var(V, Old, New),Sz,U,Type,Fl,Vs},Ke}}; -bsm_rename_ctx(#l{ke={val_clause,{bin_int,V,Sz,U,Fl,Val,Vs},Ke0}}=L, - Old, New, InProt) -> + TC#k_type_clause{values=Cs}; +bsm_rename_ctx(#k_val_clause{body=Ke0}=VC, Old, New, InProt) -> Ke = bsm_rename_ctx(Ke0, Old, New, InProt), - L#l{ke={val_clause,{bin_int,bsm_rename_var(V, Old, New),Sz,U,Fl,Val,Vs},Ke}}; -bsm_rename_ctx(#l{ke={val_clause,Val,Ke0}}=L, Old, New, InProt) -> - Ke = bsm_rename_ctx(Ke0, Old, New, InProt), - L#l{ke={val_clause,Val,Ke}}; -bsm_rename_ctx(#l{ke={alt,F0,S0}}=L, Old, New, InProt) -> + VC#k_val_clause{body=Ke}; +bsm_rename_ctx(#k_alt{first=F0,then=S0}=Alt, Old, New, InProt) -> F = bsm_rename_ctx(F0, Old, New, InProt), S = bsm_rename_ctx(S0, Old, New, InProt), - L#l{ke={alt,F,S}}; -bsm_rename_ctx(#l{ke={guard,Gcs0}}=L, Old, New, InProt) -> + Alt#k_alt{first=F,then=S}; +bsm_rename_ctx(#k_guard{clauses=Gcs0}=Guard, Old, New, InProt) -> Gcs = bsm_rename_ctx_list(Gcs0, Old, New, InProt), - L#l{ke={guard,Gcs}}; -bsm_rename_ctx(#l{ke={guard_clause,G0,B0}}=L, Old, New, InProt) -> + Guard#k_guard{clauses=Gcs}; +bsm_rename_ctx(#k_guard_clause{guard=G0,body=B0}=GC, Old, New, InProt) -> G = bsm_rename_ctx(G0, Old, New, InProt), B = bsm_rename_ctx(B0, Old, New, InProt), %% A guard clause may cause unsaved variables to be saved on the stack. @@ -356,49 +694,45 @@ bsm_rename_ctx(#l{ke={guard_clause,G0,B0}}=L, Old, New, InProt) -> %% same register), it is neither in the stack nor register descriptor %% lists and we would crash when we didn't find it unless we remove %% it from the database. - bsm_forget_var(L#l{ke={guard_clause,G,B}}, Old); -bsm_rename_ctx(#l{ke={protected,Ts0,Rs}}=L, Old, New, _InProt) -> + bsm_forget_var(GC#k_guard_clause{guard=G,body=B}, Old); +bsm_rename_ctx(#k_protected{arg=Ts0}=Prot, Old, New, _InProt) -> InProt = true, Ts = bsm_rename_ctx_list(Ts0, Old, New, InProt), - bsm_forget_var(L#l{ke={protected,Ts,Rs}}, Old); -bsm_rename_ctx(#l{ke={match,Ms0,Rs}}=L, Old, New, InProt) -> - Ms = bsm_rename_ctx(Ms0, Old, New, InProt), - L#l{ke={match,Ms,Rs}}; -bsm_rename_ctx(#l{ke={guard_match,Ms0,Rs}}=L, Old, New, InProt) -> + bsm_forget_var(Prot#k_protected{arg=Ts}, Old); +bsm_rename_ctx(#k_guard_match{body=Ms0}=Match, Old, New, InProt) -> Ms = bsm_rename_ctx(Ms0, Old, New, InProt), - L#l{ke={guard_match,Ms,Rs}}; -bsm_rename_ctx(#l{ke={test,_,_,_}}=L, _, _, _) -> L; -bsm_rename_ctx(#l{ke={bif,_,_,_}}=L, _, _, _) -> L; -bsm_rename_ctx(#l{ke={gc_bif,_,_,_}}=L, _, _, _) -> L; -bsm_rename_ctx(#l{ke={set,_,_}}=L, _, _, _) -> L; -bsm_rename_ctx(#l{ke={call,_,_,_}}=L, _, _, _) -> L; -bsm_rename_ctx(#l{ke={block,_}}=L, Old, _, false) -> + Match#k_guard_match{body=Ms}; +bsm_rename_ctx(#k_test{}=Test, _, _, _) -> Test; +bsm_rename_ctx(#k_bif{}=Bif, _, _, _) -> Bif; +bsm_rename_ctx(#k_put{}=Put, _, _, _) -> Put; +bsm_rename_ctx(#k_call{}=Call, _, _, _) -> Call; +bsm_rename_ctx(#cg_block{}=Block, Old, _, false) -> %% This block is not inside a protected. The match context variable cannot %% possibly be live inside the block. - bsm_forget_var(L, Old); -bsm_rename_ctx(#l{ke={block,Bl0}}=L, Old, New, true) -> + bsm_forget_var(Block, Old); +bsm_rename_ctx(#cg_block{es=Es0}=Block, Old, New, true) -> %% A block in a protected. We must recursively rename the variable %% inside the block. - Bl = bsm_rename_ctx_list(Bl0, Old, New, true), - bsm_forget_var(L#l{ke={block,Bl}}, Old); -bsm_rename_ctx(#l{ke={guard_break,Bs,Locked0}}=L0, Old, _New, _InProt) -> - Locked = Locked0 -- [Old], - L = L0#l{ke={guard_break,Bs,Locked}}, - bsm_forget_var(L, Old). + Es = bsm_rename_ctx_list(Es0, Old, New, true), + bsm_forget_var(Block#cg_block{es=Es}, Old); +bsm_rename_ctx(#k_guard_break{}=Break, Old, _New, _InProt) -> + bsm_forget_var(Break, Old). bsm_rename_ctx_list([C|Cs], Old, New, InProt) -> [bsm_rename_ctx(C, Old, New, InProt)| bsm_rename_ctx_list(Cs, Old, New, InProt)]; bsm_rename_ctx_list([], _, _, _) -> []. - + bsm_rename_var(Old, Old, New) -> New; bsm_rename_var(V, _, _) -> V. %% bsm_forget_var(#l{}, Variable) -> #l{} %% Remove a variable from the variable life-time database. -bsm_forget_var(#l{vdb=Vdb}=L, V) -> - L#l{vdb=keydelete(V, 1, Vdb)}. +bsm_forget_var(Ke, V) -> + #l{vdb=Vdb} = L0 = get_kanno(Ke), + L = L0#l{vdb=keydelete(V, 1, Vdb)}, + set_kanno(Ke, L). %% block_cg([Kexpr], Le, Vdb, StackReg, St) -> {[Ainstr],StackReg,St}. %% block_cg([Kexpr], Le, StackReg, St) -> {[Ainstr],StackReg,St}. @@ -421,7 +755,7 @@ cg_block(Kes0, I, Vdb, Bef, St0) -> case basic_block(Kes0) of {Kes1,LastI,Args,Rest} -> Ke = hd(Kes1), - Fb = Ke#l.i, + #l{i=Fb} = get_kanno(Ke), cg_basic_block(Kes1, Fb, LastI, Args, Vdb, Bef, St0); {Kes1,Rest} -> cg_list(Kes1, I, Vdb, Bef, St0) @@ -431,134 +765,174 @@ cg_block(Kes0, I, Vdb, Bef, St0) -> basic_block(Kes) -> basic_block(Kes, []). -basic_block([Le|Les], Acc) -> - case collect_block(Le#l.ke) of - include -> basic_block(Les, [Le|Acc]); +basic_block([Ke|Kes], Acc) -> + case collect_block(Ke) of + include -> basic_block(Kes, [Ke|Acc]); {block_end,As} -> case Acc of [] -> - %% If the basic block does not contain any set instructions, + %% If the basic block does not contain any #k_put{} instructions, %% it serves no useful purpose to do basic block optimizations. - {[Le],Les}; + {[Ke],Kes}; _ -> - {reverse(Acc, [Le]),Le#l.i,As,Les} + #l{i=I} = get_kanno(Ke), + {reverse(Acc, [Ke]),I,As,Kes} end; - no_block -> {reverse(Acc, [Le]),Les} + no_block -> {reverse(Acc, [Ke]),Kes} end. -%% sets that may garbage collect are not allowed in basic blocks. - -collect_block({set,_,{binary,_}}) -> no_block; -collect_block({set,_,{map,_,_,_}}) -> no_block; -collect_block({set,_,_}) -> include; -collect_block({call,{var,_}=Var,As,_Rs}) -> {block_end,As++[Var]}; -collect_block({call,Func,As,_Rs}) -> {block_end,As++func_vars(Func)}; -collect_block({enter,{var,_}=Var,As})-> {block_end,As++[Var]}; -collect_block({enter,Func,As}) -> {block_end,As++func_vars(Func)}; -collect_block({return,Rs}) -> {block_end,Rs}; -collect_block({break,Bs}) -> {block_end,Bs}; -collect_block(_) -> no_block. - -func_vars({remote,M,F}) when element(1, M) =:= var; - element(1, F) =:= var -> +collect_block(#k_put{arg=Arg}) -> + %% #k_put{} instructions that may garbage collect are not allowed + %% in basic blocks. + case Arg of + #k_binary{} -> no_block; + #k_map{} -> no_block; + _ -> include + end; +collect_block(#k_call{op=Func,args=As}) -> + {block_end,As++func_vars(Func)}; +collect_block(#k_enter{op=Func,args=As}) -> + {block_end,As++func_vars(Func)}; +collect_block(#k_return{args=Rs}) -> + {block_end,Rs}; +collect_block(#k_break{args=Bs}) -> + {block_end,Bs}; +collect_block(_) -> no_block. + +func_vars(#k_var{}=Var) -> + [Var]; +func_vars(#k_remote{mod=M,name=F}) + when is_record(M, k_var); is_record(F, k_var) -> [M,F]; func_vars(_) -> []. -%% cg_basic_block([Kexpr], FirstI, LastI, As, Vdb, StackReg, State) -> +%% cg_basic_block([Kexpr], FirstI, LastI, Arguments, Vdb, StackReg, State) -> %% {[Ainstr],StackReg,State}. +%% +%% Do a specialized code generation for a basic block of #put{} +%% instructions (that don't do any garbage collection) followed by a +%% call, break, or return. +%% +%% 'Arguments' is a list of the variables that must be loaded into +%% consecutive X registers before the last instruction in the block. +%% The point of this specialized code generation is to try put the +%% all of the variables in 'Arguments' into the correct X register +%% to begin with, instead of putting them into the first available +%% X register and having to move them to the correct X register +%% later. +%% +%% To achieve that, we attempt to reserve the X registers that the +%% variables in 'Arguments' will need to be in when the block ends. +%% +%% To make it more likely that reservations will be successful, we +%% will try to save variables that need to be saved to the stack as +%% early as possible (if an X register needed by a variable in +%% Arguments is occupied by another variable, the value in the +%% X register can be evicted if it is saved on the stack). +%% +%% We will take care not to increase the size of stack frame compared +%% to what the standard code generator would have done (that is, to +%% save all X registers at the last possible moment). We will do that +%% by extending the stack frame to the minimal size needed to save +%% all that needs to be saved using extend_stack/4, and use +%% save_carefully/4 during code generation to only save the variables +%% that can be saved without growing the stack frame. cg_basic_block(Kes, Fb, Lf, As, Vdb, Bef, St0) -> - Res = make_reservation(As, 0), - Regs0 = reserve(Res, Bef#sr.reg, Bef#sr.stk), - Stk = extend_stack(Bef, Lf, Lf+1, Vdb), - Int0 = Bef#sr{reg=Regs0,stk=Stk,res=Res}, - X0_v0 = x0_vars(As, Fb, Lf, Vdb), - {Keis,{Aft,_,St1}} = + Int0 = reserve_arg_regs(As, Bef), + Int = extend_stack(Int0, Lf, Lf+1, Vdb), + {Keis,{Aft,St1}} = flatmapfoldl(fun(Ke, St) -> cg_basic_block(Ke, St, Lf, Vdb) end, - {Int0,X0_v0,St0}, need_heap(Kes, Fb)), + {Int,St0}, need_heap(Kes, Fb)), {Keis,Aft,St1}. -cg_basic_block(#l{ke={need_heap,_}}=Ke, {Inta,X0v,Sta}, _Lf, Vdb) -> - {Keis,Intb,Stb} = cg(Ke, Vdb, Inta, Sta), - {Keis, {Intb,X0v,Stb}}; -cg_basic_block(Ke, {Inta,X0_v1,Sta}, Lf, Vdb) -> - {Sis,Intb} = save_carefully(Inta, Ke#l.i, Lf+1, Vdb), - {X0_v2,Intc} = allocate_x0(X0_v1, Ke#l.i, Intb), - Intd = reserve(Intc), - {Keis,Inte,Stb} = cg(Ke, Vdb, Intd, Sta), - {Sis ++ Keis, {Inte,X0_v2,Stb}}. - -make_reservation([], _) -> []; -make_reservation([{var,V}|As], I) -> [{I,V}|make_reservation(As, I+1)]; -make_reservation([A|As], I) -> [{I,A}|make_reservation(As, I+1)]. - -reserve(Sr) -> Sr#sr{reg=reserve(Sr#sr.res, Sr#sr.reg, Sr#sr.stk)}. - -reserve([{I,V}|Rs], [free|Regs], Stk) -> [{reserved,I,V}|reserve(Rs, Regs, Stk)]; -reserve([{I,V}|Rs], [{I,V}|Regs], Stk) -> [{I,V}|reserve(Rs, Regs, Stk)]; -reserve([{I,V}|Rs], [{I,Var}|Regs], Stk) -> +cg_basic_block(#cg_need_heap{}=Ke, {Bef,St0}, _Lf, Vdb) -> + {Keis,Aft,St1} = cg(Ke, Vdb, Bef, St0), + {Keis,{Aft,St1}}; +cg_basic_block(Ke, {Bef,St0}, Lf, Vdb) -> + #l{i=I} = get_kanno(Ke), + + %% Save all we can to increase the possibility that reserving + %% registers will succeed. + {Sis,Int0} = save_carefully(Bef, I, Lf+1, Vdb), + Int1 = reserve(Int0), + {Keis,Aft,St1} = cg(Ke, Vdb, Int1, St0), + {Sis ++ Keis,{Aft,St1}}. + +%% reserve_arg_regs([Argument], Bef) -> Aft. +%% Try to reserve the X registers for all arguments. All registers +%% that we wish to reserve will be saved in Bef#sr.res. + +reserve_arg_regs(As, Bef) -> + Res = reserve_arg_regs_1(As, 0), + reserve(Bef#sr{res=Res}). + +reserve_arg_regs_1([#k_var{name=V}|As], I) -> + [{I,V}|reserve_arg_regs_1(As, I+1)]; +reserve_arg_regs_1([A|As], I) -> + [{I,A}|reserve_arg_regs_1(As, I+1)]; +reserve_arg_regs_1([], _) -> []. + +%% reserve(Bef) -> Aft. +%% Try to reserve more registers. The registers we wish to reserve +%% are found in Bef#sr.res. + +reserve(#sr{reg=Regs,stk=Stk,res=Res}=Sr) -> + Sr#sr{reg=reserve_1(Res, Regs, Stk)}. + +reserve_1([{I,V}|Rs], [free|Regs], Stk) -> + [{reserved,I,V}|reserve_1(Rs, Regs, Stk)]; +reserve_1([{I,V}|Rs], [{I,V}|Regs], Stk) -> + [{I,V}|reserve_1(Rs, Regs, Stk)]; +reserve_1([{I,V}|Rs], [{I,Var}|Regs], Stk) -> case on_stack(Var, Stk) of - true -> [{reserved,I,V}|reserve(Rs, Regs, Stk)]; - false -> [{I,Var}|reserve(Rs, Regs, Stk)] + true -> [{reserved,I,V}|reserve_1(Rs, Regs, Stk)]; + false -> [{I,Var}|reserve_1(Rs, Regs, Stk)] end; -reserve([{I,V}|Rs], [{reserved,I,_}|Regs], Stk) -> - [{reserved,I,V}|reserve(Rs, Regs, Stk)]; -%reserve([{I,V}|Rs], [Other|Regs], Stk) -> [Other|reserve(Rs, Regs, Stk)]; -reserve([{I,V}|Rs], [], Stk) -> [{reserved,I,V}|reserve(Rs, [], Stk)]; -reserve([], Regs, _) -> Regs. - -extend_stack(Bef, Fb, Lf, Vdb) -> - Stk0 = clear_dead_stk(Bef#sr.stk, Fb, Vdb), - Saves = [V || {V,F,L} <- Vdb, - F < Fb, - L >= Lf, - not on_stack(V, Stk0)], - Stk1 = foldl(fun (V, Stk) -> put_stack(V, Stk) end, Stk0, Saves), - Bef#sr.stk ++ lists:duplicate(length(Stk1) - length(Bef#sr.stk), free). - -save_carefully(Bef, Fb, Lf, Vdb) -> - Stk = Bef#sr.stk, - %% New variables that are in use but not on stack. - New = [VFL || {V,F,L} = VFL <- Vdb, - F < Fb, - L >= Lf, - not on_stack(V, Stk)], - Saves = [V || {V,_,_} <- keysort(2, New)], - save_carefully(Saves, Bef, []). - -save_carefully([], Bef, Acc) -> {reverse(Acc),Bef}; -save_carefully([V|Vs], Bef, Acc) -> - case put_stack_carefully(V, Bef#sr.stk) of - error -> {reverse(Acc),Bef}; +reserve_1([{I,V}|Rs], [{reserved,I,_}|Regs], Stk) -> + [{reserved,I,V}|reserve_1(Rs, Regs, Stk)]; +reserve_1([{I,V}|Rs], [], Stk) -> + [{reserved,I,V}|reserve_1(Rs, [], Stk)]; +reserve_1([], Regs, _) -> Regs. + +%% extend_stack(Bef, FirstBefore, LastFrom, Vdb) -> Aft. +%% Extend the stack enough to fit all variables alive past LastFrom +%% and not already on the stack. + +extend_stack(#sr{stk=Stk0}=Bef, Fb, Lf, Vdb) -> + Stk1 = clear_dead_stk(Stk0, Fb, Vdb), + New = new_not_on_stack(Stk1, Fb, Lf, Vdb), + Stk2 = foldl(fun ({V,_,_}, Stk) -> put_stack(V, Stk) end, Stk1, New), + Stk = Stk0 ++ lists:duplicate(length(Stk2) - length(Stk0), free), + Bef#sr{stk=Stk}. + +%% save_carefully(Bef, FirstBefore, LastFrom, Vdb) -> {[SaveVar],Aft}. +%% Save variables which are used past current point and which are not +%% already on the stack, but only if the variables can be saved without +%% growing the stack frame. + +save_carefully(#sr{stk=Stk}=Bef, Fb, Lf, Vdb) -> + New0 = new_not_on_stack(Stk, Fb, Lf, Vdb), + New = keysort(2, New0), + save_carefully_1(New, Bef, []). + +save_carefully_1([{V,_,_}|Vs], #sr{reg=Regs,stk=Stk0}=Bef, Acc) -> + case put_stack_carefully(V, Stk0) of + error -> + {reverse(Acc),Bef}; Stk1 -> - SrcReg = fetch_reg(V, Bef#sr.reg), + SrcReg = fetch_reg(V, Regs), Move = {move,SrcReg,fetch_stack(V, Stk1)}, {x,_} = SrcReg, %Assertion - must be X register. - save_carefully(Vs, Bef#sr{stk=Stk1}, [Move|Acc]) - end. + save_carefully_1(Vs, Bef#sr{stk=Stk1}, [Move|Acc]) + end; +save_carefully_1([], Bef, Acc) -> + {reverse(Acc),Bef}. -x0_vars([], _Fb, _Lf, _Vdb) -> []; -x0_vars([{var,V}|_], Fb, _Lf, Vdb) -> - {V,F,_L} = VFL = vdb_find(V, Vdb), - x0_vars1([VFL], Fb, F, Vdb); -x0_vars([X0|_], Fb, Lf, Vdb) -> - x0_vars1([{X0,Lf,Lf}], Fb, Lf, Vdb). - -x0_vars1(X0, Fb, Xf, Vdb) -> - Vs0 = [VFL || {_V,F,L}=VFL <- Vdb, - F >= Fb, - L < Xf], - Vs1 = keysort(3, Vs0), - keysort(2, X0++Vs1). - -allocate_x0([], _, Bef) -> {[],Bef#sr{res=[]}}; -allocate_x0([{_,_,L}|Vs], I, Bef) when L =< I -> - allocate_x0(Vs, I, Bef); -allocate_x0([{V,_F,_L}=VFL|Vs], _, Bef) -> - {[VFL|Vs],Bef#sr{res=reserve_x0(V, Bef#sr.res)}}. - -reserve_x0(V, [_|Res]) -> [{0,V}|Res]; -reserve_x0(V, []) -> [{0,V}]. +%% top_level_block([Instruction], Bef, MaxRegs, St) -> [Instruction]. +%% For the top-level block, allocate a stack frame a necessary, +%% adjust Y register numbering and instructions that return +%% from the function. top_level_block(Keis, #sr{stk=[]}, _MaxRegs, #cg{need_frame=false}) -> Keis; @@ -640,21 +1014,27 @@ turn_yreg(Other, _MaxY) -> %% wrong. These are different as in the second case there is no need %% to try the next type, it will always fail. -select_cg(#l{ke={type_clause,cons,[S]}}, {var,V}, Tf, Vf, Bef, St) -> +select_cg(#k_type_clause{type=Type,values=Vs}, Var, Tf, Vf, Bef, St) -> + #k_var{name=V} = Var, + select_cg(Type, Vs, V, Tf, Vf, Bef, St). + +select_cg(k_cons, [S], V, Tf, Vf, Bef, St) -> select_cons(S, V, Tf, Vf, Bef, St); -select_cg(#l{ke={type_clause,nil,[S]}}, {var,V}, Tf, Vf, Bef, St) -> +select_cg(k_nil, [S], V, Tf, Vf, Bef, St) -> select_nil(S, V, Tf, Vf, Bef, St); -select_cg(#l{ke={type_clause,binary,[S]}}, {var,V}, Tf, Vf, Bef, St) -> +select_cg(k_binary, [S], V, Tf, Vf, Bef, St) -> select_binary(S, V, Tf, Vf, Bef, St); -select_cg(#l{ke={type_clause,bin_seg,S}}, {var,V}, Tf, _Vf, Bef, St) -> +select_cg(k_bin_seg, S, V, Tf, _Vf, Bef, St) -> select_bin_segs(S, V, Tf, Bef, St); -select_cg(#l{ke={type_clause,bin_int,S}}, {var,V}, Tf, _Vf, Bef, St) -> +select_cg(k_bin_int, S, V, Tf, _Vf, Bef, St) -> select_bin_segs(S, V, Tf, Bef, St); -select_cg(#l{ke={type_clause,bin_end,[S]}}, {var,V}, Tf, _Vf, Bef, St) -> +select_cg(k_bin_end, [S], V, Tf, _Vf, Bef, St) -> select_bin_end(S, V, Tf, Bef, St); -select_cg(#l{ke={type_clause,map,S}}, {var,V}, Tf, Vf, Bef, St) -> +select_cg(k_map, S, V, Tf, Vf, Bef, St) -> select_map(S, V, Tf, Vf, Bef, St); -select_cg(#l{ke={type_clause,Type,Scs}}, {var,V}, Tf, Vf, Bef, St0) -> +select_cg(k_literal, S, V, Tf, Vf, Bef, St) -> + select_literal(S, V, Tf, Vf, Bef, St); +select_cg(Type, Scs, V, Tf, Vf, Bef, St0) -> {Vis,{Aft,St1}} = mapfoldl(fun (S, {Int,Sta}) -> {Val,Is,Inta,Stb} = select_val(S, V, Vf, Bef, Sta), @@ -664,22 +1044,29 @@ select_cg(#l{ke={type_clause,Type,Scs}}, {var,V}, Tf, Vf, Bef, St0) -> {Vls,Sis,St2} = select_labels(OptVls, St1, [], []), {select_val_cg(Type, fetch_var(V, Bef), Vls, Tf, Vf, Sis), Aft, St2}. -select_val_cg(tuple, R, [Arity,{f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) -> +select_val_cg(k_tuple, R, [Arity,{f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) -> [{test,is_tuple,{f,Tf},[R]},{test,test_arity,{f,Vf},[R,Arity]}|Sis]; -select_val_cg(tuple, R, Vls, Tf, Vf, Sis) -> +select_val_cg(k_tuple, R, Vls, Tf, Vf, Sis) -> [{test,is_tuple,{f,Tf},[R]},{select_tuple_arity,R,{f,Vf},{list,Vls}}|Sis]; select_val_cg(Type, R, [Val, {f,Lbl}], Fail, Fail, [{label,Lbl}|Sis]) -> - [{test,is_eq_exact,{f,Fail},[R,{Type,Val}]}|Sis]; + [{test,is_eq_exact,{f,Fail},[R,{type(Type),Val}]}|Sis]; select_val_cg(Type, R, [Val, {f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) -> [{test,select_type_test(Type),{f,Tf},[R]}, - {test,is_eq_exact,{f,Vf},[R,{Type,Val}]}|Sis]; + {test,is_eq_exact,{f,Vf},[R,{type(Type),Val}]}|Sis]; select_val_cg(Type, R, Vls0, Tf, Vf, Sis) -> - Vls1 = [case Value of {f,_Lbl} -> Value; _ -> {Type,Value} end || Value <- Vls0], + Vls1 = [case Value of + {f,_Lbl} -> Value; + _ -> {type(Type),Value} + end || Value <- Vls0], [{test,select_type_test(Type),{f,Tf},[R]}, {select_val,R,{f,Vf},{list,Vls1}}|Sis]. - -select_type_test(integer) -> is_integer; -select_type_test(atom) -> is_atom; -select_type_test(float) -> is_float. + +type(k_atom) -> atom; +type(k_float) -> float; +type(k_int) -> integer. + +select_type_test(k_int) -> is_integer; +select_type_test(k_atom) -> is_atom; +select_type_test(k_float) -> is_float. combine([{Is,Vs1}, {Is,Vs2}|Vis]) -> combine([{Is,Vs1 ++ Vs2}|Vis]); combine([V|Vis]) -> [V|combine(Vis)]; @@ -695,36 +1082,49 @@ add_vls([V|Vs], Lbl, Acc) -> add_vls(Vs, Lbl, [V, {f,Lbl}|Acc]); add_vls([], _, Acc) -> Acc. -select_cons(#l{ke={val_clause,{cons,Es},B},i=I,vdb=Vdb}, V, Tf, Vf, Bef, St0) -> +select_literal(S, V, Tf, Vf, Bef, St) -> + Reg = fetch_var(V, Bef), + F = fun(ValClause, Fail, St0) -> + {Val,Is,Aft,St1} = select_val(ValClause, V, Vf, Bef, St0), + Test = {test,is_eq_exact,{f,Fail},[Reg,{literal,Val}]}, + {[Test|Is],Aft,St1} + end, + match_fmf(F, Tf, St, S). + +select_cons(#k_val_clause{val=#k_cons{hd=Hd,tl=Tl},body=B,anno=#l{i=I,vdb=Vdb}}, + V, Tf, Vf, Bef, St0) -> + Es = [Hd,Tl], {Eis,Int,St1} = select_extract_cons(V, Es, I, Vdb, Bef, St0), {Bis,Aft,St2} = match_cg(B, Vf, Int, St1), {[{test,is_nonempty_list,{f,Tf},[fetch_var(V, Bef)]}] ++ Eis ++ Bis,Aft,St2}. -select_nil(#l{ke={val_clause,nil,B}}, V, Tf, Vf, Bef, St0) -> +select_nil(#k_val_clause{val=#k_nil{},body=B}, V, Tf, Vf, Bef, St0) -> {Bis,Aft,St1} = match_cg(B, Vf, Bef, St0), {[{test,is_nil,{f,Tf},[fetch_var(V, Bef)]}] ++ Bis,Aft,St1}. -select_binary(#l{ke={val_clause,{binary,{var,V}},B},i=I,vdb=Vdb}, - V, Tf, Vf, Bef, St0) -> +select_binary(#k_val_clause{val=#k_binary{segs=#k_var{name=V}},body=B, + anno=#l{i=I,vdb=Vdb}}, V, Tf, Vf, Bef, St0) -> + #cg{ctx=OldCtx} = St0, Int0 = clear_dead(Bef#sr{reg=Bef#sr.reg}, I, Vdb), - {Bis0,Aft,St1} = match_cg(B, Vf, Int0, St0), + {Bis0,Aft,St1} = match_cg(B, Vf, Int0, St0#cg{ctx=V}), CtxReg = fetch_var(V, Int0), Live = max_reg(Bef#sr.reg), Bis1 = [{test,bs_start_match2,{f,Tf},Live,[CtxReg,V],CtxReg}, {bs_save2,CtxReg,{V,V}}|Bis0], Bis = finish_select_binary(Bis1), - {Bis,Aft,St1}; -select_binary(#l{ke={val_clause,{binary,{var,Ivar}},B},i=I,vdb=Vdb}, - V, Tf, Vf, Bef, St0) -> + {Bis,Aft,St1#cg{ctx=OldCtx}}; +select_binary(#k_val_clause{val=#k_binary{segs=#k_var{name=Ivar}},body=B, + anno=#l{i=I,vdb=Vdb}}, V, Tf, Vf, Bef, St0) -> + #cg{ctx=OldCtx} = St0, Regs = put_reg(Ivar, Bef#sr.reg), Int0 = clear_dead(Bef#sr{reg=Regs}, I, Vdb), - {Bis0,Aft,St1} = match_cg(B, Vf, Int0, St0), + {Bis0,Aft,St1} = match_cg(B, Vf, Int0, St0#cg{ctx=Ivar}), CtxReg = fetch_var(Ivar, Int0), Live = max_reg(Bef#sr.reg), Bis1 = [{test,bs_start_match2,{f,Tf},Live,[fetch_var(V, Bef),Ivar],CtxReg}, {bs_save2,CtxReg,{Ivar,Ivar}}|Bis0], Bis = finish_select_binary(Bis1), - {Bis,Aft,St1}. + {Bis,Aft,St1#cg{ctx=OldCtx}}. finish_select_binary([{bs_save2,R,Point}=I,{bs_restore2,R,Point}|Is]) -> [I|finish_select_binary(Is)]; @@ -746,9 +1146,16 @@ select_bin_segs(Scs, Ivar, Tf, Bef, St) -> select_bin_seg(S, Ivar, Fail, Bef, Sta) end, Tf, St, Scs). -select_bin_seg(#l{ke={val_clause,{bin_seg,Ctx,Size,U,T,Fs0,Es},B},i=I,vdb=Vdb,a=A}, - Ivar, Fail, Bef, St0) -> +select_bin_seg(#k_val_clause{val=#k_bin_seg{size=Size,unit=U,type=T, + seg=Seg,flags=Fs0,next=Next}, + body=B, + anno=#l{i=I,vdb=Vdb,a=A}}, Ivar, Fail, Bef, St0) -> + Ctx = St0#cg.ctx, Fs = [{anno,A}|Fs0], + Es = case Next of + [] -> [Seg]; + _ -> [Seg,Next] + end, {Mis,Int,St1} = select_extract_bin(Es, Size, U, T, Fs, Fail, I, Vdb, Bef, Ctx, B, St0), {Bis,Aft,St2} = match_cg(B, Fail, Int, St1), @@ -761,9 +1168,12 @@ select_bin_seg(#l{ke={val_clause,{bin_seg,Ctx,Size,U,T,Fs0,Es},B},i=I,vdb=Vdb,a= [{bs_restore2,CtxReg,{Ctx,Ivar}}|Mis++Bis] end, {Is,Aft,St2}; -select_bin_seg(#l{ke={val_clause,{bin_int,Ctx,Sz,U,Fs,Val,Es},B},i=I,vdb=Vdb}, - Ivar, Fail, Bef, St0) -> - {Mis,Int,St1} = select_extract_int(Es, Val, Sz, U, Fs, Fail, +select_bin_seg(#k_val_clause{val=#k_bin_int{size=Sz,unit=U,flags=Fs, + val=Val,next=Next}, + body=B, + anno=#l{i=I,vdb=Vdb}}, Ivar, Fail, Bef, St0) -> + Ctx = St0#cg.ctx, + {Mis,Int,St1} = select_extract_int(Next, Val, Sz, U, Fs, Fail, I, Vdb, Bef, Ctx, St0), {Bis,Aft,St2} = match_cg(B, Fail, Int, St1), CtxReg = fetch_var(Ctx, Bef), @@ -784,7 +1194,7 @@ select_bin_seg(#l{ke={val_clause,{bin_int,Ctx,Sz,U,Fs,Val,Es},B},i=I,vdb=Vdb}, end, {[{bs_restore2,CtxReg,{Ctx,Ivar}}|Is],Aft,St2}. -select_extract_int([{var,Tl}], Val, {integer,Sz}, U, Fs, Vf, +select_extract_int(#k_var{name=Tl}, Val, #k_int{val=Sz}, U, Fs, Vf, I, Vdb, Bef, Ctx, St) -> Bits = U*Sz, Bin = case member(big, Fs) of @@ -805,7 +1215,7 @@ select_extract_int([{var,Tl}], Val, {integer,Sz}, U, Fs, Vf, end, {Is,clear_dead(Bef, I, Vdb),St}. -select_extract_bin([{var,Hd},{var,Tl}], Size0, Unit, Type, Flags, Vf, +select_extract_bin([#k_var{name=Hd},#k_var{name=Tl}], Size0, Unit, Type, Flags, Vf, I, Vdb, Bef, Ctx, _Body, St) -> SizeReg = get_bin_size_reg(Size0, Bef), {Es,Aft} = @@ -828,11 +1238,11 @@ select_extract_bin([{var,Hd},{var,Tl}], Size0, Unit, Type, Flags, Vf, {bs_save2,CtxReg,{Ctx,Tl}}],Int1} end, {Es,clear_dead(Aft, I, Vdb),St}; -select_extract_bin([{var,Hd}], Size, Unit, binary, Flags, Vf, +select_extract_bin([#k_var{name=Hd}], Size, Unit, binary, Flags, Vf, I, Vdb, Bef, Ctx, Body, St) -> %% Match the last segment of a binary. We KNOW that the size %% must be 'all'. - Size = {atom,all}, %Assertion. + #k_atom{val=all} = Size, %Assertion. {Es,Aft} = case vdb_find(Hd, Vdb) of {_,_,Lhd} when Lhd =< I -> @@ -857,7 +1267,7 @@ select_extract_bin([{var,Hd}], Size, Unit, binary, Flags, Vf, Name = bs_get_binary2, Live = max_reg(Bef#sr.reg), {[{test,Name,{f,Vf},Live, - [CtxReg,Size,Unit,{field_flags,Flags}],Rhd}], + [CtxReg,atomic(Size),Unit,{field_flags,Flags}],Rhd}], Int1}; true -> %% Since the matching context will not be used again, @@ -872,36 +1282,42 @@ select_extract_bin([{var,Hd}], Size, Unit, binary, Flags, Vf, Name = bs_get_binary2, Live = max_reg(Int1#sr.reg), {[{test,Name,{f,Vf},Live, - [CtxReg,Size,Unit,{field_flags,Flags}],CtxReg}], + [CtxReg,atomic(Size),Unit,{field_flags,Flags}],CtxReg}], Int1} end end, {Es,clear_dead(Aft, I, Vdb),St}. %% is_context_unused(Ke) -> true | false -%% Simple heurististic to determine whether the code that follows will -%% use the current matching context again. (The information of liveness -%% calculcated by v3_life is too conservative to be useful for this purpose.) -%% 'true' means that the code that follows will definitely not use the context -%% again (because it is a block, not guard or matching code); 'false' that we -%% are not sure (there is either a guard, or more matching, either which may -%% reference the context again). - -is_context_unused(#l{ke=Ke}) -> is_context_unused(Ke); -is_context_unused({block,_}) -> true; -is_context_unused(_) -> false. - -select_bin_end(#l{ke={val_clause,{bin_end,Ctx},B}}, - Ivar, Tf, Bef, St0) -> +%% Simple heurististic to determine whether the code that follows +%% will use the current matching context again. (The liveness +%% information is too conservative to be useful for this purpose.) +%% 'true' means that the code that follows will definitely not use +%% the context again (because it is a block, not guard or matching +%% code); 'false' that we are not sure (there could be more +%% matching). + +is_context_unused(#k_alt{then=Then}) -> + %% #k_alt{} can be used for different purposes. If the Then part + %% is a block, it means that matching has finished and is used for a guard + %% to choose between the matched clauses. + is_context_unused(Then); +is_context_unused(#cg_block{}) -> + true; +is_context_unused(_) -> + false. + +select_bin_end(#k_val_clause{val=#k_bin_end{},body=B}, Ivar, Tf, Bef, St0) -> + Ctx = St0#cg.ctx, {Bis,Aft,St2} = match_cg(B, Tf, Bef, St0), CtxReg = fetch_var(Ctx, Bef), {[{bs_restore2,CtxReg,{Ctx,Ivar}}, {test,bs_test_tail2,{f,Tf},[CtxReg,0]}|Bis],Aft,St2}. -get_bin_size_reg({var,V}, Bef) -> +get_bin_size_reg(#k_var{name=V}, Bef) -> fetch_var(V, Bef); get_bin_size_reg(Literal, _Bef) -> - Literal. + atomic(Literal). build_bs_instr(Type, Vf, CtxReg, Live, SizeReg, Unit, Flags, Rhd) -> {Format,Name} = case Type of @@ -935,11 +1351,18 @@ build_skip_instr(Type, Vf, CtxReg, Live, SizeReg, Unit, Flags) -> {test,Name,{f,Vf},[CtxReg,Live,{field_flags,Flags}]} end. -select_val(#l{ke={val_clause,{tuple,Es},B},i=I,vdb=Vdb}, V, Vf, Bef, St0) -> +select_val(#k_val_clause{val=#k_tuple{es=Es},body=B,anno=#l{i=I,vdb=Vdb}}, + V, Vf, Bef, St0) -> {Eis,Int,St1} = select_extract_tuple(V, Es, I, Vdb, Bef, St0), {Bis,Aft,St2} = match_cg(B, Vf, Int, St1), {length(Es),Eis ++ Bis,Aft,St2}; -select_val(#l{ke={val_clause,{_,Val},B}}, _V, Vf, Bef, St0) -> +select_val(#k_val_clause{val=Val0,body=B}, _V, Vf, Bef, St0) -> + Val = case Val0 of + #k_atom{val=Lit} -> Lit; + #k_float{val=Lit} -> Lit; + #k_int{val=Lit} -> Lit; + #k_literal{val=Lit} -> Lit + end, {Bis,Aft,St1} = match_cg(B, Vf, Bef, St0), {Val,Bis,Aft,St1}. @@ -948,7 +1371,7 @@ select_val(#l{ke={val_clause,{_,Val},B}}, _V, Vf, Bef, St0) -> %% Extract tuple elements, but only if they do not immediately die. select_extract_tuple(Src, Vs, I, Vdb, Bef, St) -> - F = fun ({var,V}, {Int0,Elem}) -> + F = fun (#k_var{name=V}, {Int0,Elem}) -> case vdb_find(V, Vdb) of {V,_,L} when L =< I -> {[], {Int0,Elem+1}}; _Other -> @@ -965,9 +1388,10 @@ select_extract_tuple(Src, Vs, I, Vdb, Bef, St) -> select_map(Scs, V, Tf, Vf, Bef, St0) -> Reg = fetch_var(V, Bef), {Is,Aft,St1} = - match_fmf(fun(#l{ke={val_clause,{map,exact,_,Es},B},i=I,vdb=Vdb}, Fail, St1) -> - select_map_val(V, Es, B, Fail, I, Vdb, Bef, St1) - end, Vf, St0, Scs), + match_fmf(fun(#k_val_clause{val=#k_map{op=exact,es=Es}, + body=B,anno=#l{i=I,vdb=Vdb}}, Fail, St1) -> + select_map_val(V, Es, B, Fail, I, Vdb, Bef, St1) + end, Vf, St0, Scs), {[{test,is_map,{f,Tf},[Reg]}|Is],Aft,St1}. select_map_val(V, Es, B, Fail, I, Vdb, Bef, St0) -> @@ -984,29 +1408,32 @@ select_extract_map(Src, Vs, Fail, I, Vdb, Bef, St) -> %% Assume keys are term-sorted Rsrc = fetch_var(Src, Bef), - {{HasKs,GetVs,HasVarKs,GetVarVs},Aft} = lists:foldr(fun - ({map_pair,{var,K},{var,V}},{{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) -> - case vdb_find(V, Vdb) of - {V,_,L} when L =< I -> - RK = fetch_var(K,Int0), - {{HasKsi,GetVsi,[RK|HasVarVsi],GetVarVsi},Int0}; - _Other -> - Reg1 = put_reg(V, Int0#sr.reg), - Int1 = Int0#sr{reg=Reg1}, - RK = fetch_var(K,Int0), - RV = fetch_reg(V,Reg1), - {{HasKsi,GetVsi,HasVarVsi,[[RK,RV]|GetVarVsi]},Int1} - end; - ({map_pair,Key,{var,V}},{{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) -> - case vdb_find(V, Vdb) of - {V,_,L} when L =< I -> - {{[Key|HasKsi],GetVsi,HasVarVsi,GetVarVsi},Int0}; - _Other -> - Reg1 = put_reg(V, Int0#sr.reg), - Int1 = Int0#sr{reg=Reg1}, - {{HasKsi,[Key,fetch_reg(V, Reg1)|GetVsi],HasVarVsi,GetVarVsi},Int1} - end - end, {{[],[],[],[]},Bef}, Vs), + {{HasKs,GetVs,HasVarKs,GetVarVs},Aft} = + foldr(fun(#k_map_pair{key=#k_var{name=K},val=#k_var{name=V}}, + {{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) -> + case vdb_find(V, Vdb) of + {V,_,L} when L =< I -> + RK = fetch_var(K,Int0), + {{HasKsi,GetVsi,[RK|HasVarVsi],GetVarVsi},Int0}; + _Other -> + Reg1 = put_reg(V, Int0#sr.reg), + Int1 = Int0#sr{reg=Reg1}, + RK = fetch_var(K,Int0), + RV = fetch_reg(V,Reg1), + {{HasKsi,GetVsi,HasVarVsi,[[RK,RV]|GetVarVsi]},Int1} + end; + (#k_map_pair{key=Key,val=#k_var{name=V}}, + {{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) -> + case vdb_find(V, Vdb) of + {V,_,L} when L =< I -> + {{[atomic(Key)|HasKsi],GetVsi,HasVarVsi,GetVarVsi},Int0}; + _Other -> + Reg1 = put_reg(V, Int0#sr.reg), + Int1 = Int0#sr{reg=Reg1}, + {{HasKsi,[atomic(Key),fetch_reg(V, Reg1)|GetVsi], + HasVarVsi,GetVarVsi},Int1} + end + end, {{[],[],[],[]},Bef}, Vs), Code = [{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}} || HasKs =/= []] ++ [{test,has_map_fields,{f,Fail},Rsrc,{list,[K]}} || K <- HasVarKs] ++ @@ -1015,7 +1442,7 @@ select_extract_map(Src, Vs, Fail, I, Vdb, Bef, St) -> {Code, Aft, St}. -select_extract_cons(Src, [{var,Hd}, {var,Tl}], I, Vdb, Bef, St) -> +select_extract_cons(Src, [#k_var{name=Hd}, #k_var{name=Tl}], I, Vdb, Bef, St) -> {Es,Aft} = case {vdb_find(Hd, Vdb), vdb_find(Tl, Vdb)} of {{_,_,Lhd}, {_,_,Ltl}} when Lhd =< I, Ltl =< I -> %% Both head and tail are dead. No need to generate @@ -1038,7 +1465,7 @@ select_extract_cons(Src, [{var,Hd}, {var,Tl}], I, Vdb, Bef, St) -> {Es,Aft,St}. -guard_clause_cg(#l{ke={guard_clause,G,B},vdb=Vdb}, Fail, Bef, St0) -> +guard_clause_cg(#k_guard_clause{anno=#l{vdb=Vdb},guard=G,body=B}, Fail, Bef, St0) -> {Gis,Int,St1} = guard_cg(G, Fail, Vdb, Bef, St0), {Bis,Aft,St} = match_cg(B, Fail, Int, St1), {Gis ++ Bis,Aft,St}. @@ -1051,11 +1478,11 @@ guard_clause_cg(#l{ke={guard_clause,G,B},vdb=Vdb}, Fail, Bef, St0) -> %% the correct exit point. Primops and tests all go to the next %% instruction on success or jump to a failure label. -guard_cg(#l{ke={protected,Ts,Rs},i=I,vdb=Pdb}, Fail, _Vdb, Bef, St) -> +guard_cg(#k_protected{arg=Ts,ret=Rs,anno=#l{i=I,vdb=Pdb}}, Fail, _Vdb, Bef, St) -> protected_cg(Ts, Rs, Fail, I, Pdb, Bef, St); -guard_cg(#l{ke={block,Ts},i=I,vdb=Bdb}, Fail, _Vdb, Bef, St) -> - guard_cg_list(Ts, Fail, I, Bdb, Bef, St); -guard_cg(#l{ke={test,Test,As,Inverted},i=I,vdb=_Tdb}, Fail, Vdb, Bef, St0) -> +guard_cg(#k_test{anno=#l{i=I},op=Test0,args=As,inverted=Inverted}, + Fail, Vdb, Bef, St0) -> + #k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Test}} = Test0, case Inverted of false -> test_cg(Test, As, Fail, I, Vdb, Bef, St0); @@ -1070,6 +1497,18 @@ guard_cg(G, _Fail, Vdb, Bef, St) -> %%ok = io:fwrite("cg ~w: ~p~n", [?LINE,{Aft}]), {Gis,Aft,St1}. +%% guard_cg_list([Kexpr], Fail, I, Vdb, StackReg, St) -> +%% {[Ainstr],StackReg,St}. + +guard_cg_list(Kes, Fail, I, Vdb, Bef, St0) -> + {Keis,{Aft,St1}} = + flatmapfoldl(fun (Ke, {Inta,Sta}) -> + {Keis,Intb,Stb} = + guard_cg(Ke, Fail, Vdb, Inta, Sta), + {Keis,{Intb,Stb}} + end, {Bef,St0}, need_heap(Kes, I)), + {Keis,Aft,St1}. + %% protected_cg([Kexpr], [Ret], Fail, I, Vdb, Bef, St) -> {[Ainstr],Aft,St}. %% Do a protected. Protecteds without return values are just done %% for effect, the return value is not checked, success passes on to @@ -1089,7 +1528,7 @@ protected_cg(Ts, Rs, _Fail, I, Vdb, Bef, St0) -> St2#cg{bfail=Pfail}), %%ok = io:fwrite("cg ~w: ~p~n", [?LINE,{Rs,I,Vdb,Aft}]), %% Set return values to false. - Mis = [{move,{atom,false},fetch_var(V,Aft)}||{var,V} <- Rs], + Mis = [{move,{atom,false},fetch_var(V,Aft)}||#k_var{name=V} <- Rs], {Tis ++ [{jump,{f,Psucc}}, {label,Pfail}] ++ Mis ++ [{label,Psucc}], Aft,St3#cg{bfail=St0#cg.bfail}}. @@ -1114,7 +1553,7 @@ test_cg(is_map, [A], Fail, I, Vdb, Bef, St) -> Arg = cg_reg_arg_prefer_y(A, Bef), Aft = clear_dead(Bef, I, Vdb), {[{test,is_map,{f,Fail},[Arg]}],Aft,St}; -test_cg(is_boolean, [{atom,Val}], Fail, I, Vdb, Bef, St) -> +test_cg(is_boolean, [#k_atom{val=Val}], Fail, I, Vdb, Bef, St) -> Aft = clear_dead(Bef, I, Vdb), Is = case is_boolean(Val) of true -> []; @@ -1126,18 +1565,6 @@ test_cg(Test, As, Fail, I, Vdb, Bef, St) -> Aft = clear_dead(Bef, I, Vdb), {[beam_utils:bif_to_test(Test, Args, {f,Fail})],Aft,St}. -%% guard_cg_list([Kexpr], Fail, I, Vdb, StackReg, St) -> -%% {[Ainstr],StackReg,St}. - -guard_cg_list(Kes, Fail, I, Vdb, Bef, St0) -> - {Keis,{Aft,St1}} = - flatmapfoldl(fun (Ke, {Inta,Sta}) -> - {Keis,Intb,Stb} = - guard_cg(Ke, Fail, Vdb, Inta, Sta), - {Keis,{Intb,Stb}} - end, {Bef,St0}, need_heap(Kes, I)), - {Keis,Aft,St1}. - %% match_fmf(Fun, LastFail, State, [Clause]) -> {Is,Aft,State}. %% This is a special flatmapfoldl for match code gen where we %% generate a "failure" label for each clause. The last clause uses @@ -1160,7 +1587,7 @@ match_fmf(F, LastFail, St0, [H|T]) -> %% frame size. Finally the actual call is made. Call then needs the %% return values filled in. -call_cg({var,_V} = Var, As, Rs, Le, Vdb, Bef, St0) -> +call_cg(#k_var{}=Var, As, Rs, Le, Vdb, Bef, St0) -> {Sis,Int} = cg_setup_call(As++[Var], Bef, Le#l.i, Vdb), %% Put return values in registers. Reg = load_vars(Rs, clear_regs(Int#sr.reg)), @@ -1169,9 +1596,8 @@ call_cg({var,_V} = Var, As, Rs, Le, Vdb, Bef, St0) -> {Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)), {Sis ++ Frees ++ [line(Le),{call_fun,Arity}],Aft, need_stack_frame(St0)}; -call_cg({remote,Mod,Name}, As, Rs, Le, Vdb, Bef, St0) - when element(1, Mod) =:= var; - element(1, Name) =:= var -> +call_cg(#k_remote{mod=Mod,name=Name}, As, Rs, Le, Vdb, Bef, St0) + when is_record(Mod, k_var); is_record(Name, k_var) -> {Sis,Int} = cg_setup_call(As++[Mod,Name], Bef, Le#l.i, Vdb), %% Put return values in registers. Reg = load_vars(Rs, clear_regs(Int#sr.reg)), @@ -1189,8 +1615,9 @@ call_cg(Func, As, Rs, Le, Vdb, Bef, St0) -> %% %% move {atom,ok} DestReg %% jump FailureLabel - {remote,{atom,erlang},{atom,error}} = Func, %Assertion. - [{var,DestVar}] = Rs, + #k_remote{mod=#k_atom{val=erlang}, + name=#k_atom{val=error}} = Func, %Assertion. + [#k_var{name=DestVar}] = Rs, Int0 = clear_dead(Bef, Le#l.i, Vdb), Reg = put_reg(DestVar, Int0#sr.reg), Int = Int0#sr{reg=Reg}, @@ -1209,11 +1636,11 @@ call_cg(Func, As, Rs, Le, Vdb, Bef, St0) -> {Sis ++ Frees ++ [line(Le)|Call],Aft,St1} end. -build_call({remote,{atom,erlang},{atom,'!'}}, 2, St0) -> +build_call(#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='!'}}, 2, St0) -> {[send],need_stack_frame(St0)}; -build_call({remote,{atom,Mod},{atom,Name}}, Arity, St0) -> +build_call(#k_remote{mod=#k_atom{val=Mod},name=#k_atom{val=Name}}, Arity, St0) -> {[{call_ext,Arity,{extfunc,Mod,Name,Arity}}],need_stack_frame(St0)}; -build_call(Name, Arity, St0) when is_atom(Name) -> +build_call(#k_local{name=Name}, Arity, St0) when is_atom(Name) -> {Lbl,St1} = local_func_label(Name, Arity, need_stack_frame(St0)), {[{call,Arity,{f,Lbl}}],St1}. @@ -1229,16 +1656,15 @@ free_dead([Any|Stk], Y, Instr, StkAcc) -> free_dead(Stk, Y+1, Instr, [Any|StkAcc]); free_dead([], _, Instr, StkAcc) -> {Instr,reverse(StkAcc)}. -enter_cg({var,_V} = Var, As, Le, Vdb, Bef, St0) -> +enter_cg(#k_var{} = Var, As, Le, Vdb, Bef, St0) -> {Sis,Int} = cg_setup_call(As++[Var], Bef, Le#l.i, Vdb), %% Build complete code and final stack/register state. Arity = length(As), {Sis ++ [line(Le),{call_fun,Arity},return], clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb), need_stack_frame(St0)}; -enter_cg({remote,Mod,Name}, As, Le, Vdb, Bef, St0) - when element(1, Mod) =:= var; - element(1, Name) =:= var -> +enter_cg(#k_remote{mod=Mod,name=Name}, As, Le, Vdb, Bef, St0) + when is_record(Mod, k_var); is_record(Name, k_var) -> {Sis,Int} = cg_setup_call(As++[Mod,Name], Bef, Le#l.i, Vdb), %% Build complete code and final stack/register state. Arity = length(As), @@ -1256,19 +1682,19 @@ enter_cg(Func, As, Le, Vdb, Bef, St0) -> clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb), St1}. -build_enter({remote,{atom,erlang},{atom,'!'}}, 2, St0) -> +build_enter(#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='!'}}, 2, St0) -> {[send,return],need_stack_frame(St0)}; -build_enter({remote,{atom,Mod},{atom,Name}}, Arity, St0) -> +build_enter(#k_remote{mod=#k_atom{val=Mod},name=#k_atom{val=Name}}, Arity, St0) -> St1 = case trap_bif(Mod, Name, Arity) of true -> need_stack_frame(St0); false -> St0 end, {[{call_ext_only,Arity,{extfunc,Mod,Name,Arity}}],St1}; -build_enter(Name, Arity, St0) when is_atom(Name) -> +build_enter(#k_local{name=Name}, Arity, St0) when is_atom(Name) -> {Lbl,St1} = local_func_label(Name, Arity, St0), {[{call_only,Arity,{f,Lbl}}],St1}. -enter_line({remote,{atom,Mod},{atom,Name}}, Arity, Le) -> +enter_line(#k_remote{mod=#k_atom{val=Mod},name=#k_atom{val=Name}}, Arity, Le) -> case erl_bifs:is_safe(Mod, Name, Arity) of false -> %% Tail-recursive call, possibly to a BIF. @@ -1316,17 +1742,28 @@ trap_bif(erlang, group_leader, 2) -> true; trap_bif(erlang, exit, 2) -> true; trap_bif(_, _, _) -> false. +%% bif_cg(#k_bif{}, Le, Vdb, StackReg, State) -> +%% {[Ainstr],StackReg,State}. +%% Generate code a BIF. + +bif_cg(#k_bif{op=#k_internal{name=Name},args=As,ret=Rs}, Le, Vdb, Bef, St) -> + internal_cg(Name, As, Rs, Le, Vdb, Bef, St); +bif_cg(#k_bif{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Name}}, + args=As,ret=Rs}, Le, Vdb, Bef, St) -> + Ar = length(As), + case is_gc_bif(Name, Ar) of + false -> + bif_cg(Name, As, Rs, Le, Vdb, Bef, St); + true -> + gc_bif_cg(Name, As, Rs, Le, Vdb, Bef, St) + end. + %% internal_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) -> %% {[Ainstr],StackReg,State}. internal_cg(bs_context_to_binary=Instr, [Src0], [], Le, Vdb, Bef, St0) -> [Src] = cg_reg_args([Src0], Bef), - case is_register(Src) of - false -> - {[],clear_dead(Bef, Le#l.i, Vdb), St0}; - true -> - {[{Instr,Src}],clear_dead(Bef, Le#l.i, Vdb), St0} - end; + {[{Instr,Src}],clear_dead(Bef, Le#l.i, Vdb), St0}; internal_cg(dsetelement, [Index0,Tuple0,New0], _Rs, Le, Vdb, Bef, St0) -> [New,Tuple,{integer,Index1}] = cg_reg_args([New0,Tuple0,Index0], Bef), Index = Index1-1, @@ -1334,8 +1771,8 @@ internal_cg(dsetelement, [Index0,Tuple0,New0], _Rs, Le, Vdb, Bef, St0) -> clear_dead(Bef, Le#l.i, Vdb), St0}; internal_cg(make_fun, [Func0,Arity0|As], Rs, Le, Vdb, Bef, St0) -> %% This behaves more like a function call. - {atom,Func} = Func0, - {integer,Arity} = Arity0, + #k_atom{val=Func} = Func0, + #k_int{val=Arity} = Arity0, {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb), Reg = load_vars(Rs, clear_regs(Int#sr.reg)), {FuncLbl,St1} = local_func_label(Func, Arity, St0), @@ -1348,6 +1785,11 @@ internal_cg(bs_init_writable=I, As, Rs, Le, Vdb, Bef, St) -> {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb), Reg = load_vars(Rs, clear_regs(Int#sr.reg)), {Sis++[I],clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb),St}; +internal_cg(build_stacktrace=I, As, Rs, Le, Vdb, Bef, St) -> + %% This behaves like a function call. + {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb), + Reg = load_vars(Rs, clear_regs(Int#sr.reg)), + {Sis++[I],clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb),St}; internal_cg(raise, As, Rs, Le, Vdb, Bef, St) -> %% raise can be treated like a guard BIF. bif_cg(raise, As, Rs, Le, Vdb, Bef, St). @@ -1355,7 +1797,7 @@ internal_cg(raise, As, Rs, Le, Vdb, Bef, St) -> %% bif_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) -> %% {[Ainstr],StackReg,State}. -bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) -> +bif_cg(Bif, As, [#k_var{name=V}], Le, Vdb, Bef, St0) -> Ars = cg_reg_args(As, Bef), %% If we are inside a catch and in a body (not in guard) and the @@ -1393,7 +1835,7 @@ bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) -> %% gc_bif_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) -> %% {[Ainstr],StackReg,State}. -gc_bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) -> +gc_bif_cg(Bif, As, [#k_var{name=V}], Le, Vdb, Bef, St0) -> Ars = cg_reg_args(As, Bef), %% If we are inside a catch and in a body (not in guard) and the @@ -1439,7 +1881,7 @@ recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, Vdb, Bef, St0) -> %% cg_recv_mesg( ) -> {[Ainstr],Aft,St}. -cg_recv_mesg({var,R}, Rm, Tl, Bef, St0) -> +cg_recv_mesg(#k_var{name=R}, Rm, Tl, Bef, St0) -> Int0 = Bef#sr{reg=put_reg(R, Bef#sr.reg)}, Ret = fetch_reg(R, Int0#sr.reg), %% Int1 = clear_dead(Int0, I, Rm#l.vdb), @@ -1449,22 +1891,22 @@ cg_recv_mesg({var,R}, Rm, Tl, Bef, St0) -> %% cg_recv_wait(Te, Tes, I, Vdb, Int2, St3) -> {[Ainstr],Aft,St}. -cg_recv_wait({atom,infinity}, Tes, I, Bef, St0) -> +cg_recv_wait(#k_atom{val=infinity}, #cg_block{anno=Le,es=Tes}, I, Bef, St0) -> %% We know that the 'after' body will never be executed. %% But to keep the stack and register information up to date, %% we will generate the code for the 'after' body, and then discard it. - Int1 = clear_dead(Bef, I, Tes#l.vdb), - {_,Int2,St1} = cg_block(Tes#l.ke, Tes#l.i, Tes#l.vdb, - Int1#sr{reg=clear_regs(Int1#sr.reg)}, St0), + Int1 = clear_dead(Bef, I, Le#l.vdb), + {_,Int2,St1} = cg_block(Tes, Le#l.i, Le#l.vdb, + Int1#sr{reg=clear_regs(Int1#sr.reg)}, St0), {[{wait,{f,St1#cg.recv}}],Int2,St1}; -cg_recv_wait({integer,0}, Tes, _I, Bef, St0) -> - {Tis,Int,St1} = cg_block(Tes#l.ke, Tes#l.i, Tes#l.vdb, Bef, St0), +cg_recv_wait(#k_int{val=0}, #cg_block{anno=Le,es=Tes}, _I, Bef, St0) -> + {Tis,Int,St1} = cg_block(Tes, Le#l.i, Le#l.vdb, Bef, St0), {[timeout|Tis],Int,St1}; -cg_recv_wait(Te, Tes, I, Bef, St0) -> +cg_recv_wait(Te, #cg_block{anno=Le,es=Tes}, I, Bef, St0) -> Reg = cg_reg_arg(Te, Bef), %% Must have empty registers here! Bug if anything in registers. - Int0 = clear_dead(Bef, I, Tes#l.vdb), - {Tis,Int,St1} = cg_block(Tes#l.ke, Tes#l.i, Tes#l.vdb, + Int0 = clear_dead(Bef, I, Le#l.vdb), + {Tis,Int,St1} = cg_block(Tes, Le#l.i, Le#l.vdb, Int0#sr{reg=clear_regs(Int0#sr.reg)}, St0), {[{wait_timeout,{f,St1#cg.recv},Reg},timeout] ++ Tis,Int,St1}. @@ -1482,7 +1924,7 @@ try_cg(Ta, Vs, Tb, Evs, Th, Rs, Le, Vdb, Bef, St0) -> {B,St1} = new_label(St0), %Body label {H,St2} = new_label(St1), %Handler label {E,St3} = new_label(St2), %End label - TryTag = Ta#l.i, + #l{i=TryTag} = get_kanno(Ta), Int1 = Bef#sr{stk=put_catch(TryTag, Bef#sr.stk)}, TryReg = fetch_stack({catch_tag,TryTag}, Int1#sr.stk), {Ais,Int2,St4} = cg(Ta, Vdb, Int1, St3#cg{break=B,in_catch=true}), @@ -1502,7 +1944,7 @@ try_cg(Ta, Vs, Tb, Evs, Th, Rs, Le, Vdb, Bef, St0) -> try_enter_cg(Ta, Vs, Tb, Evs, Th, Le, Vdb, Bef, St0) -> {B,St1} = new_label(St0), %Body label {H,St2} = new_label(St1), %Handler label - TryTag = Ta#l.i, + #l{i=TryTag} = get_kanno(Ta), Int1 = Bef#sr{stk=put_catch(TryTag, Bef#sr.stk)}, TryReg = fetch_stack({catch_tag,TryTag}, Int1#sr.stk), {Ais,Int2,St3} = cg(Ta, Vdb, Int1, St2#cg{break=B,in_catch=true}), @@ -1520,7 +1962,7 @@ try_enter_cg(Ta, Vs, Tb, Evs, Th, Le, Vdb, Bef, St0) -> %% catch_cg(CatchBlock, Ret, Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}. -catch_cg(C, {var,R}, Le, Vdb, Bef, St0) -> +catch_cg(#cg_block{es=C}, #k_var{name=R}, Le, Vdb, Bef, St0) -> {B,St1} = new_label(St0), CatchTag = Le#l.i, Int1 = Bef#sr{stk=put_catch(CatchTag, Bef#sr.stk)}, @@ -1534,8 +1976,8 @@ catch_cg(C, {var,R}, Le, Vdb, Bef, St0) -> clear_dead(Aft, Le#l.i, Vdb), St2#cg{break=St1#cg.break,in_catch=St1#cg.in_catch}}. -%% set_cg([Var], Constr, Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}. -%% We have to be careful how a 'set' works. First the structure is +%% put_cg([Var], Constr, Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}. +%% We have to be careful how a 'put' works. First the structure is %% built, then it is filled and finally things can be cleared. The %% annotation must reflect this and make sure that the return %% variable is allocated first. @@ -1543,13 +1985,14 @@ catch_cg(C, {var,R}, Le, Vdb, Bef, St0) -> %% put_list and put_map are atomic instructions, both of %% which can safely resuse one of the source registers as target. -set_cg([{var,R}], {cons,Es}, Le, Vdb, Bef, St) -> - [S1,S2] = cg_reg_args(Es, Bef), +put_cg([#k_var{name=R}], #k_cons{hd=Hd,tl=Tl}, Le, Vdb, Bef, St) -> + [S1,S2] = cg_reg_args([Hd,Tl], Bef), Int0 = clear_dead(Bef, Le#l.i, Vdb), Int1 = Int0#sr{reg=put_reg(R, Int0#sr.reg)}, Ret = fetch_reg(R, Int1#sr.reg), {[{put_list,S1,S2,Ret}], Int1, St}; -set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, #cg{bfail=Bfail}=St) -> +put_cg([#k_var{name=R}], #k_binary{segs=Segs}, Le, Vdb, Bef, + #cg{bfail=Bfail}=St) -> %% At run-time, binaries are constructed in three stages: %% 1) First the size of the binary is calculated. %% 2) Then the binary is allocated. @@ -1577,7 +2020,9 @@ set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, #cg{bfail=Bfail}=St) -> {Sis++Code,Aft,St}; %% Map: single variable key. -set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef, St0) -> +put_cg([#k_var{name=R}], #k_map{op=Op,var=Map, + es=[#k_map_pair{key=#k_var{}=K,val=V}]}, + Le, Vdb, Bef, St0) -> {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St0), SrcReg = cg_reg_arg_prefer_y(Map, Int0), @@ -1592,22 +2037,23 @@ set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef, St0) -> Aft = Aft0#sr{reg=put_reg(R, Aft0#sr.reg)}, Target = fetch_reg(R, Aft#sr.reg), - {Is,St1} = set_cg_map(Line, Op, SrcReg, Target, Live, List, St0), + {Is,St1} = put_cg_map(Line, Op, SrcReg, Target, Live, List, St0), {Sis++Is,Aft,St1}; %% Map: (possibly) multiple literal keys. -set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef, St0) -> +put_cg([#k_var{name=R}], #k_map{op=Op,var=Map,es=Es}, Le, Vdb, Bef, St0) -> %% assert key literals - [] = [Var||{map_pair,{var,_}=Var,_} <- Es], + [] = [Var || #k_map_pair{key=#k_var{}=Var} <- Es], {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St0), SrcReg = cg_reg_arg_prefer_y(Map, Int0), Line = line(Le#l.a), %% fetch registers for values to be put into the map - Pairs = [{K,V} || {_,K,V} <- Es], - List = flatmap(fun({K,V}) -> [K,cg_reg_arg(V,Int0)] end, Pairs), + List = flatmap(fun(#k_map_pair{key=K,val=V}) -> + [atomic(K),cg_reg_arg(V, Int0)] + end, Es), Live = max_reg(Bef#sr.reg), @@ -1616,16 +2062,16 @@ set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef, St0) -> Aft = Aft0#sr{reg=put_reg(R, Aft0#sr.reg)}, Target = fetch_reg(R, Aft#sr.reg), - {Is,St1} = set_cg_map(Line, Op, SrcReg, Target, Live, List, St0), + {Is,St1} = put_cg_map(Line, Op, SrcReg, Target, Live, List, St0), {Sis++Is,Aft,St1}; %% Everything else. -set_cg([{var,R}], Con, Le, Vdb, Bef, St) -> +put_cg([#k_var{name=R}], Con, Le, Vdb, Bef, St) -> %% Find a place for the return register first. Int = Bef#sr{reg=put_reg(R, Bef#sr.reg)}, Ret = fetch_reg(R, Int#sr.reg), Ais = case Con of - {tuple,Es} -> + #k_tuple{es=Es} -> [{put_tuple,length(Es),Ret}] ++ cg_build_args(Es, Bef); Other -> [{move,cg_reg_arg(Other, Int),Ret}] @@ -1633,7 +2079,7 @@ set_cg([{var,R}], Con, Le, Vdb, Bef, St) -> {Ais,clear_dead(Int, Le#l.i, Vdb),St}. -set_cg_map(Line, Op0, SrcReg, Target, Live, List, St0) -> +put_cg_map(Line, Op0, SrcReg, Target, Live, List, St0) -> Bfail = St0#cg.bfail, Fail = {f,St0#cg.bfail}, Op = case Op0 of @@ -1811,24 +2257,44 @@ cg_gen_binsize([], _, _, _, _, Acc) -> Acc. %% cg_bin_opt(Code0) -> Code %% Optimize the size calculations for binary construction. -cg_bin_opt([{move,Size,D},{bs_append,Fail,D,Extra,Regs,U,Bin,Flags,D}|Is]) -> - cg_bin_opt([{bs_append,Fail,Size,Extra,Regs,U,Bin,Flags,D}|Is]); -cg_bin_opt([{move,Size,D},{bs_private_append,Fail,D,U,Bin,Flags,D}|Is]) -> - cg_bin_opt([{bs_private_append,Fail,Size,U,Bin,Flags,D}|Is]); -cg_bin_opt([{move,{integer,0},D},{bs_add,_,[D,{integer,_}=S,1],Dst}|Is]) -> - cg_bin_opt([{move,S,Dst}|Is]); -cg_bin_opt([{move,{integer,0},D},{bs_add,Fail,[D,S,U],Dst}|Is]) -> - cg_bin_opt([{bs_add,Fail,[{integer,0},S,U],Dst}|Is]); -cg_bin_opt([{move,{integer,Bytes},D},{Op,Fail,D,Extra,Regs,Flags,D}|Is]) +cg_bin_opt([{move,S1,{x,X}=D},{gc_bif,Op,Fail,Live0,As,Dst}|Is]) -> + Live = if + X + 1 =:= Live0 -> X; + true -> Live0 + end, + [{gc_bif,Op,Fail,Live,As,D}|cg_bin_opt([{move,S1,Dst}|Is])]; +cg_bin_opt([{move,_,_}=I1,{Op,_,_,_}=I2|Is]) + when Op =:= bs_utf8_size orelse Op =:= bs_utf16_size -> + [I2|cg_bin_opt([I1|Is])]; +cg_bin_opt([{bs_add,_,[{integer,0},Src,1],Dst}|Is]) -> + cg_bin_opt_1([{move,Src,Dst}|Is]); +cg_bin_opt([{bs_add,_,[Src,{integer,0},_],Dst}|Is]) -> + cg_bin_opt_1([{move,Src,Dst}|Is]); +cg_bin_opt(Is) -> + cg_bin_opt_1(Is). + +cg_bin_opt_1([{move,Size,D},{bs_append,Fail,D,Extra,Regs,U,Bin,Flags,D}|Is]) -> + [{bs_append,Fail,Size,Extra,Regs,U,Bin,Flags,D}|cg_bin_opt(Is)]; +cg_bin_opt_1([{move,Size,D},{bs_private_append,Fail,D,U,Bin,Flags,D}|Is]) -> + [{bs_private_append,Fail,Size,U,Bin,Flags,D}|cg_bin_opt(Is)]; +cg_bin_opt_1([{move,Size,D},{Op,Fail,D,Extra,Regs,Flags,D}|Is]) when Op =:= bs_init2; Op =:= bs_init_bits -> - cg_bin_opt([{Op,Fail,Bytes,Extra,Regs,Flags,D}|Is]); -cg_bin_opt([{move,Src1,Dst},{bs_add,Fail,[Dst,Src2,U],Dst}|Is]) -> - cg_bin_opt([{bs_add,Fail,[Src1,Src2,U],Dst}|Is]); -cg_bin_opt([I|Is]) -> + Bytes = case Size of + {integer,Int} -> Int; + _ -> Size + end, + [{Op,Fail,Bytes,Extra,Regs,Flags,D}|cg_bin_opt(Is)]; +cg_bin_opt_1([{move,S1,D},{bs_add,Fail,[D,S2,U],Dst}|Is]) -> + cg_bin_opt([{bs_add,Fail,[S1,S2,U],Dst}|Is]); +cg_bin_opt_1([{move,S1,D},{bs_add,Fail,[S2,D,U],Dst}|Is]) -> + cg_bin_opt([{bs_add,Fail,[S2,S1,U],Dst}|Is]); +cg_bin_opt_1([I|Is]) -> [I|cg_bin_opt(Is)]; -cg_bin_opt([]) -> []. +cg_bin_opt_1([]) -> + []. -cg_bin_put({bin_seg,[],S0,U,T,Fs,[E0,Next]}, Fail, Bef) -> +cg_bin_put(#k_bin_seg{size=S0,unit=U,type=T,flags=Fs,seg=E0,next=Next}, + Fail, Bef) -> S1 = cg_reg_arg(S0, Bef), E1 = cg_reg_arg(E0, Bef), {Format,Op} = case T of @@ -1845,7 +2311,7 @@ cg_bin_put({bin_seg,[],S0,U,T,Fs,[E0,Next]}, Fail, Bef) -> utf -> [{Op,Fail,{field_flags,Fs},E1}|cg_bin_put(Next, Fail, Bef)] end; -cg_bin_put({bin_end,[]}, _, _) -> []. +cg_bin_put(#k_bin_end{}, _, _) -> []. cg_build_args(As, Bef) -> [{put,cg_reg_arg(A, Bef)} || A <- As]. @@ -1865,13 +2331,12 @@ break_cg(Bs, Le, Vdb, Bef, St) -> {Ms ++ [{jump,{f,St#cg.break}}], Int#sr{reg=clear_regs(Int#sr.reg)},St}. -guard_break_cg(Bs, Locked, #l{i=I}, Vdb, #sr{reg=Reg0}=Bef, St) -> - RegLocked = get_locked_regs(Reg0, Locked), - #sr{reg=Reg1} = Int = clear_dead(Bef#sr{reg=RegLocked}, I, Vdb), +guard_break_cg(Bs, #l{i=I}, Vdb, #sr{reg=Reg0}=Bef, St) -> + #sr{reg=Reg1} = Int = clear_dead(Bef, I, Vdb), Reg2 = trim_free(Reg1), NumLocked = length(Reg2), Moves0 = gen_moves(Bs, Bef, NumLocked, []), - Moves = order_moves(Moves0, find_scratch_reg(RegLocked)), + Moves = order_moves(Moves0, find_scratch_reg(Reg0)), {BreakVars,_} = mapfoldl(fun(_, RegNum) -> {{RegNum,gbreakvar},RegNum+1} end, length(Reg2), Bs), @@ -1879,31 +2344,17 @@ guard_break_cg(Bs, Locked, #l{i=I}, Vdb, #sr{reg=Reg0}=Bef, St) -> Aft = Int#sr{reg=Reg}, {Moves ++ [{jump,{f,St#cg.break}}],Aft,St}. -get_locked_regs([R|Rs0], Preserve) -> - case {get_locked_regs(Rs0, Preserve),R} of - {[],{_,V}} -> - case lists:member(V, Preserve) of - true -> [R]; - false -> [] - end; - {[],_} -> - []; - {Rs,_} -> - [R|Rs] - end; -get_locked_regs([], _) -> []. - %% cg_reg_arg(Arg0, Info) -> Arg %% cg_reg_args([Arg0], Info) -> [Arg] %% Convert argument[s] into registers. Literal values are returned unchanged. cg_reg_args(As, Bef) -> [cg_reg_arg(A, Bef) || A <- As]. -cg_reg_arg({var,V}, Bef) -> fetch_var(V, Bef); -cg_reg_arg(Literal, _) -> Literal. +cg_reg_arg(#k_var{name=V}, Bef) -> fetch_var(V, Bef); +cg_reg_arg(Literal, _) -> atomic(Literal). -cg_reg_arg_prefer_y({var,V}, Bef) -> fetch_var_prefer_y(V, Bef); -cg_reg_arg_prefer_y(Literal, _) -> Literal. +cg_reg_arg_prefer_y(#k_var{name=V}, Bef) -> fetch_var_prefer_y(V, Bef); +cg_reg_arg_prefer_y(Literal, _) -> atomic(Literal). %% cg_setup_call([Arg], Bef, Cur, Vdb) -> {[Instr],Aft}. %% Do the complete setup for a call/enter. @@ -1941,9 +2392,9 @@ cg_call_args(As, Bef, I, Vdb) -> load_arg_regs(Regs, As) -> load_arg_regs(Regs, As, 0). -load_arg_regs([_|Rs], [{var,V}|As], I) -> [{I,V}|load_arg_regs(Rs, As, I+1)]; +load_arg_regs([_|Rs], [#k_var{name=V}|As], I) -> [{I,V}|load_arg_regs(Rs, As, I+1)]; load_arg_regs([_|Rs], [A|As], I) -> [{I,A}|load_arg_regs(Rs, As, I+1)]; -load_arg_regs([], [{var,V}|As], I) -> [{I,V}|load_arg_regs([], As, I+1)]; +load_arg_regs([], [#k_var{name=V}|As], I) -> [{I,V}|load_arg_regs([], As, I+1)]; load_arg_regs([], [A|As], I) -> [{I,A}|load_arg_regs([], As, I+1)]; load_arg_regs(Rs, [], _) -> Rs. @@ -1979,12 +2430,13 @@ move_unsaved([], _, Regs, Acc) -> {Acc,Regs}. gen_moves(As, Sr) -> gen_moves(As, Sr, 0, []). -gen_moves([{var,V}|As], Sr, I, Acc) -> +gen_moves([#k_var{name=V}|As], Sr, I, Acc) -> case fetch_var(V, Sr) of {x,I} -> gen_moves(As, Sr, I+1, Acc); Reg -> gen_moves(As, Sr, I+1, [{move,Reg,{x,I}}|Acc]) end; -gen_moves([A|As], Sr, I, Acc) -> +gen_moves([A0|As], Sr, I, Acc) -> + A = atomic(A0), gen_moves(As, Sr, I+1, [{move,A,{x,I}}|Acc]); gen_moves([], _, _, Acc) -> lists:keysort(3, Acc). @@ -2032,21 +2484,21 @@ break_up_cycle1(Dst, [M|Path], LastMove) -> %% clear_dead(Sr, Until, Vdb) -> Aft. %% Remove all variables in Sr which have died AT ALL so far. -clear_dead(Sr, Until, Vdb) -> - Sr#sr{reg=clear_dead_reg(Sr, Until, Vdb), - stk=clear_dead_stk(Sr#sr.stk, Until, Vdb)}. +clear_dead(#sr{stk=Stk}=Sr0, Until, Vdb) -> + Sr = Sr0#sr{reg=clear_dead_reg(Sr0, Until, Vdb), + stk=clear_dead_stk(Stk, Until, Vdb)}, + reserve(Sr). clear_dead_reg(Sr, Until, Vdb) -> - Reg = [case R of - {_I,V} = IV -> - case vdb_find(V, Vdb) of - {V,_,L} when L > Until -> IV; - _ -> free %Remove anything else - end; - {reserved,_I,_V} = Reserved -> Reserved; - free -> free - end || R <- Sr#sr.reg], - reserve(Sr#sr.res, Reg, Sr#sr.stk). + [case R of + {_I,V} = IV -> + case vdb_find(V, Vdb) of + {V,_,L} when L > Until -> IV; + _ -> free %Remove anything else + end; + {reserved,_I,_V}=Reserved -> Reserved; + free -> free + end || R <- Sr#sr.reg]. clear_dead_stk(Stk, Until, Vdb) -> [case S of @@ -2118,16 +2570,25 @@ adjust_stack(Bef, Fb, Lf, Vdb) -> save_stack(Stk0, Fb, Lf, Vdb) -> %% New variables that are in use but not on stack. - New = [VFL || {V,F,L} = VFL <- Vdb, - F < Fb, - L >= Lf, - not on_stack(V, Stk0)], + New = new_not_on_stack(Stk0, Fb, Lf, Vdb), + %% Add new variables that are not just dropped immediately. %% N.B. foldr works backwards from the end!! Saves = [V || {V,_,_} <- keysort(3, New)], Stk1 = foldr(fun (V, Stk) -> put_stack(V, Stk) end, Stk0, Saves), {Stk1,Saves}. +%% new_not_on_stack(Stack, FirstBefore, LastFrom, Vdb) -> +%% [{Variable,First,Last}] +%% Return information about all variables that are used past current +%% point and that are not already on the stack. + +new_not_on_stack(Stk, Fb, Lf, Vdb) -> + [VFL || {V,F,L} = VFL <- Vdb, + F < Fb, + L >= Lf, + not on_stack(V, Stk)]. + %% saves([SaveVar], Reg, Stk) -> [{move,Reg,Stk}]. %% Generate move instructions to save variables onto stack. The %% stack/reg info used is that after the new stack has been made. @@ -2153,7 +2614,7 @@ fetch_var_prefer_y(V, #sr{reg=Reg,stk=Stk}) -> end. load_vars(Vs, Regs) -> - foldl(fun ({var,V}, Rs) -> put_reg(V, Rs) end, Regs, Vs). + foldl(fun (#k_var{name=V}, Rs) -> put_reg(V, Rs) end, Regs, Vs). %% put_reg(Val, Regs) -> Regs. %% find_reg(Val, Regs) -> {ok,r{R}} | error. @@ -2233,10 +2694,6 @@ find_stack(_, [], _) -> error. on_stack(V, Stk) -> keymember(V, 1, Stk). -is_register({x,_}) -> true; -is_register({yy,_}) -> true; -is_register(_) -> false. - %% put_catch(CatchTag, Stack) -> Stack' %% drop_catch(CatchTag, Stack) -> Stack' %% Special interface for putting and removing catch tags, to ensure that @@ -2254,6 +2711,16 @@ put_catch(Tag, [Other|Stk], Acc) -> drop_catch(Tag, [{{catch_tag,Tag}}|Stk]) -> [free|Stk]; drop_catch(Tag, [Other|Stk]) -> [Other|drop_catch(Tag, Stk)]. +%% atomic(Klit) -> Lit. +%% atomic_list([Klit]) -> [Lit]. + +atomic(#k_literal{val=V}) -> {literal,V}; +atomic(#k_int{val=I}) -> {integer,I}; +atomic(#k_float{val=F}) -> {float,F}; +atomic(#k_atom{val=A}) -> {atom,A}; +%%atomic(#k_char{val=C}) -> {char,C}; +atomic(#k_nil{}) -> nil. + %% new_label(St) -> {L,St}. new_label(#cg{lcount=Next}=St) -> @@ -2296,3 +2763,86 @@ flatmapfoldl(F, Accu0, [Hd|Tail]) -> {Rs,Accu2} = flatmapfoldl(F, Accu1, Tail), {R++Rs,Accu2}; flatmapfoldl(_, Accu, []) -> {[],Accu}. + +%% Keep track of life time for variables. +%% +%% init_vars([{var,VarName}]) -> Vdb. +%% new_vars([VarName], I, Vdb) -> Vdb. +%% use_vars([VarName], I, Vdb) -> Vdb. +%% add_var(VarName, F, L, Vdb) -> Vdb. +%% +%% The list of variable names for new_vars/3 and use_vars/3 +%% must be sorted. + +init_vars(Vs) -> + vdb_new(Vs). + +new_vars([], _, Vdb) -> Vdb; +new_vars([V], I, Vdb) -> vdb_store_new(V, {V,I,I}, Vdb); +new_vars(Vs, I, Vdb) -> vdb_update_vars(Vs, Vdb, I). + +use_vars([], _, Vdb) -> + Vdb; +use_vars([V], I, Vdb) -> + case vdb_find(V, Vdb) of + {V,F,L} when I > L -> vdb_update(V, {V,F,I}, Vdb); + {V,_,_} -> Vdb; + error -> vdb_store_new(V, {V,I,I}, Vdb) + end; +use_vars(Vs, I, Vdb) -> vdb_update_vars(Vs, Vdb, I). + +add_var(V, F, L, Vdb) -> + vdb_store_new(V, {V,F,L}, Vdb). + +%% vdb + +vdb_new(Vs) -> + ordsets:from_list([{V,0,0} || #k_var{name=V} <- Vs]). + +-type var() :: atom(). + +-spec vdb_find(var(), [vdb_entry()]) -> 'error' | vdb_entry(). + +vdb_find(V, Vdb) -> + case lists:keyfind(V, 1, Vdb) of + false -> error; + Vd -> Vd + end. + +vdb_update(V, Update, [{V,_,_}|Vdb]) -> + [Update|Vdb]; +vdb_update(V, Update, [Vd|Vdb]) -> + [Vd|vdb_update(V, Update, Vdb)]. + +vdb_store_new(V, New, [{V1,_,_}=Vd|Vdb]) when V > V1 -> + [Vd|vdb_store_new(V, New, Vdb)]; +vdb_store_new(V, New, [{V1,_,_}|_]=Vdb) when V < V1 -> + [New|Vdb]; +vdb_store_new(_, New, []) -> [New]. + +vdb_update_vars([V|_]=Vs, [{V1,_,_}=Vd|Vdb], I) when V > V1 -> + [Vd|vdb_update_vars(Vs, Vdb, I)]; +vdb_update_vars([V|Vs], [{V1,_,_}|_]=Vdb, I) when V < V1 -> + %% New variable. + [{V,I,I}|vdb_update_vars(Vs, Vdb, I)]; +vdb_update_vars([V|Vs], [{_,F,L}=Vd|Vdb], I) -> + %% Existing variable. + if + I > L -> [{V,F,I}|vdb_update_vars(Vs, Vdb, I)]; + true -> [Vd|vdb_update_vars(Vs, Vdb, I)] + end; +vdb_update_vars([V|Vs], [], I) -> + %% New variable. + [{V,I,I}|vdb_update_vars(Vs, [], I)]; +vdb_update_vars([], Vdb, _) -> Vdb. + +%% vdb_sub(Min, Max, Vdb) -> Vdb. +%% Extract variables which are used before and after Min. Lock +%% variables alive after Max. + +vdb_sub(Min, Max, Vdb) -> + [ if L >= Max -> {V,F,locked}; + true -> Vd + end || {V,F,L}=Vd <- Vdb, + F < Min, + L >= Min ]. diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index ae650546e5..6029b91cdc 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -920,8 +920,9 @@ try_exception(Ecs0, St0) -> %% Note that Tag is not needed for rethrow - it is already in Info. {Evs,St1} = new_vars(3, St0), % Tag, Value, Info {Ecs1,Ceps,St2} = clauses(Ecs0, St1), + Ecs2 = try_build_stacktrace(Ecs1, hd(Evs)), [_,Value,Info] = Evs, - LA = case Ecs1 of + LA = case Ecs2 of [] -> []; [C|_] -> get_lineno_anno(C) end, @@ -930,7 +931,7 @@ try_exception(Ecs0, St0) -> body=[#iprimop{anno=#a{}, %Must have an #a{} name=#c_literal{val=raise}, args=[Info,Value]}]}, - Hs = [#icase{anno=#a{anno=LA},args=[c_tuple(Evs)],clauses=Ecs1,fc=Ec}], + Hs = [#icase{anno=#a{anno=LA},args=[c_tuple(Evs)],clauses=Ecs2,fc=Ec}], {Evs,Ceps++Hs,St2}. try_after(As, St0) -> @@ -946,6 +947,25 @@ try_after(As, St0) -> Hs = [#icase{anno=#a{},args=[c_tuple(Evs)],clauses=[],fc=Ec}], {Evs,Hs,St1}. +try_build_stacktrace([#iclause{pats=Ps0,body=B0}=C0|Cs], RawStk) -> + [#c_tuple{es=[Class,Exc,Stk]}=Tup] = Ps0, + case Stk of + #c_var{name='_'} -> + %% Stacktrace variable is not used. Nothing to do. + [C0|try_build_stacktrace(Cs, RawStk)]; + _ -> + %% Add code to build the stacktrace. + Ps = [Tup#c_tuple{es=[Class,Exc,RawStk]}], + Call = #iprimop{anno=#a{}, + name=#c_literal{val=build_stacktrace}, + args=[RawStk]}, + Iset = #iset{var=Stk,arg=Call}, + B = [Iset|B0], + C = C0#iclause{pats=Ps,body=B}, + [C|try_build_stacktrace(Cs, RawStk)] + end; +try_build_stacktrace([], _) -> []. + %% expr_bin([ArgExpr], St) -> {[Arg],[PreExpr],St}. %% Flatten the arguments of a bin. Do this straight left to right! %% Note that ibinary needs to have its annotation wrapped in a #a{} @@ -2462,9 +2482,11 @@ cexpr(#icase{anno=A,args=Largs,clauses=Lcs,fc=Lfc}, As, St0) -> cexpr(#ireceive1{anno=A,clauses=Lcs}, As, St0) -> Exp = intersection(A#a.ns, As), %Exports {Ccs,St1} = cclauses(Lcs, Exp, St0), + True = #c_literal{val=true}, + Action = core_lib:make_values(lists:duplicate(1+length(Exp), True)), {#c_receive{anno=A#a.anno, clauses=Ccs, - timeout=#c_literal{val=infinity},action=#c_literal{val=true}}, + timeout=#c_literal{val=infinity},action=Action}, Exp,A#a.us,St1}; cexpr(#ireceive2{anno=A,clauses=Lcs,timeout=Lto,action=Les}, As, St0) -> Exp = intersection(A#a.ns, As), %Exports @@ -2505,8 +2527,46 @@ cexpr(#ifun{anno=#a{us=Us0}=A0,name={named,Name},fc=#iclause{pats=Ps}}=Fun0, end; cexpr(#iapply{anno=A,op=Op,args=Args}, _As, St) -> {#c_apply{anno=A#a.anno,op=Op,args=Args},[],A#a.us,St}; -cexpr(#icall{anno=A,module=Mod,name=Name,args=Args}, _As, St) -> - {#c_call{anno=A#a.anno,module=Mod,name=Name,args=Args},[],A#a.us,St}; +cexpr(#icall{anno=A,module=Mod,name=Name,args=Args}, _As, St0) -> + Anno = A#a.anno, + case (not cerl:is_c_atom(Mod)) andalso member(tuple_calls, St0#core.opts) of + true -> + GenAnno = [compiler_generated|Anno], + + %% Generate the clause that matches on the tuple + {TupleVar,St1} = new_var(GenAnno, St0), + {TupleSizeVar, St2} = new_var(GenAnno, St1), + {TupleModVar, St3} = new_var(GenAnno, St2), + {TupleArgsVar, St4} = new_var(GenAnno, St3), + TryVar = cerl:c_var('Try'), + + TupleGuardExpr = + cerl:c_let([TupleSizeVar], + c_call_erl(tuple_size, [TupleVar]), + c_call_erl('>', [TupleSizeVar, cerl:c_int(0)])), + + TupleGuard = + cerl:c_try(TupleGuardExpr, [TryVar], TryVar, + [cerl:c_var('T'),cerl:c_var('R')], cerl:c_atom(false)), + + TupleApply = + cerl:c_let([TupleModVar], + c_call_erl(element, [cerl:c_int(1),TupleVar]), + cerl:c_let([TupleArgsVar], + cerl:make_list(Args ++ [TupleVar]), + c_call_erl(apply, [TupleModVar,Name,TupleArgsVar]))), + + TupleClause = cerl:ann_c_clause(GenAnno, [TupleVar], TupleGuard, TupleApply), + + %% Generate the fallback clause + {OtherVar,St5} = new_var(GenAnno, St4), + OtherApply = cerl:ann_c_call(GenAnno, OtherVar, Name, Args), + OtherClause = cerl:ann_c_clause(GenAnno, [OtherVar], OtherApply), + + {cerl:ann_c_case(GenAnno, Mod, [TupleClause,OtherClause]),[],A#a.us,St5}; + false -> + {#c_call{anno=Anno,module=Mod,name=Name,args=Args},[],A#a.us,St0} + end; cexpr(#iprimop{anno=A,name=Name,args=Args}, _As, St) -> {#c_primop{anno=A#a.anno,name=Name,args=Args},[],A#a.us,St}; cexpr(#iprotect{anno=A,body=Es}, _As, St0) -> @@ -2536,6 +2596,9 @@ cfun(#ifun{anno=A,id=Id,vars=Args,clauses=Lcs,fc=Lfc}, _As, St0) -> clauses=Ccs ++ [Cfc]}}, [],A#a.us,St2}. +c_call_erl(Fun, Args) -> + cerl:c_call(cerl:c_atom(erlang), cerl:c_atom(Fun), Args). + %% lit_vars(Literal) -> [Var]. lit_vars(Lit) -> lit_vars(Lit, []). diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 1fc05109c5..fd73e5a7dc 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -82,7 +82,8 @@ -export([module/2,format_error/1]). -import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2, - keymember/3,keyfind/3,partition/2,droplast/1,last/1,sort/1]). + keymember/3,keyfind/3,partition/2,droplast/1,last/1,sort/1, + reverse/1]). -import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]). -import(cerl, [c_tuple/1]). @@ -107,6 +108,7 @@ copy_anno(Kdst, Ksrc) -> -record(iclause, {anno=[],isub,osub,pats,guard,body}). -record(ireceive_accept, {anno=[],arg}). -record(ireceive_next, {anno=[],arg}). +-record(ignored, {anno=[]}). -type warning() :: term(). % XXX: REFINE @@ -159,11 +161,9 @@ function({#c_var{name={F,Arity}=FA},Body}, St0) -> {#ifun{anno=Ab,vars=Kvs,body=B0},[],St2} = expr(Body, new_sub(), St1), {B1,_,St3} = ubody(B0, return, St2), %%B1 = B0, St3 = St2, %Null second pass - {#k_fdef{anno=#k{us=[],ns=[],a=Ab}, - func=F,arity=Arity,vars=Kvs,body=B1},St3} + {make_fdef(#k{us=[],ns=[],a=Ab}, F, Arity, Kvs, B1),St3} catch - Class:Error -> - Stack = erlang:get_stacktrace(), + Class:Error:Stack -> io:fwrite("Function: ~w/~w\n", [F,Arity]), erlang:raise(Class, Error, Stack) end. @@ -489,7 +489,7 @@ make_alt(First0, Then0) -> Then1 = pre_seq(droplast(Then0), last(Then0)), First2 = make_protected(First1), Then2 = make_protected(Then1), - Body = #k_atom{val=ignored}, + Body = #ignored{}, First3 = #k_guard_clause{guard=First2,body=Body}, Then3 = #k_guard_clause{guard=Then2,body=Body}, First = #k_guard{clauses=[First3]}, @@ -1589,23 +1589,18 @@ match_var([U|Us], Cs0, Def, St) -> %% according to type, the order is really irrelevant but tries to be %% smart. -match_con(Us, [C], Def, St) -> - %% There is only one clause. We can keep literal tuples and - %% lists, but we must convert []/integer/float/atom literals - %% to the proper record (#k_nil{} and so on). - Cs = [expand_pat_lit_clause(C, false)], - match_con_1(Us, Cs, Def, St); match_con(Us, Cs0, Def, St) -> - %% More than one clause. Remove literals at the top level. - Cs = [expand_pat_lit_clause(C, true) || C <- Cs0], + %% Expand literals at the top level. + Cs = [expand_pat_lit_clause(C) || C <- Cs0], match_con_1(Us, Cs, Def, St). match_con_1([U|_Us] = L, Cs, Def, St0) -> %% Extract clauses for different constructors (types). %%ok = io:format("match_con ~p~n", [Cs]), - Ttcs = select_types([k_binary], Cs) ++ select_bin_con(Cs) ++ - select_types([k_cons,k_tuple,k_map,k_atom,k_float,k_int, - k_nil,k_literal], Cs), + Ttcs0 = select_types([k_binary], Cs) ++ select_bin_con(Cs) ++ + select_types([k_cons,k_tuple,k_map,k_atom,k_float, + k_int,k_nil], Cs), + Ttcs = opt_single_valued(Ttcs0), %%ok = io:format("ttcs = ~p~n", [Ttcs]), {Scs,St1} = mapfoldl(fun ({T,Tcs}, St) -> @@ -1618,28 +1613,14 @@ match_con_1([U|_Us] = L, Cs, Def, St0) -> select_types(Types, Cs) -> [{T,Tcs} || T <- Types, begin Tcs = select(T, Cs), Tcs =/= [] end]. - -expand_pat_lit_clause(#iclause{pats=[#ialias{pat=#k_literal{anno=A,val=Val}}=Alias|Ps]}=C, B) -> - P = case B of - true -> expand_pat_lit(Val, A); - false -> literal(Val, A) - end, + +expand_pat_lit_clause(#iclause{pats=[#ialias{pat=#k_literal{anno=A,val=Val}}=Alias|Ps]}=C) -> + P = expand_pat_lit(Val, A), C#iclause{pats=[Alias#ialias{pat=P}|Ps]}; -expand_pat_lit_clause(#iclause{pats=[#k_literal{anno=A,val=Val}|Ps]}=C, B) -> - P = case B of - true -> expand_pat_lit(Val, A); - false -> literal(Val, A) - end, +expand_pat_lit_clause(#iclause{pats=[#k_literal{anno=A,val=Val}|Ps]}=C) -> + P = expand_pat_lit(Val, A), C#iclause{pats=[P|Ps]}; -expand_pat_lit_clause(#iclause{pats=[#k_binary{anno=A,segs=#k_bin_end{}}|Ps]}=C, B) -> - case B of - true -> - C; - false -> - P = #k_literal{anno=A,val = <<>>}, - C#iclause{pats=[P|Ps]} - end; -expand_pat_lit_clause(C, _) -> C. +expand_pat_lit_clause(C) -> C. expand_pat_lit([H|T], A) -> #k_cons{anno=A,hd=literal(H, A),tl=literal(T, A)}; @@ -1659,6 +1640,107 @@ literal(Val, A) when is_atom(Val) -> literal(Val, A) when is_list(Val); is_tuple(Val) -> #k_literal{anno=A,val=Val}. +%% opt_singled_valued([{Type,Clauses}]) -> [{Type,Clauses}]. +%% If a type only has one clause and if the pattern is literal, +%% the matching can be done more efficiently by directly comparing +%% with the literal (that is especially true for binaries). + +opt_single_valued(Ttcs) -> + opt_single_valued(Ttcs, [], []). + +opt_single_valued([{_,[#iclause{pats=[P0|Ps]}=Tc]}=Ttc|Ttcs], TtcAcc, LitAcc) -> + try combine_lit_pat(P0) of + P -> + LitTtc = Tc#iclause{pats=[P|Ps]}, + opt_single_valued(Ttcs, TtcAcc, [LitTtc|LitAcc]) + catch + not_possible -> + opt_single_valued(Ttcs, [Ttc|TtcAcc], LitAcc) + end; +opt_single_valued([Ttc|Ttcs], TtcAcc, LitAcc) -> + opt_single_valued(Ttcs, [Ttc|TtcAcc], LitAcc); +opt_single_valued([], TtcAcc, []) -> + reverse(TtcAcc); +opt_single_valued([], TtcAcc, LitAcc) -> + Literals = {k_literal,reverse(LitAcc)}, + %% Test the literals as early as possible. + case reverse(TtcAcc) of + [{k_binary,_}=Bin|Ttcs] -> + %% The delayed creation of sub binaries requires + %% bs_start_match2 to be the first instruction in the + %% function. + [Bin,Literals|Ttcs]; + Ttcs -> + [Literals|Ttcs] + end. + +combine_lit_pat(#ialias{pat=Pat0}=Alias) -> + Pat = combine_lit_pat(Pat0), + Alias#ialias{pat=Pat}; +combine_lit_pat(Pat) -> + case do_combine_lit_pat(Pat) of + #k_literal{val=Val} when is_atom(Val) -> + throw(not_possible); + #k_literal{val=Val} when is_number(Val) -> + throw(not_possible); + #k_literal{val=[]} -> + throw(not_possible); + #k_literal{}=Lit -> + Lit + end. + +do_combine_lit_pat(#k_atom{anno=A,val=Val}) -> + #k_literal{anno=A,val=Val}; +do_combine_lit_pat(#k_float{anno=A,val=Val}) -> + #k_literal{anno=A,val=Val}; +do_combine_lit_pat(#k_int{anno=A,val=Val}) -> + #k_literal{anno=A,val=Val}; +do_combine_lit_pat(#k_nil{anno=A}) -> + #k_literal{anno=A,val=[]}; +do_combine_lit_pat(#k_binary{anno=A,segs=Segs}) -> + Bin = combine_bin_segs(Segs), + #k_literal{anno=A,val=Bin}; +do_combine_lit_pat(#k_cons{anno=A,hd=Hd0,tl=Tl0}) -> + #k_literal{val=Hd} = do_combine_lit_pat(Hd0), + #k_literal{val=Tl} = do_combine_lit_pat(Tl0), + #k_literal{anno=A,val=[Hd|Tl]}; +do_combine_lit_pat(#k_literal{}=Lit) -> + Lit; +do_combine_lit_pat(#k_tuple{anno=A,es=Es0}) -> + Es = [begin + #k_literal{val=Lit} = do_combine_lit_pat(El), + Lit + end || El <- Es0], + #k_literal{anno=A,val=list_to_tuple(Es)}; +do_combine_lit_pat(_) -> + throw(not_possible). + +combine_bin_segs(#k_bin_seg{size=Size0,unit=Unit,type=integer, + flags=[unsigned,big],seg=Seg,next=Next}) -> + #k_literal{val=Size1} = do_combine_lit_pat(Size0), + #k_literal{val=Int} = do_combine_lit_pat(Seg), + Size = Size1 * Unit, + if + 0 < Size, Size < 64 -> + Bin = <<Int:Size>>, + case Bin of + <<Int:Size>> -> + NextBin = combine_bin_segs(Next), + <<Bin/bits,NextBin/bits>>; + _ -> + %% The integer Int does not fit in the segment, + %% thus it will not match. + throw(not_possible) + end; + true -> + %% Avoid creating huge binary literals. + throw(not_possible) + end; +combine_bin_segs(#k_bin_end{}) -> + <<>>; +combine_bin_segs(_) -> + throw(not_possible). + %% select_bin_con([Clause]) -> [{Type,[Clause]}]. %% Extract clauses for the k_bin_seg constructor. As k_bin_seg %% matching can overlap, the k_bin_seg constructors cannot be @@ -2143,7 +2225,9 @@ ubody(E, return, St0) -> {Ea,Pa,St1} = force_atomic(E, St0), ubody(pre_seq(Pa, #ivalues{args=[Ea]}), return, St1) end; -ubody(E, {break,_Rs} = Break, St0) -> +ubody(#ignored{}, {break,_} = Break, St) -> + ubody(#ivalues{args=[]}, Break, St); +ubody(E, {break,[_]} = Break, St0) -> %%ok = io:fwrite("ubody ~w:~p~n", [?LINE,{E,Br}]), %% Exiting expressions need no trailing break. case is_exit_expr(E) of @@ -2151,6 +2235,16 @@ ubody(E, {break,_Rs} = Break, St0) -> false -> {Ea,Pa,St1} = force_atomic(E, St0), ubody(pre_seq(Pa, #ivalues{args=[Ea]}), Break, St1) + end; +ubody(E, {break,Rs}=Break, St0) -> + case is_exit_expr(E) of + true -> + uexpr(E, return, St0); + false -> + {Vs,St1} = new_vars(length(Rs), St0), + Iset = #iset{vars=Vs,arg=E}, + PreSeq = pre_seq([Iset], #ivalues{args=Vs}), + ubody(PreSeq, Break, St1) end. iletrec_funs(#iletrec{defs=Fs}, St0) -> @@ -2179,9 +2273,8 @@ iletrec_funs_gen(Fs, FreeVs, St) -> Arity0 = length(Vs), {Fb1,_,Lst1} = ubody(Fb0, return, Lst0#kern{ff={N,Arity0}}), Arity = Arity0 + length(FreeVs), - Fun = #k_fdef{anno=#k{us=[],ns=[],a=Fa}, - func=N,arity=Arity, - vars=Vs ++ FreeVs,body=Fb1}, + Fun = make_fdef(#k{us=[],ns=[],a=Fa}, N, Arity, + Vs++FreeVs, Fb1), Lst1#kern{funs=[Fun|Lst1#kern.funs]} end, St, Fs). @@ -2325,8 +2418,7 @@ uexpr(#ifun{anno=A,vars=Vs,body=B0}, {break,Rs}, St0) -> %% No id annotation. Must invent a fun name. new_fun_name(St1) end, - Fun = #k_fdef{anno=#k{us=[],ns=[],a=A},func=Fname,arity=Arity, - vars=Vs ++ Fvs,body=B1}, + Fun = make_fdef(#k{us=[],ns=[],a=A}, Fname, Arity, Vs++Fvs, B1), {#k_bif{anno=#k{us=Free,ns=lit_list_vars(Rs),a=A}, op=#k_internal{name=make_fun,arity=length(Free)+2}, args=[#k_atom{val=Fname},#k_int{val=Arity}|Fvs], @@ -2343,6 +2435,16 @@ uexpr(Lit, {break,Rs0}, St0) -> add_local_function(_, #kern{funs=ignore}=St) -> St; add_local_function(F, #kern{funs=Funs}=St) -> St#kern{funs=[F|Funs]}. +%% Make a #k_fdef{}, making sure that the body is always a #k_match{}. +make_fdef(Anno, Name, Arity, Vs, #k_match{}=Body) -> + #k_fdef{anno=Anno,func=Name,arity=Arity,vars=Vs,body=Body}; +make_fdef(Anno, Name, Arity, Vs, Body) -> + Ka = get_kanno(Body), + Match = #k_match{anno=#k{us=Ka#k.us,ns=[],a=Ka#k.a}, + vars=Vs,body=Body,ret=[]}, + #k_fdef{anno=Anno,func=Name,arity=Arity,vars=Vs,body=Match}. + + %% handle_reuse_annos([#k_var{}], State) -> State. %% In general, it is only safe to reuse a variable for a match context %% if the original value of the variable will no longer be needed. diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl index 53097d0d7d..ac91039ae0 100644 --- a/lib/compiler/src/v3_kernel_pp.erl +++ b/lib/compiler/src/v3_kernel_pp.erl @@ -491,7 +491,7 @@ indent(Ctxt) -> indent(Ctxt#ctxt.indent, Ctxt). indent(N, _Ctxt) when N =< 0 -> ""; indent(N, Ctxt) -> T = Ctxt#ctxt.tab_width, - string:chars($\t, N div T, string:chars($\s, N rem T)). + lists:duplicate(N div T, $\t) ++ lists:duplicate(N rem T, $\s). nl_indent(Ctxt) -> [$\n|indent(Ctxt)]. @@ -508,7 +508,7 @@ unindent([$\t|T], N, Ctxt, C) -> if N >= Tab -> unindent(T, N - Tab, Ctxt, C); true -> - unindent([string:chars($\s, Tab - N)|T], 0, Ctxt, C) + unindent([lists:duplicate(Tab - N, $\s)|T], 0, Ctxt, C) end; unindent([L|T], N, Ctxt, C) when is_list(L) -> unindent(L, N, Ctxt, [T|C]); diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl deleted file mode 100644 index be3ade47ff..0000000000 --- a/lib/compiler/src/v3_life.erl +++ /dev/null @@ -1,468 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% Purpose : Convert annotated kernel expressions to annotated beam format. - -%% This module creates beam format annotated with variable lifetime -%% information. Each thing is given an index and for each variable we -%% store the first and last index for its occurrence. The variable -%% database, VDB, attached to each thing is only relevant internally -%% for that thing. -%% -%% For nested things like matches the numbering continues locally and -%% the VDB for that thing refers to the variable usage within that -%% thing. Variables which live through a such a thing are internally -%% given a very large last index. Internally the indexes continue -%% after the index of that thing. This creates no problems as the -%% internal variable info never escapes and externally we only see -%% variable which are alive both before or after. -%% -%% This means that variables never "escape" from a thing and the only -%% way to get values from a thing is to "return" them, with 'break' or -%% 'return'. Externally these values become the return values of the -%% thing. This is no real limitation as most nested things have -%% multiple threads so working out a common best variable usage is -%% difficult. - --module(v3_life). - --export([module/2]). - --export([vdb_find/2]). - --import(lists, [member/2,map/2,reverse/1,sort/1]). --import(ordsets, [add_element/2,intersection/2,union/2]). - --include("v3_kernel.hrl"). --include("v3_life.hrl"). - --type fa() :: {atom(),arity()}. - -%% These are not defined in v3_kernel.hrl. -get_kanno(Kthing) -> element(2, Kthing). -%%set_kanno(Kthing, Anno) -> setelement(2, Kthing, Anno). - --spec module(#k_mdef{}, [compile:option()]) -> - {'ok',{module(),[fa()],[_],[_]}}. - -module(#k_mdef{name=M,exports=Es,attributes=As,body=Fs0}, _Opts) -> - Fs1 = functions(Fs0, []), - {ok,{M,Es,As,Fs1}}. - -functions([F|Fs], Acc) -> - functions(Fs, [function(F)|Acc]); -functions([], Acc) -> reverse(Acc). - -%% function(Kfunc) -> Func. - -function(#k_fdef{anno=#k{a=Anno},func=F,arity=Ar,vars=Vs,body=Kb}) -> - try - As = var_list(Vs), - Vdb0 = init_vars(As), - %% Force a top-level match! - B0 = case Kb of - #k_match{} -> Kb; - _ -> - Ka = get_kanno(Kb), - #k_match{anno=#k{us=Ka#k.us,ns=[],a=Ka#k.a}, - vars=Vs,body=Kb,ret=[]} - end, - {B1,_,Vdb1} = body(B0, 1, Vdb0), - {function,F,Ar,As,B1,Vdb1,Anno} - catch - Class:Error -> - Stack = erlang:get_stacktrace(), - io:fwrite("Function: ~w/~w\n", [F,Ar]), - erlang:raise(Class, Error, Stack) - end. - -%% body(Kbody, I, Vdb) -> {[Expr],MaxI,Vdb}. -%% Handle a body. - -body(#k_seq{arg=Ke,body=Kb}, I, Vdb0) -> - %%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]), - A = get_kanno(Ke), - Vdb1 = use_vars(union(A#k.us, A#k.ns), I, Vdb0), - {Es,MaxI,Vdb2} = body(Kb, I+1, Vdb1), - E = expr(Ke, I, Vdb2), - {[E|Es],MaxI,Vdb2}; -body(Ke, I, Vdb0) -> - %%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]), - A = get_kanno(Ke), - Vdb1 = use_vars(union(A#k.us, A#k.ns), I, Vdb0), - E = expr(Ke, I, Vdb1), - {[E],I,Vdb1}. - -%% protected(Kprotected, I, Vdb) -> Protected. -%% Only used in guards. - -protected(#k_protected{anno=A,arg=Ts,ret=Rs}, I, Vdb) -> - %% Lock variables that are alive before try and used afterwards. - %% Don't lock variables that are only used inside the protected - %% expression. - Pdb0 = vdb_sub(I, I+1, Vdb), - {T,MaxI,Pdb1} = body(Ts, I+1, Pdb0), - Pdb2 = use_vars(A#k.ns, MaxI+1, Pdb1), %Save "return" values - #l{ke={protected,T,var_list(Rs)},i=I,a=A#k.a,vdb=Pdb2}. - -%% expr(Kexpr, I, Vdb) -> Expr. - -expr(#k_test{anno=A,op=Op,args=As,inverted=Inverted}, I, _Vdb) -> - #l{ke={test,test_op(Op),atomic_list(As),Inverted},i=I,a=A#k.a}; -expr(#k_call{anno=A,op=Op,args=As,ret=Rs}, I, _Vdb) -> - #l{ke={call,call_op(Op),atomic_list(As),var_list(Rs)},i=I,a=A#k.a}; -expr(#k_enter{anno=A,op=Op,args=As}, I, _Vdb) -> - #l{ke={enter,call_op(Op),atomic_list(As)},i=I,a=A#k.a}; -expr(#k_bif{anno=A,op=Op,args=As,ret=Rs}, I, _Vdb) -> - Bif = k_bif(A, Op, As, Rs), - #l{ke=Bif,i=I,a=A#k.a}; -expr(#k_match{anno=A,body=Kb,ret=Rs}, I, Vdb) -> - %% Work out imported variables which need to be locked. - Mdb = vdb_sub(I, I+1, Vdb), - M = match(Kb, A#k.us, I+1, [], Mdb), - #l{ke={match,M,var_list(Rs)},i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a}; -expr(#k_guard_match{anno=A,body=Kb,ret=Rs}, I, Vdb) -> - %% Work out imported variables which need to be locked. - Mdb = vdb_sub(I, I+1, Vdb), - M = match(Kb, A#k.us, I+1, [], Mdb), - #l{ke={guard_match,M,var_list(Rs)},i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a}; -expr(#k_try{}=Try, I, Vdb) -> - body_try(Try, I, Vdb); -expr(#k_protected{}=Protected, I, Vdb) -> - protected(Protected, I, Vdb); -expr(#k_try_enter{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh}, I, Vdb) -> - %% Lock variables that are alive before the catch and used afterwards. - %% Don't lock variables that are only used inside the try. - Tdb0 = vdb_sub(I, I+1, Vdb), - %% This is the tricky bit. Lock variables in Arg that are used in - %% the body and handler. Add try tag 'variable'. - Ab = get_kanno(Kb), - Ah = get_kanno(Kh), - Tdb1 = use_vars(union(Ab#k.us, Ah#k.us), I+3, Tdb0), - Tdb2 = vdb_sub(I, I+2, Tdb1), - Vnames = fun (Kvar) -> Kvar#k_var.name end, %Get the variable names - {Aes,_,Adb} = body(Ka, I+2, add_var({catch_tag,I+1}, I+1, 1000000, Tdb2)), - {Bes,_,Bdb} = body(Kb, I+4, new_vars(sort(map(Vnames, Vs)), I+3, Tdb2)), - {Hes,_,Hdb} = body(Kh, I+4, new_vars(sort(map(Vnames, Evs)), I+3, Tdb2)), - #l{ke={try_enter,#l{ke={block,Aes},i=I+1,vdb=Adb,a=[]}, - var_list(Vs),#l{ke={block,Bes},i=I+3,vdb=Bdb,a=[]}, - var_list(Evs),#l{ke={block,Hes},i=I+3,vdb=Hdb,a=[]}}, - i=I,vdb=Tdb1,a=A#k.a}; -expr(#k_catch{anno=A,body=Kb,ret=[R]}, I, Vdb) -> - %% Lock variables that are alive before the catch and used afterwards. - %% Don't lock variables that are only used inside the catch. - %% Add catch tag 'variable'. - Cdb0 = vdb_sub(I, I+1, Vdb), - {Es,_,Cdb1} = body(Kb, I+1, add_var({catch_tag,I}, I, locked, Cdb0)), - #l{ke={'catch',Es,variable(R)},i=I,vdb=Cdb1,a=A#k.a}; -expr(#k_receive{anno=A,var=V,body=Kb,timeout=T,action=Ka,ret=Rs}, I, Vdb) -> - %% Work out imported variables which need to be locked. - Rdb = vdb_sub(I, I+1, Vdb), - M = match(Kb, add_element(V#k_var.name, A#k.us), I+1, [], - new_vars([V#k_var.name], I, Rdb)), - {Tes,_,Adb} = body(Ka, I+1, Rdb), - #l{ke={receive_loop,atomic(T),variable(V),M, - #l{ke=Tes,i=I+1,vdb=Adb,a=[]},var_list(Rs)}, - i=I,vdb=use_vars(A#k.us, I+1, Vdb),a=A#k.a}; -expr(#k_receive_accept{anno=A}, I, _Vdb) -> - #l{ke=receive_accept,i=I,a=A#k.a}; -expr(#k_receive_next{anno=A}, I, _Vdb) -> - #l{ke=receive_next,i=I,a=A#k.a}; -expr(#k_put{anno=A,arg=Arg,ret=Rs}, I, _Vdb) -> - #l{ke={set,var_list(Rs),literal(Arg, [])},i=I,a=A#k.a}; -expr(#k_break{anno=A,args=As}, I, _Vdb) -> - #l{ke={break,atomic_list(As)},i=I,a=A#k.a}; -expr(#k_guard_break{anno=A,args=As}, I, Vdb) -> - Locked = [V || {V,_,_} <- Vdb], - #l{ke={guard_break,atomic_list(As),Locked},i=I,a=A#k.a}; -expr(#k_return{anno=A,args=As}, I, _Vdb) -> - #l{ke={return,atomic_list(As)},i=I,a=A#k.a}. - -body_try(#k_try{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh,ret=Rs}, - I, Vdb) -> - %% Lock variables that are alive before the catch and used afterwards. - %% Don't lock variables that are only used inside the try. - Tdb0 = vdb_sub(I, I+1, Vdb), - %% This is the tricky bit. Lock variables in Arg that are used in - %% the body and handler. Add try tag 'variable'. - Ab = get_kanno(Kb), - Ah = get_kanno(Kh), - Tdb1 = use_vars(union(Ab#k.us, Ah#k.us), I+3, Tdb0), - Tdb2 = vdb_sub(I, I+2, Tdb1), - Vnames = fun (Kvar) -> Kvar#k_var.name end, %Get the variable names - {Aes,_,Adb} = body(Ka, I+2, add_var({catch_tag,I+1}, I+1, locked, Tdb2)), - {Bes,_,Bdb} = body(Kb, I+4, new_vars(sort(map(Vnames, Vs)), I+3, Tdb2)), - {Hes,_,Hdb} = body(Kh, I+4, new_vars(sort(map(Vnames, Evs)), I+3, Tdb2)), - #l{ke={'try',#l{ke={block,Aes},i=I+1,vdb=Adb,a=[]}, - var_list(Vs),#l{ke={block,Bes},i=I+3,vdb=Bdb,a=[]}, - var_list(Evs),#l{ke={block,Hes},i=I+3,vdb=Hdb,a=[]}, - var_list(Rs)}, - i=I,vdb=Tdb1,a=A#k.a}. - -%% call_op(Op) -> Op. -%% test_op(Op) -> Op. -%% Do any necessary name translations here to munge into beam format. - -call_op(#k_local{name=N}) -> N; -call_op(#k_remote{mod=M,name=N}) -> {remote,atomic(M),atomic(N)}; -call_op(Other) -> variable(Other). - -test_op(#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=N}}) -> N. - -%% k_bif(Anno, Op, [Arg], [Ret], Vdb) -> Expr. -%% Build bifs. - -k_bif(_A, #k_internal{name=Name}, As, Rs) -> - {internal,Name,atomic_list(As),var_list(Rs)}; -k_bif(_A, #k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Name}}, As, Rs) -> - Ar = length(As), - case is_gc_bif(Name, Ar) of - false -> - {bif,Name,atomic_list(As),var_list(Rs)}; - true -> - {gc_bif,Name,atomic_list(As),var_list(Rs)} - end. - -%% match(Kexpr, [LockVar], I, Vdb) -> Expr. -%% Convert match tree to old format. - -match(#k_alt{anno=A,first=Kf,then=Kt}, Ls, I, Ctxt, Vdb0) -> - Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0), - F = match(Kf, Ls, I+1, Ctxt, Vdb1), - T = match(Kt, Ls, I+1, Ctxt, Vdb1), - #l{ke={alt,F,T},i=I,vdb=Vdb1,a=A#k.a}; -match(#k_select{anno=A,var=V,types=Kts}, Ls0, I, Ctxt, Vdb0) -> - Vanno = get_kanno(V), - Ls1 = case member(no_usage, Vanno) of - false -> add_element(V#k_var.name, Ls0); - true -> Ls0 - end, - Anno = case member(reuse_for_context, Vanno) of - true -> [reuse_for_context|A#k.a]; - false -> A#k.a - end, - Vdb1 = use_vars(union(A#k.us, Ls1), I, Vdb0), - Ts = [type_clause(Tc, Ls1, I+1, Ctxt, Vdb1) || Tc <- Kts], - #l{ke={select,literal(V, Ctxt),Ts},i=I,vdb=Vdb1,a=Anno}; -match(#k_guard{anno=A,clauses=Kcs}, Ls, I, Ctxt, Vdb0) -> - Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0), - Cs = [guard_clause(G, Ls, I+1, Ctxt, Vdb1) || G <- Kcs], - #l{ke={guard,Cs},i=I,vdb=Vdb1,a=A#k.a}; -match(Other, Ls, I, _Ctxt, Vdb0) -> - Vdb1 = use_vars(Ls, I, Vdb0), - {B,_,Vdb2} = body(Other, I+1, Vdb1), - #l{ke={block,B},i=I,vdb=Vdb2,a=[]}. - -type_clause(#k_type_clause{anno=A,type=T,values=Kvs}, Ls, I, Ctxt, Vdb0) -> - %%ok = io:format("life ~w: ~p~n", [?LINE,{T,Kvs}]), - Vdb1 = use_vars(union(A#k.us, Ls), I+1, Vdb0), - Vs = [val_clause(Vc, Ls, I+1, Ctxt, Vdb1) || Vc <- Kvs], - #l{ke={type_clause,type(T),Vs},i=I,vdb=Vdb1,a=A#k.a}. - -val_clause(#k_val_clause{anno=A,val=V,body=Kb}, Ls0, I, Ctxt0, Vdb0) -> - New = (get_kanno(V))#k.ns, - Bus = (get_kanno(Kb))#k.us, - %%ok = io:format("Ls0 = ~p, Used=~p\n New=~p, Bus=~p\n", [Ls0,Used,New,Bus]), - Ls1 = union(intersection(New, Bus), Ls0), %Lock for safety - Vdb1 = use_vars(union(A#k.us, Ls1), I+1, new_vars(New, I, Vdb0)), - Ctxt = case V of - #k_binary{segs=#k_var{name=C0}} -> C0; - _ -> Ctxt0 - end, - B = match(Kb, Ls1, I+1, Ctxt, Vdb1), - #l{ke={val_clause,literal(V, Ctxt),B},i=I,vdb=use_vars(Bus, I+1, Vdb1),a=A#k.a}. - -guard_clause(#k_guard_clause{anno=A,guard=Kg,body=Kb}, Ls, I, Ctxt, Vdb0) -> - Vdb1 = use_vars(union(A#k.us, Ls), I+2, Vdb0), - Gdb = vdb_sub(I+1, I+2, Vdb1), - G = protected(Kg, I+1, Gdb), - B = match(Kb, Ls, I+2, Ctxt, Vdb1), - #l{ke={guard_clause,G,B}, - i=I,vdb=use_vars((get_kanno(Kg))#k.us, I+2, Vdb1), - a=A#k.a}. - -%% type(Ktype) -> Type. - -type(k_literal) -> literal; -type(k_int) -> integer; -%%type(k_char) -> integer; %Hhhmmm??? -type(k_float) -> float; -type(k_atom) -> atom; -type(k_nil) -> nil; -type(k_cons) -> cons; -type(k_tuple) -> tuple; -type(k_binary) -> binary; -type(k_bin_seg) -> bin_seg; -type(k_bin_int) -> bin_int; -type(k_bin_end) -> bin_end; -type(k_map) -> map. - -%% variable(Klit) -> Lit. -%% var_list([Klit]) -> [Lit]. - -variable(#k_var{name=N}) -> {var,N}. - -var_list(Ks) -> [variable(K) || K <- Ks]. - -%% atomic(Klit) -> Lit. -%% atomic_list([Klit]) -> [Lit]. - -atomic(#k_literal{val=V}) -> {literal,V}; -atomic(#k_var{name=N}) -> {var,N}; -atomic(#k_int{val=I}) -> {integer,I}; -atomic(#k_float{val=F}) -> {float,F}; -atomic(#k_atom{val=N}) -> {atom,N}; -%%atomic(#k_char{val=C}) -> {char,C}; -atomic(#k_nil{}) -> nil. - -atomic_list(Ks) -> [atomic(K) || K <- Ks]. - -%% literal(Klit) -> Lit. -%% literal_list([Klit]) -> [Lit]. - -literal(#k_var{name=N}, _) -> {var,N}; -literal(#k_literal{val=I}, _) -> {literal,I}; -literal(#k_int{val=I}, _) -> {integer,I}; -literal(#k_float{val=F}, _) -> {float,F}; -literal(#k_atom{val=N}, _) -> {atom,N}; -%%literal(#k_char{val=C}, _) -> {char,C}; -literal(#k_nil{}, _) -> nil; -literal(#k_cons{hd=H,tl=T}, Ctxt) -> - {cons,[literal(H, Ctxt),literal(T, Ctxt)]}; -literal(#k_binary{segs=V}, Ctxt) -> - {binary,literal(V, Ctxt)}; -literal(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=[]}, Ctxt) -> - %% Only occurs in patterns. - {bin_seg,Ctxt,literal(S, Ctxt),U,T,Fs,[literal(Seg, Ctxt)]}; -literal(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=N}, Ctxt) -> - {bin_seg,Ctxt,literal(S, Ctxt),U,T,Fs, - [literal(Seg, Ctxt),literal(N, Ctxt)]}; -literal(#k_bin_int{size=S,unit=U,flags=Fs,val=Int,next=N}, Ctxt) -> - %% Only occurs in patterns. - {bin_int,Ctxt,literal(S, Ctxt),U,Fs,Int, - [literal(N, Ctxt)]}; -literal(#k_bin_end{}, Ctxt) -> - {bin_end,Ctxt}; -literal(#k_tuple{es=Es}, Ctxt) -> - {tuple,literal_list(Es, Ctxt)}; -literal(#k_map{op=Op,var=Var,es=Es0}, Ctxt) -> - {map,Op,literal(Var, Ctxt),literal_list(Es0, Ctxt)}; -literal(#k_map_pair{key=K,val=V}, Ctxt) -> - {map_pair,literal(K, Ctxt),literal(V, Ctxt)}. - -literal_list(Ks, Ctxt) -> - [literal(K, Ctxt) || K <- Ks]. - - -%% is_gc_bif(Name, Arity) -> true|false -%% Determines whether the BIF Name/Arity might do a GC. - -is_gc_bif(hd, 1) -> false; -is_gc_bif(tl, 1) -> false; -is_gc_bif(self, 0) -> false; -is_gc_bif(node, 0) -> false; -is_gc_bif(node, 1) -> false; -is_gc_bif(element, 2) -> false; -is_gc_bif(get, 1) -> false; -is_gc_bif(tuple_size, 1) -> false; -is_gc_bif(Bif, Arity) -> - not (erl_internal:bool_op(Bif, Arity) orelse - erl_internal:new_type_test(Bif, Arity) orelse - erl_internal:comp_op(Bif, Arity)). - -%% Keep track of life time for variables. -%% -%% init_vars([{var,VarName}]) -> Vdb. -%% new_vars([VarName], I, Vdb) -> Vdb. -%% use_vars([VarName], I, Vdb) -> Vdb. -%% add_var(VarName, F, L, Vdb) -> Vdb. -%% -%% The list of variable names for new_vars/3 and use_vars/3 -%% must be sorted. - -init_vars(Vs) -> - vdb_new(Vs). - -new_vars([], _, Vdb) -> Vdb; -new_vars([V], I, Vdb) -> vdb_store_new(V, {V,I,I}, Vdb); -new_vars(Vs, I, Vdb) -> vdb_update_vars(Vs, Vdb, I). - -use_vars([], _, Vdb) -> - Vdb; -use_vars([V], I, Vdb) -> - case vdb_find(V, Vdb) of - {V,F,L} when I > L -> vdb_update(V, {V,F,I}, Vdb); - {V,_,_} -> Vdb; - error -> vdb_store_new(V, {V,I,I}, Vdb) - end; -use_vars(Vs, I, Vdb) -> vdb_update_vars(Vs, Vdb, I). - -add_var(V, F, L, Vdb) -> - vdb_store_new(V, {V,F,L}, Vdb). - -%% vdb - -vdb_new(Vs) -> - sort([{V,0,0} || {var,V} <- Vs]). - --type var() :: atom(). - --spec vdb_find(var(), [vdb_entry()]) -> 'error' | vdb_entry(). - -vdb_find(V, Vdb) -> - case lists:keyfind(V, 1, Vdb) of - false -> error; - Vd -> Vd - end. - -vdb_update(V, Update, [{V,_,_}|Vdb]) -> - [Update|Vdb]; -vdb_update(V, Update, [Vd|Vdb]) -> - [Vd|vdb_update(V, Update, Vdb)]. - -vdb_store_new(V, New, [{V1,_,_}=Vd|Vdb]) when V > V1 -> - [Vd|vdb_store_new(V, New, Vdb)]; -vdb_store_new(V, New, [{V1,_,_}|_]=Vdb) when V < V1 -> - [New|Vdb]; -vdb_store_new(_, New, []) -> [New]. - -vdb_update_vars([V|_]=Vs, [{V1,_,_}=Vd|Vdb], I) when V > V1 -> - [Vd|vdb_update_vars(Vs, Vdb, I)]; -vdb_update_vars([V|Vs], [{V1,_,_}|_]=Vdb, I) when V < V1 -> - %% New variable. - [{V,I,I}|vdb_update_vars(Vs, Vdb, I)]; -vdb_update_vars([V|Vs], [{_,F,L}=Vd|Vdb], I) -> - %% Existing variable. - if - I > L -> [{V,F,I}|vdb_update_vars(Vs, Vdb, I)]; - true -> [Vd|vdb_update_vars(Vs, Vdb, I)] - end; -vdb_update_vars([V|Vs], [], I) -> - %% New variable. - [{V,I,I}|vdb_update_vars(Vs, [], I)]; -vdb_update_vars([], Vdb, _) -> Vdb. - -%% vdb_sub(Min, Max, Vdb) -> Vdb. -%% Extract variables which are used before and after Min. Lock -%% variables alive after Max. - -vdb_sub(Min, Max, Vdb) -> - [ if L >= Max -> {V,F,locked}; - true -> Vd - end || {V,F,L}=Vd <- Vdb, F < Min, L >= Min ]. diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index 63763f31b2..da5d207db9 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -22,6 +22,7 @@ MODULES= \ bs_construct_SUITE \ bs_match_SUITE \ bs_utf_SUITE \ + core_alias_SUITE \ core_fold_SUITE \ compile_SUITE \ compilation_SUITE \ diff --git a/lib/compiler/test/beam_utils_SUITE.erl b/lib/compiler/test/beam_utils_SUITE.erl index 710cb050d4..3a07f3923f 100644 --- a/lib/compiler/test/beam_utils_SUITE.erl +++ b/lib/compiler/test/beam_utils_SUITE.erl @@ -24,7 +24,8 @@ apply_fun/1,apply_mf/1,bs_init/1,bs_save/1, is_not_killed/1,is_not_used_at/1, select/1,y_catch/1,otp_8949_b/1,liveopt/1,coverage/1, - y_registers/1]). + y_registers/1,user_predef/1,scan_f/1,cafu/1, + receive_label/1]). -export([id/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -46,7 +47,10 @@ groups() -> otp_8949_b, liveopt, coverage, - y_registers + y_registers, + user_predef, + scan_f, + cafu ]}]. init_per_suite(Config) -> @@ -376,5 +380,70 @@ do(A, B) -> {A,B}. appointment(#{"resolution" := Url}) -> do(receive _ -> Url end, #{true => Url}). +%% From epp.erl. +user_predef(_Config) -> + #{key:="value"} = user_predef({key,"value"}, #{}), + #{key:="value"} = user_predef({key,"value"}, #{key=>defined}), + error = user_predef({key,"value"}, #{key=>[defined]}), + ok. + +user_predef({M,Val}, Ms) -> + case Ms of + #{M:=Defs} when is_list(Defs) -> + error; + _ -> + Ms#{M=>Val} + end. + +%% From disk_log_1.erl. +scan_f(_Config) -> + {1,<<>>,[]} = scan_f(<<1:32>>, 1, []), + {1,<<>>,[<<156>>]} = scan_f(<<1:32,156,1:32>>, 1, []), + ok. + +scan_f(<<Size:32,Tail/binary>>, FSz, Acc) when Size =< FSz -> + case Tail of + <<BinTerm:Size/binary,Tail2/binary>> -> + scan_f(Tail2, FSz, [BinTerm | Acc]); + _ -> + {Size,Tail,Acc} + end. + +%% From file_io_server.erl. +cafu(_Config) -> + error = cafu(<<42:32>>, -1, 0, {utf32,big}), + error = cafu(<<42:32>>, 10, 0, {utf32,big}), + error = cafu(<<42:32>>, -1, 0, {utf32,little}), + ok. + +cafu(<<_/big-utf32,Rest/binary>>, N, Count, {utf32,big}) when N < 0 -> + cafu(Rest, -1, Count+1, {utf32,big}); +cafu(<<_/big-utf32,Rest/binary>>, N, Count, {utf32,big}) -> + cafu(Rest, N-1, Count+1, {utf32,big}); +cafu(<<_/little-utf32,Rest/binary>>, N, Count, {utf32,little}) when N < 0 -> + cafu(Rest, -1, Count+1, {utf32,little}); +cafu(_, _, _, _) -> + error. + +-record(rec_label, {bool}). + +receive_label(_Config) -> + Pid = spawn_link(fun() -> do_receive_label(#rec_label{bool=true}) end), + Msg = {a,b,c}, + Pid ! {self(),Msg}, + receive + {ok,Msg} -> + unlink(Pid), + exit(Pid, die), + ok + end. + +do_receive_label(Rec) -> + receive + {From,Message} when Rec#rec_label.bool -> + From ! {ok,Message}, + do_receive_label(Rec) + end. + %% The identity function. id(I) -> I. diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index c23514b36b..685eb2a72e 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -421,9 +421,9 @@ try_bin_opt(Mod) -> try do_bin_opt(Mod) catch - Class:Error -> + Class:Error:Stk -> io:format("~p: ~p ~p\n~p\n", - [Mod,Class,Error,erlang:get_stacktrace()]), + [Mod,Class,Error,Stk]), error end. diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 2fe8cd0cff..7e1a432511 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -39,7 +39,8 @@ match_string_opt/1,select_on_integer/1, map_and_binary/1,unsafe_branch_caching/1, bad_literals/1,good_literals/1,constant_propagation/1, - parse_xml/1,get_payload/1,num_slots_different/1]). + parse_xml/1,get_payload/1,escape/1,num_slots_different/1, + check_bitstring_list/1,guard/1]). -export([coverage_id/1,coverage_external_ignore/2]). @@ -71,7 +72,8 @@ groups() -> match_string_opt,select_on_integer, map_and_binary,unsafe_branch_caching, bad_literals,good_literals,constant_propagation,parse_xml, - get_payload,num_slots_different]}]. + get_payload,escape,num_slots_different, + check_bitstring_list,guard]}]. init_per_suite(Config) -> @@ -1524,6 +1526,21 @@ do_get_payload(ExtHdr) -> <<_:13,_:35>> = ExtHdr#ext_header.ext_hdr_opts, ExtHdrOptions. +escape(_Config) -> + 0 = escape(<<>>, 0), + 1 = escape(<<128>>, 0), + 2 = escape(<<128,255>>, 0), + 42 = escape(<<42>>, 0), + 50 = escape(<<42,8>>, 0), + ok. + +escape(<<Byte, Rest/bits>>, Pos) when Byte >= 127 -> + escape(Rest, Pos + 1); +escape(<<Byte, Rest/bits>>, Pos) -> + escape(Rest, Pos + Byte); +escape(<<_Rest/bits>>, Pos) -> + Pos. + %% ERL-490 num_slots_different(_Config) -> Ts = [{<<"de">>, <<"default">>, <<"Remove">>, <<"a">>}, @@ -1557,6 +1574,32 @@ lgettext(<<"de">>, <<"navigation">>, <<"Results">>) -> lgettext(<<"de">>, <<"navigation">>, <<"Resources">>) -> {ok, <<"Ressourcen">>}. +%% Cover more code in beam_bsm. +check_bitstring_list(_Config) -> + true = check_bitstring_list(<<1:1,0:1,1:1,1:1>>, [1,0,1,1]), + false = check_bitstring_list(<<1:1,0:1,1:1,1:1>>, [0]), + ok. + +check_bitstring_list(<<H:1,T1/bitstring>>, [H|T2]) -> + check_bitstring_list(T1, T2); +check_bitstring_list(<<>>, []) -> + true; +check_bitstring_list(_, _) -> + false. + +guard(_Config) -> + Tuple = id({a,b}), + ok = guard_1(<<1,2,3>>, {1,2,3}), + ok = guard_2(<<42>>, #{}), + ok. + +%% Cover handling of #k_put{} in v3_codegen:bsm_rename_ctx/4. +guard_1(<<A,B,C>>, Tuple) when Tuple =:= {A,B,C} -> + ok. + +%% Cover handling of #k_call{} in v3_codegen:bsm_rename_ctx/4. +guard_2(<<_>>, Healing) when Healing#{[] => Healing} =:= #{[] => #{}} -> + ok. check(F, R) -> R = F(). diff --git a/lib/compiler/test/compilation_SUITE_data/opt_crash.erl b/lib/compiler/test/compilation_SUITE_data/opt_crash.erl index f1607cca68..c65ec31593 100644 --- a/lib/compiler/test/compilation_SUITE_data/opt_crash.erl +++ b/lib/compiler/test/compilation_SUITE_data/opt_crash.erl @@ -33,7 +33,7 @@ test() -> {userinfo,nil}, fun() -> nil end}, nil}, - {'query',nil}}}, + {query,nil}}}, {absoluteURI, {scheme,_}, @@ -43,7 +43,7 @@ test() -> {userinfo,nil}, HostportBefore}, nil}, - {'query',nil}}} = URI_Before, + {query,nil}}} = URI_Before, %% ... some funky code ommitted, not relevant ... @@ -55,7 +55,7 @@ test() -> {userinfo,nil}, HostportAfter}, nil}, - {'query',nil}}} = URI_Before, + {query,nil}}} = URI_Before, %% NOTE: I intended to write URI_After instead of URI_Before %% but the accident revealed that when you add the line below, %% it causes internal error in v3_codegen on compilation diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index f647a4030d..35c11d894d 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -27,12 +27,12 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, app_test/1,appup_test/1, - debug_info/4, custom_debug_info/1, + debug_info/4, custom_debug_info/1, custom_compile_info/1, file_1/1, forms_2/1, module_mismatch/1, big_file/1, outdir/1, binary/1, makedep/1, cond_and_ifdef/1, listings/1, listings_big/1, other_output/1, kernel_listing/1, encrypted_abstr/1, strict_record/1, utf8_atoms/1, utf8_functions/1, extra_chunks/1, - cover/1, env/1, core_pp/1, + cover/1, env/1, core_pp/1, tuple_calls/1, core_roundtrip/1, asm/1, optimized_guards/1, sys_pre_attributes/1, dialyzer/1, warnings/1, pre_load_check/1, env_compiler_options/1, @@ -49,11 +49,12 @@ all() -> test_lib:recompile(?MODULE), [app_test, appup_test, file_1, forms_2, module_mismatch, big_file, outdir, binary, makedep, cond_and_ifdef, listings, listings_big, - other_output, kernel_listing, encrypted_abstr, + other_output, kernel_listing, encrypted_abstr, tuple_calls, strict_record, utf8_atoms, utf8_functions, extra_chunks, cover, env, core_pp, core_roundtrip, asm, optimized_guards, sys_pre_attributes, dialyzer, warnings, pre_load_check, - env_compiler_options, custom_debug_info, bc_options]. + env_compiler_options, custom_debug_info, bc_options, + custom_compile_info]. groups() -> []. @@ -119,9 +120,19 @@ file_1(Config) when is_list(Config) -> true = exists(Target), passed = run(Target, test, []), + %% Test option 'deterministic' as a compiler attribute. + Det = deterministic_module, + {DetPath, DetTarget} = get_files(Config, Det, "det_target"), + {ok,Det,DetCode} = compile:file(DetPath, [binary]), + {module,Det} = code:load_binary(Det, "", DetCode), + [{version,_}] = Det:module_info(compile), + true = code:delete(Det), + false = code:purge(Det), + %% Cleanup. ok = file:delete(Target), ok = file:del_dir(filename:dirname(Target)), + ok = file:del_dir(filename:dirname(DetTarget)), %% There should not be any messages in the messages. receive @@ -374,7 +385,6 @@ do_file_listings(DataDir, PrivDir, [File|Files]) -> do_listing(Simple, TargetDir, dcbsm, ".core_bsm"), do_listing(Simple, TargetDir, dsetel, ".dsetel"), do_listing(Simple, TargetDir, dkern, ".kernel"), - do_listing(Simple, TargetDir, dlife, ".life"), do_listing(Simple, TargetDir, dcg, ".codegen"), do_listing(Simple, TargetDir, dblk, ".block"), do_listing(Simple, TargetDir, dexcept, ".except"), @@ -398,6 +408,7 @@ do_file_listings(DataDir, PrivDir, [File|Files]) -> ok = file:delete(filename:join(Listings, File ++ ".core")), do_listing(Simple, TargetDir, to_core, ".core"), do_listing(Simple, TargetDir, to_kernel, ".kernel"), + do_listing(Simple, TargetDir, to_dis, ".dis"), %% Final clean up. lists:foreach(fun(F) -> ok = file:delete(F) end, @@ -413,6 +424,7 @@ listings_big(Config) when is_list(Config) -> do_listing(Big, TargetDir, 'E'), do_listing(Big, TargetDir, 'P'), do_listing(Big, TargetDir, dkern, ".kernel"), + do_listing(Big, TargetDir, to_dis, ".dis"), TargetNoext = filename:rootname(Target, code:objfile_extension()), {ok,big} = compile:file(TargetNoext, [from_asm,{outdir,TargetDir}]), @@ -488,9 +500,8 @@ do_kernel_listing({M,A}) -> io:format("*** compilation failure '~p' for module ~s\n", [Error,M]), error; - Class:Error -> - io:format("~p: ~p ~p\n~p\n", - [M,Class,Error,erlang:get_stacktrace()]), + Class:Error:Stk -> + io:format("~p: ~p ~p\n~p\n", [M,Class,Error,Stk]), error end. @@ -649,6 +660,23 @@ custom_debug_info(Config) when is_list(Config) -> {ok,{simple,[{debug_info,{debug_info_v1,?MODULE,error}}]}} = beam_lib:chunks(ErrorBin, [debug_info]). +custom_compile_info(Config) when is_list(Config) -> + Anno = erl_anno:new(1), + Forms = [{attribute,Anno,module,custom_compile_info}], + Opts = [binary,{compile_info,[{another,version}]}], + + {ok,custom_compile_info,Bin} = compile:forms(Forms, Opts), + {ok,{custom_compile_info,[{compile_info,CompileInfo}]}} = + beam_lib:chunks(Bin, [compile_info]), + version = proplists:get_value(another, CompileInfo), + CompileOpts = proplists:get_value(options, CompileInfo), + undefined = proplists:get_value(compile_info, CompileOpts), + + {ok,custom_compile_info,DetBin} = compile:forms(Forms, [deterministic|Opts]), + {ok,{custom_compile_info,[{compile_info,DetInfo}]}} = + beam_lib:chunks(DetBin, [compile_info]), + version = proplists:get_value(another, DetInfo). + cover(Config) when is_list(Config) -> io:format("~p\n", [compile:options()]), ok. @@ -781,6 +809,37 @@ extra_chunks(Config) when is_list(Config) -> {ok,{extra_chunks,[{"ExCh",<<"Contents">>}]}} = beam_lib:chunks(ExtraChunksBinary, ["ExCh"]). +tuple_calls(Config) when is_list(Config) -> + Anno = erl_anno:new(1), + Forms = [{attribute,Anno,export,[{size,1},{store,1}]}, + {function,Anno,size,1, + [{clause,Anno,[{var,[],mod}],[], + [{call,[],{remote,[],{var,[],mod},{atom,[],size}},[]}]}]}, + {function,Anno,store,1, + [{clause,Anno,[{var,[],mod}],[], + [{call,[],{remote,[],{var,[],mod},{atom,[],store}},[{atom,[],key},{atom,[],value}]}]}]}], + + TupleCallsFalse = [{attribute,Anno,module,tuple_calls_false}|Forms], + {ok,_,TupleCallsFalseBinary} = compile:forms(TupleCallsFalse, [binary]), + code:load_binary(tuple_calls_false, "compile_SUITE.erl", TupleCallsFalseBinary), + {'EXIT',{badarg,_}} = (catch tuple_calls_false:store(dict())), + {'EXIT',{badarg,_}} = (catch tuple_calls_false:size(dict())), + {'EXIT',{badarg,_}} = (catch tuple_calls_false:size(empty_tuple())), + + TupleCallsTrue = [{attribute,Anno,module,tuple_calls_true}|Forms], + {ok,_,TupleCallsTrueBinary} = compile:forms(TupleCallsTrue, [binary,tuple_calls]), + code:load_binary(tuple_calls_true, "compile_SUITE.erl", TupleCallsTrueBinary), + Dict = tuple_calls_true:store(dict()), + 1 = tuple_calls_true:size(Dict), + {'EXIT',{badarg,_}} = (catch tuple_calls_true:size(empty_tuple())), + + ok. + +dict() -> + dict:new(). +empty_tuple() -> + {}. + env(Config) when is_list(Config) -> {Simple,Target} = get_files(Config, simple, env), {ok,Cwd} = file:get_cwd(), @@ -842,9 +901,8 @@ do_core_pp({M,A}, Outdir) -> io:format("*** compilation failure '~p' for module ~s\n", [Error,M]), error; - Class:Error -> - io:format("~p: ~p ~p\n~p\n", - [M,Class,Error,erlang:get_stacktrace()]), + Class:Error:Stk -> + io:format("~p: ~p ~p\n~p\n", [M,Class,Error,Stk]), error end. @@ -901,9 +959,8 @@ do_core_roundtrip(Beam, Outdir) -> io:format("*** compilation failure '~p' for file ~s\n", [Error,Beam]), error; - Class:Error -> - io:format("~p: ~p ~p\n~p\n", - [Beam,Class,Error,erlang:get_stacktrace()]), + Class:Error:Stk -> + io:format("~p: ~p ~p\n~p\n", [Beam,Class,Error,Stk]), error end. @@ -1088,9 +1145,8 @@ do_asm(Beam, Outdir) -> [Other,AsmFile]), error end - catch Class:Error -> - io:format("~p: ~p ~p\n~p\n", - [M,Class,Error,erlang:get_stacktrace()]), + catch Class:Error:Stk -> + io:format("~p: ~p ~p\n~p\n", [M,Class,Error,Stk]), error end. @@ -1107,9 +1163,8 @@ do_opt_guards(Beam) -> try {ok,M,Asm} = compile:forms(A, ['S']), do_opt_guards_mod(Asm) - catch Class:Error -> - io:format("~p: ~p ~p\n~p\n", - [M,Class,Error,erlang:get_stacktrace()]), + catch Class:Error:Stk -> + io:format("~p: ~p ~p\n~p\n", [M,Class,Error,Stk]), error end. @@ -1270,10 +1325,13 @@ do_warnings_2([], Next, F) -> %% pre-loads the modules that are used by a typical compilation. pre_load_check(Config) -> - case test_server:is_cover() of - true -> + case {test_server:is_cover(),code:module_info(native)} of + {true,_} -> {skip,"Cover is running"}; - false -> + {false,true} -> + %% Tracing won't work. + {skip,"'code' is native-compiled"}; + {false,false} -> try do_pre_load_check(Config) after diff --git a/lib/compiler/test/compile_SUITE_data/deterministic_module.erl b/lib/compiler/test/compile_SUITE_data/deterministic_module.erl new file mode 100644 index 0000000000..5e0e29c25e --- /dev/null +++ b/lib/compiler/test/compile_SUITE_data/deterministic_module.erl @@ -0,0 +1,21 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(deterministic_module). +-compile([deterministic]). diff --git a/lib/compiler/test/core_alias_SUITE.erl b/lib/compiler/test/core_alias_SUITE.erl new file mode 100644 index 0000000000..f3f15ef0f8 --- /dev/null +++ b/lib/compiler/test/core_alias_SUITE.erl @@ -0,0 +1,195 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(core_alias_SUITE). + +-export([all/0, suite/0, groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2, end_per_group/2, + tuples/1, cons/1]). + +-include_lib("common_test/include/ct.hrl"). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + test_lib:recompile(?MODULE), + [{group,p}]. + +groups() -> + [{p,[parallel], + [tuples, cons]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + +id(X) -> X. + +tuples(Config) when is_list(Config) -> + Tuple = {ok,id(value)}, + + true = erts_debug:same(Tuple, simple_tuple(Tuple)), + true = erts_debug:same(Tuple, simple_tuple_in_map(#{hello => Tuple})), + true = erts_debug:same(Tuple, simple_tuple_case_repeated(Tuple, Tuple)), + true = erts_debug:same(Tuple, simple_tuple_fun_repeated(Tuple, Tuple)), + true = erts_debug:same(Tuple, simple_tuple_twice_head(Tuple, Tuple)), + + {Tuple1, Tuple2} = simple_tuple_twice_body(Tuple), + true = erts_debug:same(Tuple, Tuple1), + true = erts_debug:same(Tuple, Tuple2), + + Nested = {nested,Tuple}, + true = erts_debug:same(Tuple, nested_tuple_part(Nested)), + true = erts_debug:same(Nested, nested_tuple_whole(Nested)), + true = erts_debug:same(Nested, nested_tuple_with_alias(Nested)), + + true = erts_debug:same(Tuple, tuple_rebinding_after(Tuple)), + + Tuple = unaliased_tuple_rebinding_before(Tuple), + false = erts_debug:same(Tuple, unaliased_tuple_rebinding_before(Tuple)), + Nested = unaliased_literal_tuple_head(Nested), + false = erts_debug:same(Nested, unaliased_literal_tuple_head(Nested)), + Nested = unaliased_literal_tuple_body(Nested), + false = erts_debug:same(Nested, unaliased_literal_tuple_body(Nested)), + Nested = unaliased_different_var_tuple(Nested, Tuple), + false = erts_debug:same(Nested, unaliased_different_var_tuple(Nested, Tuple)). + +simple_tuple({ok,X}) -> + {ok,X}. +simple_tuple_twice_head({ok,X}, {ok,X}) -> + {ok,X}. +simple_tuple_twice_body({ok,X}) -> + {{ok,X},{ok,X}}. +simple_tuple_in_map(#{hello := {ok,X}}) -> + {ok,X}. +simple_tuple_fun_repeated({ok,X}, Y) -> + io:format("~p~n", [X]), + (fun({ok,X}) -> {ok,X} end)(Y). +simple_tuple_case_repeated({ok,X}, Y) -> + io:format("~p~n", [X]), + case Y of {ok,X} -> {ok,X} end. + +nested_tuple_part({nested,{ok,X}}) -> + {ok,X}. +nested_tuple_whole({nested,{ok,X}}) -> + {nested,{ok,X}}. +nested_tuple_with_alias({nested,{ok,_}=Y}) -> + {nested,Y}. + +tuple_rebinding_after(Y) -> + (fun(X) -> {ok,X} end)(Y), + case Y of {ok,X} -> {ok,X} end. +unaliased_tuple_rebinding_before({ok,X}) -> + io:format("~p~n", [X]), + (fun(X) -> {ok,X} end)(value). +unaliased_literal_tuple_head({nested,{ok,value}=X}) -> + io:format("~p~n", [X]), + {nested,{ok,value}}. +unaliased_literal_tuple_body({nested,{ok,value}=X}) -> + Res = {nested,Y={ok,value}}, + io:format("~p~n", [[X,Y]]), + Res. +unaliased_different_var_tuple({nested,{ok,value}=X}, Y) -> + io:format("~p~n", [X]), + {nested,Y}. + +cons(Config) when is_list(Config) -> + Cons = [ok|id(value)], + + true = erts_debug:same(Cons, simple_cons(Cons)), + true = erts_debug:same(Cons, simple_cons_in_map(#{hello => Cons})), + true = erts_debug:same(Cons, simple_cons_case_repeated(Cons, Cons)), + true = erts_debug:same(Cons, simple_cons_fun_repeated(Cons, Cons)), + true = erts_debug:same(Cons, simple_cons_twice_head(Cons, Cons)), + + {Cons1,Cons2} = simple_cons_twice_body(Cons), + true = erts_debug:same(Cons, Cons1), + true = erts_debug:same(Cons, Cons2), + + Nested = [nested,Cons], + true = erts_debug:same(Cons, nested_cons_part(Nested)), + true = erts_debug:same(Nested, nested_cons_whole(Nested)), + true = erts_debug:same(Nested, nested_cons_with_alias(Nested)), + true = erts_debug:same(Cons, cons_rebinding_after(Cons)), + + Unstripped = id([a,b]), + Stripped = cons_with_binary([<<>>|Unstripped]), + true = erts_debug:same(Unstripped, Stripped), + + Cons = unaliased_cons_rebinding_before(Cons), + false = erts_debug:same(Cons, unaliased_cons_rebinding_before(Cons)), + Nested = unaliased_literal_cons_head(Nested), + false = erts_debug:same(Nested, unaliased_literal_cons_head(Nested)), + Nested = unaliased_literal_cons_body(Nested), + false = erts_debug:same(Nested, unaliased_literal_cons_body(Nested)), + Nested = unaliased_different_var_cons(Nested, Cons), + false = erts_debug:same(Nested, unaliased_different_var_cons(Nested, Cons)). + +simple_cons([ok|X]) -> + [ok|X]. +simple_cons_twice_head([ok|X], [ok|X]) -> + [ok|X]. +simple_cons_twice_body([ok|X]) -> + {[ok|X],[ok|X]}. +simple_cons_in_map(#{hello := [ok|X]}) -> + [ok|X]. +simple_cons_fun_repeated([ok|X], Y) -> + io:format("~p~n", [X]), + (fun([ok|X]) -> [ok|X] end)(Y). +simple_cons_case_repeated([ok|X], Y) -> + io:format("~p~n", [X]), + case Y of [ok|X] -> [ok|X] end. + +nested_cons_part([nested,[ok|X]]) -> + [ok|X]. +nested_cons_whole([nested,[ok|X]]) -> + [nested,[ok|X]]. +nested_cons_with_alias([nested,[ok|_]=Y]) -> + [nested,Y]. + +cons_with_binary([<<>>,X|Y]) -> + cons_with_binary([X|Y]); +cons_with_binary(A) -> + A. + +cons_rebinding_after(Y) -> + (fun(X) -> [ok|X] end)(Y), + case Y of [ok|X] -> [ok|X] end. +unaliased_cons_rebinding_before([ok|X]) -> + io:format("~p~n", [X]), + (fun(X) -> [ok|X] end)(value). +unaliased_literal_cons_head([nested,[ok|value]=X]) -> + io:format("~p~n", [X]), + [nested,[ok|value]]. +unaliased_literal_cons_body([nested,[ok|value]=X]) -> + Res = [nested,Y=[ok|value]], + io:format("~p~n", [[X, Y]]), + Res. +unaliased_different_var_cons([nested,[ok|value]=X], Y) -> + io:format("~p~n", [X]), + [nested,Y]. diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index 0097e28d4d..262967d03d 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -26,7 +26,8 @@ unused_multiple_values_error/1,unused_multiple_values/1, multiple_aliases/1,redundant_boolean_clauses/1, mixed_matching_clauses/1,unnecessary_building/1, - no_no_file/1,configuration/1,supplies/1]). + no_no_file/1,configuration/1,supplies/1, + redundant_stack_frame/1]). -export([foo/0,foo/1,foo/2,foo/3]). @@ -45,7 +46,8 @@ groups() -> unused_multiple_values_error,unused_multiple_values, multiple_aliases,redundant_boolean_clauses, mixed_matching_clauses,unnecessary_building, - no_no_file,configuration,supplies]}]. + no_no_file,configuration,supplies, + redundant_stack_frame]}]. init_per_suite(Config) -> @@ -527,4 +529,26 @@ supplies(_Config) -> do_supplies(#{1 := Value}) when byte_size(Value), byte_size(kg) -> working. +redundant_stack_frame(_Config) -> + {1,2} = do_redundant_stack_frame(#{x=>1,y=>2}), + {'EXIT',{{badkey,_,x},_}} = (catch do_redundant_stack_frame(#{y=>2})), + {'EXIT',{{badkey,_,y},_}} = (catch do_redundant_stack_frame(#{x=>1})), + ok. + +do_redundant_stack_frame(Map) -> + %% There should not be a stack frame for this function. + X = case Map of + #{x := X0} -> + X0; + #{} -> + erlang:error({badkey, Map, x}) + end, + Y = case Map of + #{y := Y0} -> + Y0; + #{} -> + erlang:error({badkey, Map, y}) + end, + {X, Y}. + id(I) -> I. diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index ccb9b58225..7d2d58d5af 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -35,7 +35,8 @@ basic_andalso_orelse/1,traverse_dcd/1, check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1, bad_constants/1,bad_guards/1, - guard_in_catch/1,beam_bool_SUITE/1]). + guard_in_catch/1,beam_bool_SUITE/1, + cover_beam_dead/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -54,7 +55,8 @@ groups() -> rel_ops,rel_op_combinations, literal_type_tests,basic_andalso_orelse,traverse_dcd, check_qlc_hrl,andalso_semi,t_tuple_size,binary_part, - bad_constants,bad_guards,guard_in_catch,beam_bool_SUITE]}]. + bad_constants,bad_guards,guard_in_catch,beam_bool_SUITE, + cover_beam_dead]}]. init_per_suite(Config) -> Config. @@ -1291,6 +1293,10 @@ rel_ops(Config) when is_list(Config) -> true = any_atom /= id(42), true = [] /= id(42), + %% Coverage of beam_utils:bif_to_test/3 + Empty = id([]), + ?T(==, [], Empty), + ok. -undef(TestOp). @@ -2198,7 +2204,31 @@ maps() -> evidence(#{0 := Charge}) when 0; #{[] => Charge} == #{[] => 42} -> ok. +cover_beam_dead(_Config) -> + Mod = ?FUNCTION_NAME, + Attr = [], + Fs = [{function,test,1,2, + [{label,1}, + {line,[]}, + {func_info,{atom,Mod},{atom,test},1}, + {label,2}, + %% Cover beam_dead:turn_op/1 using swapped operand order. + {test,is_ne_exact,{f,3},[{integer,1},{x,0}]}, + {test,is_eq_exact,{f,1},[{atom,a},{x,0}]}, + {label,3}, + {move,{atom,ok},{x,0}}, + return]}], + Exp = [{test,1}], + Asm = {Mod,Exp,Attr,Fs,3}, + {ok,Mod,Beam} = compile:forms(Asm, [from_asm,binary,report]), + {module,Mod} = code:load_binary(Mod, Mod, Beam), + ok = Mod:test(1), + ok = Mod:test(a), + {'EXIT',_} = (catch Mod:test(other)), + true = code:delete(Mod), + _ = code:purge(Mod), + ok. %% Call this function to turn off constant propagation. id(I) -> I. diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index 52b2da05f7..4b26a8dcdc 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -23,8 +23,9 @@ init_per_group/2,end_per_group/2, pmatch/1,mixed/1,aliases/1,non_matching_aliases/1, match_in_call/1,untuplify/1,shortcut_boolean/1,letify_guard/1, - selectify/1,underscore/1,match_map/1,map_vars_used/1, - coverage/1,grab_bag/1,literal_binary/1]). + selectify/1,deselectify/1,underscore/1,match_map/1,map_vars_used/1, + coverage/1,grab_bag/1,literal_binary/1, + unary_op/1]). -include_lib("common_test/include/ct.hrl"). @@ -38,9 +39,9 @@ groups() -> [{p,[parallel], [pmatch,mixed,aliases,non_matching_aliases, match_in_call,untuplify, - shortcut_boolean,letify_guard,selectify, + shortcut_boolean,letify_guard,selectify,deselectify, underscore,match_map,map_vars_used,coverage, - grab_bag,literal_binary]}]. + grab_bag,literal_binary,unary_op]}]. init_per_suite(Config) -> @@ -466,6 +467,66 @@ sel_same_value2(V) when V =:= 42; V =:= 43 -> sel_same_value2(_) -> error. +%% Test deconstruction of select_val instructions in beam_peep into +%% regular tests with just one possible value left. Hitting proper cases +%% in beam_peep relies on unification of labels by beam_jump. + +deselectify(Config) when is_list(Config) -> + one_or_other = desel_tuple_arity({1}), + two = desel_tuple_arity({1,1}), + one_or_other = desel_tuple_arity({1,1,1}), + + one_or_other = dsel_integer(1), + two = dsel_integer(2), + one_or_other = dsel_integer(3), + + one_or_other = dsel_integer_typecheck(1), + two = dsel_integer_typecheck(2), + one_or_other = dsel_integer_typecheck(3), + + one_or_other = dsel_atom(one), + two = dsel_atom(two), + one_or_other = dsel_atom(three), + + one_or_other = dsel_atom_typecheck(one), + two = dsel_atom_typecheck(two), + one_or_other = dsel_atom_typecheck(three). + +desel_tuple_arity(Tuple) when is_tuple(Tuple) -> + case Tuple of + {_} -> one_or_other; + {_,_} -> two; + _ -> one_or_other + end. + +dsel_integer(Val) -> + case Val of + 1 -> one_or_other; + 2 -> two; + _ -> one_or_other + end. + +dsel_integer_typecheck(Val) when is_integer(Val) -> + case Val of + 1 -> one_or_other; + 2 -> two; + _ -> one_or_other + end. + +dsel_atom(Val) -> + case Val of + one -> one_or_other; + two -> two; + _ -> one_or_other + end. + +dsel_atom_typecheck(Val) when is_atom(Val) -> + case Val of + one -> one_or_other; + two -> two; + _ -> one_or_other + end. + underscore(Config) when is_list(Config) -> case Config of [] -> @@ -557,6 +618,10 @@ grab_bag(_Config) -> {bad,16#555555555555555555555555555555555555555555555555555}], ok = grab_bag_remove_failure(L, unit, 0), + {42,<<43,44>>} = grab_bag_single_valued(<<42,43,44>>), + empty_list = grab_bag_single_valued([]), + empty_tuple = grab_bag_single_valued({}), + ok. grab_bag_remove_failure([], _Unit, _MaxFailure) -> @@ -574,6 +639,12 @@ grab_bag_remove_failure([{stretch,_,Mi}=Stretch | Specs], Unit, _MaxFailure) -> ok end. +%% Cover a line v3_kernel that places binary matching first. +grab_bag_single_valued(<<H,T/bytes>>) -> {H,T}; +grab_bag_single_valued([]) -> empty_list; +grab_bag_single_valued({}) -> empty_tuple. + + %% Regression in 19.0, reported by Alexei Sholik literal_binary(_Config) -> 3 = literal_binary_match(bar, <<"y">>), @@ -592,5 +663,74 @@ literal_binary_match(_, <<"x">>) -> 2; literal_binary_match(_, <<"y">>) -> 3; literal_binary_match(_, _) -> fail. +unary_op(Config) -> + %% ERL-514. This test case only verifies that the code + %% calculates the correct result, not that the generated + %% code is optimial. + + {non_associative,30} = unary_op_1('&'), + {non_associative,300} = unary_op_1('^'), + {non_associative,300} = unary_op_1('not'), + {non_associative,300} = unary_op_1('+'), + {non_associative,300} = unary_op_1('-'), + {non_associative,300} = unary_op_1('~~~'), + {non_associative,300} = unary_op_1('!'), + {non_associative,320} = unary_op_1('@'), + + error = unary_op_1(Config), + error = unary_op_1(abc), + error = unary_op_1(42), + + ok. + +unary_op_1(Vop@1) -> + %% If all optimizations are working as they should, there should + %% be no stack frame and all '=:=' tests should be coalesced into + %% a single select_val instruction. + + case Vop@1 =:= '&' of + true -> + {non_associative,30}; + false -> + case + case Vop@1 =:= '^' of + true -> + true; + false -> + case Vop@1 =:= 'not' of + true -> + true; + false -> + case Vop@1 =:= '+' of + true -> + true; + false -> + case Vop@1 =:= '-' of + true -> + true; + false -> + case Vop@1 =:= '~~~' of + true -> + true; + false -> + Vop@1 =:= '!' + end + end + end + end + end + of + true -> + {non_associative,300}; + false -> + case Vop@1 =:= '@' of + true -> + {non_associative,320}; + false -> + error + end + end + end. + id(I) -> I. diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index 4bd884d86b..d93c5dda1e 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -161,16 +161,17 @@ md5_1(Beam) -> %% Cover some code that handles internal errors. silly_coverage(Config) when is_list(Config) -> - %% sys_core_fold, sys_core_bsm, sys_core_setel, v3_kernel + %% sys_core_fold, sys_core_alias, sys_core_bsm, sys_core_setel, v3_kernel BadCoreErlang = {c_module,[], name,[],[], [{{c_var,[],{foo,2}},seriously_bad_body}]}, expect_error(fun() -> sys_core_fold:module(BadCoreErlang, []) end), + expect_error(fun() -> sys_core_alias:module(BadCoreErlang, []) end), expect_error(fun() -> sys_core_bsm:module(BadCoreErlang, []) end), expect_error(fun() -> sys_core_dsetel:module(BadCoreErlang, []) end), expect_error(fun() -> v3_kernel:module(BadCoreErlang, []) end), - %% v3_life + %% v3_codegen BadKernel = {k_mdef,[],?MODULE, [{foo,0}], [], @@ -178,11 +179,7 @@ silly_coverage(Config) when is_list(Config) -> {k,[],[],[]}, f,0,[], seriously_bad_body}]}, - expect_error(fun() -> v3_life:module(BadKernel, []) end), - - %% v3_codegen - CodegenInput = {?MODULE,[{foo,0}],[],[{function,foo,0,[a|b],a,b,[]}]}, - expect_error(fun() -> v3_codegen:module(CodegenInput, []) end), + expect_error(fun() -> v3_codegen:module(BadKernel, []) end), %% beam_a BeamAInput = {?MODULE,[{foo,0}],[], @@ -321,8 +318,7 @@ expect_error(Fun) -> io:format("~p", [Any]), ct:fail(call_was_supposed_to_fail) catch - Class:Reason -> - Stk = erlang:get_stacktrace(), + Class:Reason:Stk -> io:format("~p:~p\n~p\n", [Class,Reason,Stk]), case {Class,Reason} of {error,undef} -> diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl index 8304672558..5e386790c0 100644 --- a/lib/compiler/test/receive_SUITE.erl +++ b/lib/compiler/test/receive_SUITE.erl @@ -222,9 +222,8 @@ do_ref_opt(Source, PrivDir) -> collect_recv_opt_instrs(Code) end, ok - catch Class:Error -> - io:format("~s: ~p ~p\n~p\n", - [Source,Class,Error,erlang:get_stacktrace()]), + catch Class:Error:Stk -> + io:format("~s: ~p ~p\n~p\n", [Source,Class,Error,Stk]), error end. @@ -265,6 +264,10 @@ export(Config) when is_list(Config) -> self() ! {result,Ref,42}, 42 = export_1(Ref), {error,timeout} = export_1(Ref), + + self() ! {result,Ref}, + {ok,Ref} = export_2(), + ok. export_1(Reference) -> @@ -281,6 +284,10 @@ export_1(Reference) -> id({build,self()}), Result. +export_2() -> + receive {result,Result} -> ok end, + {ok,Result}. + wait(Config) when is_list(Config) -> self() ! <<42>>, <<42>> = wait_1(r, 1, 2), diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl index a591d6cc93..8cf7928cc4 100644 --- a/lib/compiler/test/trycatch_SUITE.erl +++ b/lib/compiler/test/trycatch_SUITE.erl @@ -26,7 +26,8 @@ nested_of/1,nested_catch/1,nested_after/1, nested_horrid/1,last_call_optimization/1,bool/1, plain_catch_coverage/1,andalso_orelse/1,get_in_try/1, - hockey/1,handle_info/1,catch_in_catch/1,grab_bag/1]). + hockey/1,handle_info/1,catch_in_catch/1,grab_bag/1, + stacktrace/1,nested_stacktrace/1]). -include_lib("common_test/include/ct.hrl"). @@ -42,7 +43,8 @@ groups() -> after_oops,eclectic,rethrow,nested_of,nested_catch, nested_after,nested_horrid,last_call_optimization, bool,plain_catch_coverage,andalso_orelse,get_in_try, - hockey,handle_info,catch_in_catch,grab_bag]}]. + hockey,handle_info,catch_in_catch,grab_bag, + stacktrace,nested_stacktrace]}]. init_per_suite(Config) -> @@ -324,11 +326,11 @@ eclectic(Conf) when is_list(Conf) -> {{error,{exit,V},{'EXIT',V}},V} = eclectic_1({foo,{error,{exit,V}}}, error, {value,V}), {{value,{value,V},V}, - {'EXIT',{badarith,[{?MODULE,my_add,2,_}|_]}}} = + {'EXIT',{badarith,[{erlang,'+',[0,a],_},{?MODULE,my_add,2,_}|_]}}} = eclectic_1({foo,{value,{value,V}}}, undefined, {'add',{0,a}}), {{'EXIT',V},V} = eclectic_1({catch_foo,{exit,V}}, undefined, {throw,V}), - {{error,{'div',{1,0}},{'EXIT',{badarith,[{?MODULE,my_div,2,_}|_]}}}, + {{error,{'div',{1,0}},{'EXIT',{badarith,[{erlang,'div',[1,0],_},{?MODULE,my_div,2,_}|_]}}}, {'EXIT',V}} = eclectic_1({foo,{error,{'div',{1,0}}}}, error, {exit,V}), {{{error,V},{'EXIT',{V,[{?MODULE,foo,1,_}|_]}}}, @@ -345,7 +347,7 @@ eclectic(Conf) when is_list(Conf) -> eclectic_2({error,{value,V}}, throw, {error,V}), {{caught,{'EXIT',{badarg,[{erlang,abs,[V],_}|_]}}},V} = eclectic_2({value,{'abs',V}}, undefined, {value,V}), - {{caught,{'EXIT',{badarith,[{?MODULE,my_add,2,_}|_]}}},V} = + {{caught,{'EXIT',{badarith,[{erlang,'+',[0,a],_},{?MODULE,my_add,2,_}|_]}}},V} = eclectic_2({exit,{'add',{0,a}}}, exit, {value,V}), {{caught,{'EXIT',V}},undefined} = eclectic_2({value,{error,V}}, undefined, {exit,V}), @@ -1039,5 +1041,123 @@ grab_bag(_Config) -> ok. +stacktrace(_Config) -> + V = [make_ref()|self()], + case ?MODULE:module_info(native) of + false -> + {value2,{caught1,badarg,[{erlang,abs,[V],_}|_]}} = + stacktrace_1({'abs',V}, error, {value,V}), + {caught2,{error,badarith},[{erlang,'+',[0,a],_}, + {?MODULE,my_add,2,_}|_]} = + stacktrace_1({'div',{1,0}}, error, {'add',{0,a}}); + true -> + {value2,{caught1,badarg,[{?MODULE,my_abs,1,_}|_]}} = + stacktrace_1({'abs',V}, error, {value,V}), + {caught2,{error,badarith},[{?MODULE,my_add,2,_}|_]} = + stacktrace_1({'div',{1,0}}, error, {'add',{0,a}}) + end, + {caught2,{error,{try_clause,V}},[{?MODULE,stacktrace_1,3,_}|_]} = + stacktrace_1({value,V}, error, {value,V}), + {caught2,{throw,V},[{?MODULE,foo,1,_}|_]} = + stacktrace_1({value,V}, error, {throw,V}), + + try + stacktrace_2() + catch + error:{badmatch,_}:Stk2 -> + [{?MODULE,stacktrace_2,0,_}, + {?MODULE,stacktrace,1,_}|_] = Stk2, + Stk2 = erlang:get_stacktrace(), + ok + end, + + try + stacktrace_3(a, b) + catch + error:function_clause:Stk3 -> + Stk3 = erlang:get_stacktrace(), + case lists:module_info(native) of + false -> + [{lists,prefix,[a,b],_}|_] = Stk3; + true -> + [{lists,prefix,2,_}|_] = Stk3 + end + end, + + try + throw(x) + catch + throw:x:IntentionallyUnused -> + ok + end. + +stacktrace_1(X, C1, Y) -> + try try foo(X) of + C1 -> value1 + catch + C1:D1:Stk1 -> + Stk1 = erlang:get_stacktrace(), + {caught1,D1,Stk1} + after + foo(Y) + end of + V2 -> {value2,V2} + catch + C2:D2:Stk2 -> {caught2,{C2,D2},Stk2=erlang:get_stacktrace()} + end. + +stacktrace_2() -> + ok = erlang:process_info(self(), current_function), + ok. + +stacktrace_3(A, B) -> + {ok,lists:prefix(A, B)}. + +nested_stacktrace(_Config) -> + V = [{make_ref()}|[self()]], + value1 = nested_stacktrace_1({{value,{V,x1}},void,{V,x1}}, + {void,void,void}), + case ?MODULE:module_info(native) of + false -> + {caught1, + [{erlang,'+',[V,x1],_},{?MODULE,my_add,2,_}|_], + value2} = + nested_stacktrace_1({{'add',{V,x1}},error,badarith}, + {{value,{V,x2}},void,{V,x2}}), + {caught1, + [{erlang,'+',[V,x1],_},{?MODULE,my_add,2,_}|_], + {caught2,[{erlang,abs,[V],_}|_]}} = + nested_stacktrace_1({{'add',{V,x1}},error,badarith}, + {{'abs',V},error,badarg}); + true -> + {caught1, + [{?MODULE,my_add,2,_}|_], + value2} = + nested_stacktrace_1({{'add',{V,x1}},error,badarith}, + {{value,{V,x2}},void,{V,x2}}), + {caught1, + [{?MODULE,my_add,2,_}|_], + {caught2,[{?MODULE,my_abs,1,_}|_]}} = + nested_stacktrace_1({{'add',{V,x1}},error,badarith}, + {{'abs',V},error,badarg}) + end, + ok. + +nested_stacktrace_1({X1,C1,V1}, {X2,C2,V2}) -> + try foo(X1) of + V1 -> value1 + catch + C1:V1:S1 -> + S1 = erlang:get_stacktrace(), + T2 = try foo(X2) of + V2 -> value2 + catch + C2:V2:S2 -> + S2 = erlang:get_stacktrace(), + {caught2,S2} + end, + {caught1,S1,T2} + end. + id(I) -> I. diff --git a/lib/compiler/test/z_SUITE.erl b/lib/compiler/test/z_SUITE.erl index d864184f4c..cd95d0e733 100644 --- a/lib/compiler/test/z_SUITE.erl +++ b/lib/compiler/test/z_SUITE.erl @@ -54,8 +54,7 @@ do_loaded([{M,_}|Ms], E0) -> _ = M:module_info(functions), E0 catch - C:Error -> - Stk = erlang:get_stacktrace(), + C:Error:Stk -> io:format("~p:~p\n~p\n", [C,Error,Stk]), E0 + 1 end, diff --git a/lib/compiler/vsn.mk b/lib/compiler/vsn.mk index 435a57aac2..082786c7d8 100644 --- a/lib/compiler/vsn.mk +++ b/lib/compiler/vsn.mk @@ -1 +1 @@ -COMPILER_VSN = 7.1.3 +COMPILER_VSN = 7.1.4 diff --git a/lib/cosEvent/doc/src/Makefile b/lib/cosEvent/doc/src/Makefile index ba505d6f7b..4fcb210e5a 100644 --- a/lib/cosEvent/doc/src/Makefile +++ b/lib/cosEvent/doc/src/Makefile @@ -1,8 +1,8 @@ # # %CopyrightBegin% -# -# Copyright Ericsson AB 1999-2016. All Rights Reserved. -# +# +# Copyright Ericsson AB 1999-2017. All Rights Reserved. +# # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at @@ -14,7 +14,7 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. -# +# # %CopyrightEnd% # # @@ -49,31 +49,26 @@ XML_REF3_FILES = \ cosEventApp.xml XML_PART_FILES = \ - part.xml \ - part_notes.xml + part.xml XML_CHAPTER_FILES = \ ch_contents.xml \ ch_introduction.xml \ ch_event_service.xml \ - notes.xml + notes.xml BOOK_FILES = book.xml XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \ - $(XML_PART_FILES) $(XML_CHAPTER_FILES) + $(XML_PART_FILES) $(XML_CHAPTER_FILES) -TECHNICAL_DESCR_FILES = +TECHNICAL_DESCR_FILES = GIF_FILES = \ - book.gif \ - notes.gif \ - ref_man.gif \ - user_guide.gif \ e_s_components.gif \ - e_s_models.gif + e_s_models.gif -PS_FILES = +PS_FILES = # ---------------------------------------------------- @@ -84,7 +79,7 @@ HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) INFO_FILE = ../../info -EXTRA_FILES = summary.html.src \ +EXTRA_FILES = \ $(DEFAULT_GIF_FILES) \ $(DEFAULT_HTML_FILES) \ $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ @@ -97,10 +92,10 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += +XML_FLAGS += +DVIPS_FLAGS += # ---------------------------------------------------- # Targets @@ -130,11 +125,11 @@ gifs: $(GIF_FILES:%=$(HTMLDIR)/%) $(INDEX_TARGET): $(INDEX_SRC) sed -e 's;%VSN%;$(VSN);' $(INDEX_SRC) > $(INDEX_TARGET) -debug opt: +debug opt: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs diff --git a/lib/cosEvent/doc/src/book.gif b/lib/cosEvent/doc/src/book.gif Binary files differdeleted file mode 100644 index 94b3868792..0000000000 --- a/lib/cosEvent/doc/src/book.gif +++ /dev/null diff --git a/lib/cosEvent/doc/src/fascicules.xml b/lib/cosEvent/doc/src/fascicules.xml deleted file mode 100644 index 37feca543f..0000000000 --- a/lib/cosEvent/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/cosEvent/doc/src/notes.gif b/lib/cosEvent/doc/src/notes.gif Binary files differdeleted file mode 100644 index e000cca26a..0000000000 --- a/lib/cosEvent/doc/src/notes.gif +++ /dev/null diff --git a/lib/cosEvent/doc/src/notes.xml b/lib/cosEvent/doc/src/notes.xml index fe94cb64d3..ba0b0d88db 100644 --- a/lib/cosEvent/doc/src/notes.xml +++ b/lib/cosEvent/doc/src/notes.xml @@ -33,7 +33,22 @@ <file>notes.xml</file> </header> - <section><title>cosEvent 2.2.1</title> + <section><title>cosEvent 2.2.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Removed all old unused files in the documentation. + </p> + <p> + Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p> + </item> + </list> + </section> + +</section> + +<section><title>cosEvent 2.2.1</title> <section><title>Improvements and New Features</title> <list> diff --git a/lib/cosEvent/doc/src/part_notes.xml b/lib/cosEvent/doc/src/part_notes.xml deleted file mode 100644 index 37103a5592..0000000000 --- a/lib/cosEvent/doc/src/part_notes.xml +++ /dev/null @@ -1,38 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>1999</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>cosEvent Release Notes</title> - <prepared></prepared> - <docno></docno> - <date>1999-04-20</date> - <rev>1.0</rev> - <file>part_notes.xml</file> - </header> - <description> - <p>The cosEvent Application is an Erlang implementation of a CORBA Service - CosEvent.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/cosEvent/doc/src/ref_man.gif b/lib/cosEvent/doc/src/ref_man.gif Binary files differdeleted file mode 100644 index b13c4efd53..0000000000 --- a/lib/cosEvent/doc/src/ref_man.gif +++ /dev/null diff --git a/lib/cosEvent/doc/src/summary.html.src b/lib/cosEvent/doc/src/summary.html.src deleted file mode 100644 index 6196223480..0000000000 --- a/lib/cosEvent/doc/src/summary.html.src +++ /dev/null @@ -1 +0,0 @@ -Orber OMG Event Service
\ No newline at end of file diff --git a/lib/cosEvent/doc/src/user_guide.gif b/lib/cosEvent/doc/src/user_guide.gif Binary files differdeleted file mode 100644 index e6275a803d..0000000000 --- a/lib/cosEvent/doc/src/user_guide.gif +++ /dev/null diff --git a/lib/cosEvent/vsn.mk b/lib/cosEvent/vsn.mk index c39bed9fe4..578950294a 100644 --- a/lib/cosEvent/vsn.mk +++ b/lib/cosEvent/vsn.mk @@ -1,2 +1,2 @@ -COSEVENT_VSN = 2.2.1 +COSEVENT_VSN = 2.2.2 diff --git a/lib/cosEventDomain/doc/src/Makefile b/lib/cosEventDomain/doc/src/Makefile index 0f18e43547..9faf65394d 100644 --- a/lib/cosEventDomain/doc/src/Makefile +++ b/lib/cosEventDomain/doc/src/Makefile @@ -1,8 +1,8 @@ # # %CopyrightBegin% -# -# Copyright Ericsson AB 2001-2016. All Rights Reserved. -# +# +# Copyright Ericsson AB 2001-2017. All Rights Reserved. +# # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at @@ -14,7 +14,7 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. -# +# # %CopyrightEnd% # # @@ -44,31 +44,24 @@ XML_REF3_FILES = \ cosEventDomainApp.xml XML_PART_FILES = \ - part.xml \ - part_notes.xml + part.xml XML_CHAPTER_FILES = \ ch_contents.xml \ ch_introduction.xml \ ch_QoS.xml \ ch_event_domain_service.xml \ - notes.xml + notes.xml BOOK_FILES = book.xml XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \ - $(XML_PART_FILES) $(XML_CHAPTER_FILES) + $(XML_PART_FILES) $(XML_CHAPTER_FILES) -TECHNICAL_DESCR_FILES = +TECHNICAL_DESCR_FILES = -GIF_FILES = \ - book.gif \ - notes.gif \ - ref_man.gif \ - user_guide.gif - - -PS_FILES = +GIF_FILES = +PS_FILES = # ---------------------------------------------------- @@ -78,7 +71,7 @@ HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) INFO_FILE = ../../info -EXTRA_FILES = summary.html.src \ +EXTRA_FILES = \ $(DEFAULT_GIF_FILES) \ $(DEFAULT_HTML_FILES) \ $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ @@ -91,10 +84,10 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += +XML_FLAGS += +DVIPS_FLAGS += # ---------------------------------------------------- # Targets @@ -124,11 +117,11 @@ gifs: $(GIF_FILES:%=$(HTMLDIR)/%) $(INDEX_TARGET): $(INDEX_SRC) sed -e 's;%VSN%;$(VSN);' $(INDEX_SRC) > $(INDEX_TARGET) -debug opt: +debug opt: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs diff --git a/lib/cosEventDomain/doc/src/book.gif b/lib/cosEventDomain/doc/src/book.gif Binary files differdeleted file mode 100644 index 94b3868792..0000000000 --- a/lib/cosEventDomain/doc/src/book.gif +++ /dev/null diff --git a/lib/cosEventDomain/doc/src/fascicules.xml b/lib/cosEventDomain/doc/src/fascicules.xml deleted file mode 100644 index 37feca543f..0000000000 --- a/lib/cosEventDomain/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/cosEventDomain/doc/src/notes.gif b/lib/cosEventDomain/doc/src/notes.gif Binary files differdeleted file mode 100644 index e000cca26a..0000000000 --- a/lib/cosEventDomain/doc/src/notes.gif +++ /dev/null diff --git a/lib/cosEventDomain/doc/src/notes.xml b/lib/cosEventDomain/doc/src/notes.xml index 5e5bb2c33e..bd0a119ad2 100644 --- a/lib/cosEventDomain/doc/src/notes.xml +++ b/lib/cosEventDomain/doc/src/notes.xml @@ -32,7 +32,22 @@ <file>notes.xml</file> </header> - <section><title>cosEventDomain 1.2.1</title> + <section><title>cosEventDomain 1.2.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Removed all old unused files in the documentation. + </p> + <p> + Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p> + </item> + </list> + </section> + +</section> + +<section><title>cosEventDomain 1.2.1</title> <section><title>Improvements and New Features</title> <list> diff --git a/lib/cosEventDomain/doc/src/part_notes.xml b/lib/cosEventDomain/doc/src/part_notes.xml deleted file mode 100644 index af6864decf..0000000000 --- a/lib/cosEventDomain/doc/src/part_notes.xml +++ /dev/null @@ -1,37 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2001</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>cosEventDomain Release Notes</title> - <prepared>Niclas Eklund</prepared> - <docno></docno> - <date>2001-08-20</date> - <rev>1.0</rev> - </header> - <description> - <p>The cosEventDomain Application is an Erlang implementation of a CORBA Service - CosEventDomainAdmin.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/cosEventDomain/doc/src/ref_man.gif b/lib/cosEventDomain/doc/src/ref_man.gif Binary files differdeleted file mode 100644 index b13c4efd53..0000000000 --- a/lib/cosEventDomain/doc/src/ref_man.gif +++ /dev/null diff --git a/lib/cosEventDomain/doc/src/summary.html.src b/lib/cosEventDomain/doc/src/summary.html.src deleted file mode 100644 index 922c956633..0000000000 --- a/lib/cosEventDomain/doc/src/summary.html.src +++ /dev/null @@ -1 +0,0 @@ -Orber OMG Event Domain Service
\ No newline at end of file diff --git a/lib/cosEventDomain/doc/src/user_guide.gif b/lib/cosEventDomain/doc/src/user_guide.gif Binary files differdeleted file mode 100644 index e6275a803d..0000000000 --- a/lib/cosEventDomain/doc/src/user_guide.gif +++ /dev/null diff --git a/lib/cosEventDomain/vsn.mk b/lib/cosEventDomain/vsn.mk index 4e10d6ac60..0c063a00f9 100644 --- a/lib/cosEventDomain/vsn.mk +++ b/lib/cosEventDomain/vsn.mk @@ -1,2 +1,2 @@ -COSEVENTDOMAIN_VSN = 1.2.1 +COSEVENTDOMAIN_VSN = 1.2.2 diff --git a/lib/cosFileTransfer/doc/src/Makefile b/lib/cosFileTransfer/doc/src/Makefile index 8d8c736f1b..fcaa88c1e2 100644 --- a/lib/cosFileTransfer/doc/src/Makefile +++ b/lib/cosFileTransfer/doc/src/Makefile @@ -1,8 +1,8 @@ # # %CopyrightBegin% -# -# Copyright Ericsson AB 2000-2016. All Rights Reserved. -# +# +# Copyright Ericsson AB 2000-2017. All Rights Reserved. +# # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at @@ -14,7 +14,7 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. -# +# # %CopyrightEnd% # # @@ -46,8 +46,7 @@ XML_REF3_FILES = \ CosFileTransfer_FileIterator.xml XML_PART_FILES = \ - part.xml \ - part_notes.xml + part.xml XML_CHAPTER_FILES = \ ch_contents.xml \ ch_introduction.xml \ @@ -59,18 +58,14 @@ XML_CHAPTER_FILES = \ BOOK_FILES = book.xml XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \ - $(XML_PART_FILES) $(XML_CHAPTER_FILES) + $(XML_PART_FILES) $(XML_CHAPTER_FILES) -TECHNICAL_DESCR_FILES = +TECHNICAL_DESCR_FILES = GIF_FILES = \ - book.gif \ - notes.gif \ - ref_man.gif \ - user_guide.gif \ CosFileTransfer.gif -PS_FILES = +PS_FILES = # ---------------------------------------------------- @@ -83,7 +78,7 @@ HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ INFO_FILE = ../../info -EXTRA_FILES = summary.html.src \ +EXTRA_FILES = \ $(DEFAULT_GIF_FILES) \ $(DEFAULT_HTML_FILES) \ $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) @@ -95,10 +90,10 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += +XML_FLAGS += +DVIPS_FLAGS += # ---------------------------------------------------- # Targets @@ -127,11 +122,11 @@ gifs: $(GIF_FILES:%=$(HTMLDIR)/%) $(INDEX_TARGET): $(INDEX_SRC) sed -e 's;%VSN%;$(VSN);' $(INDEX_SRC) > $(INDEX_TARGET) -debug opt: +debug opt: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs diff --git a/lib/cosFileTransfer/doc/src/book.gif b/lib/cosFileTransfer/doc/src/book.gif Binary files differdeleted file mode 100644 index 94b3868792..0000000000 --- a/lib/cosFileTransfer/doc/src/book.gif +++ /dev/null diff --git a/lib/cosFileTransfer/doc/src/fascicules.xml b/lib/cosFileTransfer/doc/src/fascicules.xml deleted file mode 100644 index 37feca543f..0000000000 --- a/lib/cosFileTransfer/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/cosFileTransfer/doc/src/notes.gif b/lib/cosFileTransfer/doc/src/notes.gif Binary files differdeleted file mode 100644 index e000cca26a..0000000000 --- a/lib/cosFileTransfer/doc/src/notes.gif +++ /dev/null diff --git a/lib/cosFileTransfer/doc/src/notes.xml b/lib/cosFileTransfer/doc/src/notes.xml index 58ab087014..e0b4bdf64b 100644 --- a/lib/cosFileTransfer/doc/src/notes.xml +++ b/lib/cosFileTransfer/doc/src/notes.xml @@ -31,7 +31,22 @@ <file>notes.xml</file> </header> - <section><title>cosFileTransfer 1.2.1</title> + <section><title>cosFileTransfer 1.2.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Removed all old unused files in the documentation. + </p> + <p> + Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p> + </item> + </list> + </section> + +</section> + +<section><title>cosFileTransfer 1.2.1</title> <section><title>Improvements and New Features</title> <list> diff --git a/lib/cosFileTransfer/doc/src/part_notes.xml b/lib/cosFileTransfer/doc/src/part_notes.xml deleted file mode 100644 index d91de39b1f..0000000000 --- a/lib/cosFileTransfer/doc/src/part_notes.xml +++ /dev/null @@ -1,37 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2000</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>cosFileTransfer Release Notes</title> - <prepared></prepared> - <docno></docno> - <date>2000-08-24</date> - <rev>1.0</rev> - </header> - <description> - <p>The cosFileTransfer Application is an Erlang implementation of the OMG - CORBA FileTransfer Service.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/cosFileTransfer/doc/src/ref_man.gif b/lib/cosFileTransfer/doc/src/ref_man.gif Binary files differdeleted file mode 100644 index b13c4efd53..0000000000 --- a/lib/cosFileTransfer/doc/src/ref_man.gif +++ /dev/null diff --git a/lib/cosFileTransfer/doc/src/summary.html.src b/lib/cosFileTransfer/doc/src/summary.html.src deleted file mode 100644 index 4c66e147e9..0000000000 --- a/lib/cosFileTransfer/doc/src/summary.html.src +++ /dev/null @@ -1 +0,0 @@ -Orber OMG File Transfer Service. diff --git a/lib/cosFileTransfer/doc/src/user_guide.gif b/lib/cosFileTransfer/doc/src/user_guide.gif Binary files differdeleted file mode 100644 index e6275a803d..0000000000 --- a/lib/cosFileTransfer/doc/src/user_guide.gif +++ /dev/null diff --git a/lib/cosFileTransfer/vsn.mk b/lib/cosFileTransfer/vsn.mk index e271c05242..561f11fbb2 100644 --- a/lib/cosFileTransfer/vsn.mk +++ b/lib/cosFileTransfer/vsn.mk @@ -1 +1 @@ -COSFILETRANSFER_VSN = 1.2.1 +COSFILETRANSFER_VSN = 1.2.2 diff --git a/lib/cosNotification/doc/src/Makefile b/lib/cosNotification/doc/src/Makefile index 6207290101..43ed8294c4 100644 --- a/lib/cosNotification/doc/src/Makefile +++ b/lib/cosNotification/doc/src/Makefile @@ -1,8 +1,8 @@ # # %CopyrightBegin% -# -# Copyright Ericsson AB 2000-2016. All Rights Reserved. -# +# +# Copyright Ericsson AB 2000-2017. All Rights Reserved. +# # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at @@ -14,7 +14,7 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. -# +# # %CopyrightEnd% # # @@ -70,8 +70,7 @@ XML_REF3_FILES = \ XML_PART_FILES = \ - part.xml \ - part_notes.xml + part.xml XML_CHAPTER_FILES = \ ch_contents.xml \ ch_introduction.xml \ @@ -85,19 +84,15 @@ XML_CHAPTER_FILES = \ BOOK_FILES = book.xml XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \ - $(XML_PART_FILES) $(XML_CHAPTER_FILES) + $(XML_PART_FILES) $(XML_CHAPTER_FILES) -TECHNICAL_DESCR_FILES = +TECHNICAL_DESCR_FILES = GIF_FILES = \ - book.gif \ - notes.gif \ - ref_man.gif \ - user_guide.gif \ eventstructure.gif \ notificationFlow.gif -PS_FILES = +PS_FILES = # ---------------------------------------------------- @@ -107,7 +102,7 @@ HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) INFO_FILE = ../../info -EXTRA_FILES = summary.html.src \ +EXTRA_FILES = \ $(DEFAULT_GIF_FILES) \ $(DEFAULT_HTML_FILES) \ $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ @@ -120,10 +115,10 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += +XML_FLAGS += +DVIPS_FLAGS += # ---------------------------------------------------- # Targets @@ -152,11 +147,11 @@ gifs: $(GIF_FILES:%=$(HTMLDIR)/%) $(INDEX_TARGET): $(INDEX_SRC) sed -e 's;%VSN%;$(VSN);' $(INDEX_SRC) > $(INDEX_TARGET) -debug opt: +debug opt: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs diff --git a/lib/cosNotification/doc/src/book.gif b/lib/cosNotification/doc/src/book.gif Binary files differdeleted file mode 100644 index 94b3868792..0000000000 --- a/lib/cosNotification/doc/src/book.gif +++ /dev/null diff --git a/lib/cosNotification/doc/src/fascicules.xml b/lib/cosNotification/doc/src/fascicules.xml deleted file mode 100644 index 37feca543f..0000000000 --- a/lib/cosNotification/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/cosNotification/doc/src/notes.gif b/lib/cosNotification/doc/src/notes.gif Binary files differdeleted file mode 100644 index e000cca26a..0000000000 --- a/lib/cosNotification/doc/src/notes.gif +++ /dev/null diff --git a/lib/cosNotification/doc/src/notes.xml b/lib/cosNotification/doc/src/notes.xml index 1237000153..bf0fc73548 100644 --- a/lib/cosNotification/doc/src/notes.xml +++ b/lib/cosNotification/doc/src/notes.xml @@ -32,7 +32,22 @@ <file>notes.xml</file> </header> - <section><title>cosNotification 1.2.2</title> + <section><title>cosNotification 1.2.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Removed all old unused files in the documentation. + </p> + <p> + Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p> + </item> + </list> + </section> + +</section> + +<section><title>cosNotification 1.2.2</title> <section><title>Improvements and New Features</title> <list> diff --git a/lib/cosNotification/doc/src/part_notes.xml b/lib/cosNotification/doc/src/part_notes.xml deleted file mode 100644 index c999d885c1..0000000000 --- a/lib/cosNotification/doc/src/part_notes.xml +++ /dev/null @@ -1,37 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2000</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>cosNotification Release Notes</title> - <prepared>Niclas Eklund</prepared> - <docno></docno> - <date>2000-01-31</date> - <rev>1.0</rev> - </header> - <description> - <p>The cosNotification Application is an Erlang implementation of the OMG - CORBA Notification Service.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/cosNotification/doc/src/ref_man.gif b/lib/cosNotification/doc/src/ref_man.gif Binary files differdeleted file mode 100644 index b13c4efd53..0000000000 --- a/lib/cosNotification/doc/src/ref_man.gif +++ /dev/null diff --git a/lib/cosNotification/doc/src/summary.html.src b/lib/cosNotification/doc/src/summary.html.src deleted file mode 100644 index 92ade4f9cd..0000000000 --- a/lib/cosNotification/doc/src/summary.html.src +++ /dev/null @@ -1 +0,0 @@ -Orber OMG Notification Service
\ No newline at end of file diff --git a/lib/cosNotification/doc/src/user_guide.gif b/lib/cosNotification/doc/src/user_guide.gif Binary files differdeleted file mode 100644 index e6275a803d..0000000000 --- a/lib/cosNotification/doc/src/user_guide.gif +++ /dev/null diff --git a/lib/cosNotification/vsn.mk b/lib/cosNotification/vsn.mk index 0d95ab4853..1677057670 100644 --- a/lib/cosNotification/vsn.mk +++ b/lib/cosNotification/vsn.mk @@ -1,2 +1,2 @@ -COSNOTIFICATION_VSN = 1.2.2 +COSNOTIFICATION_VSN = 1.2.3 diff --git a/lib/cosProperty/doc/src/Makefile b/lib/cosProperty/doc/src/Makefile index 6b210500f9..ec11ca1735 100644 --- a/lib/cosProperty/doc/src/Makefile +++ b/lib/cosProperty/doc/src/Makefile @@ -1,8 +1,8 @@ # # %CopyrightBegin% -# -# Copyright Ericsson AB 2000-2016. All Rights Reserved. -# +# +# Copyright Ericsson AB 2000-2017. All Rights Reserved. +# # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at @@ -14,7 +14,7 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. -# +# # %CopyrightEnd% # # @@ -46,11 +46,10 @@ XML_REF3_FILES = \ CosPropertyService_PropertiesIterator.xml \ CosPropertyService_PropertyNamesIterator.xml -XML_REF6_FILES = +XML_REF6_FILES = XML_PART_FILES = \ - part.xml \ - part_notes.xml + part.xml XML_CHAPTER_FILES = \ ch_contents.xml \ ch_introduction.xml \ @@ -61,17 +60,13 @@ XML_CHAPTER_FILES = \ BOOK_FILES = book.xml XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \ - $(XML_PART_FILES) $(XML_CHAPTER_FILES) + $(XML_PART_FILES) $(XML_CHAPTER_FILES) -TECHNICAL_DESCR_FILES = +TECHNICAL_DESCR_FILES = -GIF_FILES = \ - book.gif \ - notes.gif \ - ref_man.gif \ - user_guide.gif +GIF_FILES = -PS_FILES = +PS_FILES = # ---------------------------------------------------- @@ -82,7 +77,7 @@ HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ INFO_FILE = ../../info -EXTRA_FILES = summary.html.src \ +EXTRA_FILES = \ $(DEFAULT_GIF_FILES) \ $(DEFAULT_HTML_FILES) \ $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ @@ -97,10 +92,10 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += +XML_FLAGS += +DVIPS_FLAGS += # ---------------------------------------------------- # Targets @@ -129,11 +124,11 @@ gifs: $(GIF_FILES:%=$(HTMLDIR)/%) $(INDEX_TARGET): $(INDEX_SRC) sed -e 's;%VSN%;$(VSN);' $(INDEX_SRC) > $(INDEX_TARGET) -debug opt: +debug opt: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs diff --git a/lib/cosProperty/doc/src/book.gif b/lib/cosProperty/doc/src/book.gif Binary files differdeleted file mode 100644 index 94b3868792..0000000000 --- a/lib/cosProperty/doc/src/book.gif +++ /dev/null diff --git a/lib/cosProperty/doc/src/fascicules.xml b/lib/cosProperty/doc/src/fascicules.xml deleted file mode 100644 index 37feca543f..0000000000 --- a/lib/cosProperty/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/cosProperty/doc/src/notes.gif b/lib/cosProperty/doc/src/notes.gif Binary files differdeleted file mode 100644 index e000cca26a..0000000000 --- a/lib/cosProperty/doc/src/notes.gif +++ /dev/null diff --git a/lib/cosProperty/doc/src/notes.xml b/lib/cosProperty/doc/src/notes.xml index e5d22982c5..4de246de67 100644 --- a/lib/cosProperty/doc/src/notes.xml +++ b/lib/cosProperty/doc/src/notes.xml @@ -33,7 +33,22 @@ </header> - <section><title>cosProperty 1.2.2</title> + <section><title>cosProperty 1.2.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Removed all old unused files in the documentation. + </p> + <p> + Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p> + </item> + </list> + </section> + +</section> + +<section><title>cosProperty 1.2.2</title> <section><title>Improvements and New Features</title> <list> diff --git a/lib/cosProperty/doc/src/part_notes.xml b/lib/cosProperty/doc/src/part_notes.xml deleted file mode 100644 index bb3221e41c..0000000000 --- a/lib/cosProperty/doc/src/part_notes.xml +++ /dev/null @@ -1,37 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2000</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>cosProperty Release Notes</title> - <prepared>Niclas Eklund</prepared> - <docno></docno> - <date>2000-06-07</date> - <rev>1.0</rev> - </header> - <description> - <p>The cosProperty Application is an Erlang implementation of the OMG - CORBA Property Service.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/cosProperty/doc/src/ref_man.gif b/lib/cosProperty/doc/src/ref_man.gif Binary files differdeleted file mode 100644 index b13c4efd53..0000000000 --- a/lib/cosProperty/doc/src/ref_man.gif +++ /dev/null diff --git a/lib/cosProperty/doc/src/summary.html.src b/lib/cosProperty/doc/src/summary.html.src deleted file mode 100644 index 87370c659c..0000000000 --- a/lib/cosProperty/doc/src/summary.html.src +++ /dev/null @@ -1 +0,0 @@ -Orber OMG Property Service.
\ No newline at end of file diff --git a/lib/cosProperty/doc/src/user_guide.gif b/lib/cosProperty/doc/src/user_guide.gif Binary files differdeleted file mode 100644 index e6275a803d..0000000000 --- a/lib/cosProperty/doc/src/user_guide.gif +++ /dev/null diff --git a/lib/cosProperty/vsn.mk b/lib/cosProperty/vsn.mk index 78ba88445d..a3a952346e 100644 --- a/lib/cosProperty/vsn.mk +++ b/lib/cosProperty/vsn.mk @@ -1,2 +1,2 @@ -COSPROPERTY_VSN = 1.2.2 +COSPROPERTY_VSN = 1.2.3 diff --git a/lib/cosTime/doc/src/Makefile b/lib/cosTime/doc/src/Makefile index f3fdafa58a..6886d2812c 100644 --- a/lib/cosTime/doc/src/Makefile +++ b/lib/cosTime/doc/src/Makefile @@ -1,8 +1,8 @@ # # %CopyrightBegin% -# -# Copyright Ericsson AB 2000-2016. All Rights Reserved. -# +# +# Copyright Ericsson AB 2000-2017. All Rights Reserved. +# # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at @@ -14,7 +14,7 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. -# +# # %CopyrightEnd% # # @@ -46,8 +46,7 @@ XML_REF3_FILES = \ CosTimerEvent_TimerEventService.xml \ XML_PART_FILES = \ - part.xml \ - part_notes.xml + part.xml XML_CHAPTER_FILES = \ ch_contents.xml \ ch_introduction.xml \ @@ -58,17 +57,13 @@ XML_CHAPTER_FILES = \ BOOK_FILES = book.xml XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \ - $(XML_PART_FILES) $(XML_CHAPTER_FILES) + $(XML_PART_FILES) $(XML_CHAPTER_FILES) -TECHNICAL_DESCR_FILES = +TECHNICAL_DESCR_FILES = -GIF_FILES = \ - book.gif \ - notes.gif \ - ref_man.gif \ - user_guide.gif +GIF_FILES = -PS_FILES = +PS_FILES = # ---------------------------------------------------- @@ -78,7 +73,7 @@ HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) INFO_FILE = ../../info -EXTRA_FILES = summary.html.src \ +EXTRA_FILES = \ $(DEFAULT_GIF_FILES) \ $(DEFAULT_HTML_FILES) \ $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ @@ -91,10 +86,10 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += +XML_FLAGS += +DVIPS_FLAGS += # ---------------------------------------------------- # Targets @@ -123,11 +118,11 @@ gifs: $(GIF_FILES:%=$(HTMLDIR)/%) $(INDEX_TARGET): $(INDEX_SRC) sed -e 's;%VSN%;$(VSN);' $(INDEX_SRC) > $(INDEX_TARGET) -debug opt: +debug opt: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs diff --git a/lib/cosTime/doc/src/book.gif b/lib/cosTime/doc/src/book.gif Binary files differdeleted file mode 100644 index 94b3868792..0000000000 --- a/lib/cosTime/doc/src/book.gif +++ /dev/null diff --git a/lib/cosTime/doc/src/fascicules.xml b/lib/cosTime/doc/src/fascicules.xml deleted file mode 100644 index 37feca543f..0000000000 --- a/lib/cosTime/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/cosTime/doc/src/notes.gif b/lib/cosTime/doc/src/notes.gif Binary files differdeleted file mode 100644 index e000cca26a..0000000000 --- a/lib/cosTime/doc/src/notes.gif +++ /dev/null diff --git a/lib/cosTime/doc/src/notes.xml b/lib/cosTime/doc/src/notes.xml index 686d9e6add..16e02f8b1f 100644 --- a/lib/cosTime/doc/src/notes.xml +++ b/lib/cosTime/doc/src/notes.xml @@ -33,7 +33,22 @@ <file>notes.xml</file> </header> - <section><title>cosTime 1.2.2</title> + <section><title>cosTime 1.2.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Removed all old unused files in the documentation. + </p> + <p> + Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p> + </item> + </list> + </section> + +</section> + +<section><title>cosTime 1.2.2</title> <section><title>Improvements and New Features</title> <list> diff --git a/lib/cosTime/doc/src/part_notes.xml b/lib/cosTime/doc/src/part_notes.xml deleted file mode 100644 index dbc9185038..0000000000 --- a/lib/cosTime/doc/src/part_notes.xml +++ /dev/null @@ -1,37 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2000</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>cosTime Release Notes</title> - <prepared>Niclas Eklund</prepared> - <docno></docno> - <date>2000-01-31</date> - <rev>1.0</rev> - </header> - <description> - <p>The cosTime Application is an Erlang implementation of the OMG - CORBA Time and TimerEvent Services.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/cosTime/doc/src/ref_man.gif b/lib/cosTime/doc/src/ref_man.gif Binary files differdeleted file mode 100644 index b13c4efd53..0000000000 --- a/lib/cosTime/doc/src/ref_man.gif +++ /dev/null diff --git a/lib/cosTime/doc/src/summary.html.src b/lib/cosTime/doc/src/summary.html.src deleted file mode 100644 index 78e383d275..0000000000 --- a/lib/cosTime/doc/src/summary.html.src +++ /dev/null @@ -1 +0,0 @@ -Orber OMG Timer and TimerEvent Services. diff --git a/lib/cosTime/doc/src/user_guide.gif b/lib/cosTime/doc/src/user_guide.gif Binary files differdeleted file mode 100644 index e6275a803d..0000000000 --- a/lib/cosTime/doc/src/user_guide.gif +++ /dev/null diff --git a/lib/cosTime/vsn.mk b/lib/cosTime/vsn.mk index 7c9cae2d2f..7d6fcbebcd 100644 --- a/lib/cosTime/vsn.mk +++ b/lib/cosTime/vsn.mk @@ -1,2 +1,2 @@ -COSTIME_VSN = 1.2.2 +COSTIME_VSN = 1.2.3 diff --git a/lib/cosTransactions/doc/src/Makefile b/lib/cosTransactions/doc/src/Makefile index b70d7647b1..3c054593a9 100644 --- a/lib/cosTransactions/doc/src/Makefile +++ b/lib/cosTransactions/doc/src/Makefile @@ -1,8 +1,8 @@ # # %CopyrightBegin% -# -# Copyright Ericsson AB 1999-2016. All Rights Reserved. -# +# +# Copyright Ericsson AB 1999-2017. All Rights Reserved. +# # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at @@ -14,7 +14,7 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. -# +# # %CopyrightEnd% # # @@ -49,8 +49,7 @@ XML_REF3_FILES = \ # CosTransactions_Synchronization.xml XML_PART_FILES = \ - part.xml \ - part_notes.xml + part.xml XML_CHAPTER_FILES = \ ch_contents.xml \ ch_introduction.xml \ @@ -62,17 +61,13 @@ XML_CHAPTER_FILES = \ BOOK_FILES = book.xml XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \ - $(XML_PART_FILES) $(XML_CHAPTER_FILES) + $(XML_PART_FILES) $(XML_CHAPTER_FILES) -TECHNICAL_DESCR_FILES = +TECHNICAL_DESCR_FILES = -GIF_FILES = \ - book.gif \ - notes.gif \ - ref_man.gif \ - user_guide.gif +GIF_FILES = -PS_FILES = +PS_FILES = # ---------------------------------------------------- @@ -82,7 +77,7 @@ HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) INFO_FILE = ../../info -EXTRA_FILES = summary.html.src \ +EXTRA_FILES = \ $(DEFAULT_GIF_FILES) \ $(DEFAULT_HTML_FILES) \ $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ @@ -95,10 +90,10 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += +XML_FLAGS += +DVIPS_FLAGS += # ---------------------------------------------------- # Targets @@ -127,11 +122,11 @@ gifs: $(GIF_FILES:%=$(HTMLDIR)/%) $(INDEX_TARGET): $(INDEX_SRC) sed -e 's;%VSN%;$(VSN);' $(INDEX_SRC) > $(INDEX_TARGET) -debug opt: +debug opt: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs diff --git a/lib/cosTransactions/doc/src/book.gif b/lib/cosTransactions/doc/src/book.gif Binary files differdeleted file mode 100644 index 94b3868792..0000000000 --- a/lib/cosTransactions/doc/src/book.gif +++ /dev/null diff --git a/lib/cosTransactions/doc/src/fascicules.xml b/lib/cosTransactions/doc/src/fascicules.xml deleted file mode 100644 index 37feca543f..0000000000 --- a/lib/cosTransactions/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/cosTransactions/doc/src/notes.gif b/lib/cosTransactions/doc/src/notes.gif Binary files differdeleted file mode 100644 index e000cca26a..0000000000 --- a/lib/cosTransactions/doc/src/notes.gif +++ /dev/null diff --git a/lib/cosTransactions/doc/src/notes.xml b/lib/cosTransactions/doc/src/notes.xml index 85ace1208b..2401c04c3f 100644 --- a/lib/cosTransactions/doc/src/notes.xml +++ b/lib/cosTransactions/doc/src/notes.xml @@ -33,7 +33,22 @@ <file>notes.xml</file> </header> - <section><title>cosTransactions 1.3.2</title> + <section><title>cosTransactions 1.3.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Removed all old unused files in the documentation. + </p> + <p> + Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p> + </item> + </list> + </section> + +</section> + +<section><title>cosTransactions 1.3.2</title> <section><title>Improvements and New Features</title> <list> diff --git a/lib/cosTransactions/doc/src/part_notes.xml b/lib/cosTransactions/doc/src/part_notes.xml deleted file mode 100644 index 48cc04aa4c..0000000000 --- a/lib/cosTransactions/doc/src/part_notes.xml +++ /dev/null @@ -1,37 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>1999</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>cosTransactions Release Notes</title> - <prepared></prepared> - <docno></docno> - <date>1999-04-14</date> - <rev>2.0</rev> - </header> - <description> - <p>The cosTransactions Application is an Erlang implementation of the OMG - CORBA Transaction Service.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/cosTransactions/doc/src/ref_man.gif b/lib/cosTransactions/doc/src/ref_man.gif Binary files differdeleted file mode 100644 index b13c4efd53..0000000000 --- a/lib/cosTransactions/doc/src/ref_man.gif +++ /dev/null diff --git a/lib/cosTransactions/doc/src/summary.html.src b/lib/cosTransactions/doc/src/summary.html.src deleted file mode 100644 index 8fb7d6ea20..0000000000 --- a/lib/cosTransactions/doc/src/summary.html.src +++ /dev/null @@ -1 +0,0 @@ -Orber OMG Transaction Service
\ No newline at end of file diff --git a/lib/cosTransactions/doc/src/user_guide.gif b/lib/cosTransactions/doc/src/user_guide.gif Binary files differdeleted file mode 100644 index e6275a803d..0000000000 --- a/lib/cosTransactions/doc/src/user_guide.gif +++ /dev/null diff --git a/lib/cosTransactions/vsn.mk b/lib/cosTransactions/vsn.mk index ab163d83c2..bba2058231 100644 --- a/lib/cosTransactions/vsn.mk +++ b/lib/cosTransactions/vsn.mk @@ -1 +1 @@ -COSTRANSACTIONS_VSN = 1.3.2 +COSTRANSACTIONS_VSN = 1.3.3 diff --git a/lib/crypto/c_src/Makefile.in b/lib/crypto/c_src/Makefile.in index af7c209c75..31124ba477 100644 --- a/lib/crypto/c_src/Makefile.in +++ b/lib/crypto/c_src/Makefile.in @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2016. All Rights Reserved. +# Copyright Ericsson AB 1999-2017. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -78,12 +78,16 @@ CRYPTO_STATIC_OBJS = $(OBJDIR)/crypto_static$(TYPEMARKER).o\ NIF_ARCHIVE = $(LIBDIR)/crypto$(TYPEMARKER).a +TEST_ENGINE_OBJS = $(OBJDIR)/otp_test_engine$(TYPEMARKER).o + ifeq ($(findstring win32,$(TARGET)), win32) NIF_LIB = $(LIBDIR)/crypto$(TYPEMARKER).dll CALLBACK_LIB = $(LIBDIR)/crypto_callback$(TYPEMARKER).dll +TEST_ENGINE_LIB = $(LIBDIR)/otp_test_engine$(TYPEMARKER).dll else NIF_LIB = $(LIBDIR)/crypto$(TYPEMARKER).so CALLBACK_LIB = $(LIBDIR)/crypto_callback$(TYPEMARKER).so +TEST_ENGINE_LIB = $(LIBDIR)/otp_test_engine$(TYPEMARKER).so endif ifeq ($(HOST_OS),) @@ -129,10 +133,22 @@ ALL_STATIC_CFLAGS = $(DED_STATIC_CFLAGS) $(INCLUDES) _create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR)) -debug opt valgrind: $(NIF_LIB) $(CALLBACK_LIB) +debug opt valgrind: $(NIF_LIB) $(CALLBACK_LIB) $(TEST_ENGINE_LIB) static_lib: $(NIF_ARCHIVE) +$(OBJDIR)/otp_test_engine$(TYPEMARKER).o: otp_test_engine.c + $(V_at)$(INSTALL_DIR) $(OBJDIR) + $(V_CC) -c -o $@ $(ALL_CFLAGS) $< + +$(LIBDIR)/otp_test_engine$(TYPEMARKER).so: $(TEST_ENGINE_OBJS) + $(V_at)$(INSTALL_DIR) $(LIBDIR) + $(V_LD) $(LDFLAGS) -o $@ $^ $(LDLIBS) $(CRYPTO_LINK_LIB) + +$(LIBDIR)/otp_test_engine$(TYPEMARKER).dll: $(TEST_ENGINE_OBJS) + $(V_at)$(INSTALL_DIR) $(LIBDIR) + $(V_LD) $(LDFLAGS) -o $@ $(SSL_DED_LD_RUNTIME_LIBRARY_PATH) -L$(SSL_LIBDIR) $(TEST_ENGINE_OBJS) -l$(SSL_CRYPTO_LIBNAME) -l$(SSL_SSL_LIBNAME) + $(OBJDIR)/%$(TYPEMARKER).o: %.c $(V_at)$(INSTALL_DIR) $(OBJDIR) $(V_CC) -c -o $@ $(ALL_CFLAGS) $< @@ -170,6 +186,7 @@ ifeq ($(findstring win32,$(TARGET)), win32) rm -f $(LIBDIR)/crypto.debug.dll rm -f $(LIBDIR)/crypto_callback.dll rm -f $(LIBDIR)/crypto_callback.debug.dll + rm -f $(LIBDIR)/otp_test_engine.dll else rm -f $(LIBDIR)/crypto.so rm -f $(LIBDIR)/crypto.debug.so @@ -177,6 +194,7 @@ else rm -f $(LIBDIR)/crypto_callback.so rm -f $(LIBDIR)/crypto_callback.debug.so rm -f $(LIBDIR)/crypto_callback.valgrind.so + rm -f $(LIBDIR)/otp_test_engine.so endif rm -f $(OBJDIR)/crypto.o rm -f $(OBJDIR)/crypto_static.o @@ -187,6 +205,7 @@ endif rm -f $(OBJDIR)/crypto_callback.o rm -f $(OBJDIR)/crypto_callback.debug.o rm -f $(OBJDIR)/crypto_callback.valgrind.o + rm -f $(OBJDIR)/otp_test_engine.o rm -f core *~ docs: @@ -206,6 +225,8 @@ ifeq ($(DYNAMIC_CRYPTO_LIB),yes) $(INSTALL_PROGRAM) $(CALLBACK_OBJS) "$(RELSYSDIR)/priv/obj" $(INSTALL_PROGRAM) $(CALLBACK_LIB) "$(RELSYSDIR)/priv/lib" endif + $(INSTALL_PROGRAM) $(TEST_ENGINE_OBJS) "$(RELSYSDIR)/priv/obj" + $(INSTALL_PROGRAM) $(TEST_ENGINE_LIB) "$(RELSYSDIR)/priv/lib" release_docs_spec: diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 1d9c1e0f88..6957d25774 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -1,4 +1,4 @@ -/* +/* * %CopyrightBegin% * * Copyright Ericsson AB 2010-2017. All Rights Reserved. @@ -19,8 +19,8 @@ */ /* - * Purpose: Dynamically loadable NIF library for cryptography. - * Based on OpenSSL. + * Purpose: Dynamically loadable NIF library for cryptography. + * Based on OpenSSL. */ #ifdef __WIN32__ @@ -60,6 +60,8 @@ #include <openssl/rand.h> #include <openssl/evp.h> #include <openssl/hmac.h> +#include <openssl/engine.h> +#include <openssl/err.h> /* Helper macro to construct a OPENSSL_VERSION_NUMBER. * See openssl/opensslv.h @@ -79,9 +81,9 @@ * * Therefor works tests like this as intendend: * OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0) - * (The test is for example "2.4.2" >= "1.0.0" although the test + * (The test is for example "2.4.2" >= "1.0.0" although the test * with the cloned OpenSSL test would be "1.0.1" >= "1.0.0") - * + * * But tests like this gives wrong result: * OPENSSL_VERSION_NUMBER < PACKED_OPENSSL_VERSION_PLAIN(1,1,0) * (The test is false since "2.4.2" < "1.1.0". It should have been @@ -119,6 +121,10 @@ #include <openssl/modes.h> #endif +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION(0,9,8,'h') +#define HAS_ENGINE_SUPPORT +#endif + #include "crypto_callback.h" #if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(0,9,8) \ @@ -240,7 +246,7 @@ /* This shall correspond to the similar macro in crypto.erl */ /* Current value is: erlang:system_info(context_reductions) * 10 */ -#define MAX_BYTES_TO_NIF 20000 +#define MAX_BYTES_TO_NIF 20000 #define CONSUME_REDS(NifEnv, Ibin) \ do { \ @@ -277,7 +283,7 @@ static HMAC_CTX *HMAC_CTX_new() static void HMAC_CTX_free(HMAC_CTX *ctx) { HMAC_CTX_cleanup(ctx); - return CRYPTO_free(ctx); + CRYPTO_free(ctx); } #define EVP_MD_CTX_new() EVP_MD_CTX_create() @@ -342,6 +348,10 @@ static INLINE void RSA_get0_crt_params(const RSA *r, const BIGNUM **dmp1, const static INLINE int DSA_set0_key(DSA *d, BIGNUM *pub_key, BIGNUM *priv_key); static INLINE int DSA_set0_pqg(DSA *d, BIGNUM *p, BIGNUM *q, BIGNUM *g); +static INLINE void DSA_get0_pqg(const DSA *dsa, + const BIGNUM **p, const BIGNUM **q, const BIGNUM **g); +static INLINE void DSA_get0_key(const DSA *dsa, + const BIGNUM **pub_key, const BIGNUM **priv_key); static INLINE int DSA_set0_key(DSA *d, BIGNUM *pub_key, BIGNUM *priv_key) { @@ -358,6 +368,23 @@ static INLINE int DSA_set0_pqg(DSA *d, BIGNUM *p, BIGNUM *q, BIGNUM *g) return 1; } +static INLINE void +DSA_get0_pqg(const DSA *dsa, const BIGNUM **p, const BIGNUM **q, const BIGNUM **g) +{ + *p = dsa->p; + *q = dsa->q; + *g = dsa->g; +} + +static INLINE void +DSA_get0_key(const DSA *dsa, const BIGNUM **pub_key, const BIGNUM **priv_key) +{ + if (pub_key) *pub_key = dsa->pub_key; + if (priv_key) *priv_key = dsa->priv_key; +} + + + static INLINE int DH_set0_key(DH *dh, BIGNUM *pub_key, BIGNUM *priv_key); static INLINE int DH_set0_pqg(DH *dh, BIGNUM *p, BIGNUM *q, BIGNUM *g); static INLINE int DH_set_length(DH *dh, long length); @@ -387,6 +414,8 @@ static INLINE int DH_set_length(DH *dh, long length) return 1; } + + static INLINE void DH_get0_pqg(const DH *dh, const BIGNUM **p, const BIGNUM **q, const BIGNUM **g) { @@ -398,8 +427,8 @@ DH_get0_pqg(const DH *dh, const BIGNUM **p, const BIGNUM **q, const BIGNUM **g) static INLINE void DH_get0_key(const DH *dh, const BIGNUM **pub_key, const BIGNUM **priv_key) { - *pub_key = dh->pub_key; - *priv_key = dh->priv_key; + if (pub_key) *pub_key = dh->pub_key; + if (priv_key) *priv_key = dh->priv_key; } #else /* End of compatibility definitions. */ @@ -442,13 +471,13 @@ static ERL_NIF_TERM rc4_set_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg static ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM pkey_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM pkey_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM rsa_public_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM rsa_private_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rsa_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM dh_generate_parameters_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM privkey_to_pubkey_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM srp_value_B_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM srp_user_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM srp_host_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -467,6 +496,22 @@ static ERL_NIF_TERM aes_gcm_decrypt_NO_EVP(ErlNifEnv* env, int argc, const ERL_N static ERL_NIF_TERM chacha20_poly1305_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM chacha20_poly1305_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static int get_engine_load_cmd_list(ErlNifEnv* env, const ERL_NIF_TERM term, char **cmds, int i); +static ERL_NIF_TERM engine_by_id_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM engine_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM engine_finish_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM engine_free_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM engine_load_dynamic_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM engine_ctrl_cmd_strings_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM engine_register_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM engine_unregister_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM engine_add_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM engine_remove_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM engine_get_first_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM engine_get_next_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM engine_get_id_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM engine_get_all_methods_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + /* helpers */ static void init_algorithms_types(ErlNifEnv*); static void init_digest_types(ErlNifEnv* env); @@ -478,6 +523,10 @@ static int term2point(ErlNifEnv* env, ERL_NIF_TERM term, #endif static ERL_NIF_TERM bin_from_bn(ErlNifEnv* env, const BIGNUM *bn); +#ifdef HAS_ENGINE_SUPPORT +static int zero_terminate(ErlNifBinary bin, char **buf); +#endif + static int library_refc = 0; /* number of users of this dynamic library */ static ErlNifFunc nif_funcs[] = { @@ -511,13 +560,13 @@ static ErlNifFunc nif_funcs[] = { {"rc4_encrypt_with_state", 2, rc4_encrypt_with_state}, {"pkey_sign_nif", 5, pkey_sign_nif}, {"pkey_verify_nif", 6, pkey_verify_nif}, - {"rsa_public_crypt", 4, rsa_public_crypt}, - {"rsa_private_crypt", 4, rsa_private_crypt}, + {"pkey_crypt_nif", 6, pkey_crypt_nif}, {"rsa_generate_key_nif", 2, rsa_generate_key_nif}, {"dh_generate_parameters_nif", 2, dh_generate_parameters_nif}, {"dh_check", 1, dh_check}, {"dh_generate_key_nif", 4, dh_generate_key_nif}, {"dh_compute_key_nif", 3, dh_compute_key_nif}, + {"privkey_to_pubkey_nif", 2, privkey_to_pubkey_nif}, {"srp_value_B_nif", 5, srp_value_B_nif}, {"srp_user_secret_nif", 7, srp_user_secret_nif}, {"srp_host_secret_nif", 5, srp_host_secret_nif}, @@ -531,12 +580,27 @@ static ErlNifFunc nif_funcs[] = { {"aes_gcm_decrypt", 5, aes_gcm_decrypt}, {"chacha20_poly1305_encrypt", 4, chacha20_poly1305_encrypt}, - {"chacha20_poly1305_decrypt", 5, chacha20_poly1305_decrypt} + {"chacha20_poly1305_decrypt", 5, chacha20_poly1305_decrypt}, + + {"engine_by_id_nif", 1, engine_by_id_nif}, + {"engine_init_nif", 1, engine_init_nif}, + {"engine_finish_nif", 1, engine_finish_nif}, + {"engine_free_nif", 1, engine_free_nif}, + {"engine_load_dynamic_nif", 0, engine_load_dynamic_nif}, + {"engine_ctrl_cmd_strings_nif", 3, engine_ctrl_cmd_strings_nif}, + {"engine_register_nif", 2, engine_register_nif}, + {"engine_unregister_nif", 2, engine_unregister_nif}, + {"engine_add_nif", 1, engine_add_nif}, + {"engine_remove_nif", 1, engine_remove_nif}, + {"engine_get_first_nif", 0, engine_get_first_nif}, + {"engine_get_next_nif", 1, engine_get_next_nif}, + {"engine_get_id_nif", 1, engine_get_id_nif}, + {"engine_get_all_methods_nif", 0, engine_get_all_methods_nif} + }; ERL_NIF_INIT(crypto,nif_funcs,load,NULL,upgrade,unload) - #define MD5_CTX_LEN (sizeof(MD5_CTX)) #define MD4_CTX_LEN (sizeof(MD4_CTX)) #define RIPEMD160_CTX_LEN (sizeof(RIPEMD160_CTX)) @@ -549,6 +613,7 @@ static ERL_NIF_TERM atom_error; static ERL_NIF_TERM atom_rsa_pkcs1_padding; static ERL_NIF_TERM atom_rsa_pkcs1_oaep_padding; static ERL_NIF_TERM atom_rsa_no_padding; +static ERL_NIF_TERM atom_signature_md; static ERL_NIF_TERM atom_undefined; static ERL_NIF_TERM atom_ok; @@ -589,8 +654,12 @@ static ERL_NIF_TERM atom_rsa; static ERL_NIF_TERM atom_dss; static ERL_NIF_TERM atom_ecdsa; static ERL_NIF_TERM atom_rsa_mgf1_md; +static ERL_NIF_TERM atom_rsa_oaep_label; +static ERL_NIF_TERM atom_rsa_oaep_md; +static ERL_NIF_TERM atom_rsa_pad; /* backwards compatibility */ static ERL_NIF_TERM atom_rsa_padding; static ERL_NIF_TERM atom_rsa_pkcs1_pss_padding; +static ERL_NIF_TERM atom_rsa_sslv23_padding; static ERL_NIF_TERM atom_rsa_x931_padding; static ERL_NIF_TERM atom_rsa_pss_saltlen; static ERL_NIF_TERM atom_sha224; @@ -600,7 +669,33 @@ static ERL_NIF_TERM atom_sha512; static ERL_NIF_TERM atom_md5; static ERL_NIF_TERM atom_ripemd160; - +#ifdef HAS_ENGINE_SUPPORT +static ERL_NIF_TERM atom_bad_engine_method; +static ERL_NIF_TERM atom_bad_engine_id; +static ERL_NIF_TERM atom_ctrl_cmd_failed; +static ERL_NIF_TERM atom_engine_init_failed; +static ERL_NIF_TERM atom_register_engine_failed; +static ERL_NIF_TERM atom_add_engine_failed; +static ERL_NIF_TERM atom_remove_engine_failed; +static ERL_NIF_TERM atom_engine_method_not_supported; + +static ERL_NIF_TERM atom_engine_method_rsa; +static ERL_NIF_TERM atom_engine_method_dsa; +static ERL_NIF_TERM atom_engine_method_dh; +static ERL_NIF_TERM atom_engine_method_rand; +static ERL_NIF_TERM atom_engine_method_ecdh; +static ERL_NIF_TERM atom_engine_method_ecdsa; +static ERL_NIF_TERM atom_engine_method_ciphers; +static ERL_NIF_TERM atom_engine_method_digests; +static ERL_NIF_TERM atom_engine_method_store; +static ERL_NIF_TERM atom_engine_method_pkey_meths; +static ERL_NIF_TERM atom_engine_method_pkey_asn1_meths; +static ERL_NIF_TERM atom_engine_method_ec; + +static ERL_NIF_TERM atom_engine; +static ERL_NIF_TERM atom_key_id; +static ERL_NIF_TERM atom_password; +#endif static ErlNifResourceType* hmac_context_rtype; struct hmac_context @@ -725,11 +820,13 @@ static struct cipher_type_t cipher_types[] = static struct cipher_type_t* get_cipher_type(ERL_NIF_TERM type, size_t key_len); + /* #define PRINTF_ERR0(FMT) enif_fprintf(stderr, FMT "\n") #define PRINTF_ERR1(FMT, A1) enif_fprintf(stderr, FMT "\n", A1) #define PRINTF_ERR2(FMT, A1, A2) enif_fprintf(stderr, FMT "\n", A1, A2) */ + #define PRINTF_ERR0(FMT) #define PRINTF_ERR1(FMT,A1) #define PRINTF_ERR2(FMT,A1,A2) @@ -755,6 +852,23 @@ static void evp_cipher_ctx_dtor(ErlNifEnv* env, struct evp_cipher_ctx* ctx) { } #endif +// Engine +#ifdef HAS_ENGINE_SUPPORT +static ErlNifResourceType* engine_ctx_rtype; +struct engine_ctx { + ENGINE *engine; + char *id; +}; +static void engine_ctx_dtor(ErlNifEnv* env, struct engine_ctx* ctx) { + PRINTF_ERR0("engine_ctx_dtor"); + if(ctx->id) { + PRINTF_ERR1(" non empty ctx->id=%s", ctx->id); + enif_free(ctx->id); + } else + PRINTF_ERR0(" empty ctx->id=NULL"); +} +#endif + static int verify_lib_version(void) { const unsigned long libv = SSLeay(); @@ -790,7 +904,7 @@ static char crypto_callback_name[] = "crypto_callback"; static int change_basename(ErlNifBinary* bin, char* buf, int bufsz, const char* newfile) { int i; - + for (i = bin->size; i > 0; i--) { if (bin->data[i-1] == '/') break; @@ -866,12 +980,23 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info) return __LINE__; } #endif +#ifdef HAS_ENGINE_SUPPORT + engine_ctx_rtype = enif_open_resource_type(env, NULL, "ENGINE_CTX", + (ErlNifResourceDtor*) engine_ctx_dtor, + ERL_NIF_RT_CREATE|ERL_NIF_RT_TAKEOVER, + NULL); + if (!engine_ctx_rtype) { + PRINTF_ERR0("CRYPTO: Could not open resource type 'ENGINE_CTX'"); + return __LINE__; + } + if (library_refc > 0) { /* Repeated loading of this library (module upgrade). * Atoms and callbacks are already set, we are done. */ return 0; } +#endif atom_true = enif_make_atom(env,"true"); atom_false = enif_make_atom(env,"false"); @@ -895,6 +1020,7 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info) atom_rsa_pkcs1_padding = enif_make_atom(env,"rsa_pkcs1_padding"); atom_rsa_pkcs1_oaep_padding = enif_make_atom(env,"rsa_pkcs1_oaep_padding"); atom_rsa_no_padding = enif_make_atom(env,"rsa_no_padding"); + atom_signature_md = enif_make_atom(env,"signature_md"); atom_undefined = enif_make_atom(env,"undefined"); atom_ok = enif_make_atom(env,"ok"); atom_not_prime = enif_make_atom(env,"not_prime"); @@ -933,8 +1059,12 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info) atom_dss = enif_make_atom(env,"dss"); atom_ecdsa = enif_make_atom(env,"ecdsa"); atom_rsa_mgf1_md = enif_make_atom(env,"rsa_mgf1_md"); + atom_rsa_oaep_label = enif_make_atom(env,"rsa_oaep_label"); + atom_rsa_oaep_md = enif_make_atom(env,"rsa_oaep_md"); + atom_rsa_pad = enif_make_atom(env,"rsa_pad"); /* backwards compatibility */ atom_rsa_padding = enif_make_atom(env,"rsa_padding"); atom_rsa_pkcs1_pss_padding = enif_make_atom(env,"rsa_pkcs1_pss_padding"); + atom_rsa_sslv23_padding = enif_make_atom(env,"rsa_sslv23_padding"); atom_rsa_x931_padding = enif_make_atom(env,"rsa_x931_padding"); atom_rsa_pss_saltlen = enif_make_atom(env,"rsa_pss_saltlen"); atom_sha224 = enif_make_atom(env,"sha224"); @@ -944,6 +1074,33 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info) atom_md5 = enif_make_atom(env,"md5"); atom_ripemd160 = enif_make_atom(env,"ripemd160"); +#ifdef HAS_ENGINE_SUPPORT + atom_bad_engine_method = enif_make_atom(env,"bad_engine_method"); + atom_bad_engine_id = enif_make_atom(env,"bad_engine_id"); + atom_ctrl_cmd_failed = enif_make_atom(env,"ctrl_cmd_failed"); + atom_engine_init_failed = enif_make_atom(env,"engine_init_failed"); + atom_engine_method_not_supported = enif_make_atom(env,"engine_method_not_supported"); + atom_add_engine_failed = enif_make_atom(env,"add_engine_failed"); + atom_remove_engine_failed = enif_make_atom(env,"remove_engine_failed"); + + atom_engine_method_rsa = enif_make_atom(env,"engine_method_rsa"); + atom_engine_method_dsa = enif_make_atom(env,"engine_method_dsa"); + atom_engine_method_dh = enif_make_atom(env,"engine_method_dh"); + atom_engine_method_rand = enif_make_atom(env,"engine_method_rand"); + atom_engine_method_ecdh = enif_make_atom(env,"engine_method_ecdh"); + atom_engine_method_ecdsa = enif_make_atom(env,"engine_method_ecdsa"); + atom_engine_method_store = enif_make_atom(env,"engine_method_store"); + atom_engine_method_ciphers = enif_make_atom(env,"engine_method_ciphers"); + atom_engine_method_digests = enif_make_atom(env,"engine_method_digests"); + atom_engine_method_pkey_meths = enif_make_atom(env,"engine_method_pkey_meths"); + atom_engine_method_pkey_asn1_meths = enif_make_atom(env,"engine_method_pkey_asn1_meths"); + atom_engine_method_ec = enif_make_atom(env,"engine_method_ec"); + + atom_engine = enif_make_atom(env,"engine"); + atom_key_id = enif_make_atom(env,"key_id"); + atom_password = enif_make_atom(env,"password"); +#endif + init_digest_types(env); init_cipher_types(env); init_algorithms_types(env); @@ -965,24 +1122,24 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info) #else /* !HAVE_DYNAMIC_CRYPTO_LIB */ funcp = &get_crypto_callbacks; #endif - + #ifdef OPENSSL_THREADS enif_system_info(&sys_info, sizeof(sys_info)); if (sys_info.scheduler_threads > 1) { - nlocks = CRYPTO_num_locks(); + nlocks = CRYPTO_num_locks(); } /* else no need for locks */ #endif - + ccb = (*funcp)(nlocks); - + if (!ccb || ccb->sizeof_me != sizeof(*ccb)) { PRINTF_ERR0("Invalid 'crypto_callbacks'"); return __LINE__; } - + CRYPTO_set_mem_functions(ccb->crypto_alloc, ccb->crypto_realloc, ccb->crypto_free); - + #ifdef OPENSSL_THREADS if (nlocks > 0) { CRYPTO_set_locking_callback(ccb->locking_function); @@ -1178,11 +1335,11 @@ static ERL_NIF_TERM info_lib(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] * Version string is still from library though. */ - memcpy(enif_make_new_binary(env, name_sz, &name_term), libname, name_sz); + memcpy(enif_make_new_binary(env, name_sz, &name_term), libname, name_sz); memcpy(enif_make_new_binary(env, ver_sz, &ver_term), ver, ver_sz); return enif_make_list1(env, enif_make_tuple3(env, name_term, - enif_make_int(env, ver_num), + enif_make_int(env, ver_num), ver_term)); } @@ -1217,6 +1374,8 @@ static ERL_NIF_TERM enable_fips_mode(ErlNifEnv* env, int argc, const ERL_NIF_TER } } + +#if defined(HAVE_EC) static ERL_NIF_TERM make_badarg_maybe(ErlNifEnv* env) { ERL_NIF_TERM reason; @@ -1225,6 +1384,7 @@ static ERL_NIF_TERM make_badarg_maybe(ErlNifEnv* env) else return enif_make_badarg(env); } +#endif static ERL_NIF_TERM hash_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Type, Data) */ @@ -1660,7 +1820,7 @@ static ERL_NIF_TERM hmac_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM {/* (Context, Data) */ ErlNifBinary data; struct hmac_context* obj; - + if (!enif_get_resource(env, argv[0], hmac_context_rtype, (void**)&obj) || !enif_inspect_iolist_as_binary(env, argv[1], &data)) { return enif_make_badarg(env); @@ -1696,13 +1856,13 @@ static ERL_NIF_TERM hmac_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM enif_mutex_unlock(obj->mtx); return enif_make_badarg(env); } - + HMAC_Final(obj->ctx, mac_buf, &mac_len); HMAC_CTX_free(obj->ctx); obj->alive = 0; enif_mutex_unlock(obj->mtx); - if (argc == 2 && req_len < mac_len) { + if (argc == 2 && req_len < mac_len) { /* Only truncate to req_len bytes if asked. */ mac_len = req_len; } @@ -2013,7 +2173,7 @@ static ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_ } static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* ({Key, IVec, ECount, Num}, Data) */ +{/* ({Key, IVec, ECount, Num}, Data) */ ErlNifBinary key_bin, ivec_bin, text_bin, ecount_bin; AES_KEY aes_key; unsigned int num; @@ -2034,14 +2194,14 @@ static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_N return enif_make_badarg(env); } - ivec2_buf = enif_make_new_binary(env, ivec_bin.size, &ivec2_term); + ivec2_buf = enif_make_new_binary(env, ivec_bin.size, &ivec2_term); ecount2_buf = enif_make_new_binary(env, ecount_bin.size, &ecount2_term); - + memcpy(ivec2_buf, ivec_bin.data, 16); memcpy(ecount2_buf, ecount_bin.data, ecount_bin.size); AES_ctr128_encrypt((unsigned char *) text_bin.data, - enif_make_new_binary(env, text_bin.size, &cipher_term), + enif_make_new_binary(env, text_bin.size, &cipher_term), text_bin.size, &aes_key, ivec2_buf, ecount2_buf, &num); num2_term = enif_make_uint(env, num); @@ -2344,7 +2504,7 @@ out_err: } static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Bytes) */ +{/* (Bytes) */ unsigned bytes; unsigned char* data; ERL_NIF_TERM ret; @@ -2438,7 +2598,7 @@ static ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TER bn_to = BN_new(); BN_sub(bn_to, bn_rand, bn_from); - BN_pseudo_rand_range(bn_rand, bn_to); + BN_pseudo_rand_range(bn_rand, bn_to); BN_add(bn_rand, bn_rand, bn_from); dlen = BN_num_bytes(bn_rand); data = enif_make_new_binary(env, dlen+4, &ret); @@ -2456,7 +2616,7 @@ static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg BIGNUM *bn_base=NULL, *bn_exponent=NULL, *bn_modulo=NULL, *bn_result; BN_CTX *bn_ctx; unsigned char* ptr; - unsigned dlen; + unsigned dlen; unsigned bin_hdr; /* return type: 0=plain binary, 4: mpint */ unsigned extra_byte; ERL_NIF_TERM ret; @@ -2477,7 +2637,7 @@ static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg dlen = BN_num_bytes(bn_result); extra_byte = bin_hdr && BN_is_bit_set(bn_result, dlen*8-1); ptr = enif_make_new_binary(env, bin_hdr+extra_byte+dlen, &ret); - if (bin_hdr) { + if (bin_hdr) { put_int32(ptr, extra_byte+dlen); ptr[4] = 0; /* extra zeroed byte to ensure a positive mpint */ ptr += bin_hdr + extra_byte; @@ -2537,6 +2697,7 @@ static struct cipher_type_t* get_cipher_type(ERL_NIF_TERM type, size_t key_len) return NULL; } + static ERL_NIF_TERM do_exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Data1, Data2) */ ErlNifBinary d1, d2; @@ -2570,7 +2731,7 @@ static ERL_NIF_TERM rc4_set_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg return enif_make_badarg(env); } RC4_set_key((RC4_KEY*)enif_make_new_binary(env, sizeof(RC4_KEY), &ret), - key.size, key.data); + key.size, key.data); return ret; #else return enif_raise_exception(env, atom_notsup); @@ -2722,118 +2883,6 @@ static int get_dss_public_key(ErlNifEnv* env, ERL_NIF_TERM key, DSA *dsa) return 1; } -static int rsa_pad(ERL_NIF_TERM term, int* padding) -{ - if (term == atom_rsa_pkcs1_padding) { - *padding = RSA_PKCS1_PADDING; - } - else if (term == atom_rsa_pkcs1_oaep_padding) { - *padding = RSA_PKCS1_OAEP_PADDING; - } - else if (term == atom_rsa_no_padding) { - *padding = RSA_NO_PADDING; - } - else { - return 0; - } - return 1; -} - -static ERL_NIF_TERM rsa_public_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Data, PublKey=[E,N], Padding, IsEncrypt) */ - ErlNifBinary data_bin, ret_bin; - ERL_NIF_TERM head, tail; - int padding, i; - RSA* rsa; - BIGNUM *e, *n; - - rsa = RSA_new(); - - if (!enif_inspect_binary(env, argv[0], &data_bin) - || !enif_get_list_cell(env, argv[1], &head, &tail) - || !get_bn_from_bin(env, head, &e) - || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &n) - || !enif_is_empty_list(env,tail) - || !rsa_pad(argv[2], &padding)) { - - RSA_free(rsa); - return enif_make_badarg(env); - } - (void) RSA_set0_key(rsa, n, e, NULL); - - enif_alloc_binary(RSA_size(rsa), &ret_bin); - - if (argv[3] == atom_true) { - ERL_VALGRIND_ASSERT_MEM_DEFINED(data_bin.data,data_bin.size); - i = RSA_public_encrypt(data_bin.size, data_bin.data, - ret_bin.data, rsa, padding); - if (i > 0) { - ERL_VALGRIND_MAKE_MEM_DEFINED(ret_bin.data, i); - } - } - else { - i = RSA_public_decrypt(data_bin.size, data_bin.data, - ret_bin.data, rsa, padding); - if (i > 0) { - ERL_VALGRIND_MAKE_MEM_DEFINED(ret_bin.data, i); - enif_realloc_binary(&ret_bin, i); - } - } - RSA_free(rsa); - if (i > 0) { - return enif_make_binary(env,&ret_bin); - } - else { - enif_release_binary(&ret_bin); - return atom_error; - } -} - -static ERL_NIF_TERM rsa_private_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Data, Key=[E,N,D]|[E,N,D,P1,P2,E1,E2,C], Padding, IsEncrypt) */ - ErlNifBinary data_bin, ret_bin; - int padding, i; - RSA* rsa; - - rsa = RSA_new(); - - if (!enif_inspect_binary(env, argv[0], &data_bin) - || !get_rsa_private_key(env, argv[1], rsa) - || !rsa_pad(argv[2], &padding)) { - - RSA_free(rsa); - return enif_make_badarg(env); - } - - enif_alloc_binary(RSA_size(rsa), &ret_bin); - - if (argv[3] == atom_true) { - ERL_VALGRIND_ASSERT_MEM_DEFINED(data_bin.data,data_bin.size); - i = RSA_private_encrypt(data_bin.size, data_bin.data, - ret_bin.data, rsa, padding); - if (i > 0) { - ERL_VALGRIND_MAKE_MEM_DEFINED(ret_bin.data, i); - } - } - else { - i = RSA_private_decrypt(data_bin.size, data_bin.data, - ret_bin.data, rsa, padding); - if (i > 0) { - ERL_VALGRIND_MAKE_MEM_DEFINED(ret_bin.data, i); - enif_realloc_binary(&ret_bin, i); - } - } - RSA_free(rsa); - if (i > 0) { - return enif_make_binary(env,&ret_bin); - } - else { - enif_release_binary(&ret_bin); - return atom_error; - } -} - /* Creates a term which can be parsed by get_rsa_private_key(). This is a list of plain integer binaries (not mpints). */ static ERL_NIF_TERM put_rsa_private_key(ErlNifEnv* env, const RSA *rsa) { @@ -2950,7 +2999,7 @@ static ERL_NIF_TERM rsa_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF static ERL_NIF_TERM dh_generate_parameters_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (PrimeLen, Generator) */ int prime_len, generator; - DH* dh_params; + DH* dh_params = NULL; int p_len, g_len; unsigned char *p_ptr, *g_ptr; ERL_NIF_TERM ret_p, ret_g; @@ -2961,8 +3010,8 @@ static ERL_NIF_TERM dh_generate_parameters_nif(ErlNifEnv* env, int argc, const E return enif_make_badarg(env); } - dh_params = DH_generate_parameters(prime_len, generator, NULL, NULL); - if (dh_params == NULL) { + + if (DH_generate_parameters_ex(dh_params, prime_len, generator, NULL)) { return atom_error; } DH_get0_pqg(dh_params, &dh_p, &dh_q, &dh_g); @@ -2975,7 +3024,7 @@ static ERL_NIF_TERM dh_generate_parameters_nif(ErlNifEnv* env, int argc, const E BN_bn2bin(dh_g, g_ptr); ERL_VALGRIND_MAKE_MEM_DEFINED(p_ptr, p_len); ERL_VALGRIND_MAKE_MEM_DEFINED(g_ptr, g_len); - return enif_make_list2(env, ret_p, ret_g); + return enif_make_list2(env, ret_p, ret_g); } static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -2985,9 +3034,9 @@ static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] ERL_NIF_TERM ret, head, tail; BIGNUM *dh_p, *dh_g; - if (!enif_get_list_cell(env, argv[0], &head, &tail) + if (!enif_get_list_cell(env, argv[0], &head, &tail) || !get_bn_from_bin(env, head, &dh_p) - || !enif_get_list_cell(env, tail, &head, &tail) + || !enif_get_list_cell(env, tail, &head, &tail) || !get_bn_from_bin(env, head, &dh_g) || !enif_is_empty_list(env,tail)) { @@ -3004,12 +3053,12 @@ static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] else if (i & DH_NOT_SUITABLE_GENERATOR) ret = atom_not_suitable_generator; else ret = enif_make_tuple2(env, atom_unknown, enif_make_uint(env, i)); } - else { /* Check Failed */ + else { /* Check Failed */ ret = enif_make_tuple2(env, atom_error, atom_check_failed); } DH_free(dh_params); return ret; -} +} static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (PrivKey|undefined, DHParams=[P,G], Mpint, Len|0) */ @@ -3111,7 +3160,7 @@ static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_T i = DH_compute_key(ret_bin.data, other_pub_key, dh_params); if (i > 0) { if (i != ret_bin.size) { - enif_realloc_binary(&ret_bin, i); + enif_realloc_binary(&ret_bin, i); } ret = enif_make_binary(env, &ret_bin); } @@ -3906,9 +3955,70 @@ static int get_pkey_sign_options(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF return PKEY_OK; } -static int get_pkey_sign_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_TERM key, EVP_PKEY **pkey) + +#ifdef HAS_ENGINE_SUPPORT +static int get_engine_and_key_id(ErlNifEnv *env, ERL_NIF_TERM key, char ** id, ENGINE **e) { - if (algorithm == atom_rsa) { + ERL_NIF_TERM engine_res, key_id_term; + struct engine_ctx *ctx; + ErlNifBinary key_id_bin; + + if (!enif_get_map_value(env, key, atom_engine, &engine_res) || + !enif_get_resource(env, engine_res, engine_ctx_rtype, (void**)&ctx) || + !enif_get_map_value(env, key, atom_key_id, &key_id_term) || + !enif_inspect_binary(env, key_id_term, &key_id_bin)) { + return 0; + } + else { + *e = ctx->engine; + return zero_terminate(key_id_bin, id); + } +} + + +static char *get_key_password(ErlNifEnv *env, ERL_NIF_TERM key) { + ERL_NIF_TERM tmp_term; + ErlNifBinary pwd_bin; + char *pwd; + if (enif_get_map_value(env, key, atom_password, &tmp_term) && + enif_inspect_binary(env, tmp_term, &pwd_bin) && + zero_terminate(pwd_bin, &pwd) + ) return pwd; + + return NULL; +} + +static int zero_terminate(ErlNifBinary bin, char **buf) { + *buf = enif_alloc(bin.size+1); + if (!*buf) + return 0; + memcpy(*buf, bin.data, bin.size); + *(*buf+bin.size) = 0; + return 1; +} +#endif + +static int get_pkey_private_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_TERM key, EVP_PKEY **pkey) +{ + if (enif_is_map(env, key)) { +#ifdef HAS_ENGINE_SUPPORT + /* Use key stored in engine */ + ENGINE *e; + char *id; + char *password; + + if (!get_engine_and_key_id(env, key, &id, &e)) + return PKEY_BADARG; + password = get_key_password(env, key); + *pkey = ENGINE_load_private_key(e, id, NULL, password); + if (!*pkey) + return PKEY_BADARG; + enif_free(id); +#else + return PKEY_BADARG; +#endif + } + else if (algorithm == atom_rsa) { RSA *rsa = RSA_new(); if (!get_rsa_private_key(env, key, rsa)) { @@ -3965,8 +4075,86 @@ static int get_pkey_sign_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_TER return PKEY_OK; } + +static int get_pkey_public_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_TERM key, + EVP_PKEY **pkey) +{ + if (enif_is_map(env, key)) { +#ifdef HAS_ENGINE_SUPPORT + /* Use key stored in engine */ + ENGINE *e; + char *id; + char *password; + + if (!get_engine_and_key_id(env, key, &id, &e)) + return PKEY_BADARG; + password = get_key_password(env, key); + *pkey = ENGINE_load_public_key(e, id, NULL, password); + if (!pkey) + return PKEY_BADARG; + enif_free(id); +#else + return PKEY_BADARG; +#endif + } else if (algorithm == atom_rsa) { + RSA *rsa = RSA_new(); + + if (!get_rsa_public_key(env, key, rsa)) { + RSA_free(rsa); + return PKEY_BADARG; + } + + *pkey = EVP_PKEY_new(); + if (!EVP_PKEY_assign_RSA(*pkey, rsa)) { + EVP_PKEY_free(*pkey); + RSA_free(rsa); + return PKEY_BADARG; + } + } else if (algorithm == atom_ecdsa) { +#if defined(HAVE_EC) + EC_KEY *ec = NULL; + const ERL_NIF_TERM *tpl_terms; + int tpl_arity; + + if (enif_get_tuple(env, key, &tpl_arity, &tpl_terms) && tpl_arity == 2 + && enif_is_tuple(env, tpl_terms[0]) && enif_is_binary(env, tpl_terms[1]) + && get_ec_key(env, tpl_terms[0], atom_undefined, tpl_terms[1], &ec)) { + + *pkey = EVP_PKEY_new(); + if (!EVP_PKEY_assign_EC_KEY(*pkey, ec)) { + EVP_PKEY_free(*pkey); + EC_KEY_free(ec); + return PKEY_BADARG; + } + } else { + return PKEY_BADARG; + } +#else + return PKEY_NOTSUP; +#endif + } else if (algorithm == atom_dss) { + DSA *dsa = DSA_new(); + + if (!get_dss_public_key(env, key, dsa)) { + DSA_free(dsa); + return PKEY_BADARG; + } + + *pkey = EVP_PKEY_new(); + if (!EVP_PKEY_assign_DSA(*pkey, dsa)) { + EVP_PKEY_free(*pkey); + DSA_free(dsa); + return PKEY_BADARG; + } + } else { + return PKEY_BADARG; + } + + return PKEY_OK; +} + static ERL_NIF_TERM pkey_sign_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) -{/* (Algorithm, Type, Data|{digest,Digest}, Key, Options) */ +{/* (Algorithm, Type, Data|{digest,Digest}, Key|#{}, Options) */ int i; const EVP_MD *md = NULL; unsigned char md_value[EVP_MAX_MD_SIZE]; @@ -3986,6 +4174,13 @@ enif_get_atom(env,argv[0],buf,1024,ERL_NIF_LATIN1); printf("algo=%s ",buf); enif_get_atom(env,argv[1],buf,1024,ERL_NIF_LATIN1); printf("hash=%s ",buf); printf("\r\n"); */ + +#ifndef HAS_ENGINE_SUPPORT + if (enif_is_map(env, argv[3])) { + return atom_notsup; + } +#endif + i = get_pkey_sign_digest(env, argv[0], argv[1], argv[2], md_value, &md, &tbs, &tbslen); if (i != PKEY_OK) { if (i == PKEY_NOTSUP) @@ -4002,15 +4197,14 @@ printf("\r\n"); return enif_make_badarg(env); } - if (get_pkey_sign_key(env, argv[0], argv[3], &pkey) != PKEY_OK) { + if (get_pkey_private_key(env, argv[0], argv[3], &pkey) != PKEY_OK) { return enif_make_badarg(env); } #ifdef HAS_EVP_PKEY_CTX -/* printf("EVP interface\r\n"); - */ ctx = EVP_PKEY_CTX_new(pkey, NULL); if (!ctx) goto badarg; + if (EVP_PKEY_sign_init(ctx) <= 0) goto badarg; if (md != NULL && EVP_PKEY_CTX_set_signature_md(ctx, md) <= 0) goto badarg; @@ -4097,66 +4291,6 @@ printf("\r\n"); } -static int get_pkey_verify_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_TERM key, - EVP_PKEY **pkey) -{ - if (algorithm == atom_rsa) { - RSA *rsa = RSA_new(); - - if (!get_rsa_public_key(env, key, rsa)) { - RSA_free(rsa); - return PKEY_BADARG; - } - - *pkey = EVP_PKEY_new(); - if (!EVP_PKEY_assign_RSA(*pkey, rsa)) { - EVP_PKEY_free(*pkey); - RSA_free(rsa); - return PKEY_BADARG; - } - } else if (algorithm == atom_ecdsa) { -#if defined(HAVE_EC) - EC_KEY *ec = NULL; - const ERL_NIF_TERM *tpl_terms; - int tpl_arity; - - if (enif_get_tuple(env, key, &tpl_arity, &tpl_terms) && tpl_arity == 2 - && enif_is_tuple(env, tpl_terms[0]) && enif_is_binary(env, tpl_terms[1]) - && get_ec_key(env, tpl_terms[0], atom_undefined, tpl_terms[1], &ec)) { - - *pkey = EVP_PKEY_new(); - if (!EVP_PKEY_assign_EC_KEY(*pkey, ec)) { - EVP_PKEY_free(*pkey); - EC_KEY_free(ec); - return PKEY_BADARG; - } - } else { - return PKEY_BADARG; - } -#else - return PKEY_NOTSUP; -#endif - } else if (algorithm == atom_dss) { - DSA *dsa = DSA_new(); - - if (!get_dss_public_key(env, key, dsa)) { - DSA_free(dsa); - return PKEY_BADARG; - } - - *pkey = EVP_PKEY_new(); - if (!EVP_PKEY_assign_DSA(*pkey, dsa)) { - EVP_PKEY_free(*pkey); - DSA_free(dsa); - return PKEY_BADARG; - } - } else { - return PKEY_BADARG; - } - - return PKEY_OK; -} - static ERL_NIF_TERM pkey_verify_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {/* (Algorithm, Type, Data|{digest,Digest}, Signature, Key, Options) */ int i; @@ -4172,6 +4306,12 @@ static ERL_NIF_TERM pkey_verify_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM unsigned char *tbs; /* data to be signed */ size_t tbslen; +#ifndef HAS_ENGINE_SUPPORT + if (enif_is_map(env, argv[4])) { + return atom_notsup; + } +#endif + if (!enif_inspect_binary(env, argv[3], &sig_bin)) { return enif_make_badarg(env); } @@ -4192,12 +4332,12 @@ static ERL_NIF_TERM pkey_verify_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM return enif_make_badarg(env); } - if (get_pkey_verify_key(env, argv[0], argv[4], &pkey) != PKEY_OK) { + if (get_pkey_public_key(env, argv[0], argv[4], &pkey) != PKEY_OK) { return enif_make_badarg(env); } #ifdef HAS_EVP_PKEY_CTX -/* printf("EVP interface\r\n"); +/* printf("EVP interface\r\n"); */ ctx = EVP_PKEY_CTX_new(pkey, NULL); if (!ctx) goto badarg; @@ -4269,6 +4409,461 @@ static ERL_NIF_TERM pkey_verify_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM } +/*--------------------------------*/ + +static int get_pkey_crypt_options(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_TERM options, + PKeyCryptOptions *opt) +{ + ERL_NIF_TERM head, tail; + const ERL_NIF_TERM *tpl_terms; + int tpl_arity; + const EVP_MD *opt_md; + int i; + + if (!enif_is_list(env, options)) { + return PKEY_BADARG; + } + + /* defaults */ + if (algorithm == atom_rsa) { + opt->rsa_mgf1_md = NULL; + opt->rsa_oaep_label.data = NULL; + opt->rsa_oaep_label.size = 0; + opt->rsa_oaep_md = NULL; + opt->rsa_padding = RSA_PKCS1_PADDING; + opt->signature_md = NULL; + } + + if (enif_is_empty_list(env, options)) { + return PKEY_OK; + } + + if (algorithm == atom_rsa) { + tail = options; + while (enif_get_list_cell(env, tail, &head, &tail)) { + if (enif_get_tuple(env, head, &tpl_arity, &tpl_terms) && tpl_arity == 2) { + if (tpl_terms[0] == atom_rsa_padding + || tpl_terms[0] == atom_rsa_pad /* Compatibility */ + ) { + if (tpl_terms[1] == atom_rsa_pkcs1_padding) { + opt->rsa_padding = RSA_PKCS1_PADDING; + } else if (tpl_terms[1] == atom_rsa_pkcs1_oaep_padding) { + opt->rsa_padding = RSA_PKCS1_OAEP_PADDING; + } else if (tpl_terms[1] == atom_rsa_sslv23_padding) { + opt->rsa_padding = RSA_SSLV23_PADDING; + } else if (tpl_terms[1] == atom_rsa_x931_padding) { + opt->rsa_padding = RSA_X931_PADDING; + } else if (tpl_terms[1] == atom_rsa_no_padding) { + opt->rsa_padding = RSA_NO_PADDING; + } else { + return PKEY_BADARG; + } + } else if (tpl_terms[0] == atom_signature_md && enif_is_atom(env, tpl_terms[1])) { + i = get_pkey_digest_type(env, algorithm, tpl_terms[1], &opt_md); + if (i != PKEY_OK) { + return i; + } + opt->signature_md = opt_md; + } else if (tpl_terms[0] == atom_rsa_mgf1_md && enif_is_atom(env, tpl_terms[1])) { +#ifndef HAVE_RSA_OAEP_MD + if (tpl_terms[1] != atom_sha) + return PKEY_NOTSUP; +#endif + i = get_pkey_digest_type(env, algorithm, tpl_terms[1], &opt_md); + if (i != PKEY_OK) { + return i; + } + opt->rsa_mgf1_md = opt_md; + } else if (tpl_terms[0] == atom_rsa_oaep_label + && enif_inspect_binary(env, tpl_terms[1], &(opt->rsa_oaep_label))) { +#ifdef HAVE_RSA_OAEP_MD + continue; +#else + return PKEY_NOTSUP; +#endif + } else if (tpl_terms[0] == atom_rsa_oaep_md && enif_is_atom(env, tpl_terms[1])) { +#ifndef HAVE_RSA_OAEP_MD + if (tpl_terms[1] != atom_sha) + return PKEY_NOTSUP; +#endif + i = get_pkey_digest_type(env, algorithm, tpl_terms[1], &opt_md); + if (i != PKEY_OK) { + return i; + } + opt->rsa_oaep_md = opt_md; + } else { + return PKEY_BADARG; + } + } else { + return PKEY_BADARG; + } + } + } else { + return PKEY_BADARG; + } + + return PKEY_OK; +} + +static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) +{/* (Algorithm, Data, PublKey=[E,N]|[E,N,D]|[E,N,D,P1,P2,E1,E2,C], Options, IsPrivate, IsEncrypt) */ + int i; + EVP_PKEY *pkey; +#ifdef HAS_EVP_PKEY_CTX + EVP_PKEY_CTX *ctx; +#else + RSA *rsa; +#endif + PKeyCryptOptions crypt_opt; + ErlNifBinary in_bin, out_bin, tmp_bin; + size_t outlen, tmplen; + int is_private = (argv[4] == atom_true), + is_encrypt = (argv[5] == atom_true); + int algo_init = 0; + +/* char algo[1024]; */ + +#ifndef HAS_ENGINE_SUPPORT + if (enif_is_map(env, argv[2])) { + return atom_notsup; + } +#endif + + if (!enif_inspect_binary(env, argv[1], &in_bin)) { + return enif_make_badarg(env); + } + + i = get_pkey_crypt_options(env, argv[0], argv[3], &crypt_opt); + if (i != PKEY_OK) { + if (i == PKEY_NOTSUP) + return atom_notsup; + else + return enif_make_badarg(env); + } + + if (is_private) { + if (get_pkey_private_key(env, argv[0], argv[2], &pkey) != PKEY_OK) { + return enif_make_badarg(env); + } + } else { + if (get_pkey_public_key(env, argv[0], argv[2], &pkey) != PKEY_OK) { + return enif_make_badarg(env); + } + } + + out_bin.data = NULL; + out_bin.size = 0; + tmp_bin.data = NULL; + tmp_bin.size = 0; + +#ifdef HAS_EVP_PKEY_CTX + ctx = EVP_PKEY_CTX_new(pkey, NULL); + if (!ctx) goto badarg; + +/* enif_get_atom(env,argv[0],algo,1024,ERL_NIF_LATIN1); */ + + if (is_private) { + if (is_encrypt) { + /* private encrypt */ + if ((algo_init=EVP_PKEY_sign_init(ctx)) <= 0) { + /* fprintf(stderr,"BADARG %s private encrypt algo_init=%d %s:%d\r\n", algo, algo_init, __FILE__, __LINE__); */ + goto badarg; + } + } else { + /* private decrypt */ + if ((algo_init=EVP_PKEY_decrypt_init(ctx)) <= 0) { + /* fprintf(stderr,"BADARG %s private decrypt algo_init=%d %s:%d\r\n", algo, algo_init, __FILE__, __LINE__); */ + goto badarg; + } + } + } else { + if (is_encrypt) { + /* public encrypt */ + if ((algo_init=EVP_PKEY_encrypt_init(ctx)) <= 0) { + /* fprintf(stderr,"BADARG %s public encrypt algo_init=%d %s:%d\r\n", algo,algo_init,__FILE__, __LINE__); */ + goto badarg; + } + } else { + /* public decrypt */ + if ((algo_init=EVP_PKEY_verify_recover_init(ctx)) <= 0) { + /* fprintf(stderr,"BADARG %s public decrypt algo_init=%d %s:%d\r\n", algo,algo_init,__FILE__, __LINE__); */ + goto badarg; + } + } + } + + if (argv[0] == atom_rsa) { + if (crypt_opt.signature_md != NULL + && EVP_PKEY_CTX_set_signature_md(ctx, crypt_opt.signature_md) <= 0) + goto badarg; + if (crypt_opt.rsa_padding == RSA_SSLV23_PADDING) { + if (is_encrypt) { + RSA *rsa = EVP_PKEY_get1_RSA(pkey); + if (rsa == NULL) goto badarg; + tmplen = RSA_size(rsa); + if (!enif_alloc_binary(tmplen, &tmp_bin)) goto badarg; + if (RSA_padding_add_SSLv23(tmp_bin.data, tmplen, in_bin.data, in_bin.size) <= 0) + goto badarg; + in_bin = tmp_bin; + } + if (EVP_PKEY_CTX_set_rsa_padding(ctx, RSA_NO_PADDING) <= 0) goto badarg; + } else { + if (EVP_PKEY_CTX_set_rsa_padding(ctx, crypt_opt.rsa_padding) <= 0) goto badarg; + } +#ifdef HAVE_RSA_OAEP_MD + if (crypt_opt.rsa_padding == RSA_PKCS1_OAEP_PADDING) { + if (crypt_opt.rsa_oaep_md != NULL + && EVP_PKEY_CTX_set_rsa_oaep_md(ctx, crypt_opt.rsa_oaep_md) <= 0) + goto badarg; + if (crypt_opt.rsa_mgf1_md != NULL + && EVP_PKEY_CTX_set_rsa_mgf1_md(ctx, crypt_opt.rsa_mgf1_md) <= 0) goto badarg; + if (crypt_opt.rsa_oaep_label.data != NULL && crypt_opt.rsa_oaep_label.size > 0) { + unsigned char *label_copy; + label_copy = OPENSSL_malloc(crypt_opt.rsa_oaep_label.size); + if (label_copy == NULL) goto badarg; + memcpy((void *)(label_copy), (const void *)(crypt_opt.rsa_oaep_label.data), + crypt_opt.rsa_oaep_label.size); + if (EVP_PKEY_CTX_set0_rsa_oaep_label(ctx, label_copy, + crypt_opt.rsa_oaep_label.size) <= 0) { + OPENSSL_free(label_copy); + label_copy = NULL; + goto badarg; + } + } + } +#endif + } + + if (is_private) { + if (is_encrypt) { + /* private_encrypt */ + i = EVP_PKEY_sign(ctx, NULL, &outlen, in_bin.data, in_bin.size); + } else { + /* private_decrypt */ + i = EVP_PKEY_decrypt(ctx, NULL, &outlen, in_bin.data, in_bin.size); + } + } else { + if (is_encrypt) { + /* public_encrypt */ + i = EVP_PKEY_encrypt(ctx, NULL, &outlen, in_bin.data, in_bin.size); + } else { + /* public_decrypt */ + i = EVP_PKEY_verify_recover(ctx, NULL, &outlen, in_bin.data, in_bin.size); + } + } + /* fprintf(stderr,"i = %d %s:%d\r\n", i, __FILE__, __LINE__); */ + + if (i != 1) goto badarg; + + enif_alloc_binary(outlen, &out_bin); + + if (is_private) { + if (is_encrypt) { + /* private_encrypt */ + i = EVP_PKEY_sign(ctx, out_bin.data, &outlen, in_bin.data, in_bin.size); + } else { + /* private_decrypt */ + i = EVP_PKEY_decrypt(ctx, out_bin.data, &outlen, in_bin.data, in_bin.size); + } + } else { + if (is_encrypt) { + /* public_encrypt */ + i = EVP_PKEY_encrypt(ctx, out_bin.data, &outlen, in_bin.data, in_bin.size); + } else { + /* public_decrypt */ + i = EVP_PKEY_verify_recover(ctx, out_bin.data, &outlen, in_bin.data, in_bin.size); + } + } + +#else + /* Non-EVP cryptolib. Only support RSA */ + + if (argv[0] != atom_rsa) { + algo_init = -2; /* exitcode: notsup */ + goto badarg; + } + rsa = EVP_PKEY_get1_RSA(pkey); + enif_alloc_binary(RSA_size(rsa), &out_bin); + + if (is_private) { + if (is_encrypt) { + /* non-evp rsa private encrypt */ + ERL_VALGRIND_ASSERT_MEM_DEFINED(in_bin.data,in_bin.size); + i = RSA_private_encrypt(in_bin.size, in_bin.data, + out_bin.data, rsa, crypt_opt.rsa_padding); + if (i > 0) { + ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, i); + } + } else { + /* non-evp rsa private decrypt */ + i = RSA_private_decrypt(in_bin.size, in_bin.data, + out_bin.data, rsa, crypt_opt.rsa_padding); + if (i > 0) { + ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, i); + enif_realloc_binary(&out_bin, i); + } + } + } else { + if (is_encrypt) { + /* non-evp rsa public encrypt */ + ERL_VALGRIND_ASSERT_MEM_DEFINED(in_bin.data,in_bin.size); + i = RSA_public_encrypt(in_bin.size, in_bin.data, + out_bin.data, rsa, crypt_opt.rsa_padding); + if (i > 0) { + ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, i); + } + } else { + /* non-evp rsa public decrypt */ + i = RSA_public_decrypt(in_bin.size, in_bin.data, + out_bin.data, rsa, crypt_opt.rsa_padding); + if (i > 0) { + ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, i); + enif_realloc_binary(&out_bin, i); + } + } + } + + outlen = i; + RSA_free(rsa); +#endif + + if ((i > 0) && argv[0] == atom_rsa && !is_encrypt) { + if (crypt_opt.rsa_padding == RSA_SSLV23_PADDING) { + RSA *rsa = EVP_PKEY_get1_RSA(pkey); + unsigned char *p; + if (rsa == NULL) goto badarg; + tmplen = RSA_size(rsa); + if (!enif_alloc_binary(tmplen, &tmp_bin)) goto badarg; + p = out_bin.data; + p++; + i = RSA_padding_check_SSLv23(tmp_bin.data, tmplen, p, out_bin.size - 1, tmplen); + if (i >= 0) { + outlen = i; + in_bin = out_bin; + out_bin = tmp_bin; + tmp_bin = in_bin; + i = 1; + } + } + } + + if (tmp_bin.data != NULL) { + enif_release_binary(&tmp_bin); + } + +#ifdef HAS_EVP_PKEY_CTX + EVP_PKEY_CTX_free(ctx); +#else +#endif + EVP_PKEY_free(pkey); + if (i > 0) { + ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, outlen); + if (outlen != out_bin.size) { + enif_realloc_binary(&out_bin, outlen); + ERL_VALGRIND_ASSERT_MEM_DEFINED(out_bin.data, outlen); + } + return enif_make_binary(env, &out_bin); + } else { + enif_release_binary(&out_bin); + return atom_error; + } + + badarg: + if (out_bin.data != NULL) { + enif_release_binary(&out_bin); + } + if (tmp_bin.data != NULL) { + enif_release_binary(&tmp_bin); + } +#ifdef HAS_EVP_PKEY_CTX + EVP_PKEY_CTX_free(ctx); +#else +#endif + EVP_PKEY_free(pkey); + if (algo_init == -2) + return atom_notsup; + else + return enif_make_badarg(env); +} + + + +/*--------------------------------*/ +static ERL_NIF_TERM privkey_to_pubkey_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ /* (Algorithm, PrivKey | KeyMap) */ + EVP_PKEY *pkey; + ERL_NIF_TERM alg = argv[0]; + ERL_NIF_TERM result[8]; + if (get_pkey_private_key(env, alg, argv[1], &pkey) != PKEY_OK) { + return enif_make_badarg(env); + } + + if (alg == atom_rsa) { + const BIGNUM *n = NULL, *e = NULL, *d = NULL; + RSA *rsa = EVP_PKEY_get1_RSA(pkey); + if (rsa) { + RSA_get0_key(rsa, &n, &e, &d); + result[0] = bin_from_bn(env, e); // Exponent E + result[1] = bin_from_bn(env, n); // Modulus N = p*q + EVP_PKEY_free(pkey); + return enif_make_list_from_array(env, result, 2); + } + + } else if (argv[0] == atom_dss) { + const BIGNUM *p = NULL, *q = NULL, *g = NULL, *pub_key = NULL; + DSA *dsa = EVP_PKEY_get1_DSA(pkey); + if (dsa) { + DSA_get0_pqg(dsa, &p, &q, &g); + DSA_get0_key(dsa, &pub_key, NULL); + result[0] = bin_from_bn(env, p); + result[1] = bin_from_bn(env, q); + result[2] = bin_from_bn(env, g); + result[3] = bin_from_bn(env, pub_key); + EVP_PKEY_free(pkey); + return enif_make_list_from_array(env, result, 4); + } + + } else if (argv[0] == atom_ecdsa) { +#if defined(HAVE_EC) + /* not yet implemented + EC_KEY *ec = EVP_PKEY_get1_EC_KEY(pkey); + if (ec) { + / * Example of result: + { + Curve = {Field, Prime, Point, Order, CoFactor} = + { + Field = {prime_field,<<255,...,255>>}, + Prime = {<<255,...,252>>, + <<90,...,75>>, + <<196,...,144>> + }, + Point = <<4,...,245>>, + Order = <<255,...,81>>, + CoFactor = <<1>> + }, + Key = <<151,...,62>> + } + or + { + Curve = + {characteristic_two_field, + M, + Basis = {tpbasis, _} + | {ppbasis, k1, k2, k3} + }, + Key + } + * / + EVP_PKEY_free(pkey); + return enif_make_list_from_array(env, ..., ...); + */ +#endif + } + + if (pkey) EVP_PKEY_free(pkey); + return enif_make_badarg(env); +} + /*================================================================*/ static ERL_NIF_TERM rand_seed_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -4280,3 +4875,600 @@ static ERL_NIF_TERM rand_seed_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a RAND_seed(seed_bin.data,seed_bin.size); return atom_ok; } + +/*================================================================*/ +/* Engine */ +/*================================================================*/ +static ERL_NIF_TERM engine_by_id_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (EngineId) */ +#ifdef HAS_ENGINE_SUPPORT + ERL_NIF_TERM ret; + ErlNifBinary engine_id_bin; + char *engine_id; + ENGINE *engine; + struct engine_ctx *ctx; + + // Get Engine Id + if(!enif_inspect_binary(env, argv[0], &engine_id_bin)) { + PRINTF_ERR0("engine_by_id_nif Leaved: badarg"); + return enif_make_badarg(env); + } else { + engine_id = enif_alloc(engine_id_bin.size+1); + (void) memcpy(engine_id, engine_id_bin.data, engine_id_bin.size); + engine_id[engine_id_bin.size] = '\0'; + } + + engine = ENGINE_by_id(engine_id); + if(!engine) { + enif_free(engine_id); + PRINTF_ERR0("engine_by_id_nif Leaved: {error, bad_engine_id}"); + return enif_make_tuple2(env, atom_error, atom_bad_engine_id); + } + + ctx = enif_alloc_resource(engine_ctx_rtype, sizeof(struct engine_ctx)); + ctx->engine = engine; + ctx->id = engine_id; + + ret = enif_make_resource(env, ctx); + enif_release_resource(ctx); + + return enif_make_tuple2(env, atom_ok, ret); +#else + return atom_notsup; +#endif +} + +static ERL_NIF_TERM engine_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Engine) */ +#ifdef HAS_ENGINE_SUPPORT + ERL_NIF_TERM ret = atom_ok; + struct engine_ctx *ctx; + + // Get Engine + if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) { + PRINTF_ERR0("engine_init_nif Leaved: Parameter not an engine resource object"); + return enif_make_badarg(env); + } + if (!ENGINE_init(ctx->engine)) { + //ERR_print_errors_fp(stderr); + PRINTF_ERR0("engine_init_nif Leaved: {error, engine_init_failed}"); + return enif_make_tuple2(env, atom_error, atom_engine_init_failed); + } + + return ret; +#else + return atom_notsup; +#endif +} + +static ERL_NIF_TERM engine_free_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Engine) */ +#ifdef HAS_ENGINE_SUPPORT + struct engine_ctx *ctx; + + // Get Engine + if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) { + PRINTF_ERR0("engine_free_nif Leaved: Parameter not an engine resource object"); + return enif_make_badarg(env); + } + + ENGINE_free(ctx->engine); + return atom_ok; +#else + return atom_notsup; +#endif +} + +static ERL_NIF_TERM engine_finish_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Engine) */ +#ifdef HAS_ENGINE_SUPPORT + struct engine_ctx *ctx; + + // Get Engine + if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) { + PRINTF_ERR0("engine_finish_nif Leaved: Parameter not an engine resource object"); + return enif_make_badarg(env); + } + + ENGINE_finish(ctx->engine); + return atom_ok; +#else + return atom_notsup; +#endif +} + +static ERL_NIF_TERM engine_load_dynamic_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* () */ +#ifdef HAS_ENGINE_SUPPORT + ENGINE_load_dynamic(); + return atom_ok; +#else + return atom_notsup; +#endif +} + +static ERL_NIF_TERM engine_ctrl_cmd_strings_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Engine, Commands) */ +#ifdef HAS_ENGINE_SUPPORT + ERL_NIF_TERM ret = atom_ok; + unsigned int cmds_len = 0; + char **cmds = NULL; + struct engine_ctx *ctx; + int i, optional = 0; + + // Get Engine + if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) { + PRINTF_ERR0("engine_ctrl_cmd_strings_nif Leaved: Parameter not an engine resource object"); + return enif_make_badarg(env); + } + + PRINTF_ERR1("Engine Id: %s\r\n", ENGINE_get_id(ctx->engine)); + + // Get Command List + if(!enif_get_list_length(env, argv[1], &cmds_len)) { + PRINTF_ERR0("engine_ctrl_cmd_strings_nif Leaved: Bad Command List"); + return enif_make_badarg(env); + } else { + cmds_len *= 2; // Key-Value list from erlang + cmds = enif_alloc((cmds_len+1)*sizeof(char*)); + if(get_engine_load_cmd_list(env, argv[1], cmds, 0)) { + PRINTF_ERR0("engine_ctrl_cmd_strings_nif Leaved: Couldn't read Command List"); + ret = enif_make_badarg(env); + goto error; + } + } + + if(!enif_get_int(env, argv[2], &optional)) { + PRINTF_ERR0("engine_ctrl_cmd_strings_nif Leaved: Parameter optional not an integer"); + return enif_make_badarg(env); + } + + for(i = 0; i < cmds_len; i+=2) { + PRINTF_ERR2("Cmd: %s:%s\r\n", + cmds[i] ? cmds[i] : "(NULL)", + cmds[i+1] ? cmds[i+1] : "(NULL)"); + if(!ENGINE_ctrl_cmd_string(ctx->engine, cmds[i], cmds[i+1], optional)) { + PRINTF_ERR2("Command failed: %s:%s\r\n", + cmds[i] ? cmds[i] : "(NULL)", + cmds[i+1] ? cmds[i+1] : "(NULL)"); + //ENGINE_free(ctx->engine); + ret = enif_make_tuple2(env, atom_error, atom_ctrl_cmd_failed); + PRINTF_ERR0("engine_ctrl_cmd_strings_nif Leaved: {error, ctrl_cmd_failed}"); + goto error; + } + } + + error: + for(i = 0; cmds != NULL && cmds[i] != NULL; i++) + enif_free(cmds[i]); + enif_free(cmds); + return ret; +#else + return atom_notsup; +#endif +} + +static ERL_NIF_TERM engine_add_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Engine) */ +#ifdef HAS_ENGINE_SUPPORT + struct engine_ctx *ctx; + + // Get Engine + if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) { + PRINTF_ERR0("engine_add_nif Leaved: Parameter not an engine resource object"); + return enif_make_badarg(env); + } + + if (!ENGINE_add(ctx->engine)) { + PRINTF_ERR0("engine_add_nif Leaved: {error, add_engine_failed}"); + return enif_make_tuple2(env, atom_error, atom_add_engine_failed); + } + return atom_ok; +#else + return atom_notsup; +#endif +} + +static ERL_NIF_TERM engine_remove_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Engine) */ +#ifdef HAS_ENGINE_SUPPORT + struct engine_ctx *ctx; + + // Get Engine + if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) { + PRINTF_ERR0("engine_remove_nif Leaved: Parameter not an engine resource object"); + return enif_make_badarg(env); + } + + if (!ENGINE_remove(ctx->engine)) { + PRINTF_ERR0("engine_remove_nif Leaved: {error, remove_engine_failed}"); + return enif_make_tuple2(env, atom_error, atom_remove_engine_failed); + } + return atom_ok; +#else + return atom_notsup; +#endif +} + +static ERL_NIF_TERM engine_register_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Engine, EngineMethod) */ +#ifdef HAS_ENGINE_SUPPORT + struct engine_ctx *ctx; + unsigned int method; + + // Get Engine + if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) { + PRINTF_ERR0("engine_register_nif Leaved: Parameter not an engine resource object"); + return enif_make_badarg(env); + } + // Get Method + if (!enif_get_uint(env, argv[1], &method)) { + PRINTF_ERR0("engine_register_nif Leaved: Parameter Method not an uint"); + return enif_make_badarg(env); + } + + switch(method) + { +#ifdef ENGINE_METHOD_RSA + case ENGINE_METHOD_RSA: + if (!ENGINE_register_RSA(ctx->engine)) + return enif_make_tuple2(env, atom_error, atom_register_engine_failed); + break; +#endif +#ifdef ENGINE_METHOD_DSA + case ENGINE_METHOD_DSA: + if (!ENGINE_register_DSA(ctx->engine)) + return enif_make_tuple2(env, atom_error, atom_register_engine_failed); + break; +#endif +#ifdef ENGINE_METHOD_DH + case ENGINE_METHOD_DH: + if (!ENGINE_register_DH(ctx->engine)) + return enif_make_tuple2(env, atom_error, atom_register_engine_failed); + break; +#endif +#ifdef ENGINE_METHOD_RAND + case ENGINE_METHOD_RAND: + if (!ENGINE_register_RAND(ctx->engine)) + return enif_make_tuple2(env, atom_error, atom_register_engine_failed); + break; +#endif +#ifdef ENGINE_METHOD_ECDH + case ENGINE_METHOD_ECDH: + if (!ENGINE_register_ECDH(ctx->engine)) + return enif_make_tuple2(env, atom_error, atom_register_engine_failed); + break; +#endif +#ifdef ENGINE_METHOD_ECDSA + case ENGINE_METHOD_ECDSA: + if (!ENGINE_register_ECDSA(ctx->engine)) + return enif_make_tuple2(env, atom_error, atom_register_engine_failed); + break; +#endif +#ifdef ENGINE_METHOD_STORE + case ENGINE_METHOD_STORE: + if (!ENGINE_register_STORE(ctx->engine)) + return enif_make_tuple2(env, atom_error, atom_register_engine_failed); + break; +#endif +#ifdef ENGINE_METHOD_CIPHERS + case ENGINE_METHOD_CIPHERS: + if (!ENGINE_register_ciphers(ctx->engine)) + return enif_make_tuple2(env, atom_error, atom_register_engine_failed); + break; +#endif +#ifdef ENGINE_METHOD_DIGESTS + case ENGINE_METHOD_DIGESTS: + if (!ENGINE_register_digests(ctx->engine)) + return enif_make_tuple2(env, atom_error, atom_register_engine_failed); + break; +#endif +#ifdef ENGINE_METHOD_PKEY_METHS + case ENGINE_METHOD_PKEY_METHS: + if (!ENGINE_register_pkey_meths(ctx->engine)) + return enif_make_tuple2(env, atom_error, atom_register_engine_failed); + break; +#endif +#ifdef ENGINE_METHOD_PKEY_ASN1_METHS + case ENGINE_METHOD_PKEY_ASN1_METHS: + if (!ENGINE_register_pkey_asn1_meths(ctx->engine)) + return enif_make_tuple2(env, atom_error, atom_register_engine_failed); + break; +#endif +#ifdef ENGINE_METHOD_EC + case ENGINE_METHOD_EC: + if (!ENGINE_register_EC(ctx->engine)) + return enif_make_tuple2(env, atom_error, atom_register_engine_failed); + break; +#endif + default: + return enif_make_tuple2(env, atom_error, atom_engine_method_not_supported); + break; + } + return atom_ok; +#else + return atom_notsup; +#endif +} + +static ERL_NIF_TERM engine_unregister_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Engine, EngineMethod) */ +#ifdef HAS_ENGINE_SUPPORT + struct engine_ctx *ctx; + unsigned int method; + + // Get Engine + if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) { + PRINTF_ERR0("engine_unregister_nif Leaved: Parameter not an engine resource object"); + return enif_make_badarg(env); + } + // Get Method + if (!enif_get_uint(env, argv[1], &method)) { + PRINTF_ERR0("engine_unregister_nif Leaved: Parameter Method not an uint"); + return enif_make_badarg(env); + } + + switch(method) + { +#ifdef ENGINE_METHOD_RSA + case ENGINE_METHOD_RSA: + ENGINE_unregister_RSA(ctx->engine); + break; +#endif +#ifdef ENGINE_METHOD_DSA + case ENGINE_METHOD_DSA: + ENGINE_unregister_DSA(ctx->engine); + break; +#endif +#ifdef ENGINE_METHOD_DH + case ENGINE_METHOD_DH: + ENGINE_unregister_DH(ctx->engine); + break; +#endif +#ifdef ENGINE_METHOD_RAND + case ENGINE_METHOD_RAND: + ENGINE_unregister_RAND(ctx->engine); + break; +#endif +#ifdef ENGINE_METHOD_ECDH + case ENGINE_METHOD_ECDH: + ENGINE_unregister_ECDH(ctx->engine); + break; +#endif +#ifdef ENGINE_METHOD_ECDSA + case ENGINE_METHOD_ECDSA: + ENGINE_unregister_ECDSA(ctx->engine); + break; +#endif +#ifdef ENGINE_METHOD_STORE + case ENGINE_METHOD_STORE: + ENGINE_unregister_STORE(ctx->engine); + break; +#endif +#ifdef ENGINE_METHOD_CIPHERS + case ENGINE_METHOD_CIPHERS: + ENGINE_unregister_ciphers(ctx->engine); + break; +#endif +#ifdef ENGINE_METHOD_DIGESTS + case ENGINE_METHOD_DIGESTS: + ENGINE_unregister_digests(ctx->engine); + break; +#endif +#ifdef ENGINE_METHOD_PKEY_METHS + case ENGINE_METHOD_PKEY_METHS: + ENGINE_unregister_pkey_meths(ctx->engine); + break; +#endif +#ifdef ENGINE_METHOD_PKEY_ASN1_METHS + case ENGINE_METHOD_PKEY_ASN1_METHS: + ENGINE_unregister_pkey_asn1_meths(ctx->engine); + break; +#endif +#ifdef ENGINE_METHOD_EC + case ENGINE_METHOD_EC: + ENGINE_unregister_EC(ctx->engine); + break; +#endif + default: + break; + } + return atom_ok; +#else + return atom_notsup; +#endif +} + +static ERL_NIF_TERM engine_get_first_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Engine) */ +#ifdef HAS_ENGINE_SUPPORT + ERL_NIF_TERM ret; + ENGINE *engine; + ErlNifBinary engine_bin; + struct engine_ctx *ctx; + + engine = ENGINE_get_first(); + if(!engine) { + enif_alloc_binary(0, &engine_bin); + engine_bin.size = 0; + return enif_make_tuple2(env, atom_ok, enif_make_binary(env, &engine_bin)); + } + + ctx = enif_alloc_resource(engine_ctx_rtype, sizeof(struct engine_ctx)); + ctx->engine = engine; + ctx->id = NULL; + + ret = enif_make_resource(env, ctx); + enif_release_resource(ctx); + + return enif_make_tuple2(env, atom_ok, ret); +#else + return atom_notsup; +#endif +} + +static ERL_NIF_TERM engine_get_next_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Engine) */ +#ifdef HAS_ENGINE_SUPPORT + ERL_NIF_TERM ret; + ENGINE *engine; + ErlNifBinary engine_bin; + struct engine_ctx *ctx, *next_ctx; + + // Get Engine + if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) { + PRINTF_ERR0("engine_get_next_nif Leaved: Parameter not an engine resource object"); + return enif_make_badarg(env); + } + engine = ENGINE_get_next(ctx->engine); + if (!engine) { + enif_alloc_binary(0, &engine_bin); + engine_bin.size = 0; + return enif_make_tuple2(env, atom_ok, enif_make_binary(env, &engine_bin)); + } + + next_ctx = enif_alloc_resource(engine_ctx_rtype, sizeof(struct engine_ctx)); + next_ctx->engine = engine; + next_ctx->id = NULL; + + ret = enif_make_resource(env, next_ctx); + enif_release_resource(next_ctx); + + return enif_make_tuple2(env, atom_ok, ret); +#else + return atom_notsup; +#endif +} + +static ERL_NIF_TERM engine_get_id_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Engine) */ +#ifdef HAS_ENGINE_SUPPORT + ErlNifBinary engine_id_bin; + const char *engine_id; + int size; + struct engine_ctx *ctx; + + // Get Engine + if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) { + PRINTF_ERR0("engine_get_id_nif Leaved: Parameter not an engine resource object"); + return enif_make_badarg(env); + } + + engine_id = ENGINE_get_id(ctx->engine); + if (!engine_id) { + enif_alloc_binary(0, &engine_id_bin); + engine_id_bin.size = 0; + return enif_make_tuple2(env, atom_ok, enif_make_binary(env, &engine_id_bin)); + } + + size = strlen(engine_id); + enif_alloc_binary(size, &engine_id_bin); + engine_id_bin.size = size; + memcpy(engine_id_bin.data, engine_id, size); + + return enif_make_tuple2(env, atom_ok, enif_make_binary(env, &engine_id_bin)); +#else + return atom_notsup; +#endif +} + +static int get_engine_load_cmd_list(ErlNifEnv* env, const ERL_NIF_TERM term, char **cmds, int i) +{ +#ifdef HAS_ENGINE_SUPPORT + ERL_NIF_TERM head, tail; + const ERL_NIF_TERM *tmp_tuple; + ErlNifBinary tmpbin; + int arity; + char* tmpstr; + + if(!enif_is_empty_list(env, term)) { + if(!enif_get_list_cell(env, term, &head, &tail)) { + cmds[i] = NULL; + return -1; + } else { + if(!enif_get_tuple(env, head, &arity, &tmp_tuple) || arity != 2) { + cmds[i] = NULL; + return -1; + } else { + if(!enif_inspect_binary(env, tmp_tuple[0], &tmpbin)) { + cmds[i] = NULL; + return -1; + } else { + tmpstr = enif_alloc(tmpbin.size+1); + (void) memcpy(tmpstr, tmpbin.data, tmpbin.size); + tmpstr[tmpbin.size] = '\0'; + cmds[i++] = tmpstr; + } + if(!enif_inspect_binary(env, tmp_tuple[1], &tmpbin)) { + cmds[i] = NULL; + return -1; + } else { + if(tmpbin.size == 0) + cmds[i++] = NULL; + else { + tmpstr = enif_alloc(tmpbin.size+1); + (void) memcpy(tmpstr, tmpbin.data, tmpbin.size); + tmpstr[tmpbin.size] = '\0'; + cmds[i++] = tmpstr; + } + } + return get_engine_load_cmd_list(env, tail, cmds, i); + } + } + } else { + cmds[i] = NULL; + return 0; + } +#else + return atom_notsup; +#endif +} + +static ERL_NIF_TERM engine_get_all_methods_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* () */ +#ifdef HAS_ENGINE_SUPPORT + ERL_NIF_TERM method_array[12]; + int i = 0; + +#ifdef ENGINE_METHOD_RSA + method_array[i++] = atom_engine_method_rsa; +#endif +#ifdef ENGINE_METHOD_DSA + method_array[i++] = atom_engine_method_dsa; +#endif +#ifdef ENGINE_METHOD_DH + method_array[i++] = atom_engine_method_dh; +#endif +#ifdef ENGINE_METHOD_RAND + method_array[i++] = atom_engine_method_rand; +#endif +#ifdef ENGINE_METHOD_ECDH + method_array[i++] = atom_engine_method_ecdh; +#endif +#ifdef ENGINE_METHOD_ECDSA + method_array[i++] = atom_engine_method_ecdsa; +#endif +#ifdef ENGINE_METHOD_STORE + method_array[i++] = atom_engine_method_store; +#endif +#ifdef ENGINE_METHOD_CIPHERS + method_array[i++] = atom_engine_method_ciphers; +#endif +#ifdef ENGINE_METHOD_DIGESTS + method_array[i++] = atom_engine_method_digests; +#endif +#ifdef ENGINE_METHOD_PKEY_METHS + method_array[i++] = atom_engine_method_pkey_meths; +#endif +#ifdef ENGINE_METHOD_PKEY_ASN1_METHS + method_array[i++] = atom_engine_method_pkey_asn1_meths; +#endif +#ifdef ENGINE_METHOD_EC + method_array[i++] = atom_engine_method_ec; +#endif + + return enif_make_list_from_array(env, method_array, i); +#else + return atom_notsup; +#endif +} diff --git a/lib/crypto/c_src/otp_test_engine.c b/lib/crypto/c_src/otp_test_engine.c new file mode 100644 index 0000000000..5c6122c06a --- /dev/null +++ b/lib/crypto/c_src/otp_test_engine.c @@ -0,0 +1,264 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2017-2017. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +#ifdef _WIN32 +#define OPENSSL_OPT_WINDLL +#endif +#include <stdio.h> +#include <string.h> + +#include <openssl/engine.h> +#include <openssl/md5.h> +#include <openssl/rsa.h> +#include <openssl/pem.h> + +#define PACKED_OPENSSL_VERSION(MAJ, MIN, FIX, P) \ + ((((((((MAJ << 8) | MIN) << 8 ) | FIX) << 8) | (P-'a'+1)) << 4) | 0xf) + +#define PACKED_OPENSSL_VERSION_PLAIN(MAJ, MIN, FIX) \ + PACKED_OPENSSL_VERSION(MAJ,MIN,FIX,('a'-1)) + +#if OPENSSL_VERSION_NUMBER < PACKED_OPENSSL_VERSION_PLAIN(1,1,0) \ + || defined(LIBRESSL_VERSION_NUMBER) +#define OLD +#endif + +static const char *test_engine_id = "MD5"; +static const char *test_engine_name = "MD5 test engine"; + +/* The callback that does the job of fetching keys on demand by the Engine */ +EVP_PKEY* test_key_load(ENGINE *er, const char *id, UI_METHOD *ui_method, void *callback_data); + + +static int test_init(ENGINE *e) { + printf("OTP Test Engine Initializatzion!\r\n"); + + /* Load all digest and cipher algorithms. Needed for password protected private keys */ + OpenSSL_add_all_algorithms(); + + return 111; +} + +static void add_test_data(unsigned char *md, unsigned int len) +{ + unsigned int i; + + for (i=0; i<len; i++) { + md[i] = (unsigned char)(i & 0xff); + } +} + +/* MD5 part */ +#undef data +#ifdef OLD +#define data(ctx) ((MD5_CTX *)ctx->md_data) +#endif + +static int test_engine_md5_init(EVP_MD_CTX *ctx) { + fprintf(stderr, "MD5 initialized\r\n"); +#ifdef OLD + return MD5_Init(data(ctx)); +#else + return 1; +#endif +} + +static int test_engine_md5_update(EVP_MD_CTX *ctx,const void *data, size_t count) +{ + fprintf(stderr, "MD5 update\r\n"); +#ifdef OLD + return MD5_Update(data(ctx), data, (size_t)count); +#else + return 1; +#endif +} + +static int test_engine_md5_final(EVP_MD_CTX *ctx,unsigned char *md) { +#ifdef OLD + int ret; + + fprintf(stderr, "MD5 final size of EVP_MD: %lu\r\n", sizeof(EVP_MD)); + ret = MD5_Final(md, data(ctx)); + + if (ret > 0) { + add_test_data(md, MD5_DIGEST_LENGTH); + } + return ret; +#else + fprintf(stderr, "MD5 final\r\n"); + add_test_data(md, MD5_DIGEST_LENGTH); + return 1; +#endif +} + +#ifdef OLD +static EVP_MD test_engine_md5_method= { + NID_md5, /* The name ID for MD5 */ + NID_undef, /* IGNORED: MD5 with private key encryption NID */ + MD5_DIGEST_LENGTH, /* Size of MD5 result, in bytes */ + 0, /* Flags */ + test_engine_md5_init, /* digest init */ + test_engine_md5_update, /* digest update */ + test_engine_md5_final, /* digest final */ + NULL, /* digest copy */ + NULL, /* digest cleanup */ + EVP_PKEY_NULL_method, /* IGNORED: pkey methods */ + MD5_CBLOCK, /* Internal blocksize, see rfc1321/md5.h */ + sizeof(EVP_MD *) + sizeof(MD5_CTX), + NULL, /* IGNORED: control function */ +}; +#endif + +static int test_digest_ids[] = {NID_md5}; + +static int test_engine_digest_selector(ENGINE *e, const EVP_MD **digest, + const int **nids, int nid) { + int ok = 1; + if (!digest) { + *nids = test_digest_ids; + fprintf(stderr, "Digest is empty! Nid:%d\r\n", nid); + return 2; + } + fprintf(stderr, "Digest no %d requested\r\n",nid); + if (nid == NID_md5) { +#ifdef OLD + *digest = &test_engine_md5_method; +#else + EVP_MD *md = EVP_MD_meth_new(NID_md5, NID_undef); + if (!md || + !EVP_MD_meth_set_result_size(md, MD5_DIGEST_LENGTH) || + !EVP_MD_meth_set_flags(md, 0) || + !EVP_MD_meth_set_init(md, test_engine_md5_init) || + !EVP_MD_meth_set_update(md, test_engine_md5_update) || + !EVP_MD_meth_set_final(md, test_engine_md5_final) || + !EVP_MD_meth_set_copy(md, NULL) || + !EVP_MD_meth_set_cleanup(md, NULL) || + !EVP_MD_meth_set_input_blocksize(md, MD5_CBLOCK) || + !EVP_MD_meth_set_app_datasize(md, sizeof(EVP_MD *) + sizeof(MD5_CTX)) || + !EVP_MD_meth_set_ctrl(md, NULL)) + { + ok = 0; + *digest = NULL; + } else + { + *digest = md; + } +#endif + } + else { + ok = 0; + *digest = NULL; + } + + return ok; +} + + +static int bind_helper(ENGINE * e, const char *id) +{ + if (!ENGINE_set_id(e, test_engine_id) || + !ENGINE_set_name(e, test_engine_name) || + !ENGINE_set_init_function(e, test_init) || + !ENGINE_set_digests(e, &test_engine_digest_selector) || + /* For testing of key storage in an Engine: */ + !ENGINE_set_load_privkey_function(e, &test_key_load) || + !ENGINE_set_load_pubkey_function(e, &test_key_load) + ) + return 0; + + return 1; +} + +IMPLEMENT_DYNAMIC_CHECK_FN(); + +IMPLEMENT_DYNAMIC_BIND_FN(bind_helper); + +/******************************************************** + * + * Engine storage simulation + * + */ +int pem_passwd_cb_fun(char *buf, int size, int rwflag, void *password); + +EVP_PKEY* test_key_load(ENGINE *er, const char *id, UI_METHOD *ui_method, void *callback_data) +{ + EVP_PKEY *pkey = NULL; + FILE *f = fopen(id, "r"); + + if (!f) { + fprintf(stderr, "%s:%d fopen(%s) failed\r\n", __FILE__,__LINE__,id); + return NULL; + } + + /* First try to read as a private key. If that fails, try to read as a public key: */ + pkey = PEM_read_PrivateKey(f, NULL, pem_passwd_cb_fun, callback_data); + if (!pkey) { + /* ERR_print_errors_fp (stderr); */ + fclose(f); + f = fopen(id, "r"); + pkey = PEM_read_PUBKEY(f, NULL, NULL, NULL); + } + fclose(f); + + if (!pkey) { + fprintf(stderr, "%s:%d Key read from file %s failed.\r\n", __FILE__,__LINE__,id); + if (callback_data) + fprintf(stderr, "Pwd = \"%s\".\r\n", (char *)callback_data); + fprintf(stderr, "Contents of file \"%s\":\r\n",id); + f = fopen(id, "r"); + { /* Print the contents of the key file */ + char c; + while (!feof(f)) { + switch (c=fgetc(f)) { + case '\n': + case '\r': putc('\r',stderr); putc('\n',stderr); break; + default: putc(c, stderr); + } + } + } + fprintf(stderr, "File contents printed.\r\n"); + fclose(f); + return NULL; + } + + return pkey; +} + + +int pem_passwd_cb_fun(char *buf, int size, int rwflag, void *password) +{ + int i; + + fprintf(stderr, "In pem_passwd_cb_fun\r\n"); + if (!password) + return 0; + + i = strlen(password); + if (i < size) { + /* whole pwd (incl terminating 0) fits */ + fprintf(stderr, "Got FULL pwd %d(%d) chars\r\n", i, size); + memcpy(buf, (char*)password, i+1); + return i+1; + } else { + fprintf(stderr, "Got TO LONG pwd %d(%d) chars\r\n", i, size); + /* meaningless with a truncated password */ + return 0; + } +} diff --git a/lib/crypto/doc/src/Makefile b/lib/crypto/doc/src/Makefile index 9c503b8fe0..aa987d2b39 100644 --- a/lib/crypto/doc/src/Makefile +++ b/lib/crypto/doc/src/Makefile @@ -9,11 +9,11 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. -# +# # The Initial Developer of the Original Code is Ericsson Utvecklings AB. # Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings # AB. All Rights Reserved.'' -# +# # $Id$ # include $(ERL_TOP)/make/target.mk @@ -38,13 +38,13 @@ XML_APPLICATION_FILES = ref_man.xml XML_REF3_FILES = crypto.xml XML_REF6_FILES = crypto_app.xml -XML_PART_FILES = release_notes.xml usersguide.xml -XML_CHAPTER_FILES = notes.xml licenses.xml fips.xml +XML_PART_FILES = usersguide.xml +XML_CHAPTER_FILES = notes.xml licenses.xml fips.xml engine_load.xml engine_keys.xml BOOK_FILES = book.xml XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) $(XML_REF6_FILES) \ - $(XML_PART_FILES) $(XML_CHAPTER_FILES) + $(XML_PART_FILES) $(XML_CHAPTER_FILES) GIF_FILES = @@ -63,9 +63,9 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += +XML_FLAGS += # ---------------------------------------------------- # Targets @@ -73,7 +73,6 @@ XML_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -86,7 +85,7 @@ man: $(MAN3_FILES) $(MAN6_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) -debug opt valgrind: +debug opt valgrind: clean clean_docs clean_tex: rm -rf $(HTMLDIR)/* @@ -97,7 +96,7 @@ clean clean_docs clean_tex: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs @@ -114,4 +113,3 @@ release_docs_spec: docs release_spec: - diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index 5b2c46a004..3a5efd0bea 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -11,7 +11,7 @@ Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at - + http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software @@ -19,7 +19,6 @@ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. - </legalnotice> <title>crypto</title> @@ -68,11 +67,11 @@ <section> <title>DATA TYPES </title> - - <code>key_value() = integer() | binary() </code> + + <code>key_value() = integer() | binary() </code> <p>Always <c>binary()</c> when used as return value</p> - <code>rsa_public() = [key_value()] = [E, N] </code> + <code>rsa_public() = [key_value()] = [E, N] </code> <p> Where E is the public exponent and N is public modulus. </p> <code>rsa_private() = [key_value()] = [E, N, D] | [E, N, D, P1, P2, E1, E2, C] </code> @@ -85,7 +84,7 @@ <code>dss_public() = [key_value()] = [P, Q, G, Y] </code> <p>Where P, Q and G are the dss parameters and Y is the public key.</p> - <code>dss_private() = [key_value()] = [P, Q, G, X] </code> + <code>dss_private() = [key_value()] = [P, Q, G, X] </code> <p>Where P, Q and G are the dss parameters and X is the private key.</p> <code>srp_public() = key_value() </code> @@ -109,15 +108,16 @@ <code>ecdh_private() = key_value() </code> - <code>ecdh_params() = ec_named_curve() | ec_explicit_curve()</code> + <code>ecdh_params() = ec_named_curve() | ec_explicit_curve()</code> <code>ec_explicit_curve() = - {ec_field(), Prime :: key_value(), Point :: key_value(), Order :: integer(), CoFactor :: none | integer()} </code> + {ec_field(), Prime :: key_value(), Point :: key_value(), Order :: integer(), + CoFactor :: none | integer()} </code> <code>ec_field() = {prime_field, Prime :: integer()} | {characteristic_two_field, M :: integer(), Basis :: ec_basis()}</code> - <code>ec_basis() = {tpbasis, K :: non_neg_integer()} | + <code>ec_basis() = {tpbasis, K :: non_neg_integer()} | {ppbasis, K1 :: non_neg_integer(), K2 :: non_neg_integer(), K3 :: non_neg_integer()} | onbasis</code> @@ -136,16 +136,34 @@ See also <seealso marker="#supports-0">crypto:supports/0</seealso> </p> + <marker id="engine_key_ref_type"/> + <code>engine_key_ref() = #{engine := engine_ref(), + key_id := key_id(), + password => password()}</code> + + <code>engine_ref() = term()</code> + <p>The result of a call to <seealso marker="#engine_load-3">engine_load/3</seealso>. + </p> + + <code>key_id() = string() | binary()</code> + <p>Identifies the key to be used. The format depends on the loaded engine. It is passed to + the <c>ENGINE_load_(private|public)_key</c> functions in libcrypto. + </p> + + <code>password() = string() | binary()</code> + <p>The key's password + </p> + <code>stream_cipher() = rc4 | aes_ctr </code> - <code>block_cipher() = aes_cbc | aes_cfb8 | aes_cfb128 | aes_ige256 | blowfish_cbc | + <code>block_cipher() = aes_cbc | aes_cfb8 | aes_cfb128 | aes_ige256 | blowfish_cbc | blowfish_cfb64 | des_cbc | des_cfb | des3_cbc | des3_cfb | des_ede3 | rc2_cbc </code> - <code>aead_cipher() = aes_gcm | chacha20_poly1305 </code> + <code>aead_cipher() = aes_gcm | chacha20_poly1305 </code> - <code>stream_key() = aes_key() | rc4_key() </code> + <code>stream_key() = aes_key() | rc4_key() </code> - <code>block_key() = aes_key() | blowfish_key() | des_key()| des3_key() </code> + <code>block_key() = aes_key() | blowfish_key() | des_key()| des3_key() </code> <code>aes_key() = iodata() </code> <p>Key length is 128, 192 or 256 bits</p> @@ -174,13 +192,17 @@ Note that both md4 and md5 are recommended only for compatibility with existing applications. </p> <code> cipher_algorithms() = aes_cbc | aes_cfb8 | aes_cfb128 | aes_ctr | aes_gcm | - aes_ige256 | blowfish_cbc | blowfish_cfb64 | chacha20_poly1305 | des_cbc | des_cfb | - des3_cbc | des3_cfb | des_ede3 | rc2_cbc | rc4 </code> - <code> mac_algorithms() = hmac | cmac</code> - <code> public_key_algorithms() = rsa |dss | ecdsa | dh | ecdh | ec_gf2m</code> + aes_ige256 | blowfish_cbc | blowfish_cfb64 | chacha20_poly1305 | des_cbc | + des_cfb | des3_cbc | des3_cfb | des_ede3 | rc2_cbc | rc4 </code> + <code> mac_algorithms() = hmac | cmac</code> + <code> public_key_algorithms() = rsa |dss | ecdsa | dh | ecdh | ec_gf2m</code> <p>Note that ec_gf2m is not strictly a public key algorithm, but a restriction on what curves are supported with ecdsa and ecdh. </p> + <code>engine_method_type() = engine_method_rsa | engine_method_dsa | engine_method_dh | + engine_method_rand | engine_method_ecdh | engine_method_ecdsa | + engine_method_ciphers | engine_method_digests | engine_method_store | + engine_method_pkey_meths | engine_method_pkey_asn1_meths</code> </section> @@ -261,13 +283,13 @@ is not supported by the underlying OpenSSL implementation.</p> </desc> </func> - + <func> <name>bytes_to_integer(Bin) -> Integer </name> <fsummary>Convert binary representation, of an integer, to an Erlang integer.</fsummary> <type> <v>Bin = binary() - as returned by crypto functions</v> - + <v>Integer = integer() </v> </type> <desc> @@ -439,7 +461,7 @@ </type> <desc> <p>Updates the HMAC represented by <c>Context</c> using the given <c>Data</c>. <c>Context</c> - must have been generated using an HMAC init function (such as + must have been generated using an HMAC init function (such as <seealso marker="#hmac_init-2">hmac_init</seealso>). <c>Data</c> can be any length. <c>NewContext</c> must be passed into the next call to <c>hmac_update</c> or to one of the functions <seealso marker="#hmac_final-1">hmac_final</seealso> and @@ -580,7 +602,7 @@ <type> <v>Type = rsa</v> <v>CipherText = binary()</v> - <v>PrivateKey = rsa_private()</v> + <v>PrivateKey = rsa_private() | engine_key_ref()</v> <v>Padding = rsa_pkcs1_padding | rsa_pkcs1_oaep_padding | rsa_no_padding</v> <v>PlainText = binary()</v> </type> @@ -594,7 +616,22 @@ </p> </desc> </func> - + + <func> + <name>privkey_to_pubkey(Type, EnginePrivateKeyRef) -> PublicKey</name> + <fsummary>Fetches a public key from an Engine stored private key.</fsummary> + <type> + <v>Type = rsa | dss</v> + <v>EnginePrivateKeyRef = engine_key_ref()</v> + <v>PublicKey = rsa_public() | dss_public()</v> + </type> + <desc> + <p>Fetches the corresponding public key from a private key stored in an Engine. + The key must be of the type indicated by the Type parameter. + </p> + </desc> + </func> + <func> <name>private_encrypt(Type, PlainText, PrivateKey, Padding) -> CipherText</name> <fsummary>Encrypts PlainText using the private Key.</fsummary> @@ -605,7 +642,7 @@ than <c>byte_size(N)-11</c> if <c>rsa_pkcs1_padding</c> is used, and <c>byte_size(N)</c> if <c>rsa_no_padding</c> is used, where N is public modulus of the RSA key.</d> - <v>PrivateKey = rsa_private()</v> + <v>PrivateKey = rsa_private() | engine_key_ref()</v> <v>Padding = rsa_pkcs1_padding | rsa_no_padding</v> <v>CipherText = binary()</v> </type> @@ -624,7 +661,7 @@ <type> <v>Type = rsa</v> <v>CipherText = binary()</v> - <v>PublicKey = rsa_public() </v> + <v>PublicKey = rsa_public() | engine_key_ref()</v> <v>Padding = rsa_pkcs1_padding | rsa_no_padding</v> <v>PlainText = binary()</v> </type> @@ -649,7 +686,7 @@ than <c>byte_size(N)-11</c> if <c>rsa_pkcs1_padding</c> is used, and <c>byte_size(N)</c> if <c>rsa_no_padding</c> is used, where N is public modulus of the RSA key.</d> - <v>PublicKey = rsa_public()</v> + <v>PublicKey = rsa_public() | engine_key_ref()</v> <v>Padding = rsa_pkcs1_padding | rsa_pkcs1_oaep_padding | rsa_no_padding</v> <v>CipherText = binary()</v> </type> @@ -702,7 +739,7 @@ signed or it is the hashed value of "cleartext" i.e. the digest (plaintext).</d> <v>DigestType = rsa_digest_type() | dss_digest_type() | ecdsa_digest_type()</v> - <v>Key = rsa_private() | dss_private() | [ecdh_private(),ecdh_params()]</v> + <v>Key = rsa_private() | dss_private() | [ecdh_private(),ecdh_params()] | engine_key_ref()</v> <v>Options = sign_options()</v> </type> <desc> @@ -753,9 +790,16 @@ <seealso marker="stdlib:rand">random number generation</seealso>, in order to generate cryptographically strong random numbers (based on OpenSSL's <c>BN_rand_range</c>), - and saves it on process dictionary before returning it as well. + and saves it in the process dictionary before returning it as well. See also - <seealso marker="stdlib:rand#seed-1">rand:seed/1</seealso>. + <seealso marker="stdlib:rand#seed-1">rand:seed/1</seealso> and + <seealso marker="#rand_seed_s-0">rand_seed_s/0</seealso>. + </p> + <p> + When using the state object from this function the + <seealso marker="stdlib:rand">rand</seealso> functions using it + may throw exception <c>low_entropy</c> in case the random generator + failed due to lack of secure "randomness". </p> <p><em>Example</em></p> <pre> @@ -777,6 +821,120 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre> See also <seealso marker="stdlib:rand#seed_s-1">rand:seed_s/1</seealso>. </p> + <p> + When using the state object from this function the + <seealso marker="stdlib:rand">rand</seealso> functions using it + may throw exception <c>low_entropy</c> in case the random generator + failed due to lack of secure "randomness". + </p> + <note> + <p> + The state returned from this function can not be used + to get a reproducable random sequence as from + the other + <seealso marker="stdlib:rand">rand</seealso> + functions, + since reproducability does not match cryptographically safe. + </p> + <p> + The only supported usage is to generate one distinct + random sequence from this start state. + </p> + </note> + </desc> + </func> + + <func> + <name>rand_seed_alg(Alg) -> rand:state()</name> + <fsummary>Strong random number generation plugin state</fsummary> + <type> + <v>Alg = crypto | crypto_cache</v> + </type> + <desc> + <marker id="rand_seed_alg-1" /> + <p> + Creates state object for + <seealso marker="stdlib:rand">random number generation</seealso>, + in order to generate cryptographically strong random numbers. + See also + <seealso marker="stdlib:rand#seed-1">rand:seed/1</seealso> and + <seealso marker="#rand_seed_alg_s-1">rand_seed_alg_s/1</seealso>. + </p> + <p> + When using the state object from this function the + <seealso marker="stdlib:rand">rand</seealso> functions using it + may throw exception <c>low_entropy</c> in case the random generator + failed due to lack of secure "randomness". + </p> + <p> + The cache size can be changed from its default value using the + <seealso marker="crypto_app"> + crypto app's + </seealso> configuration parameter <c>rand_cache_size</c>. + </p> + <p><em>Example</em></p> + <pre> +_ = crypto:rand_seed_alg(crypto_cache), +_IntegerValue = rand:uniform(42), % [1; 42] +_FloatValue = rand:uniform(). % [0.0; 1.0[</pre> + </desc> + </func> + + <func> + <name>rand_seed_alg_s(Alg) -> rand:state()</name> + <fsummary>Strong random number generation plugin state</fsummary> + <type> + <v>Alg = crypto | crypto_cache</v> + </type> + <desc> + <marker id="rand_seed_alg_s-1" /> + <p> + Creates state object for + <seealso marker="stdlib:rand">random number generation</seealso>, + in order to generate cryptographically strongly random numbers. + See also + <seealso marker="stdlib:rand#seed_s-1">rand:seed_s/1</seealso>. + </p> + <p> + If <c>Alg</c> is <c>crypto</c> this function behaves exactly like + <seealso marker="#rand_seed_s-0">rand_seed_s/0</seealso>. + </p> + <p> + If <c>Alg</c> is <c>crypto_cache</c> this function + fetches random data with OpenSSL's <c>RAND_bytes</c> + and caches it for speed using an internal word size + of 56 bits that makes calculations fast on 64 bit machines. + </p> + <p> + When using the state object from this function the + <seealso marker="stdlib:rand">rand</seealso> functions using it + may throw exception <c>low_entropy</c> in case the random generator + failed due to lack of secure "randomness". + </p> + <p> + The cache size can be changed from its default value using the + <seealso marker="crypto_app"> + crypto app's + </seealso> configuration parameter <c>rand_cache_size</c>. + </p> + <note> + <p> + The state returned from this function can not be used + to get a reproducable random sequence as from + the other + <seealso marker="stdlib:rand">rand</seealso> + functions, + since reproducability does not match cryptographically safe. + </p> + <p> + In fact since random data is cached some numbers may + get reproduced if you try, but this is unpredictable. + </p> + <p> + The only supported usage is to generate one distinct + random sequence from this start state. + </p> + </note> </desc> </func> @@ -893,7 +1051,7 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre> or it is the hashed value of "cleartext" i.e. the digest (plaintext).</d> <v>DigestType = rsa_digest_type() | dss_digest_type() | ecdsa_digest_type()</v> <v>Signature = binary()</v> - <v>Key = rsa_public() | dss_public() | [ecdh_public(),ecdh_params()]</v> + <v>Key = rsa_public() | dss_public() | [ecdh_public(),ecdh_params()] | engine_key_ref()</v> <v>Options = sign_options()</v> </type> <desc> @@ -905,6 +1063,175 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre> </desc> </func> + <!-- Engine functions --> + <func> + <name>engine_get_all_methods() -> Result</name> + <fsummary>Return list of all possible engine methods</fsummary> + <type> + <v>Result = [EngineMethod::atom()]</v> + </type> + <desc> + <p> + Returns a list of all possible engine methods. + </p> + <p> + May throw exception notsup in case there is + no engine support in the underlying OpenSSL implementation. + </p> + <p> + See also the chapter <seealso marker="crypto:engine_load#engine_load">Engine Load</seealso> + in the User's Guide. + </p> + </desc> + </func> + + <func> + <name>engine_load(EngineId, PreCmds, PostCmds) -> Result</name> + <fsummary>Dynamical load an encryption engine</fsummary> + <type> + <v>EngineId = unicode:chardata()</v> + <v>PreCmds, PostCmds = [{unicode:chardata(), unicode:chardata()}]</v> + <v>Result = {ok, Engine::term()} | {error, Reason::term()}</v> + </type> + <desc> + <p> + Loads the OpenSSL engine given by <c>EngineId</c> if it is available and then returns ok and + an engine handle. This function is the same as calling <c>engine_load/4</c> with + <c>EngineMethods</c> set to a list of all the possible methods. An error tuple is + returned if the engine can't be loaded. + </p> + <p> + The function throws a badarg if the parameters are in wrong format. + It may also throw the exception notsup in case there is + no engine support in the underlying OpenSSL implementation. + </p> + <p> + See also the chapter <seealso marker="crypto:engine_load#engine_load">Engine Load</seealso> + in the User's Guide. + </p> + </desc> + </func> + + <func> + <name>engine_load(EngineId, PreCmds, PostCmds, EngineMethods) -> Result</name> + <fsummary>Dynamical load an encryption engine</fsummary> + <type> + <v>EngineId = unicode:chardata()</v> + <v>PreCmds, PostCmds = [{unicode:chardata(), unicode:chardata()}]</v> + <v>EngineMethods = [engine_method_type()]</v> + <v>Result = {ok, Engine::term()} | {error, Reason::term()}</v> + </type> + <desc> + <p> + Loads the OpenSSL engine given by <c>EngineId</c> if it is available and then returns ok and + an engine handle. An error tuple is returned if the engine can't be loaded. + </p> + <p> + The function throws a badarg if the parameters are in wrong format. + It may also throw the exception notsup in case there is + no engine support in the underlying OpenSSL implementation. + </p> + <p> + See also the chapter <seealso marker="crypto:engine_load#engine_load">Engine Load</seealso> + in the User's Guide. + </p> + </desc> + </func> + + <func> + <name>engine_unload(Engine) -> Result</name> + <fsummary>Dynamical load an encryption engine</fsummary> + <type> + <v>Engine = term()</v> + <v>Result = ok | {error, Reason::term()}</v> + </type> + <desc> + <p> + Unloads the OpenSSL engine given by <c>EngineId</c>. + An error tuple is returned if the engine can't be unloaded. + </p> + <p> + The function throws a badarg if the parameter is in wrong format. + It may also throw the exception notsup in case there is + no engine support in the underlying OpenSSL implementation. + </p> + <p> + See also the chapter <seealso marker="crypto:engine_load#engine_load">Engine Load</seealso> + in the User's Guide. + </p> + </desc> + </func> + + <func> + <name>engine_list() -> Result</name> + <fsummary>List the known engine ids</fsummary> + <type> + <v>Result = [EngineId::unicode:chardata()]</v> + </type> + <desc> + <p>List the id's of all engines in OpenSSL's internal list.</p> + <p> + It may also throw the exception notsup in case there is + no engine support in the underlying OpenSSL implementation. + </p> + <p> + See also the chapter <seealso marker="crypto:engine_load#engine_load">Engine Load</seealso> + in the User's Guide. + </p> + </desc> + </func> + + <func> + <name>engine_ctrl_cmd_string(Engine, CmdName, CmdArg) -> Result</name> + <fsummary>Sends ctrl commands to an OpenSSL engine</fsummary> + <type> + <v>Engine = term()</v> + <v>CmdName = unicode:chardata()</v> + <v>CmdArg = unicode:chardata()</v> + <v>Result = ok | {error, Reason::term()}</v> + </type> + <desc> + <p> + Sends ctrl commands to the OpenSSL engine given by <c>Engine</c>. + This function is the same as calling <c>engine_ctrl_cmd_string/4</c> with + <c>Optional</c> set to <c>false</c>. + </p> + <p> + The function throws a badarg if the parameters are in wrong format. + It may also throw the exception notsup in case there is + no engine support in the underlying OpenSSL implementation. + </p> + </desc> + </func> + + <func> + <name>engine_ctrl_cmd_string(Engine, CmdName, CmdArg, Optional) -> Result</name> + <fsummary>Sends ctrl commands to an OpenSSL engine</fsummary> + <type> + <v>Engine = term()</v> + <v>CmdName = unicode:chardata()</v> + <v>CmdArg = unicode:chardata()</v> + <v>Optional = boolean()</v> + <v>Result = ok | {error, Reason::term()}</v> + </type> + <desc> + <p> + Sends ctrl commands to the OpenSSL engine given by <c>Engine</c>. + <c>Optional</c> is a boolean argument that can relax the semantics of the function. + If set to <c>true</c> it will only return failure if the ENGINE supported the given + command name but failed while executing it, if the ENGINE doesn't support the command + name it will simply return success without doing anything. In this case we assume + the user is only supplying commands specific to the given ENGINE so we set this to + <c>false</c>. + </p> + <p> + The function throws a badarg if the parameters are in wrong format. + It may also throw the exception notsup in case there is + no engine support in the underlying OpenSSL implementation. + </p> + </desc> + </func> + </funcs> <!-- Maybe put this in the users guide --> @@ -979,4 +1306,3 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre> <!-- </p> --> <!-- </section> --> </erlref> - diff --git a/lib/crypto/doc/src/crypto_app.xml b/lib/crypto/doc/src/crypto_app.xml index ba22557480..8296b1bc77 100644 --- a/lib/crypto/doc/src/crypto_app.xml +++ b/lib/crypto/doc/src/crypto_app.xml @@ -68,6 +68,24 @@ thus the crypto module will fail to load. This mechanism prevents the accidental use of non-validated algorithms.</p> </item> + <tag><c>rand_cache_size = integer()</c></tag> + <item> + <p> + Sets the cache size in bytes to use by + <seealso marker="crypto#rand_seed_alg-1"> + <c>crypto:rand_seed_alg(crypto_cache)</c> + </seealso> and + <seealso marker="crypto#rand_seed_alg_s-1"> + <c>crypto:rand_seed_alg_s(crypto_cache)</c> + </seealso>. + This parameter is read when a seed function is called, + and then kept in generators state object. It has a rather + small default value that causes reads of strong random bytes + about once per hundred calls for a random value. + The set value is rounded up to an integral number of words + of the size these seed functions use. + </p> + </item> </taglist> </section> diff --git a/lib/crypto/doc/src/engine_keys.xml b/lib/crypto/doc/src/engine_keys.xml new file mode 100644 index 0000000000..38714fed8a --- /dev/null +++ b/lib/crypto/doc/src/engine_keys.xml @@ -0,0 +1,129 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>2017</year><year>2017</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + 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. + </legalnotice> + <title>Engine Stored Keys</title> + <prepared>Hans Nilsson</prepared> + <date>2017-11-10</date> + <file>engine_keys.xml</file> + </header> + <p> + <marker id="engine_key"></marker> + This chapter describes the support in the crypto application for using public and private keys stored in encryption engines. + </p> + + <section> + <title>Background</title> + <p> + <url href="https://www.openssl.org/">OpenSSL</url> exposes an Engine API, which makes + it possible to plug in alternative implementations for some of the cryptographic + operations implemented by OpenSSL. + See the chapter <seealso marker="crypto:engine_load#engine_load">Engine Load</seealso> + for details and how to load an Engine. + </p> + <p> + An engine could among other tasks provide a storage for + private or public keys. Such a storage could be made safer than the normal file system. Thoose techniques are not + described in this User's Guide. Here we concentrate on how to use private or public keys stored in + such an engine. + </p> + <p> + The storage engine must call <c>ENGINE_set_load_privkey_function</c> and <c>ENGINE_set_load_pubkey_function</c>. + See the OpenSSL cryptolib's <url href="https://www.openssl.org/docs/manpages.html">manpages</url>. + </p> + <p> + OTP/Crypto requires that the user provides two or three items of information about the key. The application used + by the user is usually on a higher level, for example in + <seealso marker="ssl:ssl#key_option_def">SSL</seealso>. If using + the crypto application directly, it is required that: + </p> + <list> + <item>an Engine is loaded, see the chapter on <seealso marker="crypto:engine_load#engine_load">Engine Load</seealso> + or the <seealso marker="crypto:crypto#engine_load-3">Reference Manual</seealso> + </item> + <item>a reference to a key in the Engine is available. This should be an Erlang string or binary and depends + on the Engine loaded + </item> + <item>an Erlang map is constructed with the Engine reference, the key reference and possibly a key passphrase if + needed by the Engine. See the <seealso marker="crypto:crypto#engine_key_ref_type">Reference Manual</seealso> for + details of the map. + </item> + </list> + </section> + + <section> + <title>Use Cases</title> + <section> + <title>Sign with an engine stored private key</title> + <p> + This example shows how to construct a key reference that is used in a sign operation. + The actual key is stored in the engine that is loaded at prompt 1. + </p> + <code> +1> {ok, EngineRef} = crypto:engine_load(....). +... +{ok,#Ref<0.2399045421.3028942852.173962>} +2> PrivKey = #{engine => EngineRef, + key_id => "id of the private key in Engine"}. +... +3> Signature = crypto:sign(rsa, sha, <<"The message">>, PrivKey). +<<65,6,125,254,54,233,84,77,83,63,168,28,169,214,121,76, + 207,177,124,183,156,185,160,243,36,79,125,230,231,...>> + </code> + </section> + + <section> + <title>Verify with an engine stored public key</title> + <p> + Here the signature and message in the last example is verifyed using the public key. + The public key is stored in an engine, only to exemplify that it is possible. The public + key could of course be handled openly as usual. + </p> + <code> +4> PublicKey = #{engine => EngineRef, + key_id => "id of the public key in Engine"}. +... +5> crypto:verify(rsa, sha, <<"The message">>, Signature, PublicKey). +true +6> + </code> + </section> + + <section> + <title>Using a password protected private key</title> + <p> + The same example as the first sign example, except that a password protects the key down in the Engine. + </p> + <code> +6> PrivKeyPwd = #{engine => EngineRef, + key_id => "id of the pwd protected private key in Engine", + password => "password"}. +... +7> crypto:sign(rsa, sha, <<"The message">>, PrivKeyPwd). +<<140,80,168,101,234,211,146,183,231,190,160,82,85,163, + 175,106,77,241,141,120,72,149,181,181,194,154,175,76, + 223,...>> +8> + </code> + + </section> + + </section> +</chapter> diff --git a/lib/crypto/doc/src/engine_load.xml b/lib/crypto/doc/src/engine_load.xml new file mode 100644 index 0000000000..e5c3f5d561 --- /dev/null +++ b/lib/crypto/doc/src/engine_load.xml @@ -0,0 +1,110 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>2017</year><year>2017</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + 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. + </legalnotice> + <title>Engine Load</title> + <prepared>Lars Thorsén</prepared> + <date>2017-08-22</date> + <file>engine_load.xml</file> + </header> + <p> + <marker id="engine_load"></marker> + This chapter describes the support for loading encryption engines in the crypto application. + </p> + + <section> + <title>Background</title> + <p> + OpenSSL exposes an Engine API, which makes it possible to plug in alternative + implementations for some or all of the cryptographic operations implemented by OpenSSL. + When configured appropriately, OpenSSL calls the engine's implementation of these + operations instead of its own. + </p> + <p> + Typically, OpenSSL engines provide a hardware implementation of specific cryptographic + operations. The hardware implementation usually offers improved performance over its + software-based counterpart, which is known as cryptographic acceleration. + </p> + </section> + + <section> + <title>Use Cases</title> + <section> + <title>Dynamically load an engine from default directory</title> + <p> + If the engine is located in the OpenSSL/LibreSSL installation <c>engines</c> directory. + </p> + <code> +1> {ok, Engine} = crypto:engine_load(<<"otp_test_engine">>, [], []). + {ok, #Ref}</code> + <note> + <p>The file name requirement on the engine dynamic library can differ between SSL versions.</p> + </note> + </section> + + <section> + <title>Load an engine with the dynamic engine</title> + <p> + Load an engine with the help of the dynamic engine by giving the path to the library. + </p> + <code> + 2> {ok, Engine} = crypto:engine_load(<<"dynamic">>, + [{<<"SO_PATH">>, + <<"/some/path/otp_test_engine.so">>}, + {<<"ID">>, <<"MD5">>}, + <<"LOAD">>], + []). + {ok, #Ref}</code> + <note> + <p>The dynamic engine is not supported in LibreSSL from version 2.2.1</p> + </note> + </section> + + <section> + <title>Load an engine and replace some methods</title> + <p> + Load an engine with the help of the dynamic engine and just + replace some engine methods. + </p> + <code> + 3> Methods = crypto:engine_get_all_methods() -- [engine_method_dh,engine_method_rand, +engine_method_ciphers,engine_method_digests, engine_method_store, +engine_method_pkey_meths, engine_method_pkey_asn1_meths]. +[engine_method_rsa,engine_method_dsa, + engine_method_ecdh,engine_method_ecdsa] + 4> {ok, Engine} = crypto:engine_load(<<"dynamic">>, + [{<<"SO_PATH">>, + <<"/some/path/otp_test_engine.so">>}, + {<<"ID">>, <<"MD5">>}, + <<"LOAD">>], + [], + Methods). + {ok, #Ref}</code> + </section> + + <section> + <title>List all engines currently loaded</title> + <code> + 5> crypto:engine_list(). +[<<"dynamic">>, <<"MD5">>]</code> + </section> + + </section> +</chapter> diff --git a/lib/crypto/doc/src/fascicules.xml b/lib/crypto/doc/src/fascicules.xml deleted file mode 100644 index cbc266cd30..0000000000 --- a/lib/crypto/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="usersguide" href="usersguide_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="release_notes" href="release_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/crypto/doc/src/note.gif b/lib/crypto/doc/src/note.gif Binary files differdeleted file mode 100644 index 6fffe30419..0000000000 --- a/lib/crypto/doc/src/note.gif +++ /dev/null diff --git a/lib/crypto/doc/src/notes.xml b/lib/crypto/doc/src/notes.xml index 9376e6f649..dbeb886d7b 100644 --- a/lib/crypto/doc/src/notes.xml +++ b/lib/crypto/doc/src/notes.xml @@ -31,6 +31,76 @@ </header> <p>This document describes the changes made to the Crypto application.</p> +<section><title>Crypto 4.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The compatibility function <c>void HMAC_CTX_free</c> in + <c>crypto.c</c> erroneously tried to return a value.</p> + <p> + Own Id: OTP-14720</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Rewrite public and private key encode/decode with EVP + api. New RSA padding options added. This is a modified + half of PR-838.</p> + <p> + Own Id: OTP-14446</p> + </item> + <item> + <p> + The crypto API is extended to use private/public keys + stored in an Engine for sign/verify or encrypt/decrypt + operations.</p> + <p> + The ssl application provides an API to use this new + engine concept in TLS.</p> + <p> + Own Id: OTP-14448</p> + </item> + <item> + <p> Add support to plug in alternative implementations + for some or all of the cryptographic operations supported + by the OpenSSL Engine API. When configured appropriately, + OpenSSL calls the engine's implementation of these + operations instead of its own. </p> + <p> + Own Id: OTP-14567</p> + </item> + <item> + <p> + Replaced a call of the OpenSSL deprecated function + <c>DH_generate_parameters</c> in <c>crypto.c</c>.</p> + <p> + Own Id: OTP-14639</p> + </item> + <item> + <p> + Documentation added about how to use keys stored in an + Engine.</p> + <p> + Own Id: OTP-14735 Aux Id: OTP-14448 </p> + </item> + <item> + <p> Add engine_ ctrl_cmd_string/3,4 the OpenSSL Engine + support in crypto. </p> + <p> + Own Id: OTP-14801</p> + </item> + </list> + </section> + +</section> + <section><title>Crypto 4.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/crypto/doc/src/usersguide.xml b/lib/crypto/doc/src/usersguide.xml index 7971aefff4..e2ba1fe160 100644 --- a/lib/crypto/doc/src/usersguide.xml +++ b/lib/crypto/doc/src/usersguide.xml @@ -11,7 +11,7 @@ Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at - + http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software @@ -19,7 +19,7 @@ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. - + </legalnotice> <title>Crypto User's Guide</title> @@ -48,5 +48,6 @@ </description> <xi:include href="licenses.xml"/> <xi:include href="fips.xml"/> + <xi:include href="engine_load.xml"/> + <xi:include href="engine_keys.xml"/> </part> - diff --git a/lib/crypto/doc/src/warning.gif b/lib/crypto/doc/src/warning.gif Binary files differdeleted file mode 100644 index 96af52360e..0000000000 --- a/lib/crypto/doc/src/warning.gif +++ /dev/null diff --git a/lib/crypto/src/Makefile b/lib/crypto/src/Makefile index aea8a5a71c..edad0e6b61 100644 --- a/lib/crypto/src/Makefile +++ b/lib/crypto/src/Makefile @@ -39,8 +39,7 @@ MODULES= \ crypto \ crypto_ec_curves -HRL_FILES= - +HRL_FILES= ERL_FILES= $(MODULES:%=%.erl) TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) @@ -56,16 +55,16 @@ APPUP_TARGET= $(EBIN)/$(APPUP_FILE) # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -ERL_COMPILE_FLAGS += -DCRYPTO_VSN=\"$(VSN)\" -Werror +ERL_COMPILE_FLAGS += -DCRYPTO_VSN=\"$(VSN)\" -Werror -I../include # ---------------------------------------------------- # Targets # ---------------------------------------------------- -debug opt valgrind: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) +debug opt valgrind: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) clean: - rm -f $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) + rm -f $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) rm -f errs core *~ $(APP_TARGET): $(APP_SRC) ../vsn.mk @@ -78,7 +77,7 @@ docs: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt @@ -89,10 +88,3 @@ release_spec: opt $(APPUP_TARGET) "$(RELSYSDIR)/ebin" release_docs_spec: - - - - - - - diff --git a/lib/crypto/src/crypto.app.src b/lib/crypto/src/crypto.app.src index 1d3f35e465..492aa10e51 100644 --- a/lib/crypto/src/crypto.app.src +++ b/lib/crypto/src/crypto.app.src @@ -24,7 +24,7 @@ crypto_ec_curves]}, {registered, []}, {applications, [kernel, stdlib]}, - {env, [{fips_mode, false}]}, + {env, [{fips_mode, false}, {rand_cache_size, 896}]}, {runtime_dependencies, ["erts-9.0","stdlib-3.4","kernel-5.3"]}]}. diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index 1df05462c9..df259d5419 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -30,11 +30,12 @@ -export([hmac/3, hmac/4, hmac_init/2, hmac_update/2, hmac_final/1, hmac_final_n/2]). -export([cmac/3, cmac/4]). -export([exor/2, strong_rand_bytes/1, mod_pow/3]). --export([rand_seed/0]). --export([rand_seed_s/0]). +-export([rand_seed/0, rand_seed_alg/1]). +-export([rand_seed_s/0, rand_seed_alg_s/1]). -export([rand_plugin_next/1]). -export([rand_plugin_uniform/1]). -export([rand_plugin_uniform/2]). +-export([rand_cache_plugin_next/1]). -export([rand_uniform/2]). -export([block_encrypt/3, block_decrypt/3, block_encrypt/4, block_decrypt/4]). -export([next_iv/2, next_iv/3]). @@ -42,12 +43,28 @@ -export([public_encrypt/4, private_decrypt/4]). -export([private_encrypt/4, public_decrypt/4]). -export([dh_generate_parameters/2, dh_check/1]). %% Testing see +-export([privkey_to_pubkey/2]). -export([ec_curve/1, ec_curves/0]). -export([rand_seed/1]). +%% Engine +-export([ + engine_get_all_methods/0, + engine_load/3, + engine_load/4, + engine_unload/1, + engine_list/0, + engine_ctrl_cmd_string/3, + engine_ctrl_cmd_string/4 + ]). + +-export_type([engine_ref/0, + key_id/0, + password/0 + ]). -%% Private. For tests. --export([packed_openssl_version/4]). +%% Private. For tests. +-export([packed_openssl_version/4, engine_methods_convert_to_bitmask/2, get_test_engine/0]). -deprecated({rand_uniform, 2, next_major_release}). @@ -301,9 +318,17 @@ stream_decrypt(State, Data0) -> %% %% RAND - pseudo random numbers using RN_ and BN_ functions in crypto lib %% +-type rand_cache_seed() :: + nonempty_improper_list(non_neg_integer(), binary()). -spec strong_rand_bytes(non_neg_integer()) -> binary(). -spec rand_seed() -> rand:state(). -spec rand_seed_s() -> rand:state(). +-spec rand_seed_alg(Alg :: atom()) -> + {rand:alg_handler(), + atom() | rand_cache_seed()}. +-spec rand_seed_alg_s(Alg :: atom()) -> + {rand:alg_handler(), + atom() | rand_cache_seed()}. -spec rand_uniform(crypto_integer(), crypto_integer()) -> crypto_integer(). @@ -319,12 +344,36 @@ rand_seed() -> rand:seed(rand_seed_s()). rand_seed_s() -> + rand_seed_alg_s(?MODULE). + +rand_seed_alg(Alg) -> + rand:seed(rand_seed_alg_s(Alg)). + +-define(CRYPTO_CACHE_BITS, 56). +rand_seed_alg_s(?MODULE) -> {#{ type => ?MODULE, bits => 64, next => fun ?MODULE:rand_plugin_next/1, uniform => fun ?MODULE:rand_plugin_uniform/1, uniform_n => fun ?MODULE:rand_plugin_uniform/2}, - no_seed}. + no_seed}; +rand_seed_alg_s(crypto_cache) -> + CacheBits = ?CRYPTO_CACHE_BITS, + EnvCacheSize = + application:get_env( + crypto, rand_cache_size, CacheBits * 16), % Cache 16 * 8 words + Bytes = (CacheBits + 7) div 8, + CacheSize = + case ((EnvCacheSize + (Bytes - 1)) div Bytes) * Bytes of + Sz when is_integer(Sz), Bytes =< Sz -> + Sz; + _ -> + Bytes + end, + {#{ type => crypto_cache, + bits => CacheBits, + next => fun ?MODULE:rand_cache_plugin_next/1}, + {CacheBits, CacheSize, <<>>}}. rand_plugin_next(Seed) -> {bytes_to_integer(strong_rand_range(1 bsl 64)), Seed}. @@ -335,6 +384,12 @@ rand_plugin_uniform(State) -> rand_plugin_uniform(Max, State) -> {bytes_to_integer(strong_rand_range(Max)) + 1, State}. +rand_cache_plugin_next({CacheBits, CacheSize, <<>>}) -> + rand_cache_plugin_next( + {CacheBits, CacheSize, strong_rand_bytes(CacheSize)}); +rand_cache_plugin_next({CacheBits, CacheSize, Cache}) -> + <<I:CacheBits, NewCache/binary>> = Cache, + {I, {CacheBits, CacheSize, NewCache}}. strong_rand_range(Range) when is_integer(Range), Range > 0 -> BinRange = int_to_bin(Range), @@ -382,7 +437,7 @@ rand_uniform_nif(_From,_To) -> ?nif_stub. -spec rand_seed(binary()) -> ok. -rand_seed(Seed) -> +rand_seed(Seed) when is_binary(Seed) -> rand_seed_nif(Seed). rand_seed_nif(_Seed) -> ?nif_stub. @@ -420,46 +475,66 @@ sign(Algorithm, Type, Data, Key, Options) -> Signature -> Signature end. --spec public_encrypt(rsa, binary(), [binary()], rsa_padding()) -> - binary(). --spec public_decrypt(rsa, binary(), [integer() | binary()], rsa_padding()) -> - binary(). --spec private_encrypt(rsa, binary(), [integer() | binary()], rsa_padding()) -> - binary(). --spec private_decrypt(rsa, binary(), [integer() | binary()], rsa_padding()) -> - binary(). - -public_encrypt(rsa, BinMesg, Key, Padding) -> - case rsa_public_crypt(BinMesg, map_ensure_int_as_bin(Key), Padding, true) of - error -> - erlang:error(encrypt_failed, [rsa, BinMesg,Key, Padding]); - Sign -> Sign - end. -%% Binary, Key = [E,N,D] -private_decrypt(rsa, BinMesg, Key, Padding) -> - case rsa_private_crypt(BinMesg, map_ensure_int_as_bin(Key), Padding, false) of - error -> - erlang:error(decrypt_failed, [rsa, BinMesg,Key, Padding]); - Sign -> Sign - end. +-type key_id() :: string() | binary() . +-type password() :: string() | binary() . -%% Binary, Key = [E,N,D] -private_encrypt(rsa, BinMesg, Key, Padding) -> - case rsa_private_crypt(BinMesg, map_ensure_int_as_bin(Key), Padding, true) of - error -> - erlang:error(encrypt_failed, [rsa, BinMesg,Key, Padding]); - Sign -> Sign - end. +-type engine_key_ref() :: #{engine := engine_ref(), + key_id := key_id(), + password => password(), + term() => term() + }. + +-type pk_algs() :: rsa | ecdsa | dss . +-type pk_key() :: engine_key_ref() | [integer() | binary()] . +-type pk_opt() :: list() | rsa_padding() . + +-spec public_encrypt(pk_algs(), binary(), pk_key(), pk_opt()) -> binary(). +-spec public_decrypt(pk_algs(), binary(), pk_key(), pk_opt()) -> binary(). +-spec private_encrypt(pk_algs(), binary(), pk_key(), pk_opt()) -> binary(). +-spec private_decrypt(pk_algs(), binary(), pk_key(), pk_opt()) -> binary(). + +public_encrypt(Algorithm, In, Key, Options) when is_list(Options) -> + case pkey_crypt_nif(Algorithm, In, format_pkey(Algorithm, Key), Options, false, true) of + error -> erlang:error(encrypt_failed, [Algorithm, In, Key, Options]); + notsup -> erlang:error(notsup); + Out -> Out + end; +%% Backwards compatible +public_encrypt(Algorithm = rsa, In, Key, Padding) when is_atom(Padding) -> + public_encrypt(Algorithm, In, Key, [{rsa_padding, Padding}]). + +private_decrypt(Algorithm, In, Key, Options) when is_list(Options) -> + case pkey_crypt_nif(Algorithm, In, format_pkey(Algorithm, Key), Options, true, false) of + error -> erlang:error(decrypt_failed, [Algorithm, In, Key, Options]); + notsup -> erlang:error(notsup); + Out -> Out + end; +%% Backwards compatible +private_decrypt(Algorithm = rsa, In, Key, Padding) when is_atom(Padding) -> + private_decrypt(Algorithm, In, Key, [{rsa_padding, Padding}]). + +private_encrypt(Algorithm, In, Key, Options) when is_list(Options) -> + case pkey_crypt_nif(Algorithm, In, format_pkey(Algorithm, Key), Options, true, true) of + error -> erlang:error(encrypt_failed, [Algorithm, In, Key, Options]); + notsup -> erlang:error(notsup); + Out -> Out + end; +%% Backwards compatible +private_encrypt(Algorithm = rsa, In, Key, Padding) when is_atom(Padding) -> + private_encrypt(Algorithm, In, Key, [{rsa_padding, Padding}]). + +public_decrypt(Algorithm, In, Key, Options) when is_list(Options) -> + case pkey_crypt_nif(Algorithm, In, format_pkey(Algorithm, Key), Options, false, false) of + error -> erlang:error(decrypt_failed, [Algorithm, In, Key, Options]); + notsup -> erlang:error(notsup); + Out -> Out + end; +%% Backwards compatible +public_decrypt(Algorithm = rsa, In, Key, Padding) when is_atom(Padding) -> + public_decrypt(Algorithm, In, Key, [{rsa_padding, Padding}]). -%% Binary, Key = [E,N] -public_decrypt(rsa, BinMesg, Key, Padding) -> - case rsa_public_crypt(BinMesg, map_ensure_int_as_bin(Key), Padding, false) of - error -> - erlang:error(decrypt_failed, [rsa, BinMesg,Key, Padding]); - Sign -> Sign - end. %% %% XOR - xor to iolists and return a binary @@ -559,10 +634,174 @@ compute_key(ecdh, Others, My, Curve) -> nif_curve_params(Curve), ensure_int_as_bin(My)). +%%====================================================================== +%% Engine functions +%%====================================================================== +%%---------------------------------------------------------------------- +%% Function: engine_get_all_methods/0 +%%---------------------------------------------------------------------- +-type engine_method_type() :: engine_method_rsa | engine_method_dsa | engine_method_dh | + engine_method_rand | engine_method_ecdh | engine_method_ecdsa | + engine_method_ciphers | engine_method_digests | engine_method_store | + engine_method_pkey_meths | engine_method_pkey_asn1_meths | + engine_method_ec. + +-type engine_ref() :: term(). + +-spec engine_get_all_methods() -> + [engine_method_type()]. +engine_get_all_methods() -> + notsup_to_error(engine_get_all_methods_nif()). + +%%---------------------------------------------------------------------- +%% Function: engine_load/3 +%%---------------------------------------------------------------------- +-spec engine_load(EngineId::unicode:chardata(), + PreCmds::[{unicode:chardata(), unicode:chardata()}], + PostCmds::[{unicode:chardata(), unicode:chardata()}]) -> + {ok, Engine::engine_ref()} | {error, Reason::term()}. +engine_load(EngineId, PreCmds, PostCmds) when is_list(PreCmds), is_list(PostCmds) -> + engine_load(EngineId, PreCmds, PostCmds, engine_get_all_methods()). + +%%---------------------------------------------------------------------- +%% Function: engine_load/4 +%%---------------------------------------------------------------------- +-spec engine_load(EngineId::unicode:chardata(), + PreCmds::[{unicode:chardata(), unicode:chardata()}], + PostCmds::[{unicode:chardata(), unicode:chardata()}], + EngineMethods::[engine_method_type()]) -> + {ok, Engine::term()} | {error, Reason::term()}. +engine_load(EngineId, PreCmds, PostCmds, EngineMethods) when is_list(PreCmds), + is_list(PostCmds) -> + try + ok = notsup_to_error(engine_load_dynamic_nif()), + case notsup_to_error(engine_by_id_nif(ensure_bin_chardata(EngineId))) of + {ok, Engine} -> + ok = engine_load_1(Engine, PreCmds, PostCmds, EngineMethods), + {ok, Engine}; + {error, Error1} -> + {error, Error1} + end + catch + throw:Error2 -> + Error2 + end. + +engine_load_1(Engine, PreCmds, PostCmds, EngineMethods) -> + try + ok = engine_nif_wrapper(engine_ctrl_cmd_strings_nif(Engine, ensure_bin_cmds(PreCmds), 0)), + ok = engine_nif_wrapper(engine_add_nif(Engine)), + ok = engine_nif_wrapper(engine_init_nif(Engine)), + engine_load_2(Engine, PostCmds, EngineMethods), + ok + catch + throw:Error -> + %% The engine couldn't initialise, release the structural reference + ok = engine_free_nif(Engine), + throw(Error) + end. + +engine_load_2(Engine, PostCmds, EngineMethods) -> + try + ok = engine_nif_wrapper(engine_ctrl_cmd_strings_nif(Engine, ensure_bin_cmds(PostCmds), 0)), + [ok = engine_nif_wrapper(engine_register_nif(Engine, engine_method_atom_to_int(Method))) || + Method <- EngineMethods], + ok + catch + throw:Error -> + %% The engine registration failed, release the functional reference + ok = engine_finish_nif(Engine), + throw(Error) + end. + +%%---------------------------------------------------------------------- +%% Function: engine_unload/1 +%%---------------------------------------------------------------------- +-spec engine_unload(Engine::term()) -> + ok | {error, Reason::term()}. +engine_unload(Engine) -> + engine_unload(Engine, engine_get_all_methods()). + +-spec engine_unload(Engine::term(), EngineMethods::[engine_method_type()]) -> + ok | {error, Reason::term()}. +engine_unload(Engine, EngineMethods) -> + try + [ok = engine_nif_wrapper(engine_unregister_nif(Engine, engine_method_atom_to_int(Method))) || + Method <- EngineMethods], + ok = engine_nif_wrapper(engine_remove_nif(Engine)), + %% Release the functional reference from engine_init_nif + ok = engine_nif_wrapper(engine_finish_nif(Engine)), + %% Release the structural reference from engine_by_id_nif + ok = engine_nif_wrapper(engine_free_nif(Engine)) + catch + throw:Error -> + Error + end. + +%%---------------------------------------------------------------------- +%% Function: engine_list/0 +%%---------------------------------------------------------------------- +-spec engine_list() -> + [EngineId::binary()]. +engine_list() -> + case notsup_to_error(engine_get_first_nif()) of + {ok, <<>>} -> + []; + {ok, Engine} -> + case notsup_to_error(engine_get_id_nif(Engine)) of + {ok, <<>>} -> + engine_list(Engine, []); + {ok, EngineId} -> + engine_list(Engine, [EngineId]) + end + end. + +engine_list(Engine0, IdList) -> + case notsup_to_error(engine_get_next_nif(Engine0)) of + {ok, <<>>} -> + lists:reverse(IdList); + {ok, Engine1} -> + case notsup_to_error(engine_get_id_nif(Engine1)) of + {ok, <<>>} -> + engine_list(Engine1, IdList); + {ok, EngineId} -> + engine_list(Engine1, [EngineId |IdList]) + end + end. + +%%---------------------------------------------------------------------- +%% Function: engine_ctrl_cmd_string/3 +%%---------------------------------------------------------------------- +-spec engine_ctrl_cmd_string(Engine::term(), + CmdName::unicode:chardata(), + CmdArg::unicode:chardata()) -> + ok | {error, Reason::term()}. +engine_ctrl_cmd_string(Engine, CmdName, CmdArg) -> + engine_ctrl_cmd_string(Engine, CmdName, CmdArg, false). + +%%---------------------------------------------------------------------- +%% Function: engine_ctrl_cmd_string/4 +%%---------------------------------------------------------------------- +-spec engine_ctrl_cmd_string(Engine::term(), + CmdName::unicode:chardata(), + CmdArg::unicode:chardata(), + Optional::boolean()) -> + ok | {error, Reason::term()}. +engine_ctrl_cmd_string(Engine, CmdName, CmdArg, Optional) -> + case engine_ctrl_cmd_strings_nif(Engine, + ensure_bin_cmds([{CmdName, CmdArg}]), + bool_to_int(Optional)) of + ok -> + ok; + notsup -> + erlang:error(notsup); + {error, Error} -> + {error, Error} + end. + %%-------------------------------------------------------------------- %%% On load %%-------------------------------------------------------------------- - on_load() -> LibBaseName = "crypto", PrivDir = code:priv_dir(crypto), @@ -622,12 +861,12 @@ path2bin(Path) when is_list(Path) -> end. %%-------------------------------------------------------------------- -%%% Internal functions +%%% Internal functions %%-------------------------------------------------------------------- max_bytes() -> ?MAX_BYTES_TO_NIF. -notsup_to_error(notsup) -> +notsup_to_error(notsup) -> erlang:error(notsup); notsup_to_error(Other) -> Other. @@ -751,7 +990,7 @@ do_stream_decrypt({rc4, State0}, Data) -> %% -%% AES - in counter mode (CTR) with state maintained for multi-call streaming +%% AES - in counter mode (CTR) with state maintained for multi-call streaming %% -type ctr_state() :: { iodata(), binary(), binary(), integer() } | binary(). @@ -760,11 +999,11 @@ do_stream_decrypt({rc4, State0}, Data) -> { ctr_state(), binary() }. -spec aes_ctr_stream_decrypt(ctr_state(), binary()) -> { ctr_state(), binary() }. - + aes_ctr_stream_init(_Key, _IVec) -> ?nif_stub. aes_ctr_stream_encrypt(_State, _Data) -> ?nif_stub. aes_ctr_stream_decrypt(_State, _Cipher) -> ?nif_stub. - + %% %% RC4 - symmetric stream cipher %% @@ -849,22 +1088,22 @@ pkey_verify_nif(_Algorithm, _Type, _Data, _Signature, _Key, _Options) -> ?nif_st rsa_generate_key_nif(_Bits, _Exp) -> ?nif_stub. %% DH Diffie-Hellman functions -%% +%% %% Generate (and check) Parameters is not documented because they are implemented %% for testing (and offline parameter generation) only. -%% From the openssl doc: +%% From the openssl doc: %% DH_generate_parameters() may run for several hours before finding a suitable prime. -%% Thus dh_generate_parameters may in this implementation block +%% Thus dh_generate_parameters may in this implementation block %% the emulator for several hours. %% -%% usage: dh_generate_parameters(1024, 2 or 5) -> +%% usage: dh_generate_parameters(1024, 2 or 5) -> %% [Prime=mpint(), SharedGenerator=mpint()] dh_generate_parameters(PrimeLen, Generator) -> case dh_generate_parameters_nif(PrimeLen, Generator) of error -> erlang:error(generation_failed, [PrimeLen,Generator]); Ret -> Ret - end. + end. dh_generate_parameters_nif(_PrimeLen, _Generator) -> ?nif_stub. @@ -890,6 +1129,24 @@ ec_curves() -> ec_curve(X) -> crypto_ec_curves:curve(X). + +privkey_to_pubkey(Alg, EngineMap) when Alg == rsa; Alg == dss; Alg == ecdsa -> + try privkey_to_pubkey_nif(Alg, format_pkey(Alg,EngineMap)) + of + [_|_]=L -> map_ensure_bin_as_int(L); + X -> X + catch + error:badarg when Alg==ecdsa -> + {error, notsup}; + error:badarg -> + {error, not_found}; + error:notsup -> + {error, notsup} + end. + +privkey_to_pubkey_nif(_Alg, _EngineMap) -> ?nif_stub. + + %% %% EC %% @@ -957,6 +1214,19 @@ ensure_int_as_bin(Int) when is_integer(Int) -> ensure_int_as_bin(Bin) -> Bin. +map_ensure_bin_as_int(List) when is_list(List) -> + lists:map(fun ensure_bin_as_int/1, List). + +ensure_bin_as_int(Bin) when is_binary(Bin) -> + bin_to_int(Bin); +ensure_bin_as_int(E) -> + E. + +format_pkey(_Alg, #{engine:=_, key_id:=T}=M) when is_binary(T) -> format_pwd(M); +format_pkey(_Alg, #{engine:=_, key_id:=T}=M) when is_list(T) -> format_pwd(M#{key_id:=list_to_binary(T)}); +format_pkey(_Alg, #{engine:=_ }=M) -> error({bad_key_id, M}); +format_pkey(_Alg, #{}=M) -> error({bad_engine_map, M}); +%%% format_pkey(rsa, Key) -> map_ensure_int_as_bin(Key); format_pkey(ecdsa, [Key, Curve]) -> @@ -966,19 +1236,20 @@ format_pkey(dss, Key) -> format_pkey(_, Key) -> Key. +format_pwd(#{password := Pwd}=M) when is_list(Pwd) -> M#{password := list_to_binary(Pwd)}; +format_pwd(M) -> M. + %%-------------------------------------------------------------------- %% -type rsa_padding() :: 'rsa_pkcs1_padding' | 'rsa_pkcs1_oaep_padding' | 'rsa_no_padding'. -rsa_public_crypt(_BinMsg, _Key, _Padding, _IsEncrypt) -> ?nif_stub. - -rsa_private_crypt(_BinMsg, _Key, _Padding, _IsEncrypt) -> ?nif_stub. +pkey_crypt_nif(_Algorithm, _In, _Key, _Options, _IsPrivate, _IsEncrypt) -> ?nif_stub. %% large integer in a binary with 32bit length %% MP representaion (SSH2) mpint(X) when X < 0 -> mpint_neg(X); mpint(X) -> mpint_pos(X). - + -define(UINT32(X), X:32/unsigned-big-integer). @@ -986,7 +1257,7 @@ mpint_neg(X) -> Bin = int_to_bin_neg(X, []), Sz = byte_size(Bin), <<?UINT32(Sz), Bin/binary>>. - + mpint_pos(X) -> Bin = int_to_bin_pos(X, []), <<MSB,_/binary>> = Bin, @@ -1008,7 +1279,6 @@ erlint(<<MPIntSize:32/integer,MPIntValue/binary>>) -> %% mod_exp_nif(_Base,_Exp,_Mod,_bin_hdr) -> ?nif_stub. - %%%---------------------------------------------------------------- %% 9470495 == V(0,9,8,zh). %% 268435615 == V(1,0,0,i). @@ -1019,3 +1289,95 @@ packed_openssl_version(MAJ, MIN, FIX, P0) -> P1 = atom_to_list(P0), P = lists:sum([C-$a||C<-P1]), ((((((((MAJ bsl 8) bor MIN) bsl 8 ) bor FIX) bsl 8) bor (P+1)) bsl 4) bor 16#f). + +%%-------------------------------------------------------------------- +%% Engine nifs +engine_by_id_nif(_EngineId) -> ?nif_stub. +engine_init_nif(_Engine) -> ?nif_stub. +engine_finish_nif(_Engine) -> ?nif_stub. +engine_free_nif(_Engine) -> ?nif_stub. +engine_load_dynamic_nif() -> ?nif_stub. +engine_ctrl_cmd_strings_nif(_Engine, _Cmds, _Optional) -> ?nif_stub. +engine_add_nif(_Engine) -> ?nif_stub. +engine_remove_nif(_Engine) -> ?nif_stub. +engine_register_nif(_Engine, _EngineMethod) -> ?nif_stub. +engine_unregister_nif(_Engine, _EngineMethod) -> ?nif_stub. +engine_get_first_nif() -> ?nif_stub. +engine_get_next_nif(_Engine) -> ?nif_stub. +engine_get_id_nif(_Engine) -> ?nif_stub. +engine_get_all_methods_nif() -> ?nif_stub. + +%%-------------------------------------------------------------------- +%% Engine internals +engine_nif_wrapper(ok) -> + ok; +engine_nif_wrapper(notsup) -> + erlang:error(notsup); +engine_nif_wrapper({error, Error}) -> + throw({error, Error}). + +ensure_bin_chardata(CharData) when is_binary(CharData) -> + CharData; +ensure_bin_chardata(CharData) -> + unicode:characters_to_binary(CharData). + +ensure_bin_cmds(CMDs) -> + ensure_bin_cmds(CMDs, []). + +ensure_bin_cmds([], Acc) -> + lists:reverse(Acc); +ensure_bin_cmds([{Key, Value} |CMDs], Acc) -> + ensure_bin_cmds(CMDs, [{ensure_bin_chardata(Key), ensure_bin_chardata(Value)} | Acc]); +ensure_bin_cmds([Key | CMDs], Acc) -> + ensure_bin_cmds(CMDs, [{ensure_bin_chardata(Key), <<"">>} | Acc]). + +engine_methods_convert_to_bitmask([], BitMask) -> + BitMask; +engine_methods_convert_to_bitmask(engine_method_all, _BitMask) -> + 16#FFFF; +engine_methods_convert_to_bitmask(engine_method_none, _BitMask) -> + 16#0000; +engine_methods_convert_to_bitmask([M |Ms], BitMask) -> + engine_methods_convert_to_bitmask(Ms, BitMask bor engine_method_atom_to_int(M)). + +bool_to_int(true) -> 1; +bool_to_int(false) -> 0. + +engine_method_atom_to_int(engine_method_rsa) -> 16#0001; +engine_method_atom_to_int(engine_method_dsa) -> 16#0002; +engine_method_atom_to_int(engine_method_dh) -> 16#0004; +engine_method_atom_to_int(engine_method_rand) -> 16#0008; +engine_method_atom_to_int(engine_method_ecdh) -> 16#0010; +engine_method_atom_to_int(engine_method_ecdsa) -> 16#0020; +engine_method_atom_to_int(engine_method_ciphers) -> 16#0040; +engine_method_atom_to_int(engine_method_digests) -> 16#0080; +engine_method_atom_to_int(engine_method_store) -> 16#0100; +engine_method_atom_to_int(engine_method_pkey_meths) -> 16#0200; +engine_method_atom_to_int(engine_method_pkey_asn1_meths) -> 16#0400; +engine_method_atom_to_int(engine_method_ec) -> 16#0800; +engine_method_atom_to_int(X) -> + erlang:error(badarg, [X]). + +get_test_engine() -> + Type = erlang:system_info(system_architecture), + LibDir = filename:join([code:priv_dir(crypto), "lib"]), + ArchDir = filename:join([LibDir, Type]), + case filelib:is_dir(ArchDir) of + true -> check_otp_test_engine(ArchDir); + false -> check_otp_test_engine(LibDir) + end. + +check_otp_test_engine(LibDir) -> + case filelib:wildcard("otp_test_engine*", LibDir) of + [] -> + {error, notexist}; + [LibName] -> + LibPath = filename:join(LibDir,LibName), + case filelib:is_file(LibPath) of + true -> + {ok, unicode:characters_to_binary(LibPath)}; + false -> + {error, notexist} + end + end. + diff --git a/lib/crypto/test/Makefile b/lib/crypto/test/Makefile index 138081d386..e046a25338 100644 --- a/lib/crypto/test/Makefile +++ b/lib/crypto/test/Makefile @@ -7,7 +7,8 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk MODULES = \ blowfish_SUITE \ - crypto_SUITE + crypto_SUITE \ + engine_SUITE ERL_FILES= $(MODULES:%=%.erl) @@ -27,7 +28,7 @@ RELSYSDIR = $(RELEASE_PATH)/crypto_test # FLAGS # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += +ERL_COMPILE_FLAGS += +nowarn_export_all EBIN = . MAKE_EMAKE = $(wildcard $(ERL_TOP)/make/make_emakefile) @@ -77,7 +78,7 @@ release_spec: release_tests_spec: $(TEST_TARGET) $(INSTALL_DIR) "$(RELSYSDIR)" $(INSTALL_DATA) crypto.spec crypto.cover $(RELTEST_FILES) "$(RELSYSDIR)" - @tar cfh - crypto_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) + @tar cfh - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) chmod -R u+w "$(RELSYSDIR)" release_docs_spec: diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 88f13d766c..6dab459df6 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -122,10 +122,15 @@ groups() -> {sha512, [], [hash, hmac]}, {rsa, [], [sign_verify, public_encrypt, + private_encrypt, generate ]}, - {dss, [], [sign_verify]}, - {ecdsa, [], [sign_verify]}, + {dss, [], [sign_verify + %% Does not work yet: ,public_encrypt, private_encrypt + ]}, + {ecdsa, [], [sign_verify + %% Does not work yet: ,public_encrypt, private_encrypt + ]}, {dh, [], [generate_compute]}, {ecdh, [], [compute, generate]}, {srp, [], [generate_compute]}, @@ -193,7 +198,7 @@ init_per_suite(Config) -> %% This is NOT how you want to do seeding, it is just here %% to make the tests pass. Check your OS manual for how you %% really want to seed. - {H,M,L} = erlang:now(), + {H,M,L} = erlang:timestamp(), Bin = <<H:24,M:20,L:20>>, crypto:rand_seed(<< <<Bin/binary>> || _ <- lists:seq(1,16) >>), Config @@ -439,10 +444,16 @@ sign_verify(Config) when is_list(Config) -> %%-------------------------------------------------------------------- public_encrypt() -> - [{doc, "Test public_encrypt/decrypt and private_encrypt/decrypt functions. "}]. + [{doc, "Test public_encrypt/decrypt "}]. public_encrypt(Config) when is_list(Config) -> Params = proplists:get_value(pub_priv_encrypt, Config), - lists:foreach(fun do_public_encrypt/1, Params), + lists:foreach(fun do_public_encrypt/1, Params). + +%%-------------------------------------------------------------------- +private_encrypt() -> + [{doc, "Test private_encrypt/decrypt functions. "}]. +private_encrypt(Config) when is_list(Config) -> + Params = proplists:get_value(pub_priv_encrypt, Config), lists:foreach(fun do_private_encrypt/1, Params). %%-------------------------------------------------------------------- @@ -819,7 +830,7 @@ do_private_encrypt({_Type, _Public, _Private, _Msg, rsa_pkcs1_oaep_padding}) -> ok; %% Not supported by openssl do_private_encrypt({Type, Public, Private, Msg, Padding}) -> PrivEcn = (catch crypto:private_encrypt(Type, Msg, Private, Padding)), - case crypto:public_decrypt(rsa, PrivEcn, Public, Padding) of + case crypto:public_decrypt(Type, PrivEcn, Public, Padding) of Msg -> ok; Other -> @@ -1233,7 +1244,9 @@ group_config(dss = Type, Config) -> SignVerify = [{Type, Hash, Public, Private, Msg} || Hash <- DssHashs, lists:member(Hash, SupportedHashs)], - [{sign_verify, SignVerify} | Config]; + MsgPubEnc = <<"7896345786348 Asldi">>, + PubPrivEnc = [{dss, Public, Private, MsgPubEnc, []}], + [{sign_verify, SignVerify}, {pub_priv_encrypt, PubPrivEnc} | Config]; group_config(ecdsa = Type, Config) -> {Private, Public} = ec_key_named(), @@ -1243,7 +1256,9 @@ group_config(ecdsa = Type, Config) -> SignVerify = [{Type, Hash, Public, Private, Msg} || Hash <- DssHashs, lists:member(Hash, SupportedHashs)], - [{sign_verify, SignVerify} | Config]; + MsgPubEnc = <<"7896345786348 Asldi">>, + PubPrivEnc = [{ecdsa, Public, Private, MsgPubEnc, []}], + [{sign_verify, SignVerify}, {pub_priv_encrypt, PubPrivEnc} | Config]; group_config(srp, Config) -> GenerateCompute = [srp3(), srp6(), srp6a(), srp6a_smaller_prime()], [{generate_compute, GenerateCompute} | Config]; diff --git a/lib/crypto/test/engine_SUITE.erl b/lib/crypto/test/engine_SUITE.erl new file mode 100644 index 0000000000..f206f967c7 --- /dev/null +++ b/lib/crypto/test/engine_SUITE.erl @@ -0,0 +1,660 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(engine_SUITE). + +-include_lib("common_test/include/ct.hrl"). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{seconds, 10}} + ]. + +all() -> + [ + get_all_possible_methods, + engine_load_all_methods, + engine_load_some_methods, + bad_arguments, + unknown_engine, + pre_command_fail_bad_value, + pre_command_fail_bad_key, + failed_engine_init, + ctrl_cmd_string, + ctrl_cmd_string_optional, + {group, engine_stored_key} + ]. + +groups() -> + [{engine_stored_key, [], + [sign_verify_rsa, + sign_verify_dsa, + sign_verify_ecdsa, + sign_verify_rsa_pwd, + sign_verify_rsa_pwd_bad_pwd, + priv_encrypt_pub_decrypt_rsa, + priv_encrypt_pub_decrypt_rsa_pwd, + pub_encrypt_priv_decrypt_rsa, + pub_encrypt_priv_decrypt_rsa_pwd, + get_pub_from_priv_key_rsa, + get_pub_from_priv_key_rsa_pwd, + get_pub_from_priv_key_rsa_pwd_no_pwd, + get_pub_from_priv_key_rsa_pwd_bad_pwd, + get_pub_from_priv_key_dsa, + get_pub_from_priv_key_ecdsa + ]}]. + + +init_per_suite(Config) -> + try crypto:start() of + ok -> + Config; + {error,{already_started,crypto}} -> + Config + catch _:_ -> + {skip, "Crypto did not start"} + end. +end_per_suite(_Config) -> + ok. + +%%-------------------------------------------------------------------- +init_per_group(engine_stored_key, Config) -> + case load_storage_engine(Config) of + {ok, E} -> + KeyDir = key_dir(Config), + [{storage_engine,E}, {storage_dir,KeyDir} | Config]; + {error, notexist} -> + {skip, "OTP Test engine not found"}; + {error, notsup} -> + {skip, "Engine not supported on this OpenSSL version"}; + {error, bad_engine_id} -> + {skip, "Dynamic Engine not supported"}; + Other -> + ct:log("Engine load failed: ~p",[Other]), + {fail, "Engine load failed"} + end; +init_per_group(_Group, Config0) -> + Config0. + +end_per_group(engine_stored_key, Config) -> + case proplists:get_value(storage_engine, Config) of + undefined -> + ok; + E -> + ok = crypto:engine_unload(E) + end; +end_per_group(_, _) -> + ok. + +%%-------------------------------------------------------------------- +init_per_testcase(_Case, Config) -> + Config. +end_per_testcase(_Case, _Config) -> + ok. + +%%------------------------------------------------------------------------- +%% Test cases starts here. +%%------------------------------------------------------------------------- +get_all_possible_methods() -> + [{doc, "Just fetch all possible engine methods supported."}]. + +get_all_possible_methods(Config) when is_list(Config) -> + try + List = crypto:engine_get_all_methods(), + ct:log("crypto:engine_get_all_methods() -> ~p\n", [List]), + ok + catch + error:notsup -> + {skip, "Engine not supported on this OpenSSL version"} + end. + +engine_load_all_methods()-> + [{doc, "Use a dummy md5 engine that does not implement md5" + "but rather returns a static binary to test that crypto:engine_load " + "functions works."}]. + +engine_load_all_methods(Config) when is_list(Config) -> + case crypto:get_test_engine() of + {error, notexist} -> + {skip, "OTP Test engine not found"}; + {ok, Engine} -> + try + Md5Hash1 = <<106,30,3,246,166,222,229,158,244,217,241,179,50,232,107,109>>, + Md5Hash1 = crypto:hash(md5, "Don't panic"), + Md5Hash2 = <<0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15>>, + case crypto:engine_load(<<"dynamic">>, + [{<<"SO_PATH">>, Engine}, + {<<"ID">>, <<"MD5">>}, + <<"LOAD">>], + []) of + {ok, E} -> + case crypto:hash(md5, "Don't panic") of + Md5Hash1 -> + ct:fail(fail_to_load_still_original_engine); + Md5Hash2 -> + ok; + _ -> + ct:fail(fail_to_load_engine) + end, + ok = crypto:engine_unload(E), + case crypto:hash(md5, "Don't panic") of + Md5Hash2 -> + ct:fail(fail_to_unload_still_test_engine); + Md5Hash1 -> + ok; + _ -> + ct:fail(fail_to_unload_engine) + end; + {error, bad_engine_id} -> + {skip, "Dynamic Engine not supported"} + end + catch + error:notsup -> + {skip, "Engine not supported on this OpenSSL version"} + end + end. + +engine_load_some_methods()-> + [{doc, "Use a dummy md5 engine that does not implement md5" + "but rather returns a static binary to test that crypto:engine_load " + "functions works."}]. + +engine_load_some_methods(Config) when is_list(Config) -> + case crypto:get_test_engine() of + {error, notexist} -> + {skip, "OTP Test engine not found"}; + {ok, Engine} -> + try + Md5Hash1 = <<106,30,3,246,166,222,229,158,244,217,241,179,50,232,107,109>>, + Md5Hash1 = crypto:hash(md5, "Don't panic"), + Md5Hash2 = <<0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15>>, + EngineMethods = crypto:engine_get_all_methods() -- + [engine_method_dh,engine_method_rand, + engine_method_ciphers, engine_method_store, + engine_method_pkey_meths, engine_method_pkey_asn1_meths], + case crypto:engine_load(<<"dynamic">>, + [{<<"SO_PATH">>, Engine}, + {<<"ID">>, <<"MD5">>}, + <<"LOAD">>], + [], + EngineMethods) of + {ok, E} -> + case crypto:hash(md5, "Don't panic") of + Md5Hash1 -> + ct:fail(fail_to_load_engine_still_original); + Md5Hash2 -> + ok; + _ -> + ct:fail(fail_to_load_engine) + end, + ok = crypto:engine_unload(E), + case crypto:hash(md5, "Don't panic") of + Md5Hash2 -> + ct:fail(fail_to_unload_still_test_engine); + Md5Hash1 -> + ok; + _ -> + ct:fail(fail_to_unload_engine) + end; + {error, bad_engine_id} -> + {skip, "Dynamic Engine not supported"} + end + catch + error:notsup -> + {skip, "Engine not supported on this OpenSSL version"} + end + end. + +%%------------------------------------------------------------------------- +%% Error cases +bad_arguments()-> + [{doc, "Test different arguments in bad format."}]. + +bad_arguments(Config) when is_list(Config) -> + case crypto:get_test_engine() of + {error, notexist} -> + {skip, "OTP Test engine not found"}; + {ok, Engine} -> + try + try + crypto:engine_load(fail_engine, [], []) + catch + error:badarg -> + ok + end, + try + crypto:engine_load(<<"dynamic">>, + [{<<"SO_PATH">>, Engine}, + 1, + {<<"ID">>, <<"MD5">>}, + <<"LOAD">>], + []) + catch + error:badarg -> + ok + end, + try + crypto:engine_load(<<"dynamic">>, + [{<<"SO_PATH">>, Engine}, + {'ID', <<"MD5">>}, + <<"LOAD">>], + []) + catch + error:badarg -> + ok + end + catch + error:notsup -> + {skip, "Engine not supported on this OpenSSL version"} + end + end. + +unknown_engine() -> + [{doc, "Try to load a non existent engine."}]. + +unknown_engine(Config) when is_list(Config) -> + try + {error, bad_engine_id} = crypto:engine_load(<<"fail_engine">>, [], []), + ok + catch + error:notsup -> + {skip, "Engine not supported on this OpenSSL version"} + end. + +pre_command_fail_bad_value() -> + [{doc, "Test pre command due to bad value"}]. + +pre_command_fail_bad_value(Config) when is_list(Config) -> + DataDir = unicode:characters_to_binary(code:priv_dir(crypto)), + try + case crypto:engine_load(<<"dynamic">>, + [{<<"SO_PATH">>, + <<DataDir/binary, <<"/libfail_engine.so">>/binary >>}, + {<<"ID">>, <<"MD5">>}, + <<"LOAD">>], + []) of + {error, ctrl_cmd_failed} -> + ok; + {error, bad_engine_id} -> + {skip, "Dynamic Engine not supported"} + end + catch + error:notsup -> + {skip, "Engine not supported on this OpenSSL version"} + end. + +pre_command_fail_bad_key() -> + [{doc, "Test pre command due to bad key"}]. + +pre_command_fail_bad_key(Config) when is_list(Config) -> + try + case crypto:get_test_engine() of + {error, notexist} -> + {skip, "OTP Test engine not found"}; + {ok, Engine} -> + case crypto:engine_load(<<"dynamic">>, + [{<<"SO_WRONG_PATH">>, Engine}, + {<<"ID">>, <<"MD5">>}, + <<"LOAD">>], + []) of + {error, ctrl_cmd_failed} -> + ok; + {error, bad_engine_id} -> + {skip, "Dynamic Engine not supported"} + end + end + catch + error:notsup -> + {skip, "Engine not supported on this OpenSSL version"} + end. + +failed_engine_init()-> + [{doc, "Test failing engine init due to missed pre command"}]. + +failed_engine_init(Config) when is_list(Config) -> + try + case crypto:get_test_engine() of + {error, notexist} -> + {skip, "OTP Test engine not found"}; + {ok, Engine} -> + case crypto:engine_load(<<"dynamic">>, + [{<<"SO_PATH">>, Engine}, + {<<"ID">>, <<"MD5">>}], + []) of + {error, add_engine_failed} -> + ok; + {error, bad_engine_id} -> + {skip, "Dynamic Engine not supported"} + end + end + catch + error:notsup -> + {skip, "Engine not supported on this OpenSSL version"} + end. + + +ctrl_cmd_string()-> + [{doc, "Test that a not known optional ctrl comand do not fail"}]. +ctrl_cmd_string(Config) when is_list(Config) -> + try + case crypto:get_test_engine() of + {error, notexist} -> + {skip, "OTP Test engine not found"}; + {ok, Engine} -> + case crypto:engine_load(<<"dynamic">>, + [{<<"SO_PATH">>, Engine}, + {<<"ID">>, <<"MD5">>}, + <<"LOAD">>], + []) of + {ok, E} -> + case crypto:engine_ctrl_cmd_string(E, <<"TEST">>, <<"17">>) of + ok -> + ct:fail(fail_ctrl_cmd_should_fail); + {error,ctrl_cmd_failed} -> + ok + end, + ok = crypto:engine_unload(E); + {error, bad_engine_id} -> + {skip, "Dynamic Engine not supported"} + end + end + catch + error:notsup -> + {skip, "Engine not supported on this OpenSSL version"} + end. + +ctrl_cmd_string_optional()-> + [{doc, "Test that a not known optional ctrl comand do not fail"}]. +ctrl_cmd_string_optional(Config) when is_list(Config) -> + try + case crypto:get_test_engine() of + {error, notexist} -> + {skip, "OTP Test engine not found"}; + {ok, Engine} -> + case crypto:engine_load(<<"dynamic">>, + [{<<"SO_PATH">>, Engine}, + {<<"ID">>, <<"MD5">>}, + <<"LOAD">>], + []) of + {ok, E} -> + case crypto:engine_ctrl_cmd_string(E, <<"TEST">>, <<"17">>, true) of + ok -> + ok; + _ -> + ct:fail(fail_ctrl_cmd_string) + end, + ok = crypto:engine_unload(E); + {error, bad_engine_id} -> + {skip, "Dynamic Engine not supported"} + end + end + catch + error:notsup -> + {skip, "Engine not supported on this OpenSSL version"} + end. + +%%%---------------------------------------------------------------- +%%% Pub/priv key storage tests. Thoose are for testing the crypto.erl +%%% support for using priv/pub keys stored in an engine. + +sign_verify_rsa(Config) -> + Priv = #{engine => engine_ref(Config), + key_id => key_id(Config, "rsa_private_key.pem")}, + Pub = #{engine => engine_ref(Config), + key_id => key_id(Config, "rsa_public_key.pem")}, + sign_verify(rsa, sha, Priv, Pub). + +sign_verify_dsa(Config) -> + Priv = #{engine => engine_ref(Config), + key_id => key_id(Config, "dsa_private_key.pem")}, + Pub = #{engine => engine_ref(Config), + key_id => key_id(Config, "dsa_public_key.pem")}, + sign_verify(dss, sha, Priv, Pub). + +sign_verify_ecdsa(Config) -> + Priv = #{engine => engine_ref(Config), + key_id => key_id(Config, "ecdsa_private_key.pem")}, + Pub = #{engine => engine_ref(Config), + key_id => key_id(Config, "ecdsa_public_key.pem")}, + sign_verify(ecdsa, sha, Priv, Pub). + +sign_verify_rsa_pwd(Config) -> + Priv = #{engine => engine_ref(Config), + key_id => key_id(Config, "rsa_private_key_pwd.pem"), + password => "password"}, + Pub = #{engine => engine_ref(Config), + key_id => key_id(Config, "rsa_public_key_pwd.pem")}, + sign_verify(rsa, sha, Priv, Pub). + +sign_verify_rsa_pwd_bad_pwd(Config) -> + Priv = #{engine => engine_ref(Config), + key_id => key_id(Config, "rsa_private_key_pwd.pem"), + password => "Bad password"}, + Pub = #{engine => engine_ref(Config), + key_id => key_id(Config, "rsa_public_key_pwd.pem")}, + try sign_verify(rsa, sha, Priv, Pub) of + _ -> {fail, "PWD prot pubkey sign succeded with no pwd!"} + catch + error:badarg -> ok + end. + +priv_encrypt_pub_decrypt_rsa(Config) -> + Priv = #{engine => engine_ref(Config), + key_id => key_id(Config, "rsa_private_key.pem")}, + Pub = #{engine => engine_ref(Config), + key_id => key_id(Config, "rsa_public_key.pem")}, + priv_enc_pub_dec(rsa, Priv, Pub, rsa_pkcs1_padding). + +priv_encrypt_pub_decrypt_rsa_pwd(Config) -> + Priv = #{engine => engine_ref(Config), + key_id => key_id(Config, "rsa_private_key_pwd.pem"), + password => "password"}, + Pub = #{engine => engine_ref(Config), + key_id => key_id(Config, "rsa_public_key_pwd.pem")}, + priv_enc_pub_dec(rsa, Priv, Pub, rsa_pkcs1_padding). + +pub_encrypt_priv_decrypt_rsa(Config) -> + Priv = #{engine => engine_ref(Config), + key_id => key_id(Config, "rsa_private_key.pem")}, + Pub = #{engine => engine_ref(Config), + key_id => key_id(Config, "rsa_public_key.pem")}, + pub_enc_priv_dec(rsa, Pub, Priv, rsa_pkcs1_padding). + +pub_encrypt_priv_decrypt_rsa_pwd(Config) -> + Priv = #{engine => engine_ref(Config), + key_id => key_id(Config, "rsa_private_key_pwd.pem"), + password => "password"}, + Pub = #{engine => engine_ref(Config), + key_id => key_id(Config, "rsa_public_key_pwd.pem")}, + pub_enc_priv_dec(rsa, Pub, Priv, rsa_pkcs1_padding). + +get_pub_from_priv_key_rsa(Config) -> + Priv = #{engine => engine_ref(Config), + key_id => key_id(Config, "rsa_private_key.pem")}, + case crypto:privkey_to_pubkey(rsa, Priv) of + {error, not_found} -> + {fail, "Key not found"}; + {error, notsup} -> + {skip, "RSA not supported"}; + {error, Error} -> + {fail, {wrong_error,Error}}; + Pub -> + ct:log("rsa Pub = ~p",[Pub]), + sign_verify(rsa, sha, Priv, Pub) + end. + +get_pub_from_priv_key_rsa_pwd(Config) -> + Priv = #{engine => engine_ref(Config), + key_id => key_id(Config, "rsa_private_key_pwd.pem"), + password => "password"}, + case crypto:privkey_to_pubkey(rsa, Priv) of + {error, not_found} -> + {fail, "Key not found"}; + {error, notsup} -> + {skip, "RSA not supported"}; + {error, Error} -> + {fail, {wrong_error,Error}}; + Pub -> + ct:log("rsa Pub = ~p",[Pub]), + sign_verify(rsa, sha, Priv, Pub) + end. + +get_pub_from_priv_key_rsa_pwd_no_pwd(Config) -> + Priv = #{engine => engine_ref(Config), + key_id => key_id(Config, "rsa_private_key_pwd.pem")}, + case crypto:privkey_to_pubkey(rsa, Priv) of + {error, not_found} -> + ok; + {error, notsup} -> + {skip, "RSA not supported"}; + {error, Error} -> + {fail, {wrong_error,Error}}; + Pub -> + ct:log("rsa Pub = ~p",[Pub]), + {fail, "PWD prot pubkey fetch succeded although no pwd!"} + end. + +get_pub_from_priv_key_rsa_pwd_bad_pwd(Config) -> + Priv = #{engine => engine_ref(Config), + key_id => key_id(Config, "rsa_private_key_pwd.pem"), + password => "Bad password"}, + case crypto:privkey_to_pubkey(rsa, Priv) of + {error, not_found} -> + ok; + {error, notsup} -> + {skip, "RSA not supported"}; + {error, Error} -> + {fail, {wrong_error,Error}}; + Pub -> + ct:log("rsa Pub = ~p",[Pub]), + {fail, "PWD prot pubkey fetch succeded with bad pwd!"} + end. + +get_pub_from_priv_key_dsa(Config) -> + Priv = #{engine => engine_ref(Config), + key_id => key_id(Config, "dsa_private_key.pem")}, + case crypto:privkey_to_pubkey(dss, Priv) of + {error, not_found} -> + {fail, "Key not found"}; + {error, notsup} -> + {skip, "DSA not supported"}; + {error, Error} -> + {fail, {wrong_error,Error}}; + Pub -> + ct:log("dsa Pub = ~p",[Pub]), + sign_verify(dss, sha, Priv, Pub) + end. + +get_pub_from_priv_key_ecdsa(Config) -> + Priv = #{engine => engine_ref(Config), + key_id => key_id(Config, "ecdsa_private_key.pem")}, + case crypto:privkey_to_pubkey(ecdsa, Priv) of + {error, not_found} -> + {fail, "Key not found"}; + {error, notsup} -> + {skip, "ECDSA not supported"}; + {error, Error} -> + {fail, {wrong_error,Error}}; + Pub -> + ct:log("ecdsa Pub = ~p",[Pub]), + sign_verify(ecdsa, sha, Priv, Pub) + end. + +%%%================================================================ +%%% Help for engine_stored_pub_priv_keys* test cases +%%% +load_storage_engine(_Config) -> + case crypto:get_test_engine() of + {ok, Engine} -> + try crypto:engine_load(<<"dynamic">>, + [{<<"SO_PATH">>, Engine}, + <<"LOAD">>], + []) + catch + error:notsup -> + {error, notsup} + end; + + {error, Error} -> + {error, Error} + end. + + +key_dir(Config) -> + DataDir = unicode:characters_to_binary(proplists:get_value(data_dir, Config)), + filename:join(DataDir, "pkcs8"). + + +engine_ref(Config) -> + proplists:get_value(storage_engine, Config). + +key_id(Config, File) -> + filename:join(proplists:get_value(storage_dir,Config), File). + +pubkey_alg_supported(Alg) -> + lists:member(Alg, + proplists:get_value(public_keys, crypto:supports())). + + +pub_enc_priv_dec(Alg, KeyEnc, KeyDec, Padding) -> + case pubkey_alg_supported(Alg) of + true -> + PlainText = <<"Hej på dig">>, + CryptoText = crypto:public_encrypt(Alg, PlainText, KeyEnc, Padding), + case crypto:private_decrypt(Alg, CryptoText, KeyDec, Padding) of + PlainText -> ok; + _ -> {fail, "Encrypt-decrypt error"} + end; + false -> + {skip, lists:concat([Alg," is not supported by cryptolib"])} + end. + +priv_enc_pub_dec(Alg, KeyEnc, KeyDec, Padding) -> + case pubkey_alg_supported(Alg) of + true -> + PlainText = <<"Hej på dig">>, + CryptoText = crypto:private_encrypt(Alg, PlainText, KeyEnc, Padding), + case crypto:public_decrypt(Alg, CryptoText, KeyDec, Padding) of + PlainText -> ok; + _ -> {fail, "Encrypt-decrypt error"} + end; + false -> + {skip, lists:concat([Alg," is not supported by cryptolib"])} + end. + +sign_verify(Alg, Sha, KeySign, KeyVerify) -> + case pubkey_alg_supported(Alg) of + true -> + PlainText = <<"Hej på dig">>, + Signature = crypto:sign(Alg, Sha, PlainText, KeySign), + case crypto:verify(Alg, Sha, PlainText, Signature, KeyVerify) of + true -> ok; + _ -> {fail, "Sign-verify error"} + end; + false -> + {skip, lists:concat([Alg," is not supported by cryptolib"])} + end. diff --git a/lib/crypto/test/engine_SUITE_data/pkcs8/dsa_private_key.pem b/lib/crypto/test/engine_SUITE_data/pkcs8/dsa_private_key.pem new file mode 100644 index 0000000000..778ffac675 --- /dev/null +++ b/lib/crypto/test/engine_SUITE_data/pkcs8/dsa_private_key.pem @@ -0,0 +1,9 @@ +-----BEGIN PRIVATE KEY----- +MIIBSwIBADCCASwGByqGSM44BAEwggEfAoGBAMyitTMR7vPbpqyAXJpqnB0AhFwQ +F87IE+JKFl5bD/MSkhhRV5sM73HUU1ooXY0FjhZ+cdLUCATuZR5ta4ydANqWIcAB +gX3IwF1B4zf5SXEKTWkUYneL9dOKtiZLtoG28swrk8xMxwX+0fLHkltCEj6FiTW9 +PFrv8GmIfV6DjcI9AhUAqXWbb3RtoN9Ld28fVMhGZrj3LJUCgYEAwnxGHGBMpJaF +2w7zAw3jHjL8PMYlV6vnufGHQlwF0ZUXJxRsvagMb/X1qACTu2VPYEVoLQGM3cfH +EhHoQmvSXGAyTfR7Bmn3gf1n/s/DcFbdZduUCZ/rAyIrfd0eSbc1I+kZk85UCsKK +w/IYdlqcuYa4Cgm2TapT5uEMqH4jhzEEFgIULh8swEUWmU8aJNWsrWl4eCiuUUg= +-----END PRIVATE KEY----- diff --git a/lib/crypto/test/engine_SUITE_data/pkcs8/dsa_public_key.pem b/lib/crypto/test/engine_SUITE_data/pkcs8/dsa_public_key.pem new file mode 100644 index 0000000000..0fa5428828 --- /dev/null +++ b/lib/crypto/test/engine_SUITE_data/pkcs8/dsa_public_key.pem @@ -0,0 +1,12 @@ +-----BEGIN PUBLIC KEY----- +MIIBtzCCASwGByqGSM44BAEwggEfAoGBAMyitTMR7vPbpqyAXJpqnB0AhFwQF87I +E+JKFl5bD/MSkhhRV5sM73HUU1ooXY0FjhZ+cdLUCATuZR5ta4ydANqWIcABgX3I +wF1B4zf5SXEKTWkUYneL9dOKtiZLtoG28swrk8xMxwX+0fLHkltCEj6FiTW9PFrv +8GmIfV6DjcI9AhUAqXWbb3RtoN9Ld28fVMhGZrj3LJUCgYEAwnxGHGBMpJaF2w7z +Aw3jHjL8PMYlV6vnufGHQlwF0ZUXJxRsvagMb/X1qACTu2VPYEVoLQGM3cfHEhHo +QmvSXGAyTfR7Bmn3gf1n/s/DcFbdZduUCZ/rAyIrfd0eSbc1I+kZk85UCsKKw/IY +dlqcuYa4Cgm2TapT5uEMqH4jhzEDgYQAAoGAXPygOFYdeKgfLmuIC303cESYXvic +e2GNJomv8vaWLZmbLVVDfwA1fNsuF1hZkWw8f7aYaN9iZ3yl9u4Yk4TbJKkqfJqd +dgVt288SUqvi+NMHODUzYi9KAOXxupXffZSvdu54gKRaDuFTZ5XNcRqIJWGYlJYg +NVHF5FPZ4Bk2FYA= +-----END PUBLIC KEY----- diff --git a/lib/crypto/test/engine_SUITE_data/pkcs8/ecdsa_private_key.pem b/lib/crypto/test/engine_SUITE_data/pkcs8/ecdsa_private_key.pem new file mode 100644 index 0000000000..a45522064f --- /dev/null +++ b/lib/crypto/test/engine_SUITE_data/pkcs8/ecdsa_private_key.pem @@ -0,0 +1,8 @@ +-----BEGIN PRIVATE KEY----- +MIHuAgEAMBAGByqGSM49AgEGBSuBBAAjBIHWMIHTAgEBBEIBparGjr0KcdNrVM2J +G0mW5ltP1QyvxDqBMyWLWo3fruRZv6Qoohl5skd1u4O+KJoM/UrrSTOXI/MDR7NN +i1yl7O+hgYkDgYYABAG8K2XVsK0ahG9+HIIPwCO0pJY8ulwSTXwIjkCGyB2lpglh +8qJmRzuyGcfRTslv8wfv0sPlT9H9PKDvgrTUL7rvQQDdOODNgVPXSecUoXoPn+X+ +eqxs77bjx+A5x0t/i3m5PfkaNPh5MZ1H/bWuOOdj2ZXZw0R4rlVc0zVrgnPU8L8S +BQ== +-----END PRIVATE KEY----- diff --git a/lib/crypto/test/engine_SUITE_data/pkcs8/ecdsa_public_key.pem b/lib/crypto/test/engine_SUITE_data/pkcs8/ecdsa_public_key.pem new file mode 100644 index 0000000000..6d22fe43fe --- /dev/null +++ b/lib/crypto/test/engine_SUITE_data/pkcs8/ecdsa_public_key.pem @@ -0,0 +1,6 @@ +-----BEGIN PUBLIC KEY----- +MIGbMBAGByqGSM49AgEGBSuBBAAjA4GGAAQBvCtl1bCtGoRvfhyCD8AjtKSWPLpc +Ek18CI5AhsgdpaYJYfKiZkc7shnH0U7Jb/MH79LD5U/R/Tyg74K01C+670EA3Tjg +zYFT10nnFKF6D5/l/nqsbO+248fgOcdLf4t5uT35GjT4eTGdR/21rjjnY9mV2cNE +eK5VXNM1a4Jz1PC/EgU= +-----END PUBLIC KEY----- diff --git a/lib/crypto/test/engine_SUITE_data/pkcs8/rsa_private_key.pem b/lib/crypto/test/engine_SUITE_data/pkcs8/rsa_private_key.pem new file mode 100644 index 0000000000..ea0e3d3958 --- /dev/null +++ b/lib/crypto/test/engine_SUITE_data/pkcs8/rsa_private_key.pem @@ -0,0 +1,28 @@ +-----BEGIN PRIVATE KEY----- +MIIEvwIBADANBgkqhkiG9w0BAQEFAASCBKkwggSlAgEAAoIBAQCwwb0/ddXGXTFK +4FLxXdV6a/WJMSoPPS55RvZIAHFsiTtvPLbJ8LxDsZ6wSVZLN0/UQ4wdWn9jftyj +U5/IxBVG8XOtKimTMvm3/ZOzVLueGHBbrLYscRv9oL85ulTKHWgrZDu0lBX5JJTI +v5UTCErzJRQbka9DG1GaBgDb1PlXfkzBWMwfsBZmwoC77KvCcIGCgbW/XCY03TP2 +3Tg8drvpByMStddP2FQ4fZ91qFUzPu8uhZEsqSQTFlmhgGEx7dLlky0xvu62RuAD +RTpINpcWZtWDHTdssOqu653LwwqBY8lBopCZ/4Af8QR3ZYkQhen1YLEbVheXRuzI +LSCZIiJNAgMBAAECggEBAJH4/fxpqQkvr2Shy33Pu1xlyhnpw01gfn/jrcKasxEq +aC4eWup86E2TY3U8q4pkfIXU3uLi+O9HNpmflwargNLc1mY8uqb44ygiv5bLNEKE +9k2PXcdoBfC4jxPyoNFl5cBn/7LK1TazEjiTl15na9ZPWcLG1pG5/vMPYCgsQ1sP +8J3c4E3aaXIj9QceYxBprl490OCzieGyZlRipncz3g4UShRc/b4cycvDZOJpmAy4 +zbWTcBcSMPVPi5coF0K8UcimiqZkotfb/2RLc433i34IdsIXMM+brdq+g8rmjg5a ++oQPy02M6tFApBruEhAz8DGgaLtDY6MLtyZAt3SjXnUCgYEA1zLgamdTHOqrrmIi +eIQBnAJiyIfcY8B9SX1OsLGYFCHiPVwgUY35B2c7MavMsGcExJhtE+uxU7o5djtM +R6r9cRHOXJ6EQwa8OwzzPqbM17/YqNDeK39bc9WOFUqRWrhDhVMPy6z8rmZr73mG +IUC7mBNx/1GBdVYXIlsXzC96dI8CgYEA0kUAhz6I5nyPa70NDEUYHLHf3IW1BCmE +UoVbraSePJtIEY/IqFx7oDuFo30d4n5z+8ICCtyid1h/Cp3mf3akOiqltYUfgV1G +JgcEjKKYWEnO7cfFyO7LB7Y3GYYDJNy6EzVWPiwTGk9ZTfFJEESmHC45Unxgd17m +Dx/R58rFgWMCgYBQXQWFdtSI5fH7C1bIHrPjKNju/h2FeurOuObcAVZDnmu4cmD3 +U8d9xkVKxVeJQM99A1coq0nrdI3k4zwXP3mp8fZYjDHkPe2pN6rW6L9yiohEcsuk +/siON1/5/4DMmidM8LnjW9R45HLGWWGHpX7oyco2iJ+Jy/6Tq+T1MX3PbQKBgQCm +hdsbQJ0u3CrBSmFQ/E9SOlRt0r4+45pVuCOY6yweF2QF9HcXTtbhWQJHLclDHJ5C +Ha18aKuKFN3XzKFFBPKe1jOSBDGlQ/dQGnKx5fr8wMdObM3oiaTlIJuWbRmEUgJT +QARjDIi8Z2b0YUhZx+Q9oSXoe3PyVYehJrQX+/BavQKBgQCIr7Zp0rQPbfqcTL+M +OYHUoNcb14f9f8hXeXHQOqVpsGwxGdRQAU9wbx/4+obKB5xIkzBsVNcJwavisNja +hegnGjTB/9Hc4m+5bMGwH0bhS2eQO4o+YYM2ypDmFQqDLRfFUlZ5PVHffm/aA9+g +GanNBCsmtoHtV6CJ1UZ7NmBuIA== +-----END PRIVATE KEY----- diff --git a/lib/crypto/test/engine_SUITE_data/pkcs8/rsa_private_key_pwd.pem b/lib/crypto/test/engine_SUITE_data/pkcs8/rsa_private_key_pwd.pem new file mode 100644 index 0000000000..501662fc35 --- /dev/null +++ b/lib/crypto/test/engine_SUITE_data/pkcs8/rsa_private_key_pwd.pem @@ -0,0 +1,30 @@ +-----BEGIN ENCRYPTED PRIVATE KEY----- +MIIFDjBABgkqhkiG9w0BBQ0wMzAbBgkqhkiG9w0BBQwwDgQIh888Iq6gxuMCAggA +MBQGCCqGSIb3DQMHBAic/11YZ8Nt5gSCBMjG/Jb4qiMoBS50iQvHXqcETPE+0NBr +jhsn9w94LkdRBstMPAsoKmY98Er96Rnde/NfmqlU9CupKTkd7Ce5poBf72Y6KMED +cPURyjbGRFsu6x9skXB2obhyKYEqAEF2oQAg4Qbe5v1qXBIgDuC/NgiJnM+w2zCZ +LkHSZB2/NmcnvDzcgPF7TM8pTO23xCJ33m37qjfWvHsgocVqZmL9wQ4+wr/NMYjJ +pJvX1OHW1vBsZsXh40WchalYRSB1VeO368QfsE8coRJztqbMzdce9EQdMB6Q6jlO +cetd3moLIoMP4I7HW0/SgokbycTbRiYSvRyU1TGc2WbW6BrFZV24IckcnnVUFatf +6HKUcaYLG68dJcRgs5QMGkcmgVvlddENHFmHZlo0eym/xSiUl/AT8/5odscm6ML8 +wW5sneax+TF4J2eYmiN7yjAUCodXVTNYNDVKo6uUhntlymbM0o4UitVIbPIfTDHl +sxJAEZ7vpuPqeNMxUk6G6zipuEjqsVbnuFSBSZmgKiGYcifRPUmqqINa3DdS4WVx +xaPWdHbHVRD//ze3h/FsA+1lIE5q2kUE0xXseJA1ISog++kJp14XeaaL2j/tx3Ob +OsbcaOAD/IUw/ItDt9kn0qzfnar7sS0Wov8AmJQxHmH7Lm93jHTLM05yE0AR/eBr +Mig2ZdC+9OqVC+GPuBkRjSs8NpltQIDroz6EV9IMwPwXm0szSYoyoPLmlHJUdnLs +ZUef+au6hYkEJBrvuisagnq5eT/fCV3hsjD7yODebNU2CmBTo6X2PRx/xsBHRMWl +QkoM9PBdSCnKv6HpHl4pchuoqU2NpFjN0BCaad6aHfZSTnqgzK4bEh1oO6dI8/rB +/eh71JyFFG5J4xbpaqz5Su01V1iwU5leK5bDwqals4M4+ZGHGciou7qnXUmX2fJl +r6DlMUa/xy+A2ZG0NuZR05yk2oB3+KVNMgp6zFty3XaxwoNtc8GTLtLnBnIh2rlP +mE1+I65LRWwrNQalPeOAUrYuEzhyp2Df7a8Ykas5PUH7MGR/S0Ge/dLxtE2bJuK4 +znbLAsGhvo/SbNxYqIp6D4iDtd3va6yUGncy41paA/vTKFVvXZDrXcwJQYYCVOGT +OwdzNuozU8Dc7oxsd8oakfC46kvmVaOrGvZbm56PFfprcaL/Hslska5xxEni/eZe +WRxZbCBhAVqS1pn5zkDQVUe9uFlR/x39Qi01HIlKLBsjpSs6qQsFArMe8hgXmXLG +xP+dyVuOE18NzSewdEjeqSRKIM7Qi8EOjZsI4HdSRBY7bh9VhmaVXDZiCSf33TTE +3y8nimzQAeuGoYg6WqHmWWC2Qnpki2HlaIH/ayXEyQWkP/qvg61e8ovdg9Fy8JOO +0AacXVt5zj0q00AW5bKx7usi4NIjZedi86hUm6H19aBm7r86BKjwYTEI/GOcdrbV +9HC/8ayOimgwiAG3gq+aLioWym+Z6KnsbVd7XReVbvM/InQx54WA2y5im0A+/c67 +oQFFPV84XGX9waeqv/K4Wzkm6HW+qVAEM67482VGOf0PVrlQMno6dOotT/Y7ljoZ +2iz0LmN9yylJnLPDrr1i6gzbs5OhhUgbF5LI2YP2wWdCZTl/DrKSIvQZWl8U+tw3 +ciA= +-----END ENCRYPTED PRIVATE KEY----- diff --git a/lib/crypto/test/engine_SUITE_data/pkcs8/rsa_public_key.pem b/lib/crypto/test/engine_SUITE_data/pkcs8/rsa_public_key.pem new file mode 100644 index 0000000000..d3fb5a2cc9 --- /dev/null +++ b/lib/crypto/test/engine_SUITE_data/pkcs8/rsa_public_key.pem @@ -0,0 +1,9 @@ +-----BEGIN PUBLIC KEY----- +MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAsMG9P3XVxl0xSuBS8V3V +emv1iTEqDz0ueUb2SABxbIk7bzy2yfC8Q7GesElWSzdP1EOMHVp/Y37co1OfyMQV +RvFzrSopkzL5t/2Ts1S7nhhwW6y2LHEb/aC/ObpUyh1oK2Q7tJQV+SSUyL+VEwhK +8yUUG5GvQxtRmgYA29T5V35MwVjMH7AWZsKAu+yrwnCBgoG1v1wmNN0z9t04PHa7 +6QcjErXXT9hUOH2fdahVMz7vLoWRLKkkExZZoYBhMe3S5ZMtMb7utkbgA0U6SDaX +FmbVgx03bLDqruudy8MKgWPJQaKQmf+AH/EEd2WJEIXp9WCxG1YXl0bsyC0gmSIi +TQIDAQAB +-----END PUBLIC KEY----- diff --git a/lib/crypto/test/engine_SUITE_data/pkcs8/rsa_public_key_pwd.pem b/lib/crypto/test/engine_SUITE_data/pkcs8/rsa_public_key_pwd.pem new file mode 100644 index 0000000000..f74361cead --- /dev/null +++ b/lib/crypto/test/engine_SUITE_data/pkcs8/rsa_public_key_pwd.pem @@ -0,0 +1,9 @@ +-----BEGIN PUBLIC KEY----- +MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAxquo1Na8C+kjeW0YESGm +vE1bgNW9xh+SQjU1fv/97ePK8mQW2zO1h/vUNz23pfZAKjQu3rlFW/VgGJQ0LgCs +8Gr/HbMwNcCJzuFMePUrnWn/qBeR7OKUZCJ3E1pp4kwsTdGDDO7jPtNzKf0bdKlg +G2GHfZWhUediRX8NsRg12X1odVPuRGVRsyJ952YODk9PFjK7pro7Ynf3Icx7di9d +PXL5vEcKSRdomXvt1rgM8XVHES94RQqoz60ZhfV2JnPfa9V8qu0KaGntpEr7p4rQ +5BSiLFPjPOArjsD5tKyo8ldKCdQjLfisEp7AetfMjLPVVPw9o/SmCjDxsYWTVRQ2 +tQIDAQAB +-----END PUBLIC KEY----- diff --git a/lib/crypto/vsn.mk b/lib/crypto/vsn.mk index 1dceebb4e4..da3915a4fc 100644 --- a/lib/crypto/vsn.mk +++ b/lib/crypto/vsn.mk @@ -1 +1 @@ -CRYPTO_VSN = 4.1 +CRYPTO_VSN = 4.2 diff --git a/lib/debugger/doc/src/Makefile b/lib/debugger/doc/src/Makefile index 0f724b6f17..cc0b8861d3 100644 --- a/lib/debugger/doc/src/Makefile +++ b/lib/debugger/doc/src/Makefile @@ -41,7 +41,7 @@ XML_APPLICATION_FILES = ref_man.xml XML_REF3_FILES = debugger.xml i.xml int.xml XML_PART_FILES = part.xml -XML_CHAPTER_FILES = debugger_chapter.xml notes.xml +XML_CHAPTER_FILES = introduction.xml debugger_chapter.xml notes.xml BOOK_FILES = book.xml diff --git a/lib/debugger/doc/src/fascicules.xml b/lib/debugger/doc/src/fascicules.xml deleted file mode 100644 index 154c8a3b6d..0000000000 --- a/lib/debugger/doc/src/fascicules.xml +++ /dev/null @@ -1,15 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> -</fascicules> - diff --git a/lib/debugger/doc/src/notes.xml b/lib/debugger/doc/src/notes.xml index 21fe7d449d..e71746e30d 100644 --- a/lib/debugger/doc/src/notes.xml +++ b/lib/debugger/doc/src/notes.xml @@ -33,6 +33,21 @@ <p>This document describes the changes made to the Debugger application.</p> +<section><title>Debugger 4.2.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Do not quote variables and button names in Debugger + windows. The bug was introduced in Erlang/OTP 20.1. </p> + <p> + Own Id: OTP-14802</p> + </item> + </list> + </section> + +</section> + <section><title>Debugger 4.2.3</title> <section><title>Improvements and New Features</title> diff --git a/lib/debugger/src/dbg_wx_win.erl b/lib/debugger/src/dbg_wx_win.erl index 9f59915476..f1298154ab 100644 --- a/lib/debugger/src/dbg_wx_win.erl +++ b/lib/debugger/src/dbg_wx_win.erl @@ -299,7 +299,7 @@ open_help(_Parent, HelpHtmlFile) -> %%-------------------------------------------------------------------- to_string(Atom) when is_atom(Atom) -> - io_lib:format("~tw", [Atom]); + atom_to_list(Atom); to_string(Integer) when is_integer(Integer) -> integer_to_list(Integer); to_string([]) -> ""; diff --git a/lib/debugger/src/i.erl b/lib/debugger/src/i.erl index 62ce8d0e20..853fa529a0 100644 --- a/lib/debugger/src/i.erl +++ b/lib/debugger/src/i.erl @@ -30,7 +30,7 @@ -import(lists, [sort/1,foreach/2]). iv() -> - Vsn = string:substr(filename:basename(code:lib_dir(debugger)), 10), + Vsn = string:slice(filename:basename(code:lib_dir(debugger)), 9), list_to_atom(Vsn). %% ------------------------------------------- diff --git a/lib/debugger/test/guard_SUITE.erl b/lib/debugger/test/guard_SUITE.erl index f7874f79df..e781ea932f 100644 --- a/lib/debugger/test/guard_SUITE.erl +++ b/lib/debugger/test/guard_SUITE.erl @@ -390,7 +390,7 @@ all_types() -> {atom, xxxx}, {ref, make_ref()}, {pid, self()}, - {port, open_port({spawn, efile}, [])}, + {port, make_port()}, {function, fun(X) -> X+1, "" end}, {binary, list_to_binary([])}]. @@ -435,6 +435,9 @@ type_test(binary, X) when binary(X) -> type_test(function, X) when function(X) -> function. +make_port() -> + hd(erlang:ports()). + const_guard(Config) when is_list(Config) -> if (0 == 0) and ((0 == 0) or (0 == 0)) -> diff --git a/lib/debugger/vsn.mk b/lib/debugger/vsn.mk index 72cedb2240..57da7e5618 100644 --- a/lib/debugger/vsn.mk +++ b/lib/debugger/vsn.mk @@ -1 +1 @@ -DEBUGGER_VSN = 4.2.3 +DEBUGGER_VSN = 4.2.4 diff --git a/lib/dialyzer/doc/src/Makefile b/lib/dialyzer/doc/src/Makefile index 8fe6cd30eb..3463b589e6 100644 --- a/lib/dialyzer/doc/src/Makefile +++ b/lib/dialyzer/doc/src/Makefile @@ -9,11 +9,11 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. -# +# # The Initial Developer of the Original Code is Ericsson Utvecklings AB. # Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings # AB. All Rights Reserved.'' -# +# include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk @@ -36,7 +36,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) XML_APPLICATION_FILES = ref_man.xml XML_REF3_FILES = dialyzer.xml typer.xml -XML_PART_FILES = part.xml part_notes.xml +XML_PART_FILES = part.xml XML_CHAPTER_FILES = dialyzer_chapter.xml notes.xml BOOK_FILES = book.xml @@ -65,9 +65,9 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += +XML_FLAGS += # ---------------------------------------------------- # Targets @@ -85,19 +85,19 @@ html: gifs $(HTML_REF_MAN_FILE) man: $(MAN3_FILES) -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) +gifs: $(GIF_FILES:%=$(HTMLDIR)/%) -debug opt: +debug opt: clean clean_docs: rm -rf $(HTMLDIR)/* rm -f $(MAN3DIR)/* rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ + rm -f errs core *~ # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs diff --git a/lib/dialyzer/doc/src/fascicules.xml b/lib/dialyzer/doc/src/fascicules.xml deleted file mode 100644 index 37feca543f..0000000000 --- a/lib/dialyzer/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/dialyzer/doc/src/note.gif b/lib/dialyzer/doc/src/note.gif Binary files differdeleted file mode 100644 index 6fffe30419..0000000000 --- a/lib/dialyzer/doc/src/note.gif +++ /dev/null diff --git a/lib/dialyzer/doc/src/notes.xml b/lib/dialyzer/doc/src/notes.xml index 6a6e65cb94..a1eecfb3fe 100644 --- a/lib/dialyzer/doc/src/notes.xml +++ b/lib/dialyzer/doc/src/notes.xml @@ -32,6 +32,29 @@ <p>This document describes the changes made to the Dialyzer application.</p> +<section><title>Dialyzer 3.2.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> The error message returned from Dialyzer when, for + example, a modified record field type is not a subtype of + the declared type, no longer includes a call stack. The + bug was introduced in Erlang/OTP 19.3. </p> + <p> + Own Id: OTP-14742</p> + </item> + <item> + <p> A bug relating to maps and never returning functions + has been fixed. </p> + <p> + Own Id: OTP-14743</p> + </item> + </list> + </section> + +</section> + <section><title>Dialyzer 3.2.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/dialyzer/doc/src/part_notes.xml b/lib/dialyzer/doc/src/part_notes.xml deleted file mode 100644 index 4a0a0af2d1..0000000000 --- a/lib/dialyzer/doc/src/part_notes.xml +++ /dev/null @@ -1,37 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2006</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>Dialyzer Release Notes</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - <file>part_notes.xml</file> - </header> - <description> - <p><em>Dialyzer</em> is a static analysis tool that identifies software discrepancies such as type errors, unreachable code, unnecessary tests, etc in single Erlang modules or entire (sets of) applications.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/dialyzer/doc/src/warning.gif b/lib/dialyzer/doc/src/warning.gif Binary files differdeleted file mode 100644 index 96af52360e..0000000000 --- a/lib/dialyzer/doc/src/warning.gif +++ /dev/null diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl index a4b42c9367..9993c68fed 100644 --- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl @@ -165,7 +165,11 @@ analysis_start(Parent, Analysis, LegalWarnings) -> remote_type_postprocessing(TmpCServer, Args) -> Fun = fun() -> - exit(remote_type_postproc(TmpCServer, Args)) + exit(try remote_type_postproc(TmpCServer, Args) of + R -> R + catch + throw:{error,_}=Error -> Error + end) end, {Pid, Ref} = erlang:spawn_monitor(Fun), dialyzer_codeserver:give_away(TmpCServer, Pid), diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl index 0617be6435..1e06d6e974 100644 --- a/lib/dialyzer/src/dialyzer_cl.erl +++ b/lib/dialyzer/src/dialyzer_cl.erl @@ -672,7 +672,7 @@ failed_anal_msg(Reason, LogCache) -> %% format_log_cache(LogCache) -> Str = lists:append(lists:reverse(LogCache)), - string:join(string:tokens(Str, "\n"), "\n "). + lists:join("\n ", string:lexemes(Str, "\n")). -spec store_warnings(#cl_state{}, [raw_warning()]) -> #cl_state{}. diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 8367432ac5..93cfea3c5e 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -299,6 +299,7 @@ traverse(Tree, Map, State) -> match_fail -> t_none(); raise -> t_none(); bs_init_writable -> t_from_term(<<>>); + build_stacktrace -> t_list(); Other -> erlang:error({'Unsupported primop', Other}) end, {State, Map, Type}; diff --git a/lib/dialyzer/src/dialyzer_gui_wx.erl b/lib/dialyzer/src/dialyzer_gui_wx.erl index b4b1872c12..b8414b7d8b 100644 --- a/lib/dialyzer/src/dialyzer_gui_wx.erl +++ b/lib/dialyzer/src/dialyzer_gui_wx.erl @@ -475,7 +475,7 @@ gui_loop(#gui_state{backend_pid = BackendPid, doc_plt = DocPlt, gui_loop(State); {BackendPid, ext_types, ExtTypes} -> Map = fun({M,F,A}) -> io_lib:format("~tp:~tp/~p",[M,F,A]) end, - ExtTypeString = string:join(lists:map(Map, ExtTypes), "\n"), + ExtTypeString = lists:join("\n", lists:map(Map, ExtTypes)), Msg = io_lib:format("The following remote types are being used " "but information about them is not available.\n" "The analysis might get more precise by including " @@ -638,7 +638,7 @@ output_sms(#gui_state{frame = Frame}, Title, Message, Type) -> free_editor(#gui_state{gui = Wx, frame = Frame}, Title, Contents0) -> Contents = lists:flatten(Contents0), - Tokens = string:tokens(Contents, "\n"), + Tokens = string:lexemes(Contents, "\n"), NofLines = length(Tokens), LongestLine = lists:max([length(X) || X <- Tokens]), Height0 = NofLines * 25 + 80, diff --git a/lib/dialyzer/src/dialyzer_races.erl b/lib/dialyzer/src/dialyzer_races.erl index 7fe64c3e11..7602faa21d 100644 --- a/lib/dialyzer/src/dialyzer_races.erl +++ b/lib/dialyzer/src/dialyzer_races.erl @@ -1270,8 +1270,8 @@ filter_named_tables(NamesList) -> [] -> []; [Head|Tail] -> NewHead = - case string:rstr(Head, "()") of - 0 -> [Head]; + case string:find(Head, "()", trailing) of + nomatch -> [Head]; _Other -> [] end, NewHead ++ filter_named_tables(Tail) @@ -1558,8 +1558,8 @@ any_args(StrList) -> case StrList of [] -> false; [Head|Tail] -> - case string:rstr(Head, "()") of - 0 -> any_args(Tail); + case string:find(Head, "()", trailing) of + nomatch -> any_args(Tail); _Other -> true end end. @@ -1765,10 +1765,8 @@ ets_list_args(MaybeList) -> end. ets_list_argtypes(ListStr) -> - ListStr1 = string:strip(ListStr, left, $[), - ListStr2 = string:strip(ListStr1, right, $]), - ListStr3 = string:strip(ListStr2, right, $.), - string:strip(ListStr3, right, $,). + ListStr1 = string:trim(ListStr, leading, "$["), + string:trim(ListStr1, trailing, "$]$.$,"). ets_tuple_args(MaybeTuple) -> case is_tuple(MaybeTuple) of @@ -1810,7 +1808,7 @@ ets_tuple_argtypes2_helper(TupleStr, ElemStr, NestingLevel) -> {[H|ElemStr], NestingLevel, false} end, case Return of - true -> string:tokens(NewElemStr, " |"); + true -> string:lexemes(NewElemStr, " |"); false -> ets_tuple_argtypes2_helper(T, NewElemStr, NewNestingLevel) end @@ -1889,44 +1887,44 @@ format_args_2(StrArgList, Call) -> case Call of whereis -> lists_key_replace(2, StrArgList, - string:tokens(lists:nth(2, StrArgList), " |")); + string:lexemes(lists:nth(2, StrArgList), " |")); register -> lists_key_replace(2, StrArgList, - string:tokens(lists:nth(2, StrArgList), " |")); + string:lexemes(lists:nth(2, StrArgList), " |")); unregister -> lists_key_replace(2, StrArgList, - string:tokens(lists:nth(2, StrArgList), " |")); + string:lexemes(lists:nth(2, StrArgList), " |")); ets_new -> StrArgList1 = lists_key_replace(2, StrArgList, - string:tokens(lists:nth(2, StrArgList), " |")), + string:lexemes(lists:nth(2, StrArgList), " |")), lists_key_replace(4, StrArgList1, - string:tokens(ets_list_argtypes(lists:nth(4, StrArgList1)), " |")); + string:lexemes(ets_list_argtypes(lists:nth(4, StrArgList1)), " |")); ets_lookup -> StrArgList1 = lists_key_replace(2, StrArgList, - string:tokens(lists:nth(2, StrArgList), " |")), + string:lexemes(lists:nth(2, StrArgList), " |")), lists_key_replace(4, StrArgList1, - string:tokens(lists:nth(4, StrArgList1), " |")); + string:lexemes(lists:nth(4, StrArgList1), " |")); ets_insert -> StrArgList1 = lists_key_replace(2, StrArgList, - string:tokens(lists:nth(2, StrArgList), " |")), + string:lexemes(lists:nth(2, StrArgList), " |")), lists_key_replace(4, StrArgList1, ets_tuple_argtypes2( ets_tuple_argtypes1(lists:nth(4, StrArgList1), [], [], 0), [])); mnesia_dirty_read1 -> lists_key_replace(2, StrArgList, - [mnesia_tuple_argtypes(T) || T <- string:tokens( + [mnesia_tuple_argtypes(T) || T <- string:lexemes( lists:nth(2, StrArgList), " |")]); mnesia_dirty_read2 -> lists_key_replace(2, StrArgList, - string:tokens(lists:nth(2, StrArgList), " |")); + string:lexemes(lists:nth(2, StrArgList), " |")); mnesia_dirty_write1 -> lists_key_replace(2, StrArgList, - [mnesia_record_tab(R) || R <- string:tokens( + [mnesia_record_tab(R) || R <- string:lexemes( lists:nth(2, StrArgList), " |")]); mnesia_dirty_write2 -> lists_key_replace(2, StrArgList, - string:tokens(lists:nth(2, StrArgList), " |")); + string:lexemes(lists:nth(2, StrArgList), " |")); function_call -> StrArgList end. @@ -1943,18 +1941,16 @@ format_type(Type, State) -> erl_types:t_to_string(Type, R). mnesia_record_tab(RecordStr) -> - case string:str(RecordStr, "#") =:= 1 of - true -> - "'" ++ - string:sub_string(RecordStr, 2, string:str(RecordStr, "{") - 1) ++ - "'"; - false -> RecordStr + case erl_scan:string(RecordStr) of + {ok, [{'#', _}, {atom, _, Name}|_], _} -> + io_lib:write_string(atom_to_list(Name), $'); + _ -> RecordStr end. mnesia_tuple_argtypes(TupleStr) -> - TupleStr1 = string:strip(TupleStr, left, ${), - [TupleStr2|_T] = string:tokens(TupleStr1, " ,"), - lists:flatten(string:tokens(TupleStr2, " |")). + TupleStr1 = string:trim(TupleStr, leading, "${"), + [TupleStr2|_T] = string:lexemes(TupleStr1, " ,"), + lists:flatten(string:lexemes(TupleStr2, " |")). -spec race_var_map(var_to_map1(), var_to_map2(), dict:dict(), op()) -> dict:dict(). @@ -2237,7 +2233,7 @@ var_type_analysis(FunDefArgs, FunCallTypes, WarnVarArgs, RaceWarnTag, case lists_key_member_lists(Vars, FunVarArgs) of 0 -> [Vars, WVA2, WVA3, WVA4]; N when is_integer(N) -> - NewWVA2 = string:tokens(lists:nth(N + 1, FunVarArgs), " |"), + NewWVA2 = string:lexemes(lists:nth(N + 1, FunVarArgs), " |"), [Vars, NewWVA2, WVA3, WVA4] end; ?WARN_WHEREIS_UNREGISTER -> @@ -2246,7 +2242,7 @@ var_type_analysis(FunDefArgs, FunCallTypes, WarnVarArgs, RaceWarnTag, case lists_key_member_lists(Vars, FunVarArgs) of 0 -> [Vars, WVA2]; N when is_integer(N) -> - NewWVA2 = string:tokens(lists:nth(N + 1, FunVarArgs), " |"), + NewWVA2 = string:lexemes(lists:nth(N + 1, FunVarArgs), " |"), [Vars, NewWVA2] end; ?WARN_ETS_LOOKUP_INSERT -> @@ -2256,7 +2252,7 @@ var_type_analysis(FunDefArgs, FunCallTypes, WarnVarArgs, RaceWarnTag, case lists_key_member_lists(Vars1, FunVarArgs) of 0 -> [Vars1, WVA2]; N1 when is_integer(N1) -> - NewWVA2 = string:tokens(lists:nth(N1 + 1, FunVarArgs), " |"), + NewWVA2 = string:lexemes(lists:nth(N1 + 1, FunVarArgs), " |"), [Vars1, NewWVA2] end, Vars2 = @@ -2286,10 +2282,10 @@ var_type_analysis(FunDefArgs, FunCallTypes, WarnVarArgs, RaceWarnTag, NewWVA2 = case Arity of 1 -> - [mnesia_record_tab(R) || R <- string:tokens( + [mnesia_record_tab(R) || R <- string:lexemes( lists:nth(2, FunVarArgs), " |")]; 2 -> - string:tokens(lists:nth(N + 1, FunVarArgs), " |") + string:lexemes(lists:nth(N + 1, FunVarArgs), " |") end, [Vars, NewWVA2|T] end diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index c4d8f45447..b1f6a54503 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -41,7 +41,7 @@ t_is_float/1, t_is_fun/1, t_is_integer/1, t_non_neg_integer/0, t_is_list/1, t_is_nil/1, t_is_none/1, t_is_number/1, - t_is_singleton/1, + t_is_singleton/1, t_is_none_or_unit/1, t_limit/2, t_list/0, t_list/1, t_list_elements/1, t_nonempty_list/1, t_maybe_improper_list/0, @@ -418,6 +418,7 @@ traverse(Tree, DefinedVars, State) -> match_fail -> throw(error); raise -> throw(error); bs_init_writable -> {State, t_from_term(<<>>)}; + build_stacktrace -> {State, t_list()}; Other -> erlang:error({'Unsupported primop', Other}) end; 'receive' -> @@ -528,13 +529,14 @@ traverse(Tree, DefinedVars, State) -> false -> t_any(); true -> MT = t_inf(lookup_type(MapVar, Map), t_map()), - case t_is_none(MT) of + case t_is_none_or_unit(MT) of true -> t_none(); false -> DisjointFromKeyType = fun(ShadowKey) -> - t_is_none(t_inf(lookup_type(ShadowKey, Map), - KeyType)) + ST = t_inf(lookup_type(ShadowKey, Map), + KeyType), + t_is_none_or_unit(ST) end, case lists:all(DisjointFromKeyType, ShadowKeys) of true -> t_map_get(KeyType, MT); @@ -567,7 +569,8 @@ traverse(Tree, DefinedVars, State) -> case cerl:is_literal(OpTree) andalso cerl:concrete(OpTree) =:= exact of true -> - case t_is_none(t_inf(ShadowedKeys, KeyType)) of + ST = t_inf(ShadowedKeys, KeyType), + case t_is_none_or_unit(ST) of true -> t_map_put({KeyType, t_any()}, AccType); false -> diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index 9b8fbc67eb..abd89034f3 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -120,92 +120,10 @@ get_core_from_beam(File, Opts) -> {error, " Could not get Core Erlang code for: " ++ File ++ "\n"} end; _ -> - deprecated_get_core_from_beam(File, Opts) + {error, " Could not get Core Erlang code for: " ++ File ++ "\n" ++ + " Recompile with +debug_info or analyze starting from source code"} end. -deprecated_get_core_from_beam(File, Opts) -> - case get_abstract_code_from_beam(File) of - error -> - {error, " Could not get abstract code for: " ++ File ++ "\n" ++ - " Recompile with +debug_info or analyze starting from source code"}; - {ok, AbstrCode} -> - case get_compile_options_from_beam(File) of - error -> - {error, " Could not get compile options for: " ++ File ++ "\n" ++ - " Recompile or analyze starting from source code"}; - {ok, CompOpts} -> - case get_core_from_abstract_code(AbstrCode, Opts ++ CompOpts) of - error -> - {error, " Could not get core Erlang code for: " ++ File}; - {ok, _} = Core -> - Core - end - end - end. - -get_abstract_code_from_beam(File) -> - case beam_lib:chunks(File, [abstract_code]) of - {ok, {_, List}} -> - case lists:keyfind(abstract_code, 1, List) of - {abstract_code, {raw_abstract_v1, Abstr}} -> {ok, Abstr}; - _ -> error - end; - _ -> - %% No or unsuitable abstract code. - error - end. - -get_compile_options_from_beam(File) -> - case beam_lib:chunks(File, [compile_info]) of - {ok, {_, List}} -> - case lists:keyfind(compile_info, 1, List) of - {compile_info, CompInfo} -> compile_info_to_options(CompInfo); - _ -> error - end; - _ -> - %% No or unsuitable compile info. - error - end. - -compile_info_to_options(CompInfo) -> - case lists:keyfind(options, 1, CompInfo) of - {options, CompOpts} -> {ok, CompOpts}; - _ -> error - end. - -get_core_from_abstract_code(AbstrCode, Opts) -> - %% We do not want the parse_transforms around since we already - %% performed them. In some cases we end up in trouble when - %% performing them again. - AbstrCode1 = cleanup_parse_transforms(AbstrCode), - %% Remove parse_transforms (and other options) from compile options. - Opts2 = cleanup_compile_options(Opts), - try compile:noenv_forms(AbstrCode1, Opts2 ++ src_compiler_opts()) of - {ok, _, Core} -> {ok, Core}; - _What -> error - catch - error:_ -> error - end. - -cleanup_parse_transforms([{attribute, _, compile, {parse_transform, _}}|Left]) -> - cleanup_parse_transforms(Left); -cleanup_parse_transforms([Other|Left]) -> - [Other|cleanup_parse_transforms(Left)]; -cleanup_parse_transforms([]) -> - []. - -cleanup_compile_options(Opts) -> - lists:filter(fun keep_compile_option/1, Opts). - -%% Using abstract, not asm or core. -keep_compile_option(from_asm) -> false; -keep_compile_option(from_core) -> false; -%% The parse transform will already have been applied, may cause -%% problems if it is re-applied. -keep_compile_option({parse_transform, _}) -> false; -keep_compile_option(warnings_as_errors) -> false; -keep_compile_option(_) -> true. - %% ============================================================================ %% %% Typed Records diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_incorrect_args b/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_incorrect_args index 1eb8cd455b..1be0ce0d8c 100644 --- a/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_incorrect_args +++ b/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_incorrect_args @@ -1,5 +1,5 @@ gen_server_incorrect_args.erl:3: Undefined callback function handle_cast/2 (behaviour gen_server) gen_server_incorrect_args.erl:3: Undefined callback function init/1 (behaviour gen_server) -gen_server_incorrect_args.erl:7: The inferred return type of handle_call/3 ({'no'} | {'ok'}) has nothing in common with {'noreply',_} | {'noreply',_,'hibernate' | 'infinity' | non_neg_integer()} | {'reply',_,_} | {'stop',_,_} | {'reply',_,_,'hibernate' | 'infinity' | non_neg_integer()} | {'stop',_,_,_}, which is the expected return type for the callback of the gen_server behaviour +gen_server_incorrect_args.erl:7: The inferred return type of handle_call/3 ({'no'} | {'ok'}) has nothing in common with {'noreply',_} | {'noreply',_,'hibernate' | 'infinity' | non_neg_integer() | {'continue',_}} | {'reply',_,_} | {'stop',_,_} | {'reply',_,_,'hibernate' | 'infinity' | non_neg_integer() | {'continue',_}} | {'stop',_,_,_}, which is the expected return type for the callback of the gen_server behaviour gen_server_incorrect_args.erl:7: The inferred type for the 2nd argument of handle_call/3 ('boo' | 'foo') is not a supertype of {pid(),_}, which is expected type for this argument in the callback of the gen_server behaviour diff --git a/lib/dialyzer/test/dialyzer_common.erl b/lib/dialyzer/test/dialyzer_common.erl index 48083a2731..1a8403f486 100644 --- a/lib/dialyzer/test/dialyzer_common.erl +++ b/lib/dialyzer/test/dialyzer_common.erl @@ -221,13 +221,9 @@ get_suites(Dir) -> end. suffix(String, Suffix) -> - case string:rstr(String, Suffix) of - 0 -> no; - Index -> - case string:substr(String, Index) =:= Suffix of - true -> {yes, string:sub_string(String,1,Index-1)}; - false -> no - end + case string:split(String, Suffix, trailing) of + [Prefix,[]] -> {yes, Prefix}; + _ -> no end. -spec create_suite(string()) -> 'ok'. diff --git a/lib/dialyzer/test/map_SUITE_data/results/map_anon_fun b/lib/dialyzer/test/map_SUITE_data/results/map_anon_fun new file mode 100644 index 0000000000..cfca5b1407 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/map_anon_fun @@ -0,0 +1,2 @@ + +map_anon_fun.erl:4: Function g/1 will never be called diff --git a/lib/dialyzer/test/map_SUITE_data/src/map_anon_fun.erl b/lib/dialyzer/test/map_SUITE_data/src/map_anon_fun.erl new file mode 100644 index 0000000000..e77016d68a --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/map_anon_fun.erl @@ -0,0 +1,9 @@ +-module(map_anon_fun). + +%% Not exported. +g(A) -> + maps:map(fun F(K, {V, _C}) -> + F(K, V); + F(_K, _V) -> + #{ system => {A} } + end, #{}). diff --git a/lib/dialyzer/test/plt_SUITE.erl b/lib/dialyzer/test/plt_SUITE.erl index ebe79b2a6d..680f5b5088 100644 --- a/lib/dialyzer/test/plt_SUITE.erl +++ b/lib/dialyzer/test/plt_SUITE.erl @@ -9,14 +9,14 @@ -export([suite/0, all/0, build_plt/1, beam_tests/1, update_plt/1, local_fun_same_as_callback/1, remove_plt/1, run_plt_check/1, run_succ_typings/1, - bad_dialyzer_attr/1, merge_plts/1]). + bad_dialyzer_attr/1, merge_plts/1, bad_record_type/1]). suite() -> [{timetrap, ?plt_timeout}]. all() -> [build_plt, beam_tests, update_plt, run_plt_check, remove_plt, run_succ_typings, local_fun_same_as_callback, - bad_dialyzer_attr, merge_plts]. + bad_dialyzer_attr, merge_plts, bad_record_type]. build_plt(Config) -> OutDir = ?config(priv_dir, Config), @@ -283,8 +283,8 @@ bad_dialyzer_attr(Config) -> {dialyzer_error, "Analysis failed with error:\n" ++ Str1} = (catch dialyzer:run(Opts)), - P1 = string:str(Str1, "dial.erl:2: function undef/0 undefined"), - true = P1 > 0, + S1 = string:find(Str1, "dial.erl:2: function undef/0 undefined"), + true = is_list(S1), Prog2 = <<"-module(dial). -dialyzer({no_return, [{undef,1,2}]}).">>, @@ -292,9 +292,9 @@ bad_dialyzer_attr(Config) -> {dialyzer_error, "Analysis failed with error:\n" ++ Str2} = (catch dialyzer:run(Opts)), - P2 = string:str(Str2, "dial.erl:2: badly formed dialyzer " - "attribute: {no_return,{undef,1,2}}"), - true = P2 > 0, + S2 = string:find(Str2, "dial.erl:2: badly formed dialyzer " + "attribute: {no_return,{undef,1,2}}"), + true = is_list(S2), ok. @@ -369,6 +369,32 @@ create_plts(Mod1, Mod2, Config) -> %% End of merge_plts(). +bad_record_type(Config) -> + PrivDir = ?config(priv_dir, Config), + Source = lists:concat([bad_record_type, ".erl"]), + Filename = filename:join(PrivDir, Source), + PltFilename = dialyzer_common:plt_file(PrivDir), + + Opts = [{files, [Filename]}, + {check_plt, false}, + {from, src_code}, + {init_plt, PltFilename}], + + Prog = <<"-module(bad_record_type). + -export([r/0]). + -record(r, {f = 3 :: integer()}). + -spec r() -> #r{f :: atom()}. + r() -> + #r{}.">>, + ok = file:write_file(Filename, Prog), + {dialyzer_error, + "Analysis failed with error:\n" ++ Str} = + (catch dialyzer:run(Opts)), + P = string:str(Str, + "bad_record_type.erl:4: Illegal declaration of #r{f}"), + true = P > 0, + ok. + erlang_beam() -> case code:where_is_file("erlang.beam") of non_existing -> diff --git a/lib/dialyzer/test/small_SUITE_data/results/maps_sum b/lib/dialyzer/test/small_SUITE_data/results/maps_sum index bd192bdb93..b29ac77d88 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/maps_sum +++ b/lib/dialyzer/test/small_SUITE_data/results/maps_sum @@ -1,4 +1,4 @@ -maps_sum.erl:15: Invalid type specification for function maps_sum:wrong1/1. The success typing is (map()) -> any() +maps_sum.erl:15: Invalid type specification for function maps_sum:wrong1/1. The success typing is (maps:iterator() | map()) -> any() maps_sum.erl:26: Function wrong2/1 has no local return maps_sum.erl:27: The call lists:foldl(fun((_,_,_) -> any()),0,Data::any()) will never return since it differs in the 1st argument from the success typing arguments: (fun((_,_) -> any()),any(),[any()]) diff --git a/lib/dialyzer/vsn.mk b/lib/dialyzer/vsn.mk index d130b14fec..1b46f66602 100644 --- a/lib/dialyzer/vsn.mk +++ b/lib/dialyzer/vsn.mk @@ -1 +1 @@ -DIALYZER_VSN = 3.2.2 +DIALYZER_VSN = 3.2.3 diff --git a/lib/diameter/doc/src/notes.xml b/lib/diameter/doc/src/notes.xml index eded788419..ba4525fd20 100644 --- a/lib/diameter/doc/src/notes.xml +++ b/lib/diameter/doc/src/notes.xml @@ -43,6 +43,22 @@ first.</p> <!-- ===================================================================== --> +<section><title>diameter 2.1.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix documentation typo: peer_down/3 was written where + peer_down/3 was intended.</p> + <p> + Own Id: OTP-14805</p> + </item> + </list> + </section> + +</section> + <section><title>diameter 2.1.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/diameter/doc/src/seealso.ent b/lib/diameter/doc/src/seealso.ent index c5a53670d0..72d74c103c 100644 --- a/lib/diameter/doc/src/seealso.ent +++ b/lib/diameter/doc/src/seealso.ent @@ -79,7 +79,7 @@ significant. <!ENTITY app_handle_answer '<seealso marker="diameter_app#Mod:handle_answer-4">handle_answer/4</seealso>'> <!ENTITY app_handle_request '<seealso marker="diameter_app#Mod:handle_request-3">handle_request/3</seealso>'> <!ENTITY app_handle_error '<seealso marker="diameter_app#Mod:handle_error-4">handle_error/4</seealso>'> -<!ENTITY app_peer_down '<seealso marker="diameter_app#Mod:peer_down-3">peer_up/3</seealso>'> +<!ENTITY app_peer_down '<seealso marker="diameter_app#Mod:peer_down-3">peer_down/3</seealso>'> <!ENTITY app_peer_up '<seealso marker="diameter_app#Mod:peer_up-3">peer_up/3</seealso>'> <!ENTITY app_pick_peer '<seealso marker="diameter_app#Mod:pick_peer-4">pick_peer/4</seealso>'> <!ENTITY app_prepare_retransmit '<seealso marker="diameter_app#Mod:prepare_retransmit-3">prepare_retransmit/3</seealso>'> diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src index d0e58e8410..7da59f8b25 100644 --- a/lib/diameter/src/diameter.appup.src +++ b/lib/diameter/src/diameter.appup.src @@ -56,7 +56,8 @@ {"2.0", [{restart_application, diameter}]}, %% 20.0 {"2.1", [{load_module, diameter_gen}, %% 20.1 {update, diameter_reg, {advanced, "2.1"}}]}, - {"2.1.1", [{load_module, diameter_gen}]} + {"2.1.1", [{load_module, diameter_gen}]}, %% 20.1.2 + {"2.1.2", []} %% 20.1.3 ], [ {"0.9", [{restart_application, diameter}]}, @@ -93,6 +94,7 @@ {"1.12.2", [{restart_application, diameter}]}, {"2.0", [{restart_application, diameter}]}, {"2.1", [{restart_application, diameter}]}, - {"2.1.1", [{load_module, diameter_gen}]} + {"2.1.1", [{load_module, diameter_gen}]}, + {"2.1.2", []} ] }. diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk index bfb260ed8f..0c852d75cd 100644 --- a/lib/diameter/vsn.mk +++ b/lib/diameter/vsn.mk @@ -17,5 +17,5 @@ # %CopyrightEnd% APPLICATION = diameter -DIAMETER_VSN = 2.1.2 +DIAMETER_VSN = 2.1.3 APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN) diff --git a/lib/edoc/doc/src/Makefile b/lib/edoc/doc/src/Makefile index ce7945a1bb..ca9ea66e3c 100644 --- a/lib/edoc/doc/src/Makefile +++ b/lib/edoc/doc/src/Makefile @@ -9,11 +9,11 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. -# +# # The Initial Developer of the Original Code is Ericsson Utvecklings AB. # Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings # AB. All Rights Reserved.'' -# +# include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk @@ -47,7 +47,7 @@ XML_REF3_FILES = \ edoc_lib.xml \ edoc_run.xml -XML_PART_FILES = part.xml part_notes.xml +XML_PART_FILES = part.xml XML_CHAPTER_FILES = chapter.xml XML_NOTES_FILES = notes.xml @@ -80,10 +80,10 @@ TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += +XML_FLAGS += +DVIPS_FLAGS += # ---------------------------------------------------- # Targets @@ -109,19 +109,19 @@ $(XML_CHAPTER_FILES): ../overview.edoc gifs: $(GIF_FILES:%=$(HTMLDIR)/%) -debug opt: +debug opt: clean clean_docs: rm -rf $(HTMLDIR)/* rm -f $(MAN3DIR)/* rm -f $(XML_REF3_FILES) $(XML_CHAPTER_FILES) *.html rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ + rm -f errs core *~ # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs diff --git a/lib/edoc/doc/src/fascicules.xml b/lib/edoc/doc/src/fascicules.xml deleted file mode 100644 index 154c8a3b6d..0000000000 --- a/lib/edoc/doc/src/fascicules.xml +++ /dev/null @@ -1,15 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> -</fascicules> - diff --git a/lib/edoc/doc/src/notes.xml b/lib/edoc/doc/src/notes.xml index 96d7597d83..240789e876 100644 --- a/lib/edoc/doc/src/notes.xml +++ b/lib/edoc/doc/src/notes.xml @@ -32,6 +32,21 @@ <p>This document describes the changes made to the EDoc application.</p> +<section><title>Edoc 0.9.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> The map type is correctly denoted as <c>map()</c> in + function specifications and types. </p> + <p> + Own Id: OTP-14777</p> + </item> + </list> + </section> + +</section> + <section><title>Edoc 0.9.1</title> <section><title>Improvements and New Features</title> diff --git a/lib/edoc/doc/src/part_notes.xml b/lib/edoc/doc/src/part_notes.xml deleted file mode 100644 index 6a79435ff0..0000000000 --- a/lib/edoc/doc/src/part_notes.xml +++ /dev/null @@ -1,39 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2007</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>EDoc Release Notes</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p><em>EDoc</em> is the Erlang program documentation generator. - Inspired by the Javadoc (TM) tool for the Java (TM) programming - language, EDoc is adapted to the conventions of the Erlang world, - and has several features not found in Javadoc.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/edoc/priv/Makefile b/lib/edoc/priv/Makefile index 9873136201..45bff37b39 100644 --- a/lib/edoc/priv/Makefile +++ b/lib/edoc/priv/Makefile @@ -1,6 +1,6 @@ # # Copyright (C) 2004, Ericsson Telecommunications -# Author: Richard Carlsson, Bertil Karlsson +# Author: Richard Carlsson, Bertil Karlsson # include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk @@ -9,9 +9,6 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk # Application version # ---------------------------------------------------- include ../vsn.mk -include ../../xmerl/vsn.mk -include ../../syntax_tools/vsn.mk - # ---------------------------------------------------- # Release directory specification @@ -23,21 +20,12 @@ RELSYSDIR = $(RELEASE_PATH)/lib/edoc-$(EDOC_VSN) # Common Macros # -GEN_SCRIPT_SRC = edoc_generate.src GEN_SCRIPT = edoc_generate PRIV_FILES = stylesheet.css erlang.png edoc.dtd -debug opt: $(GEN_SCRIPT) - -$(GEN_SCRIPT): ../vsn.mk ../../xmerl/vsn.mk ../../syntax_tools/vsn.mk \ - $(GEN_SCRIPT_SRC) - $(vsn_verbose)sed -e "s/%EDOC_VSN%/$(EDOC_VSN)/g" \ - -e "s/%XMERL_VSN%/$(XMERL_VSN)/g" \ - -e "s/%SYNTAX_TOOLS_VSN%/$(SYNTAX_TOOLS_VSN)/g" \ - $(GEN_SCRIPT_SRC) > $(GEN_SCRIPT) +debug opt: clean: - rm -f $(GEN_SCRIPT) rm -f core *~ docs: @@ -54,4 +42,3 @@ release_spec: opt release_docs_spec: - diff --git a/lib/edoc/priv/edoc_generate.src b/lib/edoc/priv/edoc_generate index eeaa20f959..0492623c7f 100644 --- a/lib/edoc/priv/edoc_generate.src +++ b/lib/edoc/priv/edoc_generate @@ -10,28 +10,18 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. -# +# # The Initial Developer of the Original Code is Ericsson Utvecklings AB. -# Portions created by Ericsson are Copyright 1999-2000, Ericsson +# Portions created by Ericsson are Copyright 1999-2000, Ericsson # Utvecklings AB. All Rights Reserved.'' -# - -#EDOC_DIR=/clearcase/otp/internal_tools/edoc -EDOC_DIR=/home/otp/sgml/edoc-%EDOC_VSN% -SYNTAX_TOOLS_DIR=/home/otp/sgml/syntax_tools-%SYNTAX_TOOLS_VSN% -XMERL_DIR=/home/otp/sgml/xmerl-%XMERL_VSN% +# -FILE= APP= TITLE= VSN= while [ $# -gt 0 ]; do case $1 in - -file) - FILE=$2; - shift; - shift;; -app) APP=$2; shift; @@ -47,28 +37,14 @@ while [ $# -gt 0 ]; do esac done -if [ -n "$FILE" ] ; then - EDOC_ARGS="[{layout,otpsgml_layout},{dir,\".\"},{file_suffix,\".sgml\"},{preprocess,true},{includes,[\"$XMERL_DIR/include\"]}]" - erl -boot start_clean -noshell \ - -pa $EDOC_DIR/ebin \ - -pa $SYNTAX_TOOLS_DIR/ebin \ - -pa $XMERL_DIR/ebin \ - -run edoc_run file $FILE $EDOC_ARGS \ - -s erlang halt -elif [ -n "$APP" -a -n "$TITLE" ] ; then +if [ -n "$APP" -a -n "$TITLE" ] ; then erl -boot start_clean -noshell \ - -pa $EDOC_DIR/ebin \ - -pa $SYNTAX_TOOLS_DIR/ebin \ - -pa $XMERL_DIR/ebin \ -run edoc_run application $APP "\".\"" "[{title,$TITLE}]" \ -s erlang halt -elif [ -n "$APP" -a -n "$VSN" ] ; then +elif [ -n "$APP" -a -n "$VSN" ] ; then erl -boot start_clean -noshell \ - -pa $EDOC_DIR/ebin \ - -pa $SYNTAX_TOOLS_DIR/ebin \ - -pa $XMERL_DIR/ebin \ -run edoc_run application $APP "\".\"" "[{def,{vsn,\"$VSN\"}}]" \ -s erlang halt else - echo "Usage: docb_edoc [-file Filename] | [-app Appname [-title Title |-vsn Vsn]]" + echo "Usage: edoc_generate [-app Appname [-title Title |-vsn Vsn]]" fi diff --git a/lib/edoc/src/Makefile b/lib/edoc/src/Makefile index 4e5a4182da..ea2f45dc4c 100644 --- a/lib/edoc/src/Makefile +++ b/lib/edoc/src/Makefile @@ -29,8 +29,7 @@ SOURCES= \ edoc.erl edoc_data.erl edoc_doclet.erl edoc_extract.erl \ edoc_layout.erl edoc_lib.erl edoc_macros.erl edoc_parser.erl \ edoc_refs.erl edoc_report.erl edoc_run.erl edoc_scanner.erl \ - edoc_specs.erl edoc_tags.erl edoc_types.erl edoc_wiki.erl \ - otpsgml_layout.erl + edoc_specs.erl edoc_tags.erl edoc_types.erl edoc_wiki.erl OBJECTS=$(SOURCES:%.erl=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET) diff --git a/lib/edoc/src/edoc.app.src b/lib/edoc/src/edoc.app.src index e4b9040c78..43343e2ae8 100644 --- a/lib/edoc/src/edoc.app.src +++ b/lib/edoc/src/edoc.app.src @@ -18,8 +18,7 @@ edoc_specs, edoc_tags, edoc_types, - edoc_wiki, - otpsgml_layout]}, + edoc_wiki]}, {registered,[]}, {applications, [compiler,kernel,stdlib,syntax_tools]}, {env, []}, diff --git a/lib/edoc/src/edoc_layout.erl b/lib/edoc/src/edoc_layout.erl index eafab0588e..baa147410b 100644 --- a/lib/edoc/src/edoc_layout.erl +++ b/lib/edoc/src/edoc_layout.erl @@ -608,7 +608,7 @@ etypef([Cs | L], St, O, R, Opts) -> app_fix(L, Opts) -> try {"//" ++ R1,L2} = app_fix1(L, 1), - [App, Mod] = string:tokens(R1, "/"), + [App, Mod] = string:lexemes(R1, "/"), "//" ++ atom(App, Opts) ++ "/" ++ atom(Mod, Opts) ++ L2 catch _:_ -> L end. @@ -1120,13 +1120,13 @@ ot_integer(E) -> {integer,0,list_to_integer(get_attrval(value, E))}. ot_range(E) -> - [I1, I2] = string:tokens(get_attrval(value, E), "."), + [I1, I2] = string:lexemes(get_attrval(value, E), "."), {type,0,range,[{integer,0,list_to_integer(I1)}, {integer,0,list_to_integer(I2)}]}. ot_binary(E) -> {Base, Unit} = - case string:tokens(get_attrval(value, E), ",:*><") of + case string:lexemes(get_attrval(value, E), ",:*><") of [] -> {0, 0}; ["_",B] -> diff --git a/lib/edoc/src/edoc_specs.erl b/lib/edoc/src/edoc_specs.erl index fb04bfce0e..7b451c43f8 100644 --- a/lib/edoc/src/edoc_specs.erl +++ b/lib/edoc/src/edoc_specs.erl @@ -83,7 +83,7 @@ spec(Form, Clause) -> %% the given Erlang spec and an empty list of arguments. dummy_spec(Form) -> {#t_name{name = Name}, Arity, TypeSpecs} = get_spec(Form), - As = string:join(lists:duplicate(Arity, "_X"), ","), + As = lists:join(",", lists:duplicate(Arity, "_X")), S = lists:flatten(io_lib:format("~p(~s) -> true\n", [Name, As])), #tag{name = spec, line = get_line(element(2, hd(TypeSpecs))), origin = code, data = S}. @@ -372,7 +372,7 @@ d2e({type,_,binary,[Base,Unit]}, _Prec) -> {integer,_,U} = erl_eval:partial_eval(Unit), #t_binary{base_size = B, unit_size = U}; d2e({type,_,map,any}, _Prec) -> - #t_map{types = []}; + #t_type{name = #t_name{name = map}, args = []}; d2e({type,_,map,Es}, _Prec) -> #t_map{types = d2e(Es) }; d2e({type,_,map_field_assoc,[K,V]}, Prec) -> diff --git a/lib/edoc/src/otpsgml_layout.erl b/lib/edoc/src/otpsgml_layout.erl deleted file mode 100644 index 295daed551..0000000000 --- a/lib/edoc/src/otpsgml_layout.erl +++ /dev/null @@ -1,836 +0,0 @@ -%% ===================================================================== -%% Licensed under the Apache License, Version 2.0 (the "License"); you may -%% not use this file except in compliance with the License. You may obtain -%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0> -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% Alternatively, you may use this file under the terms of the GNU Lesser -%% General Public License (the "LGPL") as published by the Free Software -%% Foundation; either version 2.1, or (at your option) any later version. -%% If you wish to allow use of your version of this file only under the -%% terms of the LGPL, you should delete the provisions above and replace -%% them with the notice and other provisions required by the LGPL; see -%% <http://www.gnu.org/licenses/>. If you do not delete the provisions -%% above, a recipient may use your version of this file under the terms of -%% either the Apache License or the LGPL. -%% -%% @author Richard Carlsson <[email protected]> -%% @author Kenneth Lundin <[email protected]> -%% @copyright 2001-2004 Richard Carlsson -%% @see edoc_layout -%% @end -%% ===================================================================== - -%% @doc The OTP SGML layout module for EDoc. See the module {@link edoc} -%% for details on usage. - -%% Note that this is written so that it is *not* depending on edoc.hrl! - --module(otpsgml_layout). - --export([module/2, overview/2,type/1]). - --import(edoc_report, [report/2]). - --include_lib("xmerl/include/xmerl.hrl"). - --define(SGML_EXPORT, xmerl_otpsgml). --define(DEFAULT_XML_EXPORT, ?SGML_EXPORT). --define(STYLESHEET, "stylesheet.css"). --define(NL, "\n"). --define(DESCRIPTION_TITLE, "Description"). --define(DESCRIPTION_LABEL, "description"). --define(DATA_TYPES_TITLE, "Data Types"). --define(DATA_TYPES_LABEL, "types"). --define(FUNCTION_INDEX_TITLE, "Function Index"). --define(FUNCTION_INDEX_LABEL, "index"). --define(FUNCTIONS_TITLE, "Function Details"). --define(FUNCTIONS_LABEL, "functions"). - - -%% @doc The layout function. -%% -%% Options: -%% <dl> -%% <dt>{@type {index_columns, integer()@}} -%% </dt> -%% <dd>Specifies the number of column pairs used for the function -%% index tables. The default value is 1. -%% </dd> -%% <dt>{@type {stylesheet, string()@}} -%% </dt> -%% <dd>Specifies the URI used for referencing the stylesheet. The -%% default value is `"stylesheet.css"'. If an empty string is -%% specified, no stylesheet reference will be generated. -%% </dd> -%% <dt>{@type {xml_export, Module::atom()@}} -%% </dt> -%% <dd>Specifies an {@link //xmerl. `xmerl'} callback module to be -%% used for exporting the documentation. See {@link -%% //xmerl/xmerl:export_simple/3} for details. -%% </dd> -%% </dl> -%% -%% @see edoc:layout/2 - --record(opts, {root, stylesheet, index_columns}). - -module(Element, Options) -> - XML = layout_module(Element, init_opts(Element, Options)), - Export = proplists:get_value(xml_export, Options, - ?DEFAULT_XML_EXPORT), - xmerl:export_simple([XML], Export, []). - -% Put layout options in a data structure for easier access. - -init_opts(Element, Options) -> - R = #opts{root = get_attrval(root, Element), - index_columns = proplists:get_value(index_columns, - Options, 1) - }, - case proplists:get_value(stylesheet, Options) of - undefined -> - S = edoc_lib:join_uri(R#opts.root, ?STYLESHEET), - R#opts{stylesheet = S}; - "" -> - R; % don't use any stylesheet - S when is_list(S) -> - R#opts{stylesheet = S}; - _ -> - report("bad value for option `stylesheet'.", []), - exit(error) - end. - - -%% ===================================================================== -%% XML-BASED LAYOUT ENGINE -%% ===================================================================== - -%% We assume that we have expanded XML data. - -%% <!ELEMENT module (moduleName, moduleFullName, behaviour*, description?, -%% author*, version?, since?, copyright?, deprecated?, -%% see*, reference*, typedecls?, functions)> -%% <!ATTLIST module -%% root CDATA #IMPLIED> -%% <!ELEMENT moduleName (#PCDATA)> -%% <!ELEMENT moduleFullName (#PCDATA)> -%% <!ELEMENT behaviour (#PCDATA)> -%% <!ATTLIST behaviour -%% href CDATA #IMPLIED> -%% <!ELEMENT description (briefDescription, fullDescription?)> -%% <!ELEMENT briefDescription (#PCDATA)> -%% <!ELEMENT fullDescription (#PCDATA)> -%% <!ELEMENT author EMPTY> -%% <!ATTLIST author -%% name CDATA #REQUIRED -%% email CDATA #IMPLIED -%% website CDATA #IMPLIED> -%% <!ELEMENT version (#PCDATA)> -%% <!ELEMENT since (#PCDATA)> -%% <!ELEMENT copyright (#PCDATA)> -%% <!ELEMENT deprecated (description)> -%% <!ELEMENT see (#PCDATA)> -%% <!ATTLIST see -%% name CDATA #REQUIRED -%% href CDATA #IMPLIED> -%% <!ELEMENT reference (#PCDATA)> -%% <!ELEMENT typedecls (typedecl+)> -%% <!ELEMENT functions (function+)> - -layout_module(#xmlElement{name = module, content = Es}=E, _Opts) -> - Name = get_attrval(name, E), - Desc = get_content(description, Es), - ShortDesc = get_content(briefDescription, Desc), - FullDesc = get_content(fullDescription, Desc), - Functions = [E || E <- get_content(functions, Es)], - SortedFs = lists:sort([{function_name(E), E} || E <- Functions]), - Types = get_content(typedecls, Es), - SortedTs = lists:sort([{type_name(E), E} || E <- Types]), - Header = {header, [ - ?NL,{title, [Name]}, - ?NL,{prepared, [""]}, - ?NL,{responsible, [""]}, - ?NL,{docno, ["1"]}, - ?NL,{approved, [""]}, - ?NL,{checked, [""]}, - ?NL,{date, [""]}, - ?NL,{rev, ["A"]}, - ?NL,{file, [Name++".sgml"]} - ]}, - Module = {module, [Name]}, - ModuleSummary = {modulesummary, ShortDesc}, - {Short,Long} = find_first_p(FullDesc,[]), - Description = {description, [?NL,{p,Short}|Long]++[?NL|types(SortedTs)]}, - Funcs = functions(SortedFs), - Authors = {authors, authors(Es)}, - See = sees1(Es), - {erlref, [ - ?NL,Header, - ?NL,Module, - ?NL,ModuleSummary, - ?NL,Description, - ?NL,Funcs, - ?NL,See, - ?NL,Authors - ] - }. - -stylesheet(Opts) -> - case Opts#opts.stylesheet of - undefined -> - []; - CSS -> - [{link, [{rel, "stylesheet"}, - {type, "text/css"}, - {href, CSS}], []}, - ?NL] - end. - -% doc_index(FullDesc, Functions, Types) -> -% case doc_index_rows(FullDesc, Functions, Types) of -% [] -> []; -% Rs -> -% [{ul, [{li, [{a, [{href, local_label(R)}], [T]}]} -% || {T, R} <- Rs]}] -% end. - -% doc_index_rows(FullDesc, Functions, Types) -> -% (if FullDesc == [] -> []; -% true -> [{?DESCRIPTION_TITLE, ?DESCRIPTION_LABEL}] -% end -% ++ if Types == [] -> []; -% true -> [{?DATA_TYPES_TITLE, ?DATA_TYPES_LABEL}] -% end -% ++ if Functions == [] -> []; -% true -> [{?FUNCTION_INDEX_TITLE, ?FUNCTION_INDEX_LABEL}, -% {?FUNCTIONS_TITLE, ?FUNCTIONS_LABEL}] -% end). - -% function_index(Fs, Cols) -> -% case function_index_rows(Fs, Cols, []) of -% [] -> []; -% Rows -> -% [?NL, -% {h2, [{a, [{name, ?FUNCTION_INDEX_LABEL}], -% [?FUNCTION_INDEX_TITLE]}]}, -% ?NL, -% {table, [{width, "100%"}, {border, 1}], Rows}, -% ?NL] -% end. - -% function_index_rows(Fs, Cols, Title) -> -% Rows = (length(Fs) + (Cols - 1)) div Cols, -% (if Title == [] -> []; -% true -> [{tr, [{th, [{colspan, Cols * 2}, {align, left}], -% [Title]}]}, -% ?NL] -% end -% ++ lists:flatmap(fun index_row/1, -% edoc_lib:transpose(edoc_lib:segment(Fs, Rows)))). - -% index_row(Fs) -> -% [{tr, lists:flatmap(fun index_col/1, Fs)}, ?NL]. - -% index_col({Name, F=#xmlElement{content = Es}}) -> -% [{td, [{valign, "top"}], label_href([Name], F)}, -% {td, index_desc(Es)}]. - -index_desc(Es) -> - Desc = get_content(description, Es), - case get_content(briefDescription, Desc) of - [] -> - equiv(Es); % no description at all if no equiv - ShortDesc -> - ShortDesc - end. - -% label_href(Content, F) -> -% case get_attrval(label, F) of -% "" -> Content; -% Ref -> [{a, [{href, local_label(Ref)}], Content}] -% end. - - -%% <!ELEMENT function (args, typespec?, equiv?, description?, since?, -%% deprecated?, see*)> -%% <!ATTLIST function -%% name CDATA #REQUIRED -%% arity CDATA #REQUIRED -%% exported NMTOKEN(yes | no) #REQUIRED -%% label CDATA #IMPLIED> -%% <!ELEMENT args (arg*)> -%% <!ELEMENT arg description?> -%% <!ATTLIST arg name CDATA #REQUIRED> - - -%% <!ELEMENT equiv (expr, see?)> -%% <!ELEMENT expr (#PCDATA)> - -% functions(Fs) -> -% Es = lists:flatmap(fun ({Name, E}) -> function(Name, E) end, Fs), -% if Es == [] -> []; -% true -> -% [?NL, -% {h2, [{a, [{name, ?FUNCTIONS_LABEL}], [?FUNCTIONS_TITLE]}]}, -% ?NL | Es] -% end. - -functions(Fs) -> - Es = lists:flatmap(fun ({Name, E}) -> function(Name, E) end, Fs), - if Es == [] -> []; - true -> - {funcs, Es} - end. - -% is_exported(E) -> -% case get_attrval(exported, E) of -% "yes" -> true; -% _ -> false -% end. - -% function(Name, E=#xmlElement{content = Es}) -> -% ([?NL, {h3, label_anchor([Name], E)}, ?NL] -% ++ case typespec(get_content(typespec, Es)) of -% [] -> -% signature(get_content(arguments, Es), -% get_text(functionName, Es)); -% Spec -> Spec -% end -% ++ equiv(Es) -% ++ deprecated(Es, "function") -% ++ fulldesc(Es) -% ++ since(Es) -% ++ sees(Es)). - -function(_Name, E=#xmlElement{content = Es}) -> - TypeSpec = get_content(typespec, Es), - [?NL,{func, [ ?NL, - {name, -% case typespec(get_content(typespec, Es)) of - case funcheader(TypeSpec) of - [] -> - signature(get_content(args, Es), - get_attrval(name, E)); - Spec -> Spec - end - }, - ?NL,{fsummary, fsummary(Es)}, -% ?NL,{type, local_types(TypeSpec)}, - ?NL,local_types(TypeSpec), - ?NL,{desc, label_anchor(E)++fulldesc(Es)++sees(Es)} - ]}]. - -fsummary([]) -> ["\s"]; -fsummary(Es) -> - Desc = get_content(description, Es), - case get_content(briefDescription, Desc) of - [] -> - fsummary_equiv(Es); % no description at all if no equiv - ShortDesc -> - ShortDesc - end. - - -fsummary_equiv(Es) -> - case get_content(equiv, Es) of - [] -> ["\s"]; - Es1 -> - case get_content(expr, Es1) of - [] -> ["\s"]; - [Expr] -> - ["Equivalent to ", Expr, ".",?NL] - end - end. - - -function_name(E) -> - get_attrval(name, E) ++ "/" ++ get_attrval(arity, E). - -label_anchor(E) -> - case get_attrval(label, E) of - "" -> []; - Ref -> [{marker, [{id, Ref}],[]},?NL] - end. - -label_anchor(Content, E) -> - case get_attrval(label, E) of - "" -> Content; - Ref -> {p,[{marker, [{id, Ref}],[]}, - {em, Content}]} - end. - -%% <!ELEMENT args (arg*)> -%% <!ELEMENT arg (argName, description?)> -%% <!ELEMENT argName (#PCDATA)> - -%% This is currently only done for functions without type spec. - -signature(Es, Name) -> -% [{tt, [Name, "("] ++ seq(fun arg/1, Es) ++ [") -> term()", ?NL]}]. - [Name, "("] ++ seq(fun arg/1, Es) ++ [") -> term()", ?NL]. - -arg(#xmlElement{content = Es}) -> - [get_text(argName, Es)]. - -%% <!ELEMENT typespec (erlangName, type, localdef*)> - -% typespec([]) -> []; -% typespec(Es) -> -% [{p, ([{tt, ([t_name(get_elem(qualifiedName, Es))] -% ++ t_type(get_content(type, Es)))}] -% ++ local_defs(get_elem(definition, Es)))}, -% ?NL]. - -funcheader([]) -> []; -funcheader(Es) -> - [t_name(get_elem(erlangName, Es))] ++ t_utype(get_elem(type, Es)). - -local_types([]) -> []; -local_types(Es) -> - local_defs2(get_elem(localdef, Es)). - -local_defs2([]) -> []; -local_defs2(Es) -> - {type,[?NL | [{v, localdef(E)} || E <- Es]]}. - -%% <!ELEMENT typedecl (typedef, description?)> -%% <!ELEMENT typedef (erlangName, argtypes, type?, localdef*)> - -types([]) -> []; -types(Ts) -> - Es = lists:flatmap(fun ({Name, E}) -> typedecl(Name, E) end, Ts), - [?NL, -% {h2, [{a, [{name, ?DATA_TYPES_LABEL}], -% [?DATA_TYPES_TITLE]}]}, -% ?NL | Es] - {p,[{marker, [{id, ?DATA_TYPES_LABEL}],[]}, - {em,[?DATA_TYPES_TITLE]}]}, - ?NL, {taglist,[?NL|Es]}]. - -%%type(Name, E=#xmlElement{content = Es}) -> -%% ([?NL, {h3, label_anchor([Name, "()"], E)}, ?NL] -%% ++ [{p, typedef(get_content(typedef, Es))}, ?NL] -%% ++ fulldesc(Es)). -typedecl(_Name, #xmlElement{content = Es}) -> - [{tag, typedef(get_content(typedef, Es))},?NL,{item,fulldesc(Es)},?NL]. - - -type_name(#xmlElement{content = Es}) -> - t_name(get_elem(erlangName, get_content(typedef, Es))). - -typedef(Es) -> - Name = ([t_name(get_elem(erlangName, Es)), "("] - ++ seq(fun t_utype_elem/1, get_content(argtypes, Es), [")"])), - (case get_elem(type, Es) of - [] -> [{b, ["abstract datatype"]}, ": ", {tt, Name}]; - Type -> - [{tt, Name ++ [" = "] ++ t_utype(Type)}] - end - ++ local_defs(get_elem(localdef, Es))). - -local_defs([]) -> []; -local_defs(Es) -> - [?NL, {ul, [{li, [{tt, localdef(E)}]} || E <- Es]}]. - -localdef(E = #xmlElement{content = Es}) -> - (case get_elem(typevar, Es) of - [] -> - label_anchor(t_abstype(get_content(abstype, Es)), E); - [V] -> - t_var(V) - end - ++ [" = "] ++ t_utype(get_elem(type, Es))). - -fulldesc(Es) -> - case get_content(fullDescription, get_content(description, Es)) of -% [] -> [?NL]; - [] -> index_desc(Es); -% Desc -> [{p, Desc}, ?NL] - Desc -> - {Short,Long} = find_first_p(Desc,[]), - [?NL,{p,Short}|Long] ++[?NL] - end. - -find_first_p([#xmlElement{name=p}|_]=Long,Short) -> - {lists:reverse(Short),Long}; -find_first_p([H|T],Short) -> - find_first_p(T,[H|Short]); -find_first_p([],Short) -> - {lists:reverse(Short),[]}. - - -sees1(Es) -> - case get_elem(see, Es) of - [] -> []; - Es1 -> - {section,[{title,["See also"]},{p,seq(fun see/1, Es1, [])}]} - end. - -sees(Es) -> - case get_elem(see, Es) of - [] -> []; - Es1 -> - [{p, [{em, ["See also:"]}, " "] ++ seq(fun see/1, Es1, ["."])}, - ?NL] - end. - -see(E=#xmlElement{content = Es}) -> - see(E,Es). - -see(E, Es) -> - case get_attrval(href, E) of - "" -> Es; - Ref -> - case lists:reverse(Ref) of - "lmgs.ppa_"++Ppa -> - App = lists:reverse(Ppa), - [{seealso, [{marker, App++"_app"}], [App]},"(6)"]; - "lmgs."++Dom -> - Mod = lists:reverse(Dom), - [{seealso, [{marker, Mod}], [Mod]},"(3)"]; - _ -> - [{seealso, [{marker, Ref}], Es}] - end - end. - -equiv(Es) -> - case get_content(equiv, Es) of - [] -> ["\s"]; - Es1 -> - case get_content(expr, Es1) of - [] -> []; - [Expr] -> -% Expr1 = {tt, [Expr]}, -% Expr1 = {c, [Expr]}, - Expr1 = [Expr], - Expr2 = case get_elem(see, Es1) of - [] -> - {c,Expr1}; - [E=#xmlElement{}] -> -% see(E,Expr1) - case get_attrval(href, E) of - "" -> - {c,Expr1}; - Ref -> - {seealso, [{marker, Ref}], Expr1} - end - end, - [{p, ["Equivalent to ", Expr2, "."]}, ?NL] - end - end. - -% replace_minus_with_percent([$-|T]) -> -% [$%|T]; -% replace_minus_with_percent([H|T]) -> -% [H|replace_minus_with_percent(T)]. - -copyright(Es) -> - case get_content(copyright, Es) of - [] -> []; - Es1 -> - [{p, ["Copyright \251 " | Es1]}, ?NL] - end. - -version(Es) -> - case get_content(version, Es) of - [] -> []; - Es1 -> - [{p, [{b, ["Version:"]}, " " | Es1]}, ?NL] - end. - -since(Es) -> - case get_content(since, Es) of - [] -> []; - Es1 -> - [{p, [{b, ["Introduced in:"]}, " " | Es1]}, ?NL] - end. - -deprecated(Es, S) -> - Es1 = get_content(description, get_content(deprecated, Es)), - case get_content(fullDescription, Es1) of - [] -> []; - Es2 -> - [{p, [{b, ["This " ++ S ++ " is deprecated:"]}, " " | Es2]}, - ?NL] - end. - -% behaviours(Es) -> -% case get_elem(behaviour, Es) of -% [] -> []; -% Es1 -> -% [{p, [{b, ["Behaviour:"]}, " "] ++ seq(fun behaviour/1, Es1, ["."])}, -% ?NL] -% end. - -% behaviour(E=#xmlElement{content = Es}) -> -% case get_attrval(href, E) of -% "" -> [{tt, Es}]; -% Ref -> [{a, [{href, Ref}], [{tt, Es}]}] -% end. - -authors(Es) -> - case get_elem(author, Es) of - [] -> [?NL,{aname,["\s"]},?NL,{email,["\s"]}]; - Es1 -> [?NL|seq(fun author/1, Es1, [])] -% -% [{p, [{b, ["Authors:"]}, " "] ++ seq(fun author/1, Es1, ["."])}, -% ?NL] - end. - - -%% <!ATTLIST author -%% name CDATA #REQUIRED -%% email CDATA #IMPLIED -%% website CDATA #IMPLIED> - -author(E=#xmlElement{}) -> - Name = case get_attrval(name, E) of - [] -> "\s"; - N -> N - end, - Mail = case get_attrval(email, E) of - [] -> "\s"; - M -> M - end, - [?NL,{aname,[Name]},?NL,{email,[Mail]}]. - -% author(E=#xmlElement{}) -> -% Name = get_attrval(name, E), -% Mail = get_attrval(email, E), -% URI = get_attrval(website, E), -% (if Name == Mail -> -% [{a, [{href, "mailto:" ++ Mail}],[{tt, [Mail]}]}]; -% true -> -% if Mail == "" -> [Name]; -% true -> [Name, " (", {a, [{href, "mailto:" ++ Mail}], -% [{tt, [Mail]}]}, ")"] -% end -% end -% ++ if URI == "" -> []; -% true -> [" [", {em, ["web site:"]}, " ", -% {tt, [{a, [{href, URI}], [URI]}]}, "]"] -% end). - -references(Es) -> - case get_elem(reference, Es) of - [] -> []; - Es1 -> - [{p, [{b, ["References"]}, - {ul, [{li, C} || #xmlElement{content = C} <- Es1]}]}, - ?NL] - end. - -t_name([E]) -> - N = get_attrval(name, E), - case get_attrval(module, E) of - "" -> N; - M -> - S = M ++ ":" ++ N, - case get_attrval(app, E) of - "" -> S; - A -> "//" ++ A ++ "/" ++ S - end - end. - -t_utype([E]) -> - t_utype_elem(E). - -t_utype_elem(E=#xmlElement{content = Es}) -> - case get_attrval(name, E) of - "" -> t_type(Es); - Name -> - T = t_type(Es), - case T of - [Name] -> T; % avoid generating "Foo::Foo" - T -> [Name] ++ ["::"] ++ T - end - end. - -t_type([E=#xmlElement{name = typevar}]) -> - t_var(E); -t_type([E=#xmlElement{name = atom}]) -> - t_atom(E); -t_type([E=#xmlElement{name = integer}]) -> - t_integer(E); -t_type([E=#xmlElement{name = float}]) -> - t_float(E); -t_type([#xmlElement{name = nil}]) -> - t_nil(); -t_type([#xmlElement{name = list, content = Es}]) -> - t_list(Es); -t_type([#xmlElement{name = tuple, content = Es}]) -> - t_tuple(Es); -t_type([#xmlElement{name = 'fun', content = Es}]) -> - t_fun(Es); -t_type([E = #xmlElement{name = abstype, content = Es}]) -> - T = t_abstype(Es), -% see(E,T); - case get_attrval(href, E) of - "" -> T; - % Ref -> [{seealso, [{marker, Ref}], T}] - _Ref -> T - end; -t_type([#xmlElement{name = union, content = Es}]) -> - t_union(Es). - -t_var(E) -> - [get_attrval(name, E)]. - - -t_atom(E) -> - [get_attrval(value, E)]. - -t_integer(E) -> - [get_attrval(value, E)]. - -t_float(E) -> - [get_attrval(value, E)]. - -t_nil() -> - ["[]"]. - -t_list(Es) -> - ["["] ++ t_utype(get_elem(type, Es)) ++ ["]"]. - -t_tuple(Es) -> - ["{"] ++ seq(fun t_utype_elem/1, Es, ["}"]). - -t_fun(Es) -> - ["("] ++ seq(fun t_utype_elem/1, get_content(argtypes, Es), - [") -> "] ++ t_utype(get_elem(type, Es))). - -t_abstype(Es) -> -% ([t_name(get_elem(qualifiedName, Es)), "("] -% ++ seq(fun t_type_elem/1, get_elem(type, Es), [")"])). - case split_at_colon(t_name(get_elem(erlangName, Es)),[]) of - {Mod,Type} -> - [Type, "("] ++ - seq(fun t_utype_elem/1, get_elem(type, Es), [")"]) ++ - [" (see module ", Mod, ")"]; - Type -> - [Type, "("] ++ - seq(fun t_utype_elem/1, get_elem(type, Es), [")"]) - end. - -%% Split at one colon, but not at two (or more) -split_at_colon([$:,$:|_]=Rest,Acc) -> - lists:reverse(Acc)++Rest; -split_at_colon([$:|Type],Acc) -> - {lists:reverse(Acc),Type}; -split_at_colon([Char|Rest],Acc) -> - split_at_colon(Rest,[Char|Acc]); -split_at_colon([],Acc) -> - lists:reverse(Acc). - -% t_par(Es) -> -% T = t_type(get_content(type, Es)), -% case get_elem(variable, Es) of -% [] -> T; -% [V0] -> case t_variable(V0) of -% T -> T; -% V -> V ++ ["::"] ++ T -% end -% end. - -% t_par_elem(#xmlElement{content = Es}) -> t_par(Es). - -t_union(Es) -> - seq(fun t_utype_elem/1, Es, " | ", []). - -seq(F, Es) -> - seq(F, Es, []). - -seq(F, Es, Tail) -> - seq(F, Es, ", ", Tail). - -seq(F, [E], _Sep, Tail) -> - F(E) ++ Tail; -seq(F, [E | Es], Sep, Tail) -> - F(E) ++ [Sep] ++ seq(F, Es, Sep, Tail); -seq(_F, [], _Sep, Tail) -> - Tail. - -get_elem(Name, [#xmlElement{name = Name} = E | Es]) -> - [E | get_elem(Name, Es)]; -get_elem(Name, [_ | Es]) -> - get_elem(Name, Es); -get_elem(_, []) -> - []. - -get_attr(Name, [#xmlAttribute{name = Name} = A | As]) -> - [A | get_attr(Name, As)]; -get_attr(Name, [_ | As]) -> - get_attr(Name, As); -get_attr(_, []) -> - []. - -get_attrval(Name, #xmlElement{attributes = As}) -> - case get_attr(Name, As) of - [#xmlAttribute{value = V}] -> - V; - [] -> "" - end. - -get_content(Name, Es) -> - case get_elem(Name, Es) of - [#xmlElement{content = Es1}] -> - Es1; - [] -> [] - end. - -get_text(Name, Es) -> - case get_content(Name, Es) of - [#xmlText{value = Text}] -> - Text; - [] -> "" - end. - -% local_label(R) -> -% "#" ++ R. - -xml(Title, CSS, Body) -> - {html, [?NL, - {head, [?NL, - {title, [Title]}, - ?NL] ++ CSS}, - ?NL, - {body, [{bgcolor, "white"}], Body}, - ?NL] - }. - -%% --------------------------------------------------------------------- - - type(E) -> - type(E, []). - -% type(E, Ds) -> -% xmerl:export_simple_content(t_utype_elem(E) ++ local_defs(Ds), -% ?HTML_EXPORT). - type(E, Ds) -> - xmerl:export_simple_content(t_utype_elem(E) ++ local_defs(Ds), - ?SGML_EXPORT). - -overview(E=#xmlElement{name = overview, content = Es}, Options) -> - Opts = init_opts(E, Options), - Title = get_text(title, Es), - Desc = get_content(description, Es), -% ShortDesc = get_content(briefDescription, Desc), - FullDesc = get_content(fullDescription, Desc), - Body = ([?NL, {h1, [Title]}, ?NL] -% ++ ShortDesc - ++ copyright(Es) - ++ version(Es) - ++ since(Es) - ++ deprecated(Es, "application") - ++ authors(Es) - ++ references(Es) - ++ sees(Es) - ++ FullDesc), - XML = xml(Title, stylesheet(Opts), Body), - xmerl:export_simple([XML], ?SGML_EXPORT, []). diff --git a/lib/edoc/vsn.mk b/lib/edoc/vsn.mk index 065944ccef..2f6d469536 100644 --- a/lib/edoc/vsn.mk +++ b/lib/edoc/vsn.mk @@ -1 +1 @@ -EDOC_VSN = 0.9.1 +EDOC_VSN = 0.9.2 diff --git a/lib/eldap/doc/src/Makefile b/lib/eldap/doc/src/Makefile index ac869e446f..aff1da4a9a 100644 --- a/lib/eldap/doc/src/Makefile +++ b/lib/eldap/doc/src/Makefile @@ -37,7 +37,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) XML_APPLICATION_FILES = ref_man.xml XML_REF3_FILES = eldap.xml -XML_PART_FILES = release_notes.xml usersguide.xml +XML_PART_FILES = usersguide.xml XML_CHAPTER_FILES = notes.xml BOOK_FILES = book.xml diff --git a/lib/eldap/doc/src/fascicules.xml b/lib/eldap/doc/src/fascicules.xml deleted file mode 100644 index cbc266cd30..0000000000 --- a/lib/eldap/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="usersguide" href="usersguide_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="release_notes" href="release_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/eldap/doc/src/note.gif b/lib/eldap/doc/src/note.gif Binary files differdeleted file mode 100644 index 6fffe30419..0000000000 --- a/lib/eldap/doc/src/note.gif +++ /dev/null diff --git a/lib/eldap/doc/src/notes.xml b/lib/eldap/doc/src/notes.xml index 7aad745f67..8b066671ee 100644 --- a/lib/eldap/doc/src/notes.xml +++ b/lib/eldap/doc/src/notes.xml @@ -31,6 +31,21 @@ </header> <p>This document describes the changes made to the Eldap application.</p> +<section><title>Eldap 1.2.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Removed all old unused files in the documentation. + </p> + <p> + Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p> + </item> + </list> + </section> + +</section> + <section><title>Eldap 1.2.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/eldap/doc/src/warning.gif b/lib/eldap/doc/src/warning.gif Binary files differdeleted file mode 100644 index 96af52360e..0000000000 --- a/lib/eldap/doc/src/warning.gif +++ /dev/null diff --git a/lib/eldap/src/eldap.erl b/lib/eldap/src/eldap.erl index 625309271b..2b84872b92 100644 --- a/lib/eldap/src/eldap.erl +++ b/lib/eldap/src/eldap.erl @@ -1368,9 +1368,9 @@ rm_leading_slash(Tail) -> Tail. parse_attributes([$?|Tail]) -> case split_string(Tail,$?) of {[],Attributes} -> - {[],{attributes,string:tokens(Attributes,",")}}; + {[],{attributes,string:lexemes(Attributes,",")}}; {Attributes,Rest} -> - {Rest,{attributes,string:tokens(Attributes,",")}} + {Rest,{attributes,string:lexemes(Attributes,",")}} end. parse_hostport(Str) -> diff --git a/lib/eldap/vsn.mk b/lib/eldap/vsn.mk index 721387d97d..1636b6bb6d 100644 --- a/lib/eldap/vsn.mk +++ b/lib/eldap/vsn.mk @@ -1 +1 @@ -ELDAP_VSN = 1.2.2 +ELDAP_VSN = 1.2.3 diff --git a/lib/erl_docgen/doc/src/fasc_dtds.xml b/lib/erl_docgen/doc/src/fasc_dtds.xml deleted file mode 100644 index 390ae6c5d1..0000000000 --- a/lib/erl_docgen/doc/src/fasc_dtds.xml +++ /dev/null @@ -1,116 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2007</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>Fascicules DTDs</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - <file>fasc_dtds.xml</file> - </header> - - <section> - <title>The fascicules DTD</title> - - <p>The <c>fascicules</c> DTD is a special kind of DTD which can be - used to specify the different parts of the documentation, and - which one of those should be shown as default.</p> - - <p>Example:</p> - - <pre><![CDATA[ -<?xml version="1.0" encoding="latin1" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> -</fascicules> - ]]></pre> - - <p>In the example, it is specified that the documentation for this - application consists of three parts: User's Guide, where - the "cover page" (with the two frames) is located in - <c>part_frame.html</c>, Reference Manual with the cover page - <c>ref_man_frame.html</c> and Release Notes with the cover page - <c>part_notes_frame.html</c>.</p> - - <p>As a result, at the top of the left frame in the generated HTML - documentation, there will be corresponding links to User's Guide, - Reference Manual and Release Notes.</p> - - <p>The attribute <c>entry="yes"</c> specifies that it is - the Reference Manual which should be shown as default. This means - that when generating the HTML files, <c>application_frame.html</c> - will be copied to <c>index.html</c>.</p> - - <note> - <p>DocBuilder assumes that the XML file written according to - the <c>fascicules</c> DTD is called <c>fascicules.xml</c>.</p> - </note> - - <p>This file is optional. If it does not exist, there are no links - to other parts of the documentation (as they are not known) in - the left frame, and no <c>index.html</c> is created.</p> - </section> - - <section> - <marker id="fasciculesTAG"></marker> - <title><fascicules></title> - - <p>Top level tag for the <c>fascicules</c> DTD.</p> - - <p>Contains one or more - <seealso marker="#fasciculeTAG"><fascicule></seealso>.</p> - </section> - - <section> - <marker id="fasciculeTAG"></marker> - <title><fascicule></title> - - <p>Specifies properties for one "part" of the documentation for an - application.</p> - - <p>Contains plain text, the name of this part.</p> - - <p>The <c>file</c> attribute should specify the file name for - the corresponding <c>part</c> or <c>application</c>, without - the <c>.xml</c> extension.</p> - - <p>The <c>href</c> attribute should specify the file name for - the corresponding HTML cover page file, without the <c>.html</c> - extension.</p> - - <p>The optional <c>entry="yes"|"no"</c> attribute specifies if - the HTML cover page should be copied to <c>index.html</c> or - not. Default is <c>"no"</c>.</p> - </section> -</chapter> - diff --git a/lib/erl_docgen/doc/src/fascicules.xml b/lib/erl_docgen/doc/src/fascicules.xml deleted file mode 100644 index 154c8a3b6d..0000000000 --- a/lib/erl_docgen/doc/src/fascicules.xml +++ /dev/null @@ -1,15 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> -</fascicules> - diff --git a/lib/erl_docgen/doc/src/notes.xml b/lib/erl_docgen/doc/src/notes.xml index 59c65665d4..2652b4b0c8 100644 --- a/lib/erl_docgen/doc/src/notes.xml +++ b/lib/erl_docgen/doc/src/notes.xml @@ -31,7 +31,26 @@ </header> <p>This document describes the changes made to the <em>erl_docgen</em> application.</p> - <section><title>Erl_Docgen 0.7.1</title> + <section><title>Erl_Docgen 0.7.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> The style for code, warning and note tags in the pdf + have been changed so they look like the html version. + <br/> The spacing around code blocks have been changed + for both html and pdf so it's the same regardless if the + user have a newline after the start tag (or before the + end tag) or not. </p> + <p> + Own Id: OTP-14674</p> + </item> + </list> + </section> + +</section> + +<section><title>Erl_Docgen 0.7.1</title> <section><title>Improvements and New Features</title> <list> diff --git a/lib/erl_docgen/priv/dtd/erlref.dtd b/lib/erl_docgen/priv/dtd/erlref.dtd index 615b88b61a..78d6771f52 100644 --- a/lib/erl_docgen/priv/dtd/erlref.dtd +++ b/lib/erl_docgen/priv/dtd/erlref.dtd @@ -33,4 +33,5 @@ <!ATTLIST name name CDATA #IMPLIED arity CDATA #IMPLIED clause_i CDATA #IMPLIED + anchor CDATA #IMPLIED n_vars CDATA #IMPLIED> diff --git a/lib/erl_docgen/priv/xsl/db_funcs.xsl b/lib/erl_docgen/priv/xsl/db_funcs.xsl new file mode 100644 index 0000000000..8178ce44fb --- /dev/null +++ b/lib/erl_docgen/priv/xsl/db_funcs.xsl @@ -0,0 +1,136 @@ +<?xml version="1.0" encoding="utf-8"?> +<!-- + # + # %CopyrightBegin% + # + # Copyright Ericsson AB 2009-2017. All Rights Reserved. + # + # Licensed under the Apache License, Version 2.0 (the "License"); + # you may not use this file except in compliance with the License. + # You may obtain a copy of the License at + # + # http://www.apache.org/licenses/LICENSE-2.0 + # + # Unless required by applicable law or agreed to in writing, software + # distributed under the License is distributed on an "AS IS" BASIS, + # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + # See the License for the specific language governing permissions and + # limitations under the License. + # + # %CopyrightEnd% + + --> +<xsl:stylesheet version="1.0" + xmlns:xsl="http://www.w3.org/1999/XSL/Transform" + xmlns:erl="http://erlang.org" + xmlns:func="http://exslt.org/functions" + extension-element-prefixes="func" + xmlns:fo="http://www.w3.org/1999/XSL/Format" + xmlns:fn="http://www.w3.org/2005/02/xpath-functions"> + + <!-- Used from code template to trim the newline/cr after the tag + and spaces/tabs between them + --> + <xsl:variable name="newlinechars" select="' '" /> + <xsl:variable name="spacechars" select="'	 '" /> + + <func:function name="erl:code_trim"> + <xsl:param name="string" /> + + <xsl:variable name="leftresult" select="erl:code_ltrim($string, $string)"/> + <xsl:variable name="result" select="erl:code_rtrim($leftresult, $leftresult)"/> + + <func:result select="$result"/> + </func:function> + + <func:function name="erl:code_rtrim"> + <xsl:param name="string" /> + <xsl:param name="origstring" /> + + <xsl:variable name="length" select="string-length($string)" /> + + <xsl:variable name="result"> + <xsl:if test="$length > 0"> + <xsl:choose> + <xsl:when test="contains($spacechars, substring($string, $length, 1))"> + <xsl:value-of select="erl:code_rtrim(substring($string, 1, $length - 1), $origstring)" /> + </xsl:when> + <xsl:when test="contains($newlinechars, substring($string, $length, 1))"> + <xsl:value-of select="erl:code_rtrim_1(substring($string, 1, $length - 1))" /> + </xsl:when> + <xsl:otherwise> + <xsl:value-of select="$origstring" /> + </xsl:otherwise> + </xsl:choose> + </xsl:if> + </xsl:variable> + + <func:result select="$result" /> + </func:function> + + <func:function name="erl:code_rtrim_1"> + <xsl:param name="string" /> + + <xsl:variable name="length" select="string-length($string)" /> + + <xsl:variable name="result"> + <xsl:if test="$length > 0"> + <xsl:choose> + <xsl:when test="contains($newlinechars, substring($string, $length, 1))"> + <xsl:value-of select="erl:code_rtrim_1(substring($string, 1, $length - 1))" /> + </xsl:when> + <xsl:otherwise> + <xsl:value-of select="erl:code_rtrim($string, $string)" /> + <!--xsl:value-of select="$string" /--> + </xsl:otherwise> + </xsl:choose> + </xsl:if> + </xsl:variable> + + <func:result select="$result" /> + </func:function> + + <func:function name="erl:code_ltrim"> + <xsl:param name="string" /> + <xsl:param name="origstring" /> + + <xsl:variable name="result"> + <xsl:if test="string-length($string) > 0"> + <xsl:choose> + <xsl:when test="contains($spacechars, substring($string, 1, 1))"> + <xsl:value-of select="erl:code_ltrim(substring($string, 2), $origstring)" /> + </xsl:when> + <xsl:when test="contains($newlinechars, substring($string, 1, 1))"> + <xsl:value-of select="erl:code_ltrim_1(substring($string, 2))" /> + </xsl:when> + <xsl:otherwise> + <xsl:value-of select="$origstring" /> + </xsl:otherwise> + </xsl:choose> + </xsl:if> + </xsl:variable> + + <func:result select="$result" /> + </func:function> + + <func:function name="erl:code_ltrim_1"> + <xsl:param name="string" /> + + <xsl:variable name="result"> + <xsl:if test="string-length($string) > 0"> + <xsl:choose> + <xsl:when test="contains($newlinechars, substring($string, 1, 1))"> + <xsl:value-of select="erl:code_ltrim_1(substring($string, 2))" /> + </xsl:when> + <xsl:otherwise> + <xsl:value-of select="erl:code_ltrim($string, $string)" /> + <!--xsl:value-of select="$string" /--> + </xsl:otherwise> + </xsl:choose> + </xsl:if> + </xsl:variable> + + <func:result select="$result" /> + </func:function> + +</xsl:stylesheet> diff --git a/lib/erl_docgen/priv/xsl/db_html.xsl b/lib/erl_docgen/priv/xsl/db_html.xsl index a5e277aece..5b7eae4f73 100644 --- a/lib/erl_docgen/priv/xsl/db_html.xsl +++ b/lib/erl_docgen/priv/xsl/db_html.xsl @@ -30,6 +30,7 @@ xmlns:fn="http://www.w3.org/2005/02/xpath-functions"> <xsl:include href="db_html_params.xsl"/> + <xsl:include href="db_funcs.xsl"/> <func:function name="erl:flip_first_char"> <xsl:param name="in"/> @@ -171,6 +172,7 @@ <xsl:template name="spec_name"> <xsl:variable name="name" select="@name"/> <xsl:variable name="arity" select="@arity"/> + <xsl:variable name="anchor" select="@anchor"/> <xsl:variable name="spec0"> <xsl:call-template name="find_spec"/> </xsl:variable> @@ -197,6 +199,11 @@ </xsl:otherwise> </xsl:choose> + <!-- Insert an anchor for "anchor" attribute --> + <xsl:if test="string-length($anchor) > 0"> + <a name="{$anchor}"></a> + </xsl:if> + <xsl:variable name="global_types" select="ancestor::erlref/datatypes"/> <xsl:variable name="local_types" select="../type[string-length(@name) > 0]"/> @@ -1132,7 +1139,14 @@ <xsl:variable name="codenum"> <xsl:number level="any" from="chapter" count="code"/> </xsl:variable> - <div class="example"><pre><xsl:apply-templates/></pre></div> + <xsl:choose> + <xsl:when test="not(descendant::anno)"> + <div class="example"><pre><xsl:value-of select="erl:code_trim(text())"/></pre></div> + </xsl:when> + <xsl:otherwise> + <div class="example"><pre><xsl:apply-templates/></pre></div> + </xsl:otherwise> + </xsl:choose> </xsl:template> <!-- Pre --> diff --git a/lib/erl_docgen/priv/xsl/db_pdf.xsl b/lib/erl_docgen/priv/xsl/db_pdf.xsl index 99263847fb..46de66bcd8 100644 --- a/lib/erl_docgen/priv/xsl/db_pdf.xsl +++ b/lib/erl_docgen/priv/xsl/db_pdf.xsl @@ -23,12 +23,16 @@ <xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform" xmlns:exsl="http://exslt.org/common" - extension-element-prefixes="exsl" - xmlns:fo="http://www.w3.org/1999/XSL/Format"> + xmlns:func="http://exslt.org/functions" + xmlns:erl="http://erlang.org" + extension-element-prefixes="exsl func" + xmlns:fo="http://www.w3.org/1999/XSL/Format" + xmlns:fn="http://www.w3.org/2005/02/xpath-functions"> <xsl:output method="xml" indent="yes"/> <xsl:include href="db_pdf_params.xsl"/> + <xsl:include href="db_funcs.xsl"/> <!-- Start of Dialyzer type/spec tags. See also the templates matching "name" and "seealso" as well as @@ -687,7 +691,7 @@ <fo:block xsl:use-attribute-sets="cover.inner.copyrightnotice"> <xsl:value-of select="/book/header/legalnotice"/> - <!-- + <!-- Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at @@ -744,12 +748,12 @@ <fo:bookmark internal-destination="{generate-id(header/title)}" starting-state="hide"> <fo:bookmark-title><xsl:value-of select="header/title"/></fo:bookmark-title> - + <xsl:call-template name="bookmarks2"> <xsl:with-param name="entries" select="chapter[header/title]"/> </xsl:call-template> - + </fo:bookmark> </xsl:for-each> </xsl:if> @@ -1122,52 +1126,60 @@ <!-- Note --> <xsl:template match="note"> <xsl:param name="partnum"/> - <fo:block xsl:use-attribute-sets="note"> - <fo:block xsl:use-attribute-sets="note-warning-title"> - <xsl:text>Note:</xsl:text> - </fo:block> - <xsl:apply-templates> - <xsl:with-param name="partnum" select="$partnum"/> - </xsl:apply-templates> + <fo:block xsl:use-attribute-sets="note-warning"> + <fo:block xsl:use-attribute-sets="note-title"> + <xsl:text>Note:</xsl:text> + </fo:block> + <fo:block xsl:use-attribute-sets="note-warning-content"> + <xsl:apply-templates> + <xsl:with-param name="partnum" select="$partnum"/> + </xsl:apply-templates> + </fo:block> </fo:block> </xsl:template> <!-- Warning --> <xsl:template match="warning"> <xsl:param name="partnum"/> - <fo:block xsl:use-attribute-sets="warning"> - <fo:block xsl:use-attribute-sets="note-warning-title"> - <xsl:text>Warning:</xsl:text> - </fo:block> - <xsl:apply-templates> - <xsl:with-param name="partnum" select="$partnum"/> - </xsl:apply-templates> + <fo:block xsl:use-attribute-sets="note-warning"> + <fo:block xsl:use-attribute-sets="warning-title"> + <xsl:text>Warning:</xsl:text> + </fo:block> + <fo:block xsl:use-attribute-sets="note-warning-content"> + <xsl:apply-templates> + <xsl:with-param name="partnum" select="$partnum"/> + </xsl:apply-templates> + </fo:block> </fo:block> </xsl:template> <!-- Do --> <xsl:template match="do"> <xsl:param name="partnum"/> - <fo:block xsl:use-attribute-sets="do"> - <fo:block xsl:use-attribute-sets="note-warning-title"> - <xsl:text>Do:</xsl:text> - </fo:block> - <xsl:apply-templates> - <xsl:with-param name="partnum" select="$partnum"/> - </xsl:apply-templates> + <fo:block xsl:use-attribute-sets="note-warning"> + <fo:block xsl:use-attribute-sets="note-title"> + <xsl:text>Do:</xsl:text> + </fo:block> + <fo:block xsl:use-attribute-sets="note-warning-content"> + <xsl:apply-templates> + <xsl:with-param name="partnum" select="$partnum"/> + </xsl:apply-templates> + </fo:block> </fo:block> </xsl:template> <!-- Dont --> <xsl:template match="dont"> <xsl:param name="partnum"/> - <fo:block xsl:use-attribute-sets="dont"> - <fo:block xsl:use-attribute-sets="note-warning-title"> - <xsl:text>Don't:</xsl:text> - </fo:block> - <xsl:apply-templates> - <xsl:with-param name="partnum" select="$partnum"/> - </xsl:apply-templates> + <fo:block xsl:use-attribute-sets="note-warning"> + <fo:block xsl:use-attribute-sets="warning-title"> + <xsl:text>Don't:</xsl:text> + </fo:block> + <fo:block xsl:use-attribute-sets="note-warning-content"> + <xsl:apply-templates> + <xsl:with-param name="partnum" select="$partnum"/> + </xsl:apply-templates> + </fo:block> </fo:block> </xsl:template> @@ -1226,7 +1238,14 @@ </xsl:variable> <fo:block xsl:use-attribute-sets="code"> - <xsl:apply-templates select="text()"/> + <xsl:choose> + <xsl:when test="not(descendant::anno)"> + <xsl:value-of select="erl:code_trim(text())"/> + </xsl:when> + <xsl:otherwise> + <xsl:apply-templates/> + </xsl:otherwise> + </xsl:choose> </fo:block> <xsl:if test="@caption"> diff --git a/lib/erl_docgen/priv/xsl/db_pdf_params.xsl b/lib/erl_docgen/priv/xsl/db_pdf_params.xsl index d9a150d2d9..99da29c2ac 100644 --- a/lib/erl_docgen/priv/xsl/db_pdf_params.xsl +++ b/lib/erl_docgen/priv/xsl/db_pdf_params.xsl @@ -1,9 +1,9 @@ <?xml version="1.0" encoding="utf-8"?> -<!-- +<!-- # # %CopyrightBegin% # - # Copyright Ericsson AB 2009-2016. All Rights Reserved. + # Copyright Ericsson AB 2009-2017. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -18,7 +18,7 @@ # limitations under the License. # # %CopyrightEnd% - + --> <xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform" @@ -45,7 +45,7 @@ <xsl:param name="page-width">210mm</xsl:param> <!-- Paper size: US Letter (279x216 mm) --> - <!-- + <!-- <xsl:param name="page-height">11in</xsl:param> <xsl:param name="page-width">8.5in</xsl:param> --> @@ -248,86 +248,82 @@ </xsl:attribute-set> <xsl:attribute-set name="code"> - <xsl:attribute name="background-color">#e0e0ff</xsl:attribute> + <xsl:attribute name="background-color">#f1f3f5</xsl:attribute> + <xsl:attribute name="border-style">solid</xsl:attribute> + <xsl:attribute name="border-color">#dee2e6</xsl:attribute><!-- dee2e6--> + <xsl:attribute name="border-width">0.3mm</xsl:attribute> <xsl:attribute name="font-family">DejaVuSansMono, monospace</xsl:attribute> <xsl:attribute name="font-size">0.8em</xsl:attribute> - <xsl:attribute name="keep-together.within-page">auto</xsl:attribute> + <xsl:attribute name="keep-together.within-page">3</xsl:attribute> <xsl:attribute name="linefeed-treatment">preserve</xsl:attribute> - <xsl:attribute name="padding-before">0em</xsl:attribute> - <xsl:attribute name="padding-after">1em</xsl:attribute> - <xsl:attribute name="space-after">1em</xsl:attribute> - <xsl:attribute name="space-before">2em</xsl:attribute> - <xsl:attribute name="margin-left">0.5em</xsl:attribute> - <xsl:attribute name="margin-right">0.5em</xsl:attribute> + <xsl:attribute name="padding-before">1.5mm</xsl:attribute> + <xsl:attribute name="padding-after">1mm</xsl:attribute> + <xsl:attribute name="padding-left">1mm</xsl:attribute> + <xsl:attribute name="padding-right">1mm</xsl:attribute> + <xsl:attribute name="margin-left">1mm</xsl:attribute> + <xsl:attribute name="margin-right">1mm</xsl:attribute> <xsl:attribute name="white-space-collapse">false</xsl:attribute> <xsl:attribute name="white-space-treatment">preserve</xsl:attribute> <xsl:attribute name="wrap-option">no-wrap</xsl:attribute> + <xsl:attribute name="space-after">0.5em</xsl:attribute> + <xsl:attribute name="space-before">0.5em</xsl:attribute> </xsl:attribute-set> - - <xsl:attribute-set name="toc.level1"> <xsl:attribute name="space-before">1em</xsl:attribute> - </xsl:attribute-set> - -<xsl:attribute-set name="note"> - <xsl:attribute name="background-color">#d0fed0</xsl:attribute> - <xsl:attribute name="space-after">1em</xsl:attribute> - <xsl:attribute name="space-before">2em</xsl:attribute> - <xsl:attribute name="text-align">justify</xsl:attribute> - <xsl:attribute name="padding-before">1em</xsl:attribute> - <xsl:attribute name="padding-after">0.3em</xsl:attribute> - <xsl:attribute name="padding-left">0.5em</xsl:attribute> - <xsl:attribute name="padding-right">0.5em</xsl:attribute> - <xsl:attribute name="margin-left">0.5em</xsl:attribute> - <xsl:attribute name="margin-right">0.5em</xsl:attribute> - <xsl:attribute name="keep-together.within-page">always</xsl:attribute> </xsl:attribute-set> -<xsl:attribute-set name="warning"> - <xsl:attribute name="background-color">#ffd6d6</xsl:attribute> - <xsl:attribute name="space-after">1em</xsl:attribute> - <xsl:attribute name="space-before">2em</xsl:attribute> - <xsl:attribute name="text-align">justify</xsl:attribute> - <xsl:attribute name="padding-before">1em</xsl:attribute> - <xsl:attribute name="padding-after">0.3em</xsl:attribute> - <xsl:attribute name="padding-left">0.5em</xsl:attribute> - <xsl:attribute name="padding-right">0.5em</xsl:attribute> - <xsl:attribute name="margin-left">0.5em</xsl:attribute> - <xsl:attribute name="margin-right">0.5em</xsl:attribute> - <xsl:attribute name="keep-together.within-page">always</xsl:attribute> + <xsl:attribute-set name="note-title"> + <xsl:attribute name="space-before">0.5em</xsl:attribute> + <xsl:attribute name="border-style">solid</xsl:attribute> + <xsl:attribute name="border-bottom-width">0mm</xsl:attribute> + <xsl:attribute name="border-color">#495057</xsl:attribute> + <xsl:attribute name="background-color">#2b8a3e</xsl:attribute> + <xsl:attribute name="font-weight">bold</xsl:attribute> + <xsl:attribute name="color">#fefefe</xsl:attribute> + <xsl:attribute name="padding-before">1mm</xsl:attribute> + <xsl:attribute name="padding-after">0.5mm</xsl:attribute> + <xsl:attribute name="padding-left">1mm</xsl:attribute> + <xsl:attribute name="padding-right">1mm</xsl:attribute> + <xsl:attribute name="margin-left">1mm</xsl:attribute> + <xsl:attribute name="margin-right">1mm</xsl:attribute> + <xsl:attribute name="font-size">1.33em</xsl:attribute> </xsl:attribute-set> -<xsl:attribute-set name="do"> - <xsl:attribute name="background-color">#d0fed0</xsl:attribute> - <xsl:attribute name="space-after">1em</xsl:attribute> - <xsl:attribute name="space-before">2em</xsl:attribute> - <xsl:attribute name="text-align">justify</xsl:attribute> - <xsl:attribute name="padding-before">1em</xsl:attribute> - <xsl:attribute name="padding-after">0.3em</xsl:attribute> - <xsl:attribute name="padding-left">0.5em</xsl:attribute> - <xsl:attribute name="padding-right">0.5em</xsl:attribute> - <xsl:attribute name="margin-left">0.5em</xsl:attribute> - <xsl:attribute name="margin-right">0.5em</xsl:attribute> + <xsl:attribute-set name="note-warning"> <xsl:attribute name="keep-together.within-page">always</xsl:attribute> </xsl:attribute-set> -<xsl:attribute-set name="dont"> - <xsl:attribute name="background-color">#ffd6d6</xsl:attribute> - <xsl:attribute name="space-after">1em</xsl:attribute> - <xsl:attribute name="space-before">2em</xsl:attribute> - <xsl:attribute name="text-align">justify</xsl:attribute> - <xsl:attribute name="padding-before">1em</xsl:attribute> - <xsl:attribute name="padding-after">0.3em</xsl:attribute> - <xsl:attribute name="padding-left">0.5em</xsl:attribute> - <xsl:attribute name="padding-right">0.5em</xsl:attribute> - <xsl:attribute name="margin-left">0.5em</xsl:attribute> - <xsl:attribute name="margin-right">0.5em</xsl:attribute> - <xsl:attribute name="keep-together.within-page">always</xsl:attribute> + <xsl:attribute-set name="warning-title"> + <xsl:attribute name="space-before">0.5em</xsl:attribute> + <xsl:attribute name="border-style">solid</xsl:attribute> + <xsl:attribute name="border-bottom-width">0mm</xsl:attribute> + <xsl:attribute name="border-color">#495057</xsl:attribute> + <xsl:attribute name="background-color">#c92a2a</xsl:attribute> + <xsl:attribute name="font-weight">bold</xsl:attribute> + <xsl:attribute name="color">#fefefe</xsl:attribute> + <xsl:attribute name="padding-before">1mm</xsl:attribute> + <xsl:attribute name="padding-after">0.5mm</xsl:attribute> + <xsl:attribute name="padding-left">1mm</xsl:attribute> + <xsl:attribute name="padding-right">1mm</xsl:attribute> + <xsl:attribute name="margin-left">1mm</xsl:attribute> + <xsl:attribute name="margin-right">1mm</xsl:attribute> + <xsl:attribute name="font-size">1.33em</xsl:attribute> </xsl:attribute-set> - <xsl:attribute-set name="note-warning-title"> - <xsl:attribute name="font-size">1.33em</xsl:attribute> + <xsl:attribute-set name="note-warning-content"> + <xsl:attribute name="space-after">0.5em</xsl:attribute> + <xsl:attribute name="border-style">solid</xsl:attribute> + <xsl:attribute name="border-top-width">0mm</xsl:attribute> + <xsl:attribute name="border-color">#495057</xsl:attribute> + <xsl:attribute name="background-color">#f8f9fa</xsl:attribute> + <xsl:attribute name="text-align">justify</xsl:attribute> + <xsl:attribute name="padding-before">1mm</xsl:attribute> + <xsl:attribute name="padding-after">0.5mm</xsl:attribute> + <xsl:attribute name="padding-left">1mm</xsl:attribute> + <xsl:attribute name="padding-right">1mm</xsl:attribute> + <xsl:attribute name="margin-left">1mm</xsl:attribute> + <xsl:attribute name="margin-right">1mm</xsl:attribute> </xsl:attribute-set> <xsl:attribute-set name="module-header"> @@ -354,7 +350,7 @@ <xsl:attribute name="keep-with-next.within-page">always</xsl:attribute> <xsl:attribute name="space-after">0.25em</xsl:attribute> <!-- xsl:attribute name="space-before">1.5em</xsl:attribute --> - </xsl:attribute-set> + </xsl:attribute-set> <xsl:attribute-set name="type-listblock"> <xsl:attribute name="provisional-distance-between-starts">1.8em</xsl:attribute> diff --git a/lib/erl_docgen/src/docgen_edoc_xml_cb.erl b/lib/erl_docgen/src/docgen_edoc_xml_cb.erl index 7cdbb502d9..b065c18cda 100644 --- a/lib/erl_docgen/src/docgen_edoc_xml_cb.erl +++ b/lib/erl_docgen/src/docgen_edoc_xml_cb.erl @@ -11,7 +11,7 @@ %% limitations under the License. %% %% Copyright (c) 2001-2016 Richard Carlsson. Parts written by Ericsson -%% are Copyright (c) Ericsson AB 2001-2012. All Rights Reserved. +%% are Copyright (c) Ericsson AB 2001-2017. All Rights Reserved. %% -module(docgen_edoc_xml_cb). @@ -113,7 +113,7 @@ root_attributes(Element, Opts) -> %% epp:default_encoding/0 returns 'utf8' reformat_encoding(utf8) -> "UTF-8"; reformat_encoding(List) when is_list(List) -> - case string:to_lower(List) of + case string:lowercase(List) of "utf8" -> "UTF-8"; _ -> List end; @@ -489,6 +489,8 @@ otp_xmlify_a_href("#"++_ = Marker, Es0) -> % <seealso marker="#what"> {Marker, Es0}; otp_xmlify_a_href("http:"++_ = URL, Es0) -> % external URL {URL, Es0}; +otp_xmlify_a_href("https:"++_ = URL, Es0) -> % external URL + {URL, Es0}; otp_xmlify_a_href("OTPROOT"++AppRef, Es0) -> % <.. marker="App:FileRef [AppS, "doc", FileRef1] = split(AppRef, "/"), FileRef = AppS++":"++otp_xmlify_a_fileref(FileRef1, AppS), diff --git a/lib/erl_docgen/src/docgen_otp_specs.erl b/lib/erl_docgen/src/docgen_otp_specs.erl index 126229ecc9..9f2b401f93 100644 --- a/lib/erl_docgen/src/docgen_otp_specs.erl +++ b/lib/erl_docgen/src/docgen_otp_specs.erl @@ -297,7 +297,7 @@ indent(L) -> app_fix(L) -> try {"//" ++ R1,L2} = app_fix(L, 1), - [App, Mod] = string:tokens(R1, "/"), + [App, Mod] = string:lexemes(R1, "/"), "//" ++ atom(App) ++ "/" ++ atom(Mod) ++ L2 catch _:_ -> L end. @@ -585,13 +585,13 @@ ot_integer(E) -> {integer,0,list_to_integer(get_attrval(value, E))}. ot_range(E) -> - [I1, I2] = string:tokens(get_attrval(value, E), "."), + [I1, I2] = string:lexemes(get_attrval(value, E), "."), {type,0,range,[{integer,0,list_to_integer(I1)}, {integer,0,list_to_integer(I2)}]}. ot_binary(E) -> {Base, Unit} = - case string:tokens(get_attrval(value, E), ",:*><") of + case string:lexemes(get_attrval(value, E), ",:*><") of [] -> {0, 0}; ["_",B] -> diff --git a/lib/erl_docgen/vsn.mk b/lib/erl_docgen/vsn.mk index 17a7c483f4..95b2329ac5 100644 --- a/lib/erl_docgen/vsn.mk +++ b/lib/erl_docgen/vsn.mk @@ -1 +1 @@ -ERL_DOCGEN_VSN = 0.7.1 +ERL_DOCGEN_VSN = 0.7.2 diff --git a/lib/erl_interface/doc/src/Makefile b/lib/erl_interface/doc/src/Makefile index 204a6051b2..8ef7e9648c 100644 --- a/lib/erl_interface/doc/src/Makefile +++ b/lib/erl_interface/doc/src/Makefile @@ -1,8 +1,8 @@ # # %CopyrightBegin% -# -# Copyright Ericsson AB 1998-2016. All Rights Reserved. -# +# +# Copyright Ericsson AB 1998-2017. All Rights Reserved. +# # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at @@ -14,7 +14,7 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. -# +# # %CopyrightEnd% # include $(ERL_TOP)/make/target.mk @@ -36,7 +36,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) # Target Specs # ---------------------------------------------------- -XML_REF1_FILES = erl_call.xml +XML_REF1_FILES = erl_call.xml XML_REF3_FILES = erl_connect.xml \ erl_error.xml \ erl_eterm.xml \ @@ -46,16 +46,14 @@ XML_REF3_FILES = erl_connect.xml \ erl_global.xml \ ei.xml \ ei_connect.xml \ - registry.xml + registry.xml BOOK_FILES = book.xml -XML_APPLICATION_FILES = ref_man.xml +XML_APPLICATION_FILES = ref_man.xml #ref_man_ei.xml ref_man_erl_interface.xml XML_PART_FILES = \ - part.xml \ - part_notes.xml \ - part_notes_history.xml -XML_CHAPTER_FILES = ei_users_guide.xml notes.xml notes_history.xml + part.xml +XML_CHAPTER_FILES = ei_users_guide.xml notes.xml XML_FILES = $(XML_REF1_FILES) $(XML_REF3_FILES) $(BOOK_FILES) \ $(XML_APPLICATION_FILES) $(XML_PART_FILES) $(XML_CHAPTER_FILES) @@ -66,7 +64,7 @@ HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ INFO_FILE = ../../info -GIF_FILES = +GIF_FILES = MAN1_FILES = $(XML_REF1_FILES:%.xml=$(MAN1DIR)/%.1) MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) @@ -76,9 +74,9 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += +XML_FLAGS += # ---------------------------------------------------- # Targets @@ -98,7 +96,7 @@ man: $(MAN1_FILES) $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) -debug opt: +debug opt: clean clean_docs clean_tex: rm -rf $(HTMLDIR)/* @@ -110,7 +108,7 @@ clean clean_docs clean_tex: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs @@ -127,4 +125,3 @@ release_docs_spec: docs release_spec: - diff --git a/lib/erl_interface/doc/src/note.gif b/lib/erl_interface/doc/src/note.gif Binary files differdeleted file mode 100644 index 6fffe30419..0000000000 --- a/lib/erl_interface/doc/src/note.gif +++ /dev/null diff --git a/lib/erl_interface/doc/src/notes.xml b/lib/erl_interface/doc/src/notes.xml index ec20f3c67f..641a3de13f 100644 --- a/lib/erl_interface/doc/src/notes.xml +++ b/lib/erl_interface/doc/src/notes.xml @@ -31,6 +31,21 @@ </header> <p>This document describes the changes made to the Erl_interface application.</p> +<section><title>Erl_Interface 3.10.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Removed all old unused files in the documentation. + </p> + <p> + Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p> + </item> + </list> + </section> + +</section> + <section><title>Erl_Interface 3.10</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/erl_interface/doc/src/part_notes.xml b/lib/erl_interface/doc/src/part_notes.xml deleted file mode 100644 index facdf821ee..0000000000 --- a/lib/erl_interface/doc/src/part_notes.xml +++ /dev/null @@ -1,39 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2004</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>Erl_Interface Release Notes</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p><em>Erl_Interface</em> is a C interface library for communication - with Erlang.</p> - <p>For information about older versions, see - <url href="part_notes_history_frame.html">Release Notes History</url>.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/erl_interface/doc/src/part_notes_history.xml b/lib/erl_interface/doc/src/part_notes_history.xml deleted file mode 100644 index 401fea4dd4..0000000000 --- a/lib/erl_interface/doc/src/part_notes_history.xml +++ /dev/null @@ -1,37 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2006</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>Erl_Interface Release Notes History</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p><em>Erl_Interface</em> is a C interface library for communication - with Erlang.</p> - </description> - <xi:include href="notes_history.xml"/> -</part> - diff --git a/lib/erl_interface/doc/src/warning.gif b/lib/erl_interface/doc/src/warning.gif Binary files differdeleted file mode 100644 index 96af52360e..0000000000 --- a/lib/erl_interface/doc/src/warning.gif +++ /dev/null diff --git a/lib/erl_interface/src/Makefile b/lib/erl_interface/src/Makefile index 31f34d4bba..135522397b 100644 --- a/lib/erl_interface/src/Makefile +++ b/lib/erl_interface/src/Makefile @@ -29,5 +29,5 @@ include $(ERL_TOP)/make/target.mk debug opt shared purify quantify purecov gcov: $(make_verbose)$(MAKE) -f $(TARGET)/Makefile TYPE=$@ -clean depend docs release release_docs tests release_tests check: +clean depend docs release release_docs tests release_tests check xmllint: $(make_verbose)$(MAKE) -f $(TARGET)/Makefile $@ diff --git a/lib/erl_interface/src/Makefile.in b/lib/erl_interface/src/Makefile.in index 4f393e952c..69b5b6003d 100644 --- a/lib/erl_interface/src/Makefile.in +++ b/lib/erl_interface/src/Makefile.in @@ -854,3 +854,5 @@ endif release_docs: release_tests: + +xmllint: diff --git a/lib/erl_interface/test/ei_accept_SUITE.erl b/lib/erl_interface/test/ei_accept_SUITE.erl index e06ee762d7..6676e73e21 100644 --- a/lib/erl_interface/test/ei_accept_SUITE.erl +++ b/lib/erl_interface/test/ei_accept_SUITE.erl @@ -25,7 +25,8 @@ -include("ei_accept_SUITE_data/ei_accept_test_cases.hrl"). -export([all/0, suite/0, - ei_accept/1, ei_threaded_accept/1]). + ei_accept/1, ei_threaded_accept/1, + monitor_ei_process/1]). -import(runner, [get_term/1,send_term/2]). @@ -34,7 +35,8 @@ suite() -> {timetrap, {seconds, 30}}]. all() -> - [ei_accept, ei_threaded_accept]. + [ei_accept, ei_threaded_accept, + monitor_ei_process]. ei_accept(Config) when is_list(Config) -> P = runner:start(?interpret), @@ -44,33 +46,32 @@ ei_accept(Config) when is_list(Config) -> io:format("Myname ~p ~n", [Myname]), EINode = list_to_atom("c42@"++Myname), io:format("EINode ~p ~n", [EINode]), + + %% We take this opportunity to also test export-funs and bit-strings + %% with (ugly) tuple fallbacks. + %% Test both toward pending connection and established connection. + RealTerms = [<<1:1>>, fun lists:map/2], + Fallbacks = [{<<128>>,1}, {lists,map}], + Self = self(), - TermToSend= {call, Self, "Test"}, - F= fun() -> - case waitfornode("c42",20) of - true -> - {any, EINode} ! TermToSend, - Self ! sent_ok; - false -> - Self ! never_published - end, - ok - end, - - spawn(F), + Funny = fun() -> hello end, + TermToSend = {call, Self, "Test", Funny, RealTerms}, + TermToGet = {call, Self, "Test", Funny, Fallbacks}, Port = 6543, - {ok, Fd, _Node} = ei_accept(P, Port), - TermReceived= ei_receive(P, Fd), - io:format("Sent ~p received ~p ~n", [TermToSend, TermReceived]), - TermToSend= TermReceived, - receive - sent_ok -> - ok; - Unknown -> - io:format("~p ~n", [Unknown]) - after 1000 -> - io:format("timeout ~n") - end, + {ok, ListenFd} = ei_publish(P, Port), + {any, EINode} ! TermToSend, + + {ok, Fd, _Node} = ei_accept(P, ListenFd), + Got1 = ei_receive(P, Fd), + + %% Send again, now without auto-connect + {any, EINode} ! TermToSend, + Got2 = ei_receive(P, Fd), + + io:format("Sent ~p~nExp. ~p~nGot1 ~p~nGot2 ~p~n", [TermToSend, TermToGet, Got1, Got2]), + TermToGet = Got1, + TermToGet = Got2, + runner:finish(P), ok. @@ -87,6 +88,41 @@ ei_threaded_accept(Config) when is_list(Config) -> [receive I -> ok end || I <- lists:seq(0, N-1) ], ok. + +%% Test erlang:monitor toward erl_interface "processes" +monitor_ei_process(Config) when is_list(Config) -> + P = runner:start(?interpret), + 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0), + + Myname = hd(tl(string:tokens(atom_to_list(node()), "@"))), + io:format("Myname ~p ~n", [Myname]), + EINode = list_to_atom("c42@"++Myname), + io:format("EINode ~p ~n", [EINode]), + + Self = self(), + Port = 6543, + {ok, ListenFd} = ei_publish(P, Port), + MRef1 = erlang:monitor(process, {any, EINode}), + {any, EINode} ! hello, + + {ok, Fd, _Node} = ei_accept(P, ListenFd), + hello = ei_receive(P, Fd), + + %% Again, now on an established connection. + MRef2 = erlang:monitor(process, {any, EINode}), + {any, EINode} ! hello, + hello = ei_receive(P, Fd), + + ok = receive M -> M after 0 -> ok end, + + runner:finish(P), + + [{'DOWN', MRef1, process, {any, EINode}, noconnection}, + {'DOWN', MRef2, process, {any, EINode}, noconnection} + ] = lists:sort(flush(2, 1000)), + + ok. + waitfornode(String,0) -> io:format("~s never published itself.~n",[String]), false; @@ -137,8 +173,15 @@ ei_connect_init(P, Num, Cookie, Creation) -> {term,Int} when is_integer(Int) -> Int end. -ei_accept(P, PortNo) -> - send_command(P, ei_accept, [PortNo]), +ei_publish(P, PortNo) -> + send_command(P, ei_publish, [PortNo]), + case get_term(P) of + {term,{ListenFd, EpmdFd, _}} when ListenFd >= 0, EpmdFd >= 0 -> {ok, ListenFd}; + {term,{_, _, Errno}} -> {error,Errno} + end. + +ei_accept(P, ListenFd) -> + send_command(P, ei_accept, [ListenFd]), case get_term(P) of {term,{Fd, _, Node}} when Fd >= 0 -> {ok, Fd, Node}; {term,{_Fd, Errno, _Node}} -> {error,Errno} @@ -151,3 +194,12 @@ ei_receive(P, Fd) -> send_command(P, Name, Args) -> runner:send_term(P, {Name,list_to_tuple(Args)}). + +flush(0, Timeout) -> + flush(1, Timeout div 10); +flush(Expected, Timeout) -> + receive M -> + [M | flush(Expected-1, Timeout)] + after Timeout -> + [] + end. diff --git a/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c b/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c index 7b81ee5491..2b62d7c3a4 100644 --- a/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c +++ b/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c @@ -43,6 +43,7 @@ #include "ei_runner.h" static void cmd_ei_connect_init(char* buf, int len); +static void cmd_ei_publish(char* buf, int len); static void cmd_ei_accept(char* buf, int len); static void cmd_ei_receive(char* buf, int len); static void cmd_ei_unpublish(char* buf, int len); @@ -58,6 +59,7 @@ static struct { void (*func)(char* buf, int len); } commands[] = { "ei_connect_init", 3, cmd_ei_connect_init, + "ei_publish", 1, cmd_ei_publish, "ei_accept", 1, cmd_ei_accept, "ei_receive", 1, cmd_ei_receive, "ei_unpublish", 0, cmd_ei_unpublish @@ -149,11 +151,10 @@ static int my_listen(int port) return listen_fd; } -static void cmd_ei_accept(char* buf, int len) +static void cmd_ei_publish(char* buf, int len) { int index = 0; int listen, r; - ErlConnect conn; long port; ei_x_buff x; int i; @@ -170,6 +171,29 @@ static void cmd_ei_accept(char* buf, int len) #ifdef VXWORKS save_fd(i); #endif + /* send listen-fd, result and errno */ + ei_x_new_with_version(&x); + ei_x_encode_tuple_header(&x, 3); + ei_x_encode_long(&x, listen); + ei_x_encode_long(&x, i); + ei_x_encode_long(&x, erl_errno); + send_bin_term(&x); + ei_x_free(&x); +} + +static void cmd_ei_accept(char* buf, int len) +{ + int index = 0; + int r; + ErlConnect conn; + long listen; + ei_x_buff x; + int i; + + /* get port */ + if (ei_decode_long(buf, &index, &listen) < 0) + fail("expected int (listen fd)"); + r = ei_accept(&ec, listen, &conn); #ifdef VXWORKS save_fd(r); @@ -200,7 +224,7 @@ static void cmd_ei_receive(char* buf, int len) if (got == ERL_TICK) continue; if (got == ERL_ERROR) - fail("ei_xreceive_msg"); + fail1("ei_xreceive_msg, got==%d", got); break; } index = 1; diff --git a/lib/erl_interface/test/runner.erl b/lib/erl_interface/test/runner.erl index 1084eec2a3..cbdeb3c8a9 100644 --- a/lib/erl_interface/test/runner.erl +++ b/lib/erl_interface/test/runner.erl @@ -67,7 +67,12 @@ start({Prog, Tc}) when is_list(Prog), is_integer(Tc) -> finish(Port) when is_port(Port) -> send_eot(Port), - recv_eot(Port). + ok = recv_eot(Port), + 0 = receive + {Port,{exit_status,Status}} -> + Status + end, + ok. %% Sends an Erlang term to a C program. diff --git a/lib/erl_interface/vsn.mk b/lib/erl_interface/vsn.mk index 01fcee86dd..d76d110afd 100644 --- a/lib/erl_interface/vsn.mk +++ b/lib/erl_interface/vsn.mk @@ -1,2 +1,2 @@ -EI_VSN = 3.10 +EI_VSN = 3.10.1 ERL_INTERFACE_VSN = $(EI_VSN) diff --git a/lib/et/src/et_collector.erl b/lib/et/src/et_collector.erl index b0f016a8ea..ffe244324c 100644 --- a/lib/et/src/et_collector.erl +++ b/lib/et/src/et_collector.erl @@ -1135,7 +1135,7 @@ handle_info(Info, S) -> noreply(S). listen_on_trace_port(Node, Port, S) -> - [_Name, Host] = string:tokens(atom_to_list(Node), [$@]), + [_Name, Host] = string:lexemes(atom_to_list(Node), [$@]), case catch start_trace_client(self(), ip, {Host, Port}) of {trace_client_pid, RemotePid} -> rpc:call(Node, et_selector, change_pattern, [S#state.trace_pattern]), diff --git a/lib/eunit/doc/src/Makefile b/lib/eunit/doc/src/Makefile index f1491eb873..610e575af6 100644 --- a/lib/eunit/doc/src/Makefile +++ b/lib/eunit/doc/src/Makefile @@ -1,5 +1,5 @@ #<copyright> -# <year>2004-2007</year> +# <year>2004-2017</year> # <holder>Ericsson AB, All Rights Reserved</holder> #</copyright> #<legalnotice> @@ -51,11 +51,10 @@ EUNIT_MODULES = \ XML_APPLICATION_FILES = ref_man.xml -XML_REF3_FILES = $(EUNIT_MODULES:=.xml) +XML_REF3_FILES = $(EUNIT_MODULES:=.xml) XML_PART_FILES = \ - part.xml \ - part_notes.xml + part.xml XML_CHAPTER_FILES = \ chapter.xml @@ -63,7 +62,7 @@ XML_CHAPTER_FILES = \ XML_NOTES_FILES = \ notes.xml -HTML_EXAMPLE_FILES = +HTML_EXAMPLE_FILES = HTML_STYLESHEET_FILES = \ ../stylesheet.css @@ -99,10 +98,10 @@ TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += +XML_FLAGS += +DVIPS_FLAGS += # ---------------------------------------------------- # Targets @@ -123,8 +122,8 @@ man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) -$(XML_REF3_FILES): - escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(EUNIT_VSN) -i $(EUNIT_INC_DIR) $(EUNIT_DIR)/$(@:%.xml=%.erl) +$(XML_REF3_FILES): + escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(EUNIT_VSN) -i $(EUNIT_INC_DIR) $(EUNIT_DIR)/$(@:%.xml=%.erl) $(XML_CHAPTER_FILES): escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(EUNIT_VSN) -chapter ../overview.edoc @@ -142,19 +141,19 @@ info: xml: $(XML_REF3_FILES) $(XML_CHAPTER_FILES) -debug opt: +debug opt: clean clean_docs: rm -rf $(HTMLDIR)/* rm -f $(MAN3DIR)/* rm -f $(XML_REF3_FILES) $(XML_CHAPTER_FILES) *.html rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ + rm -f errs core *~ # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs @@ -169,6 +168,3 @@ release_docs_spec: docs release_spec: - - - diff --git a/lib/eunit/doc/src/fascicules.xml b/lib/eunit/doc/src/fascicules.xml deleted file mode 100644 index 217228785c..0000000000 --- a/lib/eunit/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/eunit/doc/src/notes.xml b/lib/eunit/doc/src/notes.xml index 7133befe37..b38cb2e70e 100644 --- a/lib/eunit/doc/src/notes.xml +++ b/lib/eunit/doc/src/notes.xml @@ -33,6 +33,21 @@ </header> <p>This document describes the changes made to the EUnit application.</p> +<section><title>Eunit 2.3.5</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Removed all old unused files in the documentation. + </p> + <p> + Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p> + </item> + </list> + </section> + +</section> + <section><title>Eunit 2.3.4</title> <section><title>Improvements and New Features</title> diff --git a/lib/eunit/doc/src/part_notes.xml b/lib/eunit/doc/src/part_notes.xml deleted file mode 100644 index 7db65083e0..0000000000 --- a/lib/eunit/doc/src/part_notes.xml +++ /dev/null @@ -1,40 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2008</year> - <year>2016</year> - <holder>Ericsson AB, All Rights Reserved</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>EUnit Release Notes</title> - <prepared></prepared> - <docno></docno> - <date>2008-10-29</date> - <rev></rev> - - </header> - <description> - <p>The <em>EUnit</em> application - contains modules with support for unit testing</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/eunit/src/eunit_lib.erl b/lib/eunit/src/eunit_lib.erl index e340f50a3c..d1bd160ea1 100644 --- a/lib/eunit/src/eunit_lib.erl +++ b/lib/eunit/src/eunit_lib.erl @@ -391,7 +391,7 @@ fun_parent(F) -> -ifdef(TEST). fun_parent_test() -> - {?MODULE,fun_parent_test,0} = fun_parent(fun () -> ok end). + {?MODULE,fun_parent_test,0} = fun_parent(fun (A) -> {ok,A} end). -endif. %% --------------------------------------------------------------------- diff --git a/lib/eunit/vsn.mk b/lib/eunit/vsn.mk index 25bb0dec17..2ed9eaac16 100644 --- a/lib/eunit/vsn.mk +++ b/lib/eunit/vsn.mk @@ -1 +1 @@ -EUNIT_VSN = 2.3.4 +EUNIT_VSN = 2.3.5 diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index a3a936322a..462a1f9dcd 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -1701,24 +1701,6 @@ type(maps, size, 1, Xs, Opaques) -> t_from_range(LowerBound, UpperBound) end end, Opaques); -type(maps, to_list, 1, Xs, Opaques) -> - strict(maps, to_list, 1, Xs, - fun ([Map]) -> - DefK = t_map_def_key(Map, Opaques), - DefV = t_map_def_val(Map, Opaques), - Pairs = t_map_entries(Map, Opaques), - EType = lists:foldl( - fun({K,_,V},EType0) -> - case t_is_none(V) of - true -> t_subtract(EType0, t_tuple([K,t_any()])); - false -> t_sup(EType0, t_tuple([K,V])) - end - end, t_tuple([DefK, DefV]), Pairs), - case t_is_none(EType) of - true -> t_nil(); - false -> t_list(EType) - end - end, Opaques); type(maps, update, 3, Xs, Opaques) -> strict(maps, update, 3, Xs, fun ([Key, Value, Map]) -> @@ -2648,8 +2630,6 @@ arg_types(maps, put, 3) -> [t_any(), t_any(), t_map()]; arg_types(maps, size, 1) -> [t_map()]; -arg_types(maps, to_list, 1) -> - [t_map()]; arg_types(maps, update, 3) -> [t_any(), t_any(), t_map()]; arg_types(M, F, A) when is_atom(M), is_atom(F), diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index abb6c259f6..77a2a7401c 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -1877,6 +1877,7 @@ t_map_put(KV, Map, Opaques) -> %% Key and Value are *not* unopaqued, but the map is map_put(_, ?none, _) -> ?none; +map_put(_, ?unit, _) -> ?none; map_put({Key, Value}, ?map(Pairs,DefK,DefV), Opaques) -> case t_is_none_or_unit(Key) orelse t_is_none_or_unit(Value) of true -> ?none; @@ -1902,6 +1903,7 @@ t_map_update(KV, Map) -> -spec t_map_update({erl_type(), erl_type()}, erl_type(), opaques()) -> erl_type(). t_map_update(_, ?none, _) -> ?none; +t_map_update(_, ?unit, _) -> ?none; t_map_update(KV={Key, _}, M, Opaques) -> case t_is_subtype(t_atom('true'), t_map_is_key(Key, M, Opaques)) of false -> ?none; @@ -1922,6 +1924,7 @@ t_map_get(Key, Map, Opaques) -> end). map_get(_, ?none) -> ?none; +map_get(_, ?unit) -> ?none; map_get(Key, ?map(Pairs, DefK, DefV)) -> DefRes = case t_do_overlap(DefK, Key) of @@ -1957,6 +1960,7 @@ t_map_is_key(Key, Map, Opaques) -> end). map_is_key(_, ?none) -> ?none; +map_is_key(_, ?unit) -> ?none; map_is_key(Key, ?map(Pairs, DefK, _DefV)) -> case is_singleton_type(Key) of true -> @@ -4249,13 +4253,13 @@ t_to_string(?identifier(Set), _RecDict) -> case Set of ?any -> "identifier()"; _ -> - string:join([flat_format("~w()", [T]) || T <- set_to_list(Set)], " | ") + flat_join([flat_format("~w()", [T]) || T <- set_to_list(Set)], " | ") end; t_to_string(?opaque(Set), RecDict) -> - string:join([opaque_type(Mod, Name, Args, S, RecDict) || - #opaque{mod = Mod, name = Name, struct = S, args = Args} - <- set_to_list(Set)], - " | "); + flat_join([opaque_type(Mod, Name, Args, S, RecDict) || + #opaque{mod = Mod, name = Name, struct = S, args = Args} + <- set_to_list(Set)], + " | "); t_to_string(?matchstate(Pres, Slots), RecDict) -> flat_format("ms(~ts,~ts)", [t_to_string(Pres, RecDict), t_to_string(Slots,RecDict)]); @@ -4346,9 +4350,9 @@ t_to_string(?map(Pairs0,DefK,DefV), RecDict) -> end end, StrMand = [{Tos(K),Tos(V)}||{K,?mand,V}<-Pairs], StrOpt = [{Tos(K),Tos(V)}||{K,?opt,V}<-Pairs], - "#{" ++ string:join([K ++ ":=" ++ V||{K,V}<-StrMand] - ++ [K ++ "=>" ++ V||{K,V}<-StrOpt] - ++ ExtraEl, ", ") ++ "}"; + "#{" ++ flat_join([K ++ ":=" ++ V||{K,V}<-StrMand] + ++ [K ++ "=>" ++ V||{K,V}<-StrOpt] + ++ ExtraEl, ", ") ++ "}"; t_to_string(?tuple(?any, ?any, ?any), _RecDict) -> "tuple()"; t_to_string(?tuple(Elements, _Arity, ?any), RecDict) -> "{" ++ comma_sequence(Elements, RecDict) ++ "}"; @@ -4371,7 +4375,7 @@ t_to_string(?var(Id), _RecDict) when is_integer(Id) -> record_to_string(Tag, [_|Fields], FieldNames, RecDict) -> FieldStrings = record_fields_to_string(Fields, FieldNames, RecDict, []), - "#" ++ atom_to_string(Tag) ++ "{" ++ string:join(FieldStrings, ",") ++ "}". + "#" ++ atom_to_string(Tag) ++ "{" ++ flat_join(FieldStrings, ",") ++ "}". record_fields_to_string([F|Fs], [{FName, _Abstr, DefType}|FDefs], RecDict, Acc) -> @@ -4397,7 +4401,7 @@ record_field_diffs_to_string(?tuple([_|Fs], Arity, Tag), RecDict) -> {ok, FieldNames} = lookup_record(TagAtom, Arity-1, RecDict), %% io:format("RecCElems = ~p\nRecTypes = ~p\n", [Fs, FieldNames]), FieldDiffs = field_diffs(Fs, FieldNames, RecDict, []), - string:join(FieldDiffs, " and "). + flat_join(FieldDiffs, " and "). field_diffs([F|Fs], [{FName, _Abstr, DefType}|FDefs], RecDict, Acc) -> %% Don't care about opacity for now. @@ -4417,11 +4421,11 @@ comma_sequence(Types, RecDict) -> true -> "_"; false -> t_to_string(T, RecDict) end || T <- Types], - string:join(List, ","). + flat_join(List, ","). union_sequence(Types, RecDict) -> List = [t_to_string(T, RecDict) || T <- Types], - string:join(List, " | "). + flat_join(List, " | "). -ifdef(DEBUG). opaque_type(Mod, Name, _Args, S, RecDict) -> @@ -5261,7 +5265,7 @@ t_form_to_string({ann_type, _L, [Var, Type]}) -> t_form_to_string({paren_type, _L, [Type]}) -> flat_format("(~ts)", [t_form_to_string(Type)]); t_form_to_string({remote_type, _L, [{atom, _, Mod}, {atom, _, Name}, Args]}) -> - ArgString = "(" ++ string:join(t_form_to_string_list(Args), ",") ++ ")", + ArgString = "(" ++ flat_join(t_form_to_string_list(Args), ",") ++ ")", flat_format("~w:~tw", [Mod, Name]) ++ ArgString; t_form_to_string({type, _L, arity, []}) -> "arity()"; t_form_to_string({type, _L, binary, []}) -> "binary()"; @@ -5284,7 +5288,7 @@ t_form_to_string({type, _L, 'fun', []}) -> "fun()"; t_form_to_string({type, _L, 'fun', [{type, _, any}, Range]}) -> "fun(...) -> " ++ t_form_to_string(Range); t_form_to_string({type, _L, 'fun', [{type, _, product, Domain}, Range]}) -> - "fun((" ++ string:join(t_form_to_string_list(Domain), ",") ++ ") -> " + "fun((" ++ flat_join(t_form_to_string_list(Domain), ",") ++ ") -> " ++ t_form_to_string(Range) ++ ")"; t_form_to_string({type, _L, iodata, []}) -> "iodata()"; t_form_to_string({type, _L, iolist, []}) -> "iolist()"; @@ -5292,7 +5296,7 @@ t_form_to_string({type, _L, list, [Type]}) -> "[" ++ t_form_to_string(Type) ++ "]"; t_form_to_string({type, _L, map, any}) -> "map()"; t_form_to_string({type, _L, map, Args}) -> - "#{" ++ string:join(t_form_to_string_list(Args), ",") ++ "}"; + "#{" ++ flat_join(t_form_to_string_list(Args), ",") ++ "}"; t_form_to_string({type, _L, map_field_assoc, [Key, Val]}) -> t_form_to_string(Key) ++ "=>" ++ t_form_to_string(Val); t_form_to_string({type, _L, map_field_exact, [Key, Val]}) -> @@ -5304,7 +5308,7 @@ t_form_to_string({type, _L, nonempty_list, [Type]}) -> "[" ++ t_form_to_string(Type) ++ ",...]"; t_form_to_string({type, _L, nonempty_string, []}) -> "nonempty_string()"; t_form_to_string({type, _L, product, Elements}) -> - "<" ++ string:join(t_form_to_string_list(Elements), ",") ++ ">"; + "<" ++ flat_join(t_form_to_string_list(Elements), ",") ++ ">"; t_form_to_string({type, _L, range, [From, To]} = Type) -> case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of {{integer, _, FromVal}, {integer, _, ToVal}} -> @@ -5314,7 +5318,7 @@ t_form_to_string({type, _L, range, [From, To]} = Type) -> t_form_to_string({type, _L, record, [{atom, _, Name}]}) -> flat_format("#~tw{}", [Name]); t_form_to_string({type, _L, record, [{atom, _, Name}|Fields]}) -> - FieldString = string:join(t_form_to_string_list(Fields), ","), + FieldString = flat_join(t_form_to_string_list(Fields), ","), flat_format("#~tw{~ts}", [Name, FieldString]); t_form_to_string({type, _L, field_type, [{atom, _, Name}, Type]}) -> flat_format("~tw::~ts", [Name, t_form_to_string(Type)]); @@ -5322,9 +5326,9 @@ t_form_to_string({type, _L, term, []}) -> "term()"; t_form_to_string({type, _L, timeout, []}) -> "timeout()"; t_form_to_string({type, _L, tuple, any}) -> "tuple()"; t_form_to_string({type, _L, tuple, Args}) -> - "{" ++ string:join(t_form_to_string_list(Args), ",") ++ "}"; + "{" ++ flat_join(t_form_to_string_list(Args), ",") ++ "}"; t_form_to_string({type, _L, union, Args}) -> - string:join(t_form_to_string_list(Args), " | "); + flat_join(t_form_to_string_list(Args), " | "); t_form_to_string({type, _L, Name, []} = T) -> try M = mod, @@ -5342,7 +5346,7 @@ t_form_to_string({type, _L, Name, []} = T) -> end; t_form_to_string({user_type, _L, Name, List}) -> flat_format("~tw(~ts)", - [Name, string:join(t_form_to_string_list(List), ",")]); + [Name, flat_join(t_form_to_string_list(List), ",")]); t_form_to_string({type, L, Name, List}) -> %% Compatibility: modules compiled before Erlang/OTP 18.0. t_form_to_string({user_type, L, Name, List}). @@ -5603,7 +5607,7 @@ set_to_string(Set) -> true -> io_lib:write_string(atom_to_list(X), $'); % stupid emacs ' false -> flat_format("~tw", [X]) end || X <- set_to_list(Set)], - string:join(L, " | "). + flat_join(L, " | "). set_min([H|_]) -> H. @@ -5613,6 +5617,9 @@ set_max(Set) -> flat_format(F, S) -> lists:flatten(io_lib:format(F, S)). +flat_join(List, Sep) -> + lists:flatten(lists:join(Sep, List)). + %%============================================================================= %% %% Utilities for the binary type diff --git a/lib/hipe/doc/src/Makefile b/lib/hipe/doc/src/Makefile index a5edb80381..1c774d3357 100644 --- a/lib/hipe/doc/src/Makefile +++ b/lib/hipe/doc/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2006-2016. All Rights Reserved. +# Copyright Ericsson AB 2006-2017. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -36,9 +36,9 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml -XML_REF3_FILES = +XML_REF3_FILES = -XML_PART_FILES = part_notes.xml +XML_PART_FILES = hipe_app.xml XML_CHAPTER_FILES = notes.xml BOOK_FILES = book.xml @@ -47,7 +47,7 @@ XML_FILES = \ $(BOOK_FILES) $(XML_CHAPTER_FILES) \ $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_APPLICATION_FILES) -GIF_FILES = +GIF_FILES = # ---------------------------------------------------- @@ -68,9 +68,9 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += +XML_FLAGS += # ---------------------------------------------------- # Targets @@ -90,20 +90,20 @@ man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) -debug opt: +debug opt: clean clean_docs: rm -rf $(HTMLDIR)/* rm -f $(MAN3DIR)/* rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ + rm -f errs core *~ distclean: clean realclean: clean # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs diff --git a/lib/hipe/doc/src/fascicules.xml b/lib/hipe/doc/src/fascicules.xml deleted file mode 100644 index b15610fa8b..0000000000 --- a/lib/hipe/doc/src/fascicules.xml +++ /dev/null @@ -1,12 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part_notes" href="part_notes_frame.html" entry="yes"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/hipe/doc/src/hipe_app.xml b/lib/hipe/doc/src/hipe_app.xml index e489d155c3..aaeb06193d 100644 --- a/lib/hipe/doc/src/hipe_app.xml +++ b/lib/hipe/doc/src/hipe_app.xml @@ -47,6 +47,61 @@ Details on HiPE compiler options are given by <c>hipe:help_options()</c>.</p> </description> <section> + <title>Feature Limitations</title> + <p> + The HiPE compiler is in general compliant with the normal BEAM compiler, + with respect to semantic behavior. There are however features in the BEAM compiler + and the runtime system that have limited or no support for HiPE compiled modules. + </p> + <taglist> + <tag>Stack traces</tag> + <item><p>Stack traces returned from <seealso marker="erts:erlang#get_stacktrace/0"> + <c>erlang:get_stacktrace/0</c></seealso> or as part of <c>'EXIT'</c> terms + can look incomplete if HiPE compiled functions are involved. Typically a stack trace + will contain only BEAM compiled functions or only HiPE compiled functions, depending + on where the exception was raised.</p> + <p>Source code line numbers in stack traces are also not supported by HiPE compiled functions.</p> + </item> + + <tag>Tracing</tag> + <item><p>Erlang call trace is not supported by HiPE. Calling + <seealso marker="erts:erlang#trace_pattern/3"><c>erlang:trace_pattern({M,F,A}, ...)</c></seealso> + does not have any effect on HiPE compiled modules.</p> + </item> + + <tag>NIFs</tag> + <item><p>Modules compiled with HiPE can not call <seealso marker="erts:erlang#load_nif-2"> + <c>erlang:load_nif/2</c></seealso> to load NIFs.</p> + </item> + + <tag>-on_load</tag> + <item><p>Modules compiled with HiPE can not use + <seealso marker="doc/reference_manual:code_loading#on_load"><c>-on_load()</c></seealso> + directives.</p> + </item> + </taglist> + + </section> + <section> + <title>Performance Limitations</title> + <p> + The HiPE compiler does in general produce faster code than the + BEAM compiler. There are however some situation when HiPE + compiled code will perform worse than BEAM code. + </p> + <taglist> + <tag>Mode switches</tag> + <item><p>Every time a process changes from executing code in a + HiPE compiled module to a BEAM compiled module (or vice versa), + it will do a mode switch. This involves a certain amount of + CPU overhead which can have a negative net impact if the + process is switching back and forth without getting enough done in + each mode.</p> + </item> + + </taglist> + </section> + <section> <title>SEE ALSO</title> <p> <seealso marker="stdlib:c">c(3)</seealso>, diff --git a/lib/hipe/doc/src/notes.xml b/lib/hipe/doc/src/notes.xml index eadaee50e2..bad0c254ce 100644 --- a/lib/hipe/doc/src/notes.xml +++ b/lib/hipe/doc/src/notes.xml @@ -31,6 +31,39 @@ </header> <p>This document describes the changes made to HiPE.</p> +<section><title>Hipe 3.17</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix bug for hipe compiled code using + <c><<X/utf32>></c> binary construction that + could cause faulty result or even VM crash.</p> + <p> + On architectures other than x86_64, code need to be + recompiled to benefit from this fix.</p> + <p> + Own Id: OTP-14740</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Added documentation about limitations of hipe compared to + beam compiled code.</p> + <p> + Own Id: OTP-14767</p> + </item> + </list> + </section> + +</section> + <section><title>Hipe 3.16.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/hipe/doc/src/part_notes.xml b/lib/hipe/doc/src/part_notes.xml deleted file mode 100644 index 828c304fb5..0000000000 --- a/lib/hipe/doc/src/part_notes.xml +++ /dev/null @@ -1,36 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2006</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>HiPE Release Notes</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p><em>HiPE</em> - High Performance Erlang.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl index 2abecf7f18..7ff9fd83eb 100644 --- a/lib/hipe/icode/hipe_beam_to_icode.erl +++ b/lib/hipe/icode/hipe_beam_to_icode.erl @@ -415,11 +415,13 @@ trans_fun([{wait_timeout,{_,Lbl},Reg}|Instructions], Env) -> SuspTmout = hipe_icode:mk_if(suspend_msg_timeout,[], map_label(Lbl),hipe_icode:label_name(DoneLbl)), Movs ++ [SetTmout, SuspTmout, DoneLbl | trans_fun(Instructions,Env1)]; -%%--- recv_mark/1 & recv_set/1 --- XXX: Handle better?? +%%--- recv_mark/1 & recv_set/1 --- trans_fun([{recv_mark,{f,_}}|Instructions], Env) -> - trans_fun(Instructions,Env); + Mark = hipe_icode:mk_primop([],recv_mark,[]), + [Mark | trans_fun(Instructions,Env)]; trans_fun([{recv_set,{f,_}}|Instructions], Env) -> - trans_fun(Instructions,Env); + Set = hipe_icode:mk_primop([],recv_set,[]), + [Set | trans_fun(Instructions,Env)]; %%-------------------------------------------------------------------- %%--- Translation of arithmetics {bif,ArithOp, ...} --- %%-------------------------------------------------------------------- @@ -794,7 +796,7 @@ trans_fun([{bs_append,{f,Lbl},Size,W,R,U,Binary,{field_flags,F},Dst}| SizeArg = trans_arg(Size), BinArg = trans_arg(Binary), IcodeDst = mk_var(Dst), - Offset = mk_var(reg), + Offset = mk_var(reg_gcsafe), Base = mk_var(reg), trans_bin_call({hipe_bs_primop,{bs_append,W,R,U,F}},Lbl,[SizeArg,BinArg], [IcodeDst,Base,Offset], @@ -805,7 +807,7 @@ trans_fun([{bs_private_append,{f,Lbl},Size,U,Binary,{field_flags,F},Dst}| SizeArg = trans_arg(Size), BinArg = trans_arg(Binary), IcodeDst = mk_var(Dst), - Offset = mk_var(reg), + Offset = mk_var(reg_gcsafe), Base = mk_var(reg), trans_bin_call({hipe_bs_primop,{bs_private_append,U,F}}, Lbl,[SizeArg,BinArg], @@ -844,7 +846,7 @@ trans_fun([{bs_init2,{f,Lbl},Size,_Words,_LiveRegs,{field_flags,Flags0},X}| Instructions], Env) -> Dst = mk_var(X), Flags = resolve_native_endianess(Flags0), - Offset = mk_var(reg), + Offset = mk_var(reg_gcsafe), Base = mk_var(reg), {Name, Args} = case Size of @@ -860,7 +862,7 @@ trans_fun([{bs_init_bits,{f,Lbl},Size,_Words,_LiveRegs,{field_flags,Flags0},X}| Instructions], Env) -> Dst = mk_var(X), Flags = resolve_native_endianess(Flags0), - Offset = mk_var(reg), + Offset = mk_var(reg_gcsafe), Base = mk_var(reg), {Name, Args} = case Size of @@ -1157,6 +1159,11 @@ trans_fun([{put_map_exact,{f,Lbl},Map,Dst,_N,{list,Pairs}}|Instructions], Env) - gen_put_map_instrs(new, exact, TempMapVar, Dst, new, Pairs, Env1) end, [MapMove, TempMapMove, PutInstructions | trans_fun(Instructions, Env2)]; +%%--- build_stacktrace --- +trans_fun([build_stacktrace|Instructions], Env) -> + Vars = [mk_var({x,0})], %{x,0} is implict arg and dst + [hipe_icode:mk_primop(Vars,build_stacktrace,Vars), + trans_fun(Instructions, Env)]; %%-------------------------------------------------------------------- %%--- ERROR HANDLING --- %%-------------------------------------------------------------------- @@ -1505,7 +1512,10 @@ clone_dst(Dest) -> New = case hipe_icode:is_reg(Dest) of true -> - mk_var(reg); + case hipe_icode:reg_is_gcsafe(Dest) of + true -> mk_var(reg_gcsafe); + false -> mk_var(reg) + end; false -> true = hipe_icode:is_var(Dest), mk_var(new) @@ -2126,7 +2136,12 @@ mk_var(reg) -> T = hipe_gensym:new_var(icode), V = (5*T)+4, hipe_gensym:update_vrange(icode,V), - hipe_icode:mk_reg(V). + hipe_icode:mk_reg(V); +mk_var(reg_gcsafe) -> + T = hipe_gensym:new_var(icode), + V = (5*T)+4, % same namespace as 'reg' + hipe_gensym:update_vrange(icode,V), + hipe_icode:mk_reg_gcsafe(V). %%----------------------------------------------------------------------- %% Make an icode label of proper type @@ -2296,6 +2311,12 @@ split_code([First|Code], Label, Instr) -> split_code([Instr|Code], Label, Instr, Prev, As) when Prev =:= Label -> split_code_final(Code, As); % drop both label and instruction +split_code([{icode_end_try}|_]=Code, Label, {try_case,_}, Prev, As) + when Prev =:= Label -> + %% The try_case has been replaced with try_end as an optimization. + %% Keep this instruction, since it might be the only try_end instruction + %% for this try/catch block. + split_code_final(Code, As); % drop label split_code([Other|_Code], Label, Instr, Prev, _As) when Prev =:= Label -> ?EXIT({missing_instr_after_label, Label, Instr, [Other, Prev | _As]}); split_code([Other|Code], Label, Instr, Prev, As) -> diff --git a/lib/hipe/icode/hipe_icode.erl b/lib/hipe/icode/hipe_icode.erl index 24b7ac4783..bc3403b0c5 100644 --- a/lib/hipe/icode/hipe_icode.erl +++ b/lib/hipe/icode/hipe_icode.erl @@ -515,10 +515,12 @@ annotate_variable/2, %% annotate_var_or_reg(VarOrReg, Type) unannotate_variable/1,%% unannotate_var_or_reg(VarOrReg) mk_reg/1, %% mk_reg(Id) + mk_reg_gcsafe/1, %% mk_reg_gcsafe(Id) mk_fvar/1, %% mk_fvar(Id) mk_new_var/0, %% mk_new_var() mk_new_fvar/0, %% mk_new_fvar() mk_new_reg/0, %% mk_new_reg() + mk_new_reg_gcsafe/0, %% mk_new_reg_gcsafe() mk_phi/1, %% mk_phi(Id) mk_phi/2 %% mk_phi(Id, ArgList) ]). @@ -1260,14 +1262,22 @@ is_var(_) -> false. -spec mk_reg(non_neg_integer()) -> #icode_variable{kind::'reg'}. mk_reg(V) -> #icode_variable{name=V, kind=reg}. --spec reg_name(#icode_variable{kind::'reg'}) -> non_neg_integer(). -reg_name(#icode_variable{name=Name, kind=reg}) -> Name. +-spec mk_reg_gcsafe(non_neg_integer()) -> #icode_variable{kind::'reg_gcsafe'}. +mk_reg_gcsafe(V) -> #icode_variable{name=V, kind=reg_gcsafe}. --spec reg_is_gcsafe(#icode_variable{kind::'reg'}) -> 'false'. -reg_is_gcsafe(#icode_variable{kind=reg}) -> false. % for now +-spec reg_name(#icode_variable{kind::'reg'|'reg_gcsafe'}) + -> non_neg_integer(). +reg_name(#icode_variable{name=Name, kind=reg}) -> Name; +reg_name(#icode_variable{name=Name, kind=reg_gcsafe}) -> Name. + +-spec reg_is_gcsafe(#icode_variable{kind::'reg'}) -> 'false'; + (#icode_variable{kind::'reg_gcsafe'}) -> 'true'. +reg_is_gcsafe(#icode_variable{kind=reg}) -> false; +reg_is_gcsafe(#icode_variable{kind=reg_gcsafe}) -> true. -spec is_reg(icode_argument()) -> boolean(). -is_reg(#icode_variable{kind=reg}) -> true; +is_reg(#icode_variable{kind=reg}) -> true; +is_reg(#icode_variable{kind=reg_gcsafe}) -> true; is_reg(_) -> false. -spec mk_fvar(non_neg_integer()) -> #icode_variable{kind::'fvar'}. @@ -1676,6 +1686,16 @@ mk_new_reg() -> mk_reg(hipe_gensym:get_next_var(icode)). %% +%% @doc Makes a new gcsafe register; that is, a register that is allowed to be +%% live over calls and other operations that might cause GCs and thus move heap +%% data around. +%% + +-spec mk_new_reg_gcsafe() -> icode_reg(). +mk_new_reg_gcsafe() -> + mk_reg_gcsafe(hipe_gensym:get_next_var(icode)). + +%% %% @doc Makes a new label. %% diff --git a/lib/hipe/icode/hipe_icode.hrl b/lib/hipe/icode/hipe_icode.hrl index 380ddd8371..7ed80a9ed4 100644 --- a/lib/hipe/icode/hipe_icode.hrl +++ b/lib/hipe/icode/hipe_icode.hrl @@ -41,9 +41,9 @@ -type variable_annotation() :: {atom(), any(), fun((any()) -> string())}. --record(icode_variable, {name :: non_neg_integer(), - kind :: 'var' | 'reg' | 'fvar', - annotation = [] :: [] | variable_annotation()}). +-record(icode_variable, {name :: non_neg_integer(), + kind :: 'var' | 'reg' | 'reg_gcsafe' | 'fvar', + annotation = [] :: [] | variable_annotation()}). %%--------------------------------------------------------------------- %% Type declarations for Icode instructions @@ -66,7 +66,7 @@ -type icode_funcall() :: mfa() | icode_primop(). -type icode_var() :: #icode_variable{kind::'var'}. --type icode_reg() :: #icode_variable{kind::'reg'}. +-type icode_reg() :: #icode_variable{kind::'reg'|'reg_gcsafe'}. -type icode_fvar() :: #icode_variable{kind::'fvar'}. -type icode_argument() :: #icode_const{} | #icode_variable{}. -type icode_term_arg() :: icode_var() | #icode_const{}. diff --git a/lib/hipe/icode/hipe_icode_liveness.erl b/lib/hipe/icode/hipe_icode_liveness.erl index 51e2855108..e61529a1bb 100644 --- a/lib/hipe/icode/hipe_icode_liveness.erl +++ b/lib/hipe/icode/hipe_icode_liveness.erl @@ -77,6 +77,7 @@ print_var(#icode_variable{name=V, kind=Kind, annotation=T}) -> case Kind of var -> io:format("v~p", [V]); reg -> io:format("r~p", [V]); + reg_gcsafe -> io:format("rs~p", [V]); fvar -> io:format("fv~p", [V]) end, case T of diff --git a/lib/hipe/icode/hipe_icode_pp.erl b/lib/hipe/icode/hipe_icode_pp.erl index 5b017dca32..33d1e62884 100644 --- a/lib/hipe/icode/hipe_icode_pp.erl +++ b/lib/hipe/icode/hipe_icode_pp.erl @@ -230,7 +230,10 @@ pp_arg(Dev, Arg) -> case hipe_icode:is_reg(Arg) of true -> N = hipe_icode:reg_name(Arg), - io:format(Dev, "r~p", [N]); + case hipe_icode:reg_is_gcsafe(Arg) of + true -> io:format(Dev, "rs~p", [N]); + false -> io:format(Dev, "r~p", [N]) + end; false -> N = hipe_icode:fvar_name(Arg), io:format(Dev, "fv~p", [N]) diff --git a/lib/hipe/icode/hipe_icode_primops.erl b/lib/hipe/icode/hipe_icode_primops.erl index 50ece05259..941516e8b1 100644 --- a/lib/hipe/icode/hipe_icode_primops.erl +++ b/lib/hipe/icode/hipe_icode_primops.erl @@ -67,6 +67,8 @@ is_safe(fp_mul) -> false; is_safe(fp_sub) -> false; is_safe(mktuple) -> true; is_safe(next_msg) -> false; +is_safe(recv_mark) -> false; +is_safe(recv_set) -> false; is_safe(redtest) -> false; is_safe(select_msg) -> false; is_safe(self) -> true; @@ -130,6 +132,7 @@ is_safe({hipe_bs_primop, {bs_match_string, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_append, _, _, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_private_append, _, _}}) -> false; is_safe({hipe_bs_primop, bs_init_writable}) -> true; +is_safe(build_stacktrace) -> true; is_safe(#mkfun{}) -> true; is_safe(#unsafe_element{}) -> true; is_safe(#unsafe_update_element{}) -> true; @@ -165,6 +168,8 @@ fails(fp_mul) -> false; fails(fp_sub) -> false; fails(mktuple) -> false; fails(next_msg) -> false; +fails(recv_mark) -> false; +fails(recv_set) -> false; fails(redtest) -> false; fails(select_msg) -> false; fails(self) -> false; @@ -230,6 +235,7 @@ fails({hipe_bs_primop, bs_final}) -> false; fails({hipe_bs_primop, {bs_append, _, _, _, _}}) -> true; fails({hipe_bs_primop, {bs_private_append, _, _}}) -> true; fails({hipe_bs_primop, bs_init_writable}) -> true; +fails(build_stacktrace) -> false; fails(#mkfun{}) -> false; fails(#unsafe_element{}) -> false; fails(#unsafe_update_element{}) -> false; @@ -709,6 +715,10 @@ type(Primop, Args) -> erl_types:t_any(); next_msg -> erl_types:t_any(); + recv_mark -> + erl_types:t_any(); + recv_set -> + erl_types:t_any(); select_msg -> erl_types:t_any(); set_timeout -> @@ -723,6 +733,8 @@ type(Primop, Args) -> erl_types:t_any(); debug_native_called -> erl_types:t_any(); + build_stacktrace -> + erl_types:t_list(); {M, F, A} -> erl_bif_types:type(M, F, A, Args) end. @@ -883,6 +895,10 @@ type(Primop) -> erl_types:t_any(); next_msg -> erl_types:t_any(); + recv_mark -> + erl_types:t_any(); + recv_set -> + erl_types:t_any(); select_msg -> erl_types:t_any(); set_timeout -> @@ -891,6 +907,8 @@ type(Primop) -> erl_types:t_any(); %%% ----------------------------------------------------- %%% Other + build_stacktrace -> + erl_types:t_any(); #closure_element{} -> erl_types:t_any(); redtest -> diff --git a/lib/hipe/icode/hipe_icode_range.erl b/lib/hipe/icode/hipe_icode_range.erl index 287b1c80fe..cf74c1eb5b 100644 --- a/lib/hipe/icode/hipe_icode_range.erl +++ b/lib/hipe/icode/hipe_icode_range.erl @@ -1160,6 +1160,8 @@ basic_type(#gc_test{}) -> not_analysed; %% Message handling basic_type(check_get_msg) -> not_analysed; basic_type(next_msg) -> not_analysed; +basic_type(recv_mark) -> not_analysed; +basic_type(recv_set) -> not_analysed; basic_type(select_msg) -> not_analysed; basic_type(suspend_msg) -> not_analysed; %% Functions @@ -1184,7 +1186,8 @@ basic_type(unsafe_hd) -> not_analysed; basic_type(unsafe_tl) -> not_int; basic_type(#element{}) -> not_analysed; basic_type(#unsafe_element{}) -> not_analysed; -basic_type(#unsafe_update_element{}) -> not_analysed. +basic_type(#unsafe_update_element{}) -> not_analysed; +basic_type(build_stacktrace) -> not_int. -spec analyse_bs_get_integer(integer(), integer(), boolean()) -> range_tuple(). diff --git a/lib/hipe/llvm/hipe_llvm.erl b/lib/hipe/llvm/hipe_llvm.erl index 641d3fda0a..ccd40162cb 100644 --- a/lib/hipe/llvm/hipe_llvm.erl +++ b/lib/hipe/llvm/hipe_llvm.erl @@ -1005,11 +1005,12 @@ pp_ins(Dev, Ver, I) -> write(Dev, [" ", adj_stack_offset(I),")\n"]); #llvm_meta{} -> write(Dev, ["!", meta_id(I), " = !{ "]), - write(Dev, string:join([if is_list(Op) -> ["!\"", Op, "\""]; - is_integer(Op) -> ["i32 ", integer_to_list(Op)]; - is_record(Op, llvm_meta) -> - ["!", meta_id(Op)] - end || Op <- meta_operands(I)], ", ")), + write(Dev, lists:join(", ", + [if is_list(Op) -> ["!\"", Op, "\""]; + is_integer(Op) -> ["i32 ", integer_to_list(Op)]; + is_record(Op, llvm_meta) -> + ["!", meta_id(Op)] + end || Op <- meta_operands(I)])), write(Dev, " }\n"); Other -> exit({?MODULE, pp_ins, {"Unknown LLVM instruction", Other}}) diff --git a/lib/hipe/llvm/hipe_llvm_main.erl b/lib/hipe/llvm/hipe_llvm_main.erl index 4eec0c752b..54c435c127 100644 --- a/lib/hipe/llvm/hipe_llvm_main.erl +++ b/lib/hipe/llvm/hipe_llvm_main.erl @@ -154,7 +154,7 @@ compiler_target_opt() -> %% @doc Join options. fix_opts(Opts) -> - string:join(Opts, " "). + lists:flatten(lists:join(" ", Opts)). %% @doc Translate optimization-level flag (default is "O2"). trans_optlev_flag(Tool, Options) -> diff --git a/lib/hipe/llvm/hipe_rtl_to_llvm.erl b/lib/hipe/llvm/hipe_rtl_to_llvm.erl index 79e1bfd381..934717efc1 100644 --- a/lib/hipe/llvm/hipe_rtl_to_llvm.erl +++ b/lib/hipe/llvm/hipe_rtl_to_llvm.erl @@ -1537,7 +1537,7 @@ declare_switch_table({Name, {switch, {TableType, Labels, _, _}, _}}, FunName) -> LabelList = [mk_jump_label(L) || L <- Labels], Fun1 = fun(X) -> "i8* blockaddress(@" ++ FunName ++ ", " ++ X ++ ")" end, List2 = lists:map(Fun1, LabelList), - List3 = string:join(List2, ",\n"), + List3 = lists:flatten(lists:join(",\n", List2)), List4 = "[\n" ++ List3 ++ "\n]\n", hipe_llvm:mk_const_decl("@" ++ Name, "constant", TableType, List4). @@ -1553,7 +1553,7 @@ declare_closure_labels(ClosureLabels, Relocs, Fun) -> Relocs1 = relocs_store("table_closures", {table_closures, ArityList}, Relocs), List2 = ["i8* blockaddress(@" ++ FunName ++ ", " ++ L ++ ")" || L <- LabelList], - List3 = string:join(List2, ",\n"), + List3 = lists:flatten(lists:join(",\n", List2)), List4 = "[\n" ++ List3 ++ "\n]\n", NrLabels = length(LabelList), ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(?BITS_IN_BYTE)), diff --git a/lib/hipe/main/hipe.app.src b/lib/hipe/main/hipe.app.src index 5b2280594f..66008a4178 100644 --- a/lib/hipe/main/hipe.app.src +++ b/lib/hipe/main/hipe.app.src @@ -179,6 +179,7 @@ hipe_rtl_to_sparc, hipe_rtl_to_x86, hipe_rtl_varmap, + hipe_rtl_verify_gcsafe, hipe_segment_trees, hipe_sdi, hipe_sparc, @@ -236,4 +237,4 @@ {applications, [kernel,stdlib]}, {env, []}, {runtime_dependencies, ["syntax_tools-1.6.14","stdlib-3.4","kernel-5.3", - "erts-9.0","compiler-5.0"]}]}. + "erts-9.2","compiler-5.0"]}]}. diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl index 19b4e8bfe2..acb9b7b062 100644 --- a/lib/hipe/main/hipe.erl +++ b/lib/hipe/main/hipe.erl @@ -1414,6 +1414,7 @@ opt_keys() -> use_clusters, use_jumptable, verbose, + verify_gcsafe, %% verbose_spills, x87]. @@ -1510,7 +1511,8 @@ opt_negations() -> {no_use_callgraph, use_callgraph}, {no_use_clusters, use_clusters}, {no_use_inline_atom_search, use_inline_atom_search}, - {no_use_indexing, use_indexing}]. + {no_use_indexing, use_indexing}, + {no_verify_gcsafe, verify_gcsafe}]. %% Don't use negative forms in right-hand sides of aliases and expansions! %% We only expand negations once, before the other expansions are done. @@ -1616,11 +1618,11 @@ llvm_support_available() -> get_llvm_version() -> OptStr = os:cmd("opt -version"), SubStr = "LLVM version ", N = length(SubStr), - case string:str(OptStr, SubStr) of - 0 -> % No opt available + case string:find(OptStr, SubStr) of + nomatch -> % No opt available {0, 0}; S -> - case string:tokens(string:sub_string(OptStr, S + N), ".") of + case string:lexemes(string:slice(S, N), ".") of [MajorS, MinorS | _] -> case {string:to_integer(MajorS), string:to_integer(MinorS)} of {{Major, ""}, {Minor, _}} diff --git a/lib/hipe/main/hipe_main.erl b/lib/hipe/main/hipe_main.erl index dca6fddec3..4b5eb4c63e 100644 --- a/lib/hipe/main/hipe_main.erl +++ b/lib/hipe/main/hipe_main.erl @@ -410,6 +410,11 @@ icode_to_rtl(MFA, Icode, Options, Servers) -> hipe_llvm_liveness:analyze(RtlCfg4) end, pp(RtlCfg5, MFA, rtl, pp_rtl, Options, Servers), + case proplists:get_bool(verify_gcsafe, Options) of + false -> ok; + true -> + ok = hipe_rtl_verify_gcsafe:check(RtlCfg5) + end, LinearRTL1 = hipe_rtl_cfg:linearize(RtlCfg5), LinearRTL2 = hipe_rtl_cleanup_const:cleanup(LinearRTL1), %% hipe_rtl:pp(standard_io, LinearRTL2), diff --git a/lib/hipe/rtl/Makefile b/lib/hipe/rtl/Makefile index 5abc9ec049..becdd0b7d8 100644 --- a/lib/hipe/rtl/Makefile +++ b/lib/hipe/rtl/Makefile @@ -50,7 +50,7 @@ HIPE_MODULES = hipe_rtl hipe_rtl_cfg \ hipe_rtl_ssa hipe_rtl_ssa_const_prop \ hipe_rtl_cleanup_const hipe_rtl_symbolic hipe_rtl_lcm \ hipe_rtl_ssapre hipe_rtl_binary hipe_rtl_ssa_avail_expr \ - hipe_rtl_arch hipe_tagscheme + hipe_rtl_arch hipe_tagscheme hipe_rtl_verify_gcsafe else HIPE_MODULES = endif diff --git a/lib/hipe/rtl/hipe_rtl.erl b/lib/hipe/rtl/hipe_rtl.erl index 04c9728d5c..33027f3259 100644 --- a/lib/hipe/rtl/hipe_rtl.erl +++ b/lib/hipe/rtl/hipe_rtl.erl @@ -1740,7 +1740,10 @@ pp_reg(Dev, Arg) -> true -> pp_hard_reg(Dev, reg_index(Arg)); false -> - io:format(Dev, "r~w", [reg_index(Arg)]) + case reg_is_gcsafe(Arg) of + true -> io:format(Dev, "rs~w", [reg_index(Arg)]); + false -> io:format(Dev, "r~w", [reg_index(Arg)]) + end end. pp_var(Dev, Arg) -> diff --git a/lib/hipe/rtl/hipe_rtl_binary_construct.erl b/lib/hipe/rtl/hipe_rtl_binary_construct.erl index 52ea5db382..5b89d4946a 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_construct.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_construct.erl @@ -195,8 +195,13 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab bs_validate_unicode -> [_Arg] = Args, - [hipe_rtl:mk_call([], bs_validate_unicode, Args, - TrueLblName, FalseLblName, not_remote)]; + [IsUnicode] = create_regs(1), + RetLbl = hipe_rtl:mk_new_label(), + [hipe_rtl:mk_call([IsUnicode], is_unicode, Args, + hipe_rtl:label_name(RetLbl), [], not_remote), + RetLbl, + hipe_rtl:mk_branch(IsUnicode, ne, hipe_rtl:mk_imm(0), + TrueLblName, FalseLblName, 0.99)]; bs_final -> Zero = hipe_rtl:mk_imm(0), @@ -354,7 +359,8 @@ not_writable_code(Bin, SizeReg, Dst, Base, Offset, Unit, allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize) -> Zero = hipe_rtl:mk_imm(0), [NextLbl] = create_lbls(1), - [EndSubSize, EndSubBitSize, ProcBin] = create_regs(3), + [EndSubSize, EndSubBitSize] = create_regs(2), + [ProcBin] = create_unsafe_regs(1), [hipe_rtl:mk_call([Base], bs_allocate, [UsedBytes], hipe_rtl:label_name(NextLbl), [], not_remote), NextLbl, @@ -581,12 +587,12 @@ const_init2(Size, Dst, Base, Offset, TrueLblName) -> false -> ByteSize = hipe_rtl:mk_new_reg(), [hipe_rtl:mk_gctest(?PROC_BIN_WORDSIZE+?SUB_BIN_WORDSIZE), - hipe_rtl:mk_move(Offset, hipe_rtl:mk_imm(0)), hipe_rtl:mk_move(ByteSize, hipe_rtl:mk_imm(Size)), hipe_rtl:mk_call([Base], bs_allocate, [ByteSize], hipe_rtl:label_name(NextLbl), [], not_remote), NextLbl, hipe_tagscheme:create_refc_binary(Base, ByteSize, Dst), + hipe_rtl:mk_move(Offset, hipe_rtl:mk_imm(0)), hipe_rtl:mk_goto(TrueLblName)] end. @@ -629,13 +635,12 @@ var_init2(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName Log2WordSize = hipe_rtl_arch:log2_word_size(), WordSize = hipe_rtl_arch:word_size(), [ContLbl, HeapLbl, REFCLbl, NextLbl] = create_lbls(4), - [USize, Tmp] = create_unsafe_regs(2), + [USize, Tmp] = create_regs(2), [get_word_integer(Size, USize, SystemLimitLblName, FalseLblName), hipe_rtl:mk_branch(USize, leu, hipe_rtl:mk_imm(?MAX_BINSIZE), hipe_rtl:label_name(ContLbl), SystemLimitLblName), ContLbl, - hipe_rtl:mk_move(Offset, hipe_rtl:mk_imm(0)), hipe_rtl:mk_branch(USize, leu, hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE), hipe_rtl:label_name(HeapLbl), hipe_rtl:label_name(REFCLbl)), @@ -645,6 +650,7 @@ var_init2(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName hipe_rtl:mk_alu(Tmp, Tmp, add, hipe_rtl:mk_imm(?SUB_BIN_WORDSIZE)), hipe_rtl:mk_gctest(Tmp), hipe_tagscheme:create_heap_binary(Base, USize, Dst), + hipe_rtl:mk_move(Offset, hipe_rtl:mk_imm(0)), hipe_rtl:mk_goto(TrueLblName), REFCLbl, hipe_rtl:mk_gctest(?PROC_BIN_WORDSIZE+?SUB_BIN_WORDSIZE), @@ -652,6 +658,7 @@ var_init2(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName hipe_rtl:label_name(NextLbl), [], not_remote), NextLbl, hipe_tagscheme:create_refc_binary(Base, USize, Dst), + hipe_rtl:mk_move(Offset, hipe_rtl:mk_imm(0)), hipe_rtl:mk_goto(TrueLblName)]. var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName) -> @@ -858,7 +865,7 @@ get_base_offset_size(Binary, SrcBase, SrcOffset, SrcSize, FLName) -> JoinLbl, hipe_tagscheme:test_heap_binary(Orig, HeapLblName, REFCLblName), HeapLbl, - hipe_rtl:mk_alu(SrcBase, Orig, add, hipe_rtl:mk_imm(?HEAP_BIN_DATA-2)), + hipe_tagscheme:get_field_addr_from_term({heap_bin, {data, 0}}, Orig, SrcBase), hipe_rtl:mk_goto(EndLblName), REFCLbl, hipe_tagscheme:get_field_from_term({proc_bin,bytes}, Orig, SrcBase), @@ -1205,6 +1212,12 @@ is_divisible(Dividend, Divisor, SuccLbl, FailLbl) -> [hipe_rtl:mk_branch(Dividend, 'and', Mask, eq, SuccLbl, FailLbl, 0.99)]; false -> %% We need division, fall back to a primop - [hipe_rtl:mk_call([], is_divisible, [Dividend, hipe_rtl:mk_imm(Divisor)], - SuccLbl, FailLbl, not_remote)] + [Tmp] = create_regs(1), + RetLbl = hipe_rtl:mk_new_label(), + [hipe_rtl:mk_call([Tmp], is_divisible, + [Dividend, hipe_rtl:mk_imm(Divisor)], + hipe_rtl:label_name(RetLbl), [], not_remote), + RetLbl, + hipe_rtl:mk_branch(Tmp, ne, hipe_rtl:mk_imm(0), + SuccLbl, FailLbl, 0.99)] end. diff --git a/lib/hipe/rtl/hipe_rtl_binary_match.erl b/lib/hipe/rtl/hipe_rtl_binary_match.erl index 362a52f8fe..4575213838 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_match.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_match.erl @@ -730,7 +730,7 @@ get_base(Orig,Base) -> [hipe_tagscheme:test_heap_binary(Orig, hipe_rtl:label_name(HeapLbl), hipe_rtl:label_name(REFCLbl)), HeapLbl, - hipe_rtl:mk_alu(Base, Orig, 'add', hipe_rtl:mk_imm(?HEAP_BIN_DATA-2)), + hipe_tagscheme:get_field_addr_from_term({heap_bin, {data, 0}}, Orig, Base), hipe_rtl:mk_goto(hipe_rtl:label_name(EndLbl)), REFCLbl, get_field_from_term({proc_bin, flags}, Orig, Flags), @@ -740,7 +740,7 @@ get_base(Orig,Base) -> WritableLbl, hipe_rtl:mk_call([], emasculate_binary, [Orig], [], [], 'not_remote'), NotWritableLbl, - hipe_rtl:mk_load(Base, Orig, hipe_rtl:mk_imm(?PROC_BIN_BYTES-2)), + get_field_from_term({proc_bin, bytes}, Orig, Base), EndLbl]. extract_matchstate_var(binsize, Ms) -> @@ -842,12 +842,12 @@ make_dyn_prep(SizeReg, CCode) -> %%------------------------------------------------------------------------ get_unaligned_int(Dst1, Size, Base, Offset, Shiftr, Type, TrueLblName) -> - [Reg] = create_regs(1), + [Reg] = create_gcsafe_regs(1), [get_maybe_unaligned_int_to_reg(Reg, Size, Base, Offset, Shiftr, Type), do_bignum_code(Size, Type, Reg, Dst1, TrueLblName)]. get_maybe_unaligned_int_to_reg(Reg, Size, Base, Offset, Shiftr, Type) -> - [LowBits] = create_regs(1), + [LowBits] = create_gcsafe_regs(1), [AlignedLbl, UnAlignedLbl, EndLbl] = create_lbls(3), [hipe_rtl:mk_alub(LowBits, Offset, 'and', hipe_rtl:mk_imm(?LOW_BITS), eq, hipe_rtl:label_name(AlignedLbl), @@ -1001,7 +1001,7 @@ do_bignum_code(Size, {Signedness,_}, Src, Dst1, TrueLblName) end. signed_bignum(Dst1, Src, TrueLblName) -> - Tmp1 = hipe_rtl:mk_new_reg(), + Tmp1 = hipe_rtl:mk_new_reg_gcsafe(), BignumLabel = hipe_rtl:mk_new_label(), [hipe_tagscheme:realtag_fixnum(Dst1, Src), hipe_tagscheme:realuntag_fixnum(Tmp1, Dst1), diff --git a/lib/hipe/rtl/hipe_rtl_cleanup_const.erl b/lib/hipe/rtl/hipe_rtl_cleanup_const.erl index bfa6b9682e..00cc2bcb37 100644 --- a/lib/hipe/rtl/hipe_rtl_cleanup_const.erl +++ b/lib/hipe/rtl/hipe_rtl_cleanup_const.erl @@ -69,9 +69,9 @@ cleanup_instr([Const|Left], I, Acc) -> case I of X when is_record(X, fp_unop) orelse is_record(X, fp) -> Fdst = hipe_rtl:mk_new_fpreg(), - Fconv = hipe_tagscheme:unsafe_untag_float(Fdst, Dst), + Fconv = lists:flatten(hipe_tagscheme:unsafe_untag_float(Fdst, Dst)), NewI = hipe_rtl:subst_uses([{Const, Fdst}], I), - cleanup_instr(Left, NewI, Fconv ++ [Load|Acc]); + cleanup_instr(Left, NewI, lists:reverse(Fconv, [Load|Acc])); _ -> NewI = hipe_rtl:subst_uses([{Const, Dst}], I), cleanup_instr(Left, NewI, [Load|Acc]) diff --git a/lib/hipe/rtl/hipe_rtl_lcm.erl b/lib/hipe/rtl/hipe_rtl_lcm.erl index 9dcdd05fb1..af39c9a0a4 100644 --- a/lib/hipe/rtl/hipe_rtl_lcm.erl +++ b/lib/hipe/rtl/hipe_rtl_lcm.erl @@ -182,42 +182,41 @@ delete_exprs(Code, _, _, []) -> Code; delete_exprs(Code, ExprMap, IdMap, [ExprId|Exprs]) -> Expr = expr_id_map_get_expr(IdMap, ExprId), - %% Perform a foldl that goes through the code and deletes all - %% occurences of the expression. - NewCode = - lists:reverse - (lists:foldl(fun(CodeExpr, Acc) -> - case is_expr(CodeExpr) of - true -> - case expr_clear_dst(CodeExpr) =:= Expr of - true -> - pp_debug(" Deleting: ", []), - pp_debug_instr(CodeExpr), - %% Lookup expression entry. - Defines = - case expr_map_lookup(ExprMap, Expr) of - {value, {_, _, Defs}} -> - Defs; - none -> - exit({?MODULE, expr_map_lookup, - "expression missing"}) - end, - MoveCode = - mk_expr_move_instr(hipe_rtl:defines(CodeExpr), - Defines), - pp_debug(" Replacing with: ", []), - pp_debug_instr(MoveCode), - [MoveCode|Acc]; - false -> - [CodeExpr|Acc] - end; - false -> - [CodeExpr|Acc] - end - end, - [], Code)), + %% Lookup expression entry. + {value, {_, _, Defines}} = expr_map_lookup(ExprMap, Expr), + %% Go through the code and deletes all occurences of the expression. + NewCode = delete_expr(Code, Expr, Defines, []), delete_exprs(NewCode, ExprMap, IdMap, Exprs). +delete_expr([], _Expr, _Defines, Acc) -> lists:reverse(Acc); +delete_expr([CodeExpr|Code], Expr, Defines, Acc) -> + case exp_kill_expr(CodeExpr, [Expr]) of + [] -> % Expr was killed; deleting stops here + pp_debug(" Stopping before: ", []), + pp_debug_instr(CodeExpr), + lists:reverse(Acc, [CodeExpr|Code]); + [Expr] -> + NewCodeExpr = + case is_expr(CodeExpr) of + true -> + case expr_clear_dst(CodeExpr) =:= Expr of + true -> + pp_debug(" Deleting: ", []), + pp_debug_instr(CodeExpr), + MoveCode = mk_expr_move_instr(hipe_rtl:defines(CodeExpr), + Defines), + pp_debug(" Replacing with: ", []), + pp_debug_instr(MoveCode), + MoveCode; + false -> + CodeExpr + end; + false -> + CodeExpr + end, + delete_expr(Code, Expr, Defines, [NewCodeExpr|Acc]) + end. + %%============================================================================= %% Goes through the given list of expressions and inserts them at %% appropriate places in the code. @@ -226,13 +225,12 @@ insert_exprs(CFG, _, _, _, _, BetweenMap, []) -> insert_exprs(CFG, Pred, Succ, ExprMap, IdMap, BetweenMap, [ExprId|Exprs]) -> Expr = expr_id_map_get_expr(IdMap, ExprId), Instr = expr_map_get_instr(ExprMap, Expr), - case hipe_rtl_cfg:succ(CFG, Pred) of - [_] -> + case try_insert_expr_last(CFG, Pred, Instr) of + {ok, NewCFG} -> pp_debug(" Inserted last: ", []), pp_debug_instr(Instr), - NewCFG = insert_expr_last(CFG, Pred, Instr), insert_exprs(NewCFG, Pred, Succ, ExprMap, IdMap, BetweenMap, Exprs); - _ -> + not_safe -> case hipe_rtl_cfg:pred(CFG, Succ) of [_] -> pp_debug(" Inserted first: ", []), @@ -252,25 +250,31 @@ insert_exprs(CFG, Pred, Succ, ExprMap, IdMap, BetweenMap, [ExprId|Exprs]) -> %% Recursively goes through the code in a block and returns a new block %% with the new code inserted second to last (assuming the last expression %% is a branch operation). -insert_expr_last(CFG0, Label, Instr) -> - Code0 = hipe_bb:code(hipe_rtl_cfg:bb(CFG0, Label)), - %% FIXME: Use hipe_bb:butlast() instead? - Code1 = insert_expr_last_work(Label, Instr, Code0), - hipe_rtl_cfg:bb_add(CFG0, Label, hipe_bb:mk_bb(Code1)). +try_insert_expr_last(CFG0, Label, Instr) -> + case hipe_rtl_cfg:succ(CFG0, Label) of + [_] -> + Code0 = hipe_bb:code(hipe_rtl_cfg:bb(CFG0, Label)), + case insert_expr_last_work(Instr, Code0) of + not_safe -> not_safe; + Code1 -> + {ok, hipe_rtl_cfg:bb_add(CFG0, Label, hipe_bb:mk_bb(Code1))} + end; + _ -> not_safe + end. %%============================================================================= %% Recursively goes through the code in a block and returns a new block %% with the new code inserted second to last (assuming the last expression %% is a branch operation). -insert_expr_last_work(_, Instr, []) -> - %% This case should not happen since this means that block was completely - %% empty when the function was called. For compatibility we insert it last. - [Instr]; -insert_expr_last_work(_, Instr, [Code1]) -> +insert_expr_last_work(_Instr, [#call{}]) -> + %% Call instructions clobber all expressions; we musn't insert the expression + %% before it + not_safe; +insert_expr_last_work(Instr, [Code1]) -> %% We insert the code next to last. [Instr, Code1]; -insert_expr_last_work(Label, Instr, [Code|Codes]) -> - [Code|insert_expr_last_work(Label, Instr, Codes)]. +insert_expr_last_work(Instr, [Code|Codes]) -> + [Code|insert_expr_last_work(Instr, Codes)]. %%============================================================================= %% Inserts expression first in the block for the given label. @@ -305,7 +309,8 @@ insert_expr_between(CFG0, BetweenMap, Pred, Succ, Instr) -> {value, Label} -> pp_debug(" Using existing new bb for edge (~w,~w) with label ~w~n", [Pred, Succ, Label]), - {insert_expr_last(CFG0, Label, Instr), BetweenMap} + {ok, NewCfg} = try_insert_expr_last(CFG0, Label, Instr), + {NewCfg, BetweenMap} end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/hipe/rtl/hipe_rtl_primops.erl b/lib/hipe/rtl/hipe_rtl_primops.erl index 850a75f71b..d646b78a3d 100644 --- a/lib/hipe/rtl/hipe_rtl_primops.erl +++ b/lib/hipe/rtl/hipe_rtl_primops.erl @@ -291,6 +291,10 @@ gen_primop({Op,Dst,Args,Cont,Fail}, IsGuard, ConstTab) -> gen_select_msg(Dst, Cont); clear_timeout -> gen_clear_timeout(Dst, GotoCont); + recv_mark -> + gen_recv_mark(Dst, GotoCont); + recv_set -> + gen_recv_set(Dst, Cont); set_timeout -> %% BIF call: am_set_timeout -> nbif_set_timeout -> hipe_set_timeout [hipe_rtl:mk_call(Dst, set_timeout, Args, Cont, Fail, not_remote)]; @@ -390,6 +394,8 @@ gen_primop({Op,Dst,Args,Cont,Fail}, IsGuard, ConstTab) -> end; debug_native_called -> [hipe_rtl:mk_call(Dst, Op, Args, Cont, Fail, not_remote)]; + build_stacktrace -> + [hipe_rtl:mk_call(Dst, Op, Args, Cont, Fail, not_remote)]; %% Only names listed above are accepted! MFA:s are not primops! _ -> @@ -1064,6 +1070,27 @@ gen_tuple_header(Ptr, Arity) -> %%% %%% Receives +%%% recv_mark is: +%%% p->msg.saved_last = p->msg.last; +gen_recv_mark([], GotoCont) -> + TmpLast = hipe_rtl:mk_new_reg(), + [load_p_field(TmpLast, ?P_MSG_LAST), + store_p_field(TmpLast, ?P_MSG_SAVED_LAST), + GotoCont]. + +%%% recv_set is: +%%% if (p->msg.saved_last) +%%% p->msg.save = p->msg.saved_last; +gen_recv_set([], Cont) -> + TmpSave = hipe_rtl:mk_new_reg(), + TrueLbl = hipe_rtl:mk_new_label(), + [load_p_field(TmpSave, ?P_MSG_SAVED_LAST), + hipe_rtl:mk_branch(TmpSave, ne, hipe_rtl:mk_imm(0), + hipe_rtl:label_name(TrueLbl), Cont), + TrueLbl, + store_p_field(TmpSave, ?P_MSG_SAVE), + hipe_rtl:mk_goto(Cont)]. + gen_check_get_msg(Dsts, GotoCont, Fail) -> gen_check_get_msg_outofline(Dsts, GotoCont, Fail). diff --git a/lib/hipe/rtl/hipe_rtl_varmap.erl b/lib/hipe/rtl/hipe_rtl_varmap.erl index 375a8f85c0..f34c66ab85 100644 --- a/lib/hipe/rtl/hipe_rtl_varmap.erl +++ b/lib/hipe/rtl/hipe_rtl_varmap.erl @@ -105,7 +105,7 @@ icode_var2rtl_var(Var, Map) -> {reg, IsGcSafe} -> NewVar = case IsGcSafe of - %% true -> hipe_rtl:mk_new_reg_gcsafe(); + true -> hipe_rtl:mk_new_reg_gcsafe(); false -> hipe_rtl:mk_new_reg() end, {NewVar, insert(Var, NewVar, Map)} diff --git a/lib/hipe/rtl/hipe_rtl_verify_gcsafe.erl b/lib/hipe/rtl/hipe_rtl_verify_gcsafe.erl new file mode 100644 index 0000000000..c3f20bfec1 --- /dev/null +++ b/lib/hipe/rtl/hipe_rtl_verify_gcsafe.erl @@ -0,0 +1,88 @@ +%% -*- mode: erlang; erlang-indent-level: 2 -*- +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +-module(hipe_rtl_verify_gcsafe). + +-export([check/1]). + +-include("../flow/cfg.hrl"). %% needed for the specs +-include("hipe_rtl.hrl"). + +check(CFG) -> + Liveness = hipe_rtl_liveness:analyze(CFG), + put({?MODULE, 'fun'}, CFG#cfg.info#cfg_info.'fun'), + lists:foreach( + fun(Lb) -> + put({?MODULE, label}, Lb), + Liveout = hipe_rtl_liveness:liveout(Liveness, Lb), + BB = hipe_rtl_cfg:bb(CFG, Lb), + check_instrs(lists:reverse(hipe_bb:code(BB)), Liveout) + end, hipe_rtl_cfg:labels(CFG)), + erase({?MODULE, 'fun'}), + erase({?MODULE, label}), + erase({?MODULE, instr}), + ok. + +check_instrs([], _Livein) -> ok; +check_instrs([I|Is], LiveOut) -> + Def = ordsets:from_list(hipe_rtl:defines(I)), + Use = ordsets:from_list(hipe_rtl:uses(I)), + LiveOver = ordsets:subtract(LiveOut, Def), + LiveIn = ordsets:union(LiveOver, Use), + case (hipe_rtl:is_call(I) + andalso not safe_primop(hipe_rtl:call_fun(I))) + orelse is_record(I, gctest) + of + false -> ok; + true -> + put({?MODULE, instr}, I), + lists:foreach(fun verify_live/1, LiveOver) + end, + check_instrs(Is, LiveIn). + +verify_live(T) -> + case hipe_rtl:is_reg(T) of + false -> ok; + true -> + case hipe_rtl:reg_is_gcsafe(T) of + true -> ok; + false -> + error({gcunsafe_live_over_call, + get({?MODULE, 'fun'}), + {label, get({?MODULE, label})}, + get({?MODULE, instr}), + T}) + end + end. + +%% Primops that can't gc +%% Note: This information is essentially duplicated from hipe_bif_list.m4 +safe_primop(is_divisible) -> true; +safe_primop(is_unicode) -> true; +safe_primop(cmp_2) -> true; +safe_primop(eq_2) -> true; +safe_primop(bs_allocate) -> true; +safe_primop(bs_reallocate) -> true; +safe_primop(bs_utf8_size) -> true; +safe_primop(bs_get_utf8) -> true; +safe_primop(bs_utf16_size) -> true; +safe_primop(bs_get_utf16) -> true; +safe_primop(bs_validate_unicode_retract) -> true; +safe_primop(bs_put_small_float) -> true; +safe_primop(bs_put_bits) -> true; +safe_primop(emasculate_binary) -> true; +safe_primop(atomic_inc) -> true; +%% Not noproc but manually verified +safe_primop(bs_put_big_integer) -> true; +safe_primop(_) -> false. diff --git a/lib/hipe/rtl/hipe_tagscheme.erl b/lib/hipe/rtl/hipe_tagscheme.erl index 68cbe75e85..737f0ec5e3 100644 --- a/lib/hipe/rtl/hipe_tagscheme.erl +++ b/lib/hipe/rtl/hipe_tagscheme.erl @@ -53,7 +53,8 @@ -export([test_subbinary/3, test_heap_binary/3]). -export([create_heap_binary/3, create_refc_binary/3, create_refc_binary/4]). -export([create_matchstate/6, convert_matchstate/1, compare_matchstate/4]). --export([get_field_from_term/3, get_field_from_pointer/3, +-export([get_field_addr_from_term/3, + get_field_from_term/3, get_field_from_pointer/3, set_field_from_term/3, set_field_from_pointer/3, extract_matchbuffer/2, extract_binary_bytes/2]). @@ -76,6 +77,10 @@ -define(TAG_PRIMARY_BOXED, 16#2). -define(TAG_PRIMARY_IMMED1, 16#3). +%% Only when ?ERTS_USE_LITERAL_TAG =:= 1 +-define(TAG_PTR_MASK__, 16#7). +-define(TAG_LITERAL_PTR, 16#4). + -define(TAG_IMMED1_SIZE, 4). -define(TAG_IMMED1_MASK, 16#F). -define(TAG_IMMED1_PID, ((16#0 bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_IMMED1)). @@ -157,6 +162,38 @@ tag_cons(Res, X) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +ptr_val(Res, X) -> + hipe_rtl:mk_alu(Res, X, 'and', hipe_rtl:mk_imm(bnot ?TAG_PTR_MASK__)). + +%% Returns {Base, Offset, Untag}. To be used like, for example: +%% {Base, Offset, Untag} = untag_ptr(X, ?TAG_PRIMARY_BOXED), +%% ... +%% [Untag, hipe_rtl:mk_load(Dst, Base, hipe_rtl:mk_imm(Offset))]. +%% +%% NB: Base might either be X or a new temp. It must thus not be modified. +untag_ptr(X, Tag) -> + case ?ERTS_USE_LITERAL_TAG of + 0 -> + {X, -Tag, []}; + 1 -> + Base = hipe_rtl:mk_new_reg(), + Untag = ptr_val(Base, X), + {Base, 0, Untag} + end. + +untag_ptr_nooffset(Dst, X, Tag) -> + %% We could just use ptr_val in all cases, but subtraction can use LEA on x86 + %% and can be inlined into effective address computations on several + %% architectures. + case ?ERTS_USE_LITERAL_TAG of + 0 -> + hipe_rtl:mk_alu(Dst, X, 'sub', hipe_rtl:mk_imm(Tag)); + 1 -> + ptr_val(Dst, X) + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + %%% Operations to test if an object has a known type T. test_nil(X, TrueLab, FalseLab, Pred) -> @@ -171,7 +208,8 @@ test_is_boxed(X, TrueLab, FalseLab, Pred) -> hipe_rtl:mk_branch(X, 'and', Mask, 'eq', TrueLab, FalseLab, Pred). get_header(Res, X) -> - hipe_rtl:mk_load(Res, X, hipe_rtl:mk_imm(-(?TAG_PRIMARY_BOXED))). + {Base, Offset, Untag} = untag_ptr(X, ?TAG_PRIMARY_BOXED), + [Untag, hipe_rtl:mk_load(Res, Base, hipe_rtl:mk_imm(Offset))]. mask_and_compare(X, Mask, Value, TrueLab, FalseLab, Pred) -> Tmp = hipe_rtl:mk_new_reg_gcsafe(), @@ -617,21 +655,25 @@ test_either_immed(Arg1, Arg2, TrueLab, FalseLab) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% unsafe_car(Dst, Arg) -> - hipe_rtl:mk_load(Dst, Arg, hipe_rtl:mk_imm(-(?TAG_PRIMARY_LIST))). + {Base, Offset, Untag} = untag_ptr(Arg, ?TAG_PRIMARY_LIST), + [Untag, hipe_rtl:mk_load(Dst, Base, hipe_rtl:mk_imm(Offset))]. unsafe_cdr(Dst, Arg) -> + {Base, Offset, Untag} = untag_ptr(Arg, ?TAG_PRIMARY_LIST), WordSize = hipe_rtl_arch:word_size(), - hipe_rtl:mk_load(Dst, Arg, hipe_rtl:mk_imm(-(?TAG_PRIMARY_LIST)+WordSize)). + [Untag, hipe_rtl:mk_load(Dst, Base, hipe_rtl:mk_imm(Offset+WordSize))]. unsafe_constant_element(Dst, Index, Tuple) -> % Index is an immediate WordSize = hipe_rtl_arch:word_size(), - Offset = -(?TAG_PRIMARY_BOXED) + WordSize * hipe_rtl:imm_value(Index), - hipe_rtl:mk_load(Dst, Tuple, hipe_rtl:mk_imm(Offset)). + {Base, Offset0, Untag} = untag_ptr(Tuple, ?TAG_PRIMARY_BOXED), + Offset = Offset0 + WordSize * hipe_rtl:imm_value(Index), + [Untag, hipe_rtl:mk_load(Dst, Base, hipe_rtl:mk_imm(Offset))]. unsafe_update_element(Tuple, Index, Value) -> % Index is an immediate WordSize = hipe_rtl_arch:word_size(), - Offset = -(?TAG_PRIMARY_BOXED) + WordSize * hipe_rtl:imm_value(Index), - hipe_rtl:mk_store(Tuple, hipe_rtl:mk_imm(Offset), Value). + {Base, Offset0, Untag} = untag_ptr(Tuple, ?TAG_PRIMARY_BOXED), + Offset = Offset0 + WordSize * hipe_rtl:imm_value(Index), + [Untag, hipe_rtl:mk_store(Base, hipe_rtl:mk_imm(Offset), Value)]. %%% wrong semantics %% unsafe_variable_element(Dst, Index, Tuple) -> % Index is an unknown fixnum @@ -644,10 +686,12 @@ unsafe_update_element(Tuple, Index, Value) -> % Index is an immediate %% Tmp1 = hipe_rtl:mk_new_reg_gcsafe(), %% Tmp2 = hipe_rtl:mk_new_reg_gcsafe(), %% Shift = ?TAG_IMMED1_SIZE - 2, -%% OffAdj = (?TAG_IMMED1_SMALL bsr Shift) + ?TAG_PRIMARY_BOXED, +%% {Base, Off0, Untag} = untag_ptr(Tuple, ?TAG_PRIMARY_BOXED), +%% OffAdj = (?TAG_IMMED1_SMALL bsr Shift) - Off0, %% [hipe_rtl:mk_alu(Tmp1, Index, 'srl', hipe_rtl:mk_imm(Shift)), %% hipe_rtl:mk_alu(Tmp2, Tmp1, 'sub', hipe_rtl:mk_imm(OffAdj)), -%% hipe_rtl:mk_load(Dst, Tuple, Tmp2)]. +%% Untag, +%% hipe_rtl:mk_load(Base, Tuple, Tmp2)]. element(Dst, Index, Tuple, FailLabName, {tuple, A}, IndexInfo) -> FixnumOkLab = hipe_rtl:mk_new_label(), @@ -660,7 +704,7 @@ element(Dst, Index, Tuple, FailLabName, {tuple, A}, IndexInfo) -> Offset = hipe_rtl:mk_new_reg_gcsafe(), Ptr = hipe_rtl:mk_new_reg(), % offset from Tuple [untag_fixnum(UIndex, Index), - hipe_rtl:mk_alu(Ptr, Tuple, 'sub', hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED)), + untag_ptr_nooffset(Ptr, Tuple, ?TAG_PRIMARY_BOXED), hipe_rtl:mk_alu(Offset, UIndex, 'sll', hipe_rtl:mk_imm(hipe_rtl_arch:log2_word_size())), hipe_rtl:mk_load(Dst, Ptr, Offset)]; @@ -769,7 +813,7 @@ gen_element_tail(Dst, Tuple, Arity, UIndex, FailLabName, IndexOkLab) -> hipe_rtl:mk_branch(ZeroIndex, 'geu', Arity, FailLabName, hipe_rtl:label_name(IndexOkLab), 0.01), IndexOkLab, - hipe_rtl:mk_alu(Ptr, Tuple, 'sub', hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED)), + untag_ptr_nooffset(Ptr, Tuple, ?TAG_PRIMARY_BOXED), hipe_rtl:mk_alu(Offset, UIndex, 'sll', hipe_rtl:mk_imm(hipe_rtl_arch:log2_word_size())), hipe_rtl:mk_load(Dst, Ptr, Offset)]. @@ -777,11 +821,13 @@ gen_element_tail(Dst, Tuple, Arity, UIndex, FailLabName, IndexOkLab) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% unsafe_closure_element(Dst, Index, Closure) -> % Index is an immediate - Offset = -(?TAG_PRIMARY_BOXED) %% Untag + %% XXX: Can there even be closure literals? + {Base, Offset0, Untag} = untag_ptr(Closure, ?TAG_PRIMARY_BOXED), + Offset = Offset0 %% Untag + ?EFT_ENV %% Field offset %% Index from 1 to N hence -1) + (hipe_rtl_arch:word_size() * (hipe_rtl:imm_value(Index)-1)), - hipe_rtl:mk_load(Dst, Closure, hipe_rtl:mk_imm(Offset)). + [Untag, hipe_rtl:mk_load(Dst, Base, hipe_rtl:mk_imm(Offset))]. mk_fun_header() -> hipe_rtl:mk_imm(?HEADER_FUN). @@ -790,7 +836,7 @@ tag_fun(Res, X) -> tag_boxed(Res, X). %% untag_fun(Res, X) -> -%% hipe_rtl:mk_alu(Res, X, 'sub', hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED)). +%% untag_ptr_nooffset(Res, X, ?TAG_PRIMARY_BOXED). if_fun_get_arity_and_address(ArityReg, AddressReg, FunP, BadFunLab, Pred) -> %% EmuAddressPtrReg = hipe_rtl:mk_new_reg(), @@ -801,15 +847,15 @@ if_fun_get_arity_and_address(ArityReg, AddressReg, FunP, BadFunLab, Pred) -> TrueLab0 = hipe_rtl:mk_new_label(), %% TrueLab1 = hipe_rtl:mk_new_label(), IsFunCode = test_closure(FunP, hipe_rtl:label_name(TrueLab0), BadFunLab, Pred), + {Base, Offset, Untag} = untag_ptr(FunP, ?TAG_PRIMARY_BOXED), GetArityCode = [TrueLab0, %% Funp->arity contains the arity - hipe_rtl:mk_load(ArityReg, FunP, - hipe_rtl:mk_imm(-(?TAG_PRIMARY_BOXED)+ - ?EFT_ARITY)), - hipe_rtl:mk_load(FEPtrReg, FunP, - hipe_rtl:mk_imm(-(?TAG_PRIMARY_BOXED)+ - ?EFT_FE)), + Untag, + hipe_rtl:mk_load(ArityReg, Base, + hipe_rtl:mk_imm(Offset+?EFT_ARITY)), + hipe_rtl:mk_load(FEPtrReg, Base, + hipe_rtl:mk_imm(Offset+?EFT_FE)), hipe_rtl:mk_load(AddressReg, FEPtrReg, hipe_rtl:mk_imm(?EFE_NATIVE_ADDRESS))], IsFunCode ++ GetArityCode. @@ -927,20 +973,24 @@ test_subbinary(Binary, TrueLblName, FalseLblName) -> unsafe_load_float(DstLo, DstHi, Src) -> WordSize = hipe_rtl_arch:word_size(), - Offset1 = -(?TAG_PRIMARY_BOXED) + WordSize, + {Base, Offset0, Untag} = untag_ptr(Src, ?TAG_PRIMARY_BOXED), + Offset1 = Offset0 + WordSize, Offset2 = Offset1 + 4, %% This should really be 4 and not WordSize case hipe_rtl_arch:endianess() of little -> - [hipe_rtl:mk_load(DstLo, Src, hipe_rtl:mk_imm(Offset1), int32, unsigned), - hipe_rtl:mk_load(DstHi, Src, hipe_rtl:mk_imm(Offset2), int32, unsigned)]; + [Untag, + hipe_rtl:mk_load(DstLo, Base, hipe_rtl:mk_imm(Offset1), int32, unsigned), + hipe_rtl:mk_load(DstHi, Base, hipe_rtl:mk_imm(Offset2), int32, unsigned)]; big -> - [hipe_rtl:mk_load(DstHi, Src, hipe_rtl:mk_imm(Offset1), int32, unsigned), - hipe_rtl:mk_load(DstLo, Src, hipe_rtl:mk_imm(Offset2), int32, unsigned)] + [Untag, + hipe_rtl:mk_load(DstHi, Base, hipe_rtl:mk_imm(Offset1), int32, unsigned), + hipe_rtl:mk_load(DstLo, Base, hipe_rtl:mk_imm(Offset2), int32, unsigned)] end. unsafe_untag_float(Dst, Src) -> - Offset = -(?TAG_PRIMARY_BOXED) + hipe_rtl_arch:word_size(), - [hipe_rtl:mk_fload(Dst, Src, hipe_rtl:mk_imm(Offset))]. + {Base, Offset0, Untag} = untag_ptr(Src, ?TAG_PRIMARY_BOXED), + Offset = Offset0 + hipe_rtl_arch:word_size(), + [Untag, hipe_rtl:mk_fload(Dst, Base, hipe_rtl:mk_imm(Offset))]. unsafe_tag_float(Dst, Src) -> {GetHPInsn, HP, PutHPInsn} = hipe_rtl_arch:heap_pointer(), @@ -999,8 +1049,9 @@ get_one_word_pos_bignum(USize, Size, Fail) -> unsafe_get_one_word_pos_bignum(USize, Size) -> WordSize = hipe_rtl_arch:word_size(), - Imm = hipe_rtl:mk_imm(1*WordSize-?TAG_PRIMARY_BOXED), - [hipe_rtl:mk_load(USize, Size, Imm)]. + {Base, Offset, Untag} = untag_ptr(Size, ?TAG_PRIMARY_BOXED), + Imm = hipe_rtl:mk_imm(1*WordSize+Offset), + [Untag, hipe_rtl:mk_load(USize, Base, Imm)]. -spec bignum_sizeneed(non_neg_integer()) -> non_neg_integer(). @@ -1040,7 +1091,7 @@ create_matchstate(Max, BinSize, Base, Offset, Orig, Ms) -> SizeInWords = ((ByteSize div WordSize) - 1), Header = hipe_rtl:mk_imm(mk_header(SizeInWords, ?TAG_HEADER_BIN_MATCHSTATE)), [GetHPInsn, - hipe_rtl:mk_alu(Ms, HP, add, hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED)), + tag_boxed(Ms, HP), set_field_from_term({matchstate,thing_word}, Ms, Header), set_field_from_term({matchstate,{matchbuffer,orig}}, Ms, Orig), set_field_from_term({matchstate,{matchbuffer,base}}, Ms, Base), @@ -1078,7 +1129,10 @@ convert_matchstate(Ms) -> size_from_header(SizeInWords, Header), hipe_rtl:mk_alu(Hole, SizeInWords, sub, hipe_rtl:mk_imm(?SUB_BIN_WORDSIZE)), mk_var_header(BigIntHeader, Hole, ?TAG_HEADER_POS_BIG), - hipe_rtl:mk_store(Ms, hipe_rtl:mk_imm(?SUB_BIN_WORDSIZE*WordSize-?TAG_PRIMARY_BOXED), + %% Matchstates can't be literals; so untagging with ?TAG_PRIMARY_BOXED is + %% fine here + hipe_rtl:mk_store(Ms, hipe_rtl:mk_imm(?SUB_BIN_WORDSIZE*WordSize + -?TAG_PRIMARY_BOXED), BigIntHeader)]. compare_matchstate(Max, Ms, LargeEnough, TooSmall) -> @@ -1087,8 +1141,10 @@ compare_matchstate(Max, Ms, LargeEnough, TooSmall) -> SizeInWords = ((ByteSize div WordSize) - 1), Header = hipe_rtl:mk_imm(mk_header(SizeInWords, ?TAG_HEADER_BIN_MATCHSTATE)), RealHeader = hipe_rtl:mk_new_reg_gcsafe(), - [hipe_rtl:mk_load(RealHeader, Ms, hipe_rtl:mk_imm(-?TAG_PRIMARY_BOXED)), - hipe_rtl:mk_branch(RealHeader, ge, Header, LargeEnough, TooSmall)]. + %% Matchstates can't be literals; so untagging with ?TAG_PRIMARY_BOXED is fine + %% here + [hipe_rtl:mk_load(RealHeader, Ms, hipe_rtl:mk_imm(-?TAG_PRIMARY_BOXED)), + hipe_rtl:mk_branch(RealHeader, ge, Header, LargeEnough, TooSmall)]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% @@ -1207,15 +1263,22 @@ get_field_size1({matchbuffer, base}) -> get_field_size1({matchbuffer, binsize}) -> ?MB_SIZE_SIZE. +get_field_addr_from_term(Struct, Term, Dst) -> + {Base, Offset0, Untag} = untag_ptr(Term, ?TAG_PRIMARY_BOXED), + Offset = hipe_rtl:mk_imm(get_field_offset(Struct) + Offset0), + [Untag, hipe_rtl:mk_alu(Dst, Base, add, Offset)]. + get_field_from_term(Struct, Term, Dst) -> - Offset = hipe_rtl:mk_imm(get_field_offset(Struct) - ?TAG_PRIMARY_BOXED), + {Base, Offset0, Untag} = untag_ptr(Term, ?TAG_PRIMARY_BOXED), + Offset = hipe_rtl:mk_imm(get_field_offset(Struct) + Offset0), Size = get_field_size(Struct), - hipe_rtl:mk_load(Dst, Term, Offset, Size, unsigned). + [Untag, hipe_rtl:mk_load(Dst, Base, Offset, Size, unsigned)]. set_field_from_term(Struct, Term, Value) -> - Offset = hipe_rtl:mk_imm(get_field_offset(Struct) - ?TAG_PRIMARY_BOXED), + {Base, Offset0, Untag} = untag_ptr(Term, ?TAG_PRIMARY_BOXED), + Offset = hipe_rtl:mk_imm(get_field_offset(Struct) + Offset0), Size = get_field_size(Struct), - hipe_rtl:mk_store(Term, Offset, Value, Size). + [Untag, hipe_rtl:mk_store(Base, Offset, Value, Size)]. get_field_from_pointer(Struct, Term, Dst) -> Offset = hipe_rtl:mk_imm(get_field_offset(Struct)), @@ -1229,6 +1292,8 @@ set_field_from_pointer(Struct, Term, Value) -> extract_matchbuffer(Mb, Ms) -> What = {matchstate, matchbuffer}, + %% Matchstates can't be literals; so untagging with ?TAG_PRIMARY_BOXED is fine + %% here Offset = hipe_rtl:mk_imm(get_field_offset(What) - ?TAG_PRIMARY_BOXED), hipe_rtl:mk_alu(Mb, Ms, add, Offset). diff --git a/lib/hipe/ssa/hipe_ssa.inc b/lib/hipe/ssa/hipe_ssa.inc index c7c1a8e1d7..29e8b92266 100644 --- a/lib/hipe/ssa/hipe_ssa.inc +++ b/lib/hipe/ssa/hipe_ssa.inc @@ -463,20 +463,20 @@ updateStatementDefs([], Statement, Current, Acc) -> %%---------------------------------------------------------------------- updateIndices(Current, Variable) -> - case ?CODE:is_var(Variable) of - true -> - NewVar = ?CODE:mk_new_var(), - {NewVar,gb_trees:enter(Variable, NewVar, Current)}; - false -> - case is_fp_temp(Variable) of - true -> - NewFVar = mk_new_fp_temp(), - {NewFVar,gb_trees:enter(Variable, NewFVar, Current)}; - false -> - NewReg = ?CODE:mk_new_reg(), - {NewReg,gb_trees:enter(Variable, NewReg, Current)} - end - end. + New = + case ?CODE:is_var(Variable) of + true -> ?CODE:mk_new_var(); + false -> + case is_fp_temp(Variable) of + true -> mk_new_fp_temp(); + false -> + case ?CODE:reg_is_gcsafe(Variable) of + true -> ?CODE:mk_new_reg_gcsafe(); + false -> ?CODE:mk_new_reg() + end + end + end, + {New, gb_trees:enter(Variable, New, Current)}. %%---------------------------------------------------------------------- %% Procedure : updateSuccPhi/4 diff --git a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl index 229a0516dc..d71b924d22 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl @@ -6,12 +6,13 @@ %%%------------------------------------------------------------------- -module(basic_exceptions). --export([test/0, test_catches/0]). +-export([test/0]). %% functions used as arguments to spawn/3 -export([bad_guy/2]). test() -> + ok = test_catches(), ok = test_catch_exit(42), ok = test_catch_throw(42), ok = test_catch_element(), @@ -22,6 +23,7 @@ test() -> ok = test_pending_errors(), ok = test_bad_fun_call(), ok = test_guard_bif(), + ok = test_eclectic(), ok. %%-------------------------------------------------------------------- @@ -463,3 +465,117 @@ guard_bif('node/0', X, Y) when node() == Y -> {'node/0', X, Y}; guard_bif('node/1', X, Y) when node(X) == Y -> {'node/1', X, Y}. + +%%-------------------------------------------------------------------- +%% Taken from trycatch_SUITE.erl (compiler test suite). +%% +%% Cases that are commented out contain exception information that was +%% added to Erlang/OTP in commit e8d45ae14c6c3bdfcbbc7964228b004ef4f11ea6 +%% (May 2017) only in the BEAM emulator. Thus, part of this test fails +%% when compiled in native code. +%% The remaining cases are uncommented so that they are properly tested +%% in native code too. +%%-------------------------------------------------------------------- + +test_eclectic() -> + V = {make_ref(),3.1415926535,[[]|{}]}, + {{value,{value,V},V},V} = + eclectic_1({foo,{value,{value,V}}}, undefined, {value,V}), + {{'EXIT',{V,[{?MODULE,foo,1,_}|_]}},V} = + eclectic_1({catch_foo,{error,V}}, undefined, {value,V}), + {{error,{exit,V},{'EXIT',V}},V} = + eclectic_1({foo,{error,{exit,V}}}, error, {value,V}), + %% {{value,{value,V},V}, + %% {'EXIT',{badarith,[{erlang,'+',[0,a],_},{?MODULE,my_add,2,_}|_]}}} = + %% eclectic_1({foo,{value,{value,V}}}, undefined, {'add',{0,a}}), + {{'EXIT',V},V} = + eclectic_1({catch_foo,{exit,V}}, undefined, {throw,V}), + %% {{error,{'div',{1,0}},{'EXIT',{badarith,[{erlang,'div',[1,0],_},{?MODULE,my_div,2,_}|_]}}}, + %% {'EXIT',V}} = + %% eclectic_1({foo,{error,{'div',{1,0}}}}, error, {exit,V}), + {{{error,V},{'EXIT',{V,[{?MODULE,foo,1,_}|_]}}}, + {'EXIT',V}} = + eclectic_1({catch_foo,{throw,{error,V}}}, undefined, {exit,V}), + %% + {{value,{value,{value,V},V}},V} = + eclectic_2({value,{value,V}}, undefined, {value,V}), + {{value,{throw,{value,V},V}},V} = + eclectic_2({throw,{value,V}}, throw, {value,V}), + {{caught,{'EXIT',V}},undefined} = + eclectic_2({value,{value,V}}, undefined, {exit,V}), + {{caught,{'EXIT',{V,[{?MODULE,foo,1,_}|_]}}},undefined} = + eclectic_2({error,{value,V}}, throw, {error,V}), + %% The following fails in native code + %% %% {{caught,{'EXIT',{badarg,[{erlang,abs,[V],_}|_]}}},V} = + %% %% eclectic_2({value,{'abs',V}}, undefined, {value,V}), + %% {{caught,{'EXIT',{badarith,[{erlang,'+',[0,a],_},{?MODULE,my_add,2,_}|_]}}},V} = + %% eclectic_2({exit,{'add',{0,a}}}, exit, {value,V}), + {{caught,{'EXIT',V}},undefined} = + eclectic_2({value,{error,V}}, undefined, {exit,V}), + {{caught,{'EXIT',{V,[{?MODULE,foo,1,_}|_]}}},undefined} = + eclectic_2({throw,{'div',{1,0}}}, throw, {error,V}), + ok. + +eclectic_1(X, C, Y) -> + erase(eclectic), + Done = make_ref(), + Try = + try case X of + {catch_foo,V} -> catch {Done,foo(V)}; + {foo,V} -> {Done,foo(V)} + end of + {Done,D} -> {value,D,catch foo(D)}; + {'EXIT',_}=Exit -> Exit; + D -> {D,catch foo(D)} + catch + C:D -> {C,D,catch foo(D)} + after + put(eclectic, catch foo(Y)) + end, + {Try,erase(eclectic)}. + +eclectic_2(X, C, Y) -> + Done = make_ref(), + erase(eclectic), + Catch = + case + catch + {Done, + try foo(X) of + V -> {value,V,foo(V)} + catch + C:D -> {C,D,foo(D)} + after + put(eclectic, foo(Y)) + end} of + {Done,Z} -> {value,Z}; + Z -> {caught,Z} + end, + {Catch,erase(eclectic)}. + +foo({value,Value}) -> Value; +foo({'div',{A,B}}) -> + my_div(A, B); +foo({'add',{A,B}}) -> + my_add(A, B); +foo({'abs',X}) -> + my_abs(X); +foo({error,Error}) -> + erlang:error(Error); +foo({throw,Throw}) -> + erlang:throw(Throw); +foo({exit,Exit}) -> + erlang:exit(Exit); +foo({raise,{Class,Reason}}) -> + erlang:raise(Class, Reason); +foo(Term) when not is_atom(Term) -> Term. +%%foo(Atom) when is_atom(Atom) -> % must not be defined! + +my_div(A, B) -> + A div B. + +my_add(A, B) -> + A + B. + +my_abs(X) -> + abs(X). diff --git a/lib/hipe/test/basic_SUITE_data/basic_receive.erl b/lib/hipe/test/basic_SUITE_data/basic_receive.erl index 5f865d7b7a..20e3f350e8 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_receive.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_receive.erl @@ -12,6 +12,7 @@ test() -> ok = test_wait_timeout(), ok = test_double_timeout(), ok = test_reschedule(), + ok = test_recv_mark(), ok. %%-------------------------------------------------------------------- @@ -54,3 +55,91 @@ doit(First) -> erts_debug:set_internal_state(hipe_test_reschedule_suspend, 1). %%-------------------------------------------------------------------- +%% Check that we cannot cause a recv_mark,recv_set pair to misbehave and +%% deadlock the process. + +test_recv_mark() -> + ok = test_recv_mark(fun disturber_nop/0), + ok = test_recv_mark(fun disturber_receive/0), + ok = test_recv_mark(fun disturber_other/0), + ok = test_recv_mark(fun disturber_recurse/0), + ok = test_recv_mark_after(self(), fun disturber_after_recurse/0, false), + ok = test_recv_mark(fun disturber_other_recurse/0), + ok = test_recv_mark(fun disturber_other_after/0), + ok = test_recv_mark_nested(). + +test_recv_mark(Disturber) -> + Ref = make_ref(), + self() ! Ref, + Disturber(), + receive Ref -> ok + after 0 -> error(failure) + end. + +disturber_nop() -> ok. + +disturber_receive() -> + self() ! message, + receive message -> ok end. + +disturber_other() -> + Ref = make_ref(), + self() ! Ref, + receive Ref -> ok end. + +disturber_recurse() -> + aborted = (catch test_recv_mark(fun() -> throw(aborted) end)), + ok. + +test_recv_mark_after(Recipient, Disturber, IsInner) -> + Ref = make_ref(), + Recipient ! Ref, + Disturber(), + receive + Ref -> ok + after 0 -> + case IsInner of + true -> expected; + false -> error(failure) + end + end. + +disturber_after_recurse() -> + NoOp = fun() -> ok end, + BlackHole = spawn(NoOp), + expected = test_recv_mark_after(BlackHole, NoOp, true), + ok. + +disturber_other_recurse() -> + aborted = (catch disturber_other_recurse(fun() -> throw(aborted) end)), + ok. + +disturber_other_recurse(InnerD) -> + Ref = make_ref(), + self() ! Ref, + InnerD(), + receive Ref -> ok + after 0 -> error(failure) + end. + +disturber_other_after() -> + BlackHole = spawn(fun() -> ok end), + Ref = make_ref(), + BlackHole ! Ref, + receive Ref -> error(imposible) + after 0 -> ok + end. + +test_recv_mark_nested() -> + Ref1 = make_ref(), + self() ! Ref1, + begin + Ref2 = make_ref(), + self() ! Ref2, + receive Ref2 -> ok end + end, + receive Ref1 -> ok + after 0 -> error(failure) + end. + +%%-------------------------------------------------------------------- diff --git a/lib/hipe/test/hipe_testsuite_driver.erl b/lib/hipe/test/hipe_testsuite_driver.erl index 88576775ca..8813af5dfc 100644 --- a/lib/hipe/test/hipe_testsuite_driver.erl +++ b/lib/hipe/test/hipe_testsuite_driver.erl @@ -29,13 +29,9 @@ get_suites(SuitesWithSuiteSuffix) -> [S || {yes, S} <- Prefixes]. suffix(String, Suffix) -> - case string:rstr(String, Suffix) of - 0 -> no; - Index -> - case string:substr(String, Index) =:= Suffix of - true -> {yes, string:sub_string(String, 1, Index-1)}; - false -> no - end + case string:split(String, Suffix, trailing) of + [Prefix,[]] -> {yes, Prefix}; + _ -> no end. -spec file_type(file:filename()) -> {ok, file_type()} | {error, ext_posix()}. @@ -165,7 +161,8 @@ run(TestCase, Dir, _OutDir) -> %% end, DataFiles), %% try ok = TestCase:test(), - HiPEOpts = try TestCase:hipe_options() catch error:undef -> [] end, + HiPEOpts0 = try TestCase:hipe_options() catch error:undef -> [] end, + HiPEOpts = HiPEOpts0 ++ hipe_options(), {ok, TestCase} = hipe:c(TestCase, HiPEOpts), ok = TestCase:test(), {ok, TestCase} = hipe:c(TestCase, [o1|HiPEOpts]), @@ -183,3 +180,6 @@ run(TestCase, Dir, _OutDir) -> %% lists:foreach(fun (DF) -> ok end, % = file:delete(DF) end, %% [filename:join(OutDir, D) || D <- DataFiles]) %% end. + +hipe_options() -> + [verify_gcsafe]. diff --git a/lib/hipe/test/opt_verify_SUITE.erl b/lib/hipe/test/opt_verify_SUITE.erl index a323c10503..24f43af275 100644 --- a/lib/hipe/test/opt_verify_SUITE.erl +++ b/lib/hipe/test/opt_verify_SUITE.erl @@ -59,7 +59,7 @@ call_elim_test_file(Config, FileName, Option) -> substring_count(Icode, Substring) -> substring_count(Icode, Substring, 0). substring_count(Icode, Substring, N) -> - case string:str(Icode, Substring) of - 0 -> N; - I -> substring_count(lists:nthtail(I, Icode), Substring, N+1) + case string:find(Icode, Substring) of + nomatch -> N; + Prefix -> substring_count(string:prefix(Prefix, Substring), Substring, N+1) end. diff --git a/lib/hipe/vsn.mk b/lib/hipe/vsn.mk index f88d9147b1..508ec00548 100644 --- a/lib/hipe/vsn.mk +++ b/lib/hipe/vsn.mk @@ -1 +1 @@ -HIPE_VSN = 3.16.1 +HIPE_VSN = 3.17 diff --git a/lib/ic/doc/src/Makefile b/lib/ic/doc/src/Makefile index 19f12ac6b9..118f42b605 100644 --- a/lib/ic/doc/src/Makefile +++ b/lib/ic/doc/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1998-2016. All Rights Reserved. +# Copyright Ericsson AB 1998-2017. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -49,8 +49,7 @@ XML_REF3_FILES = ic.xml \ ic_clib.xml \ ic_c_protocol.xml -XML_PART_FILES = part.xml \ - part_notes.xml +XML_PART_FILES = part.xml XML_CHAPTER_FILES = \ ch_introduction.xml \ @@ -68,13 +67,9 @@ XML_CHAPTER_FILES = \ BOOK_FILES = book.xml XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \ - $(XML_PART_FILES) $(XML_CHAPTER_FILES) + $(XML_PART_FILES) $(XML_CHAPTER_FILES) -GIF_FILES = \ - book.gif \ - notes.gif \ - ref_man.gif \ - user_guide.gif +GIF_FILES = # ---------------------------------------------------- @@ -82,7 +77,7 @@ HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) INFO_FILE = ../../info -EXTRA_FILES = summary.html.src \ +EXTRA_FILES = \ $(DEFAULT_GIF_FILES) \ $(DEFAULT_HTML_FILES) \ $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ @@ -161,12 +156,12 @@ JAVADOC_GENERATED_FILES = $(JAVADOC_PACK_HTML_FILES) $(JAVADOC_INDEX_HTML_FILES) # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- CLASSPATH = $(JAVA_SRC_ROOT):$(JAVA_INCL_ROOT) -XML_FLAGS += -DVIPS_FLAGS += +XML_FLAGS += +DVIPS_FLAGS += JAVADOCFLAGS = \ -classpath $(CLASSPATH) \ -d ../doc/html/java \ @@ -197,7 +192,7 @@ clean clean_docs: rm -rf $(HTMLDIR)/* rm -f $(MAN3DIR)/* rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ + rm -f errs core *~ $(JAVADOC_GENERATED_FILES): JAVADOC-GENERATED @@ -212,12 +207,12 @@ gifs: $(GIF_FILES:%=$(HTMLDIR)/%) $(INDEX_TARGET): $(INDEX_SRC) ../../vsn.mk sed -e 's;%VSN%;$(VSN);' $< > $@ -debug opt: +debug opt: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs diff --git a/lib/ic/doc/src/book.gif b/lib/ic/doc/src/book.gif Binary files differdeleted file mode 100644 index 94b3868792..0000000000 --- a/lib/ic/doc/src/book.gif +++ /dev/null diff --git a/lib/ic/doc/src/fascicules.xml b/lib/ic/doc/src/fascicules.xml deleted file mode 100644 index 37feca543f..0000000000 --- a/lib/ic/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/ic/doc/src/ic.gif b/lib/ic/doc/src/ic.gif Binary files differdeleted file mode 100644 index d78cf7d8ed..0000000000 --- a/lib/ic/doc/src/ic.gif +++ /dev/null diff --git a/lib/ic/doc/src/notes.gif b/lib/ic/doc/src/notes.gif Binary files differdeleted file mode 100644 index e000cca26a..0000000000 --- a/lib/ic/doc/src/notes.gif +++ /dev/null diff --git a/lib/ic/doc/src/notes.xml b/lib/ic/doc/src/notes.xml index ea8bf758cf..fc68ec386c 100644 --- a/lib/ic/doc/src/notes.xml +++ b/lib/ic/doc/src/notes.xml @@ -31,7 +31,22 @@ <file>notes.xml</file> </header> - <section><title>IC 4.4.2</title> + <section><title>IC 4.4.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Removed all old unused files in the documentation. + </p> + <p> + Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p> + </item> + </list> + </section> + +</section> + +<section><title>IC 4.4.2</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/ic/doc/src/part_notes.xml b/lib/ic/doc/src/part_notes.xml deleted file mode 100644 index 305b2c558d..0000000000 --- a/lib/ic/doc/src/part_notes.xml +++ /dev/null @@ -1,38 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>1998</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>Idl Compiler Release Notes</title> - <prepared></prepared> - <docno></docno> - <date>1998-05-06</date> - <rev>2.1</rev> - </header> - <description> - <p>The IDL - Compiler Application is an Erlang implementation of a compiler for the IDL language. - </p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/ic/doc/src/ref_man.gif b/lib/ic/doc/src/ref_man.gif Binary files differdeleted file mode 100644 index b13c4efd53..0000000000 --- a/lib/ic/doc/src/ref_man.gif +++ /dev/null diff --git a/lib/ic/doc/src/summary.html.src b/lib/ic/doc/src/summary.html.src deleted file mode 100644 index cb92e51791..0000000000 --- a/lib/ic/doc/src/summary.html.src +++ /dev/null @@ -1 +0,0 @@ -IDL compiler diff --git a/lib/ic/doc/src/user_guide.gif b/lib/ic/doc/src/user_guide.gif Binary files differdeleted file mode 100644 index e6275a803d..0000000000 --- a/lib/ic/doc/src/user_guide.gif +++ /dev/null diff --git a/lib/ic/vsn.mk b/lib/ic/vsn.mk index f0e5e7c266..b9f1ef7f20 100644 --- a/lib/ic/vsn.mk +++ b/lib/ic/vsn.mk @@ -1 +1 @@ -IC_VSN = 4.4.2 +IC_VSN = 4.4.3 diff --git a/lib/inets/doc/src/Makefile b/lib/inets/doc/src/Makefile index cb71fbeb9c..cbfa5c9e30 100644 --- a/lib/inets/doc/src/Makefile +++ b/lib/inets/doc/src/Makefile @@ -39,6 +39,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) XML_APPLICATION_FILES = ref_man.xml XML_CHAPTER_FILES = \ + introduction.xml \ inets_services.xml \ http_client.xml \ http_server.xml \ @@ -58,7 +59,7 @@ XML_REF3_FILES = \ mod_alias.xml \ mod_auth.xml \ mod_esi.xml \ - mod_security.xml + mod_security.xml XML_PART_FILES = \ part.xml @@ -83,7 +84,7 @@ HTML_FILES = \ $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) INFO_FILE = ../../info -EXTRA_FILES = summary.html.src \ +EXTRA_FILES = \ $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ $(XML_REF6_FILES:%.xml=$(HTMLDIR)/%.html) \ $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html) @@ -95,10 +96,10 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += +XML_FLAGS += +DVIPS_FLAGS += # ---------------------------------------------------- # Targets @@ -119,25 +120,25 @@ html: gifs $(HTML_REF_MAN_FILE) clean clean_docs: clean_html clean_man clean_pdf rm -f errs core *~ -man: $(MAN3_FILES) +man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) -debug opt: +debug opt: -clean_pdf: +clean_pdf: rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) -clean_html: +clean_html: rm -rf $(TOP_HTML_FILES) $(HTMLDIR)/* clean_man: - rm -f $(MAN3_FILES) + rm -f $(MAN3_FILES) # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs diff --git a/lib/inets/doc/src/book.gif b/lib/inets/doc/src/book.gif Binary files differdeleted file mode 100644 index 94b3868792..0000000000 --- a/lib/inets/doc/src/book.gif +++ /dev/null diff --git a/lib/inets/doc/src/fascicules.xml b/lib/inets/doc/src/fascicules.xml deleted file mode 100644 index c075478967..0000000000 --- a/lib/inets/doc/src/fascicules.xml +++ /dev/null @@ -1,19 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - - diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml index 29e4b22632..58714328c5 100644 --- a/lib/inets/doc/src/httpc.xml +++ b/lib/inets/doc/src/httpc.xml @@ -287,8 +287,7 @@ {autoredirect, boolean()} | {proxy_auth, {userstring(), passwordstring()}} | {version, http_version()} | - {relaxed, boolean()} | - {url_encode, boolean()}</v> + {relaxed, boolean()}</v> <v>timeout() = integer() >= 0 | infinity</v> <v>Options = options()</v> <v>options() = [option()]</v> @@ -379,13 +378,6 @@ from the HTTP-standard are enabled.</p> <p>Default is <c>false</c>.</p> </item> - - <tag><c><![CDATA[url_encode]]></c></tag> - <item> - <p>Applies Percent-encoding, also known as URL encoding on the - URL.</p> - <p>Default is <c>false</c>.</p> - </item> </taglist> <p>Option (<c>option()</c>) details:</p> diff --git a/lib/inets/doc/src/inets.gif b/lib/inets/doc/src/inets.gif Binary files differdeleted file mode 100644 index 64968ae68a..0000000000 --- a/lib/inets/doc/src/inets.gif +++ /dev/null diff --git a/lib/inets/doc/src/min_head.gif b/lib/inets/doc/src/min_head.gif Binary files differdeleted file mode 100644 index 67948a6378..0000000000 --- a/lib/inets/doc/src/min_head.gif +++ /dev/null diff --git a/lib/inets/doc/src/mod_esi.xml b/lib/inets/doc/src/mod_esi.xml index a8393c9248..d024c8afa8 100644 --- a/lib/inets/doc/src/mod_esi.xml +++ b/lib/inets/doc/src/mod_esi.xml @@ -142,7 +142,7 @@ to the client and <c>SessionID</c> is an identifier that shall by used when calling this function, do not assume anything about the datatype. This function may be called - several times to chunk the the respons data. Notice that the + several times to chunk the response data. Notice that the first chunk of data sent to the client must at least contain all HTTP header fields that the response will generate. If the first chunk does not contain the <em>end of HTTP header</em>, diff --git a/lib/inets/doc/src/note.gif b/lib/inets/doc/src/note.gif Binary files differdeleted file mode 100644 index 6fffe30419..0000000000 --- a/lib/inets/doc/src/note.gif +++ /dev/null diff --git a/lib/inets/doc/src/notes.gif b/lib/inets/doc/src/notes.gif Binary files differdeleted file mode 100644 index e000cca26a..0000000000 --- a/lib/inets/doc/src/notes.gif +++ /dev/null diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index 07e29b5542..70b2811c0e 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -33,7 +33,37 @@ <file>notes.xml</file> </header> - <section><title>Inets 6.4.4</title> + <section><title>Inets 6.4.5</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + CGI environment variable CONTENT_LENGTH shall be a string</p> + <p> + Own Id: OTP-14679</p> + </item> + <item> + <p> + In relaxed mode disregard Content-Length header if there + is also a Transfer-Encoding header.</p> + <p> + Own Id: OTP-14727</p> + </item> + <item> + <p> + Eliminated race condition, that could cause http request + to sporadically fail to complete successfully, when + keep-alive connections are used.</p> + <p> + Own Id: OTP-14783</p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 6.4.4</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/doc/src/part_notes.xml b/lib/inets/doc/src/part_notes.xml deleted file mode 100644 index d10c829f4a..0000000000 --- a/lib/inets/doc/src/part_notes.xml +++ /dev/null @@ -1,40 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2002</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>Inets</title> - <prepared>Micael Karlberg</prepared> - <docno></docno> - <date>2002-02-28</date> - <rev>3.0</rev> - <file>part_notes.sgml</file> - </header> - <description> - <p>A set of services such as a Web server and a ftp client etc. </p> - <p>For information about older versions see - <url href="part_notes_history_frame.html">release notes history</url>.</p> - </description> - <xi:include file="notes.xml"/> -</part> - - diff --git a/lib/inets/doc/src/part_notes_history.xml b/lib/inets/doc/src/part_notes_history.xml deleted file mode 100644 index 66e3307f69..0000000000 --- a/lib/inets/doc/src/part_notes_history.xml +++ /dev/null @@ -1,35 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part> - <header> - <copyright> - <year>2004</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>Inets</title> - <prepared>Micael Karlberg</prepared> - <docno></docno> - <date>2002-02-28</date> - <rev>3.0</rev> - <file>part_notes.sgml</file> - </header> - <include file="notes_history"></include> -</part> - - diff --git a/lib/inets/doc/src/ref_man.gif b/lib/inets/doc/src/ref_man.gif Binary files differdeleted file mode 100644 index b13c4efd53..0000000000 --- a/lib/inets/doc/src/ref_man.gif +++ /dev/null diff --git a/lib/inets/doc/src/summary.html.src b/lib/inets/doc/src/summary.html.src deleted file mode 100644 index 17637a0787..0000000000 --- a/lib/inets/doc/src/summary.html.src +++ /dev/null @@ -1 +0,0 @@ -A set of services such as a web server and a ftp client etc
\ No newline at end of file diff --git a/lib/inets/doc/src/user_guide.gif b/lib/inets/doc/src/user_guide.gif Binary files differdeleted file mode 100644 index e6275a803d..0000000000 --- a/lib/inets/doc/src/user_guide.gif +++ /dev/null diff --git a/lib/inets/doc/src/warning.gif b/lib/inets/doc/src/warning.gif Binary files differdeleted file mode 100644 index 96af52360e..0000000000 --- a/lib/inets/doc/src/warning.gif +++ /dev/null diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl index bf2da82603..821eb7f02f 100644 --- a/lib/inets/src/http_client/httpc.erl +++ b/lib/inets/src/http_client/httpc.erl @@ -175,10 +175,10 @@ request(Method, (Method =:= delete) orelse (Method =:= trace) andalso (is_atom(Profile) orelse is_pid(Profile)) -> - case uri_parse(Url, Options) of - {error, Reason} -> + case uri_string:parse(uri_string:normalize(Url)) of + {error, Reason, _} -> {error, Reason}; - {ok, ParsedUrl} -> + ParsedUrl -> case header_parse(Headers) of {error, Reason} -> {error, Reason}; @@ -189,10 +189,10 @@ request(Method, end. do_request(Method, {Url, Headers, ContentType, Body}, HTTPOptions, Options, Profile) -> - case uri_parse(Url, Options) of - {error, Reason} -> + case uri_string:parse(uri_string:normalize(Url)) of + {error, Reason, _} -> {error, Reason}; - {ok, ParsedUrl} -> + ParsedUrl -> handle_request(Method, Url, ParsedUrl, Headers, ContentType, Body, HTTPOptions, Options, Profile) @@ -312,23 +312,28 @@ store_cookies(SetCookieHeaders, Url) -> store_cookies(SetCookieHeaders, Url, Profile) when is_atom(Profile) orelse is_pid(Profile) -> - try - begin + case uri_string:parse(uri_string:normalize(Url)) of + {error, Bad, _} -> + {error, {parse_failed, Bad}}; + URI -> + Scheme = scheme_to_atom(maps:get(scheme, URI, '')), + Host = maps:get(host, URI, ""), + Port = maps:get(port, URI, default_port(Scheme)), + Path = uri_string:recompose(#{path => maps:get(path, URI, "")}), %% Since the Address part is not actually used %% by the manager when storing cookies, we dont %% care about ipv6-host-with-brackets. - {ok, {_, _, Host, Port, Path, _}} = uri_parse(Url), Address = {Host, Port}, ProfileName = profile_name(Profile), Cookies = httpc_cookie:cookies(SetCookieHeaders, Path, Host), httpc_manager:store_cookies(Cookies, Address, ProfileName), ok - end - catch - error:{badmatch, Bad} -> - {error, {parse_failed, Bad}} end. +default_port(http) -> + 80; +default_port(https) -> + 443. %%-------------------------------------------------------------------------- %% cookie_header(Url) -> Header | {error, Reason} @@ -495,7 +500,7 @@ service_info(Pid) -> %%% Internal functions %%%======================================================================== handle_request(Method, Url, - {Scheme, UserInfo, Host, Port, Path, Query}, + URI, Headers0, ContentType, Body0, HTTPOptions0, Options0, Profile) -> @@ -520,37 +525,40 @@ handle_request(Method, Url, throw({error, {bad_body, Body0}}) end, - HTTPOptions = http_options(HTTPOptions0), - Options = request_options(Options0), - Sync = proplists:get_value(sync, Options), - Stream = proplists:get_value(stream, Options), - Host2 = http_request:normalize_host(Scheme, Host, Port), - HeadersRecord = header_record(NewHeaders, Host2, HTTPOptions), - Receiver = proplists:get_value(receiver, Options), - SocketOpts = proplists:get_value(socket_opts, Options), - BracketedHost = proplists:get_value(ipv6_host_with_brackets, - Options), - MaybeEscPath = maybe_encode_uri(HTTPOptions, Path), - MaybeEscQuery = maybe_encode_uri(HTTPOptions, Query), - AbsUri = maybe_encode_uri(HTTPOptions, Url), + HTTPOptions = http_options(HTTPOptions0), + Options = request_options(Options0), + Sync = proplists:get_value(sync, Options), + Stream = proplists:get_value(stream, Options), + Receiver = proplists:get_value(receiver, Options), + SocketOpts = proplists:get_value(socket_opts, Options), + BracketedHost = proplists:get_value(ipv6_host_with_brackets, + Options), + + Scheme = scheme_to_atom(maps:get(scheme, URI, '')), + Userinfo = maps:get(userinfo, URI, ""), + Host = http_util:maybe_add_brackets(maps:get(host, URI, ""), BracketedHost), + Port = maps:get(port, URI, default_port(Scheme)), + Host2 = http_request:normalize_host(Scheme, Host, Port), + Path = uri_string:recompose(#{path => maps:get(path, URI, "")}), + Query = add_question_mark(maps:get(query, URI, "")), + HeadersRecord = header_record(NewHeaders, Host2, HTTPOptions), Request = #request{from = Receiver, - scheme = Scheme, - address = {host_address(Host, BracketedHost), Port}, - path = MaybeEscPath, - pquery = MaybeEscQuery, + scheme = Scheme, + address = {Host, Port}, + path = Path, + pquery = Query, method = Method, headers = HeadersRecord, content = {ContentType, Body}, settings = HTTPOptions, - abs_uri = AbsUri, - userinfo = UserInfo, + abs_uri = Url, + userinfo = Userinfo, stream = Stream, headers_as_is = headers_as_is(Headers0, Options), socket_opts = SocketOpts, started = Started, ipv6_host_with_brackets = BracketedHost}, - case httpc_manager:request(Request, profile_name(Profile)) of {ok, RequestId} -> handle_answer(RequestId, Sync, Options); @@ -565,14 +573,31 @@ handle_request(Method, Url, Error end. + +add_question_mark(<<>>) -> + <<>>; +add_question_mark([]) -> + []; +add_question_mark(Comp) when is_binary(Comp) -> + <<$?, Comp/binary>>; +add_question_mark(Comp) when is_list(Comp) -> + [$?|Comp]. + + +scheme_to_atom("http") -> + http; +scheme_to_atom("https") -> + https; +scheme_to_atom('') -> + ''; +scheme_to_atom(Scheme) -> + throw({error, {bad_scheme, Scheme}}). + + ensure_chunked_encoding(Hdrs) -> Key = "transfer-encoding", lists:keystore(Key, 1, Hdrs, {Key, "chunked"}). -maybe_encode_uri(#http_options{url_encode = true}, URI) -> - http_uri:encode(URI); -maybe_encode_uri(_, URI) -> - URI. mk_chunkify_fun(ProcessBody) -> fun(eof_body) -> @@ -1190,17 +1215,6 @@ validate_headers(RequestHeaders, _, _) -> %% These functions is just simple wrappers to parse specifically HTTP URIs %%-------------------------------------------------------------------------- -scheme_defaults() -> - [{http, 80}, {https, 443}]. - -uri_parse(URI) -> - http_uri:parse(URI, [{scheme_defaults, scheme_defaults()}]). - -uri_parse(URI, Opts) -> - http_uri:parse(URI, [{scheme_defaults, scheme_defaults()} | Opts]). - - -%%-------------------------------------------------------------------------- header_parse([]) -> ok; header_parse([{Field, Value}|T]) when is_list(Field), is_list(Value) -> @@ -1221,10 +1235,6 @@ child_name(Pid, [{Name, Pid} | _]) -> child_name(Pid, [_ | Children]) -> child_name(Pid, Children). -host_address(Host, false) -> - Host; -host_address(Host, true) -> - string:strip(string:strip(Host, right, $]), left, $[). check_body_gen({Fun, _}) when is_function(Fun) -> ok; diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index bd1d2e833a..1482f4f922 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -109,7 +109,7 @@ start_link(Parent, Request, Options, ProfileName) -> %% to be called by the httpc manager process. %%-------------------------------------------------------------------- send(Request, Pid) -> - call(Request, Pid, 5000). + call(Request, Pid). %%-------------------------------------------------------------------- @@ -712,12 +712,16 @@ do_handle_info({'EXIT', _, _}, State = #state{request = undefined}) -> do_handle_info({'EXIT', _, _}, State) -> {noreply, State#state{status = close}}. - call(Msg, Pid) -> - call(Msg, Pid, infinity). - -call(Msg, Pid, Timeout) -> - gen_server:call(Pid, Msg, Timeout). + try gen_server:call(Pid, Msg) + catch + exit:{noproc, _} -> + {error, closed}; + exit:{normal, _} -> + {error, closed}; + exit:{{shutdown, _},_} -> + {error, closed} + end. cast(Msg, Pid) -> gen_server:cast(Pid, Msg). @@ -736,7 +740,7 @@ maybe_send_answer(Request, Answer, State) -> answer_request(Request, Answer, State). deliver_answer(#request{from = From} = Request) - when is_pid(From) -> + when From =/= answer_sent -> Response = httpc_response:error(Request, socket_closed_remotely), httpc_response:send(From, Response); deliver_answer(_Request) -> diff --git a/lib/inets/src/http_client/httpc_manager.erl b/lib/inets/src/http_client/httpc_manager.erl index a63864493f..ffdf1603b3 100644 --- a/lib/inets/src/http_client/httpc_manager.erl +++ b/lib/inets/src/http_client/httpc_manager.erl @@ -849,11 +849,11 @@ pipeline_or_keep_alive(#request{id = Id, from = From} = Request, HandlerPid, #state{handler_db = HandlerDb} = State) -> - case (catch httpc_handler:send(Request, HandlerPid)) of + case httpc_handler:send(Request, HandlerPid) of ok -> HandlerInfo = {Id, HandlerPid, From}, ets:insert(HandlerDb, HandlerInfo); - _ -> % timeout pipelining failed + {error, closed} -> % timeout pipelining failed start_handler(Request, State) end. diff --git a/lib/inets/src/http_client/httpc_response.erl b/lib/inets/src/http_client/httpc_response.erl index b3b11b74ab..58ab9144df 100644 --- a/lib/inets/src/http_client/httpc_response.erl +++ b/lib/inets/src/http_client/httpc_response.erl @@ -190,7 +190,7 @@ parse_status_code(<<?CR, ?LF, Rest/binary>>, StatusCodeStr, MaxHeaderSize, Result, true) -> parse_headers(Rest, [], [], MaxHeaderSize, [" ", list_to_integer(lists:reverse( - string:strip(StatusCodeStr))) + string:trim(StatusCodeStr))) | Result], true); parse_status_code(<<?SP, Rest/binary>>, StatusCodeStr, @@ -269,7 +269,7 @@ parse_headers(<<?LF,?LF,Body/binary>>, Header, Headers, MaxHeaderSize, Result, Relaxed); parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, Header, Headers, - MaxHeaderSize, Result, _) -> + MaxHeaderSize, Result, Relaxed) -> HTTPHeaders = [lists:reverse(Header) | Headers], Length = lists:foldl(fun(H, Acc) -> length(H) + Acc end, 0, HTTPHeaders), @@ -277,8 +277,42 @@ parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, Header, Headers, true -> ResponseHeaderRcord = http_response:headers(HTTPHeaders, #http_response_h{}), - {ok, list_to_tuple( - lists:reverse([Body, ResponseHeaderRcord | Result]))}; + + %% RFC7230, Section 3.3.3 + %% If a message is received with both a Transfer-Encoding and a + %% Content-Length header field, the Transfer-Encoding overrides the + %% Content-Length. Such a message might indicate an attempt to + %% perform request smuggling (Section 9.5) or response splitting + %% (Section 9.4) and ought to be handled as an error. A sender MUST + %% remove the received Content-Length field prior to forwarding such + %% a message downstream. + case ResponseHeaderRcord#http_response_h.'transfer-encoding' of + undefined -> + {ok, list_to_tuple( + lists:reverse([Body, ResponseHeaderRcord | Result]))}; + Value -> + TransferEncoding = string:lowercase(Value), + ContentLength = ResponseHeaderRcord#http_response_h.'content-length', + if + %% Respond without error but remove Content-Length field in relaxed mode + (Relaxed =:= true) + andalso (TransferEncoding =:= "chunked") + andalso (ContentLength =/= "-1") -> + ResponseHeaderRcordFixed = + ResponseHeaderRcord#http_response_h{'content-length' = "-1"}, + {ok, list_to_tuple( + lists:reverse([Body, ResponseHeaderRcordFixed | Result]))}; + %% Respond with error in default (not relaxed) mode + (Relaxed =:= false) + andalso (TransferEncoding =:= "chunked") + andalso (ContentLength =/= "-1") -> + throw({error, {headers_conflict, {'content-length', + 'transfer-encoding'}}}); + true -> + {ok, list_to_tuple( + lists:reverse([Body, ResponseHeaderRcord | Result]))} + end + end; false -> throw({error, {header_too_long, MaxHeaderSize, MaxHeaderSize-Length}}) @@ -343,58 +377,173 @@ status_server_error_50x(Response, Request) -> {stop, {Request#request.id, Msg}}. -redirect(Response = {StatusLine, Headers, Body}, Request) -> +redirect(Response = {_, Headers, _}, Request) -> {_, Data} = format_response(Response), case Headers#http_response_h.location of - undefined -> - transparent(Response, Request); - RedirUrl -> - UrlParseOpts = [{ipv6_host_with_brackets, - Request#request.ipv6_host_with_brackets}], - case uri_parse(RedirUrl, UrlParseOpts) of - {error, no_scheme} when - (Request#request.settings)#http_options.relaxed -> - NewLocation = fix_relative_uri(Request, RedirUrl), - redirect({StatusLine, Headers#http_response_h{ - location = NewLocation}, - Body}, Request); - {error, Reason} -> - {ok, error(Request, Reason), Data}; - %% Automatic redirection - {ok, {Scheme, _, Host, Port, Path, Query}} -> - HostPort = http_request:normalize_host(Scheme, Host, Port), - NewHeaders = - (Request#request.headers)#http_request_h{host = HostPort}, - NewRequest = - Request#request{redircount = - Request#request.redircount+1, - scheme = Scheme, - headers = NewHeaders, - address = {Host,Port}, - path = Path, - pquery = Query, - abs_uri = - atom_to_list(Scheme) ++ "://" ++ - Host ++ ":" ++ - integer_to_list(Port) ++ - Path ++ Query}, - {redirect, NewRequest, Data} - end + undefined -> + transparent(Response, Request); + RedirUrl -> + Brackets = Request#request.ipv6_host_with_brackets, + case uri_string:parse(RedirUrl) of + {error, Reason, _} -> + {ok, error(Request, Reason), Data}; + %% Automatic redirection + URI -> + {Host, Port0} = Request#request.address, + Port = maybe_to_integer(Port0), + Path = Request#request.path, + Scheme = atom_to_list(Request#request.scheme), + Query = Request#request.pquery, + URIMap = resolve_uri(Scheme, Host, Port, Path, Query, URI), + TScheme = list_to_atom(maps:get(scheme, URIMap)), + THost = http_util:maybe_add_brackets(maps:get(host, URIMap), Brackets), + TPort = maps:get(port, URIMap), + TPath = maps:get(path, URIMap), + TQuery = maps:get(query, URIMap, ""), + NewURI = uri_string:normalize( + uri_string:recompose(URIMap)), + HostPort = http_request:normalize_host(TScheme, THost, TPort), + NewHeaders = + (Request#request.headers)#http_request_h{host = HostPort}, + NewRequest = + Request#request{redircount = + Request#request.redircount+1, + scheme = TScheme, + headers = NewHeaders, + address = {THost,TPort}, + path = TPath, + pquery = TQuery, + abs_uri = NewURI}, + {redirect, NewRequest, Data} + end + end. + + +%% RFC3986 - 5.2.2. Transform References +resolve_uri(Scheme, Host, Port, Path, Query, URI) -> + resolve_uri(Scheme, Host, Port, Path, Query, URI, #{}). +%% +resolve_uri(Scheme, Host, Port, Path, Query, URI, Map0) -> + case maps:is_key(scheme, URI) of + true -> + Port = get_port(URI), + maybe_add_query( + Map0#{scheme => maps:get(scheme, URI), + host => maps:get(host, URI), + port => Port, + path => maps:get(path, URI)}, + URI); + false -> + Map = Map0#{scheme => Scheme}, + resolve_authority(Host, Port, Path, Query, URI, Map) + end. + + +get_port(URI) -> + Scheme = maps:get(scheme, URI), + case maps:get(port, URI, undefined) of + undefined -> + get_default_port(Scheme); + Port -> + Port + end. + + +get_default_port("http") -> + 80; +get_default_port("https") -> + 443. + + +resolve_authority(Host, Port, Path, Query, RelURI, Map) -> + case maps:is_key(host, RelURI) of + true -> + Port = get_port(RelURI), + maybe_add_query( + Map#{host => maps:get(host, RelURI), + port => Port, + path => maps:get(path, RelURI)}, + RelURI); + false -> + Map1 = Map#{host => Host, + port => Port}, + resolve_path(Path, Query, RelURI, Map1) + end. + + +maybe_add_query(Map, RelURI) -> + case maps:is_key(query, RelURI) of + true -> + Map#{query => maps:get(query, RelURI)}; + false -> + Map + end. + + +resolve_path(Path, Query, RelURI, Map) -> + case maps:is_key(path, RelURI) of + true -> + Path1 = calculate_path(Path, maps:get(path, RelURI)), + maybe_add_query( + Map#{path => Path1}, + RelURI); + false -> + Map1 = Map#{path => Path}, + resolve_query(Query, RelURI, Map1) + end. + + +calculate_path(BaseP, RelP) -> + case starts_with_slash(RelP) of + true -> + RelP; + false -> + merge_paths(BaseP, RelP) end. -maybe_to_list(Port) when is_integer(Port) -> - integer_to_list(Port); -maybe_to_list(Port) when is_list(Port) -> + +starts_with_slash([$/|_]) -> + true; +starts_with_slash(<<$/,_/binary>>) -> + true; +starts_with_slash(_) -> + false. + + +%% RFC3986 - 5.2.3. Merge Paths +merge_paths("", RelP) -> + [$/|RelP]; +merge_paths(BaseP, RelP) when is_list(BaseP) -> + do_merge_paths(lists:reverse(BaseP), RelP); +merge_paths(BaseP, RelP) when is_binary(BaseP) -> + B = binary_to_list(BaseP), + R = binary_to_list(RelP), + Res = merge_paths(B, R), + list_to_binary(Res). + + +do_merge_paths([$/|_] = L, RelP) -> + lists:reverse(L) ++ RelP; +do_merge_paths([_|T], RelP) -> + do_merge_paths(T, RelP). + + +resolve_query(Query, RelURI, Map) -> + case maps:is_key(query, RelURI) of + true -> + Map#{query => maps:get(query, RelURI)}; + false -> + Map#{query => Query} + end. + + +maybe_to_integer(Port) when is_list(Port) -> + {Port1, _} = string:to_integer(Port), + Port1; +maybe_to_integer(Port) when is_integer(Port) -> Port. -%%% Guessing that we received a relative URI, fix it to become an absoluteURI -fix_relative_uri(Request, RedirUrl) -> - {Server, Port0} = Request#request.address, - Port = maybe_to_list(Port0), - Path = Request#request.path, - atom_to_list(Request#request.scheme) ++ "://" ++ Server ++ ":" ++ Port - ++ Path ++ RedirUrl. - + error(#request{id = Id}, Reason) -> {Id, {error, Reason}}. @@ -444,18 +593,3 @@ format_response({StatusLine, Headers, Body}) -> {Body, <<>>} end, {{StatusLine, http_response:header_list(Headers), NewBody}, Data}. - -%%-------------------------------------------------------------------------- -%% These functions is just simple wrappers to parse specifically HTTP URIs -%%-------------------------------------------------------------------------- - -scheme_defaults() -> - [{http, 80}, {https, 443}]. - -uri_parse(URI, Opts) -> - http_uri:parse(URI, [{scheme_defaults, scheme_defaults()} | Opts]). - - -%%-------------------------------------------------------------------------- - - diff --git a/lib/inets/src/http_lib/http_util.erl b/lib/inets/src/http_lib/http_util.erl index 487d04f7aa..5577b00cc8 100644 --- a/lib/inets/src/http_lib/http_util.erl +++ b/lib/inets/src/http_lib/http_util.erl @@ -27,7 +27,8 @@ convert_month/1, is_hostname/1, timestamp/0, timeout/2, - html_encode/1 + html_encode/1, + maybe_add_brackets/2 ]). @@ -194,6 +195,24 @@ html_encode(Chars) -> lists:append([char_to_html_entity(Char, Reserved) || Char <- Chars]). +maybe_add_brackets(Addr, false) -> + Addr; +maybe_add_brackets(Addr, true) when is_list(Addr) -> + case is_ipv6_address(Addr) of + true -> + [$[|Addr] ++ "]"; + false -> + Addr + end; +maybe_add_brackets(Addr, true) when is_binary(Addr) -> + case is_ipv6_address(Addr) of + true -> + <<$[,Addr/binary,$]>>; + false -> + Addr + end. + + %%%======================================================================== %%% Internal functions %%%======================================================================== @@ -205,3 +224,14 @@ char_to_html_entity(Char, Reserved) -> false -> [Char] end. + +is_ipv6_address(Addr) when is_binary(Addr) -> + B = binary_to_list(Addr), + is_ipv6_address(B); +is_ipv6_address(Addr) when is_list(Addr) -> + case inet:parse_ipv6strict_address(Addr) of + {ok, _ } -> + true; + {error, _} -> + false + end. diff --git a/lib/inets/src/http_server/httpd_script_env.erl b/lib/inets/src/http_server/httpd_script_env.erl index 055f08fdb0..d7c92c59ef 100644 --- a/lib/inets/src/http_server/httpd_script_env.erl +++ b/lib/inets/src/http_server/httpd_script_env.erl @@ -166,9 +166,9 @@ create_script_elements(cgi, path_info, PathInfo, ModData) -> [{"PATH_INFO", PathInfo}, {"PATH_TRANSLATED", PathTranslated}]; create_script_elements(esi, entity_body, Body, _) -> - [{content_length, httpd_util:flatlength(Body)}]; + [{content_length, integer_to_list(httpd_util:flatlength(Body))}]; create_script_elements(cgi, entity_body, Body, _) -> - [{"CONTENT_LENGTH", httpd_util:flatlength(Body)}]; + [{"CONTENT_LENGTH", integer_to_list(httpd_util:flatlength(Body))}]; create_script_elements(_, _, _, _) -> []. diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index e6dcd2285f..1e912e7640 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -42,7 +42,8 @@ %% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- suite() -> - [{ct_hooks,[ts_install_cth]} + [{ct_hooks,[ts_install_cth]}, + {timetrap,{seconds, 30}} ]. all() -> @@ -57,7 +58,10 @@ all() -> groups() -> [ {http, [], real_requests()}, - {sim_http, [], only_simulated()}, + %% process_leak_on_keepalive is depending on stream_fun_server_close + %% and it shall be the last test case in the suite otherwise cookie + %% will fail. + {sim_http, [], only_simulated() ++ [process_leak_on_keepalive]}, {https, [], real_requests()}, {sim_https, [], only_simulated()}, {misc, [], misc()} @@ -67,6 +71,7 @@ real_requests()-> [ head, get, + get_query_string, post, delete, post_stream, @@ -114,10 +119,10 @@ only_simulated() -> invalid_chunk_size, headers_dummy, headers_with_obs_fold, + headers_conflict_chunked_with_length, empty_response_header, remote_socket_close, remote_socket_close_async, - process_leak_on_keepalive, transfer_encoding, transfer_encoding_identity, redirect_loop, @@ -126,10 +131,13 @@ only_simulated() -> redirect_found, redirect_see_other, redirect_temporary_redirect, + redirect_relative_uri, port_in_host_header, redirect_port_in_host_header, relaxed, - multipart_chunks + multipart_chunks, + get_space, + stream_fun_server_close ]. misc() -> @@ -142,7 +150,6 @@ misc() -> %%-------------------------------------------------------------------- init_per_suite(Config) -> - ct:timetrap({seconds, 30}), PrivDir = proplists:get_value(priv_dir, Config), DataDir = proplists:get_value(data_dir, Config), inets_test_lib:start_apps([inets]), @@ -169,7 +176,6 @@ init_per_group(Group, Config0) when Group =:= sim_https; Group =:= https-> catch crypto:stop(), try crypto:start() of ok -> - ct:timetrap({seconds, 30}), start_apps(Group), do_init_per_group(Group, Config0) catch @@ -243,6 +249,25 @@ get(Config) when is_list(Config) -> {ok, {{_,200,_}, [_ | _], BinBody}} = httpc:request(get, Request, [], [{body_format, binary}]), true = is_binary(BinBody). + + +get_query_string() -> + [{doc, "Test http get request with query string against local server"}]. +get_query_string(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/dummy.html?foo=bar", Config), []}, + {ok, {{_,200,_}, [_ | _], Body = [_ | _]}} = httpc:request(get, Request, [], []), + + inets_test_lib:check_body(Body). + +%%-------------------------------------------------------------------- +get_space() -> + [{"Test http get request with '%20' in the path of the URL."}]. +get_space(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/space%20.html", Config), []}, + {ok, {{_,200,_}, [_ | _], Body = [_ | _]}} = httpc:request(get, Request, [], []), + + inets_test_lib:check_body(Body). + %%-------------------------------------------------------------------- post() -> [{"Test http post request against local server. We do in this case " @@ -576,7 +601,26 @@ redirect_temporary_redirect(Config) when is_list(Config) -> {ok, {{_,200,_}, [_ | _], [_|_]}} = httpc:request(post, {URL307, [],"text/plain", "foobar"}, [], []). +%%------------------------------------------------------------------------- +redirect_relative_uri() -> + [{doc, "The server SHOULD generate a Location header field in the response " + "containing a preferred URI reference for the new permanent URI. The user " + "agent MAY use the Location field value for automatic redirection. The server's " + "response payload usually contains a short hypertext note with a " + "hyperlink to the new URI(s)."}]. +redirect_relative_uri(Config) when is_list(Config) -> + + URL301 = url(group_name(Config), "/301_rel_uri.html", Config), + + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, {URL301, []}, [], []), + + {ok, {{_,200,_}, [_ | _], []}} + = httpc:request(head, {URL301, []}, [], []), + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(post, {URL301, [],"text/plain", "foobar"}, + [], []). %%------------------------------------------------------------------------- redirect_loop() -> [{"doc, Test redirect loop detection"}]. @@ -746,7 +790,7 @@ empty_body() -> empty_body(Config) when is_list(Config) -> URL = url(group_name(Config), "/empty.html", Config), {ok, {{_,200,_}, [_ | _], []}} = - httpc:request(get, {URL, []}, [{timeout, 500}], []). + httpc:request(get, {URL, []}, [], []). %%------------------------------------------------------------------------- @@ -978,7 +1022,6 @@ headers_dummy(Config) when is_list(Config) -> {"If-Range", "Sat, 29 Oct 1994 19:43:31 GMT"}, {"If-Match", "*"}, {"Content-Type", "text/plain"}, - {"Content-Encoding", "chunked"}, {"Content-Length", "6"}, {"Content-Language", "en"}, {"Content-Location", "http://www.foobar.se"}, @@ -1004,6 +1047,18 @@ headers_with_obs_fold(Config) when is_list(Config) -> %%------------------------------------------------------------------------- +headers_conflict_chunked_with_length(doc) -> + ["Test the code for handling headers with both Transfer-Encoding" + "and Content-Length which must receive error in default (not relaxed) mode" + "and must receive successful response in relaxed mode"]; +headers_conflict_chunked_with_length(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/headers_conflict_chunked_with_length.html", Config), []}, + {error, {could_not_parse_as_http, _}} = httpc:request(get, Request, [{relaxed, false}], []), + {ok,{{_,200,_},_,_}} = httpc:request(get, Request, [{relaxed, true}], []), + ok. + +%%------------------------------------------------------------------------- + invalid_headers(Config) -> Request = {url(group_name(Config), "/dummy.html", Config), [{"cookie", undefined}]}, {error, _} = httpc:request(get, Request, [], []). @@ -1043,8 +1098,6 @@ remote_socket_close_async(Config) when is_list(Config) -> %%------------------------------------------------------------------------- process_leak_on_keepalive(Config) -> - {ok, ClosedSocket} = gen_tcp:listen(6666, [{active, false}]), - ok = gen_tcp:close(ClosedSocket), Request = {url(group_name(Config), "/dummy.html", Config), []}, HttpcHandlers0 = supervisor:which_children(httpc_handler_sup), {ok, {{_, 200, _}, _, Body}} = httpc:request(get, Request, [], []), @@ -1056,11 +1109,10 @@ process_leak_on_keepalive(Config) -> ordsets:to_list( ordsets:subtract(ordsets:from_list(HttpcHandlers1), ordsets:from_list(HttpcHandlers0))), - sys:replace_state( - Pid, fun (State) -> - Session = element(3, State), - setelement(3, State, Session#session{socket=ClosedSocket}) - end), + State = sys:get_state(Pid), + #session{socket=Socket} = element(3, State), + gen_tcp:close(Socket), + {ok, {{_, 200, _}, _, Body}} = httpc:request(get, Request, [], []), %% bad handler with the closed socket should get replaced by %% the new one, so children count should stay the same @@ -1179,6 +1231,22 @@ wait_for_whole_response(Config) when is_list(Config) -> ReqSeqNumServer ! shutdown. %%-------------------------------------------------------------------- +stream_fun_server_close() -> + [{doc, "Test that an error msg is received when using a receiver fun as stream target"}]. +stream_fun_server_close(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/delay_close.html", Config), []}, + Self = self(), + Fun = fun(X) -> Self ! X end, + {ok, RequestId} = httpc:request(get, Request, [], [{sync, false}, {receiver, Fun}]), + receive + {RequestId, {error, Reason}} -> + ct:pal("Close ~p", [Reason]), + ok + after 13000 -> + ct:fail(did_not_receive_close) + end. + +%%-------------------------------------------------------------------- %% Internal Functions ------------------------------------------------ %%-------------------------------------------------------------------- stream(ReceiverPid, Receiver, Config) -> @@ -1685,6 +1753,15 @@ content_length(["content-length:" ++ Value | _]) -> content_length([_Head | Tail]) -> content_length(Tail). +handle_uri("GET","/dummy.html?foo=bar",_,_,_,_) -> + "HTTP/1.0 200 OK\r\n\r\nTEST"; + +handle_uri("GET","/space%20.html",_,_,_,_) -> + Body = "<HTML><BODY>foobar</BODY></HTML>", + "HTTP/1.1 200 OK\r\n" ++ + "Content-Length:" ++ integer_to_list(length(Body)) ++ "\r\n\r\n" ++ + Body; + handle_uri(_,"/just_close.html",_,_,_,_) -> close; handle_uri(_,"/no_content.html",_,_,_,_) -> @@ -1750,6 +1827,23 @@ handle_uri(_,"/301.html",Port,_,Socket,_) -> "Content-Length:" ++ integer_to_list(length(Body)) ++ "\r\n\r\n" ++ Body; + +handle_uri("HEAD","/301_rel_uri.html",_,_,_,_) -> + NewUri = "/dummy.html", + "HTTP/1.1 301 Moved Permanently\r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:0\r\n\r\n"; + +handle_uri(_,"/301_rel_uri.html",_,_,_,_) -> + NewUri = "/dummy.html", + Body = "<HTML><BODY><a href=" ++ NewUri ++ + ">New place</a></BODY></HTML>", + "HTTP/1.1 301 Moved Permanently\r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:" ++ integer_to_list(length(Body)) + ++ "\r\n\r\n" ++ Body; + + handle_uri("HEAD","/302.html",Port,_,Socket,_) -> NewUri = url_start(Socket) ++ integer_to_list(Port) ++ "/dummy.html", @@ -1853,7 +1947,6 @@ handle_uri(_,"/dummy_headers.html",_,_,Socket,_) -> %% user to evaluate. This is not a valid response %% it only tests that the header handling code works. Head = "HTTP/1.1 200 ok\r\n" ++ - "Content-Length:32\r\n" ++ "Pragma:1#no-cache\r\n" ++ "Via:1.0 fred, 1.1 nowhere.com (Apache/1.1)\r\n" ++ "Warning:1#pseudonym foobar\r\n" ++ @@ -1883,6 +1976,15 @@ handle_uri(_,"/obs_folded_headers.html",_,_,_,_) -> " b\r\n\r\n" "Hello"; +handle_uri(_,"/headers_conflict_chunked_with_length.html",_,_,Socket,_) -> + Head = "HTTP/1.1 200 ok\r\n" + "Content-Length:32\r\n" + "Transfer-Encoding:Chunked\r\n\r\n", + send(Socket, Head), + send(Socket, http_chunk:encode("<HTML><BODY>fo")), + send(Socket, http_chunk:encode("obar</BODY></HTML>")), + http_chunk:encode_last(); + handle_uri(_,"/capital_transfer_encoding.html",_,_,Socket,_) -> Head = "HTTP/1.1 200 ok\r\n" ++ "Transfer-Encoding:Chunked\r\n\r\n", @@ -2030,6 +2132,9 @@ handle_uri(_,"/multipart_chunks.html",_,_,Socket,_) -> send(Socket, Head), send_multipart_chunks(Socket), http_chunk:encode_last(); +handle_uri(_,"/delay_close.html",_,_,Socket,_) -> + ct:sleep(10000), + close(Socket); handle_uri("HEAD",_,_,_,_,_) -> "HTTP/1.1 200 ok\r\n" ++ "Content-Length:0\r\n\r\n"; diff --git a/lib/inets/test/httpd_basic_SUITE.erl b/lib/inets/test/httpd_basic_SUITE.erl index 931cd076cc..94d22ea76c 100644 --- a/lib/inets/test/httpd_basic_SUITE.erl +++ b/lib/inets/test/httpd_basic_SUITE.erl @@ -303,7 +303,10 @@ escaped_url_in_error_body(Config) when is_list(Config) -> %% Ask for a non-existing page(1) Path = "/<b>this_is_bold<b>", HTMLEncodedPath = http_util:html_encode(Path), - URL2 = URL1 ++ Path, + URL2 = uri_string:recompose(#{scheme => "http", + host => "localhost", + port => Port, + path => Path}), {ok, {404, Body3}} = httpc:request(get, {URL2, []}, [{url_encode, true}, {version, "HTTP/1.0"}], diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index 560d524bac..05cf4f6cc3 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 6.4.4 +INETS_VSN = 6.4.5 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/jinterface/doc/src/Makefile b/lib/jinterface/doc/src/Makefile index 508c8e01b5..37de0a35c5 100644 --- a/lib/jinterface/doc/src/Makefile +++ b/lib/jinterface/doc/src/Makefile @@ -3,7 +3,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2000-2016. All Rights Reserved. +# Copyright Ericsson AB 2000-2017. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -43,25 +43,17 @@ XML_APP_FILES = ref_man.xml XML_REF3_FILES = jinterface.xml XML_PART_FILES = \ - part.xml \ - part_notes.xml \ - part_notes_history.xml - + part.xml XML_CHAPTER_FILES = \ notes.xml \ - notes_history.xml \ jinterface_users_guide.xml BOOK_FILES = book.xml -XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \ - $(XML_PART_FILES) $(XML_CHAPTER_FILES) - -GIF_FILES = \ - notes.gif \ - ref_man.gif \ - user_guide.gif +XML_FILES = $(BOOK_FILES) $(XML_APP_FILES) $(XML_REF3_FILES) \ + $(XML_PART_FILES) $(XML_CHAPTER_FILES) +GIF_FILES = #------------------------------------------------------ @@ -92,7 +84,7 @@ JAVA_DOC_FILES = \ serialized-form.html \ package-list \ stylesheet.css \ - help-doc.html + help-doc.html INFO_FILE = ../../info JAVA_EXTRA_FILES = $(JAVA_DOC_FILES:%=$(HTMLDIR)/java/%) @@ -110,17 +102,16 @@ JAVA_GEN_FILES = \ HTML_FILES = \ $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) -TOP_HTML_FILES = $(INDEX_TARGET) +TOP_HTML_FILES = $(INDEX_TARGET) INDEX_FILE = index.html -INDEX_SRC = $(INDEX_FILE).src INDEX_TARGET = $(DOCDIR)/$(INDEX_FILE) # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += +XML_FLAGS += +DVIPS_FLAGS += # ---------------------------------------------------- # Targets @@ -146,18 +137,15 @@ jdoc:$(JAVA_SRC_FILES) (cd ../../java_src;$(JAVADOC) -sourcepath . -d $(JAVADOC_DEST) \ -windowtitle $(JAVADOC_TITLE) $(JAVADOC_PKGS)) -man: +man: gifs: $(GIF_FILES:%=$(HTMLDIR)/%) -#$(INDEX_TARGET): $(INDEX_SRC) ../../vsn.mk -# sed -e 's;%VSN%;$(VSN);' $< > $@ - -debug opt: +debug opt: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs diff --git a/lib/jinterface/doc/src/fascicules.xml b/lib/jinterface/doc/src/fascicules.xml deleted file mode 100644 index 4f04be0515..0000000000 --- a/lib/jinterface/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="yes"> - User Guide - </fascicule> - <fascicule file="" href="java/index.html" entry="no"> - Java API - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/jinterface/doc/src/index.html.src b/lib/jinterface/doc/src/index.html.src deleted file mode 100644 index 9276c5f89a..0000000000 --- a/lib/jinterface/doc/src/index.html.src +++ /dev/null @@ -1,99 +0,0 @@ -<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"> -<!-- This file is obsolete --> -<HTML> -<!-- - %CopyrightBegin% - - Copyright Ericsson AB 2000-2016. All Rights Reserved. - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - %CopyrightEnd% ---> -<HEAD> -<TITLE>Jinterface %VSN%</TITLE> -</HEAD> - -<BODY BGCOLOR="#FFFFFF"> - -<CENTER> -<A HREF="http://www.erlang.se/"><IMG ALT="Erlang/OTP" BORDER=0 SRC="html/min_head.gif"></A><BR> - -<FONT SIZE="-1"> -[<A HREF="../../../doc/index.html">Up</A> | -<A HREF="http://www.erlang.se/">Erlang/OTP</A>] -</FONT><BR> - -<P><FONT SIZE="+3">Jinterface </FONT><BR> -Version %VSN% -</CENTER> - -<P><TABLE> -<TR> -<TD> -</TD> - -<TD> -<STRONG>Jinterface</STRONG> contains functions, -which help you integrate programs written in Java and Erlang. -</TD> -</TR> -</TABLE> - -<P><CENTER> -<TABLE CELLPADDING=15> -<TR> - - -<TD ALIGN=CENTER> -<A HREF="html/part_frame.html"> -<IMG ALT="User Guide" BORDER=0 SRC="html/user_guide.gif"></A><BR> -<FONT SIZE="-1"> -<A HREF="html/part_frame.html">User Guide</A> -</FONT> -</TD> - - -<TD ALIGN=CENTER> -<A HREF="html/index.html"><IMG ALT="Java API" BORDER=0 SRC="html/ref_man.gif"></A><BR> -<FONT SIZE="-1"> -<A HREF="html/index.html">Java API</A> -</FONT> -</TD> - - - -<TD ALIGN=CENTER> -<A HREF="html/part_notes_frame.html"><IMG ALT="Release Notes" BORDER=0 SRC="html/notes.gif"></A><BR> -<FONT SIZE="-1"> -<A HREF="html/part_notes_frame.html">Release Notes</A> -</FONT> -</TD> - -</TR> -</TABLE> -</CENTER> - -<P><CENTER> -<HR> -<FONT SIZE="-1"> -Copyright © 1991-2001 -<A HREF="http://www.erlang.se/">Ericsson Utvecklings AB</A> -</FONT> -</CENTER> -</BODY> -</HTML> - - - - diff --git a/lib/jinterface/doc/src/notes.gif b/lib/jinterface/doc/src/notes.gif Binary files differdeleted file mode 100644 index e000cca26a..0000000000 --- a/lib/jinterface/doc/src/notes.gif +++ /dev/null diff --git a/lib/jinterface/doc/src/notes.xml b/lib/jinterface/doc/src/notes.xml index b44a04d7cd..346d467c2d 100644 --- a/lib/jinterface/doc/src/notes.xml +++ b/lib/jinterface/doc/src/notes.xml @@ -31,6 +31,21 @@ </header> <p>This document describes the changes made to the Jinterface application.</p> +<section><title>Jinterface 1.8.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Removed all old unused files in the documentation. + </p> + <p> + Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p> + </item> + </list> + </section> + +</section> + <section><title>Jinterface 1.8</title> <section><title>Improvements and New Features</title> diff --git a/lib/jinterface/doc/src/part_notes.xml b/lib/jinterface/doc/src/part_notes.xml deleted file mode 100644 index de6dd7d162..0000000000 --- a/lib/jinterface/doc/src/part_notes.xml +++ /dev/null @@ -1,39 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2000</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>Jinterface Release Notes</title> - <prepared>Gordon Beaton</prepared> - <docno></docno> - <date>1999-10-25</date> - <rev>A</rev> - </header> - <description> - <p>The <em>Jinterface</em> application is a Java-Erlang - communication tool package.</p> - <p>For information about older versions, see - <url href="part_notes_history_frame.html">Release Notes History</url>.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/jinterface/doc/src/part_notes_history.xml b/lib/jinterface/doc/src/part_notes_history.xml deleted file mode 100644 index 94bb996db5..0000000000 --- a/lib/jinterface/doc/src/part_notes_history.xml +++ /dev/null @@ -1,37 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part> - <header> - <copyright> - <year>2006</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>Jinterface Release Notes History</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p>The <em>Jinterface</em> application is a Java-Erlang - communication tool package.</p> - </description> - <include file="notes_history"></include> -</part> - diff --git a/lib/jinterface/doc/src/ref_man.gif b/lib/jinterface/doc/src/ref_man.gif Binary files differdeleted file mode 100644 index b13c4efd53..0000000000 --- a/lib/jinterface/doc/src/ref_man.gif +++ /dev/null diff --git a/lib/jinterface/doc/src/summary.html.src b/lib/jinterface/doc/src/summary.html.src deleted file mode 100644 index beb3305d58..0000000000 --- a/lib/jinterface/doc/src/summary.html.src +++ /dev/null @@ -1 +0,0 @@ -Low level interface to Java.
\ No newline at end of file diff --git a/lib/jinterface/doc/src/user_guide.gif b/lib/jinterface/doc/src/user_guide.gif Binary files differdeleted file mode 100644 index e6275a803d..0000000000 --- a/lib/jinterface/doc/src/user_guide.gif +++ /dev/null diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/Makefile b/lib/jinterface/java_src/com/ericsson/otp/erlang/Makefile index e55cfa62ea..001acfdd2e 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/Makefile +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/Makefile @@ -130,7 +130,6 @@ release_spec: opt release_docs_spec: - - +xmllint: # ---------------------------------------------------- diff --git a/lib/jinterface/test/jinterface_SUITE.erl b/lib/jinterface/test/jinterface_SUITE.erl index 73851f47e0..8c6a6368a9 100644 --- a/lib/jinterface/test/jinterface_SUITE.erl +++ b/lib/jinterface/test/jinterface_SUITE.erl @@ -176,11 +176,29 @@ init_per_suite(Config) when is_list(Config) -> {error,bad_name} -> false; P -> filelib:is_dir(P) end of true -> - jitu:init_all(Config); + case hostname_resolves() of + true -> + jitu:init_all(Config); + Skip -> + Skip + end; false -> {skip,"No jinterface application"} end. +%% Check if inet:gethostname() can be resolved by +%% the native resolver. If it can, we know that +%% jinterface name resolution works. If it cannot +%% jinterface tests will fail. +hostname_resolves() -> + {ok, HN} = inet:gethostname(), + case inet_gethost_native:gethostbyname(HN) of + {ok, _} -> + true; + _ -> + {skip, "Cannot resolve short hostname, add " ++ HN ++ " to /etc/hosts"} + end. + end_per_suite(Config) when is_list(Config) -> jitu:finish_all(Config). diff --git a/lib/jinterface/test/nc_SUITE.erl b/lib/jinterface/test/nc_SUITE.erl index 81944f71d4..daa17195ee 100644 --- a/lib/jinterface/test/nc_SUITE.erl +++ b/lib/jinterface/test/nc_SUITE.erl @@ -651,11 +651,10 @@ do_echo(DataList, Config, OutTrans, InTrans, ExtraArgs) echo_loop([D|Ds], Echoer, OutTrans, InTrans, TermAcc) -> OutMsg = OutTrans(D), Echoer ! OutMsg, - io:format("echo_server ~p: ~p ! ~P~n", [self(),Echoer,OutMsg,10]), + %%io:format("echo_server ~p: ~p ! ~P~n", [self(),Echoer,OutMsg,10]), receive Reply -> - io:format("echo_server ~p: receive ~P~n", - [self(),Reply,10]), + %%io:format("echo_server ~p: receive ~P~n", [self(),Reply,10]), InTrans(Echoer, D, Reply) end, Term = case OutMsg of @@ -670,11 +669,10 @@ echo_loop(Cont, Echoer, OutTrans, InTrans, TermAcc) when is_function(Cont, 0) -> check_terms(Echoer, TermAcc), OutMsg = Echoer ! {self(),undefined,hash_clear}, - io:format("echo_server ~p: ~p ! ~P~n", [self(),Echoer,OutMsg,10]), + %%io:format("echo_server ~p: ~p ! ~P~n", [self(),Echoer,OutMsg,10]), receive {Echoer,hash_cleared,hash_clear}=Reply -> - io:format("echo_server ~p: receive ~P~n", - [self(),Reply,10]), + %%io:format("echo_server ~p: receive ~P~n", [self(),Reply,10]), ok; Other -> io:format("echo_server_terms unexpected ~p: receive ~P~n", @@ -686,11 +684,10 @@ echo_loop(Cont, Echoer, OutTrans, InTrans, TermAcc) check_terms(Echoer, [Term | Rest]) -> OutMsg = {self(),Term,hash_lookup}, Echoer ! OutMsg, - io:format("check_terms ~p: ~p ! ~P~n", [self(),Echoer,OutMsg,10]), + %%io:format("check_terms ~p: ~p ! ~P~n", [self(),Echoer,OutMsg,10]), receive {Echoer,true,hash_lookup} = ReplyMsg -> - io:format("check_terms ~p: receive ~P~n", - [self(),ReplyMsg,10]), + %%io:format("check_terms ~p: receive ~P~n", [self(),ReplyMsg,10]), check_terms(Echoer, Rest); Other -> io:format("check_terms unexpected ~p: receive ~P~n", diff --git a/lib/jinterface/vsn.mk b/lib/jinterface/vsn.mk index 373e2dab22..0a8a1190ec 100644 --- a/lib/jinterface/vsn.mk +++ b/lib/jinterface/vsn.mk @@ -1 +1 @@ -JINTERFACE_VSN = 1.8 +JINTERFACE_VSN = 1.8.1 diff --git a/lib/kernel/doc/src/Makefile b/lib/kernel/doc/src/Makefile index 8976a3b800..0759f362d4 100644 --- a/lib/kernel/doc/src/Makefile +++ b/lib/kernel/doc/src/Makefile @@ -70,8 +70,8 @@ XML_REF4_FILES = app.xml config.xml XML_REF6_FILES = kernel_app.xml -XML_PART_FILES = part_notes.xml part_notes_history.xml -XML_CHAPTER_FILES = notes.xml notes_history.xml +XML_PART_FILES = +XML_CHAPTER_FILES = notes.xml BOOK_FILES = book.xml @@ -100,9 +100,9 @@ SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml) TOP_SPECS_FILE = specs.xml # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += +XML_FLAGS += SPECS_ESRC = ../../src @@ -125,7 +125,7 @@ html: gifs $(HTML_REF_MAN_FILE) man: $(MAN3_FILES) $(MAN4_FILES) $(MAN6_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) -debug opt: +debug opt: clean clean_docs: rm -rf $(HTMLDIR)/* @@ -134,7 +134,7 @@ clean clean_docs: rm -f $(MAN6DIR)/* rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f $(SPECDIR)/* - rm -f errs core *~ + rm -f errs core *~ $(SPECDIR)/specs_erl_prim_loader_stub.xml: escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \ @@ -151,7 +151,7 @@ $(SPECDIR)/specs_zlib_stub.xml: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs @@ -169,4 +169,3 @@ release_docs_spec: docs $(INSTALL_DATA) $(MAN6_FILES) "$(RELEASE_PATH)/man/man6" release_spec: - diff --git a/lib/kernel/doc/src/fascicules.xml b/lib/kernel/doc/src/fascicules.xml deleted file mode 100644 index fadd37eefb..0000000000 --- a/lib/kernel/doc/src/fascicules.xml +++ /dev/null @@ -1,15 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/kernel/doc/src/file.xml b/lib/kernel/doc/src/file.xml index b674b3ca93..58abb35428 100644 --- a/lib/kernel/doc/src/file.xml +++ b/lib/kernel/doc/src/file.xml @@ -33,15 +33,18 @@ <description> <p>This module provides an interface to the file system.</p> - <p>On operating systems with thread support, - file operations can be performed in threads of their own, allowing - other Erlang processes to continue executing in parallel with - the file operations. See command-line flag - <c>+A</c> in <seealso marker="erts:erl"><c>erl(1)</c></seealso>.</p> + <warning> + <p>File operations are only guaranteed to appear atomic when going + through the same file server. A NIF or other OS process may observe + intermediate steps on certain operations on some operating systems, + eg. renaming an existing file on Windows, or + <seealso marker="#write_file_info/2"><c>write_file_info/2</c> + </seealso> on any OS at the time of writing.</p> + </warning> <p>Regarding filename encoding, the Erlang VM can operate in two modes. The current mode can be queried using function - <seealso marker="#native_name_encoding"><c>native_name_encoding/0</c></seealso>. + <seealso marker="#native_name_encoding/0"><c>native_name_encoding/0</c></seealso>. It returns <c>latin1</c> or <c>utf8</c>.</p> <p>In <c>latin1</c> mode, the Erlang VM does not change the @@ -59,7 +62,7 @@ terminal supports UTF-8, otherwise <c>latin1</c>. The default can be overridden using <c>+fnl</c> (to force <c>latin1</c> mode) or <c>+fnu</c> (to force <c>utf8</c> mode) when starting - <seealso marker="erts:erl"><c>erts:erl</c></seealso>.</p> + <seealso marker="erts:erl"><c>erl</c></seealso>.</p> <p>On operating systems with transparent naming, files can be inconsistently named, for example, some files are encoded in UTF-8 while @@ -81,6 +84,23 @@ <p>See also section <seealso marker="stdlib:unicode_usage#notes-about-raw-filenames">Notes About Raw Filenames</seealso> in the STDLIB User's Guide.</p> + <note><p> + File operations used to accept filenames containing + null characters (integer value zero). This caused + the name to be truncated and in some cases arguments + to primitive operations to be mixed up. Filenames + containing null characters inside the filename + are now <em>rejected</em> and will cause primitive + file operations fail. + </p></note> + <warning><p> + Currently null characters at the end of the filename + will be accepted by primitive file operations. Such + filenames are however still documented as invalid. The + implementation will also change in the future and + reject such filenames. + </p></warning> + </description> <datatypes> @@ -96,9 +116,21 @@ </datatype> <datatype> <name name="filename"/> + <desc> + <p> + See also the documentation of the + <seealso marker="#type-name_all"><c>name_all()</c></seealso> type. + </p> + </desc> </datatype> <datatype> <name name="filename_all"/> + <desc> + <p> + See also the documentation of the + <seealso marker="#type-name_all"><c>name_all()</c></seealso> type. + </p> + </desc> </datatype> <datatype> <name name="io_device"/> @@ -112,21 +144,23 @@ <name name="name"/> <desc> <p>If VM is in Unicode filename mode, <c>string()</c> and <c>char()</c> - are allowed to be > 255. + are allowed to be > 255. See also the documentation of the + <seealso marker="#type-name_all"><c>name_all()</c></seealso> type. </p> </desc> </datatype> <datatype> <name name="name_all"/> <desc> - <p>If VM is in Unicode filename mode, <c>string()</c> and <c>char()</c> + <p>If VM is in Unicode filename mode, characters are allowed to be > 255. <c><anno>RawFilename</anno></c> is a filename not subject to Unicode translation, meaning that it can contain characters not conforming to the Unicode encoding expected from the file system (that is, non-UTF-8 characters although the VM is started - in Unicode filename mode). + in Unicode filename mode). Null characters (integer value zero) + are <em>not</em> allowed in filenames (not even at the end). </p> </desc> </datatype> @@ -1407,8 +1441,12 @@ f.txt: {person, "kalle", 25}. which is 1970-01-01 00:00 UTC.</p></item> </taglist> <p>Default is <c>{time, local}</c>.</p> - <p>If the option <c>raw</c> is set, the file server is not called - and only information about local files is returned.</p> + <p>If the option <c>raw</c> is set, the file server is not called and + only information about local files is returned. Note that this will + break this module's atomicity guarantees as it can race with a + concurrent call to + <seealso marker="#write_file_info/2"><c>write_file_info/1,2</c> + </seealso></p> <note> <p>As file times are stored in POSIX time on most OS, it is faster to query file information with option <c>posix</c>.</p> @@ -1656,8 +1694,12 @@ f.txt: {person, "kalle", 25}. except that if <c><anno>Name</anno></c> is a symbolic link, information about the link is returned in the <c>file_info</c> record and the <c>type</c> field of the record is set to <c>symlink</c>.</p> - <p>If the option <c>raw</c> is set, the file server is not called - and only information about local files is returned.</p> + <p>If the option <c>raw</c> is set, the file server is not called and + only information about local files is returned. Note that this will + break this module's atomicity guarantees as it can race with a + concurrent call to + <seealso marker="#write_file_info/2"><c>write_file_info/1,2</c> + </seealso></p> <p>If <c><anno>Name</anno></c> is not a symbolic link, this function returns the same result as <c>read_file_info/1</c>. On platforms that do not support symbolic links, this function @@ -1795,24 +1837,16 @@ f.txt: {person, "kalle", 25}. <p>The file used must be opened using the <c>raw</c> flag, and the process calling <c>sendfile</c> must be the controlling process of the socket. See <seealso marker="gen_tcp#controlling_process-2"><c>gen_tcp:controlling_process/2</c></seealso>.</p> - <p>If the OS used does not support <c>sendfile</c>, an Erlang fallback - using - <seealso marker="#read/2"><c>read/2</c></seealso> and - <seealso marker="gen_tcp#send/2"><c>gen_tcp:send/2</c></seealso> is used.</p> + <p>If the OS used does not support non-blocking <c>sendfile</c>, an + Erlang fallback using <seealso marker="#read/2"><c>read/2</c></seealso> + and <seealso marker="gen_tcp#send/2"><c>gen_tcp:send/2</c></seealso> is + used.</p> <p>The option list can contain the following options:</p> <taglist> <tag><c>chunk_size</c></tag> <item><p>The chunk size used by the Erlang fallback to send data. If using the fallback, set this to a value that comfortably fits in the systems memory. Default is 20 MB.</p></item> - <tag><c>use_threads</c></tag> - <item><p>Instructs the emulator to use the <c>async</c> thread pool for the - <c>sendfile</c> system call. This can be useful if the OS you are running - on does not properly support non-blocking <c>sendfile</c> calls. Notice that - using <c>async</c> threads potentially makes your system vulnerable to slow - client attacks. If set to <c>true</c> and no <c>async</c> threads are available, - the <c>sendfile</c> call returns <c>{error,einval}</c>. - Introduced in Erlang/OTP 17.0. Default is <c>false</c>.</p></item> </taglist> </desc> </func> @@ -1825,7 +1859,7 @@ f.txt: {person, "kalle", 25}. <p>The functions in the module <c>file</c> usually treat binaries as raw filenames, that is, they are passed "as is" even when the encoding of the binary does not agree with - <seealso marker="#native_name_encoding"><c>native_name_encoding()</c></seealso>. + <seealso marker="#native_name_encoding/0"><c>native_name_encoding()</c></seealso>. However, this function expects binaries to be encoded according to the value returned by <c>native_name_encoding()</c>.</p> <p>Typical error reasons are:</p> @@ -2117,144 +2151,77 @@ f.txt: {person, "kalle", 25}. <section> <title>Performance</title> - <p>Some operating system file operations, for example, a - <c>sync/1</c> or <c>close/1</c> on a huge file, can block their - calling thread for seconds. If this affects the emulator main - thread, the response time is no longer in the order of - milliseconds, depending on the definition of "soft" in soft - real-time system.</p> - <p>If the device driver thread pool is active, file operations are - done through those threads instead, so the emulator can go on - executing Erlang processes. Unfortunately, the time for serving a - file operation increases because of the extra scheduling required - from the operating system.</p> - <p>If the device driver thread pool is disabled or of size 0, large - file reads and writes are segmented into many smaller, which - enable the emulator to serve other processes during the file - operation. This has the same effect as when using the thread - pool, but with larger overhead. Other file operations, for - example, <c>sync/1</c> or <c>close/1</c> on a huge file, still are - a problem.</p> - <p>For increased performance, raw files are recommended. Raw files - use the file system of the host machine of the node.</p> + <p>For increased performance, raw files are recommended.</p> + <p>A normal file is really a process so it can be used as an I/O + device (see <seealso marker="stdlib:io"><c>io</c></seealso>). + Therefore, when data is written to a normal file, the sending of the + data to the file process, copies all data that are not binaries. Opening + the file in binary mode and writing binaries is therefore recommended. + If the file is opened on another node, or if the file server runs as + slave to the file server of another node, also binaries are copied.</p> <note> - <p> - For normal files (non-raw), the file server is used to find the files, - and if the node is running its file server as slave to the file server - of another node, and the other node runs on some other host machine, - they can have different file systems. - However, this is seldom a problem.</p> + <p>Raw files use the file system of the host machine of the node. + For normal files (non-raw), the file server is used to find the files, + and if the node is running its file server as slave to the file server + of another node, and the other node runs on some other host machine, + they can have different file systems. + However, this is seldom a problem.</p> </note> - <p>A normal file is really a process so it can be used as an I/O - device (see - <seealso marker="stdlib:io"><c>io</c></seealso>). - Therefore, when data is written to a - normal file, the sending of the data to the file process, copies - all data that are not binaries. Opening the file in binary mode - and writing binaries is therefore recommended. If the file is - opened on another node, or if the file server runs as slave to - the file server of another node, also binaries are copied.</p> - <p>Caching data to reduce the number of file operations, or rather - the number of calls to the file driver, generally increases - performance. The following function writes 4 MBytes in 23 - seconds when tested:</p> + <p><seealso marker="#open/2"><c>open/2</c></seealso> can be given the + options <c>delayed_write</c> and <c>read_ahead</c> to turn on caching, + which will reduce the number of operating system calls and greatly + improve performance for small reads and writes. However, the overhead + won't disappear completely and it's best to keep the number of file + operations to a minimum. As a contrived example, the following function + writes 4MB in 2.5 seconds when tested:</p> + <code type="none"><![CDATA[ -create_file_slow(Name, N) when integer(N), N >= 0 -> - {ok, FD} = file:open(Name, [raw, write, delayed_write, binary]), - ok = create_file_slow(FD, 0, N), - ok = ?FILE_MODULE:close(FD), - ok. - -create_file_slow(FD, M, M) -> +create_file_slow(Name) -> + {ok, Fd} = file:open(Name, [raw, write, delayed_write, binary]), + create_file_slow_1(Fd, 4 bsl 20), + file:close(Fd). + +create_file_slow_1(_Fd, 0) -> ok; -create_file_slow(FD, M, N) -> - ok = file:write(FD, <<M:32/unsigned>>), - create_file_slow(FD, M+1, N).]]></code> +create_file_slow_1(Fd, M) -> + ok = file:write(Fd, <<0>>), + create_file_slow_1(Fd, M - 1).]]></code> + + <p>The following functionally equivalent code writes 128 bytes per call + to <seealso marker="#write/2"><c>write/2</c></seealso> and so does the + same work in 0.08 seconds, which is roughly 30 times faster:</p> - <p>The following, functionally equivalent, function collects 1024 - entries into a list of 128 32-byte binaries before each call to - <seealso marker="#write/2"><c>write/2</c></seealso> and so - does the same work in 0.52 seconds, - which is 44 times faster:</p> <code type="none"><![CDATA[ -create_file(Name, N) when integer(N), N >= 0 -> - {ok, FD} = file:open(Name, [raw, write, delayed_write, binary]), - ok = create_file(FD, 0, N), - ok = ?FILE_MODULE:close(FD), +create_file(Name) -> + {ok, Fd} = file:open(Name, [raw, write, delayed_write, binary]), + create_file_1(Fd, 4 bsl 20), + file:close(Fd), ok. - -create_file(FD, M, M) -> + +create_file_1(_Fd, 0) -> ok; -create_file(FD, M, N) when M + 1024 =< N -> - create_file(FD, M, M + 1024, []), - create_file(FD, M + 1024, N); -create_file(FD, M, N) -> - create_file(FD, M, N, []). - -create_file(FD, M, M, R) -> - ok = file:write(FD, R); -create_file(FD, M, N0, R) when M + 8 =< N0 -> - N1 = N0-1, N2 = N0-2, N3 = N0-3, N4 = N0-4, - N5 = N0-5, N6 = N0-6, N7 = N0-7, N8 = N0-8, - create_file(FD, M, N8, - [<<N8:32/unsigned, N7:32/unsigned, - N6:32/unsigned, N5:32/unsigned, - N4:32/unsigned, N3:32/unsigned, - N2:32/unsigned, N1:32/unsigned>> | R]); -create_file(FD, M, N0, R) -> - N1 = N0-1, - create_file(FD, M, N1, [<<N1:32/unsigned>> | R]).]]></code> +create_file_1(Fd, M) when M >= 128 -> + ok = file:write(Fd, <<0:(128)/unit:8>>), + create_file_1(Fd, M - 128); +create_file_1(Fd, M) -> + ok = file:write(Fd, <<0:(M)/unit:8>>), + create_file_1(Fd, M - 1).]]></code> - <note> - <p>Trust only your own benchmarks. If the list length in - <c>create_file/2</c> above is increased, it runs slightly - faster, but consumes more memory and causes more memory - fragmentation. How much this affects your application is - something that this simple benchmark cannot predict.</p> - <p>If the size of each binary is increased to 64 bytes, it - also runs slightly faster, but the code is then twice as clumsy. - In the current implementation, binaries larger than 64 bytes are - stored in memory common to all processes and not copied when - sent between processes, while these smaller binaries are stored - on the process heap and copied when sent like any other term.</p> - <p>So, with a binary size of 68 bytes, <c>create_file/2</c> runs - 30 percent slower than with 64 bytes, and causes much more - memory fragmentation. Notice that if the binaries were to be sent - between processes (for example, a non-raw file), the results - would probably be completely different.</p> - </note> - <p>A raw file is really a port. When writing data to a port, it is - efficient to write a list of binaries. It is not needed to - flatten a deep list before writing. On Unix hosts, scatter output, - which writes a set of buffers in one operation, is used when - possible. In this way <c>write(FD, [Bin1, Bin2 | Bin3])</c> - writes the contents of the binaries without copying the data - at all, except for perhaps deep down in the operating system - kernel.</p> - <p>For raw files, <c>pwrite/2</c> and <c>pread/2</c> are - efficiently implemented. The file driver is called only once for - the whole operation, and the list iteration is done in the file - driver.</p> - <p>The options <c>delayed_write</c> and <c>read_ahead</c> to - <seealso marker="#open/2"><c>open/2</c></seealso> - make the file driver cache data to reduce - the number of operating system calls. The function - <c>create_file/2</c> in the recent example takes 60 seconds - without option <c>delayed_write</c>, which is 2.6 - times slower.</p> - <p>As a bad example, <c>create_file_slow/2</c> - without options <c>raw</c>, <c>binary</c>, and <c>delayed_write</c>, - meaning it calls <c>open(Name, [write])</c>, needs - 1 min 20 seconds for the job, which is 3.5 times slower than - the first example, and 150 times slower than the optimized - <c>create_file/2</c>.</p> - <warning> - <p>If an error occurs when accessing an open file with module - <seealso marker="stdlib:io"><c>io</c></seealso>, - the process handling the file exits. The dead - file process can hang if a process tries to access it later. - This will be fixed in a future release.</p> - </warning> + <p>When writing data it's generally more efficient to write a list of + binaries rather than a list of integers. It is not needed to + flatten a deep list before writing. On Unix hosts, scatter output, + which writes a set of buffers in one operation, is used when + possible. In this way <c>write(FD, [Bin1, Bin2 | Bin3])</c> + writes the contents of the binaries without copying the data + at all, except for perhaps deep down in the operating system + kernel.</p> + <warning> + <p>If an error occurs when accessing an open file with module + <seealso marker="stdlib:io"><c>io</c></seealso>, the process + handling the file exits. The dead file process can hang if a process + tries to access it later. This will be fixed in a future release. + </p> + </warning> </section> <section> diff --git a/lib/kernel/doc/src/gen_tcp.xml b/lib/kernel/doc/src/gen_tcp.xml index 070782e1f3..e6104b0c76 100644 --- a/lib/kernel/doc/src/gen_tcp.xml +++ b/lib/kernel/doc/src/gen_tcp.xml @@ -51,6 +51,7 @@ server() -> {ok, Sock} = gen_tcp:accept(LSock), {ok, Bin} = do_recv(Sock, []), ok = gen_tcp:close(Sock), + ok = gen_tcp:close(LSock), Bin. do_recv(Sock, Bs) -> @@ -309,9 +310,9 @@ do_recv(Sock, Bs) -> <seealso marker="inet#setopts/2"><c>inet:setopts/2</c></seealso>. </p></item> </taglist> - <p>The returned socket <c><anno>ListenSocket</anno></c> can only be - used in calls to - <seealso marker="#accept/1"><c>accept/1,2</c></seealso>.</p> + <p>The returned socket <c><anno>ListenSocket</anno></c> should be used + in calls to <seealso marker="#accept/1"><c>accept/1,2</c></seealso> to + accept incoming connection requests.</p> <note> <p>The default values for options specified to <c>listen</c> can be affected by the Kernel configuration parameter diff --git a/lib/kernel/doc/src/inet_res.xml b/lib/kernel/doc/src/inet_res.xml index 4ada4203c0..3454e3c6f9 100644 --- a/lib/kernel/doc/src/inet_res.xml +++ b/lib/kernel/doc/src/inet_res.xml @@ -130,7 +130,7 @@ dns_header() = DnsHeader inet_dns:header(DnsHeader) -> [ {id, integer()} | {qr, boolean()} - | {opcode, 'query' | iquery | status | integer()} + | {opcode, query | iquery | status | integer()} | {aa, boolean()} | {tc, boolean()} | {rd, boolean()} diff --git a/lib/kernel/doc/src/net_kernel.xml b/lib/kernel/doc/src/net_kernel.xml index 0b94fc0fa6..94c8fb9e20 100644 --- a/lib/kernel/doc/src/net_kernel.xml +++ b/lib/kernel/doc/src/net_kernel.xml @@ -230,7 +230,12 @@ $ <input>erl -sname foobar</input></pre> <item> <p>The tuple <c>{nodedown_reason, Reason}</c> is included in <c>InfoList</c> in <c>nodedown</c> messages.</p> - <p><c>Reason</c> can be any of the following:</p> + <p> + <c>Reason</c> can, depending on which + distribution module or process that is used be any term, + but for the standard TCP distribution module it is + any of the following: + </p> <taglist> <tag><c>connection_setup_failed</c></tag> <item><p>The connection setup failed (after <c>nodeup</c> diff --git a/lib/kernel/doc/src/notes.xml b/lib/kernel/doc/src/notes.xml index a6baf14906..d7f224c38e 100644 --- a/lib/kernel/doc/src/notes.xml +++ b/lib/kernel/doc/src/notes.xml @@ -31,20 +31,15 @@ </header> <p>This document describes the changes made to the Kernel application.</p> -<section><title>Kernel 5.4.0.1</title> +<section><title>Kernel 5.4.1</title> - <section><title>Improvements and New Features</title> + <section><title>Fixed Bugs and Malfunctions</title> <list> <item> <p> - Add <c>os:cmd/2</c> that takes an options map as the - second argument.</p> - <p> - Add <c>max_size</c> as an option to <c>os:cmd/2</c> that - control the maximum size of the result that - <c>os:cmd/2</c> will return.</p> + Refactored an internal API.</p> <p> - Own Id: OTP-14823</p> + Own Id: OTP-14784</p> </item> </list> </section> diff --git a/lib/kernel/doc/src/os.xml b/lib/kernel/doc/src/os.xml index 7ce2f54542..0a08e2c78a 100644 --- a/lib/kernel/doc/src/os.xml +++ b/lib/kernel/doc/src/os.xml @@ -36,37 +36,119 @@ only run on a specific platform. On the other hand, with careful use, these functions can be of help in enabling a program to run on most platforms.</p> + + <note> + <p> + File operations used to accept filenames containing + null characters (integer value zero). This caused + the name to be truncated and in some cases arguments + to primitive operations to be mixed up. Filenames + containing null characters inside the filename + are now <em>rejected</em> and will cause primitive + file operations to fail. + </p> + <p> + Also environment variable operations used to accept + names and values of environment variables containing + null characters (integer value zero). This caused + operations to silently produce erroneous results. + Environment variable names and values containing + null characters inside the name or value are now + <em>rejected</em> and will cause environment variable + operations to fail. + </p> + </note> + <warning> + <p> + Currently null characters at the end of filenames, + environment variable names and values will be accepted + by the primitive operations. Such filenames, environment + variable names and values are however still documented as + invalid. The implementation will also change in the + future and reject such filenames, environment variable + names and values. + </p> + </warning> </description> <datatypes> <datatype> - <name name="os_command"/> + <name name="env_var_name"/> + <desc> + <p>A string containing valid characters on the specific + OS for environment variable names using + <seealso marker="file#native_name_encoding/0"><c>file:native_name_encoding()</c></seealso> + encoding. Note that specifically null characters (integer + value zero) and <c>$=</c> characters are not allowed. + However, note that not all invalid characters necessarily + will cause the primitiv operations to fail, but may instead + produce invalid results. + </p> + </desc> + </datatype> + <datatype> + <name name="env_var_value"/> + <desc> + <p>A string containing valid characters on the specific + OS for environment variable values using + <seealso marker="file#native_name_encoding/0"><c>file:native_name_encoding()</c></seealso> + encoding. Note that specifically null characters (integer + value zero) are not allowed. However, note that not all + invalid characters necessarily will cause the primitiv + operations to fail, but may instead produce invalid results. + </p> + </desc> </datatype> <datatype> - <name name="os_command_opts"/> + <name name="env_var_name_value"/> <desc> - <p>Options for <seealso marker="#cmd/2"><c>os:cmd/2</c></seealso></p> - <taglist> - <tag><c>max_size</c></tag> - <item> - <p>The maximum size of the data returned by the <c>os:cmd</c> call. - See the <seealso marker="#cmd/2"><c>os:cmd/2</c></seealso> - documentation for more details.</p> - </item> - </taglist> + <p> + Assuming that environment variables has been correctly + set, a strings containing valid characters on the specific + OS for environment variable names and values using + <seealso marker="file#native_name_encoding/0"><c>file:native_name_encoding()</c></seealso> + encoding. The first <c>$=</c> characters appearing in + the string separates environment variable name (on the + left) from environment variable value (on the right). + </p> + </desc> + </datatype> + <datatype> + <name name="command_input"/> + <desc> + <p>All characters needs to be valid characters on the + specific OS using + <seealso marker="file#native_name_encoding/0"><c>file:native_name_encoding()</c></seealso> + encoding. Note that specifically null characters (integer + value zero) are not allowed. However, note that not all + invalid characters not necessarily will cause + <seealso marker="#cmd/1"><c>os:cmd/1</c></seealso> + to fail, but may instead produce invalid results. + </p> </desc> </datatype> </datatypes> - + <funcs> <func> <name name="cmd" arity="1"/> - <name name="cmd" arity="2"/> <fsummary>Execute a command in a shell of the target OS.</fsummary> <desc> <p>Executes <c><anno>Command</anno></c> in a command shell of the - target OS, captures the standard output of the command, - and returns this result as a string.</p> + target OS, + captures the standard output of the command, and returns this + result as a string. This function is a replacement of + the previous function <c>unix:cmd/1</c>; they are equivalent on a + Unix platform.</p> + <warning><p>Previous implementation used to allow all characters + as long as they were integer values greater than or equal to zero. + This sometimes lead to unwanted results since null characters + (integer value zero) often are interpreted as string termination. + Current implementation still accepts null characters at the end + of <c><anno>Command</anno></c> even though the documentation + states that no null characters are allowed. This will however + be changed in the future so that no null characters at all will + be accepted.</p></warning> <p><em>Examples:</em></p> <code type="none"> LsOut = os:cmd("ls"), % on unix platform @@ -75,21 +157,6 @@ DirOut = os:cmd("dir"), % on Win32 platform</code> called from another program (for example, <c>os:cmd/1</c>) can differ, compared with the standard output of the command when called directly from an OS command shell.</p> - <p><c>os:cmd/2</c> was added in kernel-5.5 (OTP-20.2.1). It makes it - possible to pass an options map as the second argument in order to - control the behaviour of <c>os:cmd</c>. The possible options are: - </p> - <taglist> - <tag><c>max_size</c></tag> - <item> - <p>The maximum size of the data returned by the <c>os:cmd</c> call. - This option is a safety feature that should be used when the command - executed can return a very large, possibly infinite, result.</p> - <code type="none"> -> os:cmd("cat /dev/zero", #{ max_size => 20 }). -[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]</code> - </item> - </taglist> </desc> </func> @@ -185,6 +252,15 @@ DirOut = os:cmd("dir"), % on Win32 platform</code> <p>On Unix platforms, the environment is set using UTF-8 encoding if Unicode filename translation is in effect. On Windows, the environment is set using wide character interfaces.</p> + <note> + <p> + <c><anno>VarName</anno></c> is not allowed to contain + an <c>$=</c> character. Previous implementations used + to just let the <c>$=</c> character through which + silently caused erroneous results. Current implementation + will instead throw a <c>badarg</c> exception. + </p> + </note> </desc> </func> diff --git a/lib/kernel/doc/src/part_notes.xml b/lib/kernel/doc/src/part_notes.xml deleted file mode 100644 index 5e849039ee..0000000000 --- a/lib/kernel/doc/src/part_notes.xml +++ /dev/null @@ -1,40 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2004</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>Kernel Release Notes</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p>The <em>Kernel</em> application has all the code necessary to run - the Erlang runtime system itself; File servers and code servers - etc.</p> - <p>For information about older versions, see - <url href="part_notes_history_frame.html">Release Notes History</url>.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/kernel/doc/src/part_notes_history.xml b/lib/kernel/doc/src/part_notes_history.xml deleted file mode 100644 index 0cf7b793da..0000000000 --- a/lib/kernel/doc/src/part_notes_history.xml +++ /dev/null @@ -1,40 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part> - <header> - <copyright> - <year>2006</year> - <year>2016</year> - <holder>Ericsson AB, All Rights Reserved</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>Kernel Release Notes History</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p>The <em>Kernel</em> application has all the code necessary to run - the Erlang runtime system itself; File servers and code servers - etc.</p> - </description> - <include file="notes_history"></include> -</part> - diff --git a/lib/kernel/doc/src/user_guide.gif b/lib/kernel/doc/src/user_guide.gif Binary files differdeleted file mode 100644 index e6275a803d..0000000000 --- a/lib/kernel/doc/src/user_guide.gif +++ /dev/null diff --git a/lib/kernel/examples/Makefile b/lib/kernel/examples/Makefile index 26ec58f571..f86e662838 100644 --- a/lib/kernel/examples/Makefile +++ b/lib/kernel/examples/Makefile @@ -45,7 +45,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/kernel-$(KERNEL_VSN)/examples # Pack and install the complete directory structure from # here (CWD) and down, for all examples. -EXAMPLES = uds_dist +EXAMPLES = uds_dist gen_tcp_dist release_spec: $(INSTALL_DIR) "$(RELSYSDIR)" diff --git a/lib/kernel/examples/gen_tcp_dist/Makefile b/lib/kernel/examples/gen_tcp_dist/Makefile new file mode 100644 index 0000000000..65513a1729 --- /dev/null +++ b/lib/kernel/examples/gen_tcp_dist/Makefile @@ -0,0 +1,20 @@ +RM=rm -f +CP=cp +EBIN=ebin +ERLC=erlc +# Works if building in open source source tree +KERNEL_INCLUDE=$(ERL_TOP)/lib/kernel/include +ERLCFLAGS+= -W -I$(KERNEL_INCLUDE) + +MODULES=gen_tcp_dist + +TARGET_FILES=$(MODULES:%=$(EBIN)/%.beam) + +opt: $(TARGET_FILES) + +$(EBIN)/%.beam: src/%.erl + $(ERLC) $(ERLCFLAGS) -o$(EBIN) $< + +clean: + $(RM) $(TARGET_FILES) + diff --git a/lib/kernel/examples/gen_tcp_dist/ebin/.gitignore b/lib/kernel/examples/gen_tcp_dist/ebin/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/kernel/examples/gen_tcp_dist/ebin/.gitignore diff --git a/lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl b/lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl new file mode 100644 index 0000000000..98554ed805 --- /dev/null +++ b/lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl @@ -0,0 +1,781 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(gen_tcp_dist). + +%% +%% This is an example of how to plug in an arbitrary distribution +%% carrier for Erlang using distribution processes. +%% +%% This example uses gen_tcp for transportation of data, but +%% you can use whatever underlying protocol you want as long +%% as your implementation reliably delivers data chunks to the +%% receiving VM in the order they were sent from the sending +%% VM. +%% +%% This code is a rewrite of the lib/kernel/src/inet_tcp_dist.erl +%% distribution impementation for TCP used by default. That +%% implementation use distribution ports instead of distribution +%% processes and is more efficient compared to this implementation. +%% This since this implementation more or less gets the +%% distribution processes in between the VM and the ports without +%% any gain specific gain. +%% + +-export([listen/1, accept/1, accept_connection/5, + setup/5, close/1, select/1, is_node_name/1]). + +%% Optional +-export([setopts/2, getopts/2]). + +%% internal exports + +-export([dist_cntrlr_setup/1, dist_cntrlr_input_setup/3, + dist_cntrlr_tick_handler/1]). + +-export([accept_loop/2,do_accept/6,do_setup/6]). + +-import(error_logger,[error_msg/2]). + +-include("net_address.hrl"). + +-include("dist.hrl"). +-include("dist_util.hrl"). + +%% ------------------------------------------------------------ +%% Select this protocol based on node name +%% select(Node) => Bool +%% ------------------------------------------------------------ + +select(Node) -> + case split_node(atom_to_list(Node), $@, []) of + [_, Host] -> + case inet:getaddr(Host, inet) of + {ok,_} -> true; + _ -> false + end; + _ -> false + end. + +%% ------------------------------------------------------------ +%% Create the listen socket, i.e. the port that this erlang +%% node is accessible through. +%% ------------------------------------------------------------ + +listen(Name) -> + case do_listen([binary, {active, false}, {packet,2}, {reuseaddr, true}]) of + {ok, Socket} -> + TcpAddress = get_tcp_address(Socket), + {_,Port} = TcpAddress#net_address.address, + ErlEpmd = net_kernel:epmd_module(), + case ErlEpmd:register_node(Name, Port) of + {ok, Creation} -> + {ok, {Socket, TcpAddress, Creation}}; + Error -> + Error + end; + Error -> + Error + end. + +do_listen(Options) -> + {First,Last} = case application:get_env(kernel,inet_dist_listen_min) of + {ok,N} when is_integer(N) -> + case application:get_env(kernel, + inet_dist_listen_max) of + {ok,M} when is_integer(M) -> + {N,M}; + _ -> + {N,N} + end; + _ -> + {0,0} + end, + do_listen(First, Last, listen_options([{backlog,128}|Options])). + +do_listen(First,Last,_) when First > Last -> + {error,eaddrinuse}; +do_listen(First,Last,Options) -> + case gen_tcp:listen(First, Options) of + {error, eaddrinuse} -> + do_listen(First+1,Last,Options); + Other -> + Other + end. + +listen_options(Opts0) -> + Opts1 = + case application:get_env(kernel, inet_dist_use_interface) of + {ok, Ip} -> + [{ip, Ip} | Opts0]; + _ -> + Opts0 + end, + case application:get_env(kernel, inet_dist_listen_options) of + {ok,ListenOpts} -> + ListenOpts ++ Opts1; + _ -> + Opts1 + end. + + +%% ------------------------------------------------------------ +%% Accepts new connection attempts from other Erlang nodes. +%% ------------------------------------------------------------ + +accept(Listen) -> + spawn_opt(?MODULE, accept_loop, [self(), Listen], [link, {priority, max}]). + +accept_loop(Kernel, Listen) -> + ?trace("~p~n",[{?MODULE, accept_loop, self()}]), + case gen_tcp:accept(Listen) of + {ok, Socket} -> + DistCtrl = spawn_dist_cntrlr(Socket), + ?trace("~p~n",[{?MODULE, accept_loop, accepted, Socket, DistCtrl, self()}]), + flush_controller(DistCtrl, Socket), + gen_tcp:controlling_process(Socket, DistCtrl), + flush_controller(DistCtrl, Socket), + Kernel ! {accept,self(),DistCtrl,inet,tcp}, + receive + {Kernel, controller, Pid} -> + call_ctrlr(DistCtrl, {supervisor, Pid}), + Pid ! {self(), controller}; + {Kernel, unsupported_protocol} -> + exit(unsupported_protocol) + end, + accept_loop(Kernel, Listen); + Error -> + exit(Error) + end. + +flush_controller(Pid, Socket) -> + receive + {tcp, Socket, Data} -> + Pid ! {tcp, Socket, Data}, + flush_controller(Pid, Socket); + {tcp_closed, Socket} -> + Pid ! {tcp_closed, Socket}, + flush_controller(Pid, Socket) + after 0 -> + ok + end. + +%% ------------------------------------------------------------ +%% Accepts a new connection attempt from another Erlang node. +%% Performs the handshake with the other side. +%% ------------------------------------------------------------ + +accept_connection(AcceptPid, DistCtrl, MyNode, Allowed, SetupTime) -> + spawn_opt(?MODULE, do_accept, + [self(), AcceptPid, DistCtrl, MyNode, Allowed, SetupTime], + [link, {priority, max}]). + +do_accept(Kernel, AcceptPid, DistCtrl, MyNode, Allowed, SetupTime) -> + ?trace("~p~n",[{?MODULE, do_accept, self(), MyNode}]), + receive + {AcceptPid, controller} -> + Timer = dist_util:start_timer(SetupTime), + case check_ip(DistCtrl) of + true -> + HSData0 = hs_data_common(DistCtrl), + HSData = HSData0#hs_data{kernel_pid = Kernel, + this_node = MyNode, + socket = DistCtrl, + timer = Timer, + this_flags = 0, + allowed = Allowed}, + dist_util:handshake_other_started(HSData); + {false,IP} -> + error_msg("** Connection attempt from " + "disallowed IP ~w ** ~n", [IP]), + ?shutdown(no_node) + end + end. + +%% we may not always want the nodelay behaviour +%% for performance reasons + +nodelay() -> + case application:get_env(kernel, dist_nodelay) of + undefined -> + {nodelay, true}; + {ok, true} -> + {nodelay, true}; + {ok, false} -> + {nodelay, false}; + _ -> + {nodelay, true} + end. + +%% ------------------------------------------------------------ +%% Setup a new connection to another Erlang node. +%% Performs the handshake with the other side. +%% ------------------------------------------------------------ + +setup(Node, Type, MyNode, LongOrShortNames,SetupTime) -> + spawn_opt(?MODULE, do_setup, + [self(), Node, Type, MyNode, LongOrShortNames, SetupTime], + [link, {priority, max}]). + +do_setup(Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) -> + ?trace("~p~n",[{?MODULE, do_setup, self(), Node}]), + [Name, Address] = splitnode(Node, LongOrShortNames), + case inet:getaddr(Address, inet) of + {ok, Ip} -> + Timer = dist_util:start_timer(SetupTime), + ErlEpmd = net_kernel:epmd_module(), + case ErlEpmd:port_please(Name, Ip) of + {port, TcpPort, Version} -> + ?trace("port_please(~p) -> version ~p~n", + [Node,Version]), + dist_util:reset_timer(Timer), + case + gen_tcp:connect( + Ip, TcpPort, + connect_options([binary, {active, false}, {packet, 2}])) + of + {ok, Socket} -> + DistCtrl = spawn_dist_cntrlr(Socket), + call_ctrlr(DistCtrl, {supervisor, self()}), + flush_controller(DistCtrl, Socket), + gen_tcp:controlling_process(Socket, DistCtrl), + flush_controller(DistCtrl, Socket), + HSData0 = hs_data_common(DistCtrl), + HSData = HSData0#hs_data{kernel_pid = Kernel, + other_node = Node, + this_node = MyNode, + socket = DistCtrl, + timer = Timer, + this_flags = 0, + other_version = Version, + request_type = Type}, + dist_util:handshake_we_started(HSData); + _ -> + %% Other Node may have closed since + %% port_please ! + ?trace("other node (~p) " + "closed since port_please.~n", + [Node]), + ?shutdown(Node) + end; + _ -> + ?trace("port_please (~p) " + "failed.~n", [Node]), + ?shutdown(Node) + end; + _Other -> + ?trace("inet_getaddr(~p) " + "failed (~p).~n", [Node,_Other]), + ?shutdown(Node) + end. + +connect_options(Opts) -> + case application:get_env(kernel, inet_dist_connect_options) of + {ok,ConnectOpts} -> + ConnectOpts ++ Opts; + _ -> + Opts + end. + +%% +%% Close a socket. +%% +close(Listen) -> + gen_tcp:close(Listen). + + +%% If Node is illegal terminate the connection setup!! +splitnode(Node, LongOrShortNames) -> + case split_node(atom_to_list(Node), $@, []) of + [Name|Tail] when Tail =/= [] -> + Host = lists:append(Tail), + case split_node(Host, $., []) of + [_] when LongOrShortNames =:= longnames -> + case inet:parse_address(Host) of + {ok, _} -> + [Name, Host]; + _ -> + error_msg("** System running to use " + "fully qualified " + "hostnames **~n" + "** Hostname ~ts is illegal **~n", + [Host]), + ?shutdown(Node) + end; + L when length(L) > 1, LongOrShortNames =:= shortnames -> + error_msg("** System NOT running to use fully qualified " + "hostnames **~n" + "** Hostname ~ts is illegal **~n", + [Host]), + ?shutdown(Node); + _ -> + [Name, Host] + end; + [_] -> + error_msg("** Nodename ~p illegal, no '@' character **~n", + [Node]), + ?shutdown(Node); + _ -> + error_msg("** Nodename ~p illegal **~n", [Node]), + ?shutdown(Node) + end. + +split_node([Chr|T], Chr, Ack) -> [lists:reverse(Ack)|split_node(T, Chr, [])]; +split_node([H|T], Chr, Ack) -> split_node(T, Chr, [H|Ack]); +split_node([], _, Ack) -> [lists:reverse(Ack)]. + +%% ------------------------------------------------------------ +%% Fetch local information about a Socket. +%% ------------------------------------------------------------ +get_tcp_address(Socket) -> + {ok, Address} = inet:sockname(Socket), + {ok, Host} = inet:gethostname(), + #net_address { + address = Address, + host = Host, + protocol = tcp, + family = inet + }. + +%% ------------------------------------------------------------ +%% Do only accept new connection attempts from nodes at our +%% own LAN, if the check_ip environment parameter is true. +%% ------------------------------------------------------------ +check_ip(DistCtrl) -> + case application:get_env(check_ip) of + {ok, true} -> + case get_ifs(DistCtrl) of + {ok, IFs, IP} -> + check_ip(IFs, IP); + _ -> + ?shutdown(no_node) + end; + _ -> + true + end. + +get_ifs(DistCtrl) -> + Socket = call_ctrlr(DistCtrl, socket), + case inet:peername(Socket) of + {ok, {IP, _}} -> + case inet:getif(Socket) of + {ok, IFs} -> {ok, IFs, IP}; + Error -> Error + end; + Error -> + Error + end. + +check_ip([{OwnIP, _, Netmask}|IFs], PeerIP) -> + case {inet_tcp:mask(Netmask, PeerIP), inet_tcp:mask(Netmask, OwnIP)} of + {M, M} -> true; + _ -> check_ip(IFs, PeerIP) + end; +check_ip([], PeerIP) -> + {false, PeerIP}. + +is_node_name(Node) when is_atom(Node) -> + case split_node(atom_to_list(Node), $@, []) of + [_, _Host] -> true; + _ -> false + end; +is_node_name(_Node) -> + false. + +hs_data_common(DistCtrl) -> + TickHandler = call_ctrlr(DistCtrl, tick_handler), + Socket = call_ctrlr(DistCtrl, socket), + #hs_data{f_send = send_fun(), + f_recv = recv_fun(), + f_setopts_pre_nodeup = setopts_pre_nodeup_fun(), + f_setopts_post_nodeup = setopts_post_nodeup_fun(), + f_getll = getll_fun(), + f_handshake_complete = handshake_complete_fun(), + f_address = address_fun(), + mf_setopts = setopts_fun(DistCtrl, Socket), + mf_getopts = getopts_fun(DistCtrl, Socket), + mf_getstat = getstat_fun(DistCtrl, Socket), + mf_tick = tick_fun(DistCtrl, TickHandler)}. + +%%% ------------------------------------------------------------ +%%% Distribution controller processes +%%% ------------------------------------------------------------ + +%% +%% There will be five parties working together when the +%% connection is up: +%% - The gen_tcp socket. Providing a tcp/ip connection +%% to the other node. +%% - The output handler. It will dispatch all outgoing +%% traffic from the VM to the gen_tcp socket. This +%% process is registered as distribution controller +%% for this channel with the VM. +%% - The input handler. It will dispatch all incoming +%% traffic from the gen_tcp socket to the VM. This +%% process is also the socket owner and receives +%% incoming traffic using active-N. +%% - The tick handler. Dispatches asynchronous tick +%% requests to the socket. It executes on max priority +%% since it is important to get ticks through to the +%% other end. +%% - The channel supervisor (provided by dist_util). It +%% monitors traffic. Issue tick requests to the tick +%% handler when no outgoing traffic is seen and bring +%% the connection down if no incoming traffic is seen. +%% This process also executes on max priority. +%% +%% These parties are linked togheter so should one +%% of them fail, all of them are terminated and the +%% connection is taken down. +%% + +%% In order to avoid issues with lingering signal binaries +%% we enable off-heap message queue data as well as fullsweep +%% after 0. The fullsweeps will be cheap since we have more +%% or less no live data. +-define(DIST_CNTRL_COMMON_SPAWN_OPTS, + [{message_queue_data, off_heap}, + {fullsweep_after, 0}]). + +tick_fun(DistCtrl, TickHandler) -> + fun (Ctrl) when Ctrl == DistCtrl -> + TickHandler ! tick + end. + +getstat_fun(DistCtrl, Socket) -> + fun (Ctrl) when Ctrl == DistCtrl -> + case inet:getstat(Socket, [recv_cnt, send_cnt, send_pend]) of + {ok, Stat} -> + split_stat(Stat,0,0,0); + Error -> + Error + end + end. + +split_stat([{recv_cnt, R}|Stat], _, W, P) -> + split_stat(Stat, R, W, P); +split_stat([{send_cnt, W}|Stat], R, _, P) -> + split_stat(Stat, R, W, P); +split_stat([{send_pend, P}|Stat], R, W, _) -> + split_stat(Stat, R, W, P); +split_stat([], R, W, P) -> + {ok, R, W, P}. + +setopts_fun(DistCtrl, Socket) -> + fun (Ctrl, Opts) when Ctrl == DistCtrl -> + setopts(Socket, Opts) + end. + +getopts_fun(DistCtrl, Socket) -> + fun (Ctrl, Opts) when Ctrl == DistCtrl -> + getopts(Socket, Opts) + end. + +setopts(S, Opts) -> + case [Opt || {K,_}=Opt <- Opts, + K =:= active orelse K =:= deliver orelse K =:= packet] of + [] -> inet:setopts(S,Opts); + Opts1 -> {error, {badopts,Opts1}} + end. + +getopts(S, Opts) -> + inet:getopts(S, Opts). + +send_fun() -> + fun (Ctrlr, Packet) -> + call_ctrlr(Ctrlr, {send, Packet}) + end. + +recv_fun() -> + fun (Ctrlr, Length, Timeout) -> + case call_ctrlr(Ctrlr, {recv, Length, Timeout}) of + {ok, Bin} when is_binary(Bin) -> + {ok, binary_to_list(Bin)}; + Other -> + Other + end + end. + +getll_fun() -> + fun (Ctrlr) -> + call_ctrlr(Ctrlr, getll) + end. + +address_fun() -> + fun (Ctrlr, Node) -> + case call_ctrlr(Ctrlr, {address, Node}) of + {error, no_node} -> %% No '@' or more than one '@' in node name. + ?shutdown(no_node); + Res -> + Res + end + end. + +setopts_pre_nodeup_fun() -> + fun (Ctrlr) -> + call_ctrlr(Ctrlr, pre_nodeup) + end. + +setopts_post_nodeup_fun() -> + fun (Ctrlr) -> + call_ctrlr(Ctrlr, post_nodeup) + end. + +handshake_complete_fun() -> + fun (Ctrlr, Node, DHandle) -> + call_ctrlr(Ctrlr, {handshake_complete, Node, DHandle}) + end. + +call_ctrlr(Ctrlr, Msg) -> + Ref = erlang:monitor(process, Ctrlr), + Ctrlr ! {Ref, self(), Msg}, + receive + {Ref, Res} -> + erlang:demonitor(Ref, [flush]), + Res; + {'DOWN', Ref, process, Ctrlr, Reason} -> + exit({dist_controller_exit, Reason}) + end. + +%% +%% The tick handler process writes a tick to the +%% socket when it receives a 'tick' message from +%% the connection supervisor. +%% +%% We are not allowed to block the connection +%% superviser when writing a tick and we also want +%% the tick to go through even during a heavily +%% loaded system. gen_tcp does not have a +%% non-blocking send operation exposed in its API +%% and we don't want to run the distribution +%% controller under high priority. Therefore this +%% sparate process with max prio that dispatches +%% ticks. +%% +dist_cntrlr_tick_handler(Socket) -> + receive + tick -> + %% May block due to busy port... + sock_send(Socket, ""); + _ -> + ok + end, + dist_cntrlr_tick_handler(Socket). + +spawn_dist_cntrlr(Socket) -> + spawn_opt(?MODULE, dist_cntrlr_setup, [Socket], + [{priority, max}] ++ ?DIST_CNTRL_COMMON_SPAWN_OPTS). + +dist_cntrlr_setup(Socket) -> + TickHandler = spawn_opt(?MODULE, dist_cntrlr_tick_handler, + [Socket], + [link, {priority, max}] + ++ ?DIST_CNTRL_COMMON_SPAWN_OPTS), + dist_cntrlr_setup_loop(Socket, TickHandler, undefined). + +%% +%% During the handshake phase we loop in dist_cntrlr_setup(). +%% When the connection is up we spawn an input handler and +%% continue as output handler. +%% +dist_cntrlr_setup_loop(Socket, TickHandler, Sup) -> + receive + {tcp_closed, Socket} -> + exit(connection_closed); + + {Ref, From, {supervisor, Pid}} -> + Res = link(Pid), + From ! {Ref, Res}, + dist_cntrlr_setup_loop(Socket, TickHandler, Pid); + + {Ref, From, tick_handler} -> + From ! {Ref, TickHandler}, + dist_cntrlr_setup_loop(Socket, TickHandler, Sup); + + {Ref, From, socket} -> + From ! {Ref, Socket}, + dist_cntrlr_setup_loop(Socket, TickHandler, Sup); + + {Ref, From, {send, Packet}} -> + Res = gen_tcp:send(Socket, Packet), + From ! {Ref, Res}, + dist_cntrlr_setup_loop(Socket, TickHandler, Sup); + + {Ref, From, {recv, Length, Timeout}} -> + Res = gen_tcp:recv(Socket, Length, Timeout), + From ! {Ref, Res}, + dist_cntrlr_setup_loop(Socket, TickHandler, Sup); + + {Ref, From, getll} -> + From ! {Ref, {ok, self()}}, + dist_cntrlr_setup_loop(Socket, TickHandler, Sup); + + {Ref, From, {address, Node}} -> + Res = case inet:peername(Socket) of + {ok, Address} -> + case split_node(atom_to_list(Node), $@, []) of + [_,Host] -> + #net_address{address=Address,host=Host, + protocol=tcp, family=inet}; + _ -> + {error, no_node} + end + end, + From ! {Ref, Res}, + dist_cntrlr_setup_loop(Socket, TickHandler, Sup); + + {Ref, From, pre_nodeup} -> + Res = inet:setopts(Socket, + [{active, false}, + {packet, 4}, + nodelay()]), + From ! {Ref, Res}, + dist_cntrlr_setup_loop(Socket, TickHandler, Sup); + + {Ref, From, post_nodeup} -> + Res = inet:setopts(Socket, + [{active, false}, + {packet, 4}, + nodelay()]), + From ! {Ref, Res}, + dist_cntrlr_setup_loop(Socket, TickHandler, Sup); + + {Ref, From, {handshake_complete, _Node, DHandle}} -> + From ! {Ref, ok}, + %% Handshake complete! Begin dispatching traffic... + + %% We use separate process for dispatching input. This + %% is not necessary, but it enables parallel execution + %% of independent work loads at the same time as it + %% simplifies the the implementation... + InputHandler = spawn_opt(?MODULE, dist_cntrlr_input_setup, + [DHandle, Socket, Sup], + [link] ++ ?DIST_CNTRL_COMMON_SPAWN_OPTS), + + flush_controller(InputHandler, Socket), + gen_tcp:controlling_process(Socket, InputHandler), + flush_controller(InputHandler, Socket), + + ok = erlang:dist_ctrl_input_handler(DHandle, InputHandler), + + InputHandler ! DHandle, + + %% From now on we execute on normal priority + process_flag(priority, normal), + erlang:dist_ctrl_get_data_notification(DHandle), + dist_cntrlr_output_loop(DHandle, Socket) + end. + +%% We use active 10 for good throughput while still +%% maintaining back-pressure if the input controller +%% isn't able to handle all incoming messages... +-define(ACTIVE_INPUT, 10). + +dist_cntrlr_input_setup(DHandle, Socket, Sup) -> + link(Sup), + %% Ensure we don't try to put data before registerd + %% as input handler... + receive + DHandle -> + dist_cntrlr_input_loop(DHandle, Socket, 0) + end. + +dist_cntrlr_input_loop(DHandle, Socket, N) when N =< ?ACTIVE_INPUT/2 -> + inet:setopts(Socket, [{active, ?ACTIVE_INPUT - N}]), + dist_cntrlr_input_loop(DHandle, Socket, ?ACTIVE_INPUT); +dist_cntrlr_input_loop(DHandle, Socket, N) -> + receive + {tcp_closed, Socket} -> + %% Connection to remote node terminated... + exit(connection_closed); + + {tcp, Socket, Data} -> + %% Incoming data from remote node... + try erlang:dist_ctrl_put_data(DHandle, Data) + catch _ : _ -> death_row() + end, + dist_cntrlr_input_loop(DHandle, Socket, N-1); + + _ -> + %% Ignore... + dist_cntrlr_input_loop(DHandle, Socket, N) + end. + +dist_cntrlr_send_data(DHandle, Socket) -> + case erlang:dist_ctrl_get_data(DHandle) of + none -> + erlang:dist_ctrl_get_data_notification(DHandle); + Data -> + sock_send(Socket, Data), + dist_cntrlr_send_data(DHandle, Socket) + end. + + +dist_cntrlr_output_loop(DHandle, Socket) -> + receive + dist_data -> + %% Outgoing data from this node... + try dist_cntrlr_send_data(DHandle, Socket) + catch _ : _ -> death_row() + end, + dist_cntrlr_output_loop(DHandle, Socket); + + {send, From, Ref, Data} -> + %% This is for testing only! + %% + %% Needed by some OTP distribution + %% test suites... + sock_send(Socket, Data), + From ! {Ref, ok}, + dist_cntrlr_output_loop(DHandle, Socket); + + _ -> + %% Drop garbage message... + dist_cntrlr_output_loop(DHandle, Socket) + + end. + +sock_send(Socket, Data) -> + try gen_tcp:send(Socket, Data) of + ok -> ok; + {error, Reason} -> death_row({send_error, Reason}) + catch + Type : Reason -> death_row({send_error, {Type, Reason}}) + end. + +death_row() -> + death_row(connection_closed). + +death_row(normal) -> + %% We do not want to exit with normal + %% exit reason since it wont bring down + %% linked processes... + death_row(); +death_row(Reason) -> + %% When the connection is on its way down operations + %% begin to fail. We catch the failures and call + %% this function waiting for termination. We should + %% be terminated by one of our links to the other + %% involved parties that began bringing the + %% connection down. By waiting for termination we + %% avoid altering the exit reason for the connection + %% teardown. We however limit the wait to 5 seconds + %% and bring down the connection ourselves if not + %% terminated... + receive after 5000 -> exit(Reason) end. diff --git a/lib/kernel/include/dist.hrl b/lib/kernel/include/dist.hrl index d6bccdf474..db4a5eaebc 100644 --- a/lib/kernel/include/dist.hrl +++ b/lib/kernel/include/dist.hrl @@ -40,3 +40,33 @@ -define(DFLAG_UTF8_ATOMS, 16#10000). -define(DFLAG_MAP_TAG, 16#20000). -define(DFLAG_BIG_CREATION, 16#40000). +-define(DFLAG_SEND_SENDER, 16#80000). + +%% DFLAGs that require strict ordering or:ed together... +-define(DFLAGS_STRICT_ORDER_DELIVERY, + ?DFLAG_DIST_HDR_ATOM_CACHE). + + +%% Also update dflag2str() in ../src/dist_util.erl +%% when adding flags... + +-define(DFLAGS_ALL, + (?DFLAG_PUBLISHED + bor ?DFLAG_ATOM_CACHE + bor ?DFLAG_EXTENDED_REFERENCES + bor ?DFLAG_DIST_MONITOR + bor ?DFLAG_FUN_TAGS + bor ?DFLAG_DIST_MONITOR_NAME + bor ?DFLAG_HIDDEN_ATOM_CACHE + bor ?DFLAG_NEW_FUN_TAGS + bor ?DFLAG_EXTENDED_PIDS_PORTS + bor ?DFLAG_EXPORT_PTR_TAG + bor ?DFLAG_BIT_BINARIES + bor ?DFLAG_NEW_FLOATS + bor ?DFLAG_UNICODE_IO + bor ?DFLAG_DIST_HDR_ATOM_CACHE + bor ?DFLAG_SMALL_ATOM_TAGS + bor ?DFLAG_UTF8_ATOMS + bor ?DFLAG_MAP_TAG + bor ?DFLAG_BIG_CREATION + bor ?DFLAG_SEND_SENDER)). diff --git a/lib/kernel/include/dist_util.hrl b/lib/kernel/include/dist_util.hrl index e3d2fe0eb6..eeb0f8dd43 100644 --- a/lib/kernel/include/dist_util.hrl +++ b/lib/kernel/include/dist_util.hrl @@ -29,9 +29,9 @@ -endif. -ifdef(dist_trace). --define(trace(Fmt,Args), io:format("~p ~p:~s",[erlang:timestamp(),node(),lists:flatten(io_lib:format(Fmt, Args))])). +-define(trace(Fmt,Args), io:format("~p ~p:~s",[erlang:convert_time_unit(erlang:monotonic_time()-erlang:system_info(start_time), native, microsecond),node(),lists:flatten(io_lib:format(Fmt, Args))])). % Use the one below for config-file (early boot) connection tracing -%-define(trace(Fmt,Args), erlang:display([erlang:now(),node(),lists:flatten(io_lib:format(Fmt, Args))])). +%-define(trace(Fmt,Args), erlang:display([erlang:convert_time_unit(erlang:monotonic_time()-erlang:system_info(start_time), native, microsecond),node(),lists:flatten(io_lib:format(Fmt, Args))])). -define(trace_factor,8). -else. -define(trace(Fmt,Args), ok). @@ -78,7 +78,13 @@ %% New in kernel-5.1 (OTP 19.1): mf_setopts, %% netkernel:setopts on active connection - mf_getopts %% netkernel:getopts on active connection + mf_getopts, %% netkernel:getopts on active connection + + %% New in kernel-6.0 (OTP 21.0) + f_handshake_complete, %% Notify handshake complete + add_flags, %% dflags to add + reject_flags, %% dflags not to use (not all can be rejected) + require_flags %% dflags that are required }). diff --git a/lib/kernel/src/Makefile b/lib/kernel/src/Makefile index 5946620f0f..4a713b2a99 100644 --- a/lib/kernel/src/Makefile +++ b/lib/kernel/src/Makefile @@ -120,6 +120,13 @@ MODULES = \ user \ user_drv \ user_sup \ + raw_file_io \ + raw_file_io_compressed \ + raw_file_io_inflate \ + raw_file_io_deflate \ + raw_file_io_delayed \ + raw_file_io_list \ + raw_file_io_raw \ wrap_log_reader HRL_FILES= ../include/file.hrl ../include/inet.hrl ../include/inet_sctp.hrl \ @@ -226,7 +233,8 @@ $(EBIN)/disk_log_server.beam: disk_log.hrl $(EBIN)/dist_util.beam: ../include/dist_util.hrl ../include/dist.hrl $(EBIN)/erl_boot_server.beam: inet_boot.hrl $(EBIN)/erl_epmd.beam: inet_int.hrl erl_epmd.hrl -$(EBIN)/file.beam: ../include/file.hrl +$(EBIN)/file.beam: ../include/file.hrl file_int.hrl +$(EBIN)/file_io_server.beam: ../include/file.hrl file_int.hrl $(EBIN)/gen_tcp.beam: inet_int.hrl $(EBIN)/gen_udp.beam: inet_int.hrl $(EBIN)/gen_sctp.beam: ../include/inet_sctp.hrl @@ -254,3 +262,10 @@ $(EBIN)/net_kernel.beam: ../include/net_address.hrl $(EBIN)/os.beam: ../include/file.hrl $(EBIN)/ram_file.beam: ../include/file.hrl $(EBIN)/wrap_log_reader.beam: disk_log.hrl ../include/file.hrl +$(EBIN)/raw_file_io.beam: ../include/file.hrl file_int.hrl +$(EBIN)/raw_file_io_compressed.beam: ../include/file.hrl file_int.hrl +$(EBIN)/raw_file_io_inflate.beam: ../include/file.hrl file_int.hrl +$(EBIN)/raw_file_io_deflate.beam: ../include/file.hrl file_int.hrl +$(EBIN)/raw_file_io_delayed.beam: ../include/file.hrl file_int.hrl +$(EBIN)/raw_file_io_list.beam: ../include/file.hrl file_int.hrl +$(EBIN)/raw_file_io_raw.beam: ../include/file.hrl file_int.hrl diff --git a/lib/kernel/src/dist_util.erl b/lib/kernel/src/dist_util.erl index b3507e5d13..fb9f7fd7eb 100644 --- a/lib/kernel/src/dist_util.erl +++ b/lib/kernel/src/dist_util.erl @@ -74,6 +74,48 @@ ticked = 0 }). +dflag2str(?DFLAG_PUBLISHED) -> + "PUBLISHED"; +dflag2str(?DFLAG_ATOM_CACHE) -> + "ATOM_CACHE"; +dflag2str(?DFLAG_EXTENDED_REFERENCES) -> + "EXTENDED_REFERENCES"; +dflag2str(?DFLAG_DIST_MONITOR) -> + "DIST_MONITOR"; +dflag2str(?DFLAG_FUN_TAGS) -> + "FUN_TAGS"; +dflag2str(?DFLAG_DIST_MONITOR_NAME) -> + "DIST_MONITOR_NAME"; +dflag2str(?DFLAG_HIDDEN_ATOM_CACHE) -> + "HIDDEN_ATOM_CACHE"; +dflag2str(?DFLAG_NEW_FUN_TAGS) -> + "NEW_FUN_TAGS"; +dflag2str(?DFLAG_EXTENDED_PIDS_PORTS) -> + "EXTENDED_PIDS_PORTS"; +dflag2str(?DFLAG_EXPORT_PTR_TAG) -> + "EXPORT_PTR_TAG"; +dflag2str(?DFLAG_BIT_BINARIES) -> + "BIT_BINARIES"; +dflag2str(?DFLAG_NEW_FLOATS) -> + "NEW_FLOATS"; +dflag2str(?DFLAG_UNICODE_IO) -> + "UNICODE_IO"; +dflag2str(?DFLAG_DIST_HDR_ATOM_CACHE) -> + "DIST_HDR_ATOM_CACHE"; +dflag2str(?DFLAG_SMALL_ATOM_TAGS) -> + "SMALL_ATOM_TAGS"; +dflag2str(?DFLAG_UTF8_ATOMS) -> + "UTF8_ATOMS"; +dflag2str(?DFLAG_MAP_TAG) -> + "MAP_TAG"; +dflag2str(?DFLAG_BIG_CREATION) -> + "BIG_CREATION"; +dflag2str(?DFLAG_SEND_SENDER) -> + "SEND_SENDER"; +dflag2str(_) -> + "UNKNOWN". + + remove_flag(Flag, Flags) -> case Flags band Flag of 0 -> @@ -82,13 +124,13 @@ remove_flag(Flag, Flags) -> Flags - Flag end. -adjust_flags(ThisFlags, OtherFlags) -> +adjust_flags(ThisFlags, OtherFlags, RejectFlags) -> case (?DFLAG_PUBLISHED band ThisFlags) band OtherFlags of 0 -> {remove_flag(?DFLAG_PUBLISHED, ThisFlags), remove_flag(?DFLAG_PUBLISHED, OtherFlags)}; _ -> - {ThisFlags, OtherFlags} + {ThisFlags, OtherFlags band (bnot RejectFlags)} end. publish_flag(hidden, _) -> @@ -101,36 +143,71 @@ publish_flag(_, OtherNode) -> 0 end. -make_this_flags(RequestType, OtherNode) -> - publish_flag(RequestType, OtherNode) bor - %% The parenthesis below makes the compiler generate better code. - (?DFLAG_EXPORT_PTR_TAG bor - ?DFLAG_EXTENDED_PIDS_PORTS bor - ?DFLAG_EXTENDED_REFERENCES bor - ?DFLAG_DIST_MONITOR bor - ?DFLAG_FUN_TAGS bor - ?DFLAG_DIST_MONITOR_NAME bor - ?DFLAG_HIDDEN_ATOM_CACHE bor - ?DFLAG_NEW_FUN_TAGS bor - ?DFLAG_BIT_BINARIES bor - ?DFLAG_NEW_FLOATS bor - ?DFLAG_UNICODE_IO bor - ?DFLAG_DIST_HDR_ATOM_CACHE bor - ?DFLAG_SMALL_ATOM_TAGS bor - ?DFLAG_UTF8_ATOMS bor - ?DFLAG_MAP_TAG bor - ?DFLAG_BIG_CREATION). - -handshake_other_started(#hs_data{request_type=ReqType}=HSData0) -> +-define(DFLAGS_REMOVABLE, + (?DFLAG_DIST_HDR_ATOM_CACHE + bor ?DFLAG_HIDDEN_ATOM_CACHE + bor ?DFLAG_ATOM_CACHE)). + +-define(DFLAGS_ADDABLE, + (?DFLAGS_ALL + band (bnot (?DFLAG_PUBLISHED + bor ?DFLAG_HIDDEN_ATOM_CACHE + bor ?DFLAG_ATOM_CACHE)))). + +-define(DFLAGS_THIS_DEFAULT, + (?DFLAG_EXPORT_PTR_TAG + bor ?DFLAG_EXTENDED_PIDS_PORTS + bor ?DFLAG_EXTENDED_REFERENCES + bor ?DFLAG_DIST_MONITOR + bor ?DFLAG_FUN_TAGS + bor ?DFLAG_DIST_MONITOR_NAME + bor ?DFLAG_NEW_FUN_TAGS + bor ?DFLAG_BIT_BINARIES + bor ?DFLAG_NEW_FLOATS + bor ?DFLAG_UNICODE_IO + bor ?DFLAG_DIST_HDR_ATOM_CACHE + bor ?DFLAG_SMALL_ATOM_TAGS + bor ?DFLAG_UTF8_ATOMS + bor ?DFLAG_MAP_TAG + bor ?DFLAG_BIG_CREATION + bor ?DFLAG_SEND_SENDER)). + +make_this_flags(RequestType, AddFlags, RemoveFlags, OtherNode) -> + case RemoveFlags band (bnot ?DFLAGS_REMOVABLE) of + 0 -> ok; + Rerror -> exit({"Rejecting non rejectable flags", Rerror}) + end, + case AddFlags band (bnot ?DFLAGS_ADDABLE) of + 0 -> ok; + Aerror -> exit({"Adding non addable flags", Aerror}) + end, + Flgs0 = ?DFLAGS_THIS_DEFAULT, + Flgs1 = Flgs0 bor publish_flag(RequestType, OtherNode), + Flgs2 = Flgs1 bor AddFlags, + Flgs3 = Flgs2 band (bnot (?DFLAG_HIDDEN_ATOM_CACHE + bor ?DFLAG_ATOM_CACHE)), + Flgs3 band (bnot RemoveFlags). + +handshake_other_started(#hs_data{request_type=ReqType, + add_flags=AddFlgs0, + reject_flags=RejFlgs0, + require_flags=ReqFlgs0}=HSData0) -> + AddFlgs = convert_flags(AddFlgs0), + RejFlgs = convert_flags(RejFlgs0), + ReqFlgs = convert_flags(ReqFlgs0), {PreOtherFlags,Node,Version} = recv_name(HSData0), - PreThisFlags = make_this_flags(ReqType, Node), + PreThisFlags = make_this_flags(ReqType, AddFlgs, RejFlgs, Node), {ThisFlags, OtherFlags} = adjust_flags(PreThisFlags, - PreOtherFlags), + PreOtherFlags, + RejFlgs), HSData = HSData0#hs_data{this_flags=ThisFlags, other_flags=OtherFlags, other_version=Version, other_node=Node, - other_started=true}, + other_started=true, + add_flags=AddFlgs, + reject_flags=RejFlgs, + require_flags=ReqFlgs}, check_dflags(HSData), is_allowed(HSData), ?debug({"MD5 connection from ~p (V~p)~n", @@ -165,23 +242,19 @@ is_allowed(#hs_data{other_node = Node, end. %% -%% Check that both nodes can handle the same types of extended -%% node containers. If they can not, abort the connection. +%% Check mandatory flags... %% check_dflags(#hs_data{other_node = Node, other_flags = OtherFlags, - other_started = OtherStarted} = HSData) -> - - Mandatory = [{?DFLAG_EXTENDED_REFERENCES, "EXTENDED_REFERENCES"}, - {?DFLAG_EXTENDED_PIDS_PORTS, "EXTENDED_PIDS_PORTS"}, - {?DFLAG_UTF8_ATOMS, "UTF8_ATOMS"}], - Missing = lists:filtermap(fun({Bit, Str}) -> - case Bit band OtherFlags of - Bit -> false; - 0 -> {true, Str} - end - end, - Mandatory), + other_started = OtherStarted, + require_flags = RequiredFlags} = HSData) -> + Mandatory = ((?DFLAG_EXTENDED_REFERENCES + bor ?DFLAG_EXTENDED_PIDS_PORTS + bor ?DFLAG_UTF8_ATOMS + bor ?DFLAG_NEW_FUN_TAGS) + bor RequiredFlags), + Missing = check_mandatory(0, ?DFLAGS_ALL, Mandatory, + OtherFlags, []), case Missing of [] -> ok; @@ -201,6 +274,22 @@ check_dflags(#hs_data{other_node = Node, ?shutdown2(Node, {check_dflags_failed, Missing}) end. +check_mandatory(_Bit, 0, _Mandatory, _OtherFlags, Missing) -> + Missing; +check_mandatory(Bit, Left, Mandatory, OtherFlags, Missing) -> + DFlag = (1 bsl Bit), + NewLeft = Left band (bnot DFlag), + NewMissing = case {DFlag band Mandatory, + DFlag band OtherFlags} of + {DFlag, 0} -> + %% Mandatory and missing... + [dflag2str(DFlag) | Missing]; + _ -> + %% Not mandatory or present... + Missing + end, + check_mandatory(Bit+1, NewLeft, Mandatory, OtherFlags, NewMissing). + %% No nodedown will be sent if we fail before this process has %% succeeded to mark the node as pending. @@ -314,13 +403,24 @@ flush_down() -> end. handshake_we_started(#hs_data{request_type=ReqType, - other_node=Node}=PreHSData) -> - PreThisFlags = make_this_flags(ReqType, Node), - HSData = PreHSData#hs_data{this_flags=PreThisFlags}, + other_node=Node, + add_flags=AddFlgs0, + reject_flags=RejFlgs0, + require_flags=ReqFlgs0}=PreHSData) -> + AddFlgs = convert_flags(AddFlgs0), + RejFlgs = convert_flags(RejFlgs0), + ReqFlgs = convert_flags(ReqFlgs0), + PreThisFlags = make_this_flags(ReqType, AddFlgs, RejFlgs, Node), + HSData = PreHSData#hs_data{this_flags = PreThisFlags, + add_flags = AddFlgs, + reject_flags = RejFlgs, + require_flags = ReqFlgs}, send_name(HSData), recv_status(HSData), {PreOtherFlags,ChallengeA} = recv_challenge(HSData), - {ThisFlags,OtherFlags} = adjust_flags(PreThisFlags, PreOtherFlags), + {ThisFlags,OtherFlags} = adjust_flags(PreThisFlags, + PreOtherFlags, + RejFlgs), NewHSData = HSData#hs_data{this_flags = ThisFlags, other_flags = OtherFlags, other_started = false}, @@ -336,15 +436,16 @@ handshake_we_started(#hs_data{request_type=ReqType, handshake_we_started(OldHsData) when element(1,OldHsData) =:= hs_data -> handshake_we_started(convert_old_hsdata(OldHsData)). -convert_old_hsdata({hs_data, KP, ON, TN, S, T, TF, A, OV, OF, OS, FS, FR, - FS_PRE, FS_POST, FG, FA, MFT, MFG, RT}) -> - #hs_data{ - kernel_pid = KP, other_node = ON, this_node = TN, socket = S, timer = T, - this_flags = TF, allowed = A, other_version = OV, other_flags = OF, - other_started = OS, f_send = FS, f_recv = FR, f_setopts_pre_nodeup = FS_PRE, - f_setopts_post_nodeup = FS_POST, f_getll = FG, f_address = FA, - mf_tick = MFT, mf_getstat = MFG, request_type = RT}. +convert_old_hsdata(OldHsData) -> + OHSDL = tuple_to_list(OldHsData), + NoMissing = tuple_size(#hs_data{}) - tuple_size(OldHsData), + true = NoMissing > 0, + list_to_tuple(OHSDL ++ lists:duplicate(NoMissing, undefined)). +convert_flags(Flags) when is_integer(Flags) -> + Flags; +convert_flags(_Undefined) -> + 0. %% -------------------------------------------------------------- %% The connection has been established. @@ -359,15 +460,20 @@ connection(#hs_data{other_node = Node, PType = publish_type(HSData#hs_data.other_flags), case FPreNodeup(Socket) of ok -> - do_setnode(HSData), % Succeeds or exits the process. + DHandle = do_setnode(HSData), % Succeeds or exits the process. Address = FAddress(Socket,Node), mark_nodeup(HSData,Address), case FPostNodeup(Socket) of ok -> + case HSData#hs_data.f_handshake_complete of + undefined -> ok; + HsComplete -> HsComplete(Socket, Node, DHandle) + end, con_loop({HSData#hs_data.kernel_pid, Node, Socket, PType, + DHandle, HSData#hs_data.mf_tick, HSData#hs_data.mf_getstat, HSData#hs_data.mf_setopts, @@ -425,18 +531,16 @@ do_setnode(#hs_data{other_node = Node, socket = Socket, [Node, Port, {publish_type(Flags), '(', Flags, ')', Version}]), - case (catch - erlang:setnode(Node, Port, - {Flags, Version, '', ''})) of - {'EXIT', {system_limit, _}} -> + try + erlang:setnode(Node, Port, {Flags, Version, '', ''}) + catch + error:system_limit -> error_msg("** Distribution system limit reached, " "no table space left for node ~w ** ~n", [Node]), ?shutdown(Node); - {'EXIT', Other} -> - exit(Other); - _Else -> - ok + error:Other -> + exit({Other, erlang:get_stacktrace()}) end; _ -> error_msg("** Distribution connection error, " @@ -468,7 +572,13 @@ mark_nodeup(#hs_data{kernel_pid = Kernel, ?shutdown(Node) end. -con_loop({Kernel, Node, Socket, Type, MFTick, MFGetstat, MFSetOpts, MFGetOpts}=ConData, +getstat(DHandle, _Socket, undefined) -> + erlang:dist_get_stat(DHandle); +getstat(_DHandle, Socket, MFGetstat) -> + MFGetstat(Socket). + +con_loop({Kernel, Node, Socket, Type, DHandle, MFTick, MFGetstat, + MFSetOpts, MFGetOpts}=ConData, Tick) -> receive {tcp_closed, Socket} -> @@ -476,7 +586,7 @@ con_loop({Kernel, Node, Socket, Type, MFTick, MFGetstat, MFSetOpts, MFGetOpts}=C {Kernel, disconnect} -> ?shutdown2(Node, disconnected); {Kernel, aux_tick} -> - case MFGetstat(Socket) of + case getstat(DHandle, Socket, MFGetstat) of {ok, _, _, PendWrite} -> send_tick(Socket, PendWrite, MFTick); _ -> @@ -484,7 +594,7 @@ con_loop({Kernel, Node, Socket, Type, MFTick, MFGetstat, MFSetOpts, MFGetOpts}=C end, con_loop(ConData, Tick); {Kernel, tick} -> - case send_tick(Socket, Tick, Type, + case send_tick(DHandle, Socket, Tick, Type, MFTick, MFGetstat) of {ok, NewTick} -> con_loop(ConData, NewTick); @@ -497,7 +607,7 @@ con_loop({Kernel, Node, Socket, Type, MFTick, MFGetstat, MFSetOpts, MFGetOpts}=C ?shutdown2(Node, send_net_tick_failed) end; {From, get_status} -> - case MFGetstat(Socket) of + case getstat(DHandle, Socket, MFGetstat) of {ok, Read, Write, _} -> From ! {self(), get_status, {ok, Read, Write}}, con_loop(ConData, Tick); @@ -735,14 +845,14 @@ send_status(#hs_data{socket = Socket, other_node = Node, %% we haven't read anything as a hidden node only ticks when it receives %% a TICK !! -send_tick(Socket, Tick, Type, MFTick, MFGetstat) -> +send_tick(DHandle, Socket, Tick, Type, MFTick, MFGetstat) -> #tick{tick = T0, read = Read, write = Write, ticked = Ticked} = Tick, T = T0 + 1, T1 = T rem 4, - case MFGetstat(Socket) of + case getstat(DHandle, Socket, MFGetstat) of {ok, Read, _, _} when Ticked =:= T -> {error, not_responding}; {ok, Read, W, Pend} when Type =:= hidden -> @@ -771,11 +881,10 @@ send_tick(Socket, Tick, Type, MFTick, MFGetstat) -> Error end. -send_tick(Socket, 0, MFTick) -> - MFTick(Socket); -send_tick(_, _Pend, _) -> - %% Dont send tick if pending write. - ok. +send_tick(_, Pend, _) when Pend /= false, Pend /= 0 -> + ok; %% Dont send tick if pending write. +send_tick(Socket, _Pend, MFTick) -> + MFTick(Socket). %% ------------------------------------------------------------ %% Connection setup timeout timer. diff --git a/lib/kernel/src/erl_boot_server.erl b/lib/kernel/src/erl_boot_server.erl index ac81cc9689..2a38266579 100644 --- a/lib/kernel/src/erl_boot_server.erl +++ b/lib/kernel/src/erl_boot_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -253,9 +253,9 @@ handle_info({udp, U, IP, Port, Data}, S0) -> "~w is not a valid address ** ~n", [IP]), {noreply,S0}; {true,_,_} -> - case catch string:substr(Data, 1, length(?EBOOT_REQUEST)) of + case catch string:slice(Data, 0, length(?EBOOT_REQUEST)) of ?EBOOT_REQUEST -> - Vsn = string:substr(Data, length(?EBOOT_REQUEST)+1, length(Data)), + Vsn = string:slice(Data, length(?EBOOT_REQUEST), length(Data)), error_logger:error_msg("** Illegal boot server connection attempt: " "client version is ~s ** ~n", [Vsn]); _ -> diff --git a/lib/kernel/src/erl_epmd.erl b/lib/kernel/src/erl_epmd.erl index 7bc9e2ede3..f96bc88913 100644 --- a/lib/kernel/src/erl_epmd.erl +++ b/lib/kernel/src/erl_epmd.erl @@ -79,7 +79,13 @@ port_please(Node, EpmdAddr, Timeout) -> port_please1(Node,HostName, Timeout) -> - case inet:gethostbyname(HostName, inet, Timeout) of + Family = case inet_db:res_option(inet6) of + true -> + inet6; + false -> + inet + end, + case inet:gethostbyname(HostName, Family, Timeout) of {ok,{hostent, _Name, _ , _Af, _Size, [EpmdAddr | _]}} -> get_port(Node, EpmdAddr, Timeout); Else -> diff --git a/lib/kernel/src/erl_reply.erl b/lib/kernel/src/erl_reply.erl index e1e046cbb4..e1c4ffe839 100644 --- a/lib/kernel/src/erl_reply.erl +++ b/lib/kernel/src/erl_reply.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% Copyright Ericsson AB 1997-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -42,7 +42,7 @@ reply(_) -> %% convert ip number to tuple ip_string_to_tuple(Ip) -> - [Ip1,Ip2,Ip3,Ip4] = string:tokens(Ip,"."), + [Ip1,Ip2,Ip3,Ip4] = string:lexemes(Ip,"."), {list_to_integer(Ip1), list_to_integer(Ip2), list_to_integer(Ip3), diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl index 480db6814e..3456c8511e 100644 --- a/lib/kernel/src/erts_debug.erl +++ b/lib/kernel/src/erts_debug.erl @@ -21,7 +21,7 @@ %% Low-level debugging support. EXPERIMENTAL! --export([size/1,df/1,df/2,df/3,ic/1]). +-export([size/1,df/1,df/2,df/3,dis_to_file/2,ic/1]). %% This module contains the following *experimental* BIFs: %% disassemble/1 @@ -378,16 +378,21 @@ df(Mod, Func, Arity) when is_atom(Mod), is_atom(Func) -> catch _:_ -> {undef,Mod} end. -dff(File, Fs) when is_pid(File), is_list(Fs) -> - lists:foreach(fun(Mfa) -> - disassemble_function(File, Mfa), - io:nl(File) - end, Fs); -dff(Name, Fs) when is_list(Name) -> - case file:open(Name, [write]) of +-spec dis_to_file(module(), file:filename()) -> df_ret(). + +dis_to_file(Mod, Name) when is_atom(Mod) -> + try Mod:module_info(functions) of + Fs0 when is_list(Fs0) -> + Fs = [{Mod,Func,Arity} || {Func,Arity} <- Fs0], + dff(Name, Fs) + catch _:_ -> {undef,Mod} + end. + +dff(Name, Fs) -> + case file:open(Name, [write,raw,delayed_write]) of {ok,F} -> try - dff(F, Fs) + dff_1(F, Fs) after _ = file:close(F) end; @@ -395,12 +400,18 @@ dff(Name, Fs) when is_list(Name) -> {error,{badopen,Reason}} end. +dff_1(File, Fs) -> + lists:foreach(fun(Mfa) -> + disassemble_function(File, Mfa), + file:write(File, "\n") + end, Fs). + disassemble_function(File, {_,_,_}=MFA) -> cont_dis(File, erts_debug:disassemble(MFA), MFA). cont_dis(_, false, _) -> ok; cont_dis(File, {Addr,Str,MFA}, MFA) -> - io:put_chars(File, binary_to_list(Str)), + ok = file:write(File, Str), cont_dis(File, erts_debug:disassemble(Addr), MFA); cont_dis(_, {_,_,_}, _) -> ok. diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl index 933f2d5f65..d05199897f 100644 --- a/lib/kernel/src/file.erl +++ b/lib/kernel/src/file.erl @@ -72,7 +72,7 @@ io_device/0, name/0, name_all/0, posix/0]). %%% Includes and defines --include("file.hrl"). +-include("file_int.hrl"). -define(FILE_IO_SERVER_TABLE, file_io_servers). @@ -454,41 +454,23 @@ raw_write_file_info(Name, #file_info{} = Info) -> Reason :: posix() | badarg | system_limit. open(Item, ModeList) when is_list(ModeList) -> - case lists:member(raw, ModeList) of - %% Raw file, use ?PRIM_FILE to handle this file - true -> + case {lists:member(raw, ModeList), lists:member(ram, ModeList)} of + {false, false} -> + %% File server file Args = [file_name(Item) | ModeList], case check_args(Args) of ok -> [FileName | _] = Args, - %% We rely on the returned Handle (in {ok, Handle}) - %% being a pid() or a #file_descriptor{} - ?PRIM_FILE:open(FileName, ModeList); + call(open, [FileName, ModeList]); Error -> Error - end; - false -> - case lists:member(ram, ModeList) of - %% RAM file, use ?RAM_FILE to handle this file - true -> - case check_args(ModeList) of - ok -> - ?RAM_FILE:open(Item, ModeList); - Error -> - Error - end; - %% File server file - false -> - Args = [file_name(Item) | ModeList], - case check_args(Args) of - ok -> - [FileName | _] = Args, - call(open, [FileName, ModeList]); - Error -> - Error - end - end + end; + {true, _Either} -> + raw_file_io:open(file_name(Item), ModeList); + {false, true} -> + ram_file:open(Item, ModeList) end; + %% Old obsolete mode specification in atom or 2-tuple format open(Item, Mode) -> open(Item, mode_list(Mode)). @@ -1254,15 +1236,18 @@ sendfile(File, _Sock, _Offet, _Bytes, _Opts) when is_pid(File) -> sendfile(File, Sock, Offset, Bytes, []) -> sendfile(File, Sock, Offset, Bytes, ?MAX_CHUNK_SIZE, [], [], []); sendfile(File, Sock, Offset, Bytes, Opts) -> - ChunkSize0 = proplists:get_value(chunk_size, Opts, ?MAX_CHUNK_SIZE), - ChunkSize = if ChunkSize0 > ?MAX_CHUNK_SIZE -> - ?MAX_CHUNK_SIZE; - true -> ChunkSize0 - end, - %% Support for headers, trailers and options has been removed because the - %% Darwin and BSD API for using it does not play nice with - %% non-blocking sockets. See unix_efile.c for more info. - sendfile(File, Sock, Offset, Bytes, ChunkSize, [], [], Opts). + try proplists:get_value(chunk_size, Opts, ?MAX_CHUNK_SIZE) of + ChunkSize0 when is_integer(ChunkSize0) -> + ChunkSize = erlang:min(ChunkSize0, ?MAX_CHUNK_SIZE), + %% Support for headers, trailers and options has been removed + %% because the Darwin and BSD API for using it does not play nice + %% with non-blocking sockets. See unix_efile.c for more info. + sendfile(File, Sock, Offset, Bytes, ChunkSize, [], [], Opts); + _Other -> + {error, badarg} + catch + error:_ -> {error, badarg} + end. %% sendfile/2 -spec sendfile(Filename, Socket) -> diff --git a/lib/compiler/src/v3_life.hrl b/lib/kernel/src/file_int.hrl index 5c76312067..bafc330c04 100644 --- a/lib/compiler/src/v3_life.hrl +++ b/lib/kernel/src/file_int.hrl @@ -1,8 +1,8 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at @@ -14,16 +14,20 @@ %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. -%% +%% %% %CopyrightEnd% %% -%% This record contains variable life-time annotation for a -%% kernel expression. Added by v3_life, used by v3_codegen. --type vdb_entry() :: {atom(),non_neg_integer(),non_neg_integer()}. +%% +%% Internal definitions for the 'file' module and friends. +%% + +-ifndef(FILE_INTERNAL_HRL_). +-define(FILE_INTERNAL_HRL_, 1). + +-include("file.hrl"). --record(l, {ke, %Kernel expression - i=0 :: non_neg_integer(), %Op number - vdb=[] :: [vdb_entry()], %Variable database - a=[] :: [term()]}). %Core annotation +-define(CALL_FD(Fd, Method, Args), + apply(Fd#file_descriptor.module, Method, [Fd | Args])). +-endif. diff --git a/lib/kernel/src/file_io_server.erl b/lib/kernel/src/file_io_server.erl index deb7b315b1..34d5497a4a 100644 --- a/lib/kernel/src/file_io_server.erl +++ b/lib/kernel/src/file_io_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2015. All Rights Reserved. +%% Copyright Ericsson AB 2000-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -28,7 +28,8 @@ -record(state, {handle,owner,mref,buf,read_mode,unic}). --define(PRIM_FILE, prim_file). +-include("file_int.hrl"). + -define(READ_SIZE_LIST, 128). -define(READ_SIZE_BINARY, (8*1024)). @@ -67,8 +68,9 @@ do_start(Spawn, Owner, FileName, ModeList) -> erlang:dt_restore_tag(Utag), %% process_flag(trap_exit, true), case parse_options(ModeList) of - {ReadMode, UnicodeMode, Opts} -> - case ?PRIM_FILE:open(FileName, Opts) of + {ReadMode, UnicodeMode, Opts0} -> + Opts = maybe_add_read_ahead(ReadMode, Opts0), + case raw_file_io:open(FileName, [raw | Opts]) of {error, Reason} = Error -> Self ! {Ref, Error}, exit(Reason); @@ -157,6 +159,24 @@ valid_enc({utf32,little}) -> valid_enc(_Other) -> {error,badarg}. +%% Add a small read_ahead buffer if the file is opened for reading +%% only in list mode and no read_ahead is already given. +maybe_add_read_ahead(binary, Opts) -> + Opts; +maybe_add_read_ahead(list, Opts) -> + P = fun(read_ahead) -> true; + ({read_ahead,_}) -> true; + (append) -> true; + (exclusive) -> true; + (write) -> true; + (_) -> false + end, + case lists:any(P, Opts) of + false -> + [{read_ahead, 4096}|Opts]; + true -> + Opts + end. server_loop(#state{mref = Mref} = State) -> receive @@ -205,7 +225,7 @@ io_reply(From, ReplyAs, Reply) -> file_request({advise,Offset,Length,Advise}, #state{handle=Handle}=State) -> - case ?PRIM_FILE:advise(Handle, Offset, Length, Advise) of + case ?CALL_FD(Handle, advise, [Offset, Length, Advise]) of {error,Reason}=Reply -> {stop,Reason,Reply,State}; Reply -> @@ -213,7 +233,7 @@ file_request({advise,Offset,Length,Advise}, end; file_request({allocate, Offset, Length}, #state{handle = Handle} = State) -> - Reply = ?PRIM_FILE:allocate(Handle, Offset, Length), + Reply = ?CALL_FD(Handle, allocate, [Offset, Length]), {reply, Reply, State}; file_request({pread,At,Sz}, State) when At =:= cur; @@ -256,7 +276,7 @@ file_request({pwrite,At,Data}, end; file_request(datasync, #state{handle=Handle}=State) -> - case ?PRIM_FILE:datasync(Handle) of + case ?CALL_FD(Handle, datasync, []) of {error,Reason}=Reply -> {stop,Reason,Reply,State}; Reply -> @@ -264,7 +284,7 @@ file_request(datasync, end; file_request(sync, #state{handle=Handle}=State) -> - case ?PRIM_FILE:sync(Handle) of + case ?CALL_FD(Handle, sync, []) of {error,Reason}=Reply -> {stop,Reason,Reply,State}; Reply -> @@ -272,7 +292,7 @@ file_request(sync, end; file_request(close, #state{handle=Handle}=State) -> - case ?PRIM_FILE:close(Handle) of + case ?CALL_FD(Handle, close, []) of {error,Reason}=Reply -> {stop,Reason,Reply,State#state{buf= <<>>}}; Reply -> @@ -288,7 +308,7 @@ file_request({position,At}, end; file_request(truncate, #state{handle=Handle}=State) -> - case ?PRIM_FILE:truncate(Handle) of + case ?CALL_FD(Handle, truncate, []) of {error,Reason}=Reply -> {stop,Reason,Reply,State#state{buf= <<>>}}; Reply -> @@ -398,7 +418,7 @@ io_request_loop([Request|Tail], %% put_chars(Chars, latin1, #state{handle=Handle, unic=latin1}=State) -> NewState = State#state{buf = <<>>}, - case ?PRIM_FILE:write(Handle, Chars) of + case ?CALL_FD(Handle, write, [Chars]) of {error,Reason}=Reply -> {stop,Reason,Reply,NewState}; Reply -> @@ -408,7 +428,7 @@ put_chars(Chars, InEncoding, #state{handle=Handle, unic=OutEncoding}=State) -> NewState = State#state{buf = <<>>}, case unicode:characters_to_binary(Chars,InEncoding,OutEncoding) of Bin when is_binary(Bin) -> - case ?PRIM_FILE:write(Handle, Bin) of + case ?CALL_FD(Handle, write, [Bin]) of {error,Reason}=Reply -> {stop,Reason,Reply,NewState}; Reply -> @@ -422,7 +442,7 @@ put_chars(Chars, InEncoding, #state{handle=Handle, unic=OutEncoding}=State) -> get_line(S, {<<>>, Cont}, OutEnc, #state{handle=Handle, read_mode=Mode, unic=InEnc}=State) -> - case ?PRIM_FILE:read(Handle, read_size(Mode)) of + case ?CALL_FD(Handle, read, [read_size(Mode)]) of {ok,Bin} -> get_line(S, convert_enc([Cont, Bin], InEnc, OutEnc), OutEnc, State); eof -> @@ -472,7 +492,7 @@ get_chars(N, OutEnc,#state{handle=Handle,buf=Buf,read_mode=ReadMode,unic=latin1} BufSize = byte_size(Buf), NeedSize = N-BufSize, Size = erlang:max(NeedSize, ?READ_SIZE_BINARY), - case ?PRIM_FILE:read(Handle, Size) of + case ?CALL_FD(Handle, read, [Size]) of {ok, B} -> if BufSize+byte_size(B) < N -> std_reply(cat(Buf, B, ReadMode,latin1,OutEnc), State); @@ -504,7 +524,7 @@ get_chars(N, OutEnc,#state{handle=Handle,buf=Buf,read_mode=ReadMode,unic=InEncod %% Need more, Try to read 4*needed in bytes... NeedSize = (N - BufCount) * 4, Size = erlang:max(NeedSize, ?READ_SIZE_BINARY), - case ?PRIM_FILE:read(Handle, Size) of + case ?CALL_FD(Handle, read, [Size]) of {ok, B} -> NewBuf = list_to_binary([Buf,B]), {NewCount,NewSplit} = count_and_find(NewBuf,N,InEncoding), @@ -544,7 +564,7 @@ get_chars(Mod, Func, XtraArg, OutEnc, #state{buf=Buf}=State) -> get_chars_empty(Mod, Func, XtraArg, S, latin1, #state{handle=Handle,read_mode=ReadMode, unic=latin1}=State) -> - case ?PRIM_FILE:read(Handle, read_size(ReadMode)) of + case ?CALL_FD(Handle, read, [read_size(ReadMode)]) of {ok,Bin} -> get_chars_apply(Mod, Func, XtraArg, S, latin1, State, Bin); eof -> @@ -554,7 +574,7 @@ get_chars_empty(Mod, Func, XtraArg, S, latin1, end; get_chars_empty(Mod, Func, XtraArg, S, OutEnc, #state{handle=Handle,read_mode=ReadMode}=State) -> - case ?PRIM_FILE:read(Handle, read_size(ReadMode)) of + case ?CALL_FD(Handle, read, [read_size(ReadMode)]) of {ok,Bin} -> get_chars_apply(Mod, Func, XtraArg, S, OutEnc, State, Bin); eof -> @@ -564,7 +584,7 @@ get_chars_empty(Mod, Func, XtraArg, S, OutEnc, end. get_chars_notempty(Mod, Func, XtraArg, S, OutEnc, #state{handle=Handle,read_mode=ReadMode,buf = B}=State) -> - case ?PRIM_FILE:read(Handle, read_size(ReadMode)) of + case ?CALL_FD(Handle, read, [read_size(ReadMode)]) of {ok,Bin} -> get_chars_apply(Mod, Func, XtraArg, S, OutEnc, State, list_to_binary([B,Bin])); eof -> @@ -918,13 +938,10 @@ cbv({utf32,little},_) -> %% Compensates ?PRIM_FILE:position/2 for the number of bytes %% we have buffered position(Handle, At, Buf) -> - ?PRIM_FILE:position( - Handle, - case At of - cur -> - {cur, -byte_size(Buf)}; - {cur, Offs} -> - {cur, Offs-byte_size(Buf)}; - _ -> - At - end). + SeekTo = + case At of + {cur, Offs} -> {cur, Offs-byte_size(Buf)}; + cur -> {cur, -byte_size(Buf)}; + _ -> At + end, + ?CALL_FD(Handle, position, [SeekTo]). diff --git a/lib/kernel/src/file_server.erl b/lib/kernel/src/file_server.erl index 6e8f64d932..ecc1ffbdd6 100644 --- a/lib/kernel/src/file_server.erl +++ b/lib/kernel/src/file_server.erl @@ -63,7 +63,7 @@ stop() -> %%% Callback functions from gen_server %%%---------------------------------------------------------------------- --type state() :: port(). % Internal type +-type state() :: term(). % Internal type %%---------------------------------------------------------------------- %% Func: init/1 @@ -77,14 +77,8 @@ stop() -> init([]) -> process_flag(trap_exit, true), - case ?PRIM_FILE:start() of - {ok, Handle} -> - ?FILE_IO_SERVER_TABLE = - ets:new(?FILE_IO_SERVER_TABLE, [named_table]), - {ok, Handle}; - {error, Reason} -> - {stop, Reason} - end. + ?FILE_IO_SERVER_TABLE = ets:new(?FILE_IO_SERVER_TABLE, [named_table]), + {ok, undefined}. %%---------------------------------------------------------------------- %% Func: handle_call/3 @@ -101,7 +95,7 @@ init([]) -> {'reply', 'eof' | 'ok' | {'error', term()} | {'ok', term()}, state()} | {'stop', 'normal', 'stopped', state()}. -handle_call({open, Name, ModeList}, {Pid, _Tag} = _From, Handle) +handle_call({open, Name, ModeList}, {Pid, _Tag} = _From, State) when is_list(ModeList) -> Child = ?FILE_IO_SERVER:start_link(Pid, Name, ModeList), case Child of @@ -110,78 +104,78 @@ handle_call({open, Name, ModeList}, {Pid, _Tag} = _From, Handle) _ -> ok end, - {reply, Child, Handle}; + {reply, Child, State}; -handle_call({open, _Name, _Mode}, _From, Handle) -> - {reply, {error, einval}, Handle}; +handle_call({open, _Name, _Mode}, _From, State) -> + {reply, {error, einval}, State}; -handle_call({read_file, Name}, _From, Handle) -> - {reply, ?PRIM_FILE:read_file(Name), Handle}; +handle_call({read_file, Name}, _From, State) -> + {reply, ?PRIM_FILE:read_file(Name), State}; -handle_call({write_file, Name, Bin}, _From, Handle) -> - {reply, ?PRIM_FILE:write_file(Name, Bin), Handle}; +handle_call({write_file, Name, Bin}, _From, State) -> + {reply, ?PRIM_FILE:write_file(Name, Bin), State}; -handle_call({set_cwd, Name}, _From, Handle) -> - {reply, ?PRIM_FILE:set_cwd(Handle, Name), Handle}; +handle_call({set_cwd, Name}, _From, State) -> + {reply, ?PRIM_FILE:set_cwd(Name), State}; -handle_call({delete, Name}, _From, Handle) -> - {reply, ?PRIM_FILE:delete(Handle, Name), Handle}; +handle_call({delete, Name}, _From, State) -> + {reply, ?PRIM_FILE:delete(Name), State}; -handle_call({rename, Fr, To}, _From, Handle) -> - {reply, ?PRIM_FILE:rename(Handle, Fr, To), Handle}; +handle_call({rename, Fr, To}, _From, State) -> + {reply, ?PRIM_FILE:rename(Fr, To), State}; -handle_call({make_dir, Name}, _From, Handle) -> - {reply, ?PRIM_FILE:make_dir(Handle, Name), Handle}; +handle_call({make_dir, Name}, _From, State) -> + {reply, ?PRIM_FILE:make_dir(Name), State}; -handle_call({del_dir, Name}, _From, Handle) -> - {reply, ?PRIM_FILE:del_dir(Handle, Name), Handle}; +handle_call({del_dir, Name}, _From, State) -> + {reply, ?PRIM_FILE:del_dir(Name), State}; -handle_call({list_dir, Name}, _From, Handle) -> - {reply, ?PRIM_FILE:list_dir(Handle, Name), Handle}; -handle_call({list_dir_all, Name}, _From, Handle) -> - {reply, ?PRIM_FILE:list_dir_all(Handle, Name), Handle}; +handle_call({list_dir, Name}, _From, State) -> + {reply, ?PRIM_FILE:list_dir(Name), State}; +handle_call({list_dir_all, Name}, _From, State) -> + {reply, ?PRIM_FILE:list_dir_all(Name), State}; -handle_call(get_cwd, _From, Handle) -> - {reply, ?PRIM_FILE:get_cwd(Handle), Handle}; -handle_call({get_cwd}, _From, Handle) -> - {reply, ?PRIM_FILE:get_cwd(Handle), Handle}; -handle_call({get_cwd, Name}, _From, Handle) -> - {reply, ?PRIM_FILE:get_cwd(Handle, Name), Handle}; +handle_call(get_cwd, _From, State) -> + {reply, ?PRIM_FILE:get_cwd(), State}; +handle_call({get_cwd}, _From, State) -> + {reply, ?PRIM_FILE:get_cwd(), State}; +handle_call({get_cwd, Name}, _From, State) -> + {reply, ?PRIM_FILE:get_cwd(Name), State}; -handle_call({read_file_info, Name}, _From, Handle) -> - {reply, ?PRIM_FILE:read_file_info(Handle, Name), Handle}; +handle_call({read_file_info, Name}, _From, State) -> + {reply, ?PRIM_FILE:read_file_info(Name), State}; -handle_call({read_file_info, Name, Opts}, _From, Handle) -> - {reply, ?PRIM_FILE:read_file_info(Handle, Name, Opts), Handle}; +handle_call({read_file_info, Name, Opts}, _From, State) -> + {reply, ?PRIM_FILE:read_file_info(Name, Opts), State}; -handle_call({altname, Name}, _From, Handle) -> - {reply, ?PRIM_FILE:altname(Handle, Name), Handle}; +handle_call({altname, Name}, _From, State) -> + {reply, ?PRIM_FILE:altname(Name), State}; -handle_call({write_file_info, Name, Info}, _From, Handle) -> - {reply, ?PRIM_FILE:write_file_info(Handle, Name, Info), Handle}; +handle_call({write_file_info, Name, Info}, _From, State) -> + {reply, ?PRIM_FILE:write_file_info(Name, Info), State}; -handle_call({write_file_info, Name, Info, Opts}, _From, Handle) -> - {reply, ?PRIM_FILE:write_file_info(Handle, Name, Info, Opts), Handle}; +handle_call({write_file_info, Name, Info, Opts}, _From, State) -> + {reply, ?PRIM_FILE:write_file_info(Name, Info, Opts), State}; -handle_call({read_link_info, Name}, _From, Handle) -> - {reply, ?PRIM_FILE:read_link_info(Handle, Name), Handle}; +handle_call({read_link_info, Name}, _From, State) -> + {reply, ?PRIM_FILE:read_link_info(Name), State}; -handle_call({read_link_info, Name, Opts}, _From, Handle) -> - {reply, ?PRIM_FILE:read_link_info(Handle, Name, Opts), Handle}; +handle_call({read_link_info, Name, Opts}, _From, State) -> + {reply, ?PRIM_FILE:read_link_info(Name, Opts), State}; -handle_call({read_link, Name}, _From, Handle) -> - {reply, ?PRIM_FILE:read_link(Handle, Name), Handle}; -handle_call({read_link_all, Name}, _From, Handle) -> - {reply, ?PRIM_FILE:read_link_all(Handle, Name), Handle}; +handle_call({read_link, Name}, _From, State) -> + {reply, ?PRIM_FILE:read_link(Name), State}; +handle_call({read_link_all, Name}, _From, State) -> + {reply, ?PRIM_FILE:read_link_all(Name), State}; -handle_call({make_link, Old, New}, _From, Handle) -> - {reply, ?PRIM_FILE:make_link(Handle, Old, New), Handle}; +handle_call({make_link, Old, New}, _From, State) -> + {reply, ?PRIM_FILE:make_link(Old, New), State}; -handle_call({make_symlink, Old, New}, _From, Handle) -> - {reply, ?PRIM_FILE:make_symlink(Handle, Old, New), Handle}; +handle_call({make_symlink, Old, New}, _From, State) -> + {reply, ?PRIM_FILE:make_symlink(Old, New), State}; handle_call({copy, SourceName, SourceOpts, DestName, DestOpts, Length}, - _From, Handle) -> + _From, State) -> Reply = case ?PRIM_FILE:open(SourceName, [read, binary | SourceOpts]) of {ok, Source} -> @@ -201,14 +195,14 @@ handle_call({copy, SourceName, SourceOpts, DestName, DestOpts, Length}, {error, _} = Error -> Error end, - {reply, Reply, Handle}; + {reply, Reply, State}; -handle_call(stop, _From, Handle) -> - {stop, normal, stopped, Handle}; +handle_call(stop, _From, State) -> + {stop, normal, stopped, State}; -handle_call(Request, From, Handle) -> +handle_call(Request, From, State) -> error_logger:error_msg("handle_call(~tp, ~tp, _)", [Request, From]), - {noreply, Handle}. + {noreply, State}. %%---------------------------------------------------------------------- %% Func: handle_cast/2 @@ -233,14 +227,9 @@ handle_cast(Msg, State) -> -spec handle_info(term(), state()) -> {'noreply', state()} | {'stop', 'normal', state()}. -handle_info({'EXIT', Pid, _Reason}, Handle) when is_pid(Pid) -> +handle_info({'EXIT', Pid, _Reason}, State) when is_pid(Pid) -> ets:delete(?FILE_IO_SERVER_TABLE, Pid), - {noreply, Handle}; - -handle_info({'EXIT', Handle, _Reason}, Handle) -> - error_logger:error_msg("Port controlling ~w terminated in ~w", - [?FILE_SERVER, ?MODULE]), - {stop, normal, Handle}; + {noreply, State}; handle_info(Info, State) -> error_logger:error_msg("handle_Info(~tp, _)", [Info]), @@ -254,8 +243,8 @@ handle_info(Info, State) -> -spec terminate(term(), state()) -> 'ok'. -terminate(_Reason, Handle) -> - ?PRIM_FILE:stop(Handle). +terminate(_Reason, _State) -> + ok. %%---------------------------------------------------------------------- %% Func: code_change/3 diff --git a/lib/kernel/src/group.erl b/lib/kernel/src/group.erl index bf785959ff..e1198d2587 100644 --- a/lib/kernel/src/group.erl +++ b/lib/kernel/src/group.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -261,11 +261,11 @@ io_request({put_chars,latin1,M,F,As}, Drv, From, Buf) -> end; io_request({get_chars,Encoding,Prompt,N}, Drv, _From, Buf) -> - get_chars(Prompt, io_lib, collect_chars, N, Drv, Buf, Encoding); + get_chars_n(Prompt, io_lib, collect_chars, N, Drv, Buf, Encoding); io_request({get_line,Encoding,Prompt}, Drv, _From, Buf) -> - get_chars(Prompt, io_lib, collect_line, [], Drv, Buf, Encoding); + get_chars_line(Prompt, io_lib, collect_line, [], Drv, Buf, Encoding); io_request({get_until,Encoding, Prompt,M,F,As}, Drv, _From, Buf) -> - get_chars(Prompt, io_lib, get_until, {M,F,As}, Drv, Buf, Encoding); + get_chars_line(Prompt, io_lib, get_until, {M,F,As}, Drv, Buf, Encoding); io_request({get_password,_Encoding},Drv,_From,Buf) -> get_password_chars(Drv, Buf); io_request({setopts,Opts}, Drv, _From, Buf) when is_list(Opts) -> @@ -434,7 +434,7 @@ getopts(Drv,Buf) -> {ok,[Exp,Echo,Bin,Uni],Buf}. -%% get_chars(Prompt, Module, Function, XtraArgument, Drv, Buffer) +%% get_chars_*(Prompt, Module, Function, XtraArgument, Drv, Buffer) %% Gets characters from the input Drv until as the applied function %% returns {stop,Result,Rest}. Does not block output until input has been %% received. @@ -452,12 +452,21 @@ get_password_chars(Drv,Buf) -> {exit, terminated} end. -get_chars(Prompt, M, F, Xa, Drv, Buf, Encoding) -> +get_chars_n(Prompt, M, F, Xa, Drv, Buf, Encoding) -> + Pbs = prompt_bytes(Prompt, Encoding), + case get(echo) of + true -> + get_chars_loop(Pbs, M, F, Xa, Drv, Buf, start, Encoding); + false -> + get_chars_n_loop(Pbs, M, F, Xa, Drv, Buf, start, Encoding) + end. + +get_chars_line(Prompt, M, F, Xa, Drv, Buf, Encoding) -> Pbs = prompt_bytes(Prompt, Encoding), get_chars_loop(Pbs, M, F, Xa, Drv, Buf, start, Encoding). get_chars_loop(Pbs, M, F, Xa, Drv, Buf0, State, Encoding) -> - Result = case get(echo) of + Result = case get(echo) of true -> get_line(Buf0, Pbs, Drv, Encoding); false -> @@ -466,8 +475,8 @@ get_chars_loop(Pbs, M, F, Xa, Drv, Buf0, State, Encoding) -> get_line_echo_off(Buf0, Pbs, Drv) end, case Result of - {done,Line,Buf1} -> - get_chars_apply(Pbs, M, F, Xa, Drv, Buf1, State, Line, Encoding); + {done,Line,Buf} -> + get_chars_apply(Pbs, M, F, Xa, Drv, Buf, State, Line, Encoding); interrupted -> {error,{error,interrupted},[]}; terminated -> @@ -476,12 +485,29 @@ get_chars_loop(Pbs, M, F, Xa, Drv, Buf0, State, Encoding) -> get_chars_apply(Pbs, M, F, Xa, Drv, Buf, State0, Line, Encoding) -> case catch M:F(State0, cast(Line,get(read_mode), Encoding), Encoding, Xa) of - {stop,Result,Rest} -> - {ok,Result,append(Rest, Buf, Encoding)}; - {'EXIT',_} -> - {error,{error,err_func(M, F, Xa)},[]}; - State1 -> - get_chars_loop(Pbs, M, F, Xa, Drv, Buf, State1, Encoding) + {stop,Result,Rest} -> + {ok,Result,append(Rest, Buf, Encoding)}; + {'EXIT',_} -> + {error,{error,err_func(M, F, Xa)},[]}; + State1 -> + get_chars_loop(Pbs, M, F, Xa, Drv, Buf, State1, Encoding) + end. + +get_chars_n_loop(Pbs, M, F, Xa, Drv, Buf0, State, Encoding) -> + try M:F(State, cast(Buf0, get(read_mode), Encoding), Encoding, Xa) of + {stop,Result,Rest} -> + {ok, Result, Rest}; + State1 -> + case get_chars_echo_off(Pbs, Drv) of + interrupted -> + {error,{error,interrupted},[]}; + terminated -> + {exit,terminated}; + Buf -> + get_chars_n_loop(Pbs, M, F, Xa, Drv, Buf, State1, Encoding) + end + catch _:_ -> + {error,{error,err_func(M, F, Xa)},[]} end. %% Convert error code to make it look as before @@ -684,6 +710,29 @@ get_line_echo_off1({Chars,[]}, Drv) -> get_line_echo_off1({Chars,Rest}, _Drv) -> {done,lists:reverse(Chars),case Rest of done -> []; _ -> Rest end}. +get_chars_echo_off(Pbs, Drv) -> + send_drv_reqs(Drv, [{put_chars, unicode,Pbs}]), + get_chars_echo_off1(Drv). + +get_chars_echo_off1(Drv) -> + receive + {Drv, {data, Cs}} -> + Cs; + {Drv, eof} -> + eof; + {io_request,From,ReplyAs,Req} when is_pid(From) -> + io_request(Req, From, ReplyAs, Drv, []), + get_chars_echo_off1(Drv); + {reply,{{From,ReplyAs},Reply}} when From =/= undefined -> + %% We take care of replies from puts here as well + io_reply(From, ReplyAs, Reply), + get_chars_echo_off1(Drv); + {'EXIT',Drv,interrupt} -> + interrupted; + {'EXIT',Drv,_} -> + terminated + end. + %% We support line editing for the ICANON mode except the following %% line editing characters, which already has another meaning in %% echo-on mode (See Advanced Programming in the Unix Environment, 2nd ed, @@ -793,9 +842,9 @@ search_up_stack(Stack, Substr) -> case up_stack(Stack) of {none,NewStack} -> {none,NewStack}; {L, NewStack} -> - case string:str(L, Substr) of - 0 -> search_up_stack(NewStack, Substr); - _ -> {string:strip(L,right,$\n), NewStack} + case string:find(L, Substr) of + nomatch -> search_up_stack(NewStack, Substr); + _ -> {string:trim(L, trailing, "$\n"), NewStack} end end. @@ -803,9 +852,9 @@ search_down_stack(Stack, Substr) -> case down_stack(Stack) of {none,NewStack} -> {none,NewStack}; {L, NewStack} -> - case string:str(L, Substr) of - 0 -> search_down_stack(NewStack, Substr); - _ -> {string:strip(L,right,$\n), NewStack} + case string:find(L, Substr) of + nomatch -> search_down_stack(NewStack, Substr); + _ -> {string:trim(L, trailing, "$\n"), NewStack} end end. diff --git a/lib/kernel/src/inet_config.erl b/lib/kernel/src/inet_config.erl index 4bbc520449..9f76360b8b 100644 --- a/lib/kernel/src/inet_config.erl +++ b/lib/kernel/src/inet_config.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% Copyright Ericsson AB 1997-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -369,7 +369,7 @@ win32_load1(Reg,Type,HFileKey) -> end. win32_split_line(Line,nt) -> inet_parse:split_line(Line); -win32_split_line(Line,windows) -> string:tokens(Line, ","). +win32_split_line(Line,windows) -> string:lexemes(Line, ","). win32_get_strings(Reg, Names) -> win32_get_strings(Reg, Names, []). diff --git a/lib/kernel/src/inet_dns.erl b/lib/kernel/src/inet_dns.erl index d5f982cc51..f1f58bc872 100644 --- a/lib/kernel/src/inet_dns.erl +++ b/lib/kernel/src/inet_dns.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% Copyright Ericsson AB 1997-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -29,7 +29,7 @@ -export([decode/1, encode/1]). --import(lists, [reverse/1, reverse/2, nthtail/2]). +-import(lists, [reverse/1]). -include("inet_int.hrl"). -include("inet_dns.hrl"). @@ -473,7 +473,7 @@ decode_data(<<Order:16,Preference:16,Data0/binary>>, _, ?S_NAPTR, Buffer) -> {Data2,Services} = decode_string(Data1), {Data,Regexp} = decode_characters(Data2, utf8), Replacement = decode_domain(Data, Buffer), - {Order,Preference,string:to_lower(Flags),string:to_lower(Services), + {Order,Preference,string:lowercase(Flags),string:lowercase(Services), Regexp,Replacement}; %% ?S_OPT falls through to default decode_data(Data, _, ?S_TXT, _) -> diff --git a/lib/kernel/src/inet_int.hrl b/lib/kernel/src/inet_int.hrl index bc5b67f7bf..357e27826c 100644 --- a/lib/kernel/src/inet_int.hrl +++ b/lib/kernel/src/inet_int.hrl @@ -100,6 +100,8 @@ -define(TCP_REQ_RECV, 42). -define(TCP_REQ_UNRECV, 43). -define(TCP_REQ_SHUTDOWN, 44). +-define(TCP_REQ_SENDFILE, 45). + %% UDP and SCTP requests -define(PACKET_REQ_RECV, 60). %%-define(SCTP_REQ_LISTEN, 61). MERGED @@ -319,6 +321,12 @@ [((X) bsr 24) band 16#ff, ((X) bsr 16) band 16#ff, ((X) bsr 8) band 16#ff, (X) band 16#ff]). +-define(int64(X), + [((X) bsr 56) band 16#ff, ((X) bsr 48) band 16#ff, + ((X) bsr 40) band 16#ff, ((X) bsr 32) band 16#ff, + ((X) bsr 24) band 16#ff, ((X) bsr 16) band 16#ff, + ((X) bsr 8) band 16#ff, (X) band 16#ff]). + -define(intAID(X), % For SCTP AssocID ?int32(X)). diff --git a/lib/kernel/src/inet_parse.erl b/lib/kernel/src/inet_parse.erl index 29804dc50b..e9685c6554 100644 --- a/lib/kernel/src/inet_parse.erl +++ b/lib/kernel/src/inet_parse.erl @@ -95,7 +95,7 @@ hosts(Fname,File) -> %% interface with a %if suffix. These kind of %% addresses maybe need to be gracefully handled %% throughout inet* and inet_drv. - case string:tokens(Address, "%") of + case string:lexemes(Address, "%") of [Addr,_] -> {ok,_} = address(Addr), skip; @@ -407,7 +407,7 @@ is_dom1([C | Cs]) when C >= $a, C =< $z -> is_dom_ldh(Cs); is_dom1([C | Cs]) when C >= $A, C =< $Z -> is_dom_ldh(Cs); is_dom1([C | Cs]) when C >= $0, C =< $9 -> case is_dom_ldh(Cs) of - true -> is_dom2(string:tokens([C | Cs],".")); + true -> is_dom2(string:lexemes([C | Cs],".")); false -> false end; is_dom1(_) -> false. diff --git a/lib/kernel/src/inet_res.erl b/lib/kernel/src/inet_res.erl index 90e49ddfdf..49aa5f8bda 100644 --- a/lib/kernel/src/inet_res.erl +++ b/lib/kernel/src/inet_res.erl @@ -859,15 +859,17 @@ query_ns(S0, Id, Buffer, IP, Port, Timer, Retry, I, {ok,S} -> Timeout = inet:timeout( (Tm * (1 bsl I)) div Retry, Timer), - {S, case query_udp( S, Id, Buffer, IP, Port, Timeout, Verbose) of {ok,#dns_rec{header=H}} when H#dns_header.tc -> TcpTimeout = inet:timeout(Tm*5, Timer), - query_tcp( - TcpTimeout, Id, Buffer, IP, Port, Verbose); - Reply -> Reply - end}; + {S, query_tcp( + TcpTimeout, Id, Buffer, IP, Port, Verbose)}; + {error, econnrefused} = Err -> + ok = udp_close(S), + {#sock{}, Err}; + Reply -> {S, Reply} + end; Error -> {S0,Error} end diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src index 2a88cc7e26..e4852a6e75 100644 --- a/lib/kernel/src/kernel.app.src +++ b/lib/kernel/src/kernel.app.src @@ -88,6 +88,13 @@ inet_udp, inet_sctp, pg2, + raw_file_io, + raw_file_io_compressed, + raw_file_io_deflate, + raw_file_io_delayed, + raw_file_io_inflate, + raw_file_io_list, + raw_file_io_raw, seq_trace, standard_error, wrap_log_reader]}, @@ -120,6 +127,6 @@ {applications, []}, {env, [{error_logger, tty}]}, {mod, {kernel, []}}, - {runtime_dependencies, ["erts-9.1", "stdlib-3.4", "sasl-3.0"]} + {runtime_dependencies, ["erts-10.0", "stdlib-3.5", "sasl-3.0"]} ] }. diff --git a/lib/kernel/src/kernel.appup.src b/lib/kernel/src/kernel.appup.src index f1ef70a373..4ee497bbbd 100644 --- a/lib/kernel/src/kernel.appup.src +++ b/lib/kernel/src/kernel.appup.src @@ -18,7 +18,9 @@ %% %CopyrightEnd% {"%VSN%", %% Up from - max one major revision back - [{<<"5\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-19.*, OTP-20.0 + [{<<"5\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.*, OTP-20.0 + {<<"5\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-20.1+ %% Down to - max one major revision back - [{<<"5\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-19.*, OTP-20.0 + [{<<"5\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.*, OTP-20.0 + {<<"5\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-20.1+ }. diff --git a/lib/kernel/src/net_kernel.erl b/lib/kernel/src/net_kernel.erl index 7da89dd7cb..cdb10a7b12 100644 --- a/lib/kernel/src/net_kernel.erl +++ b/lib/kernel/src/net_kernel.erl @@ -70,8 +70,8 @@ protocol_childspecs/0, epmd_module/0]). --export([connect/1, disconnect/1, hidden_connect/1, passive_cnct/1]). --export([hidden_connect_node/1]). %% explicit connect +-export([disconnect/1, passive_cnct/1]). +-export([hidden_connect_node/1]). -export([set_net_ticktime/1, set_net_ticktime/2, get_net_ticktime/0]). -export([node_info/1, node_info/2, nodes_info/0, @@ -122,6 +122,7 @@ -record(connection, { node, %% remote node name + conn_id, %% Connection identity state, %% pending | up | up_pending owner, %% owner pid pending_owner, %% possible new owner @@ -247,14 +248,15 @@ ticktime_res(A) when is_atom(A) -> A. %% Called though BIF's -connect(Node) -> do_connect(Node, normal, false). %%% Long timeout if blocked (== barred), only affects nodes with %%% {dist_auto_connect, once} set. -passive_cnct(Node) -> do_connect(Node, normal, true). -disconnect(Node) -> request({disconnect, Node}). +passive_cnct(Node) -> + case request({passive_cnct, Node}) of + ignored -> false; + Other -> Other + end. -%% connect but not seen -hidden_connect(Node) -> do_connect(Node, hidden, false). +disconnect(Node) -> request({disconnect, Node}). %% Should this node publish itself on Node? publish_on_node(Node) when is_atom(Node) -> @@ -272,67 +274,30 @@ connect_node(Node) when is_atom(Node) -> hidden_connect_node(Node) when is_atom(Node) -> request({connect, hidden, Node}). -do_connect(Node, Type, WaitForBarred) -> %% Type = normal | hidden - case catch ets:lookup(sys_dist, Node) of - {'EXIT', _} -> - ?connect_failure(Node,{table_missing, sys_dist}), - false; - [#barred_connection{}] -> - case WaitForBarred of - false -> - false; - true -> - Pid = spawn(?MODULE,passive_connect_monitor,[self(),Node]), - receive - {Pid, true} -> - %%io:format("Net Kernel: barred connection (~p) " - %% "connected from other end.~n",[Node]), - true; - {Pid, false} -> - ?connect_failure(Node,{barred_connection, - ets:lookup(sys_dist, Node)}), - %%io:format("Net Kernel: barred connection (~p) " - %% "- failure.~n",[Node]), - false - end - end; - Else -> - case application:get_env(kernel, dist_auto_connect) of - {ok, never} -> - ?connect_failure(Node,{dist_auto_connect,never}), - false; - % This might happen due to connection close - % not beeing propagated to user space yet. - % Save the day by just not connecting... - {ok, once} when Else =/= [], - (hd(Else))#connection.state =:= up -> - ?connect_failure(Node,{barred_connection, - ets:lookup(sys_dist, Node)}), - false; - _ -> - request({connect, Type, Node}) - end - end. -passive_connect_monitor(Parent, Node) -> +passive_connect_monitor(From, Node) -> ok = monitor_nodes(true,[{node_type,all}]), - case lists:member(Node,nodes([connected])) of - true -> - ok = monitor_nodes(false,[{node_type,all}]), - Parent ! {self(),true}; - _ -> - Ref = make_ref(), - Tref = erlang:send_after(connecttime(),self(),Ref), - receive - Ref -> - ok = monitor_nodes(false,[{node_type,all}]), - Parent ! {self(), false}; - {nodeup,Node,_} -> - ok = monitor_nodes(false,[{node_type,all}]), - _ = erlang:cancel_timer(Tref), - Parent ! {self(),true} - end - end. + Reply = case lists:member(Node,nodes([connected])) of + true -> + io:format("~p: passive_connect_monitor ~p\n", [self(), ?LINE]), + true; + _ -> + receive + {nodeup,Node,_} -> + io:format("~p: passive_connect_monitor ~p\n", [self(), ?LINE]), + true + after connecttime() -> + io:format("~p: passive_connect_monitor ~p\n", [self(), ?LINE]), + false + end + end, + ok = monitor_nodes(false,[{node_type,all}]), + io:format("~p: passive_connect_monitor ~p\n", [self(), ?LINE]), + {Pid, Tag} = From, + io:format("~p: passive_connect_monitor ~p\n", [self(), ?LINE]), + erlang:send(Pid, {Tag, Reply}), + io:format("~p: passive_connect_monitor ~p\n", [self(), ?LINE]). + %% If the net_kernel isn't running we ignore all requests to the %% kernel, thus basically accepting them :-) @@ -394,40 +359,135 @@ init({Name, LongOrShortNames, TickT, CleanHalt}) -> end. +do_auto_connect(Type, Node, ConnId, WaitForBarred, From, State) -> + ConnLookup = ets:lookup(sys_dist, Node), + + case ConnLookup of + [#barred_connection{}] -> + case WaitForBarred of + false -> + {reply, false, State}; + true -> + spawn(?MODULE,passive_connect_monitor,[From,Node]), + {noreply, State} + end; + + [#connection{conn_id=ConnId, state = up}] -> + {reply, true, State}; + [#connection{conn_id=ConnId, waiting=Waiting}=Conn] -> + case From of + noreply -> ok; + _ -> ets:insert(sys_dist, Conn#connection{waiting = [From|Waiting]}) + end, + {noreply, State}; + + _ -> + case application:get_env(kernel, dist_auto_connect) of + {ok, never} -> + ?connect_failure(Node,{dist_auto_connect,never}), + {reply, false, State}; + + %% This might happen due to connection close + %% not beeing propagated to user space yet. + %% Save the day by just not connecting... + {ok, once} when ConnLookup =/= [], + (hd(ConnLookup))#connection.state =:= up -> + ?connect_failure(Node,{barred_connection, + ets:lookup(sys_dist, Node)}), + {reply, false, State}; + _ -> + case setup(ConnLookup, Node,ConnId,Type,From,State) of + {ok, SetupPid} -> + Owners = [{SetupPid, Node} | State#state.conn_owners], + {noreply,State#state{conn_owners=Owners}}; + _Error -> + ?connect_failure(Node, {setup_call, failed, _Error}), + {reply, false, State} + end + end + end. + + +do_explicit_connect([#connection{conn_id = ConnId, state = up}], _, _, ConnId, _From, State) -> + {reply, true, State}; +do_explicit_connect([#connection{conn_id = ConnId}=Conn], _, _, ConnId, From, State) + when Conn#connection.state =:= pending; + Conn#connection.state =:= up_pending -> + Waiting = Conn#connection.waiting, + ets:insert(sys_dist, Conn#connection{waiting = [From|Waiting]}), + {noreply, State}; +do_explicit_connect([#barred_connection{}], Type, Node, ConnId, From , State) -> + %% Barred connection only affects auto_connect, ignore it. + do_explicit_connect([], Type, Node, ConnId, From , State); +do_explicit_connect(ConnLookup, Type, Node, ConnId, From , State) -> + case setup(ConnLookup, Node,ConnId,Type,From,State) of + {ok, SetupPid} -> + Owners = [{SetupPid, Node} | State#state.conn_owners], + {noreply,State#state{conn_owners=Owners}}; + _Error -> + ?connect_failure(Node, {setup_call, failed, _Error}), + {reply, false, State} + end. + +-define(ERTS_DIST_CON_ID_MASK, 16#ffffff). % also in external.h + +verify_new_conn_id([], {Nr,_DHandle}) + when (Nr band (bnot ?ERTS_DIST_CON_ID_MASK)) =:= 0 -> + true; +verify_new_conn_id([#connection{conn_id = {Old,_}}], {New,_}) + when New =:= ((Old+1) band ?ERTS_DIST_CON_ID_MASK) -> + true; +verify_new_conn_id(_, _) -> + false. + + + %% ------------------------------------------------------------ %% handle_call. %% ------------------------------------------------------------ %% -%% Set up a connection to Node. -%% The response is delayed until the connection is up and -%% running. +%% Passive auto-connect to Node. +%% The response is delayed until the connection is up and running. %% -handle_call({connect, _, Node}, From, State) when Node =:= node() -> +handle_call({passive_cnct, Node}, From, State) when Node =:= node() -> + async_reply({reply, true, State}, From); +handle_call({passive_cnct, Node}, From, State) -> + verbose({passive_cnct, Node}, 1, State), + Type = normal, + WaitForBarred = true, + R = case (catch erts_internal:new_connection(Node)) of + {Nr,_DHandle}=ConnId when is_integer(Nr) -> + do_auto_connect(Type, Node, ConnId, WaitForBarred, From, State); + + _Error -> + error_logger:error_msg("~n** Cannot get connection id for node ~w~n", + [Node]), + {reply, false, State} + end, + + return_call(R, From); + +%% +%% Explicit connect +%% The response is delayed until the connection is up and running. +%% +handle_call({connect, _, Node, _, _}, From, State) when Node =:= node() -> async_reply({reply, true, State}, From); handle_call({connect, Type, Node}, From, State) -> verbose({connect, Type, Node}, 1, State), - case ets:lookup(sys_dist, Node) of - [Conn] when Conn#connection.state =:= up -> - async_reply({reply, true, State}, From); - [Conn] when Conn#connection.state =:= pending -> - Waiting = Conn#connection.waiting, - ets:insert(sys_dist, Conn#connection{waiting = [From|Waiting]}), - {noreply, State}; - [Conn] when Conn#connection.state =:= up_pending -> - Waiting = Conn#connection.waiting, - ets:insert(sys_dist, Conn#connection{waiting = [From|Waiting]}), - {noreply, State}; - _ -> - case setup(Node,Type,From,State) of - {ok, SetupPid} -> - Owners = [{SetupPid, Node} | State#state.conn_owners], - {noreply,State#state{conn_owners=Owners}}; - _ -> - ?connect_failure(Node, {setup_call, failed}), - async_reply({reply, false, State}, From) - end - end; + ConnLookup = ets:lookup(sys_dist, Node), + R = case (catch erts_internal:new_connection(Node)) of + {Nr,_DHandle}=ConnId when is_integer(Nr) -> + do_explicit_connect(ConnLookup, Type, Node, ConnId, From, State); + + _Error -> + error_logger:error_msg("~n** Cannot get connection id for node ~w~n", + [Node]), + {reply, false, State} + end, + return_call(R, From); + %% %% Close the connection to Node. @@ -634,6 +694,26 @@ terminate(_Reason, State) -> %% ------------------------------------------------------------ %% +%% Asynchronous auto connect request +%% +handle_info({auto_connect,Node, Nr, DHandle}, State) -> + verbose({auto_connect, Node, Nr, DHandle}, 1, State), + ConnId = {Nr, DHandle}, + NewState = + case do_auto_connect(normal, Node, ConnId, false, noreply, State) of + {noreply, S} -> %% Pending connection + S; + + {reply, true, S} -> %% Already connected + S; + + {reply, false, S} -> %% Connection refused + erts_internal:abort_connection(Node, ConnId), + S + end, + {noreply, NewState}; + +%% %% accept a new connection. %% handle_info({accept,AcceptPid,Socket,Family,Proto}, State) -> @@ -713,14 +793,23 @@ handle_info({AcceptPid, {accept_pending,MyNode,Node,Address,Type}}, State) -> AcceptPid ! {self(), {accept_pending, already_pending}}, {noreply, State}; _ -> - ets:insert(sys_dist, #connection{node = Node, - state = pending, - owner = AcceptPid, - address = Address, - type = Type}), - AcceptPid ! {self(),{accept_pending,ok}}, - Owners = [{AcceptPid,Node} | State#state.conn_owners], - {noreply, State#state{conn_owners = Owners}} + case (catch erts_internal:new_connection(Node)) of + {Nr,_DHandle}=ConnId when is_integer(Nr) -> + ets:insert(sys_dist, #connection{node = Node, + conn_id = ConnId, + state = pending, + owner = AcceptPid, + address = Address, + type = Type}), + AcceptPid ! {self(),{accept_pending,ok}}, + Owners = [{AcceptPid,Node} | State#state.conn_owners], + {noreply, State#state{conn_owners = Owners}}; + + _ -> + error_logger:error_msg("~n** Cannot get connection id for node ~w~n", + [Node]), + AcceptPid ! {self(),{accept_pending,nok_pending}} + end end; handle_info({SetupPid, {is_pending, Node}}, State) -> @@ -906,6 +995,7 @@ pending_nodedown(Conn, Node, Type, State) -> % Don't bar connections that have never been alive %mark_sys_dist_nodedown(Node), % - instead just delete the node: + erts_internal:abort_connection(Node, Conn#connection.conn_id), ets:delete(sys_dist, Node), reply_waiting(Node,Conn#connection.waiting, false), case Type of @@ -920,7 +1010,9 @@ up_pending_nodedown(Conn, Node, _Reason, _Type, State) -> AcceptPid = Conn#connection.pending_owner, Owners = State#state.conn_owners, Pend = lists:keydelete(AcceptPid, 1, State#state.pend_owners), + erts_internal:abort_connection(Node, Conn#connection.conn_id), Conn1 = Conn#connection { owner = AcceptPid, + conn_id = erts_internal:new_connection(Node), pending_owner = undefined, state = pending }, ets:insert(sys_dist, Conn1), @@ -928,15 +1020,16 @@ up_pending_nodedown(Conn, Node, _Reason, _Type, State) -> State#state{conn_owners = [{AcceptPid,Node}|Owners], pend_owners = Pend}. -up_nodedown(_Conn, Node, _Reason, Type, State) -> - mark_sys_dist_nodedown(Node), +up_nodedown(Conn, Node, _Reason, Type, State) -> + mark_sys_dist_nodedown(Conn, Node), case Type of normal -> ?nodedown(Node, State); _ -> ok end, State. -mark_sys_dist_nodedown(Node) -> +mark_sys_dist_nodedown(Conn, Node) -> + erts_internal:abort_connection(Node, Conn#connection.conn_id), case application:get_env(kernel, dist_auto_connect) of {ok, once} -> ets:insert(sys_dist, #barred_connection{node = Node}); @@ -1179,15 +1272,8 @@ spawn_func(_,{From,Tag},M,F,A,Gleader) -> %% Set up connection to a new node. %% ----------------------------------------------------------- -setup(Node,Type,From,State) -> - Allowed = State#state.allowed, - case lists:member(Node, Allowed) of - false when Allowed =/= [] -> - error_msg("** Connection attempt with " - "disallowed node ~w ** ~n", [Node]), - {error, bad_node}; - _ -> - case select_mod(Node, State#state.listen) of +setup(ConnLookup, Node,ConnId,Type,From,State) -> + case setup_check(ConnLookup, Node, ConnId, State) of {ok, L} -> Mod = L#listen.module, LAddr = L#listen.address, @@ -1200,18 +1286,45 @@ setup(Node,Type,From,State) -> Addr = LAddr#net_address { address = undefined, host = undefined }, + Waiting = case From of + noreply -> []; + _ -> [From] + end, ets:insert(sys_dist, #connection{node = Node, + conn_id = ConnId, state = pending, owner = Pid, - waiting = [From], + waiting = Waiting, address = Addr, type = normal}), {ok, Pid}; Error -> Error - end end. +setup_check(ConnLookup, Node, ConnId, State) -> + Allowed = State#state.allowed, + case lists:member(Node, Allowed) of + false when Allowed =/= [] -> + error_msg("** Connection attempt with " + "disallowed node ~w ** ~n", [Node]), + {error, bad_node}; + _ -> + case verify_new_conn_id(ConnLookup, ConnId) of + false -> + error_msg("** Connection attempt to ~w with " + "bad connection id ~w ** ~n", [Node, ConnId]), + {error, bad_conn_id}; + true -> + case select_mod(Node, State#state.listen) of + {ok, _L}=OK -> OK; + Error -> Error + end + end + end. + + + %% %% Find a module that is willing to handle connection setup to Node %% @@ -1652,6 +1765,11 @@ verbose(_, _, _) -> getnode(P) when is_pid(P) -> node(P); getnode(P) -> P. +return_call({noreply, _State}=R, _From) -> + R; +return_call(R, From) -> + async_reply(R, From). + async_reply({reply, Msg, State}, From) -> async_gen_server_reply(From, Msg), {noreply, State}. diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl index c2efab1ef5..b5f19d4b99 100644 --- a/lib/kernel/src/os.erl +++ b/lib/kernel/src/os.erl @@ -21,10 +21,12 @@ %% Provides a common operating system interface. --export([type/0, version/0, cmd/1, cmd/2, find_executable/1, find_executable/2]). +-export([type/0, version/0, cmd/1, find_executable/1, find_executable/2]). -include("file.hrl"). +-export_type([env_var_name/0, env_var_value/0, env_var_name_value/0, command_input/0]). + %%% BIFs -export([getenv/0, getenv/1, getenv/2, getpid/0, @@ -32,26 +34,29 @@ putenv/2, set_signal/2, system_time/0, system_time/1, timestamp/0, unsetenv/1]). --type os_command() :: atom() | io_lib:chars(). --type os_command_opts() :: #{ max_size => non_neg_integer() | infinity }. +-type env_var_name() :: nonempty_string(). + +-type env_var_value() :: string(). + +-type env_var_name_value() :: nonempty_string(). --export_type([os_command/0, os_command_opts/0]). +-type command_input() :: atom() | io_lib:chars(). --spec getenv() -> [string()]. +-spec getenv() -> [env_var_name_value()]. getenv() -> erlang:nif_error(undef). -spec getenv(VarName) -> Value | false when - VarName :: string(), - Value :: string(). + VarName :: env_var_name(), + Value :: env_var_value(). getenv(_) -> erlang:nif_error(undef). -spec getenv(VarName, DefaultValue) -> Value when - VarName :: string(), - DefaultValue :: string(), - Value :: string(). + VarName :: env_var_name(), + DefaultValue :: env_var_value(), + Value :: env_var_value(). getenv(VarName, DefaultValue) -> case os:getenv(VarName) of @@ -80,8 +85,8 @@ perf_counter(Unit) -> erlang:convert_time_unit(os:perf_counter(), perf_counter, Unit). -spec putenv(VarName, Value) -> true when - VarName :: string(), - Value :: string(). + VarName :: env_var_name(), + Value :: env_var_value(). putenv(_, _) -> erlang:nif_error(undef). @@ -104,7 +109,7 @@ timestamp() -> erlang:nif_error(undef). -spec unsetenv(VarName) -> true when - VarName :: string(). + VarName :: env_var_name(). unsetenv(_) -> erlang:nif_error(undef). @@ -183,7 +188,7 @@ verify_executable(Name0, [Ext|Rest], OrigExtensions) -> end; verify_executable(Name, [], OrigExtensions) when OrigExtensions =/= [""] -> %% Windows %% Will only happen on windows, hence case insensitivity - case can_be_full_name(string:to_lower(Name),OrigExtensions) of + case can_be_full_name(string:lowercase(Name),OrigExtensions) of true -> verify_executable(Name,[""],[""]); _ -> @@ -237,21 +242,14 @@ extensions() -> %% Executes the given command in the default shell for the operating system. -spec cmd(Command) -> string() when - Command :: os_command(). + Command :: os:command_input(). cmd(Cmd) -> - cmd(Cmd, #{ }). - --spec cmd(Command, Options) -> string() when - Command :: os_command(), - Options :: os_command_opts(). -cmd(Cmd, Opts) -> - validate(Cmd), - {SpawnCmd, SpawnOpts, SpawnInput, Eot} = mk_cmd(os:type(), Cmd), + {SpawnCmd, SpawnOpts, SpawnInput, Eot} = mk_cmd(os:type(), validate(Cmd)), Port = open_port({spawn, SpawnCmd}, [binary, stderr_to_stdout, stream, in, hide | SpawnOpts]), MonRef = erlang:monitor(port, Port), true = port_command(Port, SpawnInput), - Bytes = get_data(Port, MonRef, Eot, [], 0, maps:get(max_size, Opts, infinity)), + Bytes = get_data(Port, MonRef, Eot, []), demonitor(MonRef, [flush]), String = unicode:characters_to_list(Bytes), if %% Convert to unicode list if possible otherwise return bytes @@ -266,8 +264,6 @@ mk_cmd({win32,Wtype}, Cmd) -> {Cspec,_} -> lists:concat([Cspec," /c",Cmd]) end, {Command, [], [], <<>>}; -mk_cmd(OsType,Cmd) when is_atom(Cmd) -> - mk_cmd(OsType, atom_to_list(Cmd)); mk_cmd(_,Cmd) -> %% Have to send command in like this in order to make sh commands like %% cd and ulimit available @@ -290,25 +286,40 @@ mk_cmd(_,Cmd) -> <<$\^D>>}. validate(Atom) when is_atom(Atom) -> - ok; + validate(atom_to_list(Atom)); validate(List) when is_list(List) -> - validate1(List). + case validate1(List) of + false -> + List; + true -> + %% Had zeros at end; remove them... + string:trim(List, trailing, [0]) + end. -validate1([C|Rest]) when is_integer(C) -> +validate1([0|Rest]) -> + validate2(Rest); +validate1([C|Rest]) when is_integer(C), C > 0 -> validate1(Rest); validate1([List|Rest]) when is_list(List) -> - validate1(List), - validate1(Rest); + validate1(List) or validate1(Rest); validate1([]) -> - ok. + false. + +%% Ensure that the rest is zero only... +validate2([]) -> + true; +validate2([0|Rest]) -> + validate2(Rest); +validate2([List|Rest]) when is_list(List) -> + validate2(List), + validate2(Rest). -get_data(Port, MonRef, Eot, Sofar, Size, Max) -> +get_data(Port, MonRef, Eot, Sofar) -> receive {Port, {data, Bytes}} -> - case eot(Bytes, Eot, Size, Max) of + case eot(Bytes, Eot) of more -> - get_data(Port, MonRef, Eot, [Sofar, Bytes], - Size + size(Bytes), Max); + get_data(Port, MonRef, Eot, [Sofar,Bytes]); Last -> catch port_close(Port), flush_until_down(Port, MonRef), @@ -319,16 +330,13 @@ get_data(Port, MonRef, Eot, Sofar, Size, Max) -> iolist_to_binary(Sofar) end. -eot(_Bs, <<>>, _Size, _Max) -> +eot(_Bs, <<>>) -> more; -eot(Bs, Eot, Size, Max) -> +eot(Bs, Eot) -> case binary:match(Bs, Eot) of - nomatch when Size + size(Bs) < Max -> - more; - {Pos, _} when Size + Pos < Max -> - binary:part(Bs,{0, Pos}); - _ -> - binary:part(Bs,{0, Max - Size}) + nomatch -> more; + {Pos, _} -> + binary:part(Bs,{0, Pos}) end. %% When port_close returns we know that all the diff --git a/lib/kernel/src/raw_file_io.erl b/lib/kernel/src/raw_file_io.erl new file mode 100644 index 0000000000..e3c07c8f78 --- /dev/null +++ b/lib/kernel/src/raw_file_io.erl @@ -0,0 +1,75 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(raw_file_io). + +-export([open/2]). + +open(Filename, Modes) -> + %% Layers are applied in this order, and the listed modules will call this + %% function again as necessary. eg. a raw compressed delayed file in list + %% mode will walk through [_list -> _compressed -> _delayed -> _raw]. + ModuleOrder = [{raw_file_io_list, fun match_list/1}, + {raw_file_io_compressed, fun match_compressed/1}, + {raw_file_io_delayed, fun match_delayed/1}, + {raw_file_io_raw, fun match_raw/1}], + open_1(ModuleOrder, Filename, add_implicit_modes(Modes)). +open_1([], _Filename, _Modes) -> + error(badarg); +open_1([{Module, Match} | Rest], Filename, Modes) -> + case lists:any(Match, Modes) of + true -> + {Options, ChildModes} = + lists:partition(fun(Mode) -> Match(Mode) end, Modes), + Module:open_layer(Filename, ChildModes, Options); + false -> + open_1(Rest, Filename, Modes) + end. + +%% 'read' and 'list' mode are enabled unless disabled by another option, so +%% we'll explicitly add them to avoid duplicating this logic in child layers. +add_implicit_modes(Modes0) -> + Modes1 = add_unless_matched(Modes0, fun match_writable/1, read), + add_unless_matched(Modes1, fun match_binary/1, list). +add_unless_matched(Modes, Match, Default) -> + case lists:any(Match, Modes) of + false -> [Default | Modes]; + true -> Modes + end. + +match_list(list) -> true; +match_list(_Other) -> false. + +match_compressed(compressed) -> true; +match_compressed(_Other) -> false. + +match_delayed({delayed_write, _Size, _Timeout}) -> true; +match_delayed(delayed_write) -> true; +match_delayed(_Other) -> false. + +match_raw(raw) -> true; +match_raw(_Other) -> false. + +match_writable(write) -> true; +match_writable(append) -> true; +match_writable(exclusive) -> true; +match_writable(_Other) -> false. + +match_binary(binary) -> true; +match_binary(_Other) -> false. diff --git a/lib/kernel/src/raw_file_io_compressed.erl b/lib/kernel/src/raw_file_io_compressed.erl new file mode 100644 index 0000000000..d5ab042d25 --- /dev/null +++ b/lib/kernel/src/raw_file_io_compressed.erl @@ -0,0 +1,134 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(raw_file_io_compressed). + +-export([close/1, sync/1, datasync/1, truncate/1, advise/4, allocate/3, + position/2, write/2, pwrite/2, pwrite/3, + read_line/1, read/2, pread/2, pread/3]). + +%% OTP internal. +-export([ipread_s32bu_p32bu/3, sendfile/8]). + +-export([open_layer/3]). + +-include("file_int.hrl"). + +open_layer(Filename, Modes, Options) -> + IsAppend = lists:member(append, Modes), + IsDeflate = lists:member(write, Modes), + IsInflate = lists:member(read, Modes), + if + IsDeflate, IsInflate; IsAppend -> + {error, einval}; + IsDeflate, not IsInflate -> + start_server_module(raw_file_io_deflate, Filename, Modes, Options); + IsInflate -> + start_server_module(raw_file_io_inflate, Filename, Modes, Options) + end. + +start_server_module(Module, Filename, Modes, Options) -> + Secret = make_ref(), + case gen_statem:start(Module, {self(), Secret, Options}, []) of + {ok, Pid} -> open_next_layer(Pid, Secret, Filename, Modes); + Other -> Other + end. + +open_next_layer(Pid, Secret, Filename, Modes) -> + case gen_statem:call(Pid, {'$open', Secret, Filename, Modes}, infinity) of + ok -> + PublicFd = #file_descriptor{ + module = raw_file_io_compressed, data = {self(), Pid} }, + {ok, PublicFd}; + Other -> Other + end. + +close(Fd) -> + wrap_call(Fd, [close]). + +sync(Fd) -> + wrap_call(Fd, [sync]). +datasync(Fd) -> + wrap_call(Fd, [datasync]). + +truncate(Fd) -> + wrap_call(Fd, [truncate]). + +advise(Fd, Offset, Length, Advise) -> + wrap_call(Fd, [advise, Offset, Length, Advise]). +allocate(Fd, Offset, Length) -> + wrap_call(Fd, [allocate, Offset, Length]). + +position(Fd, Mark) -> + wrap_call(Fd, [position, Mark]). + +write(Fd, IOData) -> + try + CompactedData = erlang:iolist_to_iovec(IOData), + wrap_call(Fd, [write, CompactedData]) + catch + error:badarg -> {error, badarg} + end. + +pwrite(Fd, Offset, IOData) -> + try + CompactedData = erlang:iolist_to_iovec(IOData), + wrap_call(Fd, [pwrite, Offset, CompactedData]) + catch + error:badarg -> {error, badarg} + end. +pwrite(Fd, LocBytes) -> + try + CompactedLocBytes = + [ {Offset, erlang:iolist_to_iovec(IOData)} || + {Offset, IOData} <- LocBytes ], + wrap_call(Fd, [pwrite, CompactedLocBytes]) + catch + error:badarg -> {error, badarg} + end. + +read_line(Fd) -> + wrap_call(Fd, [read_line]). +read(Fd, Size) -> + wrap_call(Fd, [read, Size]). +pread(Fd, Offset, Size) -> + wrap_call(Fd, [pread, Offset, Size]). +pread(Fd, LocNums) -> + wrap_call(Fd, [pread, LocNums]). + +ipread_s32bu_p32bu(Fd, Offset, MaxSize) -> + wrap_call(Fd, [ipread_s32bu_p32bu, Offset, MaxSize]). + +sendfile(_,_,_,_,_,_,_,_) -> + {error, enotsup}. + +wrap_call(Fd, Command) -> + {_Owner, Pid} = get_fd_data(Fd), + try gen_statem:call(Pid, Command, infinity) of + Result -> Result + catch + exit:{noproc, _StackTrace} -> {error, einval} + end. + +get_fd_data(#file_descriptor{ data = Data }) -> + {Owner, _ServerPid} = Data, + case self() of + Owner -> Data; + _ -> error(not_on_controlling_process) + end. diff --git a/lib/kernel/src/raw_file_io_deflate.erl b/lib/kernel/src/raw_file_io_deflate.erl new file mode 100644 index 0000000000..acfc546743 --- /dev/null +++ b/lib/kernel/src/raw_file_io_deflate.erl @@ -0,0 +1,159 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(raw_file_io_deflate). + +-behavior(gen_statem). + +-export([init/1, callback_mode/0, terminate/3]). +-export([opening/3, opened/3]). + +-include("file_int.hrl"). + +-define(GZIP_WBITS, 16 + 15). + +callback_mode() -> state_functions. + +init({Owner, Secret, [compressed]}) -> + Monitor = monitor(process, Owner), + Z = zlib:open(), + ok = zlib:deflateInit(Z, default, deflated, ?GZIP_WBITS, 8, default), + Data = + #{ owner => Owner, + monitor => Monitor, + secret => Secret, + position => 0, + zlib => Z }, + {ok, opening, Data}. + +opening({call, From}, {'$open', Secret, Filename, Modes}, #{ secret := Secret } = Data) -> + case raw_file_io:open(Filename, Modes) of + {ok, PrivateFd} -> + NewData = Data#{ handle => PrivateFd }, + {next_state, opened, NewData, [{reply, From, ok}]}; + Other -> + {stop_and_reply, normal, [{reply, From, Other}]} + end; +opening(_Event, _Contents, _Data) -> + {keep_state_and_data, [postpone]}. + +%% + +opened(info, {'DOWN', Monitor, process, _Owner, Reason}, #{ monitor := Monitor } = Data) -> + if + Reason =/= kill -> flush_deflate_state(Data); + Reason =:= kill -> ignored + end, + {stop, shutdown}; + +opened(info, _Message, _Data) -> + keep_state_and_data; + +opened({call, {Owner, _Tag} = From}, [close], #{ owner := Owner } = Data) -> + #{ handle := PrivateFd } = Data, + Response = + case flush_deflate_state(Data) of + ok -> ?CALL_FD(PrivateFd, close, []); + Other -> Other + end, + {stop_and_reply, normal, [{reply, From, Response}]}; + +opened({call, {Owner, _Tag} = From}, [position, Mark], #{ owner := Owner } = Data) -> + case position(Data, Mark) of + {ok, NewData, Result} -> + Response = {ok, Result}, + {keep_state, NewData, [{reply, From, Response}]}; + Other -> + {keep_state_and_data, [{reply, From, Other}]} + end; + +opened({call, {Owner, _Tag} = From}, [write, IOVec], #{ owner := Owner } = Data) -> + case write(Data, IOVec) of + {ok, NewData} -> {keep_state, NewData, [{reply, From, ok}]}; + Other -> {keep_state_and_data, [{reply, From, Other}]} + end; + +opened({call, {Owner, _Tag} = From}, [read, _Size], #{ owner := Owner }) -> + Response = {error, ebadf}, + {keep_state_and_data, [{reply, From, Response}]}; + +opened({call, {Owner, _Tag} = From}, [read_line], #{ owner := Owner }) -> + Response = {error, ebadf}, + {keep_state_and_data, [{reply, From, Response}]}; + +opened({call, {Owner, _Tag} = From}, _Command, #{ owner := Owner }) -> + Response = {error, enotsup}, + {keep_state_and_data, [{reply, From, Response}]}; + +opened({call, _From}, _Command, _Data) -> + %% The client functions filter this out, so we'll crash if the user does + %% anything stupid on purpose. + {shutdown, protocol_violation}; + +opened(_Event, _Request, _Data) -> + keep_state_and_data. + +write(Data, IOVec) -> + #{ handle := PrivateFd, position := Position, zlib := Z } = Data, + UncompressedSize = iolist_size(IOVec), + case ?CALL_FD(PrivateFd, write, [zlib:deflate(Z, IOVec)]) of + ok -> {ok, Data#{ position := (Position + UncompressedSize) }}; + Other -> Other + end. + +%% +%% We support "seeking" forward as long as it isn't relative to EOF. +%% +%% Seeking is a bit of a misnomer as it's really just compressing zeroes until +%% we reach the desired point, but it has always behaved like this. +%% + +position(Data, Mark) when is_atom(Mark) -> + position(Data, {Mark, 0}); +position(Data, Offset) when is_integer(Offset) -> + position(Data, {bof, Offset}); +position(Data, {bof, Offset}) when is_integer(Offset) -> + position_1(Data, Offset); +position(Data, {cur, Offset}) when is_integer(Offset) -> + #{ position := Position } = Data, + position_1(Data, Position + Offset); +position(_Data, {eof, Offset}) when is_integer(Offset) -> + {error, einval}; +position(_Data, _Any) -> + {error, badarg}. + +position_1(#{ position := Desired } = Data, Desired) -> + {ok, Data, Desired}; +position_1(#{ position := Current } = Data, Desired) when Current < Desired -> + BytesToWrite = min(Desired - Current, 4 bsl 20), + case write(Data, <<0:(BytesToWrite)/unit:8>>) of + {ok, NewData} -> position_1(NewData, Desired); + Other -> Other + end; +position_1(#{ position := Current }, Desired) when Current > Desired -> + {error, einval}. + +flush_deflate_state(#{ handle := PrivateFd, zlib := Z }) -> + case ?CALL_FD(PrivateFd, write, [zlib:deflate(Z, [], finish)]) of + ok -> ok; + Other -> Other + end. + +terminate(_Reason, _State, _Data) -> + ok. diff --git a/lib/kernel/src/raw_file_io_delayed.erl b/lib/kernel/src/raw_file_io_delayed.erl new file mode 100644 index 0000000000..d2ad7550a1 --- /dev/null +++ b/lib/kernel/src/raw_file_io_delayed.erl @@ -0,0 +1,320 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(raw_file_io_delayed). + +-behavior(gen_statem). + +-export([close/1, sync/1, datasync/1, truncate/1, advise/4, allocate/3, + position/2, write/2, pwrite/2, pwrite/3, + read_line/1, read/2, pread/2, pread/3]). + +%% OTP internal. +-export([ipread_s32bu_p32bu/3, sendfile/8]). + +-export([open_layer/3]). + +-export([init/1, callback_mode/0, terminate/3]). +-export([opening/3, opened/3]). + +-include("file_int.hrl"). + +open_layer(Filename, Modes, Options) -> + Secret = make_ref(), + case gen_statem:start(?MODULE, {self(), Secret, Options}, []) of + {ok, Pid} -> + gen_statem:call(Pid, {'$open', Secret, Filename, Modes}, infinity); + Other -> + Other + end. + +callback_mode() -> state_functions. + +init({Owner, Secret, Options}) -> + Monitor = monitor(process, Owner), + Defaults = + #{ owner => Owner, + monitor => Monitor, + secret => Secret, + timer => none, + pid => self(), + buffer => prim_buffer:new(), + delay_size => 64 bsl 10, + delay_time => 2000 }, + Data = fill_delay_values(Defaults, Options), + {ok, opening, Data}. + +fill_delay_values(Data, []) -> + Data; +fill_delay_values(Data, [{delayed_write, Size, Time} | Options]) -> + fill_delay_values(Data#{ delay_size => Size, delay_time => Time }, Options); +fill_delay_values(Data, [_ | Options]) -> + fill_delay_values(Data, Options). + +opening({call, From}, {'$open', Secret, Filename, Modes}, #{ secret := Secret } = Data) -> + case raw_file_io:open(Filename, Modes) of + {ok, PrivateFd} -> + PublicData = maps:with([owner, buffer, delay_size, pid], Data), + PublicFd = #file_descriptor{ module = ?MODULE, data = PublicData }, + + NewData = Data#{ handle => PrivateFd }, + Response = {ok, PublicFd}, + {next_state, opened, NewData, [{reply, From, Response}]}; + Other -> + {stop_and_reply, normal, [{reply, From, Other}]} + end; +opening(_Event, _Contents, _Data) -> + {keep_state_and_data, [postpone]}. + +%% + +opened(info, {'$timed_out', Secret}, #{ secret := Secret } = Data) -> + %% If the user writes something at this exact moment, the flush will fail + %% and the timer won't reset on the next write since the buffer won't be + %% empty (Unless we collided on a flush). We therefore reset the timeout to + %% ensure that data won't sit idle for extended periods of time. + case try_flush_write_buffer(Data) of + busy -> gen_statem:cast(self(), '$reset_timeout'); + ok -> ok + end, + {keep_state, Data#{ timer => none }, []}; + +opened(info, {'DOWN', Monitor, process, _Owner, Reason}, #{ monitor := Monitor } = Data) -> + if + Reason =/= kill -> try_flush_write_buffer(Data); + Reason =:= kill -> ignored + end, + {stop, shutdown}; + +opened(info, _Message, _Data) -> + keep_state_and_data; + +opened({call, {Owner, _Tag} = From}, [close], #{ owner := Owner } = Data) -> + case flush_write_buffer(Data) of + ok -> + #{ handle := PrivateFd } = Data, + Response = ?CALL_FD(PrivateFd, close, []), + {stop_and_reply, normal, [{reply, From, Response}]}; + Other -> + {stop_and_reply, normal, [{reply, From, Other}]} + end; + +opened({call, {Owner, _Tag} = From}, '$wait', #{ owner := Owner }) -> + %% Used in write/2 to synchronize writes on lock conflicts. + {keep_state_and_data, [{reply, From, ok}]}; + +opened({call, {Owner, _Tag} = From}, '$synchronous_flush', #{ owner := Owner } = Data) -> + cancel_flush_timeout(Data), + Response = flush_write_buffer(Data), + {keep_state_and_data, [{reply, From, Response}]}; + +opened({call, {Owner, _Tag} = From}, Command, #{ owner := Owner } = Data) -> + Response = + case flush_write_buffer(Data) of + ok -> dispatch_command(Data, Command); + Other -> Other + end, + {keep_state_and_data, [{reply, From, Response}]}; + +opened({call, _From}, _Command, _Data) -> + %% The client functions filter this out, so we'll crash if the user does + %% anything stupid on purpose. + {shutdown, protocol_violation}; + +opened(cast, '$reset_timeout', #{ delay_time := Timeout, secret := Secret } = Data) -> + cancel_flush_timeout(Data), + Timer = erlang:send_after(Timeout, self(), {'$timed_out', Secret}), + {keep_state, Data#{ timer => Timer }, []}; + +opened(cast, _Message, _Data) -> + {keep_state_and_data, []}. + +dispatch_command(Data, [Function | Args]) -> + #{ handle := Handle } = Data, + Module = Handle#file_descriptor.module, + apply(Module, Function, [Handle | Args]). + +cancel_flush_timeout(#{ timer := none }) -> + ok; +cancel_flush_timeout(#{ timer := Timer }) -> + _ = erlang:cancel_timer(Timer, [{async, true}]), + ok. + +try_flush_write_buffer(#{ buffer := Buffer, handle := PrivateFd }) -> + case prim_buffer:try_lock(Buffer) of + acquired -> + flush_write_buffer_1(Buffer, PrivateFd), + prim_buffer:unlock(Buffer), + ok; + busy -> + busy + end. + +%% This is only safe to use when there is no chance of conflict with the owner +%% process, or in other words, "during synchronous calls outside of the locked +%% section of write/2" +flush_write_buffer(#{ buffer := Buffer, handle := PrivateFd }) -> + acquired = prim_buffer:try_lock(Buffer), + Result = flush_write_buffer_1(Buffer, PrivateFd), + prim_buffer:unlock(Buffer), + Result. + +flush_write_buffer_1(Buffer, PrivateFd) -> + case prim_buffer:size(Buffer) of + Size when Size > 0 -> + ?CALL_FD(PrivateFd, write, [prim_buffer:read_iovec(Buffer, Size)]); + 0 -> + ok + end. + +terminate(_Reason, _State, _Data) -> + ok. + +%% Client functions + +write(Fd, IOData) -> + try + enqueue_write(Fd, erlang:iolist_to_iovec(IOData)) + catch + error:badarg -> {error, badarg} + end. +enqueue_write(_Fd, []) -> + ok; +enqueue_write(Fd, IOVec) -> + %% get_fd_data will reject everyone except the process that opened the Fd, + %% so we can't race with anyone except the wrapper process. + #{ delay_size := DelaySize, + buffer := Buffer, + pid := Pid } = get_fd_data(Fd), + case prim_buffer:try_lock(Buffer) of + acquired -> + %% (The wrapper process will exit without flushing if we're killed + %% while holding the lock). + enqueue_write_locked(Pid, Buffer, DelaySize, IOVec); + busy -> + %% This can only happen while we're processing a timeout in the + %% wrapper process, so we perform a bogus call to get a completion + %% notification before trying again. + gen_statem:call(Pid, '$wait'), + enqueue_write(Fd, IOVec) + end. +enqueue_write_locked(Pid, Buffer, DelaySize, IOVec) -> + %% The synchronous operations (write, forced flush) are safe since we're + %% running on the only process that can fill the buffer; a timeout being + %% processed just before $synchronous_flush will cause the flush to nop, + %% and a timeout sneaking in just before a synchronous write won't do + %% anything since the buffer is guaranteed to be empty at that point. + BufSize = prim_buffer:size(Buffer), + case is_iovec_smaller_than(IOVec, DelaySize - BufSize) of + true when BufSize > 0 -> + prim_buffer:write(Buffer, IOVec), + prim_buffer:unlock(Buffer); + true -> + prim_buffer:write(Buffer, IOVec), + prim_buffer:unlock(Buffer), + gen_statem:cast(Pid, '$reset_timeout'); + false when BufSize > 0 -> + prim_buffer:write(Buffer, IOVec), + prim_buffer:unlock(Buffer), + gen_statem:call(Pid, '$synchronous_flush'); + false -> + prim_buffer:unlock(Buffer), + gen_statem:call(Pid, [write, IOVec]) + end. + +%% iolist_size/1 will always look through the entire list to get a precise +%% amount, which is pretty inefficient since we only need to know whether we've +%% hit the buffer threshold or not. +%% +%% We only handle the binary case since write/2 forcibly translates input to +%% erlang:iovec(). +is_iovec_smaller_than(IOVec, Max) -> + is_iovec_smaller_than_1(IOVec, Max, 0). +is_iovec_smaller_than_1(_IOVec, Max, Acc) when Acc >= Max -> + false; +is_iovec_smaller_than_1([], _Max, _Acc) -> + true; +is_iovec_smaller_than_1([Binary | Rest], Max, Acc) when is_binary(Binary) -> + is_iovec_smaller_than_1(Rest, Max, Acc + byte_size(Binary)). + +close(Fd) -> + wrap_call(Fd, [close]). + +sync(Fd) -> + wrap_call(Fd, [sync]). +datasync(Fd) -> + wrap_call(Fd, [datasync]). + +truncate(Fd) -> + wrap_call(Fd, [truncate]). + +advise(Fd, Offset, Length, Advise) -> + wrap_call(Fd, [advise, Offset, Length, Advise]). +allocate(Fd, Offset, Length) -> + wrap_call(Fd, [allocate, Offset, Length]). + +position(Fd, Mark) -> + wrap_call(Fd, [position, Mark]). + +pwrite(Fd, Offset, IOData) -> + try + CompactedData = erlang:iolist_to_iovec(IOData), + wrap_call(Fd, [pwrite, Offset, CompactedData]) + catch + error:badarg -> {error, badarg} + end. +pwrite(Fd, LocBytes) -> + try + CompactedLocBytes = + [ {Offset, erlang:iolist_to_iovec(IOData)} || + {Offset, IOData} <- LocBytes ], + wrap_call(Fd, [pwrite, CompactedLocBytes]) + catch + error:badarg -> {error, badarg} + end. + +read_line(Fd) -> + wrap_call(Fd, [read_line]). +read(Fd, Size) -> + wrap_call(Fd, [read, Size]). +pread(Fd, Offset, Size) -> + wrap_call(Fd, [pread, Offset, Size]). +pread(Fd, LocNums) -> + wrap_call(Fd, [pread, LocNums]). + +ipread_s32bu_p32bu(Fd, Offset, MaxSize) -> + wrap_call(Fd, [ipread_s32bu_p32bu, Offset, MaxSize]). + +sendfile(_,_,_,_,_,_,_,_) -> + {error, enotsup}. + +wrap_call(Fd, Command) -> + #{ pid := Pid } = get_fd_data(Fd), + try gen_statem:call(Pid, Command, infinity) of + Result -> Result + catch + exit:{noproc, _StackTrace} -> {error, einval} + end. + +get_fd_data(#file_descriptor{ data = Data }) -> + #{ owner := Owner } = Data, + case self() of + Owner -> Data; + _ -> error(not_on_controlling_process) + end. diff --git a/lib/kernel/src/raw_file_io_inflate.erl b/lib/kernel/src/raw_file_io_inflate.erl new file mode 100644 index 0000000000..7e9780310c --- /dev/null +++ b/lib/kernel/src/raw_file_io_inflate.erl @@ -0,0 +1,261 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(raw_file_io_inflate). + +-behavior(gen_statem). + +-export([init/1, callback_mode/0, terminate/3]). +-export([opening/3, opened_gzip/3, opened_passthrough/3]). + +-include("file_int.hrl"). + +-define(INFLATE_CHUNK_SIZE, (1 bsl 10)). +-define(GZIP_WBITS, (16 + 15)). + +callback_mode() -> state_functions. + +init({Owner, Secret, [compressed]}) -> + Monitor = monitor(process, Owner), + %% We're using the undocumented inflateInit/3 to open the stream in + %% 'reset mode', which resets the inflate state at the end of every stream, + %% allowing us to read concatenated gzip files. + Z = zlib:open(), + ok = zlib:inflateInit(Z, ?GZIP_WBITS, reset), + Data = + #{ owner => Owner, + monitor => Monitor, + secret => Secret, + position => 0, + buffer => prim_buffer:new(), + zlib => Z }, + {ok, opening, Data}. + +%% The old driver fell back to plain reads if the file didn't start with the +%% magic gzip bytes. +choose_decompression_state(PrivateFd) -> + State = + case ?CALL_FD(PrivateFd, read, [2]) of + {ok, <<16#1F, 16#8B>>} -> opened_gzip; + _Other -> opened_passthrough + end, + {ok, 0} = ?CALL_FD(PrivateFd, position, [0]), + State. + +opening({call, From}, {'$open', Secret, Filename, Modes}, #{ secret := Secret } = Data) -> + case raw_file_io:open(Filename, Modes) of + {ok, PrivateFd} -> + NextState = choose_decompression_state(PrivateFd), + NewData = Data#{ handle => PrivateFd }, + {next_state, NextState, NewData, [{reply, From, ok}]}; + Other -> + {stop_and_reply, normal, [{reply, From, Other}]} + end; +opening(_Event, _Contents, _Data) -> + {keep_state_and_data, [postpone]}. + +internal_close(From, Data) -> + #{ handle := PrivateFd } = Data, + Response = ?CALL_FD(PrivateFd, close, []), + {stop_and_reply, normal, [{reply, From, Response}]}. + +opened_passthrough(info, {'DOWN', Monitor, process, _Owner, _Reason}, #{ monitor := Monitor }) -> + {stop, shutdown}; + +opened_passthrough(info, _Message, _Data) -> + keep_state_and_data; + +opened_passthrough({call, {Owner, _Tag} = From}, [close], #{ owner := Owner } = Data) -> + internal_close(From, Data); + +opened_passthrough({call, {Owner, _Tag} = From}, [Method | Args], #{ owner := Owner } = Data) -> + #{ handle := PrivateFd } = Data, + Response = ?CALL_FD(PrivateFd, Method, Args), + {keep_state_and_data, [{reply, From, Response}]}; + +opened_passthrough({call, _From}, _Command, _Data) -> + %% The client functions filter this out, so we'll crash if the user does + %% anything stupid on purpose. + {shutdown, protocol_violation}; + +opened_passthrough(_Event, _Request, _Data) -> + keep_state_and_data. + +%% + +opened_gzip(info, {'DOWN', Monitor, process, _Owner, _Reason}, #{ monitor := Monitor }) -> + {stop, shutdown}; + +opened_gzip(info, _Message, _Data) -> + keep_state_and_data; + +opened_gzip({call, {Owner, _Tag} = From}, [close], #{ owner := Owner } = Data) -> + internal_close(From, Data); + +opened_gzip({call, {Owner, _Tag} = From}, [position, Mark], #{ owner := Owner } = Data) -> + case position(Data, Mark) of + {ok, NewData, Result} -> + Response = {ok, Result}, + {keep_state, NewData, [{reply, From, Response}]}; + Other -> + {keep_state_and_data, [{reply, From, Other}]} + end; + +opened_gzip({call, {Owner, _Tag} = From}, [read, Size], #{ owner := Owner } = Data) -> + case read(Data, Size) of + {ok, NewData, Result} -> + Response = {ok, Result}, + {keep_state, NewData, [{reply, From, Response}]}; + Other -> + {keep_state_and_data, [{reply, From, Other}]} + end; + +opened_gzip({call, {Owner, _Tag} = From}, [read_line], #{ owner := Owner } = Data) -> + case read_line(Data) of + {ok, NewData, Result} -> + Response = {ok, Result}, + {keep_state, NewData, [{reply, From, Response}]}; + Other -> + {keep_state_and_data, [{reply, From, Other}]} + end; + +opened_gzip({call, {Owner, _Tag} = From}, [write, _IOData], #{ owner := Owner }) -> + Response = {error, ebadf}, + {keep_state_and_data, [{reply, From, Response}]}; + +opened_gzip({call, {Owner, _Tag} = From}, _Request, #{ owner := Owner }) -> + Response = {error, enotsup}, + {keep_state_and_data, [{reply, From, Response}]}; + +opened_gzip({call, _From}, _Request, _Data) -> + %% The client functions filter this out, so we'll crash if the user does + %% anything stupid on purpose. + {shutdown, protocol_violation}; + +opened_gzip(_Event, _Request, _Data) -> + keep_state_and_data. + +%% + +read(#{ buffer := Buffer } = Data, Size) -> + try read_1(Data, Buffer, prim_buffer:size(Buffer), Size) of + Result -> Result + catch + error:badarg -> {error, badarg}; + error:_ -> {error, eio} + end. +read_1(Data, Buffer, BufferSize, ReadSize) when BufferSize >= ReadSize -> + #{ position := Position } = Data, + Decompressed = prim_buffer:read(Buffer, ReadSize), + {ok, Data#{ position => (Position + ReadSize) }, Decompressed}; +read_1(Data, Buffer, BufferSize, ReadSize) when BufferSize < ReadSize -> + #{ handle := PrivateFd } = Data, + case ?CALL_FD(PrivateFd, read, [?INFLATE_CHUNK_SIZE]) of + {ok, Compressed} -> + #{ zlib := Z } = Data, + Uncompressed = erlang:iolist_to_iovec(zlib:inflate(Z, Compressed)), + prim_buffer:write(Buffer, Uncompressed), + read_1(Data, Buffer, prim_buffer:size(Buffer), ReadSize); + eof when BufferSize > 0 -> + read_1(Data, Buffer, BufferSize, BufferSize); + Other -> + Other + end. + +read_line(#{ buffer := Buffer } = Data) -> + try read_line_1(Data, Buffer, prim_buffer:find_byte_index(Buffer, $\n)) of + {ok, NewData, Decompressed} -> {ok, NewData, Decompressed}; + Other -> Other + catch + error:badarg -> {error, badarg}; + error:_ -> {error, eio} + end. + +read_line_1(Data, Buffer, not_found) -> + #{ handle := PrivateFd, zlib := Z } = Data, + case ?CALL_FD(PrivateFd, read, [?INFLATE_CHUNK_SIZE]) of + {ok, Compressed} -> + Uncompressed = erlang:iolist_to_iovec(zlib:inflate(Z, Compressed)), + prim_buffer:write(Buffer, Uncompressed), + read_line_1(Data, Buffer, prim_buffer:find_byte_index(Buffer, $\n)); + eof -> + case prim_buffer:size(Buffer) of + Size when Size > 0 -> {ok, prim_buffer:read(Buffer, Size)}; + Size when Size =:= 0 -> eof + end; + Error -> + Error + end; +read_line_1(Data, Buffer, {ok, LFIndex}) -> + %% Translate CRLF into just LF, completely ignoring which encoding is used, + %% but treat the file position as including CR. + #{ position := Position } = Data, + NewData = Data#{ position => (Position + LFIndex + 1) }, + CRIndex = (LFIndex - 1), + TranslatedLine = + case prim_buffer:read(Buffer, LFIndex + 1) of + <<Line:CRIndex/binary, "\r\n">> -> <<Line/binary, "\n">>; + Line -> Line + end, + {ok, NewData, TranslatedLine}. + +%% +%% We support seeking in both directions as long as it isn't relative to EOF. +%% +%% Seeking backwards is extremely inefficient since we have to seek to the very +%% beginning and then decompress up to the desired point. +%% + +position(Data, Mark) when is_atom(Mark) -> + position(Data, {Mark, 0}); +position(Data, Offset) when is_integer(Offset) -> + position(Data, {bof, Offset}); +position(Data, {bof, Offset}) when is_integer(Offset) -> + position_1(Data, Offset); +position(Data, {cur, Offset}) when is_integer(Offset) -> + #{ position := Position } = Data, + position_1(Data, Position + Offset); +position(_Data, {eof, Offset}) when is_integer(Offset) -> + {error, einval}; +position(_Data, _Other) -> + {error, badarg}. + +position_1(_Data, Desired) when Desired < 0 -> + {error, einval}; +position_1(#{ position := Desired } = Data, Desired) -> + {ok, Data, Desired}; +position_1(#{ position := Current } = Data, Desired) when Current < Desired -> + case read(Data, min(Desired - Current, ?INFLATE_CHUNK_SIZE)) of + {ok, NewData, _Data} -> position_1(NewData, Desired); + eof -> {ok, Data, Current}; + Other -> Other + end; +position_1(#{ position := Current } = Data, Desired) when Current > Desired -> + #{ handle := PrivateFd, buffer := Buffer, zlib := Z } = Data, + case ?CALL_FD(PrivateFd, position, [bof]) of + {ok, 0} -> + ok = zlib:inflateReset(Z), + prim_buffer:wipe(Buffer), + position_1(Data#{ position => 0 }, Desired); + Other -> + Other + end. + +terminate(_Reason, _State, _Data) -> + ok. diff --git a/lib/kernel/src/raw_file_io_list.erl b/lib/kernel/src/raw_file_io_list.erl new file mode 100644 index 0000000000..2e16e63f0e --- /dev/null +++ b/lib/kernel/src/raw_file_io_list.erl @@ -0,0 +1,128 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(raw_file_io_list). + +-export([close/1, sync/1, datasync/1, truncate/1, advise/4, allocate/3, + position/2, write/2, pwrite/2, pwrite/3, + read_line/1, read/2, pread/2, pread/3]). + +%% OTP internal. +-export([ipread_s32bu_p32bu/3, sendfile/8]). + +-export([open_layer/3]). + +-include("file_int.hrl"). + +open_layer(Filename, Modes, [list]) -> + case raw_file_io:open(Filename, [binary | Modes]) of + {ok, PrivateFd} -> {ok, make_public_fd(PrivateFd, Modes)}; + Other -> Other + end. + +%% We can skip wrapping the file if it's write-only since only read operations +%% are affected by list mode. Since raw_file_io fills in all implicit options +%% for us, all we need to do is check whether 'read' is among them. +make_public_fd(PrivateFd, Modes) -> + case lists:member(read, Modes) of + true -> #file_descriptor{ module = ?MODULE, data = PrivateFd }; + false -> PrivateFd + end. + +close(Fd) -> + PrivateFd = Fd#file_descriptor.data, + ?CALL_FD(PrivateFd, close, []). + +sync(Fd) -> + PrivateFd = Fd#file_descriptor.data, + ?CALL_FD(PrivateFd, sync, []). +datasync(Fd) -> + PrivateFd = Fd#file_descriptor.data, + ?CALL_FD(PrivateFd, datasync, []). + +truncate(Fd) -> + PrivateFd = Fd#file_descriptor.data, + ?CALL_FD(PrivateFd, truncate, []). + +advise(Fd, Offset, Length, Advise) -> + PrivateFd = Fd#file_descriptor.data, + ?CALL_FD(PrivateFd, advise, [Offset, Length, Advise]). +allocate(Fd, Offset, Length) -> + PrivateFd = Fd#file_descriptor.data, + ?CALL_FD(PrivateFd, allocate, [Offset, Length]). + +position(Fd, Mark) -> + PrivateFd = Fd#file_descriptor.data, + ?CALL_FD(PrivateFd, position, [Mark]). + +write(Fd, IOData) -> + PrivateFd = Fd#file_descriptor.data, + ?CALL_FD(PrivateFd, write, [IOData]). + +pwrite(Fd, Offset, IOData) -> + PrivateFd = Fd#file_descriptor.data, + ?CALL_FD(PrivateFd, pwrite, [Offset, IOData]). +pwrite(Fd, LocBytes) -> + PrivateFd = Fd#file_descriptor.data, + ?CALL_FD(PrivateFd, pwrite, [LocBytes]). + +read_line(Fd) -> + PrivateFd = Fd#file_descriptor.data, + case ?CALL_FD(PrivateFd, read_line, []) of + {ok, Binary} -> {ok, binary_to_list(Binary)}; + Other -> Other + end. +read(Fd, Size) -> + PrivateFd = Fd#file_descriptor.data, + case ?CALL_FD(PrivateFd, read, [Size]) of + {ok, Binary} -> {ok, binary_to_list(Binary)}; + Other -> Other + end. +pread(Fd, Offset, Size) -> + PrivateFd = Fd#file_descriptor.data, + case ?CALL_FD(PrivateFd, pread, [Offset, Size]) of + {ok, Binary} -> {ok, binary_to_list(Binary)}; + Other -> Other + end. +pread(Fd, LocNums) -> + PrivateFd = Fd#file_descriptor.data, + case ?CALL_FD(PrivateFd, pread, [LocNums]) of + {ok, LocResults} -> + TranslatedResults = + [ case Result of + Result when is_binary(Result) -> binary_to_list(Result); + eof -> eof + end || Result <- LocResults ], + {ok, TranslatedResults}; + Other -> Other + end. + +ipread_s32bu_p32bu(Fd, Offset, MaxSize) -> + PrivateFd = Fd#file_descriptor.data, + case ?CALL_FD(PrivateFd, ipread_s32bu_p32bu, [Offset, MaxSize]) of + {ok, {Size, Pointer, Binary}} when is_binary(Binary) -> + {ok, {Size, Pointer, binary_to_list(Binary)}}; + Other -> + Other + end. + +sendfile(Fd, Dest, Offset, Bytes, ChunkSize, Headers, Trailers, Flags) -> + Args = [Dest, Offset, Bytes, ChunkSize, Headers, Trailers, Flags], + PrivateFd = Fd#file_descriptor.data, + ?CALL_FD(PrivateFd, sendfile, Args). diff --git a/lib/kernel/src/raw_file_io_raw.erl b/lib/kernel/src/raw_file_io_raw.erl new file mode 100644 index 0000000000..9a9fe78eb1 --- /dev/null +++ b/lib/kernel/src/raw_file_io_raw.erl @@ -0,0 +1,25 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(raw_file_io_raw). + +-export([open_layer/3]). + +open_layer(Filename, Modes, [raw]) -> + prim_file:open(Filename, [raw | Modes]). diff --git a/lib/kernel/src/user.erl b/lib/kernel/src/user.erl index a5cc7b0ec1..872e63ab53 100644 --- a/lib/kernel/src/user.erl +++ b/lib/kernel/src/user.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -398,7 +398,7 @@ get_line(Prompt, Port, Q, Acc, Enc) -> get_line_bytes(Prompt, Port, Q, Acc, Bytes, Enc); {Port, eof} -> put(eof, true), - {ok, eof, []}; + {ok, eof, queue:new()}; {io_request,From,ReplyAs,{get_geometry,_}=Req} when is_pid(From) -> do_io_request(Req, From, ReplyAs, Port, queue:new()), @@ -615,7 +615,7 @@ get_chars(Prompt, M, F, Xa, Port, Q, State, Enc) -> get_chars_bytes(State, M, F, Xa, Port, Q, Bytes, Enc); {Port, eof} -> put(eof, true), - {ok, eof, []}; + {ok, eof, queue:new()}; %%{io_request,From,ReplyAs,Request} when is_pid(From) -> %% get_chars_req(Prompt, M, F, Xa, Port, queue:new(), State, %% Request, From, ReplyAs); diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index 612f77149d..569753155f 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -1562,16 +1562,7 @@ on_load_trace_on_load(Config) -> erlang:trace_pattern(on_load, false, []), erlang:trace(self(), false, [call]), - %% WE GET TRACES FOR CALLS TO UNDEFINED FUNCTIONS ??? - %% Remove filter when that is fixed. - Ms = lists:filter(fun({trace,Papa,call, - {error_handler,undefined_function, - [on_load_update_code,_,_]}}) - -> false; - (_) -> true - end, - flush()), - + Ms = flush(), [{trace, Papa, call, {on_load_update_code, a, []}}, {trace, Papa, call, {on_load_update_code, b, [99]}}, {trace, Papa, call, {on_load_update_code, c, []}}] = Ms, diff --git a/lib/kernel/test/code_SUITE_data/upgrade_client.erl b/lib/kernel/test/code_SUITE_data/upgrade_client.erl index faa18e1410..1c3c2def53 100644 --- a/lib/kernel/test/code_SUITE_data/upgrade_client.erl +++ b/lib/kernel/test/code_SUITE_data/upgrade_client.erl @@ -341,6 +341,7 @@ check_tracing_loop(N, MsgList) -> stop_tracing(Tracer) -> + erlang:trace_pattern({error_handler,undefined_function,3}, false, [global]), erlang:trace(self(), false, [call]), Tracer ! die_please, receive diff --git a/lib/kernel/test/disk_log_SUITE.erl b/lib/kernel/test/disk_log_SUITE.erl index fe2fc778f2..7beaadb1d6 100644 --- a/lib/kernel/test/disk_log_SUITE.erl +++ b/lib/kernel/test/disk_log_SUITE.erl @@ -89,8 +89,6 @@ dist_terminate/1, dist_accessible/1, dist_deadlock/1, dist_open2/1, other_groups/1, - evil/1, - otp_6278/1, otp_10131/1]). -export([head_fun/1, hf/0, lserv/1, @@ -123,7 +121,7 @@ [halt_int, wrap_int, halt_ext, wrap_ext, read_mode, head, notif, new_idx_vsn, reopen, block, unblock, open, close, error, chunk, truncate, many_users, info, change_size, - change_attribute, distribution, evil, otp_6278, otp_10131]). + change_attribute, distribution, otp_6278, otp_10131]). %% These test cases should be skipped if the VxWorks card is %% configured without NFS cache. @@ -149,7 +147,7 @@ all() -> {group, open}, {group, close}, {group, error}, chunk, truncate, many_users, {group, info}, {group, change_size}, change_attribute, - {group, distribution}, evil, otp_6278, otp_10131]. + {group, distribution}, otp_6278, otp_10131]. groups() -> [{halt_int, [], [halt_int_inf, {group, halt_int_sz}]}, @@ -4676,119 +4674,6 @@ other_groups(Conf) when is_list(Conf) -> ok. --define(MAX, ?MAX_FWRITE_CACHE). % as in disk_log_1.erl -%% Evil cases such as closed file descriptor port. -evil(Conf) when is_list(Conf) -> - Dir = ?privdir(Conf), - File = filename:join(Dir, "n.LOG"), - Log = n, - - %% Not a very thorough test. - - ok = setup_evil_filled_cache_wrap(Log, Dir), - {error, {file_error,_,einval}} = disk_log:log(Log, apa), - ok = disk_log:close(Log), - - ok = setup_evil_filled_cache_halt(Log, Dir), - {error, {file_error,_,einval}} = disk_log:truncate(Log, apa), - ok = stop_evil(Log), - - %% White box test. - file:delete(File), - Ports0 = erlang:ports(), - {ok, Log} = disk_log:open([{name,Log},{file,File},{type,halt}, - {size,?MAX+50},{format,external}]), - [Fd] = erlang:ports() -- Ports0, - {B,_} = x_mk_bytes(30), - ok = disk_log:blog(Log, <<0:(?MAX-1)/unit:8>>), - exit(Fd, kill), - {error, {file_error,_,einval}} = disk_log:blog_terms(Log, [B,B]), - ok= disk_log:close(Log), - file:delete(File), - - ok = setup_evil_wrap(Log, Dir), - {error, {file_error,_,einval}} = disk_log:close(Log), - - ok = setup_evil_wrap(Log, Dir), - {error, {file_error,_,einval}} = disk_log:log(Log, apa), - ok = stop_evil(Log), - - ok = setup_evil_halt(Log, Dir), - {error, {file_error,_,einval}} = disk_log:log(Log, apa), - ok = stop_evil(Log), - - ok = setup_evil_wrap(Log, Dir), - {error, {file_error,_,einval}} = disk_log:reopen(Log, apa), - {error, {file_error,_,einval}} = disk_log:reopen(Log, apa), - ok = stop_evil(Log), - - ok = setup_evil_wrap(Log, Dir), - {error, {file_error,_,einval}} = disk_log:reopen(Log, apa), - ok = stop_evil(Log), - - ok = setup_evil_wrap(Log, Dir), - {error, {file_error,_,einval}} = disk_log:inc_wrap_file(Log), - ok = stop_evil(Log), - - ok = setup_evil_wrap(Log, Dir), - {error, {file_error,_,einval}} = disk_log:chunk(Log, start), - ok = stop_evil(Log), - - ok = setup_evil_wrap(Log, Dir), - {error, {file_error,_,einval}} = disk_log:truncate(Log), - ok = stop_evil(Log), - - ok = setup_evil_wrap(Log, Dir), - {error, {file_error,_,einval}} = disk_log:chunk_step(Log, start, 1), - ok = stop_evil(Log), - - io:format("messages: ~p~n", [erlang:process_info(self(), messages)]), - del(File, 2), - file:delete(File), - ok. - -setup_evil_wrap(Log, Dir) -> - setup_evil(Log, [{type,wrap},{size,{100,2}}], Dir). - -setup_evil_halt(Log, Dir) -> - setup_evil(Log, [{type,halt},{size,10000}], Dir). - -setup_evil(Log, Args, Dir) -> - File = filename:join(Dir, lists:concat([Log, ".LOG"])), - file:delete(File), - del(File, 2), - ok = disk_log:start(), - Ports0 = erlang:ports(), - {ok, Log} = disk_log:open([{name,Log},{file,File} | Args]), - [Fd] = erlang:ports() -- Ports0, - exit(Fd, kill), - ok = disk_log:log_terms(n, [<<0:10/unit:8>>]), - timer:sleep(2500), % TIMEOUT in disk_log_1.erl is 2000 - ok. - -stop_evil(Log) -> - {error, _} = disk_log:close(Log), - ok. - -setup_evil_filled_cache_wrap(Log, Dir) -> - setup_evil_filled_cache(Log, [{type,wrap},{size,{?MAX,2}}], Dir). - -setup_evil_filled_cache_halt(Log, Dir) -> - setup_evil_filled_cache(Log, [{type,halt},{size,infinity}], Dir). - -%% The cache is filled, and the file descriptor port gone. -setup_evil_filled_cache(Log, Args, Dir) -> - File = filename:join(Dir, lists:concat([Log, ".LOG"])), - file:delete(File), - del(File, 2), - ok = disk_log:start(), - Ports0 = erlang:ports(), - {ok, Log} = disk_log:open([{name,Log},{file,File} | Args]), - [Fd] = erlang:ports() -- Ports0, - ok = disk_log:log_terms(n, [<<0:?MAX/unit:8>>]), - exit(Fd, kill), - ok. - %% OTP-6278. open/1 creates no status or crash report. otp_6278(Conf) when is_list(Conf) -> Dir = ?privdir(Conf), diff --git a/lib/kernel/test/erl_distribution_wb_SUITE.erl b/lib/kernel/test/erl_distribution_wb_SUITE.erl index 03aaee56b7..8256444bdc 100644 --- a/lib/kernel/test/erl_distribution_wb_SUITE.erl +++ b/lib/kernel/test/erl_distribution_wb_SUITE.erl @@ -61,10 +61,13 @@ %% From R9 and forward extended references is compulsory %% From R10 and forward extended pids and ports are compulsory %% From R20 and forward UTF8 atoms are compulsory +%% From R21 and forward NEW_FUN_TAGS is compulsory (no more tuple fallback {fun, ...}) -define(COMPULSORY_DFLAGS, (?DFLAG_EXTENDED_REFERENCES bor ?DFLAG_EXTENDED_PIDS_PORTS bor - ?DFLAG_UTF8_ATOMS)). + ?DFLAG_UTF8_ATOMS bor + ?DFLAG_NEW_FUN_TAGS)). +-define(PASS_THROUGH, $p). -define(shutdown(X), exit(X)). -define(int16(X), [((X) bsr 8) band 16#ff, (X) band 16#ff]). @@ -674,15 +677,16 @@ build_rex_message(Cookie,OurName) -> %% Receive a distribution message recv_message(Socket) -> case gen_tcp:recv(Socket, 0) of + {ok,[]} -> + recv_message(Socket); %% a tick, ignore {ok,Data} -> B0 = list_to_binary(Data), - {_,B1} = erlang:split_binary(B0,1), - Header = binary_to_term(B1), - Siz = byte_size(term_to_binary(Header)), - {_,B2} = erlang:split_binary(B1,Siz), + <<?PASS_THROUGH, B1/binary>> = B0, + {Header,Siz} = binary_to_term(B1,[used]), + <<_:Siz/binary,B2/binary>> = B1, Message = case (catch binary_to_term(B2)) of {'EXIT', _} -> - could_not_digest_message; + {could_not_digest_message,B2}; Other -> Other end, diff --git a/lib/kernel/test/erl_prim_loader_SUITE.erl b/lib/kernel/test/erl_prim_loader_SUITE.erl index b6417210b9..3502a4ad08 100644 --- a/lib/kernel/test/erl_prim_loader_SUITE.erl +++ b/lib/kernel/test/erl_prim_loader_SUITE.erl @@ -33,6 +33,7 @@ primary_archive/1, virtual_dir_in_archive/1, get_modules/1]). +-define(PRIM_FILE, prim_file). %%----------------------------------------------------------------- %% Test suite for erl_prim_loader. (Most code is run during system start/stop.) @@ -461,7 +462,7 @@ primary_archive(Config) when is_list(Config) -> %% Set primary archive ExpectedEbins = [Archive, DictDir ++ "/ebin", DummyDir ++ "/ebin"], io:format("ExpectedEbins: ~p\n", [ExpectedEbins]), - {ok, FileInfo} = prim_file:read_file_info(Archive), + {ok, FileInfo} = ?PRIM_FILE:read_file_info(Archive), {ok, Ebins} = rpc:call(Node, erl_prim_loader, set_primary_archive, [Archive, ArchiveBin, FileInfo, fun escript:parse_file/1]), diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl index 119e1f24bb..0cb8087a76 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -39,6 +39,8 @@ -define(FILE_FIN_PER_TESTCASE(Config), Config). -endif. +-define(PRIM_FILE, prim_file). + -module(?FILE_SUITE). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, @@ -97,6 +99,12 @@ -export([unicode_mode/1]). +-export([volume_relative_paths/1]). + +-export([tiny_writes/1, tiny_writes_delayed/1, + large_writes/1, large_writes_delayed/1, + tiny_reads/1, tiny_reads_ahead/1]). + %% Debug exports -export([create_file_slow/2, create_file/2, create_bin/2]). -export([verify_file/2, verify_bin/3]). @@ -107,6 +115,8 @@ -export([disc_free/1, memsize/0]). -include_lib("common_test/include/ct.hrl"). +-include_lib("common_test/include/ct_event.hrl"). + -include_lib("kernel/include/file.hrl"). -define(THROW_ERROR(RES), throw({fail, ?LINE, RES})). @@ -118,13 +128,13 @@ suite() -> all() -> [unicode, altname, read_write_file, {group, dirs}, - {group, files}, delete, rename, names, {group, errors}, - {group, compression}, {group, links}, copy, + {group, files}, delete, rename, names, volume_relative_paths, + {group, errors}, {group, compression}, {group, links}, copy, delayed_write, read_ahead, segment_read, segment_write, ipread, pid2name, interleaved_read_write, otp_5814, otp_10852, large_file, large_write, read_line_1, read_line_2, read_line_3, read_line_4, standard_io, old_io_protocol, - unicode_mode + unicode_mode, {group, bench} ]. groups() -> @@ -154,11 +164,19 @@ groups() -> write_compressed, compress_errors, catenated_gzips, compress_async_crash]}, {links, [], - [make_link, read_link_info_for_non_link, symlinks]}]. + [make_link, read_link_info_for_non_link, symlinks]}, + {bench, [], + [tiny_writes, tiny_writes_delayed, + large_writes, large_writes_delayed, + tiny_reads, tiny_reads_ahead]}]. init_per_group(_GroupName, Config) -> Config. +end_per_group(bench, Config) -> + ScratchDir = proplists:get_value(priv_dir, Config), + file:delete(filename:join(ScratchDir, "benchmark_scratch_file")), + Config; end_per_group(_GroupName, Config) -> Config. @@ -473,7 +491,7 @@ um_check_unicode(_Utf8Bin, {ok, _ListOrBin}, _, _UTF8_) -> um_filename(Bin, Dir, Options) when is_binary(Bin) -> um_filename(binary_to_list(Bin), Dir, Options); um_filename(Str = [_|_], Dir, Options) -> - Name = hd(string:tokens(Str, ":")), + Name = hd(string:lexemes(Str, ":")), Enc = atom_to_list(proplists:get_value(encoding, Options, latin1)), File = case lists:member(binary, Options) of true -> @@ -638,6 +656,10 @@ cur_dir_0(Config) when is_list(Config) -> {ok,NewDirFiles} = ?FILE_MODULE:list_dir("."), true = lists:member(UncommonName,NewDirFiles), + %% Ensure that we get the same result with a trailing slash; the + %% APIs used on Windows will choke on them if passed directly. + {ok,NewDirFiles} = ?FILE_MODULE:list_dir("./"), + %% Delete the directory and return to the old current directory %% and check that the created file isn't there (too!) expect({error, einval}, {error, eacces}, @@ -690,10 +712,15 @@ win_cur_dir_1(_Config) -> %% Get the drive letter from the current directory, %% and try to get current directory for that drive. - [Drive,$:|_] = BaseDir, - {ok,BaseDir} = ?FILE_MODULE:get_cwd([Drive,$:]), + [CurDrive,$:|_] = BaseDir, + {ok,BaseDir} = ?FILE_MODULE:get_cwd([CurDrive,$:]), io:format("BaseDir = ~s\n", [BaseDir]), + %% We should error out on non-existent drives. Any reasonable system will + %% have at least one. + CurDirs = [?FILE_MODULE:get_cwd([Drive,$:]) || Drive <- lists:seq($A, $Z)], + lists:member({error,eaccess}, CurDirs), + %% Unfortunately, there is no way to move away from the %% current drive as we can't use the "subst" command from %% a SSH connection. We can't test any more. @@ -831,7 +858,7 @@ no_untranslatable_names() -> end. start_node(Name, Args) -> - [_,Host] = string:tokens(atom_to_list(node()), "@"), + [_,Host] = string:lexemes(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} -> @@ -1019,6 +1046,23 @@ close(Config) when is_list(Config) -> Val = ?FILE_MODULE:close(Fd1), io:format("Second close gave: ~p",[Val]), + %% All operations on a closed raw file should EINVAL, even if they're not + %% supported on the current platform. + {ok,Fd2} = ?FILE_MODULE:open(Name, [read, write, raw]), + ok = ?FILE_MODULE:close(Fd2), + + {error, einval} = ?FILE_MODULE:advise(Fd2, 5, 5, normal), + {error, einval} = ?FILE_MODULE:allocate(Fd2, 5, 5), + {error, einval} = ?FILE_MODULE:close(Fd2), + {error, einval} = ?FILE_MODULE:datasync(Fd2), + {error, einval} = ?FILE_MODULE:position(Fd2, 5), + {error, einval} = ?FILE_MODULE:pread(Fd2, 5, 1), + {error, einval} = ?FILE_MODULE:pwrite(Fd2, 5, "einval please"), + {error, einval} = ?FILE_MODULE:read(Fd2, 1), + {error, einval} = ?FILE_MODULE:sync(Fd2), + {error, einval} = ?FILE_MODULE:truncate(Fd2), + {error, einval} = ?FILE_MODULE:write(Fd2, "einval please"), + [] = flush(), ok. @@ -1132,8 +1176,8 @@ pread_write_test(File, Data) -> end, I = Size + 17, ok = ?FILE_MODULE:pwrite(File, 0, Data), - Res = ?FILE_MODULE:pread(File, 0, I), - {ok, Data} = Res, + {ok, Data} = ?FILE_MODULE:pread(File, 0, I), + {ok, [Data]} = ?FILE_MODULE:pread(File, [{0, I}]), eof = ?FILE_MODULE:pread(File, I, 1), ok = ?FILE_MODULE:pwrite(File, [{0, Data}, {I, Data}]), {ok, [Data, eof, Data]} = @@ -2044,13 +2088,22 @@ names(Config) when is_list(Config) -> ok = ?FILE_MODULE:close(Fd2), {ok,Fd3} = ?FILE_MODULE:open(Name3,read), ok = ?FILE_MODULE:close(Fd3), + + %% Now try the same on raw files. + {ok,Fd4} = ?FILE_MODULE:open(Name2, [read, raw]), + ok = ?FILE_MODULE:close(Fd4), + {ok,Fd4f} = ?FILE_MODULE:open(lists:flatten(Name2), [read, raw]), + ok = ?FILE_MODULE:close(Fd4f), + {ok,Fd5} = ?FILE_MODULE:open(Name3, [read, raw]), + ok = ?FILE_MODULE:close(Fd5), + case length(Name1) > 255 of true -> io:format("Path too long for an atom:\n\n~p\n", [Name1]); false -> Name4 = list_to_atom(Name1), - {ok,Fd4} = ?FILE_MODULE:open(Name4,read), - ok = ?FILE_MODULE:close(Fd4) + {ok,Fd6} = ?FILE_MODULE:open(Name4,read), + ok = ?FILE_MODULE:close(Fd6) end, %% Try some path names @@ -2074,6 +2127,22 @@ names(Config) when is_list(Config) -> [] = flush(), ok. +volume_relative_paths(Config) when is_list(Config) -> + case os:type() of + {win32, _} -> + {ok, [Drive, $: | _]} = file:get_cwd(), + %% Relative to current device root. + {ok, RootInfo} = file:read_file_info([Drive, $:, $/]), + {ok, RootInfo} = file:read_file_info("/"), + %% Relative to current device directory. + {ok, DirContents} = file:list_dir([Drive, $:]), + {ok, DirContents} = file:list_dir("."), + [] = flush(), + ok; + _ -> + {skip, "This test is Windows-specific."} + end. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -2641,8 +2710,8 @@ altname(Config) when is_list(Config) -> {skipped, "Altname not supported on this platform"}; {ok, "LONGAL~1"} -> {ok, "A_FILE~1"} = ?FILE_MODULE:altname(Name), - {ok, "C:/"} = ?FILE_MODULE:altname("C:/"), - {ok, "C:\\"} = ?FILE_MODULE:altname("C:\\"), + {ok, "c:/"} = ?FILE_MODULE:altname("C:/"), + {ok, "c:/"} = ?FILE_MODULE:altname("C:\\"), {error,enoent} = ?FILE_MODULE:altname(NonexName), {ok, "short"} = ?FILE_MODULE:altname(ShortName), ok @@ -2923,20 +2992,22 @@ delayed_write(Config) when is_list(Config) -> %% %% Test caching and normal close of non-raw file {ok, Fd1} = - ?FILE_MODULE:open(File, [write, {delayed_write, Size+1, 2000}]), + ?FILE_MODULE:open(File, [write, {delayed_write, Size+1, 400}]), ok = ?FILE_MODULE:write(Fd1, Data1), - timer:sleep(1000), % Just in case the file system is slow + %% Wait for a reasonable amount of time to check whether the write was + %% practically instantaneous or actually delayed. + timer:sleep(100), {ok, Fd2} = ?FILE_MODULE:open(File, [read]), eof = ?FILE_MODULE:read(Fd2, 1), ok = ?FILE_MODULE:write(Fd1, Data1), % Data flush on size - timer:sleep(1000), % Just in case the file system is slow + timer:sleep(100), {ok, Data1Data1} = ?FILE_MODULE:pread(Fd2, bof, 2*Size+1), ok = ?FILE_MODULE:write(Fd1, Data1), - timer:sleep(3000), % Wait until data flush on timeout + timer:sleep(500), % Wait until data flush on timeout {ok, Data1Data1Data1} = ?FILE_MODULE:pread(Fd2, bof, 3*Size+1), ok = ?FILE_MODULE:write(Fd1, Data1), ok = ?FILE_MODULE:close(Fd1), % Data flush on close - timer:sleep(1000), % Just in case the file system is slow + timer:sleep(100), {ok, Data1Data1Data1Data1} = ?FILE_MODULE:pread(Fd2, bof, 4*Size+1), ok = ?FILE_MODULE:close(Fd2), %% @@ -2970,7 +3041,7 @@ delayed_write(Config) when is_list(Config) -> {'DOWN', Mref1, _, _, _} = Down1a -> ct:fail(Down1a) end, - timer:sleep(1000), % Just in case the file system is slow + timer:sleep(100), % Just in case the file system is slow {ok, Fd3} = ?FILE_MODULE:open(File, [read]), eof = ?FILE_MODULE:read(Fd3, 1), Child1 ! {Parent, continue, normal}, @@ -2980,7 +3051,7 @@ delayed_write(Config) when is_list(Config) -> {'DOWN', Mref1, _, _, _} = Down1b -> ct:fail(Down1b) end, - timer:sleep(1000), % Just in case the file system is slow + timer:sleep(100), % Just in case the file system is slow {ok, Data1} = ?FILE_MODULE:pread(Fd3, bof, Size+1), ok = ?FILE_MODULE:close(Fd3), %% @@ -2993,7 +3064,7 @@ delayed_write(Config) when is_list(Config) -> {'DOWN', Mref2, _, _, _} = Down2a -> ct:fail(Down2a) end, - timer:sleep(1000), % Just in case the file system is slow + timer:sleep(100), % Just in case the file system is slow {ok, Fd4} = ?FILE_MODULE:open(File, [read]), eof = ?FILE_MODULE:read(Fd4, 1), Child2 ! {Parent, continue, kill}, @@ -3003,7 +3074,7 @@ delayed_write(Config) when is_list(Config) -> {'DOWN', Mref2, _, _, _} = Down2b -> ct:fail(Down2b) end, - timer:sleep(1000), % Just in case the file system is slow + timer:sleep(100), % Just in case the file system is slow eof = ?FILE_MODULE:pread(Fd4, bof, 1), ok = ?FILE_MODULE:close(Fd4), %% @@ -3095,6 +3166,16 @@ read_ahead(Config) when is_list(Config) -> Data1Data2Data3 = Data1++Data2++Data3, {ok, Data1Data2Data3} = ?FILE_MODULE:read(Fd5, 3*Size+1), ok = ?FILE_MODULE:close(Fd5), + + %% Ensure that a read that draws from both the buffer and the file won't + %% return anything wonky. + SplitData = << <<(I rem 256)>> || I <- lists:seq(1, 1024) >>, + file:write_file(File, SplitData), + {ok, Fd6} = ?FILE_MODULE:open(File, [raw, read, binary, {read_ahead, 256}]), + {ok, <<1>>} = file:read(Fd6, 1), + <<1, Shifted:512/binary, _Rest/binary>> = SplitData, + {ok, Shifted} = file:read(Fd6, 512), + %% [] = flush(), ok. @@ -3699,6 +3780,83 @@ do_large_write(Name) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Benchmarks +%% +%% Note that we only measure the time it takes to run the isolated file +%% operations and that the actual test runtime can differ significantly, +%% especially on the write side as the files need to be truncated before +%% writing. + +large_writes(Config) when is_list(Config) -> + Modes = [raw, binary], + OpCount = 4096, + Data = <<0:(64 bsl 10)/unit:8>>, + run_write_benchmark(Config, Modes, OpCount, Data). + +large_writes_delayed(Config) when is_list(Config) -> + %% Each write is exactly as large as the delay buffer, causing the writes + %% to pass through each time, giving us a decent idea of how much overhead + %% delayed_write adds. + Modes = [raw, binary, {delayed_write, 64 bsl 10, 2000}], + OpCount = 4096, + Data = <<0:(64 bsl 10)/unit:8>>, + run_write_benchmark(Config, Modes, OpCount, Data). + +tiny_writes(Config) when is_list(Config) -> + Modes = [raw, binary], + OpCount = 512 bsl 10, + Data = <<0>>, + run_write_benchmark(Config, Modes, OpCount, Data). + +tiny_writes_delayed(Config) when is_list(Config) -> + Modes = [raw, binary, {delayed_write, 512 bsl 10, 2000}], + OpCount = 512 bsl 10, + Data = <<0>>, + run_write_benchmark(Config, Modes, OpCount, Data). + +%% The read benchmarks assume that "benchmark_scratch_file" has been filled by +%% the write benchmarks. + +tiny_reads(Config) when is_list(Config) -> + Modes = [raw, binary], + OpCount = 512 bsl 10, + run_read_benchmark(Config, Modes, OpCount, 1). + +tiny_reads_ahead(Config) when is_list(Config) -> + Modes = [raw, binary, {read_ahead, 512 bsl 10}], + OpCount = 512 bsl 10, + run_read_benchmark(Config, Modes, OpCount, 1). + +run_write_benchmark(Config, Modes, OpCount, Data) -> + run_benchmark(Config, [write | Modes], OpCount, fun file:write/2, Data). + +run_read_benchmark(Config, Modes, OpCount, OpSize) -> + run_benchmark(Config, [read | Modes], OpCount, fun file:read/2, OpSize). + +run_benchmark(Config, Modes, OpCount, Fun, Arg) -> + ScratchDir = proplists:get_value(priv_dir, Config), + Path = filename:join(ScratchDir, "benchmark_scratch_file"), + {ok, Fd} = file:open(Path, Modes), + submit_throughput_results(Fun, [Fd, Arg], OpCount). + +submit_throughput_results(Fun, Args, Times) -> + MSecs = measure_repeated_file_op(Fun, Args, Times, millisecond), + IOPS = trunc(Times * (1000 / MSecs)), + ct_event:notify(#event{ name = benchmark_data, data = [{value,IOPS}] }), + {comment, io_lib:format("~p IOPS, ~p ms", [IOPS, trunc(MSecs)])}. + +measure_repeated_file_op(Fun, Args, Times, Unit) -> + Start = os:perf_counter(Unit), + repeated_apply(Fun, Args, Times), + os:perf_counter(Unit) - Start. + +repeated_apply(_F, _Args, Times) when Times =< 0 -> + ok; +repeated_apply(F, Args, Times) -> + erlang:apply(F, Args), + repeated_apply(F, Args, Times - 1). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% response_analysis(Module, Function, Arguments) -> @@ -3934,7 +4092,7 @@ read_line_create_files(TestData) -> read_line_remove_files(TestData) -> [ file:delete(File) || {_Function,File,_,_} <- TestData ]. -%% read_line with prim_file. +%% read_line with ?PRIM_FILE. read_line_1(Config) when is_list(Config) -> PrivDir = proplists:get_value(priv_dir, Config), All = read_line_testdata(PrivDir), @@ -4103,9 +4261,9 @@ read_line_create7(Filename) -> file:close(F). read_line_all(Filename) -> - {ok,F} = prim_file:open(Filename,[read,binary]), + {ok,F} = ?PRIM_FILE:open(Filename,[read,binary]), X=read_rl_lines(F), - prim_file:close(F), + ?PRIM_FILE:close(F), Bin = list_to_binary([B || {ok,B} <- X]), Bin = re:replace(list_to_binary([element(2,file:read_file(Filename))]), "\r\n","\n",[global,{return,binary}]), @@ -4138,7 +4296,7 @@ read_line_all4(Filename) -> {length(X),Bin}. read_rl_lines(F) -> - case prim_file:read_line(F) of + case ?PRIM_FILE:read_line(F) of eof -> []; {error,X} -> @@ -4158,9 +4316,9 @@ read_rl_lines2(F) -> end. read_line_all_alternating(Filename) -> - {ok,F} = prim_file:open(Filename,[read,binary]), + {ok,F} = ?PRIM_FILE:open(Filename,[read,binary]), X=read_rl_lines(F,true), - prim_file:close(F), + ?PRIM_FILE:close(F), Bin = list_to_binary([B || {ok,B} <- X]), Bin = re:replace(list_to_binary([element(2,file:read_file(Filename))]), "\r\n","\n",[global,{return,binary}]), @@ -4194,8 +4352,8 @@ read_line_all_alternating4(Filename) -> read_rl_lines(F,Alternate) -> case begin case Alternate of - true -> prim_file:read(F,1); - false -> prim_file:read_line(F) + true -> ?PRIM_FILE:read(F,1); + false -> ?PRIM_FILE:read_line(F) end end of eof -> diff --git a/lib/kernel/test/file_name_SUITE.erl b/lib/kernel/test/file_name_SUITE.erl index 899102c908..3afc647081 100644 --- a/lib/kernel/test/file_name_SUITE.erl +++ b/lib/kernel/test/file_name_SUITE.erl @@ -77,6 +77,7 @@ init_per_testcase/2, end_per_testcase/2]). -export([normal/1,icky/1,very_icky/1,normalize/1,home_dir/1]). +-define(PRIM_FILE, prim_file). init_per_testcase(_Func, Config) -> Config. @@ -131,7 +132,7 @@ home_dir(Config) when is_list(Config) -> os:putenv("HOME",NewHome), {"HOME",Save}; _ -> - rm_rf(prim_file,NewHome), + rm_rf(?PRIM_FILE,NewHome), throw(unsupported_os) end, try @@ -145,7 +146,7 @@ home_dir(Config) when is_list(Config) -> _ -> os:putenv(SaveOldName,SaveOldValue) end, - rm_rf(prim_file,NewHome) + rm_rf(?PRIM_FILE,NewHome) end catch throw:need_unicode_mode -> @@ -190,7 +191,7 @@ normal(Config) when is_list(Config) -> try Priv = proplists:get_value(priv_dir, Config), file:set_cwd(Priv), - ok = check_normal(prim_file), + ok = check_normal(?PRIM_FILE), ok = check_normal(file), %% If all is good, delete dir again (avoid hanging dir on windows) rm_rf(file,"normal_dir"), @@ -210,7 +211,7 @@ icky(Config) when is_list(Config) -> try Priv = proplists:get_value(priv_dir, Config), file:set_cwd(Priv), - ok = check_icky(prim_file), + ok = check_icky(?PRIM_FILE), ok = check_icky(file), %% If all is good, delete dir again (avoid hanging dir on windows) rm_rf(file,"icky_dir"), @@ -229,7 +230,7 @@ very_icky(Config) when is_list(Config) -> try Priv = proplists:get_value(priv_dir, Config), file:set_cwd(Priv), - case check_very_icky(prim_file) of + case check_very_icky(?PRIM_FILE) of need_unicode_mode -> {skipped,"VM needs to be started in Unicode filename mode"}; ok -> @@ -292,17 +293,14 @@ check_normal(Mod) -> ok end, [ begin - {ok, FD} = Mod:open(Name,[read]), - {ok, Content} = Mod:read(FD,1024), - ok = file:close(FD) - end || {regular,Name,Content} <- NormalDir ], - [ begin {ok, FD} = Mod:open(Name,[read,binary]), BC = list_to_binary(Content), {ok, BC} = Mod:read(FD,1024), ok = file:close(FD) end || {regular,Name,Content} <- NormalDir ], + {error, badarg} = Mod:rename("fil1\0tmp_fil2","tmp_fil1"), Mod:rename("fil1","tmp_fil1"), + {error, badarg} = Mod:read_file("tmp_fil1\0.txt"), {ok, <<"fil1">>} = Mod:read_file("tmp_fil1"), {error,enoent} = Mod:read_file("fil1"), Mod:rename("tmp_fil1","fil1"), @@ -410,11 +408,6 @@ check_icky(Mod) -> ok end, [ begin - {ok, FD} = Mod:open(Name,[read]), - {ok, Content} = Mod:read(FD,1024), - ok = file:close(FD) - end || {regular,Name,Content} <- IckyDir ], - [ begin {ok, FD} = Mod:open(Name,[read,binary]), BC = list_to_binary([Content]), {ok, BC} = Mod:read(FD,1024), @@ -519,11 +512,6 @@ check_very_icky(Mod) -> ok end, [ begin - {ok, FD} = Mod:open(Name,[read]), - {ok, Content} = Mod:read(FD,1024), - ok = file:close(FD) - end || {regular,Name,Content} <- VeryIckyDir ], - [ begin {ok, FD} = Mod:open(Name,[read,binary]), BC = list_to_binary([Content]), {ok, BC} = Mod:read(FD,1024), diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl index 331864b5de..e47023d201 100644 --- a/lib/kernel/test/gen_tcp_misc_SUITE.erl +++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl @@ -1572,52 +1572,56 @@ fill_sendq(Config) when is_list(Config) -> Master = self(), Server = spawn_link(fun () -> - {ok,L} = gen_tcp:listen - (0, [{active,false},binary, - {reuseaddr,true},{packet,0}]), + {ok,L} = gen_tcp:listen(0, [{active,false},binary, + {reuseaddr,true},{packet,0}]), {ok,Port} = inet:port(L), Master ! {self(),client, fill_sendq_client(Port, Master)}, fill_sendq_srv(L, Master) end), io:format("~p Server~n", [Server]), - receive {Server,client,Client} -> - io:format("~p Client~n", [Client]), - receive {Server,reader,Reader} -> - io:format("~p Reader~n", [Reader]), - fill_sendq_loop(Server, Client, Reader) + receive + {Server,client,Client} -> + io:format("~p Client~n", [Client]), + receive + {Server,reader,Reader} -> + io:format("~p Reader~n", [Reader]), + fill_sendq_loop(Server, Client, Reader) end end. fill_sendq_loop(Server, Client, Reader) -> %% Master %% - receive {Server,send} -> + receive + {Server,send} -> fill_sendq_loop(Server, Client, Reader) after 2000 -> %% Send queue full, sender blocked -> close client. io:format("Send timeout, closing Client...~n", []), Client ! {self(),close}, - receive {Server,[{error,closed}]} -> - io:format("Got server closed.~n"), - receive {Reader,[{error,closed}]} -> - io:format - ("Got reader closed.~n"), - ok - after 3000 -> - ct:fail({timeout,{closed,reader}}) - end; - {Reader,[{error,closed}]} -> - io:format("Got reader closed.~n"), - receive {Server,[{error,closed}]} -> - io:format("Got server closed~n"), - ok - after 3000 -> - ct:fail({timeout,{closed,server}}) - end - after 3000 -> - ct:fail({timeout,{closed,[server,reader]}}) - end + receive + {Server,[{error,closed}]} -> + io:format("Got server closed.~n"), + receive + {Reader,[{error,closed}]} -> + io:format("Got reader closed.~n"), + ok + after 3000 -> + ct:fail({timeout,{closed,reader}}) + end; + {Reader,[{error,closed}]} -> + io:format("Got reader closed.~n"), + receive + {Server,[{error,closed}]} -> + io:format("Got server closed~n"), + ok + after 3000 -> + ct:fail({timeout,{closed,server}}) + end + after 3000 -> + ct:fail({timeout,{closed,[server,reader]}}) + end end. fill_sendq_srv(L, Master) -> diff --git a/lib/kernel/test/gen_udp_SUITE.erl b/lib/kernel/test/gen_udp_SUITE.erl index aa616d43d6..96e495505a 100644 --- a/lib/kernel/test/gen_udp_SUITE.erl +++ b/lib/kernel/test/gen_udp_SUITE.erl @@ -288,58 +288,56 @@ bad_address(Config) when is_list(Config) -> %% %% Starts a slave node that on command sends a bunch of messages %% to our UDP port. The receiving process just receives and -%% ignores the incoming messages, but counts them. -%% A tracing process traces the receiving process for -%% 'receive' and scheduling events. From the trace, -%% message contents is verified; and, how many messages -%% are received per in/out scheduling, which should be -%% the same as the read_packets parameter. -%% -%% What happens on the SMP emulator remains to be seen... -%% +%% ignores the incoming messages. +%% A tracing process traces the receiving port for +%% 'send' and scheduling events. From the trace, +%% how many messages are received per in/out scheduling, +%% which should never be more than the read_packet parameter. %% OTP-6249 UDP option for number of packet reads. read_packets(Config) when is_list(Config) -> - case erlang:system_info(smp_support) of - false -> - read_packets_1(); - true -> - %% We would need some new sort of tracing to test this - %% option reliably in an SMP emulator. - {skip,"SMP emulator"} - end. - -read_packets_1() -> N1 = 5, - N2 = 7, + N2 = 1, + Msgs = 30000, {ok,R} = gen_udp:open(0, [{read_packets,N1}]), {ok,RP} = inet:port(R), {ok,Node} = start_node(gen_udp_SUITE_read_packets), Die = make_ref(), - Loop = erlang:spawn_link(fun () -> infinite_loop(Die) end), %% - Msgs1 = [erlang:integer_to_list(M) || M <- lists:seq(1, N1*3)], - [V1|_] = read_packets_test(R, RP, Msgs1, Node), + {V1, Trace1} = read_packets_test(R, RP, Msgs, Node), {ok,[{read_packets,N1}]} = inet:getopts(R, [read_packets]), %% ok = inet:setopts(R, [{read_packets,N2}]), - Msgs2 = [erlang:integer_to_list(M) || M <- lists:seq(1, N2*3)], - [V2|_] = read_packets_test(R, RP, Msgs2, Node), + {V2, Trace2} = read_packets_test(R, RP, Msgs, Node), {ok,[{read_packets,N2}]} = inet:getopts(R, [read_packets]), %% stop_node(Node), - Mref = erlang:monitor(process, Loop), - Loop ! Die, - receive - {'DOWN',Mref,_,_, normal} -> - case {V1,V2} of - {N1,N2} -> - ok; - _ when V1 =/= N1, V2 =/= N2 -> - ok - end + ct:log("N1=~p, V1=~p vs N2=~p, V2=~p",[N1,V1,N2,V2]), + + dump_terms(Config, "trace1.terms", Trace2), + dump_terms(Config, "trace2.terms", Trace2), + + %% Because of the inherit racy-ness of the feature it is + %% hard to test that it behaves correctly. + %% Right now (OTP 21) a port task takes 5% of the + %% allotted port task reductions to execute, so + %% the max number of executions a port is allowed to + %% do before being re-scheduled is N * 20 + + if + V1 > (N1 * 20) -> + ct:fail("Got ~p msgs, max was ~p", [V1, N1]); + V2 > (N2 * 20) -> + ct:fail("Got ~p msgs, max was ~p", [V2, N2]); + true -> + ok end. +dump_terms(Config, Name, Terms) -> + FName = filename:join(proplists:get_value(priv_dir, Config),Name), + file:write_file(FName, term_to_binary(Terms)), + ct:log("Logged terms to ~s",[FName]). + infinite_loop(Die) -> receive Die -> @@ -350,7 +348,6 @@ infinite_loop(Die) -> end. read_packets_test(R, RP, Msgs, Node) -> - Len = length(Msgs), Receiver = self(), Tracer = spawn_link( @@ -375,24 +372,24 @@ read_packets_test(R, RP, Msgs, Node) -> [link,{priority,high}]), receive {Sender,{port,SP}} -> - erlang:trace(self(), true, - [running,'receive',{tracer,Tracer}]), + erlang:trace(R, true, + [running_ports,'send',{tracer,Tracer}]), erlang:yield(), Sender ! {Receiver,go}, - read_packets_recv(Len), - erlang:trace(self(), false, [all]), + read_packets_recv(Msgs), + erlang:trace(R, false, [all]), Tracer ! {Receiver,get_trace}, receive {Tracer,{trace,Trace}} -> - read_packets_verify(R, SP, Msgs, Trace) + {read_packets_verify(R, SP, Trace), Trace} end end. -read_packets_send(S, RP, [Msg|Msgs]) -> - ok = gen_udp:send(S, localhost, RP, Msg), - read_packets_send(S, RP, Msgs); -read_packets_send(_S, _RP, []) -> - ok. +read_packets_send(_S, _RP, 0) -> + ok; +read_packets_send(S, RP, Msgs) -> + ok = gen_udp:send(S, localhost, RP, "UDP FLOOOOOOD"), + read_packets_send(S, RP, Msgs - 1). read_packets_recv(0) -> ok; @@ -404,23 +401,24 @@ read_packets_recv(N) -> timeout end. -read_packets_verify(R, SP, Msg, Trace) -> - lists:reverse( - lists:sort(read_packets_verify(R, SP, Msg, Trace, 0))). - -read_packets_verify(R, SP, Msgs, [{trace,Self,OutIn,_}|Trace], M) - when Self =:= self(), OutIn =:= out; - Self =:= self(), OutIn =:= in -> - push(M, read_packets_verify(R, SP, Msgs, Trace, 0)); -read_packets_verify(R, SP, [Msg|Msgs], - [{trace,Self,'receive',{udp,R,{127,0,0,1},SP,Msg}} - |Trace], M) +read_packets_verify(R, SP, Trace) -> + [Max | _] = Pkts = lists:reverse(lists:sort(read_packets_verify(R, SP, Trace, 0))), + ct:pal("~p",[lists:sublist(Pkts,10)]), + Max. + +read_packets_verify(R, SP, [{trace,R,OutIn,_}|Trace], M) + when OutIn =:= out; OutIn =:= in -> + push(M, read_packets_verify(R, SP, Trace, 0)); +read_packets_verify(R, SP, [{trace, R,'receive',timeout}|Trace], M) -> + push(M, read_packets_verify(R, SP, Trace, 0)); +read_packets_verify(R, SP, + [{trace,R,'send',{udp,R,{127,0,0,1},SP,_Msg}, Self} | Trace], M) when Self =:= self() -> - read_packets_verify(R, SP, Msgs, Trace, M+1); -read_packets_verify(_R, _SP, [], [], M) -> + read_packets_verify(R, SP, Trace, M+1); +read_packets_verify(_R, _SP, [], M) -> push(M, []); -read_packets_verify(_R, _SP, Msgs, Trace, M) -> - ct:fail({read_packets_verify,mismatch,Msgs,Trace,M}). +read_packets_verify(_R, _SP, Trace, M) -> + ct:fail({read_packets_verify,mismatch,Trace,M}). push(0, Vs) -> Vs; diff --git a/lib/kernel/test/kernel_bench.spec b/lib/kernel/test/kernel_bench.spec index 8de60dae31..4de133f21b 100644 --- a/lib/kernel/test/kernel_bench.spec +++ b/lib/kernel/test/kernel_bench.spec @@ -1 +1,2 @@ {groups,"../kernel_test",zlib_SUITE,[bench]}. +{groups,"../kernel_test",file_SUITE,[bench]}. diff --git a/lib/kernel/test/os_SUITE.erl b/lib/kernel/test/os_SUITE.erl index 079b9790f6..8056321448 100644 --- a/lib/kernel/test/os_SUITE.erl +++ b/lib/kernel/test/os_SUITE.erl @@ -22,11 +22,11 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2]). --export([space_in_cwd/1, quoting/1, cmd_unicode/1, space_in_name/1, bad_command/1, +-export([space_in_cwd/1, quoting/1, cmd_unicode/1, + null_in_command/1, space_in_name/1, bad_command/1, find_executable/1, unix_comment_in_command/1, deep_list_command/1, large_output_command/1, background_command/0, background_command/1, - message_leak/1, close_stdin/0, close_stdin/1, max_size_command/1, - perf_counter_api/1]). + message_leak/1, close_stdin/0, close_stdin/1, perf_counter_api/1]). -include_lib("common_test/include/ct.hrl"). @@ -35,10 +35,11 @@ suite() -> {timetrap,{minutes,1}}]. all() -> - [space_in_cwd, quoting, cmd_unicode, space_in_name, bad_command, + [space_in_cwd, quoting, cmd_unicode, null_in_command, + space_in_name, bad_command, find_executable, unix_comment_in_command, deep_list_command, large_output_command, background_command, message_leak, - close_stdin, max_size_command, perf_counter_api]. + close_stdin, perf_counter_api]. groups() -> []. @@ -126,6 +127,14 @@ cmd_unicode(Config) when is_list(Config) -> [] = receive_all(), ok. +null_in_command(Config) -> + {Ok, Error} = case os:type() of + {win32,_} -> {"dir", "di\0r"}; + _ -> {"ls", "l\0s"} + end, + true = is_list(try os:cmd(Ok) catch Class0:_ -> Class0 end), + error = try os:cmd(Error) catch Class1:_ -> Class1 end, + ok. %% Test that program with a space in its name can be executed. space_in_name(Config) when is_list(Config) -> @@ -313,19 +322,6 @@ close_stdin(Config) -> "-1" = os:cmd(Fds). -max_size_command(_Config) -> - - Res20 = os:cmd("cat /dev/zero", #{ max_size => 20 }), - 20 = length(Res20), - - Res0 = os:cmd("cat /dev/zero", #{ max_size => 0 }), - 0 = length(Res0), - - Res32768 = os:cmd("cat /dev/zero", #{ max_size => 32768 }), - 32768 = length(Res32768), - - ResHello = os:cmd("echo hello", #{ max_size => 20 }), - 6 = length(ResHello). %% Test that the os:perf_counter api works as expected perf_counter_api(_Config) -> diff --git a/lib/kernel/test/prim_file_SUITE.erl b/lib/kernel/test/prim_file_SUITE.erl index 2f4330c217..db753679ea 100644 --- a/lib/kernel/test/prim_file_SUITE.erl +++ b/lib/kernel/test/prim_file_SUITE.erl @@ -21,38 +21,23 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, init_per_testcase/2, end_per_testcase/2, read_write_file/1, free_memory/0]). --export([cur_dir_0a/1, cur_dir_0b/1, - cur_dir_1a/1, cur_dir_1b/1, - make_del_dir_a/1, make_del_dir_b/1, - pos1/1, pos2/1]). --export([close/1, - delete_a/1, delete_b/1]). --export([ open1/1, modes/1]). --export([ - file_info_basic_file_a/1, file_info_basic_file_b/1, - file_info_basic_directory_a/1, file_info_basic_directory_b/1, - file_info_bad_a/1, file_info_bad_b/1, - file_info_times_a/1, file_info_times_b/1, - file_write_file_info_a/1, file_write_file_info_b/1, - file_read_file_info_opts/1, file_write_file_info_opts/1, - file_write_read_file_info_opts/1 - ]). --export([rename_a/1, rename_b/1, - access/1, truncate/1, datasync/1, sync/1, +-export([cur_dir_0/1, cur_dir_1/1, + make_del_dir/1, pos1/1, pos2/1]). +-export([close/1, delete/1]). +-export([open1/1, modes/1]). +-export([file_info_basic_file/1, file_info_basic_directory/1, file_info_bad/1, + file_info_times/1, file_write_file_info/1, + file_read_file_info_opts/1, file_write_file_info_opts/1, + file_write_read_file_info_opts/1]). +-export([rename/1, access/1, truncate/1, datasync/1, sync/1, read_write/1, pread_write/1, append/1, exclusive/1]). --export([ e_delete/1, e_rename/1, e_make_dir/1, e_del_dir/1]). +-export([e_delete/1, e_rename/1, e_make_dir/1, e_del_dir/1]). --export([ read_not_really_compressed/1, - read_compressed/1, write_compressed/1, - compress_errors/1]). - --export([ - make_link_a/1, make_link_b/1, - read_link_info_for_non_link/1, - symlinks_a/1, symlinks_b/1, - list_dir_limit/1, - list_dir_error/1, - list_dir/1]). +-export([make_link/1, read_link_info_for_non_link/1, + symlinks/1, + list_dir_limit/1, + list_dir_error/1, + list_dir/1]). -export([advise/1]). -export([large_write/1]). @@ -67,29 +52,16 @@ -define(PRIM_FILE, prim_file). -%% Calls ?PRIM_FILE:F with arguments A and an optional handle H -%% as first argument, unless the handle is [], i.e no handle. -%% This is a macro to give the compiler and thereby -%% the cross reference tool the possibility to interprete -%% the call, since M, F, A (or [H | A]) can all be known at -%% compile time. --define(PRIM_FILE_call(F, H, A), - case H of - [] -> apply(?PRIM_FILE, F, A); - _ -> apply(?PRIM_FILE, F, [H | A]) - end). - suite() -> []. all() -> [read_write_file, {group, dirs}, {group, files}, - delete_a, delete_b, rename_a, rename_b, {group, errors}, - {group, compression}, {group, links}, list_dir_limit, list_dir]. + delete, rename, {group, errors}, {group, links}, + list_dir_limit, list_dir]. groups() -> [{dirs, [], - [make_del_dir_a, make_del_dir_b, cur_dir_0a, cur_dir_0b, - cur_dir_1a, cur_dir_1b]}, + [make_del_dir, cur_dir_0, cur_dir_1]}, {files, [], [{group, open}, {group, pos}, {group, file_info}, truncate, sync, datasync, advise, large_write, allocate]}, @@ -98,22 +70,14 @@ groups() -> append, exclusive]}, {pos, [], [pos1, pos2]}, {file_info, [], - [file_info_basic_file_a, file_info_basic_file_b, - file_info_basic_directory_a, - file_info_basic_directory_b, file_info_bad_a, - file_info_bad_b, file_info_times_a, file_info_times_b, - file_write_file_info_a, file_write_file_info_b, - file_read_file_info_opts, file_write_file_info_opts, - file_write_read_file_info_opts + [file_info_basic_file,file_info_basic_directory, file_info_bad, + file_info_times, file_write_file_info, file_read_file_info_opts, + file_write_file_info_opts, file_write_read_file_info_opts ]}, {errors, [], [e_delete, e_rename, e_make_dir, e_del_dir]}, - {compression, [], - [read_compressed, read_not_really_compressed, - write_compressed, compress_errors]}, {links, [], - [make_link_a, make_link_b, read_link_info_for_non_link, - symlinks_a, symlinks_b, list_dir_error]}]. + [make_link, read_link_info_for_non_link, symlinks, list_dir_error]}]. init_per_testcase(large_write, Config) -> {ok, Started} = application:ensure_all_started(os_mon), @@ -246,39 +210,27 @@ read_write_file(Config) when is_list(Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -make_del_dir_a(Config) when is_list(Config) -> - make_del_dir(Config, [], "_a"). - -make_del_dir_b(Config) when is_list(Config) -> - {ok, Handle} = ?PRIM_FILE:start(), - Result = make_del_dir(Config, Handle, "_b"), - ok = ?PRIM_FILE:stop(Handle), - %% Just to make sure the state of the server makes a difference - {error, einval} = ?PRIM_FILE_call(get_cwd, Handle, []), - Result. - -make_del_dir(Config, Handle, Suffix) -> +make_del_dir(Config) when is_list(Config) -> RootDir = proplists:get_value(priv_dir,Config), NewDir = filename:join(RootDir, atom_to_list(?MODULE) - ++"_mk-dir"++Suffix), - ok = ?PRIM_FILE_call(make_dir, Handle, [NewDir]), - {error, eexist} = ?PRIM_FILE_call(make_dir, Handle, [NewDir]), - ok = ?PRIM_FILE_call(del_dir, Handle, [NewDir]), - {error, enoent} = ?PRIM_FILE_call(del_dir, Handle, [NewDir]), + ++"_mk-dir"), + ok = ?PRIM_FILE:make_dir(NewDir), + {error, eexist} = ?PRIM_FILE:make_dir(NewDir), + ok = ?PRIM_FILE:del_dir(NewDir), + {error, enoent} = ?PRIM_FILE:del_dir(NewDir), %% Make sure we are not in a directory directly under test_server %% as that would result in eacces errors when trying to delete '..', %% because there are processes having that directory as current. - ok = ?PRIM_FILE_call(make_dir, Handle, [NewDir]), - {ok, CurrentDir} = ?PRIM_FILE_call(get_cwd, Handle, []), + ok = ?PRIM_FILE:make_dir(NewDir), + {ok, CurrentDir} = ?PRIM_FILE:get_cwd(), case {os:type(), length(NewDir) >= 260 } of {{win32,_}, true} -> io:format("Skip set_cwd for windows path longer than 260 (MAX_PATH)\n", []), io:format("\nNewDir = ~p\n", [NewDir]); _ -> - ok = ?PRIM_FILE_call(set_cwd, Handle, [NewDir]) + ok = ?PRIM_FILE:set_cwd(NewDir) end, try %% Check that we get an error when trying to create... @@ -286,14 +238,14 @@ make_del_dir(Config, Handle, Suffix) -> NewDir2 = filename:join(RootDir, atom_to_list(?MODULE) ++"_mk-dir-noexist/foo"), - {error, enoent} = ?PRIM_FILE_call(make_dir, Handle, [NewDir2]), + {error, enoent} = ?PRIM_FILE:make_dir(NewDir2), %% a nameless directory - {error, enoent} = ?PRIM_FILE_call(make_dir, Handle, [""]), + {error, enoent} = ?PRIM_FILE:make_dir(""), %% a directory with illegal name - {error, badarg} = ?PRIM_FILE_call(make_dir, Handle, ['mk-dir']), + {error, badarg} = ?PRIM_FILE:make_dir('mk-dir'), %% a directory with illegal name, even if it's a (bad) list - {error, badarg} = ?PRIM_FILE_call(make_dir, Handle, [[1,2,3,{}]]), + {error, badarg} = ?PRIM_FILE:make_dir([1,2,3,{}]), %% Maybe this isn't an error, exactly, but worth mentioning anyway: %% ok = ?PRIM_FILE:make_dir([$f,$o,$o,0,$b,$a,$r])), @@ -306,125 +258,101 @@ make_del_dir(Config, Handle, Suffix) -> %% Try deleting some bad directories %% Deleting the parent directory to the current, sounds dangerous, huh? %% Don't worry ;-) the parent directory should never be empty, right? - case ?PRIM_FILE_call(del_dir, Handle, [".."]) of + case ?PRIM_FILE:del_dir("..") of {error, eexist} -> ok; {error, eacces} -> ok; %OpenBSD {error, einval} -> ok %FreeBSD end, - {error, enoent} = ?PRIM_FILE_call(del_dir, Handle, [""]), - {error, badarg} = ?PRIM_FILE_call(del_dir, Handle, [[3,2,1,{}]]) + {error, enoent} = ?PRIM_FILE:del_dir(""), + {error, badarg} = ?PRIM_FILE:del_dir([3,2,1,{}]) after - ok = ?PRIM_FILE_call(set_cwd, Handle, [CurrentDir]) + ok = ?PRIM_FILE:set_cwd(CurrentDir) end, ok. -cur_dir_0a(Config) when is_list(Config) -> - cur_dir_0(Config, []). - -cur_dir_0b(Config) when is_list(Config) -> - {ok, Handle} = ?PRIM_FILE:start(), - Result = cur_dir_0(Config, Handle), - ok = ?PRIM_FILE:stop(Handle), - Result. - -cur_dir_0(Config, Handle) -> +cur_dir_0(Config) when is_list(Config) -> %% Find out the current dir, and cd to it ;-) - {ok,BaseDir} = ?PRIM_FILE_call(get_cwd, Handle, []), + {ok,BaseDir} = ?PRIM_FILE:get_cwd(), Dir1 = BaseDir ++ "", %% Check that it's a string - ok = ?PRIM_FILE_call(set_cwd, Handle, [Dir1]), - DirName = atom_to_list(?MODULE) ++ - case Handle of - [] -> - "_curdir"; - _ -> - "_curdir_h" - end, + ok = ?PRIM_FILE:set_cwd(Dir1), + DirName = atom_to_list(?MODULE) ++ "_curdir", %% Make a new dir, and cd to that RootDir = proplists:get_value(priv_dir,Config), NewDir = filename:join(RootDir, DirName), - ok = ?PRIM_FILE_call(make_dir, Handle, [NewDir]), + ok = ?PRIM_FILE:make_dir(NewDir), case {os:type(), length(NewDir) >= 260} of {{win32,_}, true} -> io:format("Skip set_cwd for windows path longer than 260 (MAX_PATH):\n"), io:format("\nNewDir = ~p\n", [NewDir]); _ -> io:format("cd to ~s",[NewDir]), - ok = ?PRIM_FILE_call(set_cwd, Handle, [NewDir]), + ok = ?PRIM_FILE:set_cwd(NewDir), %% Create a file in the new current directory, and check that it %% really is created there UncommonName = "uncommon.fil", {ok,Fd} = ?PRIM_FILE:open(UncommonName, [read, write]), ok = ?PRIM_FILE:close(Fd), - {ok,NewDirFiles} = ?PRIM_FILE_call(list_dir, Handle, ["."]), + {ok,NewDirFiles} = ?PRIM_FILE:list_dir("."), true = lists:member(UncommonName,NewDirFiles), %% Delete the directory and return to the old current directory %% and check that the created file isn't there (too!) expect({error, einval}, {error, eacces}, {error, eexist}, - ?PRIM_FILE_call(del_dir, Handle, [NewDir])), - ?PRIM_FILE_call(delete, Handle, [UncommonName]), - {ok,[]} = ?PRIM_FILE_call(list_dir, Handle, ["."]), - ok = ?PRIM_FILE_call(set_cwd, Handle, [Dir1]), + ?PRIM_FILE:del_dir(NewDir)), + ?PRIM_FILE:delete(UncommonName), + {ok,[]} = ?PRIM_FILE:list_dir("."), + ok = ?PRIM_FILE:set_cwd(Dir1), io:format("cd back to ~s",[Dir1]), - ok = ?PRIM_FILE_call(del_dir, Handle, [NewDir]), - {error, enoent} = ?PRIM_FILE_call(set_cwd, Handle, [NewDir]), - ok = ?PRIM_FILE_call(set_cwd, Handle, [Dir1]), + ok = ?PRIM_FILE:del_dir(NewDir), + {error, enoent} = ?PRIM_FILE:set_cwd(NewDir), + ok = ?PRIM_FILE:set_cwd(Dir1), io:format("cd back to ~s",[Dir1]), - {ok,OldDirFiles} = ?PRIM_FILE_call(list_dir, Handle, ["."]), + {ok,OldDirFiles} = ?PRIM_FILE:list_dir("."), false = lists:member(UncommonName,OldDirFiles) end, %% Try doing some bad things {error, badarg} = - ?PRIM_FILE_call(set_cwd, Handle, [{foo,bar}]), + ?PRIM_FILE:set_cwd({foo,bar}), {error, enoent} = - ?PRIM_FILE_call(set_cwd, Handle, [""]), + ?PRIM_FILE:set_cwd(""), {error, enoent} = - ?PRIM_FILE_call(set_cwd, Handle, [".......a......"]), + ?PRIM_FILE:set_cwd(".......a......"), {ok,BaseDir} = - ?PRIM_FILE_call(get_cwd, Handle, []), %% Still there? + ?PRIM_FILE:get_cwd(), %% Still there? %% On Windows, there should only be slashes, no backslashes, %% in the return value of get_cwd(). %% (The test is harmless on Unix, because filenames usually %% don't contain backslashes.) - {ok, BaseDir} = ?PRIM_FILE_call(get_cwd, Handle, []), + {ok, BaseDir} = ?PRIM_FILE:get_cwd(), false = lists:member($\\, BaseDir), ok. %% Tests ?PRIM_FILE:get_cwd/1. -cur_dir_1a(Config) when is_list(Config) -> - cur_dir_1(Config, []). - -cur_dir_1b(Config) when is_list(Config) -> - {ok, Handle} = ?PRIM_FILE:start(), - Result = cur_dir_1(Config, Handle), - ok = ?PRIM_FILE:stop(Handle), - Result. - -cur_dir_1(Config, Handle) -> +cur_dir_1(Config) when is_list(Config) -> case os:type() of {win32, _} -> - win_cur_dir_1(Config, Handle); + win_cur_dir_1(Config); _ -> {error, enotsup} = - ?PRIM_FILE_call(get_cwd, Handle, ["d:"]) + ?PRIM_FILE:get_cwd("d:") end, ok. -win_cur_dir_1(_Config, Handle) -> - {ok, BaseDir} = ?PRIM_FILE_call(get_cwd, Handle, []), +win_cur_dir_1(_Config) -> + {ok, BaseDir} = ?PRIM_FILE:get_cwd(), %% Get the drive letter from the current directory, %% and try to get current directory for that drive. [Drive, $:|_] = BaseDir, - {ok, BaseDir} = ?PRIM_FILE_call(get_cwd, Handle, [[Drive, $:]]), + {ok, BaseDir} = ?PRIM_FILE:get_cwd([Drive, $:]), io:format("BaseDir = ~s\n", [BaseDir]), %% Unfortunately, there is no way to move away from the @@ -446,12 +374,12 @@ open1(Config) when is_list(Config) -> Name = filename:join(NewDir, "foo1.fil"), {ok,Fd1} = ?PRIM_FILE:open(Name, [read, write]), {ok,Fd2} = ?PRIM_FILE:open(Name, [read]), - Str = "{a,tuple}.\n", - Length = length(Str), - ?PRIM_FILE:write(Fd1,Str), + Bin = list_to_binary("{a,tuple}.\n"), + Length = byte_size(Bin), + ?PRIM_FILE:write(Fd1,Bin), {ok,0} = ?PRIM_FILE:position(Fd1,bof), - {ok, Str} = ?PRIM_FILE:read(Fd1,Length), - {ok, Str} = ?PRIM_FILE:read(Fd2,Length), + {ok, Bin} = ?PRIM_FILE:read(Fd1,Length), + {ok, Bin} = ?PRIM_FILE:read(Fd2,Length), ok = ?PRIM_FILE:close(Fd2), {ok,0} = ?PRIM_FILE:position(Fd1,bof), ok = ?PRIM_FILE:truncate(Fd1), @@ -471,13 +399,13 @@ modes(Config) when is_list(Config) -> ++"_open_modes"), ok = ?PRIM_FILE:make_dir(NewDir), Name1 = filename:join(NewDir, "foo1.fil"), - Marker = "hello, world", - Length = length(Marker), + Marker = <<"hello, world">>, + Length = byte_size(Marker), %% write {ok, Fd1} = ?PRIM_FILE:open(Name1, [write]), ok = ?PRIM_FILE:write(Fd1, Marker), - ok = ?PRIM_FILE:write(Fd1, ".\n"), + ok = ?PRIM_FILE:write(Fd1, <<".\n">>), ok = ?PRIM_FILE:close(Fd1), %% read @@ -496,12 +424,6 @@ modes(Config) when is_list(Config) -> {ok, Marker} = ?PRIM_FILE:read(Fd4, Length), ok = ?PRIM_FILE:close(Fd4), - %% read and binary - BinaryMarker = list_to_binary(Marker), - {ok, Fd5} = ?PRIM_FILE:open(Name1, [read, binary]), - {ok, BinaryMarker} = ?PRIM_FILE:read(Fd5, Length), - ok = ?PRIM_FILE:close(Fd5), - ok. close(Config) when is_list(Config) -> @@ -528,9 +450,9 @@ access(Config) when is_list(Config) -> Name = filename:join(RootDir, atom_to_list(?MODULE) ++"_access.fil"), - Str = "ABCDEFGH", + Bin = <<"ABCDEFGH">>, {ok,Fd1} = ?PRIM_FILE:open(Name, [write]), - ?PRIM_FILE:write(Fd1,Str), + ?PRIM_FILE:write(Fd1,Bin), ok = ?PRIM_FILE:close(Fd1), %% Check that we can't write when in read only mode {ok,Fd2} = ?PRIM_FILE:open(Name, [read]), @@ -542,7 +464,7 @@ access(Config) when is_list(Config) -> end, ok = ?PRIM_FILE:close(Fd2), {ok, Fd3} = ?PRIM_FILE:open(Name, [read]), - {ok, Str} = ?PRIM_FILE:read(Fd3,length(Str)), + {ok, Bin} = ?PRIM_FILE:read(Fd3,byte_size(Bin)), ok = ?PRIM_FILE:close(Fd3), ok. @@ -564,7 +486,7 @@ read_write(Config) when is_list(Config) -> ok. read_write_test(File) -> - Marker = "hello, world", + Marker = <<"hello, world">>, ok = ?PRIM_FILE:write(File, Marker), {ok, 0} = ?PRIM_FILE:position(File, 0), {ok, Marker} = ?PRIM_FILE:read(File, 100), @@ -590,15 +512,15 @@ pread_write(Config) when is_list(Config) -> ok. pread_write_test(File) -> - Marker = "hello, world", - Len = length(Marker), + Marker = <<"hello, world">>, + Len = byte_size(Marker), ok = ?PRIM_FILE:write(File, Marker), {ok, Marker} = ?PRIM_FILE:pread(File, 0, 100), eof = ?PRIM_FILE:pread(File, 100, 1), ok = ?PRIM_FILE:pwrite(File, Len, Marker), {ok, Marker} = ?PRIM_FILE:pread(File, Len, 100), eof = ?PRIM_FILE:pread(File, 100, 1), - MM = Marker ++ Marker, + MM = <<Marker/binary,Marker/binary>>, {ok, MM} = ?PRIM_FILE:pread(File, 0, 100), ok = ?PRIM_FILE:close(File), ok. @@ -655,24 +577,24 @@ pos1(Config) when is_list(Config) -> atom_to_list(?MODULE) ++"_pos1.fil"), {ok, Fd1} = ?PRIM_FILE:open(Name, [write]), - ?PRIM_FILE:write(Fd1,"ABCDEFGH"), + ?PRIM_FILE:write(Fd1,<<"ABCDEFGH">>), ok = ?PRIM_FILE:close(Fd1), {ok, Fd2} = ?PRIM_FILE:open(Name, [read]), %% Start pos is first char io:format("Relative positions"), - {ok, "A"} = ?PRIM_FILE:read(Fd2,1), + {ok, <<"A">>} = ?PRIM_FILE:read(Fd2,1), {ok, 2} = ?PRIM_FILE:position(Fd2,{cur,1}), - {ok, "C"} = ?PRIM_FILE:read(Fd2,1), + {ok, <<"C">>} = ?PRIM_FILE:read(Fd2,1), {ok, 0} = ?PRIM_FILE:position(Fd2,{cur,-3}), - {ok, "A"} = ?PRIM_FILE:read(Fd2,1), + {ok, <<"A">>} = ?PRIM_FILE:read(Fd2,1), %% Backwards from first char should be an error {ok,0} = ?PRIM_FILE:position(Fd2,{cur,-1}), {error, einval} = ?PRIM_FILE:position(Fd2,{cur,-1}), %% Reset position and move again {ok, 0} = ?PRIM_FILE:position(Fd2,0), {ok, 2} = ?PRIM_FILE:position(Fd2,{cur,2}), - {ok, "C"} = ?PRIM_FILE:read(Fd2,1), + {ok, <<"C">>} = ?PRIM_FILE:read(Fd2,1), %% Go a lot forwards {ok, 13} = ?PRIM_FILE:position(Fd2,{cur,10}), eof = ?PRIM_FILE:read(Fd2,1), @@ -684,27 +606,27 @@ pos1(Config) when is_list(Config) -> {ok, 8} = ?PRIM_FILE:position(Fd2,cur), eof = ?PRIM_FILE:read(Fd2,1), {ok, 7} = ?PRIM_FILE:position(Fd2,7), - {ok, "H"} = ?PRIM_FILE:read(Fd2,1), + {ok, <<"H">>} = ?PRIM_FILE:read(Fd2,1), {ok, 0} = ?PRIM_FILE:position(Fd2,0), - {ok, "A"} = ?PRIM_FILE:read(Fd2,1), + {ok, <<"A">>} = ?PRIM_FILE:read(Fd2,1), {ok, 3} = ?PRIM_FILE:position(Fd2,3), - {ok, "D"} = ?PRIM_FILE:read(Fd2,1), + {ok, <<"D">>} = ?PRIM_FILE:read(Fd2,1), {ok, 12} = ?PRIM_FILE:position(Fd2,12), eof = ?PRIM_FILE:read(Fd2,1), {ok, 3} = ?PRIM_FILE:position(Fd2,3), - {ok, "D"} = ?PRIM_FILE:read(Fd2,1), + {ok, <<"D">>} = ?PRIM_FILE:read(Fd2,1), %% Try the {bof,X} notation {ok, 3} = ?PRIM_FILE:position(Fd2,{bof,3}), - {ok, "D"} = ?PRIM_FILE:read(Fd2,1), + {ok, <<"D">>} = ?PRIM_FILE:read(Fd2,1), %% Try eof positions io:format("EOF positions"), {ok, 8} = ?PRIM_FILE:position(Fd2,{eof,0}), eof = ?PRIM_FILE:read(Fd2,1), {ok, 7} = ?PRIM_FILE:position(Fd2,{eof,-1}), - {ok, "H"} = ?PRIM_FILE:read(Fd2,1), + {ok, <<"H">>} = ?PRIM_FILE:read(Fd2,1), {ok, 0} = ?PRIM_FILE:position(Fd2,{eof,-8}), - {ok, "A"} = ?PRIM_FILE:read(Fd2,1), + {ok, <<"A">>} = ?PRIM_FILE:read(Fd2,1), {error, einval} = ?PRIM_FILE:position(Fd2,{eof,-9}), ok. @@ -714,7 +636,7 @@ pos2(Config) when is_list(Config) -> atom_to_list(?MODULE) ++"_pos2.fil"), {ok,Fd1} = ?PRIM_FILE:open(Name, [write]), - ?PRIM_FILE:write(Fd1,"ABCDEFGH"), + ?PRIM_FILE:write(Fd1,<<"ABCDEFGH">>), ok = ?PRIM_FILE:close(Fd1), {ok, Fd2} = ?PRIM_FILE:open(Name, [read]), {error, einval} = ?PRIM_FILE:position(Fd2,-1), @@ -722,35 +644,25 @@ pos2(Config) when is_list(Config) -> %% Make sure that we still can search after an error. {ok, 0} = ?PRIM_FILE:position(Fd2, 0), {ok, 3} = ?PRIM_FILE:position(Fd2, {bof,3}), - {ok, "D"} = ?PRIM_FILE:read(Fd2,1), + {ok, <<"D">>} = ?PRIM_FILE:read(Fd2,1), io:format("DONE"), ok. - -file_info_basic_file_a(Config) when is_list(Config) -> - file_info_basic_file(Config, [], "_a"). - -file_info_basic_file_b(Config) when is_list(Config) -> - {ok, Handle} = ?PRIM_FILE:start(), - Result = file_info_basic_file(Config, Handle, "_b"), - ok = ?PRIM_FILE:stop(Handle), - Result. - -file_info_basic_file(Config, Handle, Suffix) -> +file_info_basic_file(Config) when is_list(Config) -> RootDir = proplists:get_value(priv_dir, Config), %% Create a short file. Name = filename:join(RootDir, atom_to_list(?MODULE) - ++"_basic_test"++Suffix++".fil"), + ++"_basic_test"".fil"), {ok,Fd1} = ?PRIM_FILE:open(Name, [write]), ?PRIM_FILE:write(Fd1, "foo bar"), ok = ?PRIM_FILE:close(Fd1), %% Test that the file has the expected attributes. %% The times are tricky, so we will save them to a separate test case. - {ok, FileInfo} = ?PRIM_FILE_call(read_file_info, Handle, [Name]), + {ok, FileInfo} = ?PRIM_FILE:read_file_info(Name), #file_info{size = Size, type = Type, access = Access, atime = AccessTime, mtime = ModifyTime} = FileInfo, @@ -768,39 +680,30 @@ file_info_basic_file(Config, Handle, Suffix) -> ok. -file_info_basic_directory_a(Config) when is_list(Config) -> - file_info_basic_directory(Config, []). - -file_info_basic_directory_b(Config) when is_list(Config) -> - {ok, Handle} = ?PRIM_FILE:start(), - Result = file_info_basic_directory(Config, Handle), - ok = ?PRIM_FILE:stop(Handle), - Result. - -file_info_basic_directory(Config, Handle) -> +file_info_basic_directory(Config) when is_list(Config) -> %% Note: filename:join/1 removes any trailing slash, %% which is essential for ?PRIM_FILE:read_file_info/1 to work on %% platforms such as Windows95. RootDir = filename:join([proplists:get_value(priv_dir, Config)]), %% Test that the RootDir directory has the expected attributes. - test_directory(RootDir, read_write, Handle), + test_directory(RootDir, read_write), %% Note that on Windows file systems, "/" or "c:/" are *NOT* directories. %% Therefore, test that ?PRIM_FILE:read_file_info/1 behaves %% as if they were directories. case os:type() of {win32, _} -> - test_directory("/", read_write, Handle), - test_directory("c:/", read_write, Handle), - test_directory("c:\\", read_write, Handle); + test_directory("/", read_write), + test_directory("c:/", read_write), + test_directory("c:\\", read_write); _ -> - test_directory("/", read, Handle) + test_directory("/", read) end, ok. -test_directory(Name, ExpectedAccess, Handle) -> - {ok, FileInfo} = ?PRIM_FILE_call(read_file_info, Handle, [Name]), +test_directory(Name, ExpectedAccess) -> + {ok, FileInfo} = ?PRIM_FILE:read_file_info(Name), #file_info{size = Size, type = Type, access = Access, atime = AccessTime, mtime = ModifyTime} = FileInfo, @@ -824,45 +727,24 @@ all_integers([]) -> %% Try something nonexistent. -file_info_bad_a(Config) when is_list(Config) -> - file_info_bad(Config, []). - -file_info_bad_b(Config) when is_list(Config) -> - {ok, Handle} = ?PRIM_FILE:start(), - Result = file_info_bad(Config, Handle), - ok = ?PRIM_FILE:stop(Handle), - Result. - -file_info_bad(Config, Handle) -> +file_info_bad(Config) when is_list(Config) -> RootDir = filename:join([proplists:get_value(priv_dir, Config)]), - {error, enoent} = - ?PRIM_FILE_call( - read_file_info, Handle, - [filename:join(RootDir, - atom_to_list(?MODULE)++"_nonexistent")]), + NonExistent = filename:join(RootDir, atom_to_list(?MODULE)++"_nonexistent"), + {error, enoent} = ?PRIM_FILE:read_file_info(NonExistent), ok. %% Test that the file times behave as they should. -file_info_times_a(Config) when is_list(Config) -> - file_info_times(Config, [], "_a"). - -file_info_times_b(Config) when is_list(Config) -> - {ok, Handle} = ?PRIM_FILE:start(), - Result = file_info_times(Config, Handle, "_b"), - ok = ?PRIM_FILE:stop(Handle), - Result. - -file_info_times(Config, Handle, Suffix) -> +file_info_times(Config) when is_list(Config) -> %% We have to try this twice, since if the test runs across the change %% of a month the time diff calculations will fail. But it won't happen %% if you run it twice in succession. test_server:m_out_of_n( 1,2, - fun() -> file_info_int(Config, Handle, Suffix) end), + fun() -> file_info_int(Config) end), ok. -file_info_int(Config, Handle, Suffix) -> +file_info_int(Config) -> %% Note: filename:join/1 removes any trailing slash, %% which is essential for ?PRIM_FILE:read_file_info/1 to work on %% platforms such as Windows95. @@ -872,14 +754,14 @@ file_info_int(Config, Handle, Suffix) -> Name = filename:join(RootDir, atom_to_list(?MODULE) - ++"_file_info"++Suffix++".fil"), + ++"_file_info.fil"), {ok,Fd1} = ?PRIM_FILE:open(Name, [write]), ?PRIM_FILE:write(Fd1,"foo"), %% check that the file got a modify date max a few seconds away from now {ok, #file_info{type = regular, atime = AccTime1, mtime = ModTime1}} = - ?PRIM_FILE_call(read_file_info, Handle, [Name]), + ?PRIM_FILE:read_file_info(Name), Now = erlang:localtime(), io:format("Now ~p",[Now]), io:format("Open file Acc ~p Mod ~p",[AccTime1,ModTime1]), @@ -897,7 +779,7 @@ file_info_int(Config, Handle, Suffix) -> ok = ?PRIM_FILE:close(Fd1), {ok, #file_info{size = Size, type = regular, access = Access, atime = AccTime2, mtime = ModTime2}} = - ?PRIM_FILE_call(read_file_info, Handle, [Name]), + ?PRIM_FILE:read_file_info(Name), io:format("Closed file Acc ~p Mod ~p",[AccTime2,ModTime2]), true = time_dist(ModTime1, ModTime2) >= 0, @@ -909,7 +791,7 @@ file_info_int(Config, Handle, Suffix) -> {ok, #file_info{size = DSize, type = directory, access = DAccess, atime = AccTime3, mtime = ModTime3}} = - ?PRIM_FILE_call(read_file_info, Handle, [RootDir]), + ?PRIM_FILE:read_file_info(RootDir), %% this dir was modified only a few secs ago io:format("Dir Acc ~p; Mod ~p; Now ~p", [AccTime3, ModTime3, Now]), @@ -936,16 +818,7 @@ filter_atime(Atime, Config) -> %% Test the write_file_info/2 function. -file_write_file_info_a(Config) when is_list(Config) -> - file_write_file_info(Config, [], "_a"). - -file_write_file_info_b(Config) when is_list(Config) -> - {ok, Handle} = ?PRIM_FILE:start(), - Result = file_write_file_info(Config, Handle, "_b"), - ok = ?PRIM_FILE:stop(Handle), - Result. - -file_write_file_info(Config, Handle, Suffix) -> +file_write_file_info(Config) when is_list(Config) -> RootDir = get_good_directory(Config), io:format("RootDir = ~p", [RootDir]), @@ -955,16 +828,16 @@ file_write_file_info(Config, Handle, Suffix) -> Name = filename:join(RootDir, atom_to_list(?MODULE) - ++"_write_file_info_ro"++Suffix), + ++"_write_file_info_ro"), ok = ?PRIM_FILE:write_file(Name, "hello"), Time = {{1997, 01, 02}, {12, 35, 42}}, Info = #file_info{mode=8#400, atime=Time, mtime=Time, ctime=Time}, - ok = ?PRIM_FILE_call(write_file_info, Handle, [Name, Info]), + ok = ?PRIM_FILE:write_file_info(Name, Info), %% Read back the times. {ok, ActualInfo} = - ?PRIM_FILE_call(read_file_info, Handle, [Name]), + ?PRIM_FILE:read_file_info(Name), #file_info{mode=_Mode, atime=ActAtime, mtime=Time, ctime=ActCtime} = ActualInfo, FilteredAtime = filter_atime(Time, Config), @@ -980,14 +853,11 @@ file_write_file_info(Config, Handle, Suffix) -> {error, eacces} = ?PRIM_FILE:write_file(Name, "hello again"), %% Make the file writable again. - - ?PRIM_FILE_call(write_file_info, Handle, - [Name, #file_info{mode=8#600}]), + ?PRIM_FILE:write_file_info(Name, #file_info{mode=8#600}), ok = ?PRIM_FILE:write_file(Name, "hello again"), %% And unwritable. - ?PRIM_FILE_call(write_file_info, Handle, - [Name, #file_info{mode=8#400}]), + ?PRIM_FILE:write_file_info(Name, #file_info{mode=8#400}), {error, eacces} = ?PRIM_FILE:write_file(Name, "hello again"), %% Write the times again. @@ -995,9 +865,9 @@ file_write_file_info(Config, Handle, Suffix) -> NewTime = {{1997, 02, 15}, {13, 18, 20}}, NewInfo = #file_info{atime=NewTime, mtime=NewTime, ctime=NewTime}, - ok = ?PRIM_FILE_call(write_file_info, Handle, [Name, NewInfo]), + ok = ?PRIM_FILE:write_file_info(Name, NewInfo), {ok, ActualInfo2} = - ?PRIM_FILE_call(read_file_info, Handle, [Name]), + ?PRIM_FILE:read_file_info(Name), #file_info{atime=NewActAtime, mtime=NewTime, ctime=NewActCtime} = ActualInfo2, NewFilteredAtime = filter_atime(NewTime, Config), @@ -1012,14 +882,12 @@ file_write_file_info(Config, Handle, Suffix) -> %% Make the file writeable again, so that we can remove the %% test suites ... :-) - ?PRIM_FILE_call(write_file_info, Handle, - [Name, #file_info{mode=8#600}]), + ?PRIM_FILE:write_file_info(Name, #file_info{mode=8#600}), ok. %% Test the write_file_info/3 function. file_write_file_info_opts(Config) when is_list(Config) -> - {ok, Handle} = ?PRIM_FILE:start(), RootDir = get_good_directory(Config), io:format("RootDir = ~p", [RootDir]), @@ -1028,7 +896,7 @@ file_write_file_info_opts(Config) when is_list(Config) -> lists:foreach(fun ({FI, Opts}) -> - ok = ?PRIM_FILE_call(write_file_info, Handle, [Name, FI, Opts]) + ok = ?PRIM_FILE:write_file_info(Name, FI, Opts) end, [ {#file_info{ mode=8#600, atime = Time, mtime = Time, ctime = Time}, Opts} || Opts <- [[{time, posix}]], @@ -1038,7 +906,7 @@ file_write_file_info_opts(Config) when is_list(Config) -> %% REM: determine date range dependent on time_t = Uint32 | Sint32 | Sint64 | Uint64 %% Determine time_t on os:type()? lists:foreach(fun ({FI, Opts}) -> - ok = ?PRIM_FILE_call(write_file_info, Handle, [Name, FI, Opts]) + ok = ?PRIM_FILE:write_file_info(Name, FI, Opts) end, [ {#file_info{ mode=8#400, atime = Time, mtime = Time, ctime = Time}, Opts} || Opts <- [[{time, universal}],[{time, local}]], Time <- [ @@ -1050,11 +918,9 @@ file_write_file_info_opts(Config) when is_list(Config) -> {{2037,2,3},{23,59,59}}, erlang:localtime() ]]), - ok = ?PRIM_FILE:stop(Handle), ok. file_read_file_info_opts(Config) when is_list(Config) -> - {ok, Handle} = ?PRIM_FILE:start(), RootDir = get_good_directory(Config), io:format("RootDir = ~p", [RootDir]), @@ -1063,41 +929,38 @@ file_read_file_info_opts(Config) when is_list(Config) -> lists:foreach(fun (Opts) -> - {ok,_} = ?PRIM_FILE_call(read_file_info, Handle, [Name, Opts]) + {ok,_} = ?PRIM_FILE:read_file_info(Name, Opts) end, [[{time, Type}] || Type <- [local, universal, posix]]), - ok = ?PRIM_FILE:stop(Handle), ok. %% Test the write and read back *_file_info/3 functions. file_write_read_file_info_opts(Config) when is_list(Config) -> - {ok, Handle} = ?PRIM_FILE:start(), RootDir = get_good_directory(Config), io:format("RootDir = ~p", [RootDir]), Name = filename:join(RootDir, atom_to_list(?MODULE) ++"_read_write_file_info_opts"), ok = ?PRIM_FILE:write_file(Name, "hello_opts2"), - ok = file_write_read_file_info_opts(Handle, Name, {{1989, 04, 28}, {19,30,22}}, [{time, local}]), - ok = file_write_read_file_info_opts(Handle, Name, {{1989, 04, 28}, {19,30,22}}, [{time, universal}]), + ok = file_write_read_file_info_opts(Name, {{1989, 04, 28}, {19,30,22}}, [{time, local}]), + ok = file_write_read_file_info_opts(Name, {{1989, 04, 28}, {19,30,22}}, [{time, universal}]), %% will not work on platforms with unsigned time_t - %ok = file_write_read_file_info_opts(Handle, Name, {{1930, 04, 28}, {19,30,22}}, [{time, local}]), - %ok = file_write_read_file_info_opts(Handle, Name, {{1930, 04, 28}, {19,30,22}}, [{time, universal}]), - ok = file_write_read_file_info_opts(Handle, Name, 1, [{time, posix}]), + %ok = file_write_read_file_info_opts(Name, {{1930, 04, 28}, {19,30,22}}, [{time, local}]), + %ok = file_write_read_file_info_opts(Name, {{1930, 04, 28}, {19,30,22}}, [{time, universal}]), + ok = file_write_read_file_info_opts(Name, 1, [{time, posix}]), %% will not work on platforms with unsigned time_t - %ok = file_write_read_file_info_opts(Handle, Name, -1, [{time, posix}]), - %ok = file_write_read_file_info_opts(Handle, Name, -300000, [{time, posix}]), - ok = file_write_read_file_info_opts(Handle, Name, 300000, [{time, posix}]), - ok = file_write_read_file_info_opts(Handle, Name, 0, [{time, posix}]), + %ok = file_write_read_file_info_opts(Name, -1, [{time, posix}]), + %ok = file_write_read_file_info_opts(Name, -300000, [{time, posix}]), + ok = file_write_read_file_info_opts(Name, 300000, [{time, posix}]), + ok = file_write_read_file_info_opts(Name, 0, [{time, posix}]), - ok = ?PRIM_FILE:stop(Handle), ok. -file_write_read_file_info_opts(Handle, Name, Mtime, Opts) -> - {ok, FI} = ?PRIM_FILE_call(read_file_info, Handle, [Name, Opts]), +file_write_read_file_info_opts(Name, Mtime, Opts) -> + {ok, FI} = ?PRIM_FILE:read_file_info(Name, Opts), FI2 = FI#file_info{ mtime = Mtime }, - ok = ?PRIM_FILE_call(write_file_info, Handle, [Name, FI2, Opts]), - {ok, FI3} = ?PRIM_FILE_call(read_file_info, Handle, [Name, Opts]), + ok = ?PRIM_FILE:write_file_info(Name, FI2, Opts), + {ok, FI3} = ?PRIM_FILE:read_file_info(Name, Opts), io:format("Expecting mtime = ~p, got ~p~n", [FI2#file_info.mtime, FI3#file_info.mtime]), FI2 = FI3, ok. @@ -1175,8 +1038,8 @@ advise(Config) when is_list(Config) -> atom_to_list(?MODULE) ++"_advise.fil"), - Line1 = "Hello\n", - Line2 = "World!\n", + Line1 = <<"Hello\n">>, + Line2 = <<"World!\n">>, {ok, Fd} = ?PRIM_FILE:open(Advise, [write]), ok = ?PRIM_FILE:advise(Fd, 0, 0, normal), @@ -1226,7 +1089,7 @@ advise(Config) when is_list(Config) -> {ok, Fd9} = ?PRIM_FILE:open(Advise, [read]), Offset = 0, %% same as a 0 length in some implementations - Length = length(Line1) + length(Line2), + Length = byte_size(Line1) + byte_size(Line2), ok = ?PRIM_FILE:advise(Fd9, Offset, Length, sequential), {ok, Line1} = ?PRIM_FILE:read_line(Fd9), {ok, Line2} = ?PRIM_FILE:read_line(Fd9), @@ -1250,23 +1113,18 @@ do_large_write(Name) -> Chunk = <<0:ChunkSize/unit:8>>, Data = zip_data(lists:duplicate(Chunks, Chunk), Interleave), Size = Chunks * ChunkSize + Chunks, % 4 G + 32 - Wordsize = erlang:system_info(wordsize), - case prim_file:write_file(Name, Data) of - ok when Wordsize =:= 8 -> - {ok,#file_info{size=Size}} = file:read_file_info(Name), - {ok,Fd} = prim_file:open(Name, [read]), - check_large_write(Fd, ChunkSize, 0, Interleave); - {error,einval} when Wordsize =:= 4 -> - ok - end. + ok = ?PRIM_FILE:write_file(Name, Data), + {ok,#file_info{size=Size}} = file:read_file_info(Name), + {ok,Fd} = ?PRIM_FILE:open(Name, [read]), + check_large_write(Fd, ChunkSize, 0, Interleave). check_large_write(Fd, ChunkSize, Pos, [X|Interleave]) -> Pos1 = Pos + ChunkSize, - {ok,Pos1} = prim_file:position(Fd, {cur,ChunkSize}), - {ok,[X]} = prim_file:read(Fd, 1), + {ok,Pos1} = ?PRIM_FILE:position(Fd, {cur,ChunkSize}), + {ok,<<X>>} = ?PRIM_FILE:read(Fd, 1), check_large_write(Fd, ChunkSize, Pos1+1, Interleave); check_large_write(Fd, _, _, []) -> - eof = prim_file:read(Fd, 1), + eof = ?PRIM_FILE:read(Fd, 1), ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1338,71 +1196,53 @@ allocate_and_assert(Fd, Offset, Length) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -delete_a(Config) when is_list(Config) -> - delete(Config, [], "_a"). - -delete_b(Config) when is_list(Config) -> - {ok, Handle} = ?PRIM_FILE:start(), - Result = delete(Config, Handle, "_b"), - ok = ?PRIM_FILE:stop(Handle), - Result. - -delete(Config, Handle, Suffix) -> +delete(Config) when is_list(Config) -> RootDir = proplists:get_value(priv_dir,Config), Name = filename:join(RootDir, atom_to_list(?MODULE) - ++"_delete"++Suffix++".fil"), + ++"_delete.fil"), {ok, Fd1} = ?PRIM_FILE:open(Name, [write]), ?PRIM_FILE:write(Fd1,"ok.\n"), ok = ?PRIM_FILE:close(Fd1), %% Check that the file is readable {ok, Fd2} = ?PRIM_FILE:open(Name, [read]), ok = ?PRIM_FILE:close(Fd2), - ok = ?PRIM_FILE_call(delete, Handle, [Name]), + ok = ?PRIM_FILE:delete(Name), %% Check that the file is not readable anymore {error, _} = ?PRIM_FILE:open(Name, [read]), %% Try deleting a nonexistent file - {error, enoent} = ?PRIM_FILE_call(delete, Handle, [Name]), + {error, enoent} = ?PRIM_FILE:delete(Name), ok. -rename_a(Config) when is_list(Config) -> - rename(Config, [], "_a"). - -rename_b(Config) when is_list(Config) -> - {ok, Handle} = ?PRIM_FILE:start(), - Result = rename(Config, Handle, "_b"), - ok = ?PRIM_FILE:stop(Handle), - Result. - -rename(Config, Handle, Suffix) -> +rename(Config) when is_list(Config) -> RootDir = proplists:get_value(priv_dir,Config), - FileName1 = atom_to_list(?MODULE)++"_rename"++Suffix++".fil", - FileName2 = atom_to_list(?MODULE)++"_rename"++Suffix++".ful", + FileName1 = atom_to_list(?MODULE)++"_rename.fil", + FileName2 = atom_to_list(?MODULE)++"_rename.ful", Name1 = filename:join(RootDir, FileName1), Name2 = filename:join(RootDir, FileName2), {ok,Fd1} = ?PRIM_FILE:open(Name1, [write]), ok = ?PRIM_FILE:close(Fd1), %% Rename, and check that it really changed name - ok = ?PRIM_FILE_call(rename, Handle, [Name1, Name2]), + ok = ?PRIM_FILE:rename(Name1, Name2), {error, _} = ?PRIM_FILE:open(Name1, [read]), {ok, Fd2} = ?PRIM_FILE:open(Name2, [read]), ok = ?PRIM_FILE:close(Fd2), %% Try renaming something to itself - ok = ?PRIM_FILE_call(rename, Handle, [Name2, Name2]), + ok = ?PRIM_FILE:rename(Name2, Name2), %% Try renaming something that doesn't exist {error, enoent} = - ?PRIM_FILE_call(rename, Handle, [Name1, Name2]), + ?PRIM_FILE:rename(Name1, Name2), %% Try renaming to something else than a string {error, badarg} = - ?PRIM_FILE_call(rename, Handle, [Name1, foobar]), + ?PRIM_FILE:rename(Name1, foobar), %% Move between directories DirName1 = filename:join(RootDir, atom_to_list(?MODULE) - ++"_rename_dir"++Suffix), + ++"_rename_dir"), DirName2 = filename:join(RootDir, atom_to_list(?MODULE) - ++"_second_rename_dir"++Suffix), + ++"_second_rename_dir"), Name1foo = filename:join(DirName1, "foo.fil"), Name2foo = filename:join(DirName2, "foo.fil"), Name2bar = filename:join(DirName2, "bar.dir"), @@ -1410,21 +1250,21 @@ rename(Config, Handle, Suffix) -> %% The name has to include the full file name, path is not enough expect( {error, eexist}, {error, eisdir}, - ?PRIM_FILE_call(rename, Handle, [Name2, DirName1])), + ?PRIM_FILE:rename(Name2, DirName1)), ok = - ?PRIM_FILE_call(rename, Handle, [Name2, Name1foo]), + ?PRIM_FILE:rename(Name2, Name1foo), %% Now rename the directory - ok = ?PRIM_FILE_call(rename, Handle, [DirName1, DirName2]), + ok = ?PRIM_FILE:rename(DirName1, DirName2), %% And check that the file is there now {ok,Fd3} = ?PRIM_FILE:open(Name2foo, [read]), ok = ?PRIM_FILE:close(Fd3), %% Try some dirty things now: move the directory into itself {error, Msg1} = - ?PRIM_FILE_call(rename, Handle, [DirName2, Name2bar]), + ?PRIM_FILE:rename(DirName2, Name2bar), io:format("Errmsg1: ~p",[Msg1]), %% move dir into a file in itself {error, Msg2} = - ?PRIM_FILE_call(rename, Handle, [DirName2, Name2foo]), + ?PRIM_FILE:rename(DirName2, Name2foo), io:format("Errmsg2: ~p",[Msg2]), ok. @@ -1657,165 +1497,19 @@ e_del_dir(Config) when is_list(Config) -> ok. -%% Trying reading and positioning from a compressed file. - -read_compressed(Config) when is_list(Config) -> - Data = proplists:get_value(data_dir, Config), - Real = filename:join(Data, "realmen.html.gz"), - {ok, Fd} = ?PRIM_FILE:open(Real, [read, compressed]), - try_read_file(Fd). - -%% Trying reading and positioning from an uncompressed file, -%% but with the compressed flag given. - -read_not_really_compressed(Config) when is_list(Config) -> - Data = proplists:get_value(data_dir, Config), - Priv = proplists:get_value(priv_dir, Config), - - %% The file realmen.html might have got CRs added (by WinZip). - %% Remove them, or the file positions will not be correct. - - Real = filename:join(Data, "realmen.html"), - RealPriv = filename:join(Priv, - atom_to_list(?MODULE)++"_realmen.html"), - {ok, RealDataBin} = ?PRIM_FILE:read_file(Real), - RealData = remove_crs(binary_to_list(RealDataBin), []), - ok = ?PRIM_FILE:write_file(RealPriv, RealData), - {ok, Fd} = ?PRIM_FILE:open(RealPriv, [read, compressed]), - try_read_file(Fd). - -remove_crs([$\r|Rest], Result) -> - remove_crs(Rest, Result); -remove_crs([C|Rest], Result) -> - remove_crs(Rest, [C|Result]); -remove_crs([], Result) -> - lists:reverse(Result). - -try_read_file(Fd) -> - %% Seek to the current position (nothing should happen). - - {ok, 0} = ?PRIM_FILE:position(Fd, 0), - {ok, 0} = ?PRIM_FILE:position(Fd, {cur, 0}), - - %% Read a few lines from a compressed file. - - ShouldBe = "<TITLE>Real Programmers Don't Use PASCAL</TITLE>\n", - {ok, ShouldBe} = ?PRIM_FILE:read(Fd, length(ShouldBe)), - - %% Now seek forward. - - {ok, 381} = ?PRIM_FILE:position(Fd, 381), - Back = "Back in the good old days -- the \"Golden Era\" " ++ - "of computers, it was\n", - {ok, Back} = ?PRIM_FILE:read(Fd, length(Back)), - - %% Try to search forward relative to the current position. - - {ok, CurPos} = ?PRIM_FILE:position(Fd, {cur, 0}), - RealPos = 4273, - {ok, RealPos} = ?PRIM_FILE:position(Fd, {cur, RealPos-CurPos}), - RealProg = "<LI> Real Programmers aren't afraid to use GOTOs.\n", - {ok, RealProg} = ?PRIM_FILE:read(Fd, length(RealProg)), - - %% Seek backward. - - AfterTitle = length("<TITLE>"), - {ok, AfterTitle} = ?PRIM_FILE:position(Fd, AfterTitle), - Title = "Real Programmers Don't Use PASCAL</TITLE>\n", - {ok, Title} = ?PRIM_FILE:read(Fd, length(Title)), - - %% Done. - - ?PRIM_FILE:close(Fd), - ok. - -write_compressed(Config) when is_list(Config) -> - Priv = proplists:get_value(priv_dir, Config), - MyFile = filename:join(Priv, - atom_to_list(?MODULE)++"_test.gz"), - - %% Write a file. - - {ok, Fd} = ?PRIM_FILE:open(MyFile, [write, compressed]), - {ok, 0} = ?PRIM_FILE:position(Fd, 0), - Prefix = "hello\n", - End = "end\n", - ok = ?PRIM_FILE:write(Fd, Prefix), - {ok, 143} = ?PRIM_FILE:position(Fd, 143), - ok = ?PRIM_FILE:write(Fd, End), - ok = ?PRIM_FILE:close(Fd), - - %% Read the file and verify the contents. - - {ok, Fd1} = ?PRIM_FILE:open(MyFile, [read, compressed]), - {ok, Prefix} = ?PRIM_FILE:read(Fd1, length(Prefix)), - Second = lists:duplicate(143-length(Prefix), 0) ++ End, - {ok, Second} = ?PRIM_FILE:read(Fd1, length(Second)), - ok = ?PRIM_FILE:close(Fd1), - - %% Ensure that the file is compressed. - - TotalSize = 143 + length(End), - case ?PRIM_FILE:read_file_info(MyFile) of - {ok, #file_info{size=Size}} when Size < TotalSize -> - ok; - {ok, #file_info{size=Size}} when Size == TotalSize -> - ct:fail(file_not_compressed) - end, - - %% Write again to ensure that the file is truncated. - - {ok, Fd2} = ?PRIM_FILE:open(MyFile, [write, compressed]), - NewString = "aaaaaaaaaaa", - ok = ?PRIM_FILE:write(Fd2, NewString), - ok = ?PRIM_FILE:close(Fd2), - {ok, Fd3} = ?PRIM_FILE:open(MyFile, [read, compressed]), - {ok, NewString} = ?PRIM_FILE:read(Fd3, 1024), - ok = ?PRIM_FILE:close(Fd3), - - ok. - -compress_errors(Config) when is_list(Config) -> - Data = proplists:get_value(data_dir, Config), - {error, enoent} = ?PRIM_FILE:open("non_existing__", - [compressed, read]), - {error, einval} = ?PRIM_FILE:open("non_existing__", - [compressed, read, write]), - - %% Read a corrupted .gz file. - - Corrupted = filename:join(Data, "corrupted.gz"), - {ok, Fd} = ?PRIM_FILE:open(Corrupted, [read, compressed]), - {error, eio} = ?PRIM_FILE:read(Fd, 100), - ?PRIM_FILE:close(Fd), - - ok. - - -%% Test creating a hard link. -make_link_a(Config) when is_list(Config) -> - make_link(Config, [], "_a"). - -%% Test creating a hard link. -make_link_b(Config) when is_list(Config) -> - {ok, Handle} = ?PRIM_FILE:start(), - Result = make_link(Config, Handle, "_b"), - ok = ?PRIM_FILE:stop(Handle), - Result. - -make_link(Config, Handle, Suffix) -> +make_link(Config) when is_list(Config) -> RootDir = proplists:get_value(priv_dir, Config), NewDir = filename:join(RootDir, atom_to_list(?MODULE) - ++"_make_link"++Suffix), - ok = ?PRIM_FILE_call(make_dir, Handle, [NewDir]), + ++"_make_link"), + ok = ?PRIM_FILE:make_dir(NewDir), Name = filename:join(NewDir, "a_file"), ok = ?PRIM_FILE:write_file(Name, "some contents\n"), Alias = filename:join(NewDir, "an_alias"), Result = - case ?PRIM_FILE_call(make_link, Handle, [Name, Alias]) of + case ?PRIM_FILE:make_link(Name, Alias) of {error, enotsup} -> {skipped, "Links not supported on this platform"}; ok -> @@ -1826,12 +1520,12 @@ make_link(Config, Handle, Suffix) -> %% since they are not used on symbolic links. {ok, Info} = - ?PRIM_FILE_call(read_link_info, Handle, [Name]), + ?PRIM_FILE:read_link_info(Name), {ok, Info} = - ?PRIM_FILE_call(read_link_info, Handle, [Alias]), + ?PRIM_FILE:read_link_info(Alias), #file_info{links = 2, type = regular} = Info, {error, eexist} = - ?PRIM_FILE_call(make_link, Handle, [Name, Alias]), + ?PRIM_FILE:make_link(Name, Alias), ok end, @@ -1843,30 +1537,19 @@ read_link_info_for_non_link(Config) when is_list(Config) -> {ok, #file_info{type=directory}} = ?PRIM_FILE:read_link_info("."), ok. -%% Test operations on symbolic links (for Unix). -symlinks_a(Config) when is_list(Config) -> - symlinks(Config, [], "_a"). - -%% Test operations on symbolic links (for Unix). -symlinks_b(Config) when is_list(Config) -> - {ok, Handle} = ?PRIM_FILE:start(), - Result = symlinks(Config, Handle, "_b"), - ok = ?PRIM_FILE:stop(Handle), - Result. - -symlinks(Config, Handle, Suffix) -> +symlinks(Config) when is_list(Config) -> RootDir = proplists:get_value(priv_dir, Config), NewDir = filename:join(RootDir, atom_to_list(?MODULE) - ++"_make_symlink"++Suffix), - ok = ?PRIM_FILE_call(make_dir, Handle, [NewDir]), + ++"_make_symlink"), + ok = ?PRIM_FILE:make_dir(NewDir), Name = filename:join(NewDir, "a_plain_file"), ok = ?PRIM_FILE:write_file(Name, "some stupid content\n"), Alias = filename:join(NewDir, "a_symlink_alias"), Result = - case ?PRIM_FILE_call(make_symlink, Handle, [Name, Alias]) of + case ?PRIM_FILE:make_symlink(Name, Alias) of {error, enotsup} -> {skipped, "Links not supported on this platform"}; {error, eperm} -> @@ -1874,20 +1557,20 @@ symlinks(Config, Handle, Suffix) -> {skipped, "Windows user not privileged to create links"}; ok -> {ok, Info1} = - ?PRIM_FILE_call(read_file_info, Handle, [Name]), + ?PRIM_FILE:read_file_info(Name), {ok, Info1} = - ?PRIM_FILE_call(read_file_info, Handle, [Alias]), + ?PRIM_FILE:read_file_info(Alias), {ok, Info1} = - ?PRIM_FILE_call(read_link_info, Handle, [Name]), + ?PRIM_FILE:read_link_info(Name), #file_info{links = 1, type = regular} = Info1, {ok, Info2} = - ?PRIM_FILE_call(read_link_info, Handle, [Alias]), + ?PRIM_FILE:read_link_info(Alias), #file_info{links=1, type=symlink} = Info2, {ok, Name} = - ?PRIM_FILE_call(read_link, Handle, [Alias]), + ?PRIM_FILE:read_link(Alias), {ok, Name} = - ?PRIM_FILE_call(read_link_all, Handle, [Alias]), + ?PRIM_FILE:read_link_all(Alias), %% If all is good, delete dir again (avoid hanging dir on windows) rm_rf(?PRIM_FILE,NewDir), ok @@ -1907,10 +1590,9 @@ list_dir_limit(Config) when is_list(Config) -> RootDir = proplists:get_value(priv_dir, Config), NewDir = filename:join(RootDir, atom_to_list(?MODULE)++"_list_dir_limit"), - {ok, Handle1} = ?PRIM_FILE:start(), - ok = ?PRIM_FILE_call(make_dir, Handle1, [NewDir]), + ok = ?PRIM_FILE:make_dir(NewDir), Ref = erlang:start_timer(MaxTime*1000, self(), []), - Result = list_dir_limit_loop(NewDir, Handle1, Ref, MaxNumber, 0), + Result = list_dir_limit_loop(NewDir, Ref, MaxNumber, 0), Time = case erlang:cancel_timer(Ref) of false -> MaxTime; T -> MaxTime - (T div 1000) @@ -1920,21 +1602,18 @@ list_dir_limit(Config) when is_list(Config) -> {error, _Reason, N} -> N; _ -> 0 end, - {ok, Handle2} = ?PRIM_FILE:start(), - list_dir_limit_cleanup(NewDir, Handle2, Number, 0), - ok = ?PRIM_FILE:stop(Handle1), - ok = ?PRIM_FILE:stop(Handle2), + list_dir_limit_cleanup(NewDir, Number, 0), {ok, Number} = Result, {comment, "Created " ++ integer_to_list(Number) ++ " files in " ++ integer_to_list(Time) ++ " seconds."}. -list_dir_limit_loop(Dir, Handle, _Ref, N, Cnt) when Cnt >= N -> - list_dir_check(Dir, Handle, Cnt); -list_dir_limit_loop(Dir, Handle, Ref, N, Cnt) -> +list_dir_limit_loop(Dir, _Ref, N, Cnt) when Cnt >= N -> + list_dir_check(Dir, Cnt); +list_dir_limit_loop(Dir, Ref, N, Cnt) -> receive {timeout, Ref, []} -> - list_dir_check(Dir, Handle, Cnt) + list_dir_check(Dir, Cnt) after 0 -> Name = integer_to_list(Cnt), case ?PRIM_FILE:write_file(filename:join(Dir, Name), Name) of @@ -1942,23 +1621,23 @@ list_dir_limit_loop(Dir, Handle, Ref, N, Cnt) -> Next = Cnt + 1, case Cnt rem 100 of 0 -> - case list_dir_check(Dir, Handle, Next) of + case list_dir_check(Dir, Next) of {ok, Next} -> list_dir_limit_loop( - Dir, Handle, Ref, N, Next); + Dir, Ref, N, Next); Other -> Other end; _ -> - list_dir_limit_loop(Dir, Handle, Ref, N, Next) + list_dir_limit_loop(Dir, Ref, N, Next) end; {error, Reason} -> {error, Reason, Cnt} end end. -list_dir_check(Dir, Handle, Cnt) -> - case ?PRIM_FILE:list_dir(Handle, Dir) of +list_dir_check(Dir, Cnt) -> + case ?PRIM_FILE:list_dir(Dir) of {ok, ListDir} -> case length(ListDir) of Cnt -> @@ -1975,18 +1654,18 @@ list_dir_check(Dir, Handle, Cnt) -> %% Deletes N files while ignoring errors, then continues deleting %% as long as they exist. -list_dir_limit_cleanup(Dir, Handle, N, Cnt) when Cnt >= N -> +list_dir_limit_cleanup(Dir, N, Cnt) when Cnt >= N -> Name = integer_to_list(Cnt), - case ?PRIM_FILE:delete(Handle, filename:join(Dir, Name)) of + case ?PRIM_FILE:delete(filename:join(Dir, Name)) of ok -> - list_dir_limit_cleanup(Dir, Handle, N, Cnt+1); + list_dir_limit_cleanup(Dir, N, Cnt+1); _ -> ok end; -list_dir_limit_cleanup(Dir, Handle, N, Cnt) -> +list_dir_limit_cleanup(Dir, N, Cnt) -> Name = integer_to_list(Cnt), - ?PRIM_FILE:delete(Handle, filename:join(Dir, Name)), - list_dir_limit_cleanup(Dir, Handle, N, Cnt+1). + ?PRIM_FILE:delete(filename:join(Dir, Name)), + list_dir_limit_cleanup(Dir, N, Cnt+1). %%% %%% Test list_dir() on a non-existing pathname. @@ -1995,7 +1674,7 @@ list_dir_limit_cleanup(Dir, Handle, N, Cnt) -> list_dir_error(Config) -> Priv = proplists:get_value(priv_dir, Config), NonExisting = filename:join(Priv, "non-existing-dir"), - {error,enoent} = prim_file:list_dir(NonExisting), + {error,enoent} = ?PRIM_FILE:list_dir(NonExisting), ok. %%% @@ -2063,7 +1742,7 @@ do_run_large_file_test(Config, Run, Name0) -> {'DOWN',Mref,_,_,_} -> ok; {Tester,done} -> ok end, - prim_file:delete(Name) + ?PRIM_FILE:delete(Name) end), %% Run the test case. diff --git a/lib/kernel/test/sendfile_SUITE.erl b/lib/kernel/test/sendfile_SUITE.erl index bfa564c32c..0c0b1cbcb6 100644 --- a/lib/kernel/test/sendfile_SUITE.erl +++ b/lib/kernel/test/sendfile_SUITE.erl @@ -23,30 +23,41 @@ -include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). --compile(export_all). - -all() -> [{group,async_threads}, - {group,no_async_threads}]. - -groups() -> - [{async_threads,[],tcs()}, - {no_async_threads,[],tcs()}]. - -tcs() -> - [t_sendfile_small - ,t_sendfile_big_all - ,t_sendfile_big_size - ,t_sendfile_many_small - ,t_sendfile_partial - ,t_sendfile_offset - ,t_sendfile_sendafter - ,t_sendfile_recvafter - ,t_sendfile_recvafter_remoteclose - ,t_sendfile_sendduring - ,t_sendfile_recvduring - ,t_sendfile_closeduring - ,t_sendfile_crashduring - ]. +-export([all/0, init_per_suite/1, end_per_suite/1, init_per_testcase/2]). + +-export([sendfile_server/2, sendfile_do_recv/2, init/1, handle_event/2]). + +-export( + [t_sendfile_small/1, + t_sendfile_big_all/1, + t_sendfile_big_size/1, + t_sendfile_many_small/1, + t_sendfile_partial/1, + t_sendfile_offset/1, + t_sendfile_sendafter/1, + t_sendfile_recvafter/1, + t_sendfile_recvafter_remoteclose/1, + t_sendfile_sendduring/1, + t_sendfile_recvduring/1, + t_sendfile_closeduring/1, + t_sendfile_crashduring/1, + t_sendfile_arguments/1]). + +all() -> + [t_sendfile_small, + t_sendfile_big_all, + t_sendfile_big_size, + t_sendfile_many_small, + t_sendfile_partial, + t_sendfile_offset, + t_sendfile_sendafter, + t_sendfile_recvafter, + t_sendfile_recvafter_remoteclose, + t_sendfile_sendduring, + t_sendfile_recvduring, + t_sendfile_closeduring, + t_sendfile_crashduring, + t_sendfile_arguments]. init_per_suite(Config) -> case {os:type(),os:version()} of @@ -72,28 +83,18 @@ init_per_suite(Config) -> end_per_suite(Config) -> file:delete(proplists:get_value(big_file, Config)). -init_per_group(async_threads,Config) -> - case erlang:system_info(thread_pool_size) of - 0 -> - {skip,"No async threads"}; - _ -> - [{sendfile_opts,[{use_threads,true}]}|Config] - end; -init_per_group(no_async_threads,Config) -> - [{sendfile_opts,[{use_threads,false}]}|Config]. - -end_per_group(_,_Config) -> - ok. - init_per_testcase(TC,Config) when TC == t_sendfile_recvduring; TC == t_sendfile_sendduring -> Filename = proplists:get_value(small_file, Config), Send = fun(Sock) -> {_Size, Data} = sendfile_file_info(Filename), - {ok,D} = file:open(Filename, [raw,binary,read]), - prim_file:sendfile(D, Sock, 0, 0, 0, - [],[],[]), + {ok,Fd} = file:open(Filename, [raw,binary,read]), + %% Determine whether the driver has native support by + %% hitting the raw module directly; file:sendfile/5 will + %% land in the fallback if it doesn't. + RawModule = Fd#file_descriptor.module, + {ok, _Ignored} = RawModule:sendfile(Fd,Sock,0,0,0,[],[],[]), Data end, @@ -105,9 +106,8 @@ init_per_testcase(TC,Config) when TC == t_sendfile_recvduring; ct:log("Error: ~p",[Error]), {skip,"Not supported"} end; -init_per_testcase(_Tc,Config) -> - Config ++ [{sendfile_opts,[{use_threads,false}]}]. - +init_per_testcase(_TC,Config) -> + Config. t_sendfile_small(Config) when is_list(Config) -> Filename = proplists:get_value(small_file, Config), @@ -124,7 +124,7 @@ t_sendfile_small(Config) when is_list(Config) -> t_sendfile_many_small(Config) when is_list(Config) -> Filename = proplists:get_value(small_file, Config), FileOpts = proplists:get_value(file_opts, Config, []), - SendfileOpts = proplists:get_value(sendfile_opts, Config), + SendfileOpts = proplists:get_value(sendfile_opts, Config, []), error_logger:add_report_handler(?MODULE,[self()]), @@ -151,7 +151,7 @@ t_sendfile_many_small(Config) when is_list(Config) -> t_sendfile_big_all(Config) when is_list(Config) -> Filename = proplists:get_value(big_file, Config), - SendfileOpts = proplists:get_value(sendfile_opts, Config), + SendfileOpts = proplists:get_value(sendfile_opts, Config, []), Send = fun(Sock) -> {ok, #file_info{size = Size}} = @@ -165,7 +165,7 @@ t_sendfile_big_all(Config) when is_list(Config) -> t_sendfile_big_size(Config) -> Filename = proplists:get_value(big_file, Config), FileOpts = proplists:get_value(file_opts, Config, []), - SendfileOpts = proplists:get_value(sendfile_opts, Config), + SendfileOpts = proplists:get_value(sendfile_opts, Config, []), SendAll = fun(Sock) -> {ok, #file_info{size = Size}} = @@ -180,7 +180,7 @@ t_sendfile_big_size(Config) -> t_sendfile_partial(Config) -> Filename = proplists:get_value(small_file, Config), FileOpts = proplists:get_value(file_opts, Config, []), - SendfileOpts = proplists:get_value(sendfile_opts, Config), + SendfileOpts = proplists:get_value(sendfile_opts, Config, []), SendSingle = fun(Sock) -> {_Size, <<Data:5/binary,_/binary>>} = @@ -217,7 +217,7 @@ t_sendfile_partial(Config) -> t_sendfile_offset(Config) -> Filename = proplists:get_value(small_file, Config), FileOpts = proplists:get_value(file_opts, Config, []), - SendfileOpts = proplists:get_value(sendfile_opts, Config), + SendfileOpts = proplists:get_value(sendfile_opts, Config, []), Send = fun(Sock) -> {_Size, <<_:5/binary,Data:3/binary,_/binary>> = AllData} = @@ -233,7 +233,7 @@ t_sendfile_offset(Config) -> t_sendfile_sendafter(Config) -> Filename = proplists:get_value(small_file, Config), - SendfileOpts = proplists:get_value(sendfile_opts, Config), + SendfileOpts = proplists:get_value(sendfile_opts, Config, []), Send = fun(Sock) -> {Size, Data} = sendfile_file_info(Filename), @@ -246,7 +246,7 @@ t_sendfile_sendafter(Config) -> t_sendfile_recvafter(Config) -> Filename = proplists:get_value(small_file, Config), - SendfileOpts = proplists:get_value(sendfile_opts, Config), + SendfileOpts = proplists:get_value(sendfile_opts, Config, []), Send = fun(Sock) -> {Size, Data} = sendfile_file_info(Filename), @@ -279,7 +279,7 @@ t_sendfile_recvafter_remoteclose(Config) -> t_sendfile_sendduring(Config) -> Filename = proplists:get_value(big_file, Config), - SendfileOpts = proplists:get_value(sendfile_opts, Config), + SendfileOpts = proplists:get_value(sendfile_opts, Config, []), Send = fun(Sock) -> {ok, #file_info{size = Size}} = @@ -296,7 +296,7 @@ t_sendfile_sendduring(Config) -> t_sendfile_recvduring(Config) -> Filename = proplists:get_value(big_file, Config), - SendfileOpts = proplists:get_value(sendfile_opts, Config), + SendfileOpts = proplists:get_value(sendfile_opts, Config, []), Send = fun(Sock) -> {ok, #file_info{size = Size}} = @@ -315,7 +315,7 @@ t_sendfile_recvduring(Config) -> t_sendfile_closeduring(Config) -> Filename = proplists:get_value(big_file, Config), - SendfileOpts = proplists:get_value(sendfile_opts, Config), + SendfileOpts = proplists:get_value(sendfile_opts, Config, []), Send = fun(Sock,SFServPid) -> spawn_link(fun() -> @@ -345,7 +345,7 @@ t_sendfile_closeduring(Config) -> t_sendfile_crashduring(Config) -> Filename = proplists:get_value(big_file, Config), - SendfileOpts = proplists:get_value(sendfile_opts, Config), + SendfileOpts = proplists:get_value(sendfile_opts, Config, []), error_logger:add_report_handler(?MODULE,[self()]), @@ -373,6 +373,36 @@ t_sendfile_crashduring(Config) -> end end. +t_sendfile_arguments(Config) -> + Filename = proplists:get_value(small_file, Config), + + {ok, Listener} = gen_tcp:listen(0, + [{packet, 0}, {active, false}, {reuseaddr, true}]), + {ok, Port} = inet:port(Listener), + + ErrorCheck = + fun(Reason, Offset, Length, Opts) -> + {ok, Sender} = gen_tcp:connect({127, 0, 0, 1}, Port, + [{packet, 0}, {active, false}]), + {ok, Receiver} = gen_tcp:accept(Listener), + {ok, Fd} = file:open(Filename, [read, raw]), + {error, Reason} = file:sendfile(Fd, Sender, Offset, Length, Opts), + gen_tcp:close(Receiver), + gen_tcp:close(Sender), + file:close(Fd) + end, + + ErrorCheck(einval, -1, 0, []), + ErrorCheck(einval, 0, -1, []), + ErrorCheck(badarg, gurka, 0, []), + ErrorCheck(badarg, 0, gurka, []), + ErrorCheck(badarg, 0, 0, gurka), + ErrorCheck(badarg, 0, 0, [{chunk_size, gurka}]), + + gen_tcp:close(Listener), + + ok. + %% Generic sendfile server code sendfile_send(Send) -> sendfile_send({127,0,0,1},Send). diff --git a/lib/kernel/test/zlib_SUITE.erl b/lib/kernel/test/zlib_SUITE.erl index 26602bdcda..f203ef878f 100644 --- a/lib/kernel/test/zlib_SUITE.erl +++ b/lib/kernel/test/zlib_SUITE.erl @@ -1061,32 +1061,27 @@ sub_heap_binaries(Config) when is_list(Config) -> %% Check concurrent access to zlib driver. smp(Config) -> - case erlang:system_info(smp_support) of - true -> - NumOfProcs = lists:min([8,erlang:system_info(schedulers)]), - io:format("smp starting ~p workers\n",[NumOfProcs]), - - %% Tests to run in parallel. - Funcs = - [zip_usage, gz_usage, compress_usage, dictionary_usage, - crc, adler], - - %% We get all function arguments here to avoid repeated parallel - %% file read access. - UsageArgs = - list_to_tuple([{F, ?MODULE:F({get_arg,Config})} || F <- Funcs]), - Parent = self(), - - WorkerFun = - fun() -> - worker(rand:uniform(9999), UsageArgs, Parent) - end, - - Pids = [spawn_link(WorkerFun) || _ <- lists:seq(1, NumOfProcs)], - wait_pids(Pids); - false -> - {skipped,"No smp support"} - end. + NumOfProcs = lists:min([8,erlang:system_info(schedulers)]), + io:format("smp starting ~p workers\n",[NumOfProcs]), + + %% Tests to run in parallel. + Funcs = + [zip_usage, gz_usage, compress_usage, dictionary_usage, + crc, adler], + + %% We get all function arguments here to avoid repeated parallel + %% file read access. + UsageArgs = + list_to_tuple([{F, ?MODULE:F({get_arg,Config})} || F <- Funcs]), + Parent = self(), + + WorkerFun = + fun() -> + worker(rand:uniform(9999), UsageArgs, Parent) + end, + + Pids = [spawn_link(WorkerFun) || _ <- lists:seq(1, NumOfProcs)], + wait_pids(Pids). worker(Seed, FnATpl, Parent) -> io:format("smp worker ~p, seed=~p~n",[self(),Seed]), diff --git a/lib/kernel/vsn.mk b/lib/kernel/vsn.mk index bd229c81b4..106bda01ca 100644 --- a/lib/kernel/vsn.mk +++ b/lib/kernel/vsn.mk @@ -1 +1 @@ -KERNEL_VSN = 5.4.0.1 +KERNEL_VSN = 5.4.1 diff --git a/lib/megaco/doc/src/Makefile b/lib/megaco/doc/src/Makefile index 8b9ce31d0e..43704cddf4 100644 --- a/lib/megaco/doc/src/Makefile +++ b/lib/megaco/doc/src/Makefile @@ -1,7 +1,7 @@ -# +# # %CopyrightBegin% # -# Copyright Ericsson AB 2000-2016. All Rights Reserved. +# Copyright Ericsson AB 2000-2017. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -43,7 +43,7 @@ include files.mk # ---------------------------------------------------- XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \ - $(XML_PART_FILES) $(XML_CHAPTER_FILES) + $(XML_PART_FILES) $(XML_CHAPTER_FILES) INTERNAL_HTML_FILES = $(TECHNICAL_DESCR_FILES:%.xml=$(HTMLDIR)/%.html) @@ -70,10 +70,6 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -INDEX_FILE = index.html -INDEX_SRC = $(INDEX_FILE).src -INDEX_TARGET = $(DOCDIR)/$(INDEX_FILE) - STANDARD_DIR = ../standard STANDARDS = $(STANDARD_DIR)/rfc3525.txt \ $(STANDARD_DIR)/rfc4234.txt \ @@ -81,10 +77,10 @@ STANDARDS = $(STANDARD_DIR)/rfc3525.txt \ $(STANDARD_DIR)/implementors_guide_v10-13.pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += +XML_FLAGS += +DVIPS_FLAGS += # ---------------------------------------------------- @@ -101,7 +97,7 @@ $(HTMLDIR)/%.png: %.png docs: pdf html man -ldocs: local_docs $(INDEX_TARGET) +ldocs: local_docs $(TOP_PDF_FILE): $(XML_FILES) @@ -121,22 +117,14 @@ clean_html: imgs: $(IMG_FILES:%=$(HTMLDIR)/%) -man: $(MAN3_FILES) - -$(INDEX_TARGET): $(INDEX_SRC) $(APP_FILE) - sed -e 's/%VSN%/$(VSN)/' \ - -e 's/%ERLANG_SITE%/www\.erlang\.se\//' \ - -e 's/%UP_ONE_LEVEL%/..\/..\/..\/doc\/index.html/' \ - -e 's/%OFF_PRINT%/pdf\/megaco-$(VSN).pdf/' $< > $@ +man: $(MAN3_FILES) -debug opt: +debug opt: info: @echo "->Makefile<-" @echo "" - @echo "INDEX_FILE = $(INDEX_FILE)" - @echo "INDEX_SRC = $(INDEX_SRC)" - @echo "INDEX_TARGET = $(INDEX_TARGET)" + @echo "HTML_REF_MAN_FILE = $(HTML_REF_MAN_FILE)" @echo "" @echo "XML_APPLICATION_FILES = $(XML_APPLICATION_FILES)" @echo "XML_PART_FILES = $(XML_PART_FILES)" @@ -158,7 +146,7 @@ info: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs @@ -193,4 +181,3 @@ $(HTMLDIR)/megaco_transport_mechanisms.html: megaco_transport_mechanisms.xml $(HTMLDIR)/megaco_transport.html: megaco_transport.xml $(HTMLDIR)/megaco_udp.html: megaco_udp.xml $(HTMLDIR)/megaco_user.html: megaco_user.xml - diff --git a/lib/megaco/doc/src/book.gif b/lib/megaco/doc/src/book.gif Binary files differdeleted file mode 100644 index 94b3868792..0000000000 --- a/lib/megaco/doc/src/book.gif +++ /dev/null diff --git a/lib/megaco/doc/src/book.xml b/lib/megaco/doc/src/book.xml index 47ad9b6a5e..9c304d6cae 100644 --- a/lib/megaco/doc/src/book.xml +++ b/lib/megaco/doc/src/book.xml @@ -11,7 +11,7 @@ Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at - + http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software @@ -19,7 +19,7 @@ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. - + </legalnotice> <title>Megaco/H.248</title> @@ -46,4 +46,3 @@ </releasenotes> <index></index> </book> - diff --git a/lib/megaco/doc/src/fascicules.xml b/lib/megaco/doc/src/fascicules.xml deleted file mode 100644 index 37feca543f..0000000000 --- a/lib/megaco/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/megaco/doc/src/files.mk b/lib/megaco/doc/src/files.mk index 5e7d849ab6..e40889c3fb 100644 --- a/lib/megaco/doc/src/files.mk +++ b/lib/megaco/doc/src/files.mk @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 2001-2016. All Rights Reserved. +# Copyright Ericsson AB 2001-2017. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -36,9 +36,7 @@ XML_REF3_FILES = \ megaco_udp.xml XML_PART_FILES = \ - part.xml \ - part_notes.xml \ - part_notes_history.xml + part.xml XML_EXTRA_FILES = \ notes_history.xml @@ -61,11 +59,6 @@ IMG_FILES = \ single_node_config.gif \ distr_node_config.gif \ megaco_sys_arch.gif \ - user_guide.gif \ - note.gif \ - notes.gif \ - ref_man.gif \ - book.gif \ MG-startup_flow_noMID.gif \ MGC_startup_call_flow.gif \ MG_startup_call_flow.gif \ diff --git a/lib/megaco/doc/src/index.html.src b/lib/megaco/doc/src/index.html.src deleted file mode 100644 index b3ff9c3ae7..0000000000 --- a/lib/megaco/doc/src/index.html.src +++ /dev/null @@ -1,113 +0,0 @@ -<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"> -<!-- This file is obsolete --> -<HTML> -<!-- - ``Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - The Initial Developer of the Original Code is Ericsson Utvecklings AB. - Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings - AB. All Rights Reserved.'' - - $Id$ ---> -<HEAD> -<TITLE>Megaco %VSN%</TITLE> -</HEAD> - -<BODY BGCOLOR="#FFFFFF"> - -<CENTER> -<A HREF="http://%ERLANG_SITE%"> - <IMG ALT="Erlang/OTP" BORDER=0 SRC="html/min_head.gif"> -</A><BR> - -<FONT SIZE="-1"> -[<A HREF="%UP_ONE_LEVEL%">Up</A> | -<A HREF="http://%ERLANG_SITE%">Erlang/OTP</A>] -</FONT><BR> - -<P><FONT SIZE="+3">Megaco</FONT><BR> -Version %VSN% -</CENTER> - -<P><TABLE> -<TR> -<TD> -<!-- IMG ALIGN=LEFT ALT="MEGACO" SRC="html/megaco.gif" --> -</TD> - -<TD> - <p>The <STRONG>Megaco</STRONG> application is a framework -for building applications on top of the Megaco/H.248 protocol.</p> -</TD> -</TR> -</TABLE> - -<P><CENTER> -<TABLE CELLPADDING=15> -<TR> -<TD ALIGN=CENTER> -<A HREF="html/users_guide.html"> - <IMG ALT="User's Guide" BORDER=0 SRC="html/user_guide.gif"> -</A> -<BR> -<FONT SIZE="-1"> -<A HREF="html/users_guide.html">User's Guide</A> -</FONT> -</TD> - -<TD ALIGN=CENTER> -<A HREF="html/index.html"> - <IMG ALT="Reference Manual" BORDER=0 SRC="html/ref_man.gif"> -</A> -<BR> -<FONT SIZE="-1"> -<A HREF="html/index.html">Reference Manual</A> -</FONT> -</TD> - -</TR> - -<TR> -<TD ALIGN=CENTER> -<A HREF="html/release_notes.html"> - <IMG ALT="Release Notes" BORDER=0 SRC="html/notes.gif"> -</A> -<BR> -<FONT SIZE="-1"> -<A HREF="html/release_notes.html">Release Notes</A> -</FONT> -</TD> - -<TD ALIGN=CENTER> -<A HREF="%OFF_PRINT%"> - <IMG ALT="Off-Print" BORDER=0 SRC="html/book.gif"> -</A> -<BR> -<FONT SIZE="-1"> -<A HREF="%OFF_PRINT%">Off-Print</A> -</FONT> -</TD> -</TR> -</TABLE> -</CENTER> - -<P><CENTER> -<HR> -<FONT SIZE="-1"> -Copyright © 1991-2001 -<A HREF="http://www.erlang.se/">Ericsson Utvecklings AB</A> -</FONT> -</CENTER> -</BODY> -</HTML> diff --git a/lib/megaco/doc/src/note.gif b/lib/megaco/doc/src/note.gif Binary files differdeleted file mode 100644 index 6fffe30419..0000000000 --- a/lib/megaco/doc/src/note.gif +++ /dev/null diff --git a/lib/megaco/doc/src/notes.gif b/lib/megaco/doc/src/notes.gif Binary files differdeleted file mode 100644 index e000cca26a..0000000000 --- a/lib/megaco/doc/src/notes.gif +++ /dev/null diff --git a/lib/megaco/doc/src/notes.xml b/lib/megaco/doc/src/notes.xml index 068389c0c2..54e048a172 100644 --- a/lib/megaco/doc/src/notes.xml +++ b/lib/megaco/doc/src/notes.xml @@ -11,7 +11,7 @@ Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at - + http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software @@ -19,9 +19,9 @@ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. - + </legalnotice> - + <title>Megaco Release Notes</title> <prepared>Lars Thorsén, Håkan Mattsson, Micael Karlberg</prepared> <docno></docno> @@ -35,9 +35,24 @@ bugfixes for every release of Megaco. Each release of Megaco thus constitutes one section in this document. The title of each section is the version number of Megaco.</p> - - - <section><title>Megaco 3.18.2</title> + + + <section><title>Megaco 3.18.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Removed all old unused files in the documentation. + </p> + <p> + Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p> + </item> + </list> + </section> + +</section> + +<section><title>Megaco 3.18.2</title> <section><title>Improvements and New Features</title> <list> @@ -142,7 +157,7 @@ </item> </list> </section> - + </section> <section><title>Megaco 3.17.0.2</title> @@ -158,7 +173,7 @@ </item> </list> </section> - + </section> <section><title>Megaco 3.17.0.1</title> @@ -190,7 +205,7 @@ <list type="bulleted"> <item> <p>Allow whitespaces in installation path. </p> - <p>It is now possible to give configure and make an + <p>It is now possible to give configure and make an installation/release path with whitespaces in it. </p> <p>Own Id: OTP-10107</p> </item> @@ -202,24 +217,24 @@ <section> <title>Fixed bugs and malfunctions</title> - + <!-- <p>-</p> --> - + <list type="bulleted"> <item> - <p>Buffer overrun error while flex scanner processing + <p>Buffer overrun error while flex scanner processing property parm groups. </p> - <p>This error occured only for large messages if a - buffer realloc was needed while processing the + <p>This error occured only for large messages if a + buffer realloc was needed while processing the property parm groups. </p> <p>Own Id: OTP-10998</p> <p>Aux Id: Seq 12263</p> </item> - + </list> - + </section> <section> @@ -229,10 +244,10 @@ <!-- <list type="bulleted"> <item> - <p>A number of binary encoding alternatives has been removed. + <p>A number of binary encoding alternatives has been removed. The binary encoding option <c>driver</c> has been removed - since this (the use of the asn1 linked in driver) is - now default and there is now way to <em>not</em> use it. + since this (the use of the asn1 linked in driver) is + now default and there is now way to <em>not</em> use it. See <seealso marker="megaco_encode#binary_config">configuration of binary encoding</seealso> for more info. </p> </item> @@ -270,19 +285,19 @@ <section> <title>Fixed bugs and malfunctions</title> - + <p>-</p> - + <!-- <list type="bulleted"> <item> <p>Fixing miscellaneous things detected by dialyzer. </p> <p>Own Id: OTP-9075</p> </item> - + </list> --> - + </section> <section> @@ -293,10 +308,10 @@ <list type="bulleted"> <item> - <p>A number of binary encoding alternatives has been removed. + <p>A number of binary encoding alternatives has been removed. The binary encoding option <c>driver</c> has been removed - since this (the use of the asn1 linked in driver) is - now default and there is now way to <em>not</em> use it. + since this (the use of the asn1 linked in driver) is + now default and there is now way to <em>not</em> use it. See <seealso marker="megaco_encode#binary_config">configuration of binary encoding</seealso> for more info. </p> </item> @@ -322,7 +337,7 @@ <list type="bulleted"> <item> <p>Allow whitespaces in installation path. </p> - <p>It is now possible to give configure and make an + <p>It is now possible to give configure and make an installation/release path with whitespaces in it. </p> <p>Own Id: OTP-10107</p> </item> @@ -332,8 +347,8 @@ </item> <item> - <p>Removed use of deprecated system flag, - <c>global_haeps_size</c>, in the measurement tool + <p>Removed use of deprecated system flag, + <c>global_haeps_size</c>, in the measurement tool <c>mstone1</c>. </p> </item> @@ -343,19 +358,19 @@ <section> <title>Fixed bugs and malfunctions</title> - + <p>-</p> - + <!-- <list type="bulleted"> <item> <p>Fixing miscellaneous things detected by dialyzer. </p> <p>Own Id: OTP-9075</p> </item> - + </list> --> - + </section> <section> @@ -365,8 +380,8 @@ <!-- <list type="bulleted"> <item> - <p>Due to the change in the flex driver API, - we may no longer be able to build and/or use + <p>Due to the change in the flex driver API, + we may no longer be able to build and/or use the flex driver without reentrant support. </p> <p>Own Id: OTP-9795</p> </item> @@ -400,8 +415,8 @@ </item> <item> - <p>Removed use of deprecated system flag, - <c>scheduler_bind_type</c>, in the measurement tool + <p>Removed use of deprecated system flag, + <c>scheduler_bind_type</c>, in the measurement tool <c>mstone1</c>. </p> <p>Own Id: OTP-9949</p> </item> @@ -412,19 +427,19 @@ <section> <title>Fixed bugs and malfunctions</title> - + <p>-</p> - + <!-- <list type="bulleted"> <item> <p>Fixing miscellaneous things detected by dialyzer. </p> <p>Own Id: OTP-9075</p> </item> - + </list> --> - + </section> <section> @@ -434,8 +449,8 @@ <!-- <list type="bulleted"> <item> - <p>Due to the change in the flex driver API, - we may no longer be able to build and/or use + <p>Due to the change in the flex driver API, + we may no longer be able to build and/or use the flex driver without reentrant support. </p> <p>Own Id: OTP-9795</p> </item> @@ -467,8 +482,8 @@ </item> <item> - <p>ASN.1 no longer makes use of a driver to accelerate encode/decode, - instead it uses NIFs. The encoding config option is <em>still</em> + <p>ASN.1 no longer makes use of a driver to accelerate encode/decode, + instead it uses NIFs. The encoding config option is <em>still</em> the same, i.e. <c>driver</c>. </p> <p>Own Id: OTP-9672</p> </item> @@ -491,19 +506,19 @@ <section> <title>Fixed bugs and malfunctions</title> - + <p>-</p> - + <!-- <list type="bulleted"> <item> <p>Fixing miscellaneous things detected by dialyzer. </p> <p>Own Id: OTP-9075</p> </item> - + </list> --> - + </section> <section> @@ -513,8 +528,8 @@ <!-- <list type="bulleted"> <item> - <p>Due to the change in the flex driver API, - we may no longer be able to build and/or use + <p>Due to the change in the flex driver API, + we may no longer be able to build and/or use the flex driver without reentrant support. </p> <p>Own Id: OTP-9795</p> </item> @@ -551,19 +566,19 @@ <section> <title>Fixed bugs and malfunctions</title> - + <p>-</p> - + <!-- <list type="bulleted"> <item> <p>Fixing miscellaneous things detected by dialyzer. </p> <p>Own Id: OTP-9075</p> </item> - + </list> --> - + </section> </section> <!-- 3.15.1.1 --> @@ -582,8 +597,8 @@ <!-- <list type="bulleted"> <item> - <p>Updated the - <seealso marker="megaco_performance">performance</seealso> + <p>Updated the + <seealso marker="megaco_performance">performance</seealso> chapter. </p> <p>Own Id: OTP-8696</p> </item> @@ -637,7 +652,7 @@ <!-- <list type="bulleted"> <item> - <p>Eliminated a possible race condition while creating + <p>Eliminated a possible race condition while creating pending counters. </p> <p>Own Id: OTP-8634</p> <p>Aux Id: Seq 11579</p> @@ -666,8 +681,8 @@ <list type="bulleted"> <item> - <p>Updated the - <seealso marker="megaco_performance">performance</seealso> + <p>Updated the + <seealso marker="megaco_performance">performance</seealso> chapter. </p> <p>Own Id: OTP-8696</p> </item> @@ -694,14 +709,14 @@ <item> <p>Fix shared libraries installation. </p> - <p>The flex shared lib(s) were incorrectly installed as data + <p>The flex shared lib(s) were incorrectly installed as data files. </p> <p>Peter Lemenkov</p> <p>Own Id: OTP-8627</p> </item> <item> - <p>Eliminated a possible race condition while creating + <p>Eliminated a possible race condition while creating pending counters. </p> <p>Own Id: OTP-8634</p> <p>Aux Id: Seq 11579</p> @@ -757,14 +772,14 @@ <item> <p>Fix shared libraries installation. </p> - <p>The flex shared lib(s) were incorrectly installed as data + <p>The flex shared lib(s) were incorrectly installed as data files. </p> <p>Peter Lemenkov</p> <p>Own Id: OTP-8627</p> </item> <item> - <p>Eliminated a possible race condition while creating + <p>Eliminated a possible race condition while creating pending counters. </p> <p>Own Id: OTP-8634</p> <p>Aux Id: Seq 11579</p> @@ -792,18 +807,18 @@ <list type="bulleted"> <item> - <p>Various changes to configure and makefile(s) to facilitate cross + <p>Various changes to configure and makefile(s) to facilitate cross compilation (and other build system improvements). </p> <p>Own Id: OTP-8323</p> </item> <item> - <p>Added a help target in the test Makefile to explain - the most useful make targets, used when testing the + <p>Added a help target in the test Makefile to explain + the most useful make targets, used when testing the application using the test-server provided with megaco.</p> <p>Own Id: OTP-8362</p> </item> - + <item> <p>Adapted megaco_filter to the new internal format.</p> <p>Own Id: OTP-8403</p> @@ -820,16 +835,16 @@ <list type="bulleted"> <item> - <p>Callbacks, when the callback module is unknown (undefined), + <p>Callbacks, when the callback module is unknown (undefined), results in warning messages. </p> <p>A race condition scenario. As part of a cancelation operation, replies with waiting acknowledgements is cancelled. This includes - informing the user (via a call to the handle_trans_ack callback - function). It is possible that at this point the connection data - has been removed, which makes it impossible for megaco to - perform this operation, resulting in the warning message. The - solution is to also store the callback module with the other - reply information, to be used when cleaning up after a + informing the user (via a call to the handle_trans_ack callback + function). It is possible that at this point the connection data + has been removed, which makes it impossible for megaco to + perform this operation, resulting in the warning message. The + solution is to also store the callback module with the other + reply information, to be used when cleaning up after a cancelation. </p> <p>Own Id: OTP-8328</p> <p>Aux Id: Seq 11384</p> @@ -863,8 +878,8 @@ </item> <item> - <p>The documentation is now built with open source tools - (<em>xsltproc</em> and <em>fop</em>) that exists on most + <p>The documentation is now built with open source tools + (<em>xsltproc</em> and <em>fop</em>) that exists on most platforms. One visible change is that the frames are removed.</p> <p>Own Id: OTP-8249</p> </item> @@ -910,11 +925,4 @@ </section> </section> <!-- 3.13 --> - - <!-- section> - <title>Release notes history</title> - <p>For information about older versions see - <url href="part_notes_history_frame.html">release notes history</url>.</p - </section> --> </chapter> - diff --git a/lib/megaco/doc/src/part_notes.xml b/lib/megaco/doc/src/part_notes.xml deleted file mode 100644 index 7a838c5718..0000000000 --- a/lib/megaco/doc/src/part_notes.xml +++ /dev/null @@ -1,40 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2000</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>Megaco/H.248 Release Notes</title> - <prepared>Lars Thorsén, Håkan Mattsson, Micael Karlberg</prepared> - <docno></docno> - <date>2007-06-15</date> - <rev>%VSN%</rev> - <file>part_notes.xml</file> - </header> - <description> - <p>The Megaco application is a framework for building - applications on top of the Megaco/H.248 protocol.</p> - <p>For information about older versions see - <url href="part_notes_history_frame.html">release notes history</url>.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/megaco/doc/src/part_notes_history.xml b/lib/megaco/doc/src/part_notes_history.xml deleted file mode 100644 index 0d8f1f2fb5..0000000000 --- a/lib/megaco/doc/src/part_notes_history.xml +++ /dev/null @@ -1,41 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part> - <header> - <copyright> - <year>2006</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>Megaco Release Notes History</title> - <prepared>Micael Karklberg</prepared> - <responsible>OTP</responsible> - <docno></docno> - <approved>OTP</approved> - <checked></checked> - <date>2007-06-15</date> - <rev>A</rev> - <file>part_notes_history.xml</file> - </header> - <description> - <p>The Megaco application is a framework for building - applications on top of the Megaco/H.248 protocol.</p> - </description> - <include file="notes_history"></include> -</part> - diff --git a/lib/megaco/doc/src/ref_man.gif b/lib/megaco/doc/src/ref_man.gif Binary files differdeleted file mode 100644 index b13c4efd53..0000000000 --- a/lib/megaco/doc/src/ref_man.gif +++ /dev/null diff --git a/lib/megaco/doc/src/user_guide.gif b/lib/megaco/doc/src/user_guide.gif Binary files differdeleted file mode 100644 index e6275a803d..0000000000 --- a/lib/megaco/doc/src/user_guide.gif +++ /dev/null diff --git a/lib/megaco/doc/src/warning.gif b/lib/megaco/doc/src/warning.gif Binary files differdeleted file mode 100644 index 96af52360e..0000000000 --- a/lib/megaco/doc/src/warning.gif +++ /dev/null diff --git a/lib/megaco/vsn.mk b/lib/megaco/vsn.mk index 9c6ba5bba0..a4f7de7f07 100644 --- a/lib/megaco/vsn.mk +++ b/lib/megaco/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = megaco -MEGACO_VSN = 3.18.2 +MEGACO_VSN = 3.18.3 PRE_VSN = APP_VSN = "$(APPLICATION)-$(MEGACO_VSN)$(PRE_VSN)" diff --git a/lib/mnesia/doc/src/Makefile b/lib/mnesia/doc/src/Makefile index 39f2b28637..82fcf66256 100644 --- a/lib/mnesia/doc/src/Makefile +++ b/lib/mnesia/doc/src/Makefile @@ -1,8 +1,8 @@ # # %CopyrightBegin% -# -# Copyright Ericsson AB 1997-2016. All Rights Reserved. -# +# +# Copyright Ericsson AB 1997-2017. All Rights Reserved. +# # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at @@ -14,7 +14,7 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. -# +# # %CopyrightEnd% # @@ -44,12 +44,11 @@ XML_REF3_FILES = \ mnesia_registry.xml XML_PART_FILES = \ - part.xml \ - part_notes.xml \ - part_notes_history.xml + part.xml XML_CHAPTER_FILES = \ Mnesia_chap1.xml \ + Mnesia_overview.xml \ Mnesia_chap2.xml \ Mnesia_chap3.xml \ Mnesia_chap4.xml \ @@ -63,20 +62,12 @@ XML_CHAPTER_FILES = \ BOOK_FILES = book.xml - XML_FILES = \ $(BOOK_FILES) $(XML_CHAPTER_FILES) \ $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_APPLICATION_FILES) GIF_FILES = \ - book.gif \ - company.gif \ - mnesia.gif \ - note.gif \ - notes.gif \ - ref_man.gif \ - user_guide.gif \ - warning.gif + company.gif XML_HTML_FILES = \ notes_history.xml @@ -89,7 +80,7 @@ HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) INFO_FILE = ../../info -EXTRA_FILES = summary.html.src \ +EXTRA_FILES = \ $(DEFAULT_GIF_FILES) \ $(DEFAULT_HTML_FILES) \ $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ @@ -102,10 +93,10 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += +XML_FLAGS += +DVIPS_FLAGS += # ---------------------------------------------------- # Targets @@ -134,11 +125,11 @@ gifs: $(GIF_FILES:%=$(HTMLDIR)/%) $(INDEX_TARGET): $(INDEX_SRC) ../../vsn.mk sed -e 's;%VSN%;$(VSN);' $< > $@ -debug opt: +debug opt: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs diff --git a/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc b/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc index 62759c624b..0265e0efa0 100644 --- a/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc +++ b/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc @@ -226,8 +226,10 @@ not known beforehand, all fragments are searched for matching records.</p> <p>Notice that in <c>ordered_set</c> tables, the records - are ordered per fragment, and the the order is undefined in - results returned by <c>select</c> and <c>match_object</c>.</p> + are ordered per fragment, and the order is undefined in + results returned by <c>select</c> and <c>match_object</c>, + as well as <c>first</c>, <c>next</c>, <c>prev</c> and + <c>last</c>.</p> <p>The following code illustrates how a <c>Mnesia</c> table is converted to be a fragmented table and how more fragments are added later:</p> diff --git a/lib/mnesia/doc/src/book.gif b/lib/mnesia/doc/src/book.gif Binary files differdeleted file mode 100644 index 94b3868792..0000000000 --- a/lib/mnesia/doc/src/book.gif +++ /dev/null diff --git a/lib/mnesia/doc/src/fascicules.xml b/lib/mnesia/doc/src/fascicules.xml deleted file mode 100644 index 37feca543f..0000000000 --- a/lib/mnesia/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/mnesia/doc/src/mnesia.gif b/lib/mnesia/doc/src/mnesia.gif Binary files differdeleted file mode 100644 index fbbabee5aa..0000000000 --- a/lib/mnesia/doc/src/mnesia.gif +++ /dev/null diff --git a/lib/mnesia/doc/src/note.gif b/lib/mnesia/doc/src/note.gif Binary files differdeleted file mode 100644 index 6fffe30419..0000000000 --- a/lib/mnesia/doc/src/note.gif +++ /dev/null diff --git a/lib/mnesia/doc/src/notes.gif b/lib/mnesia/doc/src/notes.gif Binary files differdeleted file mode 100644 index e000cca26a..0000000000 --- a/lib/mnesia/doc/src/notes.gif +++ /dev/null diff --git a/lib/mnesia/doc/src/notes.xml b/lib/mnesia/doc/src/notes.xml index e9243f7fc9..ebab612b58 100644 --- a/lib/mnesia/doc/src/notes.xml +++ b/lib/mnesia/doc/src/notes.xml @@ -11,7 +11,7 @@ Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at - + http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software @@ -39,7 +39,23 @@ thus constitutes one section in this document. The title of each section is the version number of Mnesia.</p> - <section><title>Mnesia 4.15.1</title> + <section><title>Mnesia 4.15.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix backup error handling, the real failure reason was + not returned.</p> + <p> + Own Id: OTP-14776 Aux Id: ERIERL-103 </p> + </item> + </list> + </section> + +</section> + +<section><title>Mnesia 4.15.1</title> <section><title>Improvements and New Features</title> <list> @@ -906,9 +922,9 @@ </item> </list> </section> - - </section> - + + </section> + <section><title>Mnesia 4.4.13</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -977,7 +993,7 @@ </section> <section><title>Mnesia 4.4.10</title> - + <section><title>Fixed Bugs and Malfunctions</title> <list> <item> @@ -1007,7 +1023,7 @@ </item> </list> </section> - + </section> @@ -1025,7 +1041,7 @@ </item> </list> </section> - + </section> <section><title>Mnesia 4.4.8</title> @@ -1050,7 +1066,7 @@ </item> </list> </section> - + </section> <section><title>Mnesia 4.4.7</title> @@ -1084,7 +1100,7 @@ </section> - <section><title>Mnesia 4.4.6</title> + <section><title>Mnesia 4.4.6</title> <section><title>Fixed Bugs and Malfunctions</title> <list> <item> @@ -1275,9 +1291,4 @@ </section> </section> - <!-- section> - <title>Previous Notes</title> - <p>For information about older versions see <url href="part_notes_history_frame.html">release notes history</url>.</p> - </section --> </chapter> - diff --git a/lib/mnesia/doc/src/part_notes.xml b/lib/mnesia/doc/src/part_notes.xml deleted file mode 100644 index 1e4e4bc60a..0000000000 --- a/lib/mnesia/doc/src/part_notes.xml +++ /dev/null @@ -1,42 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>1997</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>MNESIA Release Notes</title> - <prepared>Claes Wikström, Hans Nilsson and Håkan Mattsson</prepared> - <docno></docno> - <date>1997-05-27</date> - <rev>1.2</rev> - <file>part_notes.xml</file> - </header> - <description> - <p><em>Mnesia</em> is a Distributed DataBase Management - System (DBMS), appropriate for telecommunications applications and other - Erlang applications which require continuous operation and exhibit soft - real-time properties. </p> - <p>For information about older versions see - <url href="part_notes_history_frame.html">release notes history</url>.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/mnesia/doc/src/part_notes_history.xml b/lib/mnesia/doc/src/part_notes_history.xml deleted file mode 100644 index a1c6f5aef0..0000000000 --- a/lib/mnesia/doc/src/part_notes_history.xml +++ /dev/null @@ -1,42 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part> - <header> - <copyright> - <year>2004</year> - <year>2016</year> - <holder>Ericsson AB, All Rights Reserved</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>MNESIA Release Notes</title> - <prepared>Claes Wikström, Hans Nilsson and Håkan Mattsson</prepared> - <docno></docno> - <date>1997-05-27</date> - <rev>1.2</rev> - <file>part_notes_history.sgml</file> - </header> - <description> - <p><em>Mnesia</em> is a Distributed DataBase Management - System (DBMS), appropriate for telecommunications applications and other - Erlang applications which require continuous operation and exhibit soft - real-time properties. </p> - </description> - <include file="notes_history"></include> -</part> - diff --git a/lib/mnesia/doc/src/ref_man.gif b/lib/mnesia/doc/src/ref_man.gif Binary files differdeleted file mode 100644 index b13c4efd53..0000000000 --- a/lib/mnesia/doc/src/ref_man.gif +++ /dev/null diff --git a/lib/mnesia/doc/src/summary.html.src b/lib/mnesia/doc/src/summary.html.src deleted file mode 100644 index 2941a2f46a..0000000000 --- a/lib/mnesia/doc/src/summary.html.src +++ /dev/null @@ -1 +0,0 @@ -A heavy duty real-time distributed database
\ No newline at end of file diff --git a/lib/mnesia/doc/src/user_guide.gif b/lib/mnesia/doc/src/user_guide.gif Binary files differdeleted file mode 100644 index e6275a803d..0000000000 --- a/lib/mnesia/doc/src/user_guide.gif +++ /dev/null diff --git a/lib/mnesia/doc/src/warning.gif b/lib/mnesia/doc/src/warning.gif Binary files differdeleted file mode 100644 index 96af52360e..0000000000 --- a/lib/mnesia/doc/src/warning.gif +++ /dev/null diff --git a/lib/mnesia/src/mnesia.erl b/lib/mnesia/src/mnesia.erl index b68b2de028..95f7d4afc1 100644 --- a/lib/mnesia/src/mnesia.erl +++ b/lib/mnesia/src/mnesia.erl @@ -151,7 +151,8 @@ {'snmp', SnmpStruct::term()} | {'storage_properties', [{Backend::module(), [BackendProp::_]}]} | {'type', 'set' | 'ordered_set' | 'bag'} | - {'local_content', boolean()}. + {'local_content', boolean()} | + {'user_properties', proplists:proplist()}. -type t_result(Res) :: {'atomic', Res} | {'aborted', Reason::term()}. -type activity() :: 'ets' | 'async_dirty' | 'sync_dirty' | 'transaction' | 'sync_transaction' | @@ -2681,7 +2682,7 @@ del_table_index(Tab, Ix) -> -spec transform_table(Tab::table(), Fun, [Attr]) -> t_result(ok) when Attr :: atom(), - Fun:: fun((Record::tuple()) -> Transformed::tuple()). + Fun:: fun((Record::tuple()) -> Transformed::tuple()) | ignore. transform_table(Tab, Fun, NewA) -> try val({Tab, record_name}) of OldRN -> mnesia_schema:transform_table(Tab, Fun, NewA, OldRN) @@ -2692,7 +2693,7 @@ transform_table(Tab, Fun, NewA) -> -spec transform_table(Tab::table(), Fun, [Attr], RecName) -> t_result(ok) when RecName :: atom(), Attr :: atom(), - Fun:: fun((Record::tuple()) -> Transformed::tuple()). + Fun:: fun((Record::tuple()) -> Transformed::tuple()) | ignore. transform_table(Tab, Fun, NewA, NewRN) -> mnesia_schema:transform_table(Tab, Fun, NewA, NewRN). diff --git a/lib/mnesia/src/mnesia_log.erl b/lib/mnesia/src/mnesia_log.erl index 55b1d6e419..a2de23a2a3 100644 --- a/lib/mnesia/src/mnesia_log.erl +++ b/lib/mnesia/src/mnesia_log.erl @@ -752,8 +752,8 @@ abort_write(B, What, Args, Reason) -> Opaque = B#backup_args.opaque, dbg_out("Failed to perform backup. M=~p:F=~tp:A=~tp -> ~tp~n", [Mod, What, Args, Reason]), - try apply(Mod, abort_write, [Opaque]) of - {ok, _Res} -> throw({error, Reason}) + try {ok, _Res} = apply(Mod, abort_write, [Opaque]) of + _ -> throw({error, Reason}) catch _:Other -> error("Failed to abort backup. ~p:~tp~tp -> ~tp~n", [Mod, abort_write, [Opaque], Other]), diff --git a/lib/mnesia/test/mnesia_test_lib.erl b/lib/mnesia/test/mnesia_test_lib.erl index 0fabdc7929..78dbe7ffde 100644 --- a/lib/mnesia/test/mnesia_test_lib.erl +++ b/lib/mnesia/test/mnesia_test_lib.erl @@ -774,7 +774,7 @@ init_nodes([], _File, _Line) -> %% Returns [Name, Host] node_to_name_and_host(Node) -> - string:tokens(atom_to_list(Node), [$@]). + string:lexemes(atom_to_list(Node), [$@]). lookup_config(Key,Config) -> case lists:keysearch(Key,1,Config) of diff --git a/lib/mnesia/vsn.mk b/lib/mnesia/vsn.mk index a95f468ba2..67afbdc0de 100644 --- a/lib/mnesia/vsn.mk +++ b/lib/mnesia/vsn.mk @@ -1 +1 @@ -MNESIA_VSN = 4.15.1 +MNESIA_VSN = 4.15.2 diff --git a/lib/observer/doc/src/Makefile b/lib/observer/doc/src/Makefile index b38278a156..11bfee1bdb 100644 --- a/lib/observer/doc/src/Makefile +++ b/lib/observer/doc/src/Makefile @@ -9,11 +9,11 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. -# +# # The Initial Developer of the Original Code is Ericsson Utvecklings AB. # Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings # AB. All Rights Reserved.'' -# +# # $Id$ # include $(ERL_TOP)/make/target.mk @@ -45,17 +45,15 @@ XML_REF3_FILES = \ XML_REF6_FILES = observer_app.xml XML_PART_FILES = \ - part.xml \ - part_notes.xml \ - part_notes_history.xml + part.xml XML_CHAPTER_FILES = \ + introduction_ug.xml \ crashdump_ug.xml \ etop_ug.xml \ observer_ug.xml \ ttb_ug.xml \ - notes.xml \ - notes_history.xml + notes.xml BOOK_FILES = book.xml @@ -69,9 +67,7 @@ ONLY_HTML_FILE = GIF_FILES = \ et_processes.gif \ - et_modsprocs.gif \ - note.gif - + et_modsprocs.gif # ---------------------------------------------------- HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ @@ -88,9 +84,9 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += +XML_FLAGS += # ---------------------------------------------------- # Targets @@ -123,12 +119,12 @@ man: $(MAN1_FILES) $(MAN3_FILES) $(MAN6_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) -debug opt: +debug opt: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk @@ -148,4 +144,3 @@ release_docs_spec: docs release_spec: - diff --git a/lib/observer/doc/src/fascicules.xml b/lib/observer/doc/src/fascicules.xml deleted file mode 100644 index 37feca543f..0000000000 --- a/lib/observer/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/observer/doc/src/note.gif b/lib/observer/doc/src/note.gif Binary files differdeleted file mode 100644 index 6fffe30419..0000000000 --- a/lib/observer/doc/src/note.gif +++ /dev/null diff --git a/lib/observer/doc/src/notes.xml b/lib/observer/doc/src/notes.xml index 05ea550964..96cd89b375 100644 --- a/lib/observer/doc/src/notes.xml +++ b/lib/observer/doc/src/notes.xml @@ -32,6 +32,73 @@ <p>This document describes the changes made to the Observer application.</p> +<section><title>Observer 2.6</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A bug introduced in OTP-20 would make Crashdump Viewer + crash when trying to expand an empty binary. This is now + corrected.</p> + <p> + Own Id: OTP-14642</p> + </item> + <item> + <p> + If a match spec in the config file contained more than + one clause, observer would earlier crash when trying to + display it in the GUI. This is now corrected.</p> + <p> + Own Id: OTP-14643 Aux Id: ERL-489 </p> + </item> + <item> + <p>Writing of crash dumps is significantly faster.</p> + <p>Maps are now included in crash dumps.</p> + <p>Constants terms would only be shown in one process, + while other processes referencing the same constant term + would show a marker for incomplete heap. </p> + <p> + Own Id: OTP-14685 Aux Id: OTP-14611, OTP-14603, OTP-14595 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p>Binaries and some other data in crash dumps are now + encoded in base64 (instead of in hex), which will reduce + the size of crash dumps.</p> + <p>A few bugs in the handling of sub binaries in + <c>crashdump_viewer</c> have been fixed.</p> + <p> + Own Id: OTP-14686</p> + </item> + <item> + <p> + In order to allow future improvements, Crashdump Viewer + now checks the version tag of the crashdump to see that + it is a known format. If the crashdump version is newer + than Crashdump Viewer is prepared to read, then an + information dialog is displayed before Crashdump Viewer + terminates.</p> + <p> + If an incomplete process heap is discovered in a + crashdump, Crashdump Viewer will now display a warning + for this, similar to the warning displayed when a + crashdump is truncated. Incomplete heaps can occur if for + instance the literals are not included, which is the case + for all dumps prior to OTP-20.2.</p> + <p> + Own Id: OTP-14755</p> + </item> + </list> + </section> + +</section> + <section><title>Observer 2.5</title> <section><title>Improvements and New Features</title> diff --git a/lib/observer/doc/src/part_notes.xml b/lib/observer/doc/src/part_notes.xml deleted file mode 100644 index ba15c39cda..0000000000 --- a/lib/observer/doc/src/part_notes.xml +++ /dev/null @@ -1,39 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2004</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>Observer Release Notes</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p>The <em>OBSERVER</em> application contains tools for tracing - and investigation of distributed systems.</p> - <p>For information about older versions, see - <url href="part_notes_history_frame.html">Release Notes History</url>.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/observer/doc/src/part_notes_history.xml b/lib/observer/doc/src/part_notes_history.xml deleted file mode 100644 index e60210924c..0000000000 --- a/lib/observer/doc/src/part_notes_history.xml +++ /dev/null @@ -1,39 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part> - <header> - <copyright> - <year>2006</year> - <year>2016</year> - <holder>Ericsson AB, All Rights Reserved</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>Observer Release Notes History</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p>The <em>OBSERVER</em> application contains tools for tracing - and investigation of distributed systems.</p> - </description> - <include file="notes_history"></include> -</part> - diff --git a/lib/observer/src/cdv_bin_cb.erl b/lib/observer/src/cdv_bin_cb.erl index 5502869973..a4a542297c 100644 --- a/lib/observer/src/cdv_bin_cb.erl +++ b/lib/observer/src/cdv_bin_cb.erl @@ -71,6 +71,8 @@ hex_binary_fun(Bin) -> plain_html(io_lib:format("~s",[S])) end. +format_hex(<<>>,_) -> + []; format_hex(<<B1:4,B2:4>>,_) -> [integer_to_list(B1,16),integer_to_list(B2,16)]; format_hex(<<B1:4,B2:4,Bin/binary>>,0) -> diff --git a/lib/observer/src/cdv_dist_cb.erl b/lib/observer/src/cdv_dist_cb.erl index 2b4c9f56d1..aeb34e5baf 100644 --- a/lib/observer/src/cdv_dist_cb.erl +++ b/lib/observer/src/cdv_dist_cb.erl @@ -78,7 +78,7 @@ init_gen_page(Parent, Info) -> cdv_info_wx:start_link(Parent,{Fields,Info,[]}). format({creations,Creations}) -> - string:join([integer_to_list(C) || C <- Creations],","); + lists:flatten(lists:join(",",[integer_to_list(C) || C <- Creations])); format(D) -> D. diff --git a/lib/observer/src/cdv_mem_cb.erl b/lib/observer/src/cdv_mem_cb.erl index abeddc7335..925487786c 100644 --- a/lib/observer/src/cdv_mem_cb.erl +++ b/lib/observer/src/cdv_mem_cb.erl @@ -49,9 +49,7 @@ gen_mem_info_fields([]) -> []. upper(Key) -> - string:join([string:to_upper([H]) ++ T || - [H|T] <- string:tokens(Key,"_")]," "). - + lists:join(" ", [string:titlecase(Word) || Word <- string:split(Key, "_", all)]). %%%----------------------------------------------------------------- %%% Allocated areas page diff --git a/lib/observer/src/cdv_wx.erl b/lib/observer/src/cdv_wx.erl index c3f36cd689..0e33c9e618 100644 --- a/lib/observer/src/cdv_wx.erl +++ b/lib/observer/src/cdv_wx.erl @@ -130,8 +130,9 @@ init(File0) -> {ok,File} -> %% Set window title T1 = "Crashdump Viewer: ", + FileLength = string:length(File), Title = - if length(File) > 70 -> + if FileLength > 70 -> T1 ++ filename:basename(File); true -> T1 ++ File @@ -428,8 +429,9 @@ do_load_dump(Frame,FileName) -> ok -> %% Set window title T1 = "Crashdump Viewer: ", + FileLength = string:length(FileName), Title = - if length(FileName) > 70 -> + if FileLength > 70 -> T1 ++ filename:basename(FileName); true -> T1 ++ FileName diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl index 95e12887cd..f197e72b90 100644 --- a/lib/observer/src/crashdump_viewer.erl +++ b/lib/observer/src/crashdump_viewer.erl @@ -26,10 +26,25 @@ %% Tables %% ------ %% cdv_dump_index_table: This table holds all tags read from the -%% crashdump. Each tag indicates where the information about a -%% specific item starts. The table entry for a tag includes the start -%% position for this item-information. In a crash dump file, all tags -%% start with a "=" at the beginning of a line. +%% crashdump, except the 'binary' tag. Each tag indicates where the +%% information about a specific item starts. The table entry for a +%% tag includes the start position for this item-information. In a +%% crash dump file, all tags start with a "=" at the beginning of a +%% line. +%% +%% cdv_binary_index_table: This table holds all 'binary' tags. The hex +%% address for each binary is converted to its integer value before +%% storing Address -> Start Position in this table. The hex value of +%% the address is never used for lookup. +%% +%% cdv_reg_proc_table: This table holds mappings between pid and +%% registered name. This is used for timers and monitors. +%% +%% cdv_heap_file_chars: For each 'proc_heap' and 'literals' tag, this +%% table contains the number of characters to read from the crash dump +%% file. This is used for giving an indication in percent of the +%% progress when parsing this data. +%% %% %% Process state %% ------------- @@ -73,6 +88,9 @@ -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). +%% Test support +-export([get_dump_versions/0]). + %% Debug support -export([debug/1,stop_debug/0]). @@ -87,7 +105,10 @@ % line_head/1 function can return -define(not_available,"N/A"). -define(binary_size_progress_limit,10000). +-define(max_dump_version,[0,5]). +%% The value of the next define must be divisible by 4. +-define(base64_chunk_size, (4*256)). %% All possible tags - use macros in order to avoid misspelling in the code -define(abort,abort). @@ -104,6 +125,7 @@ -define(index_table,index_table). -define(instr_data,instr_data). -define(internal_ets,internal_ets). +-define(literals,literals). -define(loaded_modules,loaded_modules). -define(memory,memory). -define(memory_map,memory_map). @@ -125,6 +147,7 @@ -record(state,{file,dump_vsn,wordsize=4,num_atoms="unknown"}). +-record(dec_opts, {bin_addr_adj=0,base64=true}). %%%----------------------------------------------------------------- %%% Debugging @@ -293,6 +316,11 @@ port(Id) -> expand_binary(Pos) -> call({expand_binary,Pos}). +%%%----------------------------------------------------------------- +%%% For testing only - called from crashdump_viewer_SUITE +get_dump_versions() -> + call(get_dump_versions). + %%==================================================================== %% Server functions %%==================================================================== @@ -342,10 +370,12 @@ handle_call(general_info,_From,State=#state{file=File}) -> ets:insert(cdv_reg_proc_table, {cdv_dump_node_name,GenInfo#general_info.node_name}), {reply,{ok,GenInfo,TW},State#state{wordsize=WS, num_atoms=NumAtoms}}; -handle_call({expand_binary,{Offset,Size,Pos}},_From,State=#state{file=File}) -> +handle_call({expand_binary,{Offset,Size,Pos}},_From, + #state{file=File,dump_vsn=DumpVsn}=State) -> Fd = open(File), pos_bof(Fd,Pos), - {Bin,_Line} = get_binary(Offset,Size,bytes(Fd)), + DecodeOpts = get_decode_opts(DumpVsn), + {Bin,_Line} = get_binary(Offset,Size,bytes(Fd),DecodeOpts), close(Fd), {reply,{ok,Bin},State}; handle_call(procs_summary,_From,State=#state{file=File,wordsize=WS}) -> @@ -418,9 +448,11 @@ handle_call(loaded_mods,_From,State=#state{file=File}) -> TW = truncated_warning([?mod]), {_CC,_OC,Mods} = loaded_mods(File), {reply,{ok,Mods,TW},State}; -handle_call({loaded_mod_details,Mod},_From,State=#state{file=File}) -> +handle_call({loaded_mod_details,Mod},_From, + #state{dump_vsn=DumpVsn,file=File}=State) -> TW = truncated_warning([{?mod,Mod}]), - ModInfo = get_loaded_mod_details(File,Mod), + DecodeOpts = get_decode_opts(DumpVsn), + ModInfo = get_loaded_mod_details(File,Mod,DecodeOpts), {reply,{ok,ModInfo,TW},State}; handle_call(funs,_From,State=#state{file=File}) -> TW = truncated_warning([?fu]), @@ -454,8 +486,9 @@ handle_call(index_tables,_From,State=#state{file=File}) -> handle_call(schedulers,_From,State=#state{file=File}) -> Schedulers=schedulers(File), TW = truncated_warning([?scheduler]), - {reply,{ok,Schedulers,TW},State}. - + {reply,{ok,Schedulers,TW},State}; +handle_call(get_dump_versions,_From,State=#state{dump_vsn=DumpVsn}) -> + {reply,{ok,{?max_dump_version,DumpVsn}},State}. %%-------------------------------------------------------------------- @@ -780,11 +813,12 @@ parse_vsn_str(Str,WS) -> %%%----------------------------------------------------------------- -%%% Traverse crash dump and insert index in table for each heading -%%% -%%% Progress is reported during the time and MUST be checked with -%%% crashdump_viewer:get_progress/0 until it returns {ok,done}. +%%% Traverse crash dump and insert index in table for each heading. +%%% Progress is reported during the time. do_read_file(File) -> + erase(?literals), %Clear literal cache. + put(truncated,false), %Not truncated (yet). + erase(truncated_reason), %Not truncated (yet). case file:read_file_info(File) of {ok,#file_info{type=regular, access=FileA, @@ -796,17 +830,21 @@ do_read_file(File) -> {Tag,Id,Rest,N1} = tag(Fd,TagAndRest,1), case Tag of ?erl_crash_dump -> - reset_tables(), - insert_index(Tag,Id,N1+1), - put_last_tag(Tag,""), - DumpVsn = [list_to_integer(L) || - L<-string:tokens(Id,".")], - AddrAdj = get_bin_addr_adj(DumpVsn), - indexify(Fd,AddrAdj,Rest,N1), - end_progress(), - check_if_truncated(), - close(Fd), - {ok,DumpVsn}; + case check_dump_version(Id) of + {ok,DumpVsn} -> + reset_tables(), + insert_index(Tag,Id,N1+1), + put_last_tag(Tag,""), + DecodeOpts = get_decode_opts(DumpVsn), + indexify(Fd,DecodeOpts,Rest,N1), + end_progress(), + check_if_truncated(), + close(Fd), + {ok,DumpVsn}; + Error -> + close(Fd), + Error + end; _Other -> R = io_lib:format( "~ts is not an Erlang crash dump~n", @@ -834,7 +872,19 @@ do_read_file(File) -> {error,R} end. -indexify(Fd,AddrAdj,Bin,N) -> +check_dump_version(Vsn) -> + DumpVsn = [list_to_integer(L) || L<-string:lexemes(Vsn,".")], + if DumpVsn > ?max_dump_version -> + Info = + "This Crashdump Viewer is too old for the given " + "Erlang crash dump. Please use a newer version of " + "Crashdump Viewer.", + {error,Info}; + true -> + {ok,DumpVsn} + end. + +indexify(Fd,DecodeOpts,Bin,N) -> case binary:match(Bin,<<"\n=">>) of {Start,Len} -> Pos = Start+Len, @@ -847,7 +897,7 @@ indexify(Fd,AddrAdj,Bin,N) -> %% order to minimize lookup time. Key is the %% translated address. {HexAddr,_} = get_hex(Id), - Addr = HexAddr bor AddrAdj, + Addr = HexAddr bor DecodeOpts#dec_opts.bin_addr_adj, insert_binary_index(Addr,NewPos); _ -> insert_index(Tag,Id,NewPos) @@ -856,9 +906,22 @@ indexify(Fd,AddrAdj,Bin,N) -> {?proc_heap,LastId} -> [{_,LastPos}] = lookup_index(?proc_heap,LastId), ets:insert(cdv_heap_file_chars,{LastId,N+Start+1-LastPos}); + {?literals,[]} -> + case get(truncated_reason) of + undefined -> + [{_,LastPos}] = lookup_index(?literals,[]), + ets:insert(cdv_heap_file_chars, + {literals,N+Start+1-LastPos}); + _ -> + %% Literals are truncated. Make sure we never + %% attempt to read in the literals. (Heaps that + %% references literals will show markers for + %% incomplete heaps, but will otherwise work.) + delete_index(?literals, []) + end; _ -> ok end, - indexify(Fd,AddrAdj,Rest,N1); + indexify(Fd,DecodeOpts,Rest,N1); nomatch -> case progress_read(Fd) of {ok,Chunk0} when is_binary(Chunk0) -> @@ -869,7 +932,7 @@ indexify(Fd,AddrAdj,Bin,N) -> _ -> {Chunk0,N+byte_size(Bin)} end, - indexify(Fd,AddrAdj,Chunk,N1); + indexify(Fd,DecodeOpts,Chunk,N1); eof -> eof end @@ -908,6 +971,7 @@ check_if_truncated() -> find_truncated_proc({Tag,_Id}) when Tag==?atoms; Tag==?binary; Tag==?instr_data; + Tag==?literals; Tag==?memory_status; Tag==?memory_map -> put(truncated_proc,false); @@ -1065,7 +1129,7 @@ get_proc_details(File,Pid,WS,DumpVsn) -> {{Stack,MsgQ,Dict},TW} = case truncated_warning([{?proc,Pid}]) of [] -> - {expand_memory(Fd,Pid,DumpVsn),[]}; + expand_memory(Fd,Pid,DumpVsn); TW0 -> {{[],[],[]},TW0} end, @@ -1293,12 +1357,12 @@ parse_monitor("{"++Str) -> %% Named process {Name,Node,Rest1} = parse_name_node(Str,[]), Pid = get_pid_from_name(Name,Node), - case parse_link(string:strip(Rest1,left,$,),[]) of + case parse_link(string:trim(Rest1,leading,","),[]) of {Ref,"}"++Rest2} -> %% Bug in break.c - prints an extra "}" for remote %% nodes... thus the strip {{Pid,"{"++Name++","++Node++"} ("++Ref++")"}, - string:strip(Rest2,left,$})}; + string:trim(Rest2,leading,"}")}; {Ref,[]} -> {{Pid,"{"++Name++","++Node++"} ("++Ref++")"},[]} end; @@ -1384,50 +1448,85 @@ maybe_other_node2(Channel) -> expand_memory(Fd,Pid,DumpVsn) -> - BinAddrAdj = get_bin_addr_adj(DumpVsn), + DecodeOpts = get_decode_opts(DumpVsn), put(fd,Fd), - Dict = read_heap(Fd,Pid,BinAddrAdj,gb_trees:empty()), - Expanded = {read_stack_dump(Fd,Pid,BinAddrAdj,Dict), - read_messages(Fd,Pid,BinAddrAdj,Dict), - read_dictionary(Fd,Pid,BinAddrAdj,Dict)}, + Dict0 = case get(?literals) of + undefined -> + Literals = read_literals(Fd,DecodeOpts), + put(?literals,Literals), + put(fd,Fd), + Literals; + Literals -> + Literals + end, + Dict = read_heap(Fd,Pid,DecodeOpts,Dict0), + Expanded = {read_stack_dump(Fd,Pid,DecodeOpts,Dict), + read_messages(Fd,Pid,DecodeOpts,Dict), + read_dictionary(Fd,Pid,DecodeOpts,Dict)}, erase(fd), - Expanded. - -%%%----------------------------------------------------------------- -%%% This is a workaround for a bug in dump versions prior to 0.3: -%%% Addresses were truncated to 32 bits. This could cause binaries to -%%% get the same address as heap terms in the dump. To work around it -%%% we always store binaries on very high addresses in the gb_tree. -get_bin_addr_adj(DumpVsn) when DumpVsn < [0,3] -> - 16#f bsl 64; -get_bin_addr_adj(_) -> - 0. + IncompleteWarning = + case erase(incomplete_heap) of + undefined -> + []; + true -> + ["WARNING: This process has an incomplete heap. " + "Some information might be missing."] + end, + {Expanded,IncompleteWarning}. + +read_literals(Fd,DecodeOpts) -> + case lookup_index(?literals,[]) of + [{_,Start}] -> + [{_,Chars}] = ets:lookup(cdv_heap_file_chars,literals), + init_progress("Reading literals",Chars), + pos_bof(Fd,Start), + read_heap(DecodeOpts,gb_trees:empty()); + [] -> + gb_trees:empty() + end. + +get_decode_opts(DumpVsn) -> + BinAddrAdj = if + DumpVsn < [0,3] -> + %% This is a workaround for a bug in dump + %% versions prior to 0.3: Addresses were + %% truncated to 32 bits. This could cause + %% binaries to get the same address as heap + %% terms in the dump. To work around it we + %% always store binaries on very high + %% addresses in the gb_tree. + 16#f bsl 64; + true -> + 0 + end, + Base64 = DumpVsn >= [0,5], + #dec_opts{bin_addr_adj=BinAddrAdj,base64=Base64}. %%% %%% Read top level section. %%% -read_stack_dump(Fd,Pid,BinAddrAdj,Dict) -> +read_stack_dump(Fd,Pid,DecodeOpts,Dict) -> case lookup_index(?proc_stack,Pid) of [{_,Start}] -> pos_bof(Fd,Start), - read_stack_dump1(Fd,BinAddrAdj,Dict,[]); + read_stack_dump1(Fd,DecodeOpts,Dict,[]); [] -> [] end. -read_stack_dump1(Fd,BinAddrAdj,Dict,Acc) -> +read_stack_dump1(Fd,DecodeOpts,Dict,Acc) -> %% This function is never called if the dump is truncated in {?proc_heap,Pid} case bytes(Fd) of "=" ++ _next_tag -> lists:reverse(Acc); Line -> - Stack = parse_top(Line,BinAddrAdj,Dict), - read_stack_dump1(Fd,BinAddrAdj,Dict,[Stack|Acc]) + Stack = parse_top(Line,DecodeOpts,Dict), + read_stack_dump1(Fd,DecodeOpts,Dict,[Stack|Acc]) end. -parse_top(Line0, BinAddrAdj, D) -> +parse_top(Line0, DecodeOpts, D) -> {Label,Line1} = get_label(Line0), - {Term,Line,D} = parse_term(Line1, BinAddrAdj, D), + {Term,Line,D} = parse_term(Line1, DecodeOpts, D), [] = skip_blanks(Line), {Label,Term}. @@ -1435,27 +1534,27 @@ parse_top(Line0, BinAddrAdj, D) -> %%% Read message queue. %%% -read_messages(Fd,Pid,BinAddrAdj,Dict) -> +read_messages(Fd,Pid,DecodeOpts,Dict) -> case lookup_index(?proc_messages,Pid) of [{_,Start}] -> pos_bof(Fd,Start), - read_messages1(Fd,BinAddrAdj,Dict,[]); + read_messages1(Fd,DecodeOpts,Dict,[]); [] -> [] end. -read_messages1(Fd,BinAddrAdj,Dict,Acc) -> +read_messages1(Fd,DecodeOpts,Dict,Acc) -> %% This function is never called if the dump is truncated in {?proc_heap,Pid} case bytes(Fd) of "=" ++ _next_tag -> lists:reverse(Acc); Line -> - Msg = parse_message(Line,BinAddrAdj,Dict), - read_messages1(Fd,BinAddrAdj,Dict,[Msg|Acc]) + Msg = parse_message(Line,DecodeOpts,Dict), + read_messages1(Fd,DecodeOpts,Dict,[Msg|Acc]) end. -parse_message(Line0, BinAddrAdj, D) -> - {Msg,":"++Line1,_} = parse_term(Line0, BinAddrAdj, D), - {Token,Line,_} = parse_term(Line1, BinAddrAdj, D), +parse_message(Line0, DecodeOpts, D) -> + {Msg,":"++Line1,_} = parse_term(Line0, DecodeOpts, D), + {Token,Line,_} = parse_term(Line1, DecodeOpts, D), [] = skip_blanks(Line), {Msg,Token}. @@ -1463,26 +1562,26 @@ parse_message(Line0, BinAddrAdj, D) -> %%% Read process dictionary %%% -read_dictionary(Fd,Pid,BinAddrAdj,Dict) -> +read_dictionary(Fd,Pid,DecodeOpts,Dict) -> case lookup_index(?proc_dictionary,Pid) of [{_,Start}] -> pos_bof(Fd,Start), - read_dictionary1(Fd,BinAddrAdj,Dict,[]); + read_dictionary1(Fd,DecodeOpts,Dict,[]); [] -> [] end. -read_dictionary1(Fd,BinAddrAdj,Dict,Acc) -> +read_dictionary1(Fd,DecodeOpts,Dict,Acc) -> %% This function is never called if the dump is truncated in {?proc_heap,Pid} case bytes(Fd) of "=" ++ _next_tag -> lists:reverse(Acc); Line -> - Msg = parse_dictionary(Line,BinAddrAdj,Dict), - read_dictionary1(Fd,BinAddrAdj,Dict,[Msg|Acc]) + Msg = parse_dictionary(Line,DecodeOpts,Dict), + read_dictionary1(Fd,DecodeOpts,Dict,[Msg|Acc]) end. -parse_dictionary(Line0, BinAddrAdj, D) -> - {Entry,Line,_} = parse_term(Line0, BinAddrAdj, D), +parse_dictionary(Line0, DecodeOpts, D) -> + {Entry,Line,_} = parse_term(Line0, DecodeOpts, D), [] = skip_blanks(Line), Entry. @@ -1490,18 +1589,18 @@ parse_dictionary(Line0, BinAddrAdj, D) -> %%% Read heap data. %%% -read_heap(Fd,Pid,BinAddrAdj,Dict0) -> +read_heap(Fd,Pid,DecodeOpts,Dict0) -> case lookup_index(?proc_heap,Pid) of [{_,Pos}] -> [{_,Chars}] = ets:lookup(cdv_heap_file_chars,Pid), init_progress("Reading process heap",Chars), pos_bof(Fd,Pos), - read_heap(BinAddrAdj,Dict0); + read_heap(DecodeOpts,Dict0); [] -> Dict0 end. -read_heap(BinAddrAdj,Dict0) -> +read_heap(DecodeOpts,Dict0) -> %% This function is never called if the dump is truncated in {?proc_heap,Pid} case get(fd) of end_of_heap -> @@ -1515,14 +1614,14 @@ read_heap(BinAddrAdj,Dict0) -> Dict0; Line -> update_progress(length(Line)+1), - Dict = parse(Line,BinAddrAdj,Dict0), - read_heap(BinAddrAdj,Dict) + Dict = parse(Line,DecodeOpts,Dict0), + read_heap(DecodeOpts,Dict) end end. -parse(Line0, BinAddrAdj, Dict0) -> +parse(Line0, DecodeOpts, Dict0) -> {Addr,":"++Line1} = get_hex(Line0), - {_Term,Line,Dict} = parse_heap_term(Line1, Addr, BinAddrAdj, Dict0), + {_Term,Line,Dict} = parse_heap_term(Line1, Addr, DecodeOpts, Dict0), [] = skip_blanks(Line), Dict. @@ -1550,7 +1649,7 @@ get_ports(File) -> %% Converting port string to tuple to secure correct sorting. This is %% converted back in cdv_port_cb:format/1. port_to_tuple("#Port<"++Port) -> - [I1,I2] = string:tokens(Port,".>"), + [I1,I2] = string:lexemes(Port,".>"), {list_to_integer(I1),list_to_integer(I2)}. get_portinfo(Fd,Port) -> @@ -1573,9 +1672,9 @@ get_portinfo(Fd,Port) -> "Registered as" -> get_portinfo(Fd,Port#port{name=string(Fd)}); "Monitors" -> - Monitors0 = string:tokens(bytes(Fd),"()"), + Monitors0 = string:lexemes(bytes(Fd),"()"), Monitors = [begin - [Pid,Ref] = string:tokens(Mon,","), + [Pid,Ref] = string:lexemes(Mon,","), {Pid,Pid++" ("++Ref++")"} end || Mon <- Monitors0], get_portinfo(Fd,Port#port{monitors=Monitors}); @@ -1636,7 +1735,7 @@ get_etsinfo(Fd,EtsTable = #ets_table{details=Ds},WS) -> "Buckets" -> %% A bug in erl_db_hash.c prints a space after the buckets %% - need to strip the string to make list_to_integer/1 happy. - Buckets = list_to_integer(string:strip(bytes(Fd))), + Buckets = list_to_integer(string:trim(bytes(Fd),both,"\s")), get_etsinfo(Fd,EtsTable#ets_table{buckets=Buckets},WS); "Objects" -> get_etsinfo(Fd,EtsTable#ets_table{size=list_to_integer(bytes(Fd))},WS); @@ -1654,7 +1753,9 @@ get_etsinfo(Fd,EtsTable = #ets_table{details=Ds},WS) -> Val = bytes(Fd), get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{chain_min=>Val}},WS); "Chain Length Avg" -> - Val = try list_to_float(string:strip(bytes(Fd))) catch _:_ -> "-" end, + Val = try list_to_float(string:trim(bytes(Fd),both,"\s")) + catch _:_ -> "-" + end, get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{chain_avg=>Val}},WS); "Chain Length Max" -> Val = bytes(Fd), @@ -1811,7 +1912,7 @@ get_nodeinfo(Fd,Nod) -> Creations = lists:flatmap(fun(C) -> try [list_to_integer(C)] catch error:badarg -> [] end - end, string:tokens(bytes(Fd)," ")), + end, string:lexemes(bytes(Fd)," ")), get_nodeinfo(Fd,Nod#nod{creation={creations,Creations}}); "Remote link" -> Procs = bytes(Fd), % e.g. "<0.31.0> <4322.54.0>" @@ -1842,12 +1943,15 @@ get_nodeinfo(Fd,Nod) -> %%----------------------------------------------------------------- %% Page with details about one loaded modules -get_loaded_mod_details(File,Mod) -> +get_loaded_mod_details(File,Mod,DecodeOpts) -> [{_,Start}] = lookup_index(?mod,Mod), Fd = open(File), pos_bof(Fd,Start), InitLM = #loaded_mod{mod=Mod,old_size="No old code exists"}, - ModInfo = get_loaded_mod_info(Fd,InitLM,fun all_modinfo/3), + Fun = fun(F, LM, LineHead) -> + all_modinfo(F, LM, LineHead, DecodeOpts) + end, + ModInfo = get_loaded_mod_info(Fd,InitLM,Fun), close(Fd), ModInfo. @@ -1905,59 +2009,44 @@ get_loaded_mod_info(Fd,LM,Fun) -> main_modinfo(_Fd,LM,_LineHead) -> LM. -all_modinfo(Fd,LM,LineHead) -> +all_modinfo(Fd,LM,LineHead,DecodeOpts) -> case LineHead of "Current attributes" -> - Str = hex_to_str(bytes(Fd,"")), + Str = get_attribute(Fd, DecodeOpts), LM#loaded_mod{current_attrib=Str}; "Current compilation info" -> - Str = hex_to_str(bytes(Fd,"")), + Str = get_attribute(Fd, DecodeOpts), LM#loaded_mod{current_comp_info=Str}; "Old attributes" -> - Str = hex_to_str(bytes(Fd,"")), + Str = get_attribute(Fd, DecodeOpts), LM#loaded_mod{old_attrib=Str}; "Old compilation info" -> - Str = hex_to_str(bytes(Fd,"")), + Str = get_attribute(Fd, DecodeOpts), LM#loaded_mod{old_comp_info=Str}; Other -> unexpected(Fd,Other,"loaded modules info"), LM end. - -hex_to_str(Hex) -> - Term = hex_to_term(Hex,[]), - io_lib:format("~tp~n",[Term]). - -hex_to_term([X,Y|Hex],Acc) -> - MS = hex_to_dec([X]), - LS = hex_to_dec([Y]), - Z = 16*MS+LS, - hex_to_term(Hex,[Z|Acc]); -hex_to_term([],Acc) -> - Bin = list_to_binary(lists:reverse(Acc)), - case catch binary_to_term(Bin) of - {'EXIT',_Reason} -> - {"WARNING: The term is probably truncated!", - "I can not do binary_to_term.", - Bin}; - Term -> - Term - end; -hex_to_term(Rest,Acc) -> - {"WARNING: The term is probably truncated!", - "I can not convert hex to term.", - Rest,list_to_binary(lists:reverse(Acc))}. - - -hex_to_dec("F") -> 15; -hex_to_dec("E") -> 14; -hex_to_dec("D") -> 13; -hex_to_dec("C") -> 12; -hex_to_dec("B") -> 11; -hex_to_dec("A") -> 10; -hex_to_dec(N) -> list_to_integer(N). - +get_attribute(Fd, DecodeOpts) -> + Bytes = bytes(Fd, ""), + try get_binary(Bytes, DecodeOpts) of + {Bin,_} -> + try binary_to_term(Bin) of + Term -> + io_lib:format("~tp~n",[Term]) + catch + _:_ -> + {"WARNING: The term is probably truncated!", + "I cannot do binary_to_term/1.", + Bin} + end + catch + _:_ -> + {"WARNING: The term is probably truncated!", + "I cannot convert to binary.", + Bytes} + end. %%----------------------------------------------------------------- %% Page with list of all funs @@ -2257,7 +2346,7 @@ get_size_value(Key,Data) -> %% and Value is the sum over all allocator instances of each type. sort_allocator_types([{Name,Data}|Allocators],Acc,DoTotal) -> Type = - case string:tokens(Name,"[]") of + case string:lexemes(Name,"[]") of [T,_Id] -> T; [Name] -> Name; Other -> Other @@ -2514,99 +2603,134 @@ get_limited_stack(Fd, N, Ds) -> %%%----------------------------------------------------------------- %%% Parse memory in crashdump version 0.1 and newer %%% -parse_heap_term([$l|Line0], Addr, BinAddrAdj, D0) -> %Cons cell. - {H,"|"++Line1,D1} = parse_term(Line0, BinAddrAdj, D0), - {T,Line,D2} = parse_term(Line1, BinAddrAdj, D1), +parse_heap_term([$l|Line0], Addr, DecodeOpts, D0) -> %Cons cell. + {H,"|"++Line1,D1} = parse_term(Line0, DecodeOpts, D0), + {T,Line,D2} = parse_term(Line1, DecodeOpts, D1), Term = [H|T], D = gb_trees:insert(Addr, Term, D2), {Term,Line,D}; -parse_heap_term([$t|Line0], Addr, BinAddrAdj, D) -> %Tuple +parse_heap_term([$t|Line0], Addr, DecodeOpts, D) -> %Tuple {N,":"++Line} = get_hex(Line0), - parse_tuple(N, Line, Addr, BinAddrAdj, D, []); -parse_heap_term([$F|Line0], Addr, _BinAddrAdj, D0) -> %Float + parse_tuple(N, Line, Addr, DecodeOpts, D, []); +parse_heap_term([$F|Line0], Addr, _DecodeOpts, D0) -> %Float {N,":"++Line1} = get_hex(Line0), {Chars,Line} = get_chars(N, Line1), Term = list_to_float(Chars), D = gb_trees:insert(Addr, Term, D0), {Term,Line,D}; -parse_heap_term("B16#"++Line0, Addr, _BinAddrAdj, D0) -> %Positive big number. +parse_heap_term("B16#"++Line0, Addr, _DecodeOpts, D0) -> %Positive big number. {Term,Line} = get_hex(Line0), D = gb_trees:insert(Addr, Term, D0), {Term,Line,D}; -parse_heap_term("B-16#"++Line0, Addr, _BinAddrAdj, D0) -> %Negative big number +parse_heap_term("B-16#"++Line0, Addr, _DecodeOpts, D0) -> %Negative big number {Term0,Line} = get_hex(Line0), Term = -Term0, D = gb_trees:insert(Addr, Term, D0), {Term,Line,D}; -parse_heap_term("B"++Line0, Addr, _BinAddrAdj, D0) -> %Decimal big num +parse_heap_term("B"++Line0, Addr, _DecodeOpts, D0) -> %Decimal big num case string:to_integer(Line0) of {Int,Line} when is_integer(Int) -> D = gb_trees:insert(Addr, Int, D0), {Int,Line,D} end; -parse_heap_term([$P|Line0], Addr, _BinAddrAdj, D0) -> % External Pid. +parse_heap_term([$P|Line0], Addr, _DecodeOpts, D0) -> % External Pid. {Pid0,Line} = get_id(Line0), Pid = ['#CDVPid'|Pid0], D = gb_trees:insert(Addr, Pid, D0), {Pid,Line,D}; -parse_heap_term([$p|Line0], Addr, _BinAddrAdj, D0) -> % External Port. +parse_heap_term([$p|Line0], Addr, _DecodeOpts, D0) -> % External Port. {Port0,Line} = get_id(Line0), Port = ['#CDVPort'|Port0], D = gb_trees:insert(Addr, Port, D0), {Port,Line,D}; -parse_heap_term("E"++Line0, Addr, _BinAddrAdj, D0) -> %Term encoded in external format. - {Bin,Line} = get_binary(Line0), +parse_heap_term("E"++Line0, Addr, DecodeOpts, D0) -> %Term encoded in external format. + {Bin,Line} = get_binary(Line0, DecodeOpts), Term = binary_to_term(Bin), D = gb_trees:insert(Addr, Term, D0), {Term,Line,D}; -parse_heap_term("Yh"++Line0, Addr, _BinAddrAdj, D0) -> %Heap binary. - {Term,Line} = get_binary(Line0), +parse_heap_term("Yh"++Line0, Addr, DecodeOpts, D0) -> %Heap binary. + {Term,Line} = get_binary(Line0, DecodeOpts), D = gb_trees:insert(Addr, Term, D0), {Term,Line,D}; -parse_heap_term("Yc"++Line0, Addr, BinAddrAdj, D0) -> %Reference-counted binary. +parse_heap_term("Yc"++Line0, Addr, DecodeOpts, D0) -> %Reference-counted binary. {Binp0,":"++Line1} = get_hex(Line0), {Offset,":"++Line2} = get_hex(Line1), {Sz,Line} = get_hex(Line2), - Binp = Binp0 bor BinAddrAdj, - Term = case lookup_binary_index(Binp) of - [{_,Start}] -> cdvbin(Offset,Sz,{'#CDVBin',Start}); - [] -> '#CDVNonexistingBinary' - end, - D = gb_trees:insert(Addr, Term, D0), - {Term,Line,D}; -parse_heap_term("Ys"++Line0, Addr, BinAddrAdj, D0) -> %Sub binary. + Binp = Binp0 bor DecodeOpts#dec_opts.bin_addr_adj, + case lookup_binary_index(Binp) of + [{_,Start}] -> + SymbolicBin = {'#CDVBin',Start}, + Term = cdvbin(Offset, Sz, SymbolicBin), + D1 = gb_trees:insert(Addr, Term, D0), + D = gb_trees:insert(Binp, SymbolicBin, D1), + {Term,Line,D}; + [] -> + Term = '#CDVNonexistingBinary', + D1 = gb_trees:insert(Addr, Term, D0), + D = gb_trees:insert(Binp, Term, D1), + {Term,Line,D} + end; +parse_heap_term("Ys"++Line0, Addr, DecodeOpts, D0) -> %Sub binary. {Binp0,":"++Line1} = get_hex(Line0), {Offset,":"++Line2} = get_hex(Line1), - {Sz,Line} = get_hex(Line2), - Binp = Binp0 bor BinAddrAdj, - Term = case lookup_binary_index(Binp) of - [{_,Start}] -> cdvbin(Offset,Sz,{'#CDVBin',Start}); - [] -> - %% Might it be on the heap? - case gb_trees:lookup(Binp, D0) of - {value,Bin} -> cdvbin(Offset,Sz,Bin); - none -> '#CDVNonexistingBinary' - end - end, - D = gb_trees:insert(Addr, Term, D0), - {Term,Line,D}. - + {Sz,Line3} = get_hex(Line2), + {Term,Line,D1} = deref_bin(Binp0, Offset, Sz, Line3, DecodeOpts, D0), + D = gb_trees:insert(Addr, Term, D1), + {Term,Line,D}; +parse_heap_term("Mf"++Line0, Addr, DecodeOpts, D0) -> %Flatmap. + {Size,":"++Line1} = get_hex(Line0), + {Keys,":"++Line2,D1} = parse_term(Line1, DecodeOpts, D0), + {Values,Line,D2} = parse_tuple(Size, Line2, Addr,DecodeOpts, D1, []), + Pairs = zip_tuples(tuple_size(Keys), Keys, Values, []), + Map = maps:from_list(Pairs), + D = gb_trees:update(Addr, Map, D2), + {Map,Line,D}; +parse_heap_term("Mh"++Line0, Addr, DecodeOpts, D0) -> %Head node in a hashmap. + {MapSize,":"++Line1} = get_hex(Line0), + {N,":"++Line2} = get_hex(Line1), + {Nodes,Line,D1} = parse_tuple(N, Line2, Addr, DecodeOpts, D0, []), + Map = maps:from_list(flatten_hashmap_nodes(Nodes)), + MapSize = maps:size(Map), %Assertion. + D = gb_trees:update(Addr, Map, D1), + {Map,Line,D}; +parse_heap_term("Mn"++Line0, Addr, DecodeOpts, D) -> %Interior node in a hashmap. + {N,":"++Line} = get_hex(Line0), + parse_tuple(N, Line, Addr, DecodeOpts, D, []). parse_tuple(0, Line, Addr, _, D0, Acc) -> Tuple = list_to_tuple(lists:reverse(Acc)), D = gb_trees:insert(Addr, Tuple, D0), {Tuple,Line,D}; -parse_tuple(N, Line0, Addr, BinAddrAdj, D0, Acc) -> - case parse_term(Line0, BinAddrAdj, D0) of +parse_tuple(N, Line0, Addr, DecodeOpts, D0, Acc) -> + case parse_term(Line0, DecodeOpts, D0) of {Term,[$,|Line],D} when N > 1 -> - parse_tuple(N-1, Line, Addr, BinAddrAdj, D, [Term|Acc]); + parse_tuple(N-1, Line, Addr, DecodeOpts, D, [Term|Acc]); {Term,Line,D}-> - parse_tuple(N-1, Line, Addr, BinAddrAdj, D, [Term|Acc]) + parse_tuple(N-1, Line, Addr, DecodeOpts, D, [Term|Acc]) end. -parse_term([$H|Line0], BinAddrAdj, D) -> %Pointer to heap term. +zip_tuples(0, _T1, _T2, Acc) -> + Acc; +zip_tuples(N, T1, T2, Acc) when N =< tuple_size(T1) -> + zip_tuples(N-1, T1, T2, [{element(N, T1),element(N, T2)}|Acc]). + +flatten_hashmap_nodes(Tuple) -> + flatten_hashmap_nodes_1(tuple_size(Tuple), Tuple, []). + +flatten_hashmap_nodes_1(0, _Tuple, Acc) -> + Acc; +flatten_hashmap_nodes_1(N, Tuple0, Acc0) -> + case element(N, Tuple0) of + [K|V] -> + flatten_hashmap_nodes_1(N-1, Tuple0, [{K,V}|Acc0]); + Tuple when is_tuple(Tuple) -> + Acc = flatten_hashmap_nodes_1(N-1, Tuple0, Acc0), + flatten_hashmap_nodes_1(tuple_size(Tuple), Tuple, Acc) + end. + +parse_term([$H|Line0], DecodeOpts, D) -> %Pointer to heap term. {Ptr,Line} = get_hex(Line0), - deref_ptr(Ptr, Line, BinAddrAdj, D); + deref_ptr(Ptr, Line, DecodeOpts, D); parse_term([$N|Line], _, D) -> %[] (nil). {[],Line,D}; parse_term([$I|Line0], _, D) -> %Small. @@ -2623,11 +2747,11 @@ parse_term([$p|Line0], _, D) -> %Port. parse_term([$S|Str0], _, D) -> %Information string. Str = lists:reverse(skip_blanks(lists:reverse(Str0))), {Str,[],D}; -parse_term([$D|Line0], _, D) -> %DistExternal +parse_term([$D|Line0], DecodeOpts, D) -> %DistExternal try {AttabSize,":"++Line1} = get_hex(Line0), {Attab, "E"++Line2} = parse_atom_translation_table(AttabSize, Line1, []), - {Bin,Line3} = get_binary(Line2), + {Bin,Line3} = get_binary(Line2, DecodeOpts), {try erts_debug:dist_ext_to_term(Attab, Bin) catch @@ -2660,26 +2784,55 @@ parse_atom_translation_table(0, Line0, As) -> parse_atom_translation_table(N, Line0, As) -> {A, Line1, _} = parse_atom(Line0, []), parse_atom_translation_table(N-1, Line1, [A|As]). - - -deref_ptr(Ptr, Line, BinAddrAdj, D0) -> - case gb_trees:lookup(Ptr, D0) of + +deref_ptr(Ptr, Line, DecodeOpts, D) -> + Lookup = fun(D0) -> + gb_trees:lookup(Ptr, D0) + end, + do_deref_ptr(Lookup, Line, DecodeOpts, D). + +deref_bin(Binp0, Offset, Sz, Line, DecodeOpts, D) -> + Binp = Binp0 bor DecodeOpts#dec_opts.bin_addr_adj, + Lookup = fun(D0) -> + lookup_binary(Binp, Offset, Sz, D0) + end, + do_deref_ptr(Lookup, Line, DecodeOpts, D). + +lookup_binary(Binp, Offset, Sz, D) -> + case lookup_binary_index(Binp) of + [{_,Start}] -> + Term = cdvbin(Offset, Sz, {'#CDVBin',Start}), + {value,Term}; + [] -> + case gb_trees:lookup(Binp, D) of + {value,<<_:Offset/bytes,Sub:Sz/bytes,_/bytes>>} -> + {value,Sub}; + {value,SymbolicBin} -> + {value,cdvbin(Offset, Sz, SymbolicBin)}; + none -> + none + end + end. + +do_deref_ptr(Lookup, Line, DecodeOpts, D0) -> + case Lookup(D0) of {value,Term} -> {Term,Line,D0}; none -> case get(fd) of end_of_heap -> + put(incomplete_heap,true), {['#CDVIncompleteHeap'],Line,D0}; Fd -> case bytes(Fd) of "="++_ -> put(fd, end_of_heap), - deref_ptr(Ptr, Line, BinAddrAdj, D0); + do_deref_ptr(Lookup, Line, DecodeOpts, D0); L -> update_progress(length(L)+1), - D = parse(L, BinAddrAdj, D0), - deref_ptr(Ptr, Line, BinAddrAdj, D) + D = parse(L, DecodeOpts, D0), + do_deref_ptr(Lookup, Line, DecodeOpts, D) end end end. @@ -2742,36 +2895,80 @@ get_label([$:|Line], Acc) -> get_label([H|T], Acc) -> get_label(T, [H|Acc]). -get_binary(Line0) -> +get_binary(Line0,DecodeOpts) -> case get_hex(Line0) of {N,":"++Line} -> - do_get_binary(N, Line, [], false); + get_binary_1(N, Line, DecodeOpts); _ -> {'#CDVTruncatedBinary',[]} end. -get_binary(Offset,Size,Line0) -> +get_binary_1(N,Line,#dec_opts{base64=false}) -> + get_binary_hex(N, Line, [], false); +get_binary_1(N,Line0,#dec_opts{base64=true}) -> + NumBytes = ((N+2) div 3) * 4, + {Base64,Line} = lists:split(NumBytes, Line0), + Bin = get_binary_base64(list_to_binary(Base64), <<>>, false), + {Bin,Line}. + +get_binary(Offset,Size,Line0,DecodeOpts) -> case get_hex(Line0) of {_N,":"++Line} -> - Progress = Size>?binary_size_progress_limit, - Progress andalso init_progress("Reading binary",Size), - do_get_binary(Size, lists:sublist(Line,(Offset*2)+1,Size*2), [], - Progress); - _ -> - {'#CDVTruncatedBinary',[]} - end. - -do_get_binary(0, Line, Acc, Progress) -> + get_binary_1(Offset,Size,Line,DecodeOpts); + _ -> + {'#CDVTruncatedBinary',[]} + end. + +get_binary_1(Offset,Size,Line,#dec_opts{base64=false}) -> + Progress = Size > ?binary_size_progress_limit, + Progress andalso init_progress("Reading binary",Size), + get_binary_hex(Size, lists:sublist(Line,(Offset*2)+1,Size*2), [], + Progress); +get_binary_1(StartOffset,Size,Line,#dec_opts{base64=true}) -> + Progress = Size > ?binary_size_progress_limit, + Progress andalso init_progress("Reading binary",Size), + EndOffset = StartOffset + Size, + StartByte = (StartOffset div 3) * 4, + EndByte = ((EndOffset + 2) div 3) * 4, + NumBytes = EndByte - StartByte, + case list_to_binary(Line) of + <<_:StartByte/bytes,Base64:NumBytes/bytes,_/bytes>> -> + Bin0 = get_binary_base64(Base64, <<>>, Progress), + Skip = StartOffset - (StartOffset div 3) * 3, + <<_:Skip/bytes,Bin:Size/bytes,_/bytes>> = Bin0, + {Bin,[]}; + _ -> + {'#CDVTruncatedBinary',[]} + end. + +get_binary_hex(0, Line, Acc, Progress) -> Progress andalso end_progress(), {list_to_binary(lists:reverse(Acc)),Line}; -do_get_binary(N, [A,B|Line], Acc, Progress) -> +get_binary_hex(N, [A,B|Line], Acc, Progress) -> Byte = (get_hex_digit(A) bsl 4) bor get_hex_digit(B), Progress andalso update_progress(), - do_get_binary(N-1, Line, [Byte|Acc], Progress); -do_get_binary(_N, [], _Acc, Progress) -> + get_binary_hex(N-1, Line, [Byte|Acc], Progress); +get_binary_hex(_N, [], _Acc, Progress) -> Progress andalso end_progress(), {'#CDVTruncatedBinary',[]}. +get_binary_base64(<<Chunk0:?base64_chunk_size/bytes,T/bytes>>, + Acc0, Progress) -> + Chunk = base64:decode(Chunk0), + Acc = <<Acc0/binary,Chunk/binary>>, + Progress andalso update_progress(?base64_chunk_size * 3 div 4), + get_binary_base64(T, Acc, Progress); +get_binary_base64(Chunk0, Acc, Progress) -> + case Progress of + true -> + update_progress(?base64_chunk_size * 3 div 4), + end_progress(); + false -> + ok + end, + Chunk = base64:decode(Chunk0), + <<Acc/binary,Chunk/binary>>. + cdvbin(Offset,Size,{'#CDVBin',Pos}) -> ['#CDVBin',Offset,Size,Pos]; cdvbin(Offset,Size,['#CDVBin',_,_,Pos]) -> @@ -2792,6 +2989,10 @@ reset_tables() -> insert_index(Tag,Id,Pos) -> ets:insert(cdv_dump_index_table,{{Tag,Pos},Id}). +delete_index(Tag,Id) -> + Ms = [{{{Tag,'$1'},Id},[],[true]}], + ets:select_delete(cdv_dump_index_table, Ms). + lookup_index({Tag,Id}) -> lookup_index(Tag,Id); lookup_index(Tag) -> @@ -2808,6 +3009,7 @@ insert_binary_index(Addr,Pos) -> lookup_binary_index(Addr) -> ets:lookup(cdv_binary_index_table,Addr). + %%----------------------------------------------------------------- %% Convert tags read from crashdump to atoms used as first part of key %% in cdv_dump_index_table @@ -2825,6 +3027,7 @@ tag_to_atom("hidden_node") -> ?hidden_node; tag_to_atom("index_table") -> ?index_table; tag_to_atom("instr_data") -> ?instr_data; tag_to_atom("internal_ets") -> ?internal_ets; +tag_to_atom("literals") -> ?literals; tag_to_atom("loaded_modules") -> ?loaded_modules; tag_to_atom("memory") -> ?memory; tag_to_atom("mod") -> ?mod; @@ -2848,8 +3051,10 @@ tag_to_atom(UnknownTag) -> %%%----------------------------------------------------------------- %%% Store last tag for use when truncated, and reason if aborted put_last_tag(?abort,Reason) -> - %% Don't overwrite the real last tag - put(truncated_reason,Reason); + %% Don't overwrite the real last tag, and make sure to return + %% the previous last tag. + put(truncated_reason,Reason), + get(last_tag); put_last_tag(Tag,Id) -> put(last_tag,{Tag,Id}). diff --git a/lib/observer/src/observer_html_lib.erl b/lib/observer/src/observer_html_lib.erl index a85808a472..8202f91030 100644 --- a/lib/observer/src/observer_html_lib.erl +++ b/lib/observer/src/observer_html_lib.erl @@ -278,24 +278,24 @@ href_proc_port("['#CDVPort'"++T,Acc,LTB) -> %% Port written by crashdump_viewer:parse_term(...) {Port0,Rest} = split($],T), PortStr= - case string:tokens(Port0,",.|") of + case string:lexemes(Port0,",.|") of [X,Y] -> Port = "#Port<"++X++"."++Y++">", href(Port,Port); Ns -> - "#Port<" ++ string:join(Ns,".") ++"...>" + "#Port<" ++ lists:join($.,Ns) ++"...>" end, href_proc_port(Rest,[PortStr|Acc],LTB); href_proc_port("['#CDVPid'"++T,Acc,LTB) -> %% Pid written by crashdump_viewer:parse_term(...) {Pid0,Rest} = split($],T), PidStr = - case string:tokens(Pid0,",.|") of + case string:lexemes(Pid0,",.|") of [X,Y,Z] -> Pid = "<"++X++"."++Y++"."++Z++">", href(Pid,Pid); Ns -> - "<" ++ string:join(Ns,".") ++ "...>" + "<" ++ lists:join($.,Ns) ++ "...>" end, href_proc_port(Rest,[PidStr|Acc],LTB); href_proc_port("'#CDVIncompleteHeap'"++T,Acc,LTB)-> @@ -332,7 +332,7 @@ href_proc_port([],Acc,_) -> href_proc_bin(From, T, Acc, LTB) -> {OffsetSizePos,Rest} = split($],T), BinStr = - case string:tokens(OffsetSizePos,",.| \n") of + case string:lexemes(OffsetSizePos,",.| \n") of [Offset,SizeStr,Pos] when From =:= cdv -> Size = list_to_integer(SizeStr), PreviewSize = min(Size,10), @@ -355,11 +355,11 @@ href_proc_bin(From, T, Acc, LTB) -> PreviewStr end end; - [PreviewIntStr,SizeStr,Md5] when From =:= obs -> + [PreviewIntStr,PreviewBitSizeStr,SizeStr,Md5] when From =:= obs -> Size = list_to_integer(SizeStr), PreviewInt = list_to_integer(PreviewIntStr), - PrevSize = (trunc(math:log2(PreviewInt)/8)+1)*8, - PreviewStr = preview_string(Size,<<PreviewInt:PrevSize>>), + PreviewBitSize = list_to_integer(PreviewBitSizeStr), + PreviewStr = preview_string(Size,<<PreviewInt:PreviewBitSize>>), if LTB -> href("TARGET=\"expanded\"", ["#OBSBinary?key1="++PreviewIntStr++ diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl index 29f4f9fabc..52e6c3e52a 100644 --- a/lib/observer/src/observer_lib.erl +++ b/lib/observer/src/observer_lib.erl @@ -478,7 +478,7 @@ create_box(Parent, Data) -> link_entry(Panel,Value); _ -> Value = to_str(Value0), - case string:sub_word(lists:sublist(Value, 80),1,$\n) of + case string:nth_lexeme(lists:sublist(Value, 80),1, [$\n]) of Value -> %% Short string, no newlines - show all wxStaticText:new(Panel, ?wxID_ANY, Value); @@ -810,7 +810,7 @@ progress_dialog_destroy({Dialog,_,_}) -> make_obsbin(Bin,Tab) -> Size = byte_size(Bin), - Preview = + {Preview,PreviewBitSize} = try %% The binary might be a unicode string, in which case we %% don't want to split it in the middle of a grapheme @@ -819,14 +819,14 @@ make_obsbin(Bin,Tab) -> PB1 = string:slice(Bin,0,PL1), PS1 = byte_size(PB1) * 8, <<P1:PS1>> = PB1, - P1 + {P1,PS1} catch _:_ -> %% Probably not a string, so just split anywhere PS2 = min(Size, 10) * 8, <<P2:PS2, _/binary>> = Bin, - P2 + {P2,PS2} end, Hash = erlang:phash2(Bin), Key = {Preview, Size, Hash}, ets:insert(Tab, {Key,Bin}), - ['#OBSBin',Preview,Size,Hash]. + ['#OBSBin',Preview,PreviewBitSize,Size,Hash]. diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl index fb02ae2728..4ce38e439d 100644 --- a/lib/observer/src/observer_procinfo.erl +++ b/lib/observer/src/observer_procinfo.erl @@ -454,7 +454,8 @@ local_pid_str(Pid) -> global_pid_node_pref(Pid) -> %% Global PID node prefix : X of <X.Y.Z> - string:strip(string:sub_word(pid_to_list(Pid),1,$.),left,$<). + [NodePrefix|_] = string:lexemes(pid_to_list(Pid),"<."), + NodePrefix. io_get_data(Pid) -> Pid ! {self(), get_data_and_close}, diff --git a/lib/observer/src/observer_trace_wx.erl b/lib/observer/src/observer_trace_wx.erl index 8127248262..2c3b46a3a1 100644 --- a/lib/observer/src/observer_trace_wx.erl +++ b/lib/observer/src/observer_trace_wx.erl @@ -1201,7 +1201,7 @@ make_ms(MS) -> make_ms(Name,Term,FunStr). make_ms(Name, Term, FunStr) -> - #match_spec{name=Name, term=Term, str=io_lib:format("~tw", Term), func = FunStr}. + #match_spec{name=Name, term=Term, str=io_lib:format("~tw", [Term]), func = FunStr}. parse_tp({tp, Mod, FAs}, State) -> Patterns = [#tpattern{m=Mod,fa={F,A}, ms=make_ms(List)} || diff --git a/lib/observer/src/observer_traceoptions_wx.erl b/lib/observer/src/observer_traceoptions_wx.erl index 4f46426cf6..fbcf6d7fe9 100644 --- a/lib/observer/src/observer_traceoptions_wx.erl +++ b/lib/observer/src/observer_traceoptions_wx.erl @@ -619,7 +619,7 @@ create_styled_txtctrl(Parent) -> keyWords() -> L = ["after","begin","case","try","cond","catch","andalso","orelse", - "end","fun","if","let","of","query","receive","when","bnot","not", + "end","fun","if","let","of","receive","when","bnot","not", "div","rem","band","and","bor","bxor","bsl","bsr","or","xor"], lists:flatten([K ++ " " || K <- L] ++ [0]). diff --git a/lib/observer/src/observer_wx.erl b/lib/observer/src/observer_wx.erl index be93b1d5f1..453e3bdc2d 100644 --- a/lib/observer/src/observer_wx.erl +++ b/lib/observer/src/observer_wx.erl @@ -732,7 +732,7 @@ get_nodes() -> {Nodes, lists:reverse(Menues)}. epmd_nodes(Names) -> - [_, Host] = string:tokens(atom_to_list(node()),"@"), + [_, Host] = string:lexemes(atom_to_list(node()),"@"), [list_to_atom(Name ++ [$@|Host]) || {Name, _} <- Names]. update_node_list(State = #state{menubar=MenuBar}) -> diff --git a/lib/observer/src/ttb.erl b/lib/observer/src/ttb.erl index 940fdc9818..29a572d7fe 100644 --- a/lib/observer/src/ttb.erl +++ b/lib/observer/src/ttb.erl @@ -100,7 +100,7 @@ do_tracer(Clients,PI,Traci) -> {ok, H} = inet:gethostname(), H; _ -> - [_,H] = string:tokens(atom_to_list(N),"@"), + [_,H] = string:lexemes(atom_to_list(N),"@"), H end, case catch dbg:tracer(N,port,dbg:trace_port(ip,IpPortSpec)) of @@ -976,7 +976,7 @@ decode_filename(3,Bin,latin1) -> File. host(Node) -> - [_name,Host] = string:tokens(atom_to_list(Node),"@"), + [_name,Host] = string:lexemes(atom_to_list(Node),"@"), Host. wait_for_fetch([]) -> @@ -1064,7 +1064,7 @@ collect_files(Dirs) -> lists:map(fun(Dir) -> MetaFiles = filelib:wildcard(filename:join(Dir,"*.ti")), lists:map(fun(M) -> - Sub = string:left(M,length(M)-3), + Sub = filename:rootname(M,".ti"), case filelib:is_file(Sub) of true -> Sub; false -> Sub++".*.wrp" diff --git a/lib/observer/test/crashdump_helper.erl b/lib/observer/test/crashdump_helper.erl index f37d9057cb..bb1755f530 100644 --- a/lib/observer/test/crashdump_helper.erl +++ b/lib/observer/test/crashdump_helper.erl @@ -19,7 +19,9 @@ %% -module(crashdump_helper). --export([n1_proc/2,remote_proc/2]). +-export([n1_proc/2,remote_proc/2, + dump_maps/0,create_maps/0, + create_binaries/0,create_sub_binaries/1]). -compile(r18). -include_lib("common_test/include/ct.hrl"). @@ -60,7 +62,9 @@ n1_proc(Creator,_N2,Pid2,Port2,_L) -> put(ref,Ref), put(pid,Pid), put(bin,Bin), + put(bins,create_binaries()), put(sub_bin,SubBin), + put(sub_bins,create_sub_binaries(get(bins))), put(bignum,83974938738373873), put(neg_bignum,-38748762783736367), put(ext_pid,Pid2), @@ -92,3 +96,49 @@ remote_proc(P1,Creator) -> Creator ! {self(),done}, receive after infinity -> ok end end). + +create_binaries() -> + Sizes = lists:seq(60, 70) ++ lists:seq(120, 140), + [begin + <<H:16/unit:8>> = erlang:md5(<<Size:32>>), + Data = ((H bsl (8*150)) div (H+7919)), + <<Data:Size/unit:8>> + end || Size <- Sizes]. + +create_sub_binaries(Bins) -> + [create_sub_binary(Bin, Start, LenSub) || + Bin <- Bins, + Start <- [0,1,2,3,4,5,10,22], + LenSub <- [0,1,2,3,4,6,9]]. + +create_sub_binary(Bin, Start, LenSub) -> + Len = byte_size(Bin) - LenSub - Start, + <<_:Start/bytes,Sub:Len/bytes,_/bytes>> = Bin, + Sub. + +%%% +%%% Test dumping of maps. Dumping of maps only from OTP 20.2. +%%% + +dump_maps() -> + Parent = self(), + F = fun() -> + register(aaaaaaaa_maps, self()), + put(maps, create_maps()), + Parent ! {self(),done}, + receive _ -> ok end + end, + Pid = spawn_link(F), + receive + {Pid,done} -> + {ok,Pid} + end. + +create_maps() -> + Map0 = maps:from_list([{I,[I,I+1]} || I <- lists:seq(1, 40)]), + Map1 = maps:from_list([{I,{a,[I,I*I],{}}} || I <- lists:seq(1, 100)]), + Map2 = maps:from_list([{{I},(I*I) bsl 24} || I <- lists:seq(1, 10000)]), + Map3 = lists:foldl(fun(I, A) -> + A#{I=>I*I} + end, Map2, lists:seq(-10, 0)), + #{a=>Map0,b=>Map1,c=>Map2,d=>Map3,e=>#{}}. diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl index f9ac884743..9fbd1a62a4 100644 --- a/lib/observer/test/crashdump_viewer_SUITE.erl +++ b/lib/observer/test/crashdump_viewer_SUITE.erl @@ -25,7 +25,7 @@ %% Test functions -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, start_stop/1,load_file/1,not_found_items/1, - non_existing/1,not_a_crashdump/1,old_crashdump/1]). + non_existing/1,not_a_crashdump/1,old_crashdump/1,new_crashdump/1]). -export([init_per_suite/1, end_per_suite/1]). -export([init_per_testcase/2, end_per_testcase/2]). @@ -83,6 +83,7 @@ all() -> non_existing, not_a_crashdump, old_crashdump, + new_crashdump, load_file, not_found_items ]. @@ -212,6 +213,25 @@ not_a_crashdump(Config) when is_list(Config) -> ok = crashdump_viewer:stop(). +%% Try to load a file with newer version than this crashdump viewer can handle +new_crashdump(Config) -> + Dump = hd(?config(dumps,Config)), + ok = start_backend(Dump), + {ok,{MaxVsn,CurrentVsn}} = crashdump_viewer:get_dump_versions(), + if MaxVsn =/= CurrentVsn -> + ct:fail("Current dump version is not equal to cdv's max version"); + true -> + ok + end, + ok = crashdump_viewer:stop(), + NewerVsn = lists:join($.,[integer_to_list(X+1) || X <- MaxVsn]), + PrivDir = ?config(priv_dir,Config), + NewDump = filename:join(PrivDir,"new_erl_crash.dump"), + ok = file:write_file(NewDump,"=erl_crash_dump:"++NewerVsn++"\n"), + {error, Reason} = start_backend(NewDump), + "This Crashdump Viewer is too old" ++_ = Reason, + ok = crashdump_viewer:stop(). + %% Load files into the tool and view all pages load_file(Config) when is_list(Config) -> case ?t:is_debug() of @@ -328,7 +348,7 @@ browse_file(File) -> io:format(" info read",[]), - lookat_all_pids(Procs), + lookat_all_pids(Procs,is_truncated(File),incomplete_allowed(File)), io:format(" pids ok",[]), lookat_all_ports(Ports), io:format(" ports ok",[]), @@ -339,6 +359,21 @@ browse_file(File) -> Procs. % used as second arg to special/2 +is_truncated(File) -> + case filename:extension(File) of + ".trunc"++_ -> + true; + _ -> + false + end. + +incomplete_allowed(File) -> + %% Incomplete heap is allowed for native libs, since some literals + %% are not dumped - and for pre OTP-20 (really pre 20.2) releases, + %% since literals were not dumped at all then. + Rel = get_rel_from_dump_name(File), + Rel < 20 orelse test_server:is_native(lists). + special(File,Procs) -> case filename:extension(File) of ".full_dist" -> @@ -364,6 +399,14 @@ special(File,Procs) -> crashdump_viewer:expand_binary({SOffset,SSize,SPos}), io:format(" expand binary ok",[]), + Binaries = crashdump_helper:create_binaries(), + verify_binaries(Binaries, proplists:get_value(bins,Dict)), + io:format(" binaries ok",[]), + + SubBinaries = crashdump_helper:create_sub_binaries(Binaries), + verify_binaries(SubBinaries, proplists:get_value(sub_bins,Dict)), + io:format(" sub binaries ok",[]), + #proc{last_calls=LastCalls} = ProcDetails, true = length(LastCalls) =< 4, @@ -422,7 +465,9 @@ special(File,Procs) -> %% i.e. no binary exist in the dump [#proc{pid=Pid0}|_Rest] = lists:keysort(#proc.name,Procs), Pid = pid_to_list(Pid0), - {ok,ProcDetails=#proc{},[]} = crashdump_viewer:proc_details(Pid), + %%WarnIncompleteHeap = ["WARNING: This process has an incomplete heap. Some information might be missing."], + {ok,ProcDetails=#proc{},[]} = + crashdump_viewer:proc_details(Pid), io:format(" process details ok",[]), #proc{dict=Dict} = ProcDetails, @@ -513,20 +558,56 @@ special(File,Procs) -> io:format(" unicode table name ok",[]), ok; + ".maps" -> + %% I registered a process as aaaaaaaa_maps in the map dump + %% to make sure it will be the first in the list when sorted + %% on names. + [#proc{pid=Pid0,name=Name}|_Rest] = lists:keysort(#proc.name,Procs), + "aaaaaaaa_maps" = Name, + Pid = pid_to_list(Pid0), + {ok,ProcDetails=#proc{},[]} = crashdump_viewer:proc_details(Pid), + io:format(" process details ok",[]), + + #proc{dict=Dict} = ProcDetails, + %% io:format("~p\n", [Dict]), + Maps = crashdump_helper:create_maps(), + Maps = proplists:get_value(maps,Dict), + io:format(" maps ok",[]), + ok; _ -> ok end, ok. +verify_binaries([H|T1], [H|T2]) -> + %% Heap binary. + verify_binaries(T1, T2); +verify_binaries([Bin|T1], [['#CDVBin',Offset,Size,Pos]|T2]) -> + %% Refc binary. + {ok,<<Bin:Size/binary>>} = crashdump_viewer:expand_binary({Offset,Size,Pos}), + verify_binaries(T1, T2); +verify_binaries([], []) -> + ok. -lookat_all_pids([]) -> +lookat_all_pids([],_,_) -> ok; -lookat_all_pids([#proc{pid=Pid0}|Procs]) -> +lookat_all_pids([#proc{pid=Pid0}|Procs],TruncAllowed,IncompAllowed) -> Pid = pid_to_list(Pid0), - {ok,_ProcDetails=#proc{},_ProcTW} = crashdump_viewer:proc_details(Pid), - {ok,_Ets,_EtsTW} = crashdump_viewer:ets_tables(Pid), - {ok,_Timers,_TimersTW} = crashdump_viewer:timers(Pid), - lookat_all_pids(Procs). + {ok,_ProcDetails=#proc{},ProcTW} = crashdump_viewer:proc_details(Pid), + {ok,_Ets,EtsTW} = crashdump_viewer:ets_tables(Pid), + {ok,_Timers,TimersTW} = crashdump_viewer:timers(Pid), + case {ProcTW,EtsTW,TimersTW} of + {[],[],[]} -> + ok; + {["WARNING: This process has an incomplete heap."++_],[],[]} + when IncompAllowed -> + ok; % native libs, literals might not be included in dump + _ when TruncAllowed -> + ok; % truncated dump + TWs -> + ct:fail({unexpected_warning,TWs}) + end, + lookat_all_pids(Procs,TruncAllowed,IncompAllowed). lookat_all_ports([]) -> ok; @@ -574,16 +655,11 @@ do_create_dumps(DataDir,Rel) -> current -> CD3 = dump_with_args(DataDir,Rel,"instr","+Mim true"), CD4 = dump_with_strange_module_name(DataDir,Rel,"strangemodname"), - Tmp = dump_with_args(DataDir,Rel,"trunc_bytes",""), - {ok,#file_info{size=Max}} = file:read_file_info(Tmp), - ok = file:delete(Tmp), - Bytes = max(15,rand:uniform(Max)), - CD5 = dump_with_args(DataDir,Rel,"trunc_bytes", - "-env ERL_CRASH_DUMP_BYTES " ++ - integer_to_list(Bytes)), + CD5 = dump_with_size_limit_reached(DataDir,Rel,"trunc_bytes"), CD6 = dump_with_unicode_atoms(DataDir,Rel,"unicode"), + CD7 = dump_with_maps(DataDir,Rel,"maps"), TruncatedDumps = truncate_dump(CD1), - {[CD1,CD2,CD3,CD4,CD5,CD6|TruncatedDumps], DosDump}; + {[CD1,CD2,CD3,CD4,CD5,CD6,CD7|TruncatedDumps], DosDump}; _ -> {[CD1,CD2], DosDump} end. @@ -596,7 +672,10 @@ truncate_dump(File) -> {win32,_} -> <<"\r\n">>; _ -> <<"\n">> end, - [StartBin,AfterTag] = binary:split(Bin,BinTag), + %% Split after "our binary" created by crashdump_helper + %% (it may not be the first binary). + RE = <<"\n=binary:(?=[0-9A-Z]+",NewLine/binary,"FF:AQID)">>, + [StartBin,AfterTag] = re:split(Bin,RE,[{parts,2}]), [AddrAndSize,BinaryAndRest] = binary:split(AfterTag,Colon), [Binary,_Rest] = binary:split(BinaryAndRest,NewLine), TruncSize = byte_size(Binary) - 2, @@ -689,6 +768,28 @@ dump_with_strange_module_name(DataDir,Rel,DumpName) -> ?t:stop_node(n1), CD. +dump_with_size_limit_reached(DataDir,Rel,DumpName) -> + Tmp = dump_with_args(DataDir,Rel,DumpName,""), + {ok,#file_info{size=Max}} = file:read_file_info(Tmp), + ok = file:delete(Tmp), + dump_with_size_limit_reached(DataDir,Rel,DumpName,Max). + +dump_with_size_limit_reached(DataDir,Rel,DumpName,Max) -> + Bytes = max(15,rand:uniform(Max)), + CD = dump_with_args(DataDir,Rel,DumpName, + "-env ERL_CRASH_DUMP_BYTES " ++ + integer_to_list(Bytes)), + {ok,#file_info{size=Size}} = file:read_file_info(CD), + if Size < Bytes -> + %% This means that the dump was actually smaller than the + %% randomly selected truncation size, so we'll just do it + %% again with a smaller numer + ok = file:delete(CD), + dump_with_size_limit_reached(DataDir,Rel,DumpName,Size-3); + true -> + CD + end. + dump_with_unicode_atoms(DataDir,Rel,DumpName) -> Opt = rel_opt(Rel), Pz = "-pz \"" ++ filename:dirname(code:which(?MODULE)) ++ "\"", @@ -699,6 +800,16 @@ dump_with_unicode_atoms(DataDir,Rel,DumpName) -> ?t:stop_node(n1), CD. +dump_with_maps(DataDir,Rel,DumpName) -> + Opt = rel_opt(Rel), + Pz = "-pz \"" ++ filename:dirname(code:which(?MODULE)) ++ "\"", + PzOpt = [{args,Pz}], + {ok,N1} = ?t:start_node(n1,peer,Opt ++ PzOpt), + {ok,_Pid} = rpc:call(N1,crashdump_helper,dump_maps,[]), + CD = dump(N1,DataDir,Rel,DumpName), + ?t:stop_node(n1), + CD. + dump(Node,DataDir,Rel,DumpName) -> Crashdump = filename:join(DataDir, dump_prefix(Rel)++DumpName), rpc:call(Node,os,putenv,["ERL_CRASH_DUMP",Crashdump]), @@ -751,6 +862,11 @@ dump_prefix(current) -> dump_prefix(Rel) -> lists:concat(["r",Rel,"_dump."]). +get_rel_from_dump_name(File) -> + Name = filename:basename(File), + ["r"++Rel|_] = string:split(Name,"_"), + list_to_integer(Rel). + compat_rel(current) -> ""; compat_rel(Rel) -> diff --git a/lib/observer/test/ttb_SUITE.erl b/lib/observer/test/ttb_SUITE.erl index e8c2f9e37d..ed62efbb58 100644 --- a/lib/observer/test/ttb_SUITE.erl +++ b/lib/observer/test/ttb_SUITE.erl @@ -222,7 +222,7 @@ file_fetch(Config) when is_list(Config) -> ?line ?t:capture_stop(), ?line [StoreString] = ?t:capture_get(), ?line UploadDir = - lists:last(string:tokens(lists:flatten(StoreString),"$ \n")), + lists:last(string:lexemes(lists:flatten(StoreString),"$ \n")), %% check that files are no longer in original directories... ?line ok = check_gone(ThisDir,atom_to_list(Node)++"-file_fetch"), @@ -1035,8 +1035,8 @@ logfile_name_in_fetch_dir(Config) when is_list(Config) -> ?line {ServerNode, ClientNode} = start_client_and_server(), ?line begin_trace(ServerNode, ClientNode, {local, ?FNAME}), ?line {_,Dir} = ttb:stop([return_fetch_dir]), - ?line P1 = lists:nth(3, string:tokens(filename:basename(Dir), "_")), - ?line P2 = hd(string:tokens(P1, "-")), + ?line P1 = lists:nth(3, string:lexemes(filename:basename(Dir), "_")), + ?line P2 = hd(string:lexemes(P1, "-")), ?line _File = P2. logfile_name_in_fetch_dir(cleanup,_Config) -> ?line stop_client_and_server(). diff --git a/lib/observer/vsn.mk b/lib/observer/vsn.mk index 5f43198f85..fc1fca0925 100644 --- a/lib/observer/vsn.mk +++ b/lib/observer/vsn.mk @@ -1 +1 @@ -OBSERVER_VSN = 2.5 +OBSERVER_VSN = 2.6 diff --git a/lib/odbc/doc/src/Makefile b/lib/odbc/doc/src/Makefile index b66d00a88b..b3f93a7e9c 100644 --- a/lib/odbc/doc/src/Makefile +++ b/lib/odbc/doc/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2016. All Rights Reserved. +# Copyright Ericsson AB 1999-2017. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -38,11 +38,9 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml -XML_REF3_FILES = odbc.xml +XML_REF3_FILES = odbc.xml -XML_PART_FILES = part.xml \ - part_notes.xml \ - part_notes_history.xml +XML_PART_FILES = part.xml XML_HTML_FILES = \ notes_history.xml @@ -52,21 +50,15 @@ XML_CHAPTER_FILES = \ getting_started.xml \ databases.xml \ error_handling.xml \ - notes.xml + notes.xml BOOK_FILES = book.xml XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \ - $(XML_PART_FILES) $(XML_CHAPTER_FILES) + $(XML_PART_FILES) $(XML_CHAPTER_FILES) GIF_FILES = \ - book.gif \ - odbc.gif \ - note.gif \ - notes.gif \ - ref_man.gif \ - user_guide.gif \ - odbc_app_arc.gif + odbc_app_arc.gif # ---------------------------------------------------- @@ -87,10 +79,10 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += +XML_FLAGS += +DVIPS_FLAGS += # ---------------------------------------------------- # Targets @@ -117,12 +109,12 @@ man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) # We depend just to copy them to ../html -debug opt: +debug opt: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs diff --git a/lib/odbc/doc/src/book.gif b/lib/odbc/doc/src/book.gif Binary files differdeleted file mode 100644 index 94b3868792..0000000000 --- a/lib/odbc/doc/src/book.gif +++ /dev/null diff --git a/lib/odbc/doc/src/fascicules.xml b/lib/odbc/doc/src/fascicules.xml deleted file mode 100644 index 91251d4b20..0000000000 --- a/lib/odbc/doc/src/fascicules.xml +++ /dev/null @@ -1,19 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - - diff --git a/lib/odbc/doc/src/note.gif b/lib/odbc/doc/src/note.gif Binary files differdeleted file mode 100644 index 6fffe30419..0000000000 --- a/lib/odbc/doc/src/note.gif +++ /dev/null diff --git a/lib/odbc/doc/src/notes.gif b/lib/odbc/doc/src/notes.gif Binary files differdeleted file mode 100644 index e000cca26a..0000000000 --- a/lib/odbc/doc/src/notes.gif +++ /dev/null diff --git a/lib/odbc/doc/src/notes.xml b/lib/odbc/doc/src/notes.xml index cc25a21c74..2aa55ca99c 100644 --- a/lib/odbc/doc/src/notes.xml +++ b/lib/odbc/doc/src/notes.xml @@ -11,7 +11,7 @@ Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at - + http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software @@ -21,7 +21,7 @@ limitations under the License. </legalnotice> - + <title>ODBC Release Notes</title> <prepared>otp_appnotes</prepared> <docno>nil</docno> @@ -32,7 +32,22 @@ <p>This document describes the changes made to the odbc application. </p> - <section><title>ODBC 2.12</title> + <section><title>ODBC 2.12.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Removed all old unused files in the documentation. + </p> + <p> + Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p> + </item> + </list> + </section> + +</section> + +<section><title>ODBC 2.12</title> <section><title>Improvements and New Features</title> <list> @@ -568,9 +583,9 @@ </section> - + <section><title>ODBC 2.10.7</title> - + <section><title>Fixed Bugs and Malfunctions</title> <list> <item> @@ -583,7 +598,7 @@ </list> </section> - + <section><title>Improvements and New Features</title> <list> <item> @@ -720,7 +735,7 @@ </section> <section><title>ODBC 2.10.5</title> - + <section><title>Fixed Bugs and Malfunctions</title> <list> <item> @@ -732,12 +747,12 @@ </item> </list> </section> - + </section> <section><title>ODBC 2.10.4</title> - + <section><title>Improvements and New Features</title> <list> <item> @@ -756,7 +771,7 @@ </item> </list> </section> - + </section> <section><title>ODBC 2.10.3</title> @@ -787,7 +802,7 @@ </section> <section><title>ODBC 2.10.2</title> - + <section><title>Fixed Bugs and Malfunctions</title> <list> <item> @@ -802,9 +817,9 @@ </section> </section> - + <section><title>ODBC 2.10.1</title> - + <section><title>Improvements and New Features</title> <list> <item> @@ -852,7 +867,7 @@ </section> <section><title>ODBC 2.10</title> - + <section><title>Improvements and New Features</title> <list> <item> @@ -865,11 +880,11 @@ </item> </list> </section> - + </section> <section><title>ODBC 2.0.9</title> - + <section><title>Improvements and New Features</title> <list> <item> @@ -897,9 +912,9 @@ </item> </list> </section> - + </section> - + <section> <title>ODBC 2.0.8</title> @@ -1142,9 +1157,5 @@ </item> </list> </section> - <!-- p>For information about older versions see - <url href="part_notes_history_frame.html">release notes history</url>.</p --> </section> </chapter> - - diff --git a/lib/odbc/doc/src/odbc.gif b/lib/odbc/doc/src/odbc.gif Binary files differdeleted file mode 100644 index fbbabee5aa..0000000000 --- a/lib/odbc/doc/src/odbc.gif +++ /dev/null diff --git a/lib/odbc/doc/src/odbc_index.gif b/lib/odbc/doc/src/odbc_index.gif Binary files differdeleted file mode 100644 index fbbabee5aa..0000000000 --- a/lib/odbc/doc/src/odbc_index.gif +++ /dev/null diff --git a/lib/odbc/doc/src/part_notes.xml b/lib/odbc/doc/src/part_notes.xml deleted file mode 100644 index 8f1dbd3fbc..0000000000 --- a/lib/odbc/doc/src/part_notes.xml +++ /dev/null @@ -1,41 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2004</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>ODBC Release Notes</title> - <prepared>Ingela Anderton Andin</prepared> - <docno></docno> - <date>2004-09-07</date> - <rev></rev> - <file>part_notes.sgml</file> - </header> - <description> - <p>An interface to relational SQL-databases built on ODBC (Open - Database Connectivity). </p> - <p>For information about older versions see - <url href="part_notes_history_frame.html">release notes history</url>.</p> - </description> - <xi:include href="notes.xml"/> -</part> - - diff --git a/lib/odbc/doc/src/part_notes_history.xml b/lib/odbc/doc/src/part_notes_history.xml deleted file mode 100644 index 6f855f6ed1..0000000000 --- a/lib/odbc/doc/src/part_notes_history.xml +++ /dev/null @@ -1,35 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part> - <header> - <copyright> - <year>2004</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>Odbc</title> - <prepared>Ingela Anderton Andin</prepared> - <docno></docno> - <date>2004-09-30</date> - <rev></rev> - <file>part_notes.sgml</file> - </header> - <include file="notes_history"></include> -</part> - - diff --git a/lib/odbc/doc/src/ref_man.gif b/lib/odbc/doc/src/ref_man.gif Binary files differdeleted file mode 100644 index b13c4efd53..0000000000 --- a/lib/odbc/doc/src/ref_man.gif +++ /dev/null diff --git a/lib/odbc/doc/src/user_guide.gif b/lib/odbc/doc/src/user_guide.gif Binary files differdeleted file mode 100644 index e6275a803d..0000000000 --- a/lib/odbc/doc/src/user_guide.gif +++ /dev/null diff --git a/lib/odbc/doc/src/warning.gif b/lib/odbc/doc/src/warning.gif Binary files differdeleted file mode 100644 index 96af52360e..0000000000 --- a/lib/odbc/doc/src/warning.gif +++ /dev/null diff --git a/lib/odbc/vsn.mk b/lib/odbc/vsn.mk index 2e313570e1..3f7677a71d 100644 --- a/lib/odbc/vsn.mk +++ b/lib/odbc/vsn.mk @@ -1 +1 @@ -ODBC_VSN = 2.12 +ODBC_VSN = 2.12.1 diff --git a/lib/orber/doc/src/CosNaming.xml b/lib/orber/doc/src/CosNaming.xml index d69b604f2f..251e721df1 100644 --- a/lib/orber/doc/src/CosNaming.xml +++ b/lib/orber/doc/src/CosNaming.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1997</year><year>2016</year> + <year>1997</year><year>2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -55,8 +55,8 @@ struct Binding { typedef sequence <Binding> BindingList; ]]></code> - <p>To get access to the record definitions for the structs use: - <c>-include_lib("orber/COSS/CosNaming.hrl").</c>.</p> + <p>To get access to the record definitions for the structs use:</p> + <code>-include_lib("orber/COSS/CosNaming.hrl").</code> <p>Names are not an ORB object but the can be structured in components as seen by the definition above. There are no requirements on names so the service can support many different conventions and standards.</p> diff --git a/lib/orber/doc/src/CosNaming_NamingContext.xml b/lib/orber/doc/src/CosNaming_NamingContext.xml index 96a6367cbb..4c83e6a240 100644 --- a/lib/orber/doc/src/CosNaming_NamingContext.xml +++ b/lib/orber/doc/src/CosNaming_NamingContext.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1997</year><year>2016</year> + <year>1997</year><year>2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -37,61 +37,54 @@ naming contexts. Name context may be named in other contexts and cycles are permitted.</p> <p>The type <c>NameComponent</c> used below is defined as:</p> - <code type="none"> - -record('CosNaming_NameComponent', {id, kind=""}). - </code> + <code type="erl">-record('CosNaming_NameComponent', {id, kind=""}).</code> <p>where <c>id</c> and <c>kind</c> are strings. </p> <p>The type <c>Binding</c> used below is defined as:</p> - <code type="none"> - -record('CosNaming_Binding', {binding_name, binding_type}). - </code> + <code type="erl">-record('CosNaming_Binding', {binding_name, binding_type}).</code> <p>where <c>binding_name</c> is a Name and <c>binding_type</c> is an enum which has the values <c>nobject</c> and <c>ncontext</c>.</p> <p>Both these records are defined in the file <c>CosNaming.hrl</c> and it is included with:</p> - <code type="none"> - -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). - </code> + <code type="erl">-include_lib("orber/COSS/CosNaming/CosNaming.hrl").</code> <p>There are a number of exceptions that can be returned from functions in this interface.</p> <list type="bulleted"> <item> <p>NotFound is defined as </p> - <code type="none"> --record('CosNaming_NamingContext_NotFound', - {rest_of_name, why}). </code> + <code type="erl"> +-record('CosNaming_NamingContext_NotFound', + {rest_of_name, why}).</code> </item> <item> <p>CannotProceed is defined as </p> - <code type="none"> --record('CosNaming_NamingContext_CannotProceed', - {rest_of_name, cxt}). </code> + <code type="erl"> +-record('CosNaming_NamingContext_CannotProceed', + {rest_of_name, cxt}). + </code> </item> <item> <p>InvalidName is defined as </p> - <code type="none"> --record('CosNaming_NamingContext_InvalidName', {}). </code> + <code type="erl"> +-record('CosNaming_NamingContext_InvalidName', {}). + </code> </item> <item> <p>NotFound is defined as </p> - <code type="none"> --record('CosNaming_NamingContext_NotFound', {}). </code> + <code type="erl">-record('CosNaming_NamingContext_NotFound', {}).</code> </item> <item> <p>AlreadyBound is defined as </p> - <code type="none"> --record('CosNaming_NamingContext_AlreadyBound', {}). </code> + <code type="erl">-record('CosNaming_NamingContext_AlreadyBound', {}).</code> </item> <item> <p>NotEmpty is defined as </p> - <code type="none"> --record('CosNaming_NamingContext_NotEmpty', {). </code> + <code type="erl">-record('CosNaming_NamingContext_NotEmpty', {}).</code> </item> </list> <p>These exceptions are defined in the file <c>CosNaming_NamingContext.hrl</c> and it is included with:</p> - <code type="none"> - -include_lib("orber/COSS/CosNaming/CosNaming_NamingContext.hrl"). + <code type="erl"> +-include_lib("orber/COSS/CosNaming/CosNaming_NamingContext.hrl"). </code> </description> <funcs> diff --git a/lib/orber/doc/src/CosNaming_NamingContextExt.xml b/lib/orber/doc/src/CosNaming_NamingContextExt.xml index a571b97ccb..2af3deadda 100644 --- a/lib/orber/doc/src/CosNaming_NamingContextExt.xml +++ b/lib/orber/doc/src/CosNaming_NamingContextExt.xml @@ -4,8 +4,7 @@ <erlref> <header> <copyright> - <year>2000</year> - <year>2016</year> + <year>2000</year><year>2017</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -36,8 +35,8 @@ <description> <p>To get access to the record definitions for the structures use: <br></br> </p> - <code type="none"> - -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). + <code type="erl"> +-include_lib("orber/COSS/CosNaming/CosNaming.hrl"). </code> <p>This module also exports the functions described in:</p> <list type="bulleted"> diff --git a/lib/orber/doc/src/Makefile b/lib/orber/doc/src/Makefile index ecb0206443..c77345f12b 100644 --- a/lib/orber/doc/src/Makefile +++ b/lib/orber/doc/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2016. All Rights Reserved. +# Copyright Ericsson AB 1997-2017. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -57,8 +57,7 @@ XML_REF3_FILES = \ orber_acl.xml XML_PART_FILES = \ - part.xml \ - part_notes.xml + part.xml XML_CHAPTER_FILES = \ ch_contents.xml \ @@ -79,15 +78,11 @@ XML_CHAPTER_FILES = \ BOOK_FILES = book.xml XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \ - $(XML_PART_FILES) $(XML_CHAPTER_FILES) + $(XML_PART_FILES) $(XML_CHAPTER_FILES) -TECHNICAL_DESCR_FILES = +TECHNICAL_DESCR_FILES = GIF_FILES = \ - book.gif \ - notes.gif \ - ref_man.gif \ - user_guide.gif \ name.gif \ orbs.gif \ theORB.gif \ @@ -114,7 +109,7 @@ HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) INFO_FILE = ../../info -EXTRA_FILES = summary.html.src \ +EXTRA_FILES = \ $(DEFAULT_GIF_FILES) \ $(DEFAULT_HTML_FILES) \ $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) @@ -126,10 +121,10 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += +XML_FLAGS += +DVIPS_FLAGS += # ---------------------------------------------------- # Targets @@ -157,11 +152,11 @@ man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) -debug opt: +debug opt: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs diff --git a/lib/orber/doc/src/any.xml b/lib/orber/doc/src/any.xml index f51712c97e..c94a2132d8 100644 --- a/lib/orber/doc/src/any.xml +++ b/lib/orber/doc/src/any.xml @@ -4,8 +4,7 @@ <erlref> <header> <copyright> - <year>1998</year> - <year>2016</year> + <year>1998</year><year>2017</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -41,9 +40,7 @@ <p>The type <c>TC</c> used below describes an IDL type and is a tuple according to the to the Erlang language mapping.</p> <p>The type <c>Any</c> used below is defined as:</p> - <code type="none"> - -record(any, {typecode, value}). - </code> + <code type="erl">-record(any, {typecode, value}).</code> <p>where <c>typecode</c> is a TC tuple and <c>value</c> is an Erlang term of the type defined by the typecode field.</p> </description> diff --git a/lib/orber/doc/src/book.gif b/lib/orber/doc/src/book.gif Binary files differdeleted file mode 100644 index 94b3868792..0000000000 --- a/lib/orber/doc/src/book.gif +++ /dev/null diff --git a/lib/orber/doc/src/ch_debugging.xml b/lib/orber/doc/src/ch_debugging.xml index a036cf5231..debac4313e 100644 --- a/lib/orber/doc/src/ch_debugging.xml +++ b/lib/orber/doc/src/ch_debugging.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2001</year><year>2016</year> + <year>2001</year><year>2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -121,7 +121,7 @@ Result.......: {'EXCEPTION',{'MARSHAL',[],102,'COMPLETED_NO'}} uses the <c>error_logger</c> module to generate the logs. If the traffic is intense you probably want to write the reports to a log-file. This is done by, for example, invoking:</p> - <code type="none"> + <code type="erl"> erl> error_logger:tty(false). erl> error_logger:logfile({open, "/tmp/IIOPTrace"}). </code> diff --git a/lib/orber/doc/src/ch_exceptions.xml b/lib/orber/doc/src/ch_exceptions.xml index 52735dc394..17657d0d4a 100644 --- a/lib/orber/doc/src/ch_exceptions.xml +++ b/lib/orber/doc/src/ch_exceptions.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2001</year><year>2016</year> + <year>2001</year><year>2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -192,7 +192,7 @@ module MyModule { <title>Throwing Exceptions</title> <p>To be able to raise <c>MyException</c> or <c>MyExceptionMsg</c> exceptions, the generated <c>MyModule.hrl</c> must be included, and typical usage is:</p> - <code type="none"> + <code type="erl"> -module('MyModule_MyInterface_impl'). -include("MyModule.hrl"). diff --git a/lib/orber/doc/src/ch_idl_to_erlang_mapping.xml b/lib/orber/doc/src/ch_idl_to_erlang_mapping.xml index a0feda3f84..eaa88f24f1 100644 --- a/lib/orber/doc/src/ch_idl_to_erlang_mapping.xml +++ b/lib/orber/doc/src/ch_idl_to_erlang_mapping.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>1997</year><year>2016</year> + <year>1997</year><year>2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -819,7 +819,7 @@ module x { <p><term id="Type Codes"><termdef>Type codes give a complete description of the type including all its components and structure.</termdef></term>are, for example, used in <seealso marker="any">Any</seealso> values. Hence, we can encapsulate the <c>employee</c> struct in an <c>any</c> type by:</p> - <code type="none"> + <code type="erl"> %% Erlang code .... AnEmployee = #'DB_employee'{'No' = 1, @@ -962,7 +962,7 @@ R1 = m_i:foo(Obj, 55), representation of the IDL-type <c>void</c>, must be returned by <c>baz</c> and <c>'_set_RWAttribute'</c>. These operations can be implemented in the call-back module as:</p> - <code type="none"> + <code type="erl"> '_set_RWAttribute'(State, Long) -> {reply, ok, State}. @@ -1011,7 +1011,7 @@ $> erlc +"{be,erl_template}" DB.idl <p>We begin with implementing the <c>DB_Access_impl.erl</c> module, which, if we used <c>erl_template</c>, will look like the following. All we need to do is to add the logic to the <c>logon</c> operation.</p> - <code type="none"><![CDATA[ + <code type="erl"><![CDATA[ %%---------------------------------------------------------------------- %% <LICENSE> %% @@ -1154,7 +1154,7 @@ $ <input>erlc *.erl</input> <seealso marker="ch_exceptions">Exceptions</seealso> chapter. In the following example, only the implementation of the API functions are shown:</p> - <code type="none"> + <code type="erl"> %%====================================================================== %% API Functions %%====================================================================== diff --git a/lib/orber/doc/src/ch_install.xml b/lib/orber/doc/src/ch_install.xml index 9bc974225d..65faa91ccf 100644 --- a/lib/orber/doc/src/ch_install.xml +++ b/lib/orber/doc/src/ch_install.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>1997</year><year>2016</year> + <year>1997</year><year>2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -106,7 +106,7 @@ necessary to start the Erlang distribution (i.e. using <c>-name/-sname</c>).</p> <p>If we use <c>ram_copies</c> there is no need for creating a disk based schema. Simply use:</p> - <code type="none"> + <code type="erl"> erl> mnesia:start(). erl> corba:orb_init([{domain, "MyRAMSingleNodeORB"}]). erl> orber:install([node()], [{ifr_storage_type, ram_copies}]). @@ -115,7 +115,7 @@ erl> orber:start(). <p>If you installation requires <c>disc_copies</c> you must begin with creating a Mnesia schema. Otherwise, the installation is similar to a RAM installation:</p> - <code type="none"> + <code type="erl"> erl> mnesia:create_schema([node()]). erl> mnesia:start(). erl> corba:orb_init([{domain, "MyDiskSingleNodeORB"}]). @@ -137,7 +137,7 @@ erl> orber:start(). <title>Install RAM Based Multi Node Orber</title> <p>Within a domain Orber uses the Erlang distribution protocol. Hence, you <em>must</em> start it first by, for example, using:</p> - <code type="none"> + <code type="erl"> hostA> erl -sname nodeA </code> <p>In this example, we assume that we want to use two nodes; <c>nodeA</c> and @@ -146,7 +146,7 @@ hostA> erl -sname nodeA parameter <c>extra_db_nodes</c> or use <c>mnesia:change_config/2</c>. To begin with, Mnesia must be started on all nodes before we can install Orber:</p> - <code type="none"> + <code type="erl"> nodeA@hostA> mnesia:start(). nodeA@hostA> mnesia:change_config(extra_db_nodes, [nodeA@hostA, nodeB@hostB]). @@ -154,7 +154,7 @@ nodeA@hostA> mnesia:change_config(extra_db_nodes, <p>After that the above have been repeated on <c>nodeB</c> we must first make sure that both nodes will use the same domain name, then we can install Orber:</p> - <code type="none"> + <code type="erl"> nodeA@hostA> corba:orb_init([{domain, "MyRAMMultiNodeORB"}]). nodeA@hostA> orber:install([nodeA@hostA, nodeB@hostB], [{ifr_storage_type, ram_copies}]). @@ -162,7 +162,7 @@ nodeA@hostA> orber:start(). </code> <p>Note that you can only invoke <c>orber:install/1/2</c> on one of the nodes. Now we can start Orber on the other node:</p> - <code type="none"> + <code type="erl"> nodeB@hostB> corba:orb_init([{domain, "MyRAMMultiNodeORB"}]). nodeB@hostB> orber:start(). </code> @@ -173,7 +173,7 @@ nodeB@hostB> orber:start(). <p>As for RAM based multi-node Orber installations, the Erlang distribution must be started (e.g. erl -sname nodeA). The major difference is that when it is disk based a Mnesia schema must be created:</p> - <code type="none"> + <code type="erl"> nodeA@hostA> mnesia:create_schema([nodeA@hostA, nodeB@hostB]). nodeA@hostA> mnesia:start(). </code> @@ -183,7 +183,7 @@ nodeA@hostA> mnesia:start(). <c>mnesia:start()</c>) on <c>nodeB</c>.</p> <p>After Mnesia have been started on all nodes, you must confirm that all nodes have the same domain name, then Orber is ready to be installed:</p> - <code type="none"> + <code type="erl"> nodeA@hostA> corba:orb_init([{domain, "MyDiskMultiNodeORB"}]). nodeA@hostA> orber:install([nodeA@hostA, nodeB@hostB], [{ifr_storage_type, disc_copies}]). @@ -191,7 +191,7 @@ nodeA@hostA> orber:start(). </code> <p>Note that you can only invoke <c>orber:install/1/2</c> on one of the nodes. Now we can start Orber on the other node:</p> - <code type="none"> + <code type="erl"> nodeB@hostB> corba:orb_init([{domain, "MyDiskMultiNodeORB"}]). nodeB@hostB> orber:start(). </code> @@ -918,7 +918,7 @@ TCP Firewall With NAT</icaption> verify whether access would be granted or not. For example, if Orber would be started with the ACL <c>[{tcp_out, "10.1.1.1/8#4001/5001"}]</c>, then <c>orber_acl:match/2</c> would behave as follows:</p> - <code type="none"> + <code type="erl"> erl> orber_acl:match({11,1,1,1}, tcp_out). false @@ -967,7 +967,7 @@ erl> orber_acl:match({10,1,1,1}, tcp_out, true). the configuration of the underlying system.</p> <p>Adding the interface context, for generated stubs/skeletons, is done in the following way:</p> - <code type="none"> + <code type="erl"> Ctx = #'IOP_ServiceContext'{context_id = ?ORBER_GENERIC_CTX_ID, context_data = {interface, "10.0.0.1"}}, 'CosNaming_NamingContext':resolve(NS, [{context, [Ctx]}], Name), diff --git a/lib/orber/doc/src/ch_interceptors.xml b/lib/orber/doc/src/ch_interceptors.xml index 392fe7de82..4a9f8e69ca 100644 --- a/lib/orber/doc/src/ch_interceptors.xml +++ b/lib/orber/doc/src/ch_interceptors.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2001</year><year>2016</year> + <year>2001</year><year>2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -121,7 +121,7 @@ The Invocation Order of Interceptor Functions.</icaption> we store which objects the clients are allowed to invoke operations on and <c>ChecksumModule</c> determines which module we should use to handle the checksums. </p> - <code type="none"> + <code type="erl"> new_in_connection(Arg, Host, Port) -> %% Since we only use one interceptor we do not care about the %% input Arg since it is set do undefined by Orber. @@ -141,7 +141,7 @@ new_in_connection(Arg, Host, Port) -> <p>When a new request comes in the first interceptor function to be invoked is <c>in_request_encoded</c>. We will remove the checksum from the coded request body in the following way:</p> - <code type="none"> + <code type="erl"> in_request_encoded({ObjTable, ChecksumModule}, ObjKey, Ctx, Op, Bin, Extra) -> NewBin = ChecksumModule:remove_checksum(Bin), {NewBin, Extra}. @@ -154,7 +154,7 @@ in_request_encoded({ObjTable, ChecksumModule}, ObjKey, Ctx, Op, Bin, Extra) -> good throughput.</p> <p>If we want to we can restrict any clients to only use a subset of operations exported by a server:</p> - <code type="none"> + <code type="erl"> in_request({ObjTable, ChecksumModule}, ObjKey, Ctx, Op, Params, Extra) -> case ets:lookup(ObjTable, {ObjKey, Op}) of [] -> @@ -166,13 +166,13 @@ in_request({ObjTable, ChecksumModule}, ObjKey, Ctx, Op, Params, Extra) -> <p>At this point Orber are now ready to invoke the operation on the target object. Since we do not care about what the reply is the <c>out_reply</c> function do nothing, i.e.:</p> - <code type="none"> + <code type="erl"> out_reply(_, _, _, _, Reply, Extra) -> {Reply, Extra}. </code> <p>If the client side ORB expects a checksum to be added to the reply we add it by using:</p> - <code type="none"> + <code type="erl"> out_reply_encoded({ObjTable, ChecksumModule}, ObjKey, Ctx, Op, Bin, Extra) -> NewBin = ChecksumModule:add_checksum(Bin), {NewBin, Extra}. @@ -183,8 +183,7 @@ out_reply_encoded({ObjTable, ChecksumModule}, ObjKey, Ctx, Op, Bin, Extra) -> </warning> <p>For outgoing requests the principle is the same. Hence, it is not further described here. The complete interceptor module would look like:</p> - <code type="none"> - + <code type="erl"> -module(myInterceptor). %% Interceptor functions. diff --git a/lib/orber/doc/src/ch_naming_service.xml b/lib/orber/doc/src/ch_naming_service.xml index bcbab2a597..991402ae86 100644 --- a/lib/orber/doc/src/ch_naming_service.xml +++ b/lib/orber/doc/src/ch_naming_service.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>1997</year><year>2016</year> + <year>1997</year><year>2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -116,7 +116,7 @@ Figure 1: Contextual object relationships using the Naming Service.</icaption> <title>Fetch Initial Reference to the Naming Service</title> <p>In order to use the naming service you have to fetch an initial reference to it. This is done with:</p> - <code type="none"> + <code type="erl"> NS = corba:resolve_initial_references("NameService"). </code> <note> @@ -128,14 +128,14 @@ NS = corba:resolve_initial_references("NameService"). <title>Creating a Naming Context</title> <p>There are two functions for creating a naming context. The first function, which only creates a naming context object is:</p> - <code type="none"> + <code type="erl"> NC = 'CosNaming_NamingContext':new_context(NS). </code> <p>The other function creates a naming context and binds it to a name in an already existing naming context (the initial context in this example): </p> - <code type="none"> + <code type="erl"> NC = 'CosNaming_NamingContext':bind_new_context(NS, lname:new(["new"])). </code> </section> @@ -150,19 +150,19 @@ NC = 'CosNaming_NamingContext':bind_new_context(NS, lname:new(["new"])). <list type="ordered"> <item> <p>Use the naming library functions to create a name</p> - <code type="none"> + <code type="erl"> Name = lname:new(["object"]). </code> </item> <item> <p>Use CosNaming::NamingContext::bind() to bind a name to an object</p> - <code type="none"> + <code type="erl"> 'CosNaming_NamingContext':bind(Sc, Name, Object). </code> </item> <item> <p>Use CosNaming::NamingContext::unbind() to remove the NameBinding from an object</p> - <code type="none"> + <code type="erl"> 'CosNaming_NamingContext':unbind(Sc, Name). </code> </item> @@ -180,19 +180,19 @@ Name = lname:new(["object"]). <list type="ordered"> <item> <p>Use the naming library functions to create a name path:</p> - <code type="none"> + <code type="erl"> Name = lname:new(["workgroup", "services"]). </code> </item> <item> <p>Use CosNaming::NamingContext::resolve() to to resolve the name to an object</p> - <code type="none"> + <code type="erl"> Sc = 'CosNaming_NamingContext':resolve(NS, Name). </code> </item> </list> <p>An alternative is to use:</p> - <code type="none"> + <code type="erl"> Sc = corba:string_to_object("corbaname:rir:/NameService#workgroup/services/"). </code> <p>The <c>corbaname</c> schema is described further in the Interoperable @@ -205,7 +205,7 @@ Sc = corba:string_to_object("corbaname:rir:/NameService#workgroup/services/"). <item> <p>Use CosNaming::NamingContext::list() to list all the bindings in a context</p> <p>The following code retrieves and lists up to 10 bindings from a context.</p> - <code type="none"> + <code type="erl"> {BList, BIterator} = 'CosNaming_NamingContext':list(Sc, 10). lists:foreach(fun({{Id, Kind},BindingType}) -> case BindingType of @@ -229,8 +229,8 @@ lists:foreach(fun({{Id, Kind},BindingType}) -> case BindingType of <em>must be removed</em> otherwise dangling processes will occur. Use <c>CosNaming::BindingIterator::destroy()</c> to remove it.</p> </warning> - <code type="none"> - 'CosNaming_NamingContext':destroy(BIterator). + <code type="erl"> +'CosNaming_NamingContext':destroy(BIterator). </code> </section> @@ -241,7 +241,7 @@ lists:foreach(fun({{Id, Kind},BindingType}) -> case BindingType of <list type="ordered"> <item> <p>Use CosNaming::NamingContext::destroy() to remove a NamingContext</p> - <code type="none"> + <code type="erl"> 'CosNaming_NamingContext':destroy(Sc). </code> </item> @@ -318,13 +318,13 @@ lists:foreach(fun({{Id, Kind},BindingType}) -> case BindingType of listed below, they should be associated with. The <c>NameService</c> key may <em>not</em> be changed in Orber. If you want to add one of the reserved keys as an initial service, simply use:</p> - <code type="none"> + <code type="erl"> 1> Factory = cosNotificationApp:start_global_factory(). 2> corba:add_initial_service("NotificationService", Factory). </code> <p>This object can then be easily resolved by any other ORB, supporting the Interoperable Naming Service, by using:</p> - <code type="none"> + <code type="erl"> 3> NF = corba:string_to_object("corbaloc::[email protected]:4001/NotificationService"). </code> <table> @@ -438,13 +438,13 @@ lists:foreach(fun({{Id, Kind},BindingType}) -> case BindingType of <tcaption>Stringified Name representation</tcaption> </table> <p>After creating a stringified Name we can either use:</p> - <code type="none"> + <code type="erl"> NameStr = "org.erlang", NS = corba:resolve_initial_references("NameService"), Obj = 'CosNaming_NamingContextExt':resolve_str(NS, NameStr), </code> <p>or concatenate the Name String using:</p> - <code type="none"> + <code type="erl"> NameStr = "Swedish/Soccer/Champions", Address = "corbaname:iiop:[email protected]:2000/NameService", NS = corba:resolve_initial_references("NameService"), diff --git a/lib/orber/doc/src/ch_orberweb.xml b/lib/orber/doc/src/ch_orberweb.xml index be1d7fb983..c9dcc382e6 100644 --- a/lib/orber/doc/src/ch_orberweb.xml +++ b/lib/orber/doc/src/ch_orberweb.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2001</year><year>2016</year> + <year>2001</year><year>2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -208,8 +208,7 @@ <p>You may choose to start OrberWeb on node, on which Orber is running or not. But the Erlang distribution must be started (e.g. by using -sname aNodeName). Now, all you have to do is to invoke:</p> - <code type="none"> - + <code type="none"> erl> webtool:start(). WebTool is available at http://localhost:8888/ Or http://127.0.0.1:8888/ diff --git a/lib/orber/doc/src/ch_stubs.xml b/lib/orber/doc/src/ch_stubs.xml index 144191a66a..9290c127f9 100644 --- a/lib/orber/doc/src/ch_stubs.xml +++ b/lib/orber/doc/src/ch_stubs.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>1999</year><year>2016</year> + <year>1999</year><year>2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -158,7 +158,7 @@ up_to_date <p>Arguments and Replies are determined by the IDL-code and, hence, not further described here.</p> </note> - <code type="none"> + <code type="erl"> %%%----------------------------------------------------------- %%% File : Module_Interface_impl.erl %%% Author : diff --git a/lib/orber/doc/src/corba.xml b/lib/orber/doc/src/corba.xml index d89f035dba..fbfb55f2f2 100644 --- a/lib/orber/doc/src/corba.xml +++ b/lib/orber/doc/src/corba.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1997</year><year>2016</year> + <year>1997</year><year>2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -370,12 +370,12 @@ Example: <desc> <p>This function takes a <c>corbaname</c>, <c>corbaloc</c> or an IOR on the external string representation and returns the object reference.</p> - <p>To lookup the NameService reference, simply use - <c>"corbaloc:iiop:[email protected]:4001/NameService"</c></p> - <p>We can also resolve an object from the NameService by using - <c>"corbaname:iiop:[email protected]:4001/NameService#org/Erlang/MyObj"</c></p> - <p>To lookup the NameService reference with an IPv6 address, simply use - <c>"corbaloc:iiop:1.2@[FEC1:0:3:0:0312:44AF:FAB1:3D01]:4001/NameService"</c></p> + <p>To lookup the NameService reference, simply use:</p> + <code>corbaloc:iiop:[email protected]:4001/NameService</code> + <p>We can also resolve an object from the NameService by using:</p> + <code>corbaname:iiop:[email protected]:4001/NameService#org/Erlang/MyObj</code> + <p>To lookup the NameService reference with an IPv6 address, simply use:</p> + <code>corbaloc:iiop:1.2@[FEC1:0:3:0:0312:44AF:FAB1:3D01]:4001/NameService</code> <p>For more information about <c>corbaname</c> and <c>corbaloc</c>, see the User's Guide (Interoperable Naming Service).</p> <p>The <em>configuration</em> context is used to override the global diff --git a/lib/orber/doc/src/fascicules.xml b/lib/orber/doc/src/fascicules.xml deleted file mode 100644 index 37feca543f..0000000000 --- a/lib/orber/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/orber/doc/src/fixed.xml b/lib/orber/doc/src/fixed.xml index a751476cf7..ef4d1bd604 100644 --- a/lib/orber/doc/src/fixed.xml +++ b/lib/orber/doc/src/fixed.xml @@ -4,8 +4,7 @@ <erlref> <header> <copyright> - <year>2002</year> - <year>2016</year> + <year>2002</year><year>2017</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -38,8 +37,8 @@ <description> <p>This module contains functions that gives an interface to the CORBA fixed type.</p> <p>The type <c>Fixed</c> used below is defined as:</p> - <code type="none"> - -record(fixed, {digits, scale, value}). + <code type="erl"> +-record(fixed, {digits, scale, value}). </code> <p>where <c>digits</c> is the total amount of digits it consists of and <c>scale</c> is the number of fractional digits. The <c>value</c> field diff --git a/lib/orber/doc/src/lname.xml b/lib/orber/doc/src/lname.xml index 09d6859777..c0c9be1a85 100644 --- a/lib/orber/doc/src/lname.xml +++ b/lib/orber/doc/src/lname.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1997</year><year>2016</year> + <year>1997</year><year>2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -44,14 +44,14 @@ the Names are represented as standard Erlang lists and therefor will be removed by the garbage collector when not in use.</p> <p>The type <c>NameComponent</c> used below is defined as:</p> - <code type="none"> - -record('CosNaming_NameComponent', {id, kind=""}). + <code type="erl"> +-record('CosNaming_NameComponent', {id, kind=""}). </code> <p><c>id</c> and <c>kind</c> are strings. </p> <p>The record is defined in the file <c>CosNaming.hrl</c> and it is included with:</p> - <code type="none"> - -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). + <code type="erl"> +-include_lib("orber/COSS/CosNaming/CosNaming.hrl"). </code> </description> <funcs> diff --git a/lib/orber/doc/src/lname_component.xml b/lib/orber/doc/src/lname_component.xml index 631e5d0244..8b8001c0fb 100644 --- a/lib/orber/doc/src/lname_component.xml +++ b/lib/orber/doc/src/lname_component.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1997</year><year>2016</year> + <year>1997</year><year>2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -44,14 +44,14 @@ function because the NameComponents are represented as Erlang records and therefor will be removed by the garbage collector when not in use.</p> <p>The type <c>NameComponent</c> used below is defined as:</p> - <code type="none"> - -record('CosNaming_NameComponent', {id, kind=""}). + <code type="erl"> +-record('CosNaming_NameComponent', {id, kind=""}). </code> <p><c>id</c> and <c>kind</c> are strings. </p> <p>The record is defined in the file <c>CosNaming.hrl</c> and it is included with:</p> - <code type="none"> - -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). + <code type="erl"> +-include_lib("orber/COSS/CosNaming/CosNaming.hrl"). </code> </description> <funcs> diff --git a/lib/orber/doc/src/notes.gif b/lib/orber/doc/src/notes.gif Binary files differdeleted file mode 100644 index e000cca26a..0000000000 --- a/lib/orber/doc/src/notes.gif +++ /dev/null diff --git a/lib/orber/doc/src/notes.xml b/lib/orber/doc/src/notes.xml index 5a82270b28..35da4f73da 100644 --- a/lib/orber/doc/src/notes.xml +++ b/lib/orber/doc/src/notes.xml @@ -33,7 +33,28 @@ <file>notes.xml</file> </header> - <section><title>Orber 3.8.3</title> + <section><title>Orber 3.8.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Removed all old unused files in the documentation. + </p> + <p> + Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p> + </item> + <item> + <p> Removed the man warnings by using the code tag + instead of c tag. </p> + <p> + Own Id: OTP-14673</p> + </item> + </list> + </section> + +</section> + +<section><title>Orber 3.8.3</title> <section><title>Improvements and New Features</title> <list> diff --git a/lib/orber/doc/src/orber.gif b/lib/orber/doc/src/orber.gif Binary files differdeleted file mode 100644 index d78cf7d8ed..0000000000 --- a/lib/orber/doc/src/orber.gif +++ /dev/null diff --git a/lib/orber/doc/src/part_notes.xml b/lib/orber/doc/src/part_notes.xml deleted file mode 100644 index 61d9d4c3b9..0000000000 --- a/lib/orber/doc/src/part_notes.xml +++ /dev/null @@ -1,37 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>1997</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>Orber Release Notes</title> - <prepared>Lars Thorsén, Peter Lundell</prepared> - <docno></docno> - <date>1999-04-20</date> - <rev>2.0</rev> - </header> - <description> - <p>The Orber Application is an Erlang implementation of a CORBA Object - Request Broker.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/orber/doc/src/ref_man.gif b/lib/orber/doc/src/ref_man.gif Binary files differdeleted file mode 100644 index b13c4efd53..0000000000 --- a/lib/orber/doc/src/ref_man.gif +++ /dev/null diff --git a/lib/orber/doc/src/summary.html.src b/lib/orber/doc/src/summary.html.src deleted file mode 100644 index f88ee7218f..0000000000 --- a/lib/orber/doc/src/summary.html.src +++ /dev/null @@ -1 +0,0 @@ -A CORBA Object Request Broker diff --git a/lib/orber/doc/src/user_guide.gif b/lib/orber/doc/src/user_guide.gif Binary files differdeleted file mode 100644 index e6275a803d..0000000000 --- a/lib/orber/doc/src/user_guide.gif +++ /dev/null diff --git a/lib/orber/vsn.mk b/lib/orber/vsn.mk index 595e686cb7..bfd3f283b5 100644 --- a/lib/orber/vsn.mk +++ b/lib/orber/vsn.mk @@ -1 +1 @@ -ORBER_VSN = 3.8.3 +ORBER_VSN = 3.8.4 diff --git a/lib/os_mon/doc/src/Makefile b/lib/os_mon/doc/src/Makefile index 91c7ae7bc3..4aa8879a91 100644 --- a/lib/os_mon/doc/src/Makefile +++ b/lib/os_mon/doc/src/Makefile @@ -1,8 +1,8 @@ # # %CopyrightBegin% -# -# Copyright Ericsson AB 1997-2016. All Rights Reserved. -# +# +# Copyright Ericsson AB 1997-2017. All Rights Reserved. +# # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at @@ -14,7 +14,7 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. -# +# # %CopyrightEnd% # include $(ERL_TOP)/make/target.mk @@ -43,16 +43,14 @@ XML_REF3_FILES = cpu_sup.xml \ os_sup.xml \ nteventlog.xml -XML_REF6_FILES = os_mon_app.xml +XML_REF6_FILES = os_mon_app.xml -XML_PART_FILES = part_notes.xml +XML_PART_FILES = XML_CHAPTER_FILES = notes.xml BOOK_FILES = book.xml -GIF_FILES = \ - note.gif \ - warning.gif +GIF_FILES = XML_FILES = \ $(BOOK_FILES) $(XML_CHAPTER_FILES) \ @@ -74,9 +72,9 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += +XML_FLAGS += # ---------------------------------------------------- # Targets @@ -96,17 +94,17 @@ man: $(MAN3_FILES) $(MAN6_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) -debug opt: +debug opt: clean clean_docs: rm -rf $(HTMLDIR)/* rm -f $(MAN3DIR)/* rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ + rm -f errs core *~ # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs @@ -122,4 +120,3 @@ release_docs_spec: docs $(INSTALL_DATA) $(MAN6DIR)/* "$(RELEASE_PATH)/man/man6" release_spec: - diff --git a/lib/os_mon/doc/src/fascicules.xml b/lib/os_mon/doc/src/fascicules.xml deleted file mode 100644 index fadd37eefb..0000000000 --- a/lib/os_mon/doc/src/fascicules.xml +++ /dev/null @@ -1,15 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/os_mon/doc/src/note.gif b/lib/os_mon/doc/src/note.gif Binary files differdeleted file mode 100644 index 6fffe30419..0000000000 --- a/lib/os_mon/doc/src/note.gif +++ /dev/null diff --git a/lib/os_mon/doc/src/notes.xml b/lib/os_mon/doc/src/notes.xml index b29a64155e..cec0856a8b 100644 --- a/lib/os_mon/doc/src/notes.xml +++ b/lib/os_mon/doc/src/notes.xml @@ -31,6 +31,21 @@ </header> <p>This document describes the changes made to the OS_Mon application.</p> +<section><title>Os_Mon 2.4.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Removed all old unused files in the documentation. + </p> + <p> + Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p> + </item> + </list> + </section> + +</section> + <section><title>Os_Mon 2.4.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/os_mon/doc/src/part_notes.xml b/lib/os_mon/doc/src/part_notes.xml deleted file mode 100644 index 364178acc3..0000000000 --- a/lib/os_mon/doc/src/part_notes.xml +++ /dev/null @@ -1,37 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2004</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>OS_Mon Release Notes</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p>The operating system monitor, OS_Mon, provides services for - monitoring CPU load, disk usage, memory usage and OS messages.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/os_mon/doc/src/user_guide.gif b/lib/os_mon/doc/src/user_guide.gif Binary files differdeleted file mode 100644 index e6275a803d..0000000000 --- a/lib/os_mon/doc/src/user_guide.gif +++ /dev/null diff --git a/lib/os_mon/doc/src/warning.gif b/lib/os_mon/doc/src/warning.gif Binary files differdeleted file mode 100644 index 96af52360e..0000000000 --- a/lib/os_mon/doc/src/warning.gif +++ /dev/null diff --git a/lib/os_mon/src/cpu_sup.erl b/lib/os_mon/src/cpu_sup.erl index e758b63d19..c1c972b5b1 100644 --- a/lib/os_mon/src/cpu_sup.erl +++ b/lib/os_mon/src/cpu_sup.erl @@ -244,7 +244,7 @@ get_uint32_measurement(Request, #internal{os_type = {unix, Sys}}) when Sys == ir %% Get the load average using uptime. %% "8:01pm up 2 days, 22:12, 4 users, load average: 0.70, 0.58, 0.43" D = os:cmd("uptime") -- "\n", - Avg = lists:reverse(hd(string:tokens(lists:reverse(D), ":"))), + Avg = lists:reverse(hd(string:lexemes(lists:reverse(D), ":"))), {ok, [L1, L5, L15], _} = io_lib:fread("~f, ~f, ~f", Avg), case Request of ?avg1 -> sunify(L1); diff --git a/lib/os_mon/src/disksup.erl b/lib/os_mon/src/disksup.erl index 044604b000..aeec335ba7 100644 --- a/lib/os_mon/src/disksup.erl +++ b/lib/os_mon/src/disksup.erl @@ -32,7 +32,7 @@ terminate/2, code_change/3]). %% Other exports --export([format_status/2]). +-export([format_status/2, parse_df/2]). -record(state, {threshold, timeout, os, diskdata = [],port}). @@ -294,8 +294,8 @@ check_disks_solaris("", _Threshold) -> check_disks_solaris("\n", _Threshold) -> []; check_disks_solaris(Str, Threshold) -> - case io_lib:fread("~s~d~d~d~d%~s", Str) of - {ok, [_FS, KB, _Used, _Avail, Cap, MntOn], RestStr} -> + case parse_df(Str, posix) of + {ok, {KB, Cap, MntOn}, RestStr} -> if Cap >= Threshold -> set_alarm({disk_almost_full, MntOn}, []); @@ -308,14 +308,102 @@ check_disks_solaris(Str, Threshold) -> check_disks_solaris(skip_to_eol(Str),Threshold) end. +%% @private +%% @doc Predicate to take a word from the input string until a space or +%% a percent '%' sign (the Capacity field is followed by a %) +parse_df_is_not_space($ ) -> false; +parse_df_is_not_space($%) -> false; +parse_df_is_not_space(_) -> true. + +%% @private +%% @doc Predicate to take spaces away from string. Stops on a non-space +parse_df_is_space($ ) -> true; +parse_df_is_space(_) -> false. + +%% @private +%% @doc Predicate to consume remaining characters until end of line. +parse_df_is_not_eol($\r) -> false; +parse_df_is_not_eol($\n) -> false; +parse_df_is_not_eol(_) -> true. + +%% @private +%% @doc Trims leading non-spaces (the word) from the string then trims spaces. +parse_df_skip_word(Input) -> + Remaining = lists:dropwhile(fun parse_df_is_not_space/1, Input), + lists:dropwhile(fun parse_df_is_space/1, Remaining). + +%% @private +%% @doc Takes all non-spaces and then drops following spaces. +parse_df_take_word(Input) -> + {Word, Remaining0} = lists:splitwith(fun parse_df_is_not_space/1, Input), + Remaining1 = lists:dropwhile(fun parse_df_is_space/1, Remaining0), + {Word, Remaining1}. + +%% @private +%% @doc Takes all non-spaces and then drops the % after it and the spaces. +parse_df_take_word_percent(Input) -> + {Word, Remaining0} = lists:splitwith(fun parse_df_is_not_space/1, Input), + %% Drop the leading % or do nothing + Remaining1 = case Remaining0 of + [$% | R1] -> R1; + _ -> Remaining0 % Might be no % or empty list even + end, + Remaining2 = lists:dropwhile(fun parse_df_is_space/1, Remaining1), + {Word, Remaining2}. + +%% @private +%% @doc Given a line of 'df' POSIX/SUSv3 output split it into fields: +%% a string (mounted device), 4 integers (kilobytes, used, available +%% and capacity), skip % sign, (optionally for susv3 can also skip IUsed, IFree +%% and ICap% fields) then take remaining characters as the mount path +-spec parse_df(string(), posix | susv3) -> + {error, parse_df} | {ok, {integer(), integer(), integer()}, string()}. +parse_df(Input0, Flavor) -> + %% Format of Posix/Linux df output looks like Header + Lines + %% Filesystem 1024-blocks Used Available Capacity Mounted on + %% udev 2467108 0 2467108 0% /dev + Input1 = parse_df_skip_word(Input0), % skip device path field + {KbStr, Input2} = parse_df_take_word(Input1), % take Kb field + Input3 = parse_df_skip_word(Input2), % skip Used field + Input4 = parse_df_skip_word(Input3), % skip Avail field + + % take Capacity% field; drop a % sign following the capacity + {CapacityStr, Input5} = parse_df_take_word_percent(Input4), + + %% Format of OS X/SUSv3 df looks similar to POSIX but has 3 extra columns + %% Filesystem 1024-blocks Used Available Capacity iused ifree %iused Mounted + %% /dev/disk1 243949060 2380 86690680 65% 2029724 37555 0% / + Input6 = case Flavor of + posix -> Input5; + susv3 -> % there are 3 extra integers we want to skip + Input5a = parse_df_skip_word(Input5), % skip IUsed field + Input5b = parse_df_skip_word(Input5a), % skip IFree field + %% skip the value of ICap + '%' field + {_, Input5c} = parse_df_take_word_percent(Input5b), + Input5c + end, + + % path is the remaining string till end of line + {MountPath, Input7} = lists:splitwith(fun parse_df_is_not_eol/1, Input6), + % Trim the newlines + Remaining = lists:dropwhile(fun(X) -> not parse_df_is_not_eol(X) end, + Input7), + try + Kb = erlang:list_to_integer(KbStr), + Capacity = erlang:list_to_integer(CapacityStr), + {ok, {Kb, Capacity, MountPath}, Remaining} + catch error:badarg -> + {error, parse_df} + end. + % Parse per SUSv3 specification, notably recent OS X check_disks_susv3("", _Threshold) -> []; check_disks_susv3("\n", _Threshold) -> []; check_disks_susv3(Str, Threshold) -> - case io_lib:fread("~s~d~d~d~d%~d~d~d%~s", Str) of - {ok, [_FS, KB, _Used, _Avail, Cap, _IUsed, _IFree, _ICap, MntOn], RestStr} -> + case parse_df(Str, susv3) of + {ok, {KB, Cap, MntOn}, RestStr} -> if Cap >= Threshold -> set_alarm({disk_almost_full, MntOn}, []); diff --git a/lib/os_mon/src/memsup.erl b/lib/os_mon/src/memsup.erl index 0a9a883390..95cb798ba5 100644 --- a/lib/os_mon/src/memsup.erl +++ b/lib/os_mon/src/memsup.erl @@ -705,7 +705,7 @@ get_os_wordsize_with_uname() -> _ -> 32 end. -clean_string(String) -> lists:flatten(string:tokens(String,"\r\n\t ")). +clean_string(String) -> lists:flatten(string:lexemes(String,"\r\n\t ")). %%--Replying to pending clients----------------------------------------- diff --git a/lib/os_mon/test/disksup_SUITE.erl b/lib/os_mon/test/disksup_SUITE.erl index ad61985014..d7f2626160 100644 --- a/lib/os_mon/test/disksup_SUITE.erl +++ b/lib/os_mon/test/disksup_SUITE.erl @@ -30,7 +30,7 @@ -export([port/1]). -export([terminate/1, unavailable/1, restart/1]). -export([otp_5910/1]). --export([posix_only/1]). +-export([posix_only/1, parse_df_output_posix/1, parse_df_output_susv3/1]). init_per_suite(Config) when is_list(Config) -> ok = application:start(os_mon), @@ -59,7 +59,8 @@ suite() -> all() -> Bugs = [otp_5910], - Always = [api, config, alarm, port, posix_only, unavailable] ++ Bugs, + Always = [api, config, alarm, port, posix_only, unavailable, + parse_df_output_posix, parse_df_output_susv3] ++ Bugs, case test_server:os_type() of {unix, _OSname} -> Always; {win32, _OSname} -> Always; @@ -413,3 +414,36 @@ get_disk_data([{"none",0,0}=E]) -> [E]; get_disk_data([{_,_,0}|Es]) -> get_disk_data(Es); get_disk_data([E|Es]) -> [E|get_disk_data(Es)]; get_disk_data([]) -> []. + +%% @doc Test various expected inputs to 'df' command output (Linux/POSIX) +parse_df_output_posix(Config) when is_list(Config) -> + PosixHdr = "Filesystem 1K-blocks Used Available Use% Mounted on\n", + {error, _} = disksup:parse_df(PosixHdr, posix), + {error, _} = disksup:parse_df("", posix), + {error, _} = disksup:parse_df("\n\n", posix), + + %% Have a simple example with no funny spaces in mount path + Posix1 = "tmpfs 498048 7288 490760 2% /run\n", + {ok, {498048, 2, "/run"}, ""} = disksup:parse_df(Posix1, posix), + + %% Have a mount path with some spaces in it + Posix2 = "tmpfs 498048 7288 490760 2% /spaces 1 2\n", + {ok, {498048, 2, "/spaces 1 2"}, ""} = disksup:parse_df(Posix2, posix). + +%% @doc Test various expected inputs to 'df' command output (Darwin/SUSv3) +parse_df_output_susv3(Config) when is_list(Config) -> + DarwinHdr = "Filesystem 1024-blocks Used Available Capacity " ++ + "iused ifree %iused Mounted on", + {error, _} = disksup:parse_df(DarwinHdr, susv3), + {error, _} = disksup:parse_df("", susv3), + {error, _} = disksup:parse_df("\n\n", susv3), + + %% Have a simple example with no funny spaces in mount path + Darwin1 = "/dev/disk1 243949060 157002380 86690680 65% 2029724 " ++ + "4292937555 0% /\n", + {ok, {243949060, 65, "/"}, ""} = disksup:parse_df(Darwin1, susv3), + + %% Have a mount path with some spaces in it + Darwin2 = "/dev/disk1 243949060 157002380 86690680 65% 2029724 " ++ + "4292937555 0% /spaces 1 2\n", + {ok, {243949060, 65, "/spaces 1 2"}, ""} = disksup:parse_df(Darwin2, susv3). diff --git a/lib/os_mon/vsn.mk b/lib/os_mon/vsn.mk index e4250f577b..eb4f13ea9e 100644 --- a/lib/os_mon/vsn.mk +++ b/lib/os_mon/vsn.mk @@ -1 +1 @@ -OS_MON_VSN = 2.4.3 +OS_MON_VSN = 2.4.4 diff --git a/lib/otp_mibs/doc/src/Makefile b/lib/otp_mibs/doc/src/Makefile index 62698b9300..c65e2a8e3c 100644 --- a/lib/otp_mibs/doc/src/Makefile +++ b/lib/otp_mibs/doc/src/Makefile @@ -1,8 +1,8 @@ # # %CopyrightBegin% -# -# Copyright Ericsson AB 2003-2016. All Rights Reserved. -# +# +# Copyright Ericsson AB 2003-2017. All Rights Reserved. +# # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at @@ -14,7 +14,7 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. -# +# # %CopyrightEnd% # @@ -38,7 +38,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) XML_APPLICATION_FILES = ref_man.xml XML_REF3_FILES = otp_mib.xml -XML_PART_FILES = part.xml part_notes.xml +XML_PART_FILES = part.xml XML_CHAPTER_FILES = \ introduction.xml \ mibs.xml \ @@ -50,7 +50,7 @@ XML_FILES = \ $(BOOK_FILES) $(XML_CHAPTER_FILES) \ $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_APPLICATION_FILES) -GIF_FILES = note.gif +GIF_FILES = # ---------------------------------------------------- @@ -95,7 +95,7 @@ clean clean_docs: rm -rf $(HTMLDIR)/* rm -f $(MAN3DIR)/* rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ + rm -f errs core *~ # ---------------------------------------------------- # Release Target @@ -113,4 +113,3 @@ release_docs_spec: docs $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" release_spec: - diff --git a/lib/otp_mibs/doc/src/fascicules.xml b/lib/otp_mibs/doc/src/fascicules.xml deleted file mode 100644 index c075478967..0000000000 --- a/lib/otp_mibs/doc/src/fascicules.xml +++ /dev/null @@ -1,19 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - - diff --git a/lib/otp_mibs/doc/src/note.gif b/lib/otp_mibs/doc/src/note.gif Binary files differdeleted file mode 100644 index 6fffe30419..0000000000 --- a/lib/otp_mibs/doc/src/note.gif +++ /dev/null diff --git a/lib/otp_mibs/doc/src/notes.xml b/lib/otp_mibs/doc/src/notes.xml index dbd2f47ffb..c99148a904 100644 --- a/lib/otp_mibs/doc/src/notes.xml +++ b/lib/otp_mibs/doc/src/notes.xml @@ -32,6 +32,21 @@ <p>This document describes the changes made to the OTP_Mibs application.</p> +<section><title>Otp_Mibs 1.1.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Removed all old unused files in the documentation. + </p> + <p> + Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p> + </item> + </list> + </section> + +</section> + <section><title>Otp_Mibs 1.1.1</title> <section><title>Improvements and New Features</title> diff --git a/lib/otp_mibs/doc/src/part_notes.xml b/lib/otp_mibs/doc/src/part_notes.xml deleted file mode 100644 index 5c03d28720..0000000000 --- a/lib/otp_mibs/doc/src/part_notes.xml +++ /dev/null @@ -1,38 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2004</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>OTP_Mibs Release Notes</title> - <prepared>Ingela Anderton Andin</prepared> - <docno></docno> - <date>2004-09-07</date> - <rev></rev> - </header> - <description> - <p>The <em>OTP_Mibs</em> application provides an SNMP management - information base for Erlang nodes.</p> - </description> - <xi:include href="notes.xml"/> -</part> - - diff --git a/lib/otp_mibs/vsn.mk b/lib/otp_mibs/vsn.mk index 7a793007ee..13406cb5b1 100644 --- a/lib/otp_mibs/vsn.mk +++ b/lib/otp_mibs/vsn.mk @@ -1,4 +1,4 @@ -OTP_MIBS_VSN = 1.1.1 +OTP_MIBS_VSN = 1.1.2 # Note: The branch 'otp_mibs' is defunct as of otp_mibs-1.0.4 and # should NOT be used again. diff --git a/lib/parsetools/doc/src/Makefile b/lib/parsetools/doc/src/Makefile index 8b03ed0fc7..e4cd2c0a76 100644 --- a/lib/parsetools/doc/src/Makefile +++ b/lib/parsetools/doc/src/Makefile @@ -1,8 +1,8 @@ # # %CopyrightBegin% -# -# Copyright Ericsson AB 1997-2016. All Rights Reserved. -# +# +# Copyright Ericsson AB 1997-2017. All Rights Reserved. +# # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at @@ -14,7 +14,7 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. -# +# # %CopyrightEnd% # @@ -39,7 +39,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) XML_APPLICATION_FILES = ref_man.xml XML_REF3_FILES = yecc.xml leex.xml -XML_PART_FILES = part_notes.xml +XML_PART_FILES = XML_CHAPTER_FILES = notes.xml BOOK_FILES = book.xml @@ -48,8 +48,7 @@ XML_FILES = \ $(BOOK_FILES) $(XML_CHAPTER_FILES) \ $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_APPLICATION_FILES) -GIF_FILES = \ - note.gif +GIF_FILES = XML_HTML_FILES = \ notes_history.xml @@ -69,10 +68,10 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += +XML_FLAGS += +DVIPS_FLAGS += # ---------------------------------------------------- # Targets @@ -98,11 +97,11 @@ man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) -debug opt: +debug opt: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs @@ -117,4 +116,3 @@ release_docs_spec: docs release_spec: - diff --git a/lib/parsetools/doc/src/fascicules.xml b/lib/parsetools/doc/src/fascicules.xml deleted file mode 100644 index fadd37eefb..0000000000 --- a/lib/parsetools/doc/src/fascicules.xml +++ /dev/null @@ -1,15 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/parsetools/doc/src/note.gif b/lib/parsetools/doc/src/note.gif Binary files differdeleted file mode 100644 index 6fffe30419..0000000000 --- a/lib/parsetools/doc/src/note.gif +++ /dev/null diff --git a/lib/parsetools/doc/src/notes.xml b/lib/parsetools/doc/src/notes.xml index 3fa7169f50..b3370a06ab 100644 --- a/lib/parsetools/doc/src/notes.xml +++ b/lib/parsetools/doc/src/notes.xml @@ -31,6 +31,21 @@ </header> <p>This document describes the changes made to the Parsetools application.</p> +<section><title>Parsetools 2.1.6</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Warnings about unused functions in <c>leexinc.hrl</c> + are suppressed. </p> + <p> + Own Id: OTP-14697</p> + </item> + </list> + </section> + +</section> + <section><title>Parsetools 2.1.5</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/parsetools/doc/src/part_notes.xml b/lib/parsetools/doc/src/part_notes.xml deleted file mode 100644 index 5e0824e839..0000000000 --- a/lib/parsetools/doc/src/part_notes.xml +++ /dev/null @@ -1,44 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>1997</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>PARSETOOLS Release Notes</title> - <prepared>Carl Velin</prepared> - <docno></docno> - <date>1997-04-28</date> - <rev>1.0</rev> - <file>part_notes.sgml</file> - </header> - <description> - <p>The <em>Parsetools</em> application contains utilities for - parsing and scanning. Yecc is an <term id="LALR-1"></term>parser - generator for Erlang, similar to yacc. Yecc takes a <term - id="BNF"></term>grammar definition as input, and produces Erlang - code for a parser as output. Leex is a regular expression based - lexical analyzer generator for Erlang, similar to lex or flex.</p> - <p>There are also release notes for - <seealso marker="notes_history">older versions</seealso>.</p> - </description> - <xi:lude href="notes.xml"/> -</part> - diff --git a/lib/parsetools/doc/src/user_guide.gif b/lib/parsetools/doc/src/user_guide.gif Binary files differdeleted file mode 100644 index e6275a803d..0000000000 --- a/lib/parsetools/doc/src/user_guide.gif +++ /dev/null diff --git a/lib/parsetools/doc/src/warning.gif b/lib/parsetools/doc/src/warning.gif Binary files differdeleted file mode 100644 index 96af52360e..0000000000 --- a/lib/parsetools/doc/src/warning.gif +++ /dev/null diff --git a/lib/parsetools/include/leexinc.hrl b/lib/parsetools/include/leexinc.hrl index b4449607cb..2a74c252ff 100644 --- a/lib/parsetools/include/leexinc.hrl +++ b/lib/parsetools/include/leexinc.hrl @@ -272,6 +272,8 @@ skip_cont(Rest, Line, {skip_token,Push}, Error) -> skip_cont(Rest, Line, {error,_S}, Error) -> skip_tokens(yystate(), Rest, Line, Rest, 0, Line, Error, reject, 0). +-compile({nowarn_unused_function, [yyrev/1, yyrev/2, yypre/2, yysuf/2]}). + yyrev(List) -> lists:reverse(List). yyrev(List, Tail) -> lists:reverse(List, Tail). yypre(List, N) -> lists:sublist(List, N). @@ -282,6 +284,8 @@ yysuf(List, N) -> lists:nthtail(N, List). %% Line has been updated with respect to newlines in the prefix of %% Chars consisting of (TokenLength - AcceptLength) characters. +-compile({nowarn_unused_function, adjust_line/4}). + adjust_line(N, N, _Cs, L) -> L; adjust_line(T, A, [$\n|Cs], L) -> adjust_line(T-1, A, Cs, L-1); diff --git a/lib/parsetools/src/leex.erl b/lib/parsetools/src/leex.erl index e2e7d7359f..8a4a5e8d86 100644 --- a/lib/parsetools/src/leex.erl +++ b/lib/parsetools/src/leex.erl @@ -37,7 +37,6 @@ -import(lists, [member/2,reverse/1,sort/1,delete/2, keysort/2,keydelete/3, map/2,foldl/3,foreach/2,flatmap/2]). --import(string, [substr/2,substr/3,span/2]). -import(ordsets, [is_element/2,add_element/2,union/2]). -import(orddict, [store/3]). @@ -251,10 +250,10 @@ is_filename(T) -> shorten_filename(Name0) -> {ok,Cwd} = file:get_cwd(), - case lists:prefix(Cwd, Name0) of - false -> Name0; - true -> - case lists:nthtail(length(Cwd), Name0) of + case string:prefix(Name0, Cwd) of + nomatch -> Name0; + Rest -> + case unicode:characters_to_list(Rest) of "/"++N -> N; N -> N end @@ -490,12 +489,9 @@ parse_rules_end(_, NextLine, REAs, As, St) -> %% action has been read. Keep track of line number. collect_rule(Ifile, Chars, L0) -> - %% Erlang strings are 1 based, but re 0 :-( - {match,[{St0,Len}|_]} = re:run(Chars, "[^ \t\r\n]+", [unicode]), - St = St0 + 1, - %%io:fwrite("RE = ~p~n", [substr(Chars, St, Len)]), - case collect_action(Ifile, substr(Chars, St+Len), L0, []) of - {ok,[{':',_}|Toks],L1} -> {ok,substr(Chars, St, Len),Toks,L1}; + {RegExp,Rest} = string:take(Chars, " \t\r\n", true), + case collect_action(Ifile, Rest, L0, []) of + {ok,[{':',_}|Toks],L1} -> {ok,RegExp,Toks,L1}; {ok,_,_} -> {error,{L0,leex,bad_rule}}; {eof,L1} -> {error,{L1,leex,bad_rule}}; {error,E,_} -> {error,E} @@ -549,7 +545,7 @@ var_used(Name, Toks) -> parse_rule_regexp(RE0, [{M,Exp}|Ms], St) -> Split= re:split(RE0, "\\{" ++ M ++ "\\}", [{return,list},unicode]), - RE1 = string:join(Split, Exp), + RE1 = lists:append(lists:join(Exp, Split)), parse_rule_regexp(RE1, Ms, St); parse_rule_regexp(RE, [], St) -> %%io:fwrite("RE = ~p~n", [RE]), @@ -589,9 +585,9 @@ nextline(Ifile, L, St) -> eof -> {eof,L}; {error, _} -> add_error({L+1, leex, cannot_parse}, St); Chars -> - case substr(Chars, span(Chars, " \t\n")+1) of - [$%|_Rest] -> nextline(Ifile, L+1, St); - [] -> nextline(Ifile, L+1, St); + case string:take(Chars, " \t\n") of + {_, [$%|_Rest]} -> nextline(Ifile, L+1, St); + {_, []} -> nextline(Ifile, L+1, St); _Other -> {ok,Chars,L+1} end end. @@ -824,7 +820,7 @@ re_char_class(Cs, Cc, _) -> {reverse(Cc),Cs}. % Preserve order %% posix_cc("space" ++ Cs) -> {space,Cs}; %% posix_cc("upper" ++ Cs) -> {upper,Cs}; %% posix_cc("xdigit" ++ Cs) -> {xdigit,Cs}; -%% posix_cc(Cs) -> parse_error({posix_cc,substr(Cs, 1, 5)}). +%% posix_cc(Cs) -> parse_error({posix_cc,string:slice(Cs, 0, 5)}). escape_char($n) -> $\n; % \n = LF escape_char($r) -> $\r; % \r = CR @@ -863,7 +859,7 @@ escape_char(C) -> C. % Pass it straight through %% re_number(Cs, Acc) -> {Acc,Cs}. string_between(Cs1, Cs2) -> - substr(Cs1, 1, length(Cs1)-length(Cs2)). + string:slice(Cs1, 0, string:length(Cs1)-string:length(Cs2)). %% We use standard methods, Thompson's construction and subset %% construction, to create first an NFA and then a DFA from the @@ -1343,7 +1339,7 @@ out_file(Ifile, Ofile, St, DFA, DF, Actions, Code, L) -> eof -> output_file_directive(Ofile, St#leex.ifile, L); {error, _} -> add_error(St#leex.ifile, {L, leex, cannot_parse}, St); Line -> - case substr(Line, 1, 5) of + case string:slice(Line, 0, 5) of "##mod" -> out_module(Ofile, St); "##cod" -> out_erlang_code(Ofile, St, Code, L); "##dfa" -> out_dfa(Ofile, St, DFA, Code, DF, L); @@ -1523,7 +1519,7 @@ prep_out_actions(As) -> Name = list_to_atom(lists:concat([yyaction_,A])), [Chars,Len,Line,_,_] = Vars, Args = [V || V <- [Chars,Len,Line], V =/= "_"], - ArgsChars = string:join(Args, ", "), + ArgsChars = lists:join(", ", Args), {A,Code,Vars,Name,Args,ArgsChars} end, As). diff --git a/lib/parsetools/src/yecc.erl b/lib/parsetools/src/yecc.erl index 36e33b52a4..b4e1cfe5e3 100644 --- a/lib/parsetools/src/yecc.erl +++ b/lib/parsetools/src/yecc.erl @@ -365,10 +365,10 @@ is_filename(T) -> shorten_filename(Name0) -> {ok,Cwd} = file:get_cwd(), - case lists:prefix(Cwd, Name0) of - false -> Name0; - true -> - case lists:nthtail(length(Cwd), Name0) of + case string:prefix(Name0, Cwd) of + nomatch -> Name0; + Rest -> + case unicode:characters_to_list(Rest) of "/"++N -> N; N -> N end @@ -2196,8 +2196,8 @@ output_reduce(St0, State, Terminal, St20; true -> Ns = "Nss", - Tmp = string:join(lists:duplicate(NmbrOfDaughters - 1, "_"), - ","), + Tmp = lists:join(",", + lists:duplicate(NmbrOfDaughters - 1, "_")), fwrite(St20, <<" [~s|Nss] = Ss,\n">>, [Tmp]) end, St40 = case tokens(RuleNmbr, St30) of diff --git a/lib/parsetools/vsn.mk b/lib/parsetools/vsn.mk index 502ca00a47..b6d2ce0cd4 100644 --- a/lib/parsetools/vsn.mk +++ b/lib/parsetools/vsn.mk @@ -1 +1 @@ -PARSETOOLS_VSN = 2.1.5 +PARSETOOLS_VSN = 2.1.6 diff --git a/lib/public_key/doc/src/Makefile b/lib/public_key/doc/src/Makefile index 5bdc5d4159..f5157fe87a 100644 --- a/lib/public_key/doc/src/Makefile +++ b/lib/public_key/doc/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2008-2016. All Rights Reserved. +# Copyright Ericsson AB 2008-2017. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -40,7 +40,7 @@ XML_APPLICATION_FILES = ref_man.xml XML_REF3_FILES = public_key.xml XML_REF6_FILES = public_key_app.xml -XML_PART_FILES = part.xml part_notes.xml +XML_PART_FILES = part.xml XML_CHAPTER_FILES = \ introduction.xml \ public_key_records.xml \ @@ -50,9 +50,9 @@ XML_CHAPTER_FILES = \ BOOK_FILES = book.xml XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \ - $(XML_REF6_FILES) $(XML_PART_FILES) $(XML_CHAPTER_FILES) + $(XML_REF6_FILES) $(XML_PART_FILES) $(XML_CHAPTER_FILES) -GIF_FILES = note.gif +GIF_FILES = # ---------------------------------------------------- diff --git a/lib/public_key/doc/src/fascicules.xml b/lib/public_key/doc/src/fascicules.xml deleted file mode 100644 index 25e7008537..0000000000 --- a/lib/public_key/doc/src/fascicules.xml +++ /dev/null @@ -1,19 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="usersguide" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="release_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - - diff --git a/lib/public_key/doc/src/note.gif b/lib/public_key/doc/src/note.gif Binary files differdeleted file mode 100644 index 6fffe30419..0000000000 --- a/lib/public_key/doc/src/note.gif +++ /dev/null diff --git a/lib/public_key/doc/src/notes.xml b/lib/public_key/doc/src/notes.xml index a4c0194328..11012ee9e5 100644 --- a/lib/public_key/doc/src/notes.xml +++ b/lib/public_key/doc/src/notes.xml @@ -35,6 +35,31 @@ <file>notes.xml</file> </header> +<section><title>Public_Key 1.5.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed a bug in <c>public_key:ssh_encode/2</c> that made + it possible to erroneously encode e.g. an RSA key with + another type e.g. ECDSA in the resulting binary.</p> + <p> + Own Id: OTP-14570 Aux Id: ERIERL-52, OTP-14676 </p> + </item> + <item> + <p> + Corrected handling of parameterized EC keys in + public_key:generate_key/1 so that it will work as + expected instead of causing a runtime error in crypto.</p> + <p> + Own Id: OTP-14620</p> + </item> + </list> + </section> + +</section> + <section><title>Public_Key 1.5.1</title> <section><title>Improvements and New Features</title> diff --git a/lib/public_key/doc/src/part_notes.xml b/lib/public_key/doc/src/part_notes.xml deleted file mode 100644 index 17f06d14f5..0000000000 --- a/lib/public_key/doc/src/part_notes.xml +++ /dev/null @@ -1,39 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2008</year> - <year>2016</year> - <holder>Ericsson AB, All Rights Reserved</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>public_key Release Notes</title> - <prepared>Ingela Anderton Andin</prepared> - <docno></docno> - <date>2008-01-22</date> - <rev></rev> - </header> - <description> - <p></p> - </description> - <xi:include href="notes.xml"/> -</part> - - diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index 3040f2db0d..dea35bc390 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -774,6 +774,7 @@ fun(#'DistributionPoint'{}, #'CertificateList'{}, <func> <name>pkix_test_data(Options) -> Config </name> + <name>pkix_test_data([chain_opts()]) -> [conf_opt()]</name> <fsummary>Creates certificate test data.</fsummary> <type> <v>Options = #{chain_type() := chain_opts()} </v> @@ -781,30 +782,83 @@ fun(#'DistributionPoint'{}, #'CertificateList'{}, <v>chain_type() = server_chain | client_chain </v> - <v>chain_opts() = #{chain_end() := [cert_opt()], - intermediates => [[cert_opt()]]}</v> - <d>A valid chain must have at least a ROOT and a peer cert</d> - - <v>chain_end() = root | peer </v> - + <v>chain_opts() = #{root := [cert_opt()] | root_cert(), + peer := [cert_opt()], + intermediates => [[cert_opt()]]}</v> + <d> + A valid chain must have at least a ROOT and a peer cert. + The root cert can be given either as a cert pre-generated by + <seealso marker="#pkix_test_root_cert-2"> + pkix_test_root_cert/2 + </seealso>, or as root cert generation options. + </d> + <v>root_cert() = #{cert := der_encoded(), key := Key}</v> + <d> + A root certificate generated by + <seealso marker="#pkix_test_root_cert-2"> + pkix_test_root_cert/2 + </seealso>. + </d> <v>cert_opt() = {Key, Value}</v> <d>For available options see <seealso marker="#cert_opt"> cert_opt()</seealso> below.</d> <v>Config = #{server_config := [conf_opt()], client_config := [conf_opt()]}</v> - <v>conf_opt() = {cert, der_encoded()} | {key, der_encoded()} |{cacerts, [der_encoded()]}</v> - <d>This is a subset of the type <seealso marker="ssl:ssl#type-ssloption"> ssl:ssl_option()</seealso> </d> + <v>conf_opt() = {cert, der_encoded()} | {key, PrivateKey} |{cacerts, [der_encoded()]}</v> + <d> + This is a subset of the type + <seealso marker="ssl:ssl#type-ssloption"> ssl:ssl_option()</seealso>. + <c>PrivateKey</c> is what + <seealso marker="#generate_key-1">generate_key/1</seealso> + returns. + </d> </type> <desc> - <p>Creates certificate test data to facilitate automated testing - of applications using X509-certificates often through - SSL/TLS. The test data can be used when you have control - over both the client and the server in a test scenario. + <p> + Creates certificate configuration(s) consisting of certificate + and its private key plus CA certificate bundle, for a client + and a server, intended to facilitate automated testing + of applications using X509-certificates, + often through SSL/TLS. The test data can be used + when you have control over both the client and the server + in a test scenario. + </p> + <p> + When this function is called with a map containing + client and server chain specifications; + it generates both a client and a server certificate chain + where the <c>cacerts</c> + returned for the server contains the root cert the server + should trust and the intermediate certificates the server + should present to connecting clients. + The root cert the server should trust is the one used + as root of the client certificate chain. + Vice versa applies to the <c>cacerts</c> returned for the client. + The root cert(s) can either be pre-generated with + <seealso marker="#pkix_test_root_cert-2"> + pkix_test_root_cert/2 + </seealso>, or if options are specified; it is (they are) + generated. + </p> + <p> + When this function is called with a list of certificate options; + it generates a configuration with just one node certificate + where <c>cacerts</c> contains the root cert + and the intermediate certs that should be presented to a peer. + In this case the same root cert must be used for all peers. + This is useful in for example an Erlang distributed cluster + where any node, towards another node, acts either + as a server or as a client depending on who connects to whom. + The generated certificate contains a subject altname, + which is not needed in a client certificate, + but makes the certificate useful for both roles. + </p> + <p> + The <marker id="cert_opt"/><c>cert_opt()</c> + type consists of the following options: </p> - - <p> The <marker id="cert_opt"/> cert_opt() type consists of the following options: </p> <taglist> <tag> {digest, digest_type()}</tag> <item><p>Hash algorithm to be used for @@ -851,6 +905,36 @@ fun(#'DistributionPoint'{}, #'CertificateList'{}, </desc> </func> + <func> + <name>pkix_test_root_cert(Name, Options) -> RootCert</name> + <fsummary>Generates a test data root cert.</fsummary> + <type> + <v>Name = string()</v> + <d>The root certificate name.</d> + <v>Options = [cert_opt()]</v> + <d> + For available options see + <seealso marker="#cert_opt">cert_opt()</seealso> + under + <seealso marker="#pkix_test_data-1">pkix_test_data/1</seealso>. + </d> + <v>RootCert = #{cert := der_encoded(), key := Key}</v> + <d> + A root certificate and key. The <c>Key</c> is generated by + <seealso marker="#generate_key-1">generate_key/1</seealso>. + </d> + </type> + <desc> + <p> + Generates a root certificate that can be used + in multiple calls to + <seealso marker="#pkix_test_data-1">pkix_test_data/1</seealso> + when you want the same root certificate for + several generated certificates. + </p> + </desc> + </func> + <func> <name>pkix_verify(Cert, Key) -> boolean()</name> <fsummary>Verifies PKIX x.509 certificate signature.</fsummary> @@ -883,8 +967,8 @@ fun(#'DistributionPoint'{}, #'CertificateList'{}, </type> <desc> <p>This function checks that the <i>Presented Identifier</i> (e.g hostname) in a peer certificate - conforms with the Expected Identifier that the client wants to connect to. - This functions is intended to be added as an extra client check to the peer certificate when performing + is in agreement with the <i>Reference Identifier</i> that the client expects to be connected to. + The function is intended to be added as an extra client check of the peer certificate when performing <seealso marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_validation/3</seealso> </p> <p>See <url href="https://tools.ietf.org/html/rfc6125">RFC 6125</url> @@ -897,7 +981,8 @@ fun(#'DistributionPoint'{}, #'CertificateList'{}, <p>The <c>{OtherRefId,term()}</c> is defined by the user and is passed to the <c>match_fun</c>, if defined. If that term is a binary, it will be converted to a string. </p> - <p>The <c>ip</c> takes a 4-tuple or a + <p>The <c>ip</c> Reference ID takes an <seealso marker="inet:inet#type-ip_address">inet:ip_address()</seealso> + or an ip address in string format (E.g "10.0.1.1" or "1234::5678:9012") as second element. </p> </desc> </func> diff --git a/lib/public_key/doc/src/public_key_records.xml b/lib/public_key/doc/src/public_key_records.xml index 739310c88b..9ebdbb244d 100644 --- a/lib/public_key/doc/src/public_key_records.xml +++ b/lib/public_key/doc/src/public_key_records.xml @@ -70,10 +70,10 @@ <p><c>| {dNSName, string()}</c></p> <p><c>| {x400Address, string()}</c></p> <p><c>| {directoryName, {rdnSequence, [#AttributeTypeAndValue'{}]}}</c></p> - <p><c>| {eidPartyName, special_string()}</c></p> - <p><c>| {eidPartyName, special_string(), special_string()}</c></p> + <p><c>| {ediPartyName, special_string()}</c></p> + <p><c>| {ediPartyName, special_string(), special_string()}</c></p> <p><c>| {uniformResourceIdentifier, string()}</c></p> - <p><c>| {ipAddress, string()}</c></p> + <p><c>| {iPAddress, string()}</c></p> <p><c>| {registeredId, oid()}</c></p> <p><c>| {otherName, term()}</c></p> </item> diff --git a/lib/public_key/src/pubkey_cert.erl b/lib/public_key/src/pubkey_cert.erl index 76fd0f8133..c433a96585 100644 --- a/lib/public_key/src/pubkey_cert.erl +++ b/lib/public_key/src/pubkey_cert.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2016. All Rights Reserved. +%% Copyright Ericsson AB 2008-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -33,11 +33,12 @@ is_fixed_dh_cert/1, verify_data/1, verify_fun/4, select_extension/2, match_name/3, extensions_list/1, cert_auth_key_id/1, time_str_2_gregorian_sec/1, - gen_test_certs/1]). + gen_test_certs/1, root_cert/2]). -define(NULL, 0). --export_type([chain_opts/0, test_config/0]). +-export_type([cert_opt/0, chain_opts/0, conf_opt/0, + test_config/0, test_root_cert/0]). -type cert_opt() :: {digest, public_key:digest_type()} | {key, public_key:key_params() | public_key:private_key()} | @@ -46,9 +47,12 @@ -type chain_end() :: root | peer. -type chain_opts() :: #{chain_end() := [cert_opt()], intermediates => [[cert_opt()]]}. -type conf_opt() :: {cert, public_key:der_encoded()} | - {key, public_key:der_encoded()} | + {key, public_key:private_key()} | {cacerts, [public_key:der_encoded()]}. --type test_config() :: #{server_config := [conf_opt()], client_config := [conf_opt()]}. +-type test_config() :: + #{server_config := [conf_opt()], client_config := [conf_opt()]}. +-type test_root_cert() :: + #{cert := binary(), key := public_key:private_key()}. %%==================================================================== %% Internal application APIu %%==================================================================== @@ -430,31 +434,94 @@ match_name(Fun, Name, PermittedName, [Head | Tail]) -> false -> match_name(Fun, Name, Head, Tail) end. + %%% --spec gen_test_certs(#{server_chain:= chain_opts(), client_chain:= chain_opts()}) -> test_config(). - -%% Generates server and and client configuration for testing +-spec gen_test_certs(#{server_chain:= chain_opts(), + client_chain:= chain_opts()} | + chain_opts()) -> + test_config() | + [conf_opt()]. +%% +%% Generates server and and client configuration for testing %% purposes. All certificate options have default values -gen_test_certs(#{client_chain := #{root := ClientRootConf, - intermediates := ClientCAs, - peer := ClientPeer}, - server_chain := - #{root := ServerRootConf, - intermediates := ServerCAs, - peer := ServerPeer}}) -> - SRootKey = gen_key(proplists:get_value(key, ServerRootConf, default_key_gen())), - CRootKey = gen_key(proplists:get_value(key, ClientRootConf, default_key_gen())), - ServerRoot = root_cert("server", SRootKey, ClientRootConf), - ClientRoot = root_cert("client", CRootKey, ServerRootConf), - - [{ServerDERCert, ServerDERKey} | ServerCAsKeys] = config(server, ServerRoot, - SRootKey, lists:reverse([ServerPeer | lists:reverse(ServerCAs)])), - [{ClientDERCert, ClientDERKey} | ClientCAsKeys] = config(client, ClientRoot, - CRootKey, lists:reverse([ClientPeer | lists:reverse(ClientCAs)])), - ServerDERCA = ca_config(ClientRoot, ServerCAsKeys), - ClientDERCA = ca_config(ServerRoot, ClientCAsKeys), - #{server_config => [{cert, ServerDERCert}, {key, ServerDERKey}, {cacerts, ServerDERCA}], - client_config => [{cert, ClientDERCert}, {key, ClientDERKey}, {cacerts, ClientDERCA}]}. +gen_test_certs( + #{client_chain := + #{root := ClientRoot, + intermediates := ClientCAs, + peer := ClientPeer}, + server_chain := + #{root := ServerRoot, + intermediates := ServerCAs, + peer := ServerPeer}}) -> + #{cert := ServerRootCert, key := ServerRootKey} = + case ServerRoot of + #{} -> + ServerRoot; + ServerRootConf when is_list(ServerRootConf) -> + root_cert("SERVER ROOT CA", ServerRootConf) + end, + #{cert := ClientRootCert, key := ClientRootKey} = + case ClientRoot of + #{} -> + ClientRoot; + ClientRootConf when is_list(ClientRootConf) -> + root_cert("CLIENT ROOT CA", ClientRootConf) + end, + [{ServerDERCert, ServerDERKey} | ServerCAsKeys] = + config( + server, ServerRootCert, ServerRootKey, + lists:reverse([ServerPeer | lists:reverse(ServerCAs)])), + [{ClientDERCert, ClientDERKey} | ClientCAsKeys] = + config( + client, ClientRootCert, ClientRootKey, + lists:reverse([ClientPeer | lists:reverse(ClientCAs)])), + ServerDERCA = ca_config(ClientRootCert, ServerCAsKeys), + ClientDERCA = ca_config(ServerRootCert, ClientCAsKeys), + #{server_config => + [{cert, ServerDERCert}, {key, ServerDERKey}, + {cacerts, ServerDERCA}], + client_config => + [{cert, ClientDERCert}, {key, ClientDERKey}, + {cacerts, ClientDERCA}]}; +%% +%% Generates a node configuration for testing purposes, +%% when using the node server cert also for the client. +%% All certificate options have default values +gen_test_certs( + #{root := Root, intermediates := CAs, peer := Peer}) -> + #{cert := RootCert, key := RootKey} = + case Root of + #{} -> + Root; + RootConf when is_list(RootConf) -> + root_cert("SERVER ROOT CA", RootConf) + end, + [{DERCert, DERKey} | CAsKeys] = + config( + server, RootCert, RootKey, + lists:reverse([Peer | lists:reverse(CAs)])), + DERCAs = ca_config(RootCert, CAsKeys), + [{cert, DERCert}, {key, DERKey}, {cacerts, DERCAs}]. + +%%% +-spec root_cert(string(), [cert_opt()]) -> test_root_cert(). +%% +%% Generate a self-signed root cert +root_cert(Name, Opts) -> + PrivKey = gen_key(proplists:get_value(key, Opts, default_key_gen())), + TBS = cert_template(), + Issuer = subject("root", Name), + OTPTBS = + TBS#'OTPTBSCertificate'{ + signature = sign_algorithm(PrivKey, Opts), + issuer = Issuer, + validity = validity(Opts), + subject = Issuer, + subjectPublicKeyInfo = public_key(PrivKey), + extensions = extensions(undefined, ca, Opts) + }, + #{cert => public_key:pkix_sign(OTPTBS, PrivKey), + key => PrivKey}. %%-------------------------------------------------------------------- %%% Internal functions @@ -1103,7 +1170,7 @@ missing_basic_constraints(OtpCert, SelfSigned, ValidationState, VerifyFun, UserS UserState} end. - gen_key(KeyGen) -> +gen_key(KeyGen) -> case is_key(KeyGen) of true -> KeyGen; @@ -1120,28 +1187,14 @@ is_key(#'ECPrivateKey'{}) -> is_key(_) -> false. -root_cert(Role, PrivKey, Opts) -> - TBS = cert_template(), - Issuer = issuer("root", Role, " ROOT CA"), - OTPTBS = TBS#'OTPTBSCertificate'{ - signature = sign_algorithm(PrivKey, Opts), - issuer = Issuer, - validity = validity(Opts), - subject = Issuer, - subjectPublicKeyInfo = public_key(PrivKey), - extensions = extensions(Role, ca, Opts) - }, - public_key:pkix_sign(OTPTBS, PrivKey). cert_template() -> #'OTPTBSCertificate'{ version = v3, - serialNumber = trunc(rand:uniform()*100000000)*10000 + 1, + serialNumber = erlang:unique_integer([positive, monotonic]), issuerUniqueID = asn1_NOVALUE, subjectUniqueID = asn1_NOVALUE }. -issuer(Contact, Role, Name) -> - subject(Contact, Role ++ Name). subject(Contact, Name) -> Opts = [{email, Contact ++ "@example.org"}, @@ -1176,9 +1229,11 @@ validity(Opts) -> DefFrom0 = calendar:gregorian_days_to_date(calendar:date_to_gregorian_days(date())-1), DefTo0 = calendar:gregorian_days_to_date(calendar:date_to_gregorian_days(date())+7), {DefFrom, DefTo} = proplists:get_value(validity, Opts, {DefFrom0, DefTo0}), - Format = fun({Y,M,D}) -> - lists:flatten(io_lib:format("~w~2..0w~2..0w000000Z",[Y,M,D])) - end, + Format = + fun({Y,M,D}) -> + lists:flatten( + io_lib:format("~4..0w~2..0w~2..0w000000Z",[Y,M,D])) + end, #'Validity'{notBefore={generalTime, Format(DefFrom)}, notAfter ={generalTime, Format(DefTo)}}. @@ -1240,7 +1295,6 @@ cert(Role, #'OTPCertificate'{tbsCertificate = #'OTPTBSCertificate'{subject = Iss subject = subject(Contact, atom_to_list(Role) ++ Name), subjectPublicKeyInfo = public_key(Key), extensions = extensions(Role, Type, Opts) - }, public_key:pkix_sign(OTPTBS, PrivKey). @@ -1297,7 +1351,7 @@ add_default_extensions(server, peer, Exts) -> ], add_default_extensions(Default, Exts); -add_default_extensions(_, peer, Exts) -> +add_default_extensions(client, peer, Exts) -> Exts. add_default_extensions(Defaults0, Exts) -> diff --git a/lib/public_key/src/pubkey_pbe.erl b/lib/public_key/src/pubkey_pbe.erl index 0243bcaa82..e89e16f120 100644 --- a/lib/public_key/src/pubkey_pbe.erl +++ b/lib/public_key/src/pubkey_pbe.erl @@ -222,7 +222,8 @@ pbe_pad(Data, {#'PBEParameter'{}, _}) -> pbe_pad(Data, #'PBES2-params'{}) -> pbe_pad(Data); pbe_pad(Data, _) -> - Data. +pbe_pad(Data).%% Data. + pbe_pad(Data) -> N = 8 - (erlang:byte_size(Data) rem 8), diff --git a/lib/public_key/src/pubkey_ssh.erl b/lib/public_key/src/pubkey_ssh.erl index 75c1880655..02c061efc9 100644 --- a/lib/public_key/src/pubkey_ssh.erl +++ b/lib/public_key/src/pubkey_ssh.erl @@ -29,7 +29,17 @@ ]). -define(UINT32(X), X:32/unsigned-big-integer). --define(STRING(X), ?UINT32((size(X))), (X)/binary). +-define(STRING(X), ?UINT32((byte_size(X))), (X)/binary). + +-define(DEC_BIN(X,Len), ?UINT32(Len), X:Len/binary ). +-define(DEC_MPINT(I,Len), ?DEC_INT(I,Len) ). +-define(DEC_INT(I,Len), ?UINT32(Len), I:Len/big-signed-integer-unit:8 ). + +-define(Empint(X), (mpint(X))/binary ). +-define(Estring(X), (string(X))/binary ). + +-define(b64enc(X), base64:encode(iolist_to_binary(X)) ). +-define(b64mime_dec(X), base64:mime_decode(iolist_to_binary(X)) ). %% Max encoded line length is 72, but conformance examples use 68 %% Comment from rfc 4716: "The following are some examples of public @@ -47,12 +57,12 @@ %% Description: Decodes a ssh file-binary. %%-------------------------------------------------------------------- decode(Bin, public_key)-> - case binary:match(Bin, begin_marker()) of - nomatch -> - openssh_decode(Bin, openssh_public_key); - _ -> - rfc4716_decode(Bin) - end; + PKtype = + case binary:match(Bin, begin_marker()) of + nomatch -> openssh_public_key; + _ -> rfc4716_public_key + end, + decode(Bin, PKtype); decode(Bin, rfc4716_public_key) -> rfc4716_decode(Bin); decode(Bin, ssh2_pubkey) -> @@ -155,7 +165,7 @@ rfc4716_decode_line(Line, Lines, Acc) -> rfc4716_decode_lines(Lines, [{string_decode(Tag), unicode_decode(Value)} | Acc]); _ -> {Body, Rest} = join_entry([Line | Lines], []), - {lists:reverse(Acc), rfc4716_pubkey_decode(base64:mime_decode(Body)), Rest} + {lists:reverse(Acc), rfc4716_pubkey_decode(?b64mime_dec(Body)), Rest} end. join_entry([<<"---- END SSH2 PUBLIC KEY ----", _/binary>>| Lines], Entry) -> @@ -164,26 +174,8 @@ join_entry([Line | Lines], Entry) -> join_entry(Lines, [Line | Entry]). -rfc4716_pubkey_decode(<<?UINT32(Len), Type:Len/binary, - ?UINT32(SizeE), E:SizeE/binary, - ?UINT32(SizeN), N:SizeN/binary>>) when Type == <<"ssh-rsa">> -> - #'RSAPublicKey'{modulus = erlint(SizeN, N), - publicExponent = erlint(SizeE, E)}; - -rfc4716_pubkey_decode(<<?UINT32(Len), Type:Len/binary, - ?UINT32(SizeP), P:SizeP/binary, - ?UINT32(SizeQ), Q:SizeQ/binary, - ?UINT32(SizeG), G:SizeG/binary, - ?UINT32(SizeY), Y:SizeY/binary>>) when Type == <<"ssh-dss">> -> - {erlint(SizeY, Y), - #'Dss-Parms'{p = erlint(SizeP, P), - q = erlint(SizeQ, Q), - g = erlint(SizeG, G)}}; -rfc4716_pubkey_decode(<<?UINT32(Len), ECDSA_SHA2_etc:Len/binary, - ?UINT32(SizeId), Id:SizeId/binary, - ?UINT32(SizeQ), Q:SizeQ/binary>>) -> - <<"ecdsa-sha2-", Id/binary>> = ECDSA_SHA2_etc, - {#'ECPoint'{point = Q}, {namedCurve,public_key:ssh_curvename2oid(Id)}}. +rfc4716_pubkey_decode(BinKey) -> ssh2_pubkey_decode(BinKey). + openssh_decode(Bin, FileType) -> Lines = binary:split(Bin, <<"\n">>, [global]), @@ -267,18 +259,14 @@ decode_comment(Comment) -> openssh_pubkey_decode(Type, Base64Enc) -> try - ssh2_pubkey_decode(Type, base64:mime_decode(Base64Enc)) + <<?DEC_BIN(Type,_TL), Bin/binary>> = ?b64mime_dec(Base64Enc), + ssh2_pubkey_decode(Type, Bin) catch _:_ -> - {Type, base64:mime_decode(Base64Enc)} + {Type, ?b64mime_dec(Base64Enc)} end. -erlint(MPIntSize, MPIntValue) -> - Bits= MPIntSize * 8, - <<Integer:Bits/integer>> = MPIntValue, - Integer. - ssh1_rsa_pubkey_decode(MBin, EBin) -> #'RSAPublicKey'{modulus = integer_decode(MBin), publicExponent = integer_decode(EBin)}. @@ -306,12 +294,12 @@ do_encode(Type, Key, Attributes) -> rfc4716_encode(Key, [],[]) -> iolist_to_binary([begin_marker(),"\n", - split_lines(base64:encode(ssh2_pubkey_encode(Key))), + split_lines(?b64enc(ssh2_pubkey_encode(Key))), "\n", end_marker(), "\n"]); rfc4716_encode(Key, [], [_|_] = Acc) -> iolist_to_binary([begin_marker(), "\n", lists:reverse(Acc), - split_lines(base64:encode(ssh2_pubkey_encode(Key))), + split_lines(?b64enc(ssh2_pubkey_encode(Key))), "\n", end_marker(), "\n"]); rfc4716_encode(Key, [ Header | Headers], Acc) -> LinesStr = rfc4716_encode_header(Header), @@ -340,7 +328,7 @@ rfc4716_encode_value(Value) -> openssh_encode(openssh_public_key, Key, Attributes) -> Comment = proplists:get_value(comment, Attributes, ""), - Enc = base64:encode(ssh2_pubkey_encode(Key)), + Enc = ?b64enc(ssh2_pubkey_encode(Key)), iolist_to_binary([key_type(Key), " ", Enc, " ", Comment, "\n"]); openssh_encode(auth_keys, Key, Attributes) -> @@ -365,10 +353,10 @@ openssh_encode(known_hosts, Key, Attributes) -> end. openssh_ssh2_auth_keys_encode(undefined, Key, Comment) -> - iolist_to_binary([key_type(Key)," ", base64:encode(ssh2_pubkey_encode(Key)), line_end(Comment)]); + iolist_to_binary([key_type(Key)," ", ?b64enc(ssh2_pubkey_encode(Key)), line_end(Comment)]); openssh_ssh2_auth_keys_encode(Options, Key, Comment) -> iolist_to_binary([comma_list_encode(Options, []), " ", - key_type(Key)," ", base64:encode(ssh2_pubkey_encode(Key)), line_end(Comment)]). + key_type(Key)," ", ?b64enc(ssh2_pubkey_encode(Key)), line_end(Comment)]). openssh_ssh1_auth_keys_encode(undefined, Bits, #'RSAPublicKey'{modulus = N, publicExponent = E}, @@ -383,7 +371,7 @@ openssh_ssh1_auth_keys_encode(Options, Bits, openssh_ssh2_know_hosts_encode(Hostnames, Key, Comment) -> iolist_to_binary([comma_list_encode(Hostnames, []), " ", - key_type(Key)," ", base64:encode(ssh2_pubkey_encode(Key)), line_end(Comment)]). + key_type(Key)," ", ?b64enc(ssh2_pubkey_encode(Key)), line_end(Comment)]). openssh_ssh1_known_hosts_encode(Hostnames, Bits, #'RSAPublicKey'{modulus = N, publicExponent = E}, @@ -411,71 +399,37 @@ comma_list_encode([Option | Rest], Acc) -> ssh2_pubkey_encode(#'RSAPublicKey'{modulus = N, publicExponent = E}) -> - ssh2_pubkey_encode({#'RSAPublicKey'{modulus = N, publicExponent = E}, 'ssh-rsa'}); - -ssh2_pubkey_encode({Key, 'rsa-sha2-256'}) -> ssh2_pubkey_encode({Key, 'ssh-rsa'}); -ssh2_pubkey_encode({Key, 'rsa-sha2-512'}) -> ssh2_pubkey_encode({Key, 'ssh-rsa'}); -ssh2_pubkey_encode({#'RSAPublicKey'{modulus = N, publicExponent = E}, SignAlg}) -> - SignAlgName = list_to_binary(atom_to_list(SignAlg)), - StrLen = size(SignAlgName), - EBin = mpint(E), - NBin = mpint(N), - <<?UINT32(StrLen), SignAlgName:StrLen/binary, - EBin/binary, - NBin/binary>>; -ssh2_pubkey_encode({{_,#'Dss-Parms'{}}=Key, _}) -> - ssh2_pubkey_encode(Key); + <<?STRING(<<"ssh-rsa">>), ?Empint(E), ?Empint(N)>>; ssh2_pubkey_encode({Y, #'Dss-Parms'{p = P, q = Q, g = G}}) -> - TypeStr = <<"ssh-dss">>, - StrLen = size(TypeStr), - PBin = mpint(P), - QBin = mpint(Q), - GBin = mpint(G), - YBin = mpint(Y), - <<?UINT32(StrLen), TypeStr:StrLen/binary, - PBin/binary, - QBin/binary, - GBin/binary, - YBin/binary>>; -ssh2_pubkey_encode({{#'ECPoint'{},_}=Key, _}) -> - ssh2_pubkey_encode(Key); + <<?STRING(<<"ssh-dss">>), ?Empint(P), ?Empint(Q), ?Empint(G), ?Empint(Y)>>; ssh2_pubkey_encode(Key={#'ECPoint'{point = Q}, {namedCurve,OID}}) -> - TypeStr = key_type(Key), - StrLen = size(TypeStr), - IdB = public_key:oid2ssh_curvename(OID), - <<?UINT32(StrLen), TypeStr:StrLen/binary, - (string(IdB))/binary, - (string(Q))/binary>>. + Curve = public_key:oid2ssh_curvename(OID), + <<?STRING(key_type(Key)), ?Estring(Curve), ?Estring(Q)>>. -ssh2_pubkey_decode(Bin = <<?UINT32(Len), Type:Len/binary, _/binary>>) -> +ssh2_pubkey_decode(<<?DEC_BIN(Type,_TL), Bin/binary>>) -> ssh2_pubkey_decode(Type, Bin). -ssh2_pubkey_decode(<<"rsa-sha2-256">>, Bin) -> ssh2_pubkey_decode(<<"ssh-rsa">>, Bin); -ssh2_pubkey_decode(<<"rsa-sha2-512">>, Bin) -> ssh2_pubkey_decode(<<"ssh-rsa">>, Bin); +%% ssh2_pubkey_decode(<<"rsa-sha2-256">>, Bin) -> ssh2_pubkey_decode(<<"ssh-rsa">>, Bin); +%% ssh2_pubkey_decode(<<"rsa-sha2-512">>, Bin) -> ssh2_pubkey_decode(<<"ssh-rsa">>, Bin); ssh2_pubkey_decode(<<"ssh-rsa">>, - <<?UINT32(Len), _:Len/binary, - ?UINT32(SizeE), E:SizeE/binary, - ?UINT32(SizeN), N:SizeN/binary>>) -> - #'RSAPublicKey'{modulus = erlint(SizeN, N), - publicExponent = erlint(SizeE, E)}; + <<?DEC_INT(E, _EL), + ?DEC_INT(N, _NL)>>) -> + #'RSAPublicKey'{modulus = N, + publicExponent = E}; ssh2_pubkey_decode(<<"ssh-dss">>, - <<?UINT32(Len), _:Len/binary, - ?UINT32(SizeP), P:SizeP/binary, - ?UINT32(SizeQ), Q:SizeQ/binary, - ?UINT32(SizeG), G:SizeG/binary, - ?UINT32(SizeY), Y:SizeY/binary>>) -> - {erlint(SizeY, Y), - #'Dss-Parms'{p = erlint(SizeP, P), - q = erlint(SizeQ, Q), - g = erlint(SizeG, G)}}; + <<?DEC_INT(P, _PL), + ?DEC_INT(Q, _QL), + ?DEC_INT(G, _GL), + ?DEC_INT(Y, _YL)>>) -> + {Y, #'Dss-Parms'{p = P, + q = Q, + g = G}}; ssh2_pubkey_decode(<<"ecdsa-sha2-",Id/binary>>, - <<?UINT32(Len), ECDSA_SHA2_etc:Len/binary, - ?UINT32(SizeId), Id:SizeId/binary, - ?UINT32(SizeQ), Q:SizeQ/binary>>) -> - <<"ecdsa-sha2-", Id/binary>> = ECDSA_SHA2_etc, + <<?DEC_BIN(Id, _IL), + ?DEC_BIN(Q, _QL)>>) -> {#'ECPoint'{point = Q}, {namedCurve,public_key:ssh_curvename2oid(Id)}}. @@ -575,17 +529,16 @@ mpint(X) -> mpint_pos(X). mpint_neg(X) -> Bin = int_to_bin_neg(X, []), - Sz = byte_size(Bin), - <<?UINT32(Sz), Bin/binary>>. + <<?STRING(Bin)>>. mpint_pos(X) -> Bin = int_to_bin_pos(X, []), <<MSB,_/binary>> = Bin, - Sz = byte_size(Bin), if MSB band 16#80 == 16#80 -> - <<?UINT32((Sz+1)), 0, Bin/binary>>; + B = << 0, Bin/binary>>, + <<?STRING(B)>>; true -> - <<?UINT32(Sz), Bin/binary>> + <<?STRING(Bin)>> end. int_to_bin_pos(0,Ds=[_|_]) -> @@ -602,7 +555,8 @@ int_to_bin_neg(X,Ds) -> string(X) when is_binary(X) -> << ?STRING(X) >>; string(X) -> - << ?STRING(list_to_binary(X)) >>. + B = list_to_binary(X), + << ?STRING(B) >>. is_ssh_curvename(Id) -> try public_key:ssh_curvename2oid(Id) of _ -> true catch _:_ -> false diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index 31cb1fff3c..034126655c 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -59,7 +59,8 @@ pkix_crl_verify/2, pkix_crl_issuer/1, short_name_hash/1, - pkix_test_data/1 + pkix_test_data/1, + pkix_test_root_cert/2 ]). -export_type([public_key/0, private_key/0, pem_entry/0, @@ -942,7 +943,6 @@ ssh_decode(SshBin, Type) when is_binary(SshBin), %%-------------------------------------------------------------------- -spec ssh_encode([{public_key(), Attributes::list()}], ssh_file()) -> binary() ; (public_key(), ssh2_pubkey) -> binary() - ; ({public_key(),atom()}, ssh2_pubkey) -> binary() . %% %% Description: Encodes a list of ssh file entries (public keys and @@ -1034,10 +1034,12 @@ short_name_hash({rdnSequence, _Attributes} = Name) -> %%-------------------------------------------------------------------- --spec pkix_test_data(#{chain_type() := pubkey_cert:chain_opts()}) -> - pubkey_cert:test_config(). +-spec pkix_test_data(#{chain_type() := pubkey_cert:chain_opts()} | + pubkey_cert:chain_opts()) -> + pubkey_cert:test_config() | + [pubkey_cert:conf_opt()]. -%% Description: Generates OpenSSL-style hash of a name. +%% Description: Generates cert(s) and ssl configuration %%-------------------------------------------------------------------- pkix_test_data(#{client_chain := ClientChain0, @@ -1046,7 +1048,21 @@ pkix_test_data(#{client_chain := ClientChain0, ClientChain = maps:merge(Default, ClientChain0), ServerChain = maps:merge(Default, ServerChain0), pubkey_cert:gen_test_certs(#{client_chain => ClientChain, - server_chain => ServerChain}). + server_chain => ServerChain}); +pkix_test_data(#{} = Chain) -> + Default = #{intermediates => []}, + pubkey_cert:gen_test_certs(maps:merge(Default, Chain)). + +%%-------------------------------------------------------------------- +-spec pkix_test_root_cert( + Name :: string(), Opts :: [pubkey_cert:cert_opt()]) -> + pubkey_cert:test_root_cert(). + +%% Description: Generates a root cert suitable for pkix_test_data/1 +%%-------------------------------------------------------------------- + +pkix_test_root_cert(Name, Opts) -> + pubkey_cert:root_cert(Name, Opts). %%-------------------------------------------------------------------- %%% Internal functions @@ -1324,9 +1340,9 @@ ec_normalize_params(#'ECParameters'{} = ECParams) -> ec_normalize_params(Other) -> Other. -spec ec_curve_spec(ecpk_parameters_api()) -> term(). -ec_curve_spec( #'ECParameters'{fieldID = FieldId, curve = PCurve, base = Base, order = Order, cofactor = CoFactor }) -> - Field = {pubkey_cert_records:supportedCurvesTypes(FieldId#'FieldID'.fieldType), - FieldId#'FieldID'.parameters}, +ec_curve_spec( #'ECParameters'{fieldID = #'FieldID'{fieldType = Type, + parameters = Params}, curve = PCurve, base = Base, order = Order, cofactor = CoFactor }) -> + Field = format_field(pubkey_cert_records:supportedCurvesTypes(Type), Params), Curve = {PCurve#'Curve'.a, PCurve#'Curve'.b, none}, {Field, Curve, Base, Order, CoFactor}; ec_curve_spec({ecParameters, ECParams}) -> @@ -1336,6 +1352,26 @@ ec_curve_spec({namedCurve, OID}) when is_tuple(OID), is_integer(element(1,OID)) ec_curve_spec({namedCurve, Name}) when is_atom(Name) -> crypto:ec_curve(Name). +format_field(characteristic_two_field = Type, Params0) -> + #'Characteristic-two'{ + m = M, + basis = BasisOid, + parameters = Params} = der_decode('Characteristic-two', Params0), + {Type, M, field_param_decode(BasisOid, Params)}; +format_field(prime_field, Params0) -> + Prime = der_decode('Prime-p', Params0), + {prime_field, Prime}. + +field_param_decode(?'ppBasis', Params) -> + #'Pentanomial'{k1 = K1, k2 = K2, k3 = K3} = + der_decode('Pentanomial', Params), + {ppbasis, K1, K2, K3}; +field_param_decode(?'tpBasis', Params) -> + K = der_decode('Trinomial', Params), + {tpbasis, K}; +field_param_decode(?'gnBasis', _) -> + onbasis. + -spec ec_key({PubKey::term(), PrivateKey::term()}, Params::ecpk_parameters()) -> #'ECPrivateKey'{}. ec_key({PubKey, PrivateKey}, Params) -> #'ECPrivateKey'{version = 1, @@ -1529,6 +1565,8 @@ verify_hostname_match_loop(Refs, Pres, MatchFun, FailCB, Cert) -> Refs). +to_lower_ascii({ip,_}=X) -> X; +to_lower_ascii({iPAddress,_}=X) -> X; to_lower_ascii(S) when is_list(S) -> lists:map(fun to_lower_ascii/1, S); to_lower_ascii({T,S}) -> {T, to_lower_ascii(S)}; to_lower_ascii(C) when $A =< C,C =< $Z -> C + ($a-$A); diff --git a/lib/public_key/test/public_key_SUITE.erl b/lib/public_key/test/public_key_SUITE.erl index 0077c7908c..449d1fc040 100644 --- a/lib/public_key/test/public_key_SUITE.erl +++ b/lib/public_key/test/public_key_SUITE.erl @@ -64,7 +64,9 @@ all() -> groups() -> [{pem_decode_encode, [], [dsa_pem, rsa_pem, ec_pem, encrypted_pem, dh_pem, cert_pem, pkcs7_pem, pkcs10_pem, ec_pem2, - ec_pem_encode_generated]}, + ec_pem_encode_generated, + gen_ec_param_prime_field, gen_ec_param_char_2_field + ]}, {ssh_public_key_decode_encode, [], [ssh_rsa_public_key, ssh_dsa_public_key, ssh_ecdsa_public_key, ssh_rfc4716_rsa_comment, ssh_rfc4716_dsa_comment, @@ -102,8 +104,15 @@ init_per_testcase(pkix_test_data_all_default, Config) -> [] -> {skip, missing_ecc_support}; _ -> - init_common_per_testcase(Config) + init_common_per_testcase(Config) end; + +init_per_testcase(gen_ec_param_prime_field=TC, Config) -> + init_per_testcase_gen_ec_param(TC, secp521r1, Config); + +init_per_testcase(gen_ec_param_char_2_field=TC, Config) -> + init_per_testcase_gen_ec_param(TC, sect571r1, Config); + init_per_testcase(TestCase, Config) -> case TestCase of ssh_hostkey_fingerprint_md5_implicit -> init_fingerprint_testcase([md5], Config); @@ -991,7 +1000,7 @@ pkix_verify_hostname_options(Config) -> %% openssl req -x509 -nodes -newkey rsa:1024 -keyout /dev/null -extensions SAN -config public_key_SUITE_data/verify_hostname_ip.conf 2>/dev/null > public_key_SUITE_data/pkix_verify_hostname_subjAltName_IP.pem %% %% Subject: C=SE, CN=example.com -%% Subject Alternative Name: DNS:1.2.3.4, DNS: abcd:ef::1, IP:5.6.7.8, URI:https://10.11.12.13 +%% Subject Alternative Name: DNS:1.2.3.4, DNS: abcd:ef::1, IP:10.67.16.75, URI:https://10.11.12.13 pkix_verify_hostname_subjAltName_IP(Config) -> DataDir = proplists:get_value(data_dir, Config), @@ -1000,7 +1009,7 @@ pkix_verify_hostname_subjAltName_IP(Config) -> %% Print the tests that a matchfun has to handle catch public_key:pkix_verify_hostname(Cert, [{some_tag,"some.domain"}, - {ip, {5,6,7,8}} + {ip, {10,67,16,75}} ], [{match_fun, fun(Ref,Pres) -> @@ -1012,14 +1021,14 @@ pkix_verify_hostname_subjAltName_IP(Config) -> true = public_key:pkix_verify_hostname(Cert, [{uri_id,"https://10.11.12.13"}]), true = public_key:pkix_verify_hostname(Cert, [{dns_id,"1.2.3.4"}]), true = public_key:pkix_verify_hostname(Cert, [{dns_id,<<"1.2.3.4">>}]), - false = public_key:pkix_verify_hostname(Cert, [{dns_id,"5.6.7.8"}]), + false = public_key:pkix_verify_hostname(Cert, [{dns_id,"10.67.16.75"}]), true = public_key:pkix_verify_hostname(Cert, [{ip, "aBcD:ef:0::0:1"}]), true = public_key:pkix_verify_hostname(Cert, [{ip, {16#abcd,16#ef,0,0,0,0,0,1}}]), - true = public_key:pkix_verify_hostname(Cert, [{ip, "5.6.7.8"}]), - true = public_key:pkix_verify_hostname(Cert, [{ip, <<"5.6.7.8">>}]), - true = public_key:pkix_verify_hostname(Cert, [{ip, {5,6,7,8}}]). - - + true = public_key:pkix_verify_hostname(Cert, [{ip, "10.67.16.75"}]), + true = public_key:pkix_verify_hostname(Cert, [{ip, <<"10.67.16.75">>}]), + true = public_key:pkix_verify_hostname(Cert, [{ip, {10,67,16,75}}]), + false = public_key:pkix_verify_hostname(Cert, [{ip, {1,2,3,4}}]), + false = public_key:pkix_verify_hostname(Cert, [{ip, {10,11,12,13}}]). %%-------------------------------------------------------------------- pkix_iso_rsa_oid() -> [{doc, "Test workaround for supporting certs that use ISO oids" @@ -1205,6 +1214,19 @@ short_crl_issuer_hash(Config) when is_list(Config) -> CrlIssuerHash = public_key:short_name_hash(Issuer). +%%-------------------------------------------------------------------- +gen_ec_param_prime_field() -> + [{doc, "Generate key with EC prime_field parameters"}]. +gen_ec_param_prime_field(Config) when is_list(Config) -> + Datadir = proplists:get_value(data_dir, Config), + do_gen_ec_param(filename:join(Datadir, "ec_key_param0.pem")). + +%%-------------------------------------------------------------------- +gen_ec_param_char_2_field() -> + [{doc, "Generate key with EC characteristic_two_field parameters"}]. +gen_ec_param_char_2_field(Config) when is_list(Config) -> + Datadir = proplists:get_value(data_dir, Config), + do_gen_ec_param(filename:join(Datadir, "ec_key_param1.pem")). %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ @@ -1277,6 +1299,43 @@ strip_superfluous_newlines(Bin) -> Str = string:strip(binary_to_list(Bin), right, 10), re:replace(Str,"\n\n","\n", [{return,list}, global]). +do_gen_ec_param(File) -> + {ok, KeyPem} = file:read_file(File), + Entries = public_key:pem_decode(KeyPem), + [ParamInfo] = [Entry || Entry={'EcpkParameters', _, not_encrypted} <- Entries], + {ecParameters, Params} = public_key:pem_entry_decode(ParamInfo), + Key = public_key:generate_key(Params), + case check_entry_type(Key, 'ECPrivateKey') of + true -> + ok; + false -> + ct:fail({key_gen_fail, File}) + end. + +init_per_testcase_gen_ec_param(TC, Curve, Config) -> + case crypto:ec_curves() of + [] -> + {skip, missing_ec_support}; + Curves -> + case lists:member(Curve, Curves) + andalso crypto_supported_curve(Curve, Curves) + of + true -> + init_common_per_testcase(Config); + false -> + {skip, {missing_ec_support, Curve}} + end + end. + + +crypto_supported_curve(Curve, Curves) -> + try crypto:generate_key(ecdh, Curve) of + {error,_} -> false; % Just in case crypto is changed in the future... + _-> true + catch + _:_-> false + end. + incorrect_countryname_pkix_cert() -> <<48,130,5,186,48,130,4,162,160,3,2,1,2,2,7,7,250,61,63,6,140,137,48,13,6,9,42, 134,72,134,247,13,1,1,5,5,0,48,129,220,49,11,48,9,6,3,85,4,6,19,2,85,83,49, 16,48,14,6,3,85,4,8,19,7,65,114,105,122,111,110,97,49,19,48,17,6,3,85,4,7,19, 10,83,99,111,116,116,115,100,97,108,101,49,37,48,35,6,3,85,4,10,19,28,83,116, 97,114,102,105,101,108,100,32,84,101,99,104,110,111,108,111,103,105,101,115, 44,32,73,110,99,46,49,57,48,55,6,3,85,4,11,19,48,104,116,116,112,58,47,47,99, 101,114,116,105,102,105,99,97,116,101,115,46,115,116,97,114,102,105,101,108, 100,116,101,99,104,46,99,111,109,47,114,101,112,111,115,105,116,111,114,121, 49,49,48,47,6,3,85,4,3,19,40,83,116,97,114,102,105,101,108,100,32,83,101,99, 117,114,101,32,67,101,114,116,105,102,105,99,97,116,105,111,110,32,65,117, 116,104,111,114,105,116,121,49,17,48,15,6,3,85,4,5,19,8,49,48,54,56,56,52,51, 53,48,30,23,13,49,48,49,48,50,51,48,49,51,50,48,53,90,23,13,49,50,49,48,50, 51,48,49,51,50,48,53,90,48,122,49,11,48,9,6,3,85,4,6,12,2,85,83,49,11,48,9,6, 3,85,4,8,12,2,65,90,49,19,48,17,6,3,85,4,7,12,10,83,99,111,116,116,115,100, 97,108,101,49,38,48,36,6,3,85,4,10,12,29,83,112,101,99,105,97,108,32,68,111, 109,97,105,110,32,83,101,114,118,105,99,101,115,44,32,73,110,99,46,49,33,48, 31,6,3,85,4,3,12,24,42,46,108,111,103,105,110,46,115,101,99,117,114,101,115, 101,114,118,101,114,46,110,101,116,48,130,1,34,48,13,6,9,42,134,72,134,247, 13,1,1,1,5,0,3,130,1,15,0,48,130,1,10,2,130,1,1,0,185,136,240,80,141,36,124, 245,182,130,73,19,188,74,166,117,72,228,185,209,43,129,244,40,44,193,231,11, 209,12,234,88,43,142,1,162,48,122,17,95,230,105,171,131,12,147,46,204,36,80, 250,171,33,253,35,62,83,22,71,212,186,141,14,198,89,89,121,204,224,122,246, 127,110,188,229,162,67,95,6,74,231,127,99,131,7,240,85,102,203,251,50,58,58, 104,245,103,181,183,134,32,203,121,232,54,32,188,139,136,112,166,126,14,91, 223,153,172,164,14,61,38,163,208,215,186,210,136,213,143,70,147,173,109,217, 250,169,108,31,211,104,238,103,93,182,59,165,43,196,189,218,241,30,148,240, 109,90,69,176,194,52,116,173,151,135,239,10,209,179,129,192,102,75,11,25,168, 223,32,174,84,223,134,70,167,55,172,143,27,130,123,226,226,7,34,142,166,39, 48,246,96,231,150,84,220,106,133,193,55,95,159,227,24,249,64,36,1,142,171,16, 202,55,126,7,156,15,194,22,116,53,113,174,104,239,203,120,45,131,57,87,84, 163,184,27,83,57,199,91,200,34,43,98,61,180,144,76,65,170,177,2,3,1,0,1,163, 130,1,224,48,130,1,220,48,15,6,3,85,29,19,1,1,255,4,5,48,3,1,1,0,48,29,6,3, 85,29,37,4,22,48,20,6,8,43,6,1,5,5,7,3,1,6,8,43,6,1,5,5,7,3,2,48,14,6,3,85, 29,15,1,1,255,4,4,3,2,5,160,48,56,6,3,85,29,31,4,49,48,47,48,45,160,43,160, 41,134,39,104,116,116,112,58,47,47,99,114,108,46,115,116,97,114,102,105,101, 108,100,116,101,99,104,46,99,111,109,47,115,102,115,50,45,48,46,99,114,108, 48,83,6,3,85,29,32,4,76,48,74,48,72,6,11,96,134,72,1,134,253,110,1,7,23,2,48, 57,48,55,6,8,43,6,1,5,5,7,2,1,22,43,104,116,116,112,115,58,47,47,99,101,114, 116,115,46,115,116,97,114,102,105,101,108,100,116,101,99,104,46,99,111,109, 47,114,101,112,111,115,105,116,111,114,121,47,48,129,141,6,8,43,6,1,5,5,7,1, 1,4,129,128,48,126,48,42,6,8,43,6,1,5,5,7,48,1,134,30,104,116,116,112,58,47, 47,111,99,115,112,46,115,116,97,114,102,105,101,108,100,116,101,99,104,46,99, 111,109,47,48,80,6,8,43,6,1,5,5,7,48,2,134,68,104,116,116,112,58,47,47,99, 101,114,116,105,102,105,99,97,116,101,115,46,115,116,97,114,102,105,101,108, 100,116,101,99,104,46,99,111,109,47,114,101,112,111,115,105,116,111,114,121, 47,115,102,95,105,110,116,101,114,109,101,100,105,97,116,101,46,99,114,116, 48,31,6,3,85,29,35,4,24,48,22,128,20,73,75,82,39,209,27,188,242,161,33,106, 98,123,81,66,122,138,215,213,86,48,59,6,3,85,29,17,4,52,48,50,130,24,42,46, 108,111,103,105,110,46,115,101,99,117,114,101,115,101,114,118,101,114,46,110, 101,116,130,22,108,111,103,105,110,46,115,101,99,117,114,101,115,101,114,118, 101,114,46,110,101,116,48,29,6,3,85,29,14,4,22,4,20,138,233,191,208,157,203, 249,85,242,239,20,195,48,10,148,49,144,101,255,116,48,13,6,9,42,134,72,134, 247,13,1,1,5,5,0,3,130,1,1,0,82,31,121,162,49,50,143,26,167,202,143,61,71, 189,201,199,57,81,122,116,90,192,88,24,102,194,174,48,157,74,27,87,210,223, 253,93,3,91,150,109,120,1,110,27,11,200,198,141,222,246,14,200,71,105,41,138, 13,114,122,106,63,17,197,181,234,121,61,89,74,65,41,231,248,219,129,83,176, 219,55,107,55,211,112,98,38,49,69,77,96,221,108,123,152,12,210,159,157,141, 43,226,55,187,129,3,82,49,136,66,81,196,91,234,196,10,82,48,6,80,163,83,71, 127,102,177,93,209,129,26,104,2,84,24,255,248,161,3,244,169,234,92,122,110, 43,4,17,113,185,235,108,219,210,236,132,216,177,227,17,169,58,162,159,182, 162,93,160,229,200,9,163,229,110,121,240,168,232,14,91,214,188,196,109,210, 164,222,0,109,139,132,113,91,16,118,173,178,176,80,132,34,41,199,51,206,250, 224,132,60,115,192,94,107,163,219,212,226,225,65,169,148,108,213,46,174,173, 103,110,189,229,166,149,254,31,51,44,144,108,187,182,11,251,201,206,86,138, 208,59,51,86,132,235,81,225,88,34,190,8,184>>. diff --git a/lib/public_key/test/public_key_SUITE_data/ec_key_param0.pem b/lib/public_key/test/public_key_SUITE_data/ec_key_param0.pem new file mode 100644 index 0000000000..679b08f1a2 --- /dev/null +++ b/lib/public_key/test/public_key_SUITE_data/ec_key_param0.pem @@ -0,0 +1,28 @@ +-----BEGIN EC PARAMETERS----- +MIIBwgIBATBNBgcqhkjOPQEBAkIB//////////////////////////////////// +//////////////////////////////////////////////////8wgZ4EQgH///// +//////////////////////////////////////////////////////////////// +/////////////////ARBUZU+uWGOHJofkpohoLaFQO6i2nJbmbMV87i0iZGO8Qnh +Vhk5Uex+k3sWUsC9O7G/BzVz34g9LDTx70Uf1GtQPwADFQDQnogAKRy4U5bMZxc5 +MoSqoNpkugSBhQQAxoWOBrcEBOnNnj7LZiOVtEKcZIE5BT+1Ifgor2BrTT26oUte +d+/nWSj+HcEnov+o3jNIs8GFakKb+X5+McLlvWYBGDkpaniaO8AEXIpftCx9G9mY +9URJV5tEaBevvRcnPmYsl+5ymV70JkDFULkBP60HYTU8cIaicsJAiL6Udp/RZlAC +QgH///////////////////////////////////////////pRhoeDvy+Wa3/MAUj3 +CaXQO7XJuImcR667b7cekThkCQIBAQ== +-----END EC PARAMETERS----- +-----BEGIN EC PRIVATE KEY----- +MIICnAIBAQRBP6XqBV/b2Q49a8RUvrJBwotzY+IErK5FkzgkExqJuyzXXMM3jMtd +M1vlEF46OCjbldw7NaYITW1mpwz6z2xtqyagggHGMIIBwgIBATBNBgcqhkjOPQEB +AkIB//////////////////////////////////////////////////////////// +//////////////////////////8wgZ4EQgH///////////////////////////// +/////////////////////////////////////////////////////////ARBUZU+ +uWGOHJofkpohoLaFQO6i2nJbmbMV87i0iZGO8QnhVhk5Uex+k3sWUsC9O7G/BzVz +34g9LDTx70Uf1GtQPwADFQDQnogAKRy4U5bMZxc5MoSqoNpkugSBhQQAxoWOBrcE +BOnNnj7LZiOVtEKcZIE5BT+1Ifgor2BrTT26oUted+/nWSj+HcEnov+o3jNIs8GF +akKb+X5+McLlvWYBGDkpaniaO8AEXIpftCx9G9mY9URJV5tEaBevvRcnPmYsl+5y +mV70JkDFULkBP60HYTU8cIaicsJAiL6Udp/RZlACQgH///////////////////// +//////////////////////pRhoeDvy+Wa3/MAUj3CaXQO7XJuImcR667b7cekThk +CQIBAaGBiQOBhgAEAVtCjzs+HP67ZZheraLGJPY+iIJHwDYWeCyzn2J4/fOv5CTo +x0+1QcjrECh4V4F6jfqwW/oQaG9KKyEWhvvWQ0yVAeBfE+89DhYB3h2kyelqRcwZ +XUuB7n7TxijJiHJXq9b+u+sh0qH9ya6nbWjHk79V37pgQOegHjnRc1gIFz6IfRUa +-----END EC PRIVATE KEY----- diff --git a/lib/public_key/test/public_key_SUITE_data/ec_key_param1.pem b/lib/public_key/test/public_key_SUITE_data/ec_key_param1.pem new file mode 100644 index 0000000000..67095d8dc5 --- /dev/null +++ b/lib/public_key/test/public_key_SUITE_data/ec_key_param1.pem @@ -0,0 +1,25 @@ +-----BEGIN EC PARAMETERS----- +MIIBcQIBATAlBgcqhkjOPQECMBoCAgI7BgkqhkjOPQECAwMwCQIBAgIBBQIBCjBk +BAEBBEgC9A5+IiHyld4pcRe389YvXGqX/8uM7/HNa6jOSpoYrYT/q72O+lkzK+et +Z1ambilK/RhaeP8SqlIOTec5usoMf/7/fylVcnoDFQAqoFj3Og4zq0hrD2EEEMU6 +fxMjEASBkQQDAwAdNLhWKWwWwNQNPNd1CpPR0pVfqAql9A/I23sqvb3lOVD0wNKT +zdcRo1tn+xSZrmADhhTxOUq/o7TIUNkn4ed2nI7sLRkDe/JzQtpjm23M//63PWnX +jGwnpgCcu8oZgPhTOSHopoRCPkO6sIpXYpGvj0YbsqizUx0vBIXBmxbi8VFuI908 +GkgnrxuKwVsCSAP//////////////////////////////////////////////+Zh +zhj/VZhzCAWbGGgjhR7H3ZyhFh3pPVF01m6Dgum7L+hORwIBAg== +-----END EC PARAMETERS----- +-----BEGIN EC PRIVATE KEY----- +MIICXgIBAQRIAwaM3VblR1nZJseRVx4qJBQLLulB7uMF9KE+hMPlzZjj/f3KbcK4 +dfhxYFf4gqWNJW3fzFMEYF7JpzDjuFTmfX5jjO5f8cw9oIIBdTCCAXECAQEwJQYH +KoZIzj0BAjAaAgICOwYJKoZIzj0BAgMDMAkCAQICAQUCAQowZAQBAQRIAvQOfiIh +8pXeKXEXt/PWL1xql//LjO/xzWuozkqaGK2E/6u9jvpZMyvnrWdWpm4pSv0YWnj/ +EqpSDk3nObrKDH/+/38pVXJ6AxUAKqBY9zoOM6tIaw9hBBDFOn8TIxAEgZEEAwMA +HTS4VilsFsDUDTzXdQqT0dKVX6gKpfQPyNt7Kr295TlQ9MDSk83XEaNbZ/sUma5g +A4YU8TlKv6O0yFDZJ+HndpyO7C0ZA3vyc0LaY5ttzP/+tz1p14xsJ6YAnLvKGYD4 +Uzkh6KaEQj5DurCKV2KRr49GG7Kos1MdLwSFwZsW4vFRbiPdPBpIJ68bisFbAkgD +///////////////////////////////////////////////mYc4Y/1WYcwgFmxho +I4Uex92coRYd6T1RdNZug4Lpuy/oTkcCAQKhgZUDgZIABALOIIukF443IxnNZx1Q +4HKDifQ9Lj3Rh+inIKczXLLJNEGCJ0wwG3d4v/fOxzdepZcnYviFAijQQA/iYWsA +/Zet+5B4yxKISQcHei+PXkqwAAwEqq6D4hO2orlNOO430rgLoA0MNFc7I1THanOp +q4RhYp8qnCEjM7nfQ4R0F+hPgZK1VPojkrGolaY/cNT/oA== +-----END EC PRIVATE KEY----- diff --git a/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_subjAltName_IP.pem b/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_subjAltName_IP.pem index f9ffb257b5..97d12cdadf 100644 --- a/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_subjAltName_IP.pem +++ b/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_subjAltName_IP.pem @@ -1,13 +1,13 @@ -----BEGIN CERTIFICATE----- -MIIB/zCCAWigAwIBAgIJAMoSejmTjwAGMA0GCSqGSIb3DQEBCwUAMB8xCzAJBgNV -BAYTAlNFMRAwDgYDVQQDEwc1LjYuNy44MB4XDTE3MDkyODE0MDAxNVoXDTE3MTAy -ODE0MDAxNVowHzELMAkGA1UEBhMCU0UxEDAOBgNVBAMTBzUuNi43LjgwgZ8wDQYJ -KoZIhvcNAQEBBQADgY0AMIGJAoGBAMUPU89KwVbTCDkyxQSz3wprMbZTLe35K6jm -Q7oY1rJyVXjsFHwZrFqqNMScEyX40rJhczQ2Z9etEX6qYLbdb/DZeFcKo14fR583 -QMFZC+qqpLWHdvjaQN0KwD99VFeZIGpRgywG8SR+BXZjDHUkGsMrikAEJtf0Tgih -IPyiFtiJAgMBAAGjQzBBMD8GA1UdEQQ4MDaCBzEuMi4zLjSHBAUGBwiHEKvNAO8A -AAAAAAAAAAAAAAGGE2h0dHBzOi8vMTAuMTEuMTIuMTMwDQYJKoZIhvcNAQELBQAD -gYEAtWVeQaRFZ0kH/pzSWMSsOCUrjbwlWRwDNbagNKoM6nCRv0QQ59fG6XrVZwR3 -c0s5arlMh3U2+bjKE+Iq9+b/lN1lGzf8iaAqBNa7KptwTSUEY3TiNG5X0zlSXKTI -3z7AaUEtghL9ImCPj5V3tVksqWd7U0zLmeeLZnM+wGAL9Hc= +MIICBzCCAXCgAwIBAgIJAJgbo5FL73LuMA0GCSqGSIb3DQEBCwUAMCMxCzAJBgNV +BAYTAlNFMRQwEgYDVQQDEwtleGFtcGxlLmNvbTAeFw0xNzEwMTExMDM0NDJaFw0x +NzExMTAxMDM0NDJaMCMxCzAJBgNVBAYTAlNFMRQwEgYDVQQDEwtleGFtcGxlLmNv +bTCBnzANBgkqhkiG9w0BAQEFAAOBjQAwgYkCgYEA5muN8NIRHuqXgtAFpaJ4EPnd +SD+hnzMiiWQ9qAsS8P4xFsl5aNH74BTgst6Rcq33qAw+4BtKFXMt7JbWMuZklFV3 +fzRSx099MVJSH3f2LDMNLfyDiSJnhBEv1rLPaosi91ZLvI5LiGTxzRLi3qftZBft +Ryw1OempB4chLcBy2rsCAwEAAaNDMEEwPwYDVR0RBDgwNoIHMS4yLjMuNIcECkMQ +S4cQq80A7wAAAAAAAAAAAAAAAYYTaHR0cHM6Ly8xMC4xMS4xMi4xMzANBgkqhkiG +9w0BAQsFAAOBgQDMn8aqs/5FkkWhspvN2n+D2l87M+33a5My54ZVZhayZ/KRmhCN +Gix/BiVYJ3UlmWmGcnQXb3MLt/LQHaD3S2whDaLN3xJ8BbnX7A4ZTybitdyeFhDw +K3iDVUM3bSsBJ4EcBPWIMnow3ALP5HlGRMlH/87Qt+uVPXuwNh9pmyIhRQ== -----END CERTIFICATE----- diff --git a/lib/public_key/test/public_key_SUITE_data/verify_hostname_ip.conf b/lib/public_key/test/public_key_SUITE_data/verify_hostname_ip.conf index 0a738f2586..798592e4f6 100644 --- a/lib/public_key/test/public_key_SUITE_data/verify_hostname_ip.conf +++ b/lib/public_key/test/public_key_SUITE_data/verify_hostname_ip.conf @@ -5,14 +5,13 @@ distinguished_name = DN [DN] C=SE CN=example.com -CN=5.6.7.8 [SAN] subjectAltName = @alt_names [alt_names] DNS = 1.2.3.4 -IP.1 = 5.6.7.8 +IP.1 = 10.67.16.75 IP.2 = abcd:ef::1 URI = https://10.11.12.13 diff --git a/lib/public_key/vsn.mk b/lib/public_key/vsn.mk index c01d8820f2..99a0cc087e 100644 --- a/lib/public_key/vsn.mk +++ b/lib/public_key/vsn.mk @@ -1 +1 @@ -PUBLIC_KEY_VSN = 1.5.1 +PUBLIC_KEY_VSN = 1.5.2 diff --git a/lib/reltool/src/reltool.hrl b/lib/reltool/src/reltool.hrl index 9c8aae6b7e..d133762818 100644 --- a/lib/reltool/src/reltool.hrl +++ b/lib/reltool/src/reltool.hrl @@ -220,7 +220,8 @@ { name :: rel_name(), vsn :: rel_vsn(), - rel_apps :: [#rel_app{}] + rel_apps :: [#rel_app{}], + load_dot_erlang = true :: boolean() }). -record(sys, @@ -300,6 +301,7 @@ -define(STANDALONE_INCL_SYS_FILTERS, ["^bin/(erl|epmd)(|\\.exe|\\.ini)\$", "^bin/start(|_clean).boot\$", + "^bin/no_dot_erlang\\.boot\$", "^erts.*/bin", "^lib\$"]). -define(STANDALONE_EXCL_SYS_FILTERS, diff --git a/lib/reltool/src/reltool_mod_win.erl b/lib/reltool/src/reltool_mod_win.erl index 2d56d74563..dcd802a5de 100644 --- a/lib/reltool/src/reltool_mod_win.erl +++ b/lib/reltool/src/reltool_mod_win.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2016. All Rights Reserved. +%% Copyright Ericsson AB 2009-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -833,7 +833,7 @@ load_code(Ed, Code) when is_binary(Code) -> keyWords() -> L = ["after","begin","case","try","cond","catch","andalso","orelse", - "end","fun","if","let","of","query","receive","when","bnot","not", + "end","fun","if","let","of","receive","when","bnot","not", "div","rem","band","and","bor","bxor","bsl","bsr","or","xor"], lists:flatten([K ++ " " || K <- L] ++ [0]). diff --git a/lib/reltool/src/reltool_target.erl b/lib/reltool/src/reltool_target.erl index 1b1461178e..503e1971b9 100644 --- a/lib/reltool/src/reltool_target.erl +++ b/lib/reltool/src/reltool_target.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2016. All Rights Reserved. +%% Copyright Ericsson AB 2009-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -424,7 +424,7 @@ gen_script(Rel, Sys, PathFlag, Variables) -> {error, Text} end. -do_gen_script(#rel{name = RelName, vsn = RelVsn}, +do_gen_script(#rel{name = RelName, vsn = RelVsn, load_dot_erlang=LoadErlangRc}, #sys{apps = Apps}, MergedApps, PathFlag, @@ -474,9 +474,11 @@ do_gen_script(#rel{name = RelName, vsn = RelVsn}, Type =/= none, Type =/= load, not lists:member(Name, InclApps)], - %% Apply user specific customizations - {apply, {c, erlangrc, []}}, + case LoadErlangRc of + true -> {apply, {c, erlangrc, []}}; + false -> [] + end, {progress, started} ], {ok, {script, {RelName, RelVsn}, lists:flatten(DeepList)}}. diff --git a/lib/reltool/src/reltool_utils.erl b/lib/reltool/src/reltool_utils.erl index 3891b5ae4d..060a0912f9 100644 --- a/lib/reltool/src/reltool_utils.erl +++ b/lib/reltool/src/reltool_utils.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2016. All Rights Reserved. +%% Copyright Ericsson AB 2009-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -154,7 +154,12 @@ default_rels() -> rel_apps = []}, #rel{name = "start_sasl", vsn = "1.0", - rel_apps = [#rel_app{name = sasl}]} + rel_apps = [#rel_app{name = sasl}]}, + #rel{name = "no_dot_erlang", %% Needed by escript and erlc + vsn = "1.0", + rel_apps = [], + load_dot_erlang = false + } ]. choose_default(Tag, Profile, InclDefs) diff --git a/lib/reltool/test/reltool_server_SUITE.erl b/lib/reltool/test/reltool_server_SUITE.erl index 49efe5aeda..3622f6650c 100644 --- a/lib/reltool/test/reltool_server_SUITE.erl +++ b/lib/reltool/test/reltool_server_SUITE.erl @@ -247,6 +247,7 @@ get_config(_Config) -> {app,stdlib,[{incl_cond,include},{vsn,undefined}, {lib_dir,StdLibDir}]}, {boot_rel,"start_clean"}, + {rel,"no_dot_erlang","1.0",[]}, {rel,"start_clean","1.0",[]}, {rel,"start_sasl","1.0",[sasl]}, {emu_name,"beam"}, @@ -277,6 +278,7 @@ get_config(_Config) -> {app,stdlib,[{incl_cond,include},{vsn,StdVsn}, {lib_dir,StdLibDir},{mod,_,[]}|_]}, {boot_rel,"start_clean"}, + {rel,"no_dot_erlang","1.0",[]}, {rel,"start_clean","1.0",[]}, {rel,"start_sasl","1.0",[sasl]}, {emu_name,"beam"}, @@ -2104,6 +2106,7 @@ save_config(Config) -> {app,stdlib,[{incl_cond,include},{vsn,undefined}, {lib_dir,undefined}]}, {boot_rel,"start_clean"}, + {rel,"no_dot_erlang","1.0",[]}, {rel,"start_clean","1.0",[]}, {rel,"start_sasl","1.0",[sasl]}, {emu_name,"beam"}, @@ -2144,6 +2147,7 @@ save_config(Config) -> {app,stdlib,[{incl_cond,include},{vsn,StdVsn}, {lib_dir,StdLibDir},{mod,_,[]}|_]}, {boot_rel,"start_clean"}, + {rel,"no_dot_erlang","1.0",[]}, {rel,"start_clean","1.0",[]}, {rel,"start_sasl","1.0",[sasl]}, {emu_name,"beam"}, @@ -2545,7 +2549,7 @@ undefined_regexp(_Config) -> %% Library functions erl_libs() -> - string:tokens(os:getenv("ERL_LIBS", ""), ":;"). + string:lexemes(os:getenv("ERL_LIBS", ""), ":;"). datadir(Config) -> %% Removes the trailing slash... @@ -2555,7 +2559,7 @@ latest(App) -> AppStr = atom_to_list(App), AppDirs = filelib:wildcard(filename:join(code:lib_dir(),AppStr++"-*")), [LatestAppDir|_] = lists:reverse(AppDirs), - [_,Vsn] = string:tokens(filename:basename(LatestAppDir),"-"), + [_,Vsn] = string:lexemes(filename:basename(LatestAppDir),"-"), Vsn. rm_missing_app(Apps) -> @@ -2631,16 +2635,11 @@ os_cmd(Cmd) when is_list(Cmd) -> Return-> %% Find the position of the status code wich is last in the string %% prepended with # - case string:rchr(Return, $#) of - - %% This happens only if the sh command pipe is somehow interrupted - 0-> - {98, Return}; - - Position-> - Result = string:left(Return,Position - 1), - Status = string:substr(Return,Position + 1, length(Return) - Position - 1), - {list_to_integer(Status), Result} + case string:split(Return, "$#", trailing) of + [_] -> %% This happens only if the sh command pipe is somehow interrupted + {98, Return}; + [Result, Status0] -> + {list_to_integer(string:trim(Status0)), Result} end end. diff --git a/lib/runtime_tools/doc/src/LTTng.xml b/lib/runtime_tools/doc/src/LTTng.xml index 392d54857c..93937b3fdc 100644 --- a/lib/runtime_tools/doc/src/LTTng.xml +++ b/lib/runtime_tools/doc/src/LTTng.xml @@ -134,7 +134,7 @@ $ make </code> <p><em>port_open</em></p> <list type="bulleted"> <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> - <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item> <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> </list> <p> @@ -323,7 +323,7 @@ $ make </code> <p><em>driver_init</em></p> <list type="bulleted"> - <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item> <item><c>major : integer</c> :: Major version. Ex. <c>3</c></item> <item><c>minor : integer</c> :: Minor version. Ex. <c>1</c></item> <item><c>flags : integer</c> :: Flags. Ex. <c>1</c></item> @@ -334,7 +334,7 @@ $ make </code> <p><em>driver_start</em></p> <list type="bulleted"> <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> - <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item> <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> </list> <p>Example:</p> @@ -344,7 +344,7 @@ $ make </code> <list type="bulleted"> <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> - <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item> <item><c>bytes : integer</c> :: Size of data returned. Ex. <c>82</c></item> </list> <p>Example:</p> @@ -354,7 +354,7 @@ $ make </code> <list type="bulleted"> <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> - <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item> <item><c>bytes : integer</c> :: Size of data returned. Ex. <c>82</c></item> </list> <p>Example:</p> @@ -364,7 +364,7 @@ $ make </code> <list type="bulleted"> <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> - <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item> </list> <p>Example:</p> <code type="none">driver_ready_input: { cpu_id = 5 }, { pid = "<0.189.0>", port = "#Port<0.3637>", driver = "inet_gethost 4 " }</code> @@ -373,7 +373,7 @@ $ make </code> <list type="bulleted"> <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> - <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item> </list> <p>Example:</p> <code type="none">driver_ready_output: { cpu_id = 5 }, { pid = "<0.194.0>", port = "#Port<0.3663>", driver = "tcp_inet" }</code> @@ -382,14 +382,14 @@ $ make </code> <list type="bulleted"> <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> - <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item> </list> <p>Example:</p> <code type="none">driver_timeout: { cpu_id = 5 }, { pid = "<0.196.0>", port = "#Port<0.3664>", driver = "tcp_inet" }</code> <p><em>driver_stop_select</em></p> <list type="bulleted"> - <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item> </list> <p>Example:</p> <code type="none">driver_stop_select: { cpu_id = 5 }, { driver = "unknown" }</code> @@ -398,7 +398,7 @@ $ make </code> <list type="bulleted"> <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> - <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item> </list> <p>Example:</p> <code type="none">driver_flush: { cpu_id = 7 }, { pid = "<0.204.0>", port = "#Port<0.3686>", driver = "tcp_inet" }</code> @@ -407,32 +407,32 @@ $ make </code> <list type="bulleted"> <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> - <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item> </list> <p>Example:</p> - <code type="none">driver_stop: { cpu_id = 5 }, { pid = "[]", port = "#Port<0.3673>", driver = "efile" }</code> + <code type="none">driver_stop: { cpu_id = 5 }, { pid = "[]", port = "#Port<0.3673>", driver = "tcp_inet" }</code> <p><em>driver_process_exit</em></p> <list type="bulleted"> <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> - <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item> </list> <p><em>driver_ready_async</em></p> <list type="bulleted"> <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> - <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item> </list> <p>Example:</p> - <code type="none">driver_ready_async: { cpu_id = 3 }, { pid = "<0.181.0>", port = "#Port<0.3622>", driver = "efile" }</code> + <code type="none">driver_ready_async: { cpu_id = 3 }, { pid = "<0.181.0>", port = "#Port<0.3622>", driver = "tcp_inet" }</code> <p><em>driver_call</em></p> <list type="bulleted"> <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> - <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item> <item><c>command : integer</c> :: Command integer. Ex. <c>1</c></item> <item><c>bytes : integer</c> :: Size of data returned. Ex. <c>82</c></item> </list> @@ -443,7 +443,7 @@ $ make </code> <list type="bulleted"> <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> - <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item> <item><c>command : integer</c> :: Command integer. Ex. <c>1</c></item> <item><c>bytes : integer</c> :: Size of data returned. Ex. <c>82</c></item> </list> diff --git a/lib/runtime_tools/doc/src/Makefile b/lib/runtime_tools/doc/src/Makefile index 5ce40bb995..ec19a4ce59 100644 --- a/lib/runtime_tools/doc/src/Makefile +++ b/lib/runtime_tools/doc/src/Makefile @@ -1,8 +1,8 @@ # # %CopyrightBegin% -# +# # Copyright Ericsson AB 1999-2016. All Rights Reserved. -# +# # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at @@ -14,7 +14,7 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. -# +# # %CopyrightEnd% # include $(ERL_TOP)/make/target.mk @@ -44,8 +44,8 @@ XML_APPLICATION_FILES = ref_man.xml XML_REF3_FILES = dbg.xml dyntrace.xml erts_alloc_config.xml system_information.xml msacc.xml XML_REF6_FILES = runtime_tools_app.xml -XML_PART_FILES = part_notes.xml part_notes_history.xml part.xml -XML_CHAPTER_FILES = notes.xml notes_history.xml LTTng.xml +XML_PART_FILES = part.xml +XML_CHAPTER_FILES = notes.xml LTTng.xml GENERATED_XML_FILES = DTRACE.xml SYSTEMTAP.xml @@ -54,7 +54,8 @@ BOOK_FILES = book.xml XML_FILES = \ $(BOOK_FILES) $(XML_CHAPTER_FILES) \ $(XML_PART_FILES) $(XML_REF3_FILES) \ - $(XML_REF6_FILES) $(XML_APPLICATION_FILES) + $(XML_REF6_FILES) $(XML_APPLICATION_FILES) \ + $(GENERATED_XML_FILES) GIF_FILES = @@ -77,10 +78,10 @@ SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml) TOP_SPECS_FILE = specs.xml # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += +XML_FLAGS += +DVIPS_FLAGS += SPECS_ESRC = ../../src @@ -89,7 +90,6 @@ SPECS_FLAGS = -I../../include -I../../../kernel/src # ---------------------------------------------------- # Targets # ---------------------------------------------------- -$(XML_FILES): $(GENERATED_XML_FILES) %.xml: $(ERL_TOP)/HOWTO/%.md $(ERL_TOP)/make/emd2exml $(ERL_TOP)/make/emd2exml $< $@ @@ -109,18 +109,18 @@ man: $(MAN3_FILES) $(MAN6_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) -debug opt: +debug opt: clean clean_docs: rm -rf $(HTMLDIR)/* rm -f $(MAN3DIR)/* rm -f $(MAN6DIR)/* rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ + rm -f errs core *~ # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs @@ -136,4 +136,3 @@ release_docs_spec: docs $(INSTALL_DATA) $(MAN6_FILES) "$(RELEASE_PATH)/man/man6" release_spec: - diff --git a/lib/runtime_tools/doc/src/fascicules.xml b/lib/runtime_tools/doc/src/fascicules.xml deleted file mode 100644 index 1a0bd6ec97..0000000000 --- a/lib/runtime_tools/doc/src/fascicules.xml +++ /dev/null @@ -1,15 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="refman" href="refman_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/runtime_tools/doc/src/note.gif b/lib/runtime_tools/doc/src/note.gif Binary files differdeleted file mode 100644 index 6fffe30419..0000000000 --- a/lib/runtime_tools/doc/src/note.gif +++ /dev/null diff --git a/lib/runtime_tools/doc/src/notes.xml b/lib/runtime_tools/doc/src/notes.xml index 8b4d437c26..93e3e26fda 100644 --- a/lib/runtime_tools/doc/src/notes.xml +++ b/lib/runtime_tools/doc/src/notes.xml @@ -32,6 +32,21 @@ <p>This document describes the changes made to the Runtime_Tools application.</p> +<section><title>Runtime_Tools 1.12.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Removed all old unused files in the documentation. + </p> + <p> + Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p> + </item> + </list> + </section> + +</section> + <section><title>Runtime_Tools 1.12.2</title> <section><title>Improvements and New Features</title> diff --git a/lib/runtime_tools/doc/src/part_notes.xml b/lib/runtime_tools/doc/src/part_notes.xml deleted file mode 100644 index cabf3e39da..0000000000 --- a/lib/runtime_tools/doc/src/part_notes.xml +++ /dev/null @@ -1,39 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2004</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>Runtime_Tools Release Notes</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p><em>Runtime_Tools</em> provides low footprint tracing/debugging - tools suitable for inclusion in a production system.</p> - <p>For information about older versions, see - <url href="part_notes_history_frame.html">Release Notes History</url>.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/runtime_tools/doc/src/part_notes_history.xml b/lib/runtime_tools/doc/src/part_notes_history.xml deleted file mode 100644 index dd1991f23a..0000000000 --- a/lib/runtime_tools/doc/src/part_notes_history.xml +++ /dev/null @@ -1,39 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part> - <header> - <copyright> - <year>2006</year> - <year>2016</year> - <holder>Ericsson AB, All Rights Reserved</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>Runtime_Tools Release Notes History</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p><em>Runtime_Tools</em> provides low footprint tracing/debugging - tools suitable for inclusion in a production system.</p> - </description> - <include file="notes_history"></include> -</part> - diff --git a/lib/runtime_tools/doc/src/warning.gif b/lib/runtime_tools/doc/src/warning.gif Binary files differdeleted file mode 100644 index 96af52360e..0000000000 --- a/lib/runtime_tools/doc/src/warning.gif +++ /dev/null diff --git a/lib/runtime_tools/examples/efile_drv.d b/lib/runtime_tools/examples/efile_drv.d deleted file mode 100644 index a470518dd9..0000000000 --- a/lib/runtime_tools/examples/efile_drv.d +++ /dev/null @@ -1,105 +0,0 @@ -/* example usage: dtrace -q -s /path/to/efile_drv.d */ -/* - * %CopyrightBegin% - * - * Copyright Scott Lystig Fritchie 2011-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -BEGIN -{ - op_map[1] = "OPEN"; - op_map[2] = "READ"; - op_map[3] = "LSEEK"; - op_map[4] = "WRITE"; - op_map[5] = "FSTAT"; - op_map[6] = "PWD"; - op_map[7] = "READDIR"; - op_map[8] = "CHDIR"; - op_map[9] = "FSYNC"; - op_map[10] = "MKDIR"; - op_map[11] = "DELETE"; - op_map[12] = "RENAME"; - op_map[13] = "RMDIR"; - op_map[14] = "TRUNCATE"; - op_map[15] = "READ_FILE"; - op_map[16] = "WRITE_INFO"; - op_map[19] = "LSTAT"; - op_map[20] = "READLINK"; - op_map[21] = "LINK"; - op_map[22] = "SYMLINK"; - op_map[23] = "CLOSE"; - op_map[24] = "PWRITEV"; - op_map[25] = "PREADV"; - op_map[26] = "SETOPT"; - op_map[27] = "IPREAD"; - op_map[28] = "ALTNAME"; - op_map[29] = "READ_LINE"; - op_map[30] = "FDATASYNC"; - op_map[31] = "FADVISE"; -} - -erlang*:::aio_pool-add -{ - printf("async I/O pool port %s queue len %d\n", copyinstr(arg0), arg1); -} - -erlang*:::aio_pool-get -{ - printf("async I/O pool port %s queue len %d\n", copyinstr(arg0), arg1); -} - -erlang*:::efile_drv-entry -{ - printf("efile_drv enter tag={%d,%d} %s%s | %s (%d) | args: %s %s , %d %d (port %s)\n", - arg0, arg1, - arg2 == NULL ? "" : "user tag ", - arg2 == NULL ? "" : copyinstr(arg2), - op_map[arg3], arg3, - arg4 == NULL ? "" : copyinstr(arg4), - arg5 == NULL ? "" : copyinstr(arg5), arg6, arg7, - /* NOTE: port name in args[10] is experimental */ - (args[10] == NULL) ? - "?" : copyinstr((user_addr_t) args[10])); -} - -erlang*:::efile_drv-int* -{ - printf("async I/O worker tag={%d,%d} | %s (%d) | %s\n", - arg0, arg1, op_map[arg2], arg2, probename); -} - -/* efile_drv-return error case */ -erlang*:::efile_drv-return -/arg4 == 0/ -{ - printf("efile_drv return tag={%d,%d} %s%s | %s (%d) | errno %d\n", - arg0, arg1, - arg2 == NULL ? "" : "user tag ", - arg2 == NULL ? "" : copyinstr(arg2), - op_map[arg3], arg3, - arg5); -} - -/* efile_drv-return success case */ -erlang*:::efile_drv-return -/arg4 != 0/ -{ - printf("efile_drv return tag={%d,%d} %s | %s (%d) ok\n", - arg0, arg1, - arg2 == NULL ? "" : copyinstr(arg2), - op_map[arg3], arg3); -} diff --git a/lib/runtime_tools/examples/efile_drv.systemtap b/lib/runtime_tools/examples/efile_drv.systemtap deleted file mode 100644 index 29c3637e10..0000000000 --- a/lib/runtime_tools/examples/efile_drv.systemtap +++ /dev/null @@ -1,113 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Scott Lystig Fritchie and Andreas Schultz, 2011-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -/* - * Note: This file assumes that you're using the non-SMP-enabled Erlang - * virtual machine, "beam". The SMP-enabled VM is called "beam.smp". - * Note that other variations of the virtual machine also have - * different names, e.g. the debug build of the SMP-enabled VM - * is "beam.debug.smp". - * - * To use a different virtual machine, replace each instance of - * "beam" with "beam.smp" or the VM name appropriate to your - * environment. - */ - -probe begin -{ - op_map[1] = "OPEN"; - op_map[2] = "READ"; - op_map[3] = "LSEEK"; - op_map[4] = "WRITE"; - op_map[5] = "FSTAT"; - op_map[6] = "PWD"; - op_map[7] = "READDIR"; - op_map[8] = "CHDIR"; - op_map[9] = "FSYNC"; - op_map[10] = "MKDIR"; - op_map[11] = "DELETE"; - op_map[12] = "RENAME"; - op_map[13] = "RMDIR"; - op_map[14] = "TRUNCATE"; - op_map[15] = "READ_FILE"; - op_map[16] = "WRITE_INFO"; - op_map[19] = "LSTAT"; - op_map[20] = "READLINK"; - op_map[21] = "LINK"; - op_map[22] = "SYMLINK"; - op_map[23] = "CLOSE"; - op_map[24] = "PWRITEV"; - op_map[25] = "PREADV"; - op_map[26] = "SETOPT"; - op_map[27] = "IPREAD"; - op_map[28] = "ALTNAME"; - op_map[29] = "READ_LINE"; - op_map[30] = "FDATASYNC"; - op_map[31] = "FADVISE"; -} - -probe process("beam").mark("aio_pool-add") -{ - printf("async I/O pool port %s queue len %d\n", user_string($arg1), $arg2); -} - -probe process("beam").mark("aio_pool-get") -{ - printf("async I/O pool port %s queue len %d\n", user_string($arg1), $arg2); -} - -probe process("beam").mark("efile_drv-entry") -{ - printf("efile_drv enter tag={%d,%d} %s%s | %s (%d) | args: %s %s , %d %d (port %s)\n", - $arg1, $arg2, - $arg3 == NULL ? "" : "user tag ", - $arg3 == NULL ? "" : user_string($arg3), - op_map[$arg4], $arg4, - $arg5 == NULL ? "" : user_string($arg5), - $arg6 == NULL ? "" : user_string($arg6), $arg7, $arg8, - /* NOTE: port name in $arg[11] is experimental */ - user_string($arg11)) -} - -probe process("beam").mark("efile_drv-int*") -{ - printf("async I/O worker tag={%d,%d} | %s (%d) | %s\n", - $arg1, $arg2, op_map[$arg3], $arg3, probefunc()); -} - -probe process("beam").mark("efile_drv-return") -{ - if ($arg5 == 0) { - /* efile_drv-return error case */ - printf("efile_drv return tag={%d,%d} %s%s | %s (%d) | errno %d\n", - $arg1, $arg2, - $arg3 == NULL ? "" : "user tag ", - $arg3 == NULL ? "" : user_string($arg3), - op_map[$arg4], $arg4, - $arg6); - } else { - /* efile_drv-return success case */ - printf("efile_drv return tag={%d,%d} %s | %s (%d) ok\n", - $arg1, $arg2, - $arg3 == NULL ? "" : user_string($arg3), - op_map[$arg4], $arg4); - } -} - -global op_map; diff --git a/lib/runtime_tools/src/erts_alloc_config.erl b/lib/runtime_tools/src/erts_alloc_config.erl index 514530332c..342363d08d 100644 --- a/lib/runtime_tools/src/erts_alloc_config.erl +++ b/lib/runtime_tools/src/erts_alloc_config.erl @@ -621,7 +621,7 @@ format_header(FTO) -> [Y, Mo, D, H, Mi, S]), fcp(FTO, "~s was used when generating the configuration.", - [string:strip(erlang:system_info(system_version), both, $\n)]), + [string:trim(erlang:system_info(system_version), both, "$\n")]), case erlang:system_info(schedulers) of 1 -> ok; Schdlrs -> @@ -698,28 +698,32 @@ fc(IODev, Frmt, Args) -> fc(IODev, lists:flatten(io_lib:format(Frmt, Args))). fc(IODev, String) -> - fc_aux(IODev, string:tokens(String, " "), 0). + fc_aux(IODev, string:lexemes(String, " "), 0). fc_aux(_IODev, [], 0) -> ok; fc_aux(IODev, [], _Len) -> format(IODev, "~n"); fc_aux(IODev, [T|Ts], 0) -> - Len = 2 + length(T), + Len = 2 + string:length(T), format(IODev, "# ~s", [T]), fc_aux(IODev, Ts, Len); -fc_aux(IODev, [T|_Ts] = ATs, Len) when (length(T) + Len) >= ?PRINT_WITDH -> - format(IODev, "~n"), - fc_aux(IODev, ATs, 0); -fc_aux(IODev, [T|Ts], Len) -> - NewLen = Len + 1 + length(T), - format(IODev, " ~s", [T]), - fc_aux(IODev, Ts, NewLen). +fc_aux(IODev, [T|Ts] = ATs, Len) -> + TLength = string:length(T), + case (TLength + Len) >= ?PRINT_WITDH of + true -> + format(IODev, "~n"), + fc_aux(IODev, ATs, 0); + false -> + NewLen = Len + 1 + TLength, + format(IODev, " ~s", [T]), + fc_aux(IODev, Ts, NewLen) + end. %% fcl: format comment line fcl(FTO) -> EndStr = "# ", - Precision = length(EndStr), + Precision = string:length(EndStr), FieldWidth = -1*(?PRINT_WITDH), format(FTO, "~*.*.*s~n", [FieldWidth, Precision, $-, EndStr]). @@ -727,6 +731,6 @@ fcl(FTO, A) when is_atom(A) -> fcl(FTO, atom_to_list(A)); fcl(FTO, Str) when is_list(Str) -> Str2 = "# --- " ++ Str ++ " ", - Precision = length(Str2), + Precision = string:length(Str2), FieldWidth = -1*(?PRINT_WITDH), format(FTO, "~*.*.*s~n", [FieldWidth, Precision, $-, Str2]). diff --git a/lib/runtime_tools/src/msacc.erl b/lib/runtime_tools/src/msacc.erl index 0d9b2690e5..37887cee72 100644 --- a/lib/runtime_tools/src/msacc.erl +++ b/lib/runtime_tools/src/msacc.erl @@ -46,7 +46,8 @@ system := float()}}. --type msacc_type() :: scheduler | aux | async. +-type msacc_type() :: aux | async | dirty_cpu_scheduler + | dirty_io_scheduler | poll | scheduler. -type msacc_id() :: non_neg_integer(). -type msacc_state() :: alloc | aux | bif | busy_wait | check_io | emulator | ets | gc | gc_fullsweep | nif | diff --git a/lib/runtime_tools/src/system_information.erl b/lib/runtime_tools/src/system_information.erl index df25297eb9..92109c9a74 100644 --- a/lib/runtime_tools/src/system_information.erl +++ b/lib/runtime_tools/src/system_information.erl @@ -590,12 +590,12 @@ vsnstr2vsn(VsnStr) -> list_to_tuple(lists:map(fun (Part) -> list_to_integer(Part) end, - string:tokens(VsnStr, "."))). + string:lexemes(VsnStr, "."))). rtdepstrs2rtdeps([]) -> []; rtdepstrs2rtdeps([RTDep | RTDeps]) -> - [AppStr, VsnStr] = string:tokens(RTDep, "-"), + [AppStr, VsnStr] = string:lexemes(RTDep, "-"), [{list_to_atom(AppStr), vsnstr2vsn(VsnStr)} | rtdepstrs2rtdeps(RTDeps)]. build_app_table([], AppTab) -> diff --git a/lib/runtime_tools/test/dbg_SUITE.erl b/lib/runtime_tools/test/dbg_SUITE.erl index 4b0864858c..cfe8412e33 100644 --- a/lib/runtime_tools/test/dbg_SUITE.erl +++ b/lib/runtime_tools/test/dbg_SUITE.erl @@ -23,7 +23,7 @@ -export([all/0, suite/0, big/1, tiny/1, simple/1, message/1, distributed/1, port/1, send/1, recv/1, - ip_port/1, file_port/1, file_port2/1, file_port_schedfix/1, + ip_port/1, file_port/1, file_port2/1, ip_port_busy/1, wrap_port/1, wrap_port_time/1, with_seq_trace/1, dead_suspend/1, local_trace/1, saved_patterns/1, tracer_exit_on_stop/1, @@ -41,7 +41,7 @@ suite() -> all() -> [big, tiny, simple, message, distributed, port, ip_port, send, recv, - file_port, file_port2, file_port_schedfix, ip_port_busy, + file_port, file_port2, ip_port_busy, wrap_port, wrap_port_time, with_seq_trace, dead_suspend, local_trace, saved_patterns, tracer_exit_on_stop, erl_tracer, distributed_erl_tracer]. @@ -623,99 +623,6 @@ file_port2(Config) when is_list(Config) -> end, ok. -%% Test that the scheduling timestamp fix for trace flag 'running' works. -file_port_schedfix(Config) when is_list(Config) -> - case (catch erlang:system_info(smp_support)) of - true -> - {skip, "No schedule fix on SMP"}; - _ -> - try - file_port_schedfix1(Config) - after - dbg:stop() - end - end. -file_port_schedfix1(Config) when is_list(Config) -> - stop(), - {A,B,C} = erlang:now(), - FTMP = atom_to_list(?MODULE) ++ integer_to_list(A) ++ - "-" ++ integer_to_list(B) ++ "-" ++ integer_to_list(C), - FName = filename:join([proplists:get_value(data_dir, Config), FTMP]), - %% - Port = dbg:trace_port(file, {FName, wrap, ".wraplog", 8*1024, 4}), - {ok, _} = dbg:tracer(port, Port), - {ok,[{matched,_node,0}]} = dbg:p(new,[running,procs,send,timestamp]), - %% - %% Generate the trace data - %% - %% This starts 3 processes that sends a message to each other in a ring, - %% 4 laps. Prior to sending the message to the next in the ring, each - %% process send 8 messages to itself, just to generate some trace data, - %% and to lower the possibility that the trace log wraps just after - %% a schedule out message (which would not burden any process and hence - %% not show up in the result) - %% - %% The wrap file trace is used because it burns a lot of time when the - %% driver swaps files, a lot more than the regular file trace. The test - %% case is dimensioned so that the log fills two files and just starts - %% on the third (out of four wrap files). This gives two file swaps, - %% and there are three processes, so one process will NOT be burdened. - %% The criterion for trace success is then that the max process - %% execution time must not be more than twice the min process - %% execution time. Wallclock. A normal result is about 10 times more - %% without schedule in - schedule out compensation (OTP-3938). - %% - ok = token_volleyball(3, 4, 8), - %% - {ok,[{matched,_,_}]} = dbg:p(all, [clear]), - stop(), - %% - %% Get the trace result - %% - Tag = make_ref(), - dbg:trace_client(file, {FName, wrap, ".wraplog"}, - {fun schedstat_handler/2, {self(), Tag, []}}), - Result = - receive - {Tag, D} -> - lists:map( - fun({Pid, {A1, B1, C1}}) -> - {Pid, C1/1000000 + B1 + A1*1000000} - end, - D) - end, - ok = io:format("Result=~p", [Result]), - % erlang:display({?MODULE, ?LINE, Result}), - %% - %% Analyze the result - %% - {Min, Max} = lists:foldl(fun({_Pid, M}, {Mi, Ma}) -> - {if M < Mi -> M; true -> Mi end, - if M > Ma -> M; true -> Ma end} - end, - {void, 0}, - Result), - % More PaN debug - io:format("Min = ~f, Max = ~f~n",[Min,Max]), - %% - %% Cleanup - %% - ToBeDeleted = filelib:wildcard(FName++"*"++".wraplog"), - lists:map(fun file:delete/1, ToBeDeleted), - % io:format("ToBeDeleted=~p", [ToBeDeleted]), - %% - %% Present the result - %% - P = (Max / Min - 1) * 100, - BottomLine = lists:flatten(io_lib:format("~.2f %", [P])), - if P > 100 -> - Reason = {BottomLine, '>', "100%"}, - erlang:display({file_port_schedfix, fail, Reason}), - ct:fail(Reason); - true -> - {comment, BottomLine} - end. - %% Test tracing to wrapping file port wrap_port(Config) when is_list(Config) -> Self = self(), diff --git a/lib/runtime_tools/test/dyntrace_SUITE.erl b/lib/runtime_tools/test/dyntrace_SUITE.erl index 7be2f49a8b..7ffbe54446 100644 --- a/lib/runtime_tools/test/dyntrace_SUITE.erl +++ b/lib/runtime_tools/test/dyntrace_SUITE.erl @@ -51,11 +51,7 @@ init_per_suite(Config) -> case erlang:system_info(debug_compiled) of false -> ""; true -> ".debug" - end ++ - case erlang:system_info(smp_support) of - false -> ""; - true -> ".smp" - end, + end ++ ".smp", [{emu_name,N}|Config]. end_per_suite(_Config) -> diff --git a/lib/runtime_tools/vsn.mk b/lib/runtime_tools/vsn.mk index d8a4ede136..872bd5db1d 100644 --- a/lib/runtime_tools/vsn.mk +++ b/lib/runtime_tools/vsn.mk @@ -1 +1 @@ -RUNTIME_TOOLS_VSN = 1.12.2 +RUNTIME_TOOLS_VSN = 1.12.3 diff --git a/lib/sasl/doc/src/Makefile b/lib/sasl/doc/src/Makefile index a66b1f8bcb..baf563ca62 100644 --- a/lib/sasl/doc/src/Makefile +++ b/lib/sasl/doc/src/Makefile @@ -9,11 +9,11 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. -# +# # The Initial Developer of the Original Code is Ericsson Utvecklings AB. # Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings # AB. All Rights Reserved.'' -# +# # $Id$ # include $(ERL_TOP)/make/target.mk @@ -44,17 +44,14 @@ XML_REF4_FILES = appup.xml rel.xml relup.xml script.xml XML_REF6_FILES = sasl_app.xml -XML_PART_FILES = part.xml part_notes.xml part_notes_history.xml +XML_PART_FILES = part.xml XML_CHAPTER_FILES = sasl_intro.xml \ error_logging.xml \ - notes.xml \ - notes_history.xml + notes.xml BOOK_FILES = book.xml -GIF_FILES = \ - note.gif \ - warning.gif +GIF_FILES = XML_FILES = \ $(BOOK_FILES) $(XML_CHAPTER_FILES) \ @@ -78,14 +75,14 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += +XML_FLAGS += # ---------------------------------------------------- # Targets # ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif +$(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ docs: pdf html man @@ -100,7 +97,7 @@ man: $(MAN3_FILES) $(MAN4_FILES) $(MAN6_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) # We depend just to copy them to ../html -debug opt: +debug opt: clean clean_docs: rm -rf $(HTMLDIR)/* @@ -108,11 +105,11 @@ clean clean_docs: rm -f $(MAN4DIR)/* rm -f $(MAN6DIR)/* rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ + rm -f errs core *~ # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs @@ -130,4 +127,3 @@ release_docs_spec: docs $(INSTALL_DATA) $(MAN6_FILES) "$(RELEASE_PATH)/man/man6" release_spec: - diff --git a/lib/sasl/doc/src/fascicules.xml b/lib/sasl/doc/src/fascicules.xml deleted file mode 100644 index 37feca543f..0000000000 --- a/lib/sasl/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/sasl/doc/src/note.gif b/lib/sasl/doc/src/note.gif Binary files differdeleted file mode 100644 index 6fffe30419..0000000000 --- a/lib/sasl/doc/src/note.gif +++ /dev/null diff --git a/lib/sasl/doc/src/notes.xml b/lib/sasl/doc/src/notes.xml index b144122c4b..e532c3cd6f 100644 --- a/lib/sasl/doc/src/notes.xml +++ b/lib/sasl/doc/src/notes.xml @@ -31,6 +31,26 @@ </header> <p>This document describes the changes made to the SASL application.</p> +<section><title>SASL 3.1.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The Report Browser, rb, could earlier not handle reports + that were not lists, for example generated by + <c>error_logger:info_report({some, tuple})</c>. This term + is allowed as input to error_logger, but rb would state + that "A report on bad form was encountered". This is now + corrected.</p> + <p> + Own Id: OTP-13906 Aux Id: ERL-261 </p> + </item> + </list> + </section> + +</section> + <section><title>SASL 3.1</title> <section><title>Improvements and New Features</title> diff --git a/lib/sasl/doc/src/part_notes.xml b/lib/sasl/doc/src/part_notes.xml deleted file mode 100644 index 8a32deefd9..0000000000 --- a/lib/sasl/doc/src/part_notes.xml +++ /dev/null @@ -1,39 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2004</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>SASL Release Notes</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p>The System Architecture Support Libraries, <em>SASL</em>, - provides support for alarm and release handling etc.</p> - <p>For information about older versions, see - <url href="part_notes_history_frame.html">Release Notes History</url>.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/sasl/doc/src/part_notes_history.xml b/lib/sasl/doc/src/part_notes_history.xml deleted file mode 100644 index abdf09d845..0000000000 --- a/lib/sasl/doc/src/part_notes_history.xml +++ /dev/null @@ -1,39 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part> - <header> - <copyright> - <year>2006</year> - <year>2016</year> - <holder>Ericsson AB, All Rights Reserved</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>SASL Release Notes History</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p>The System Architecture Support Libraries, <em>SASL</em>, - provides support for alarm and release handling etc.</p> - </description> - <include file="notes_history"></include> -</part> - diff --git a/lib/sasl/doc/src/warning.gif b/lib/sasl/doc/src/warning.gif Binary files differdeleted file mode 100644 index 96af52360e..0000000000 --- a/lib/sasl/doc/src/warning.gif +++ /dev/null diff --git a/lib/sasl/src/Makefile b/lib/sasl/src/Makefile index ac7ee51100..45cd814bf8 100644 --- a/lib/sasl/src/Makefile +++ b/lib/sasl/src/Makefile @@ -37,7 +37,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/sasl-$(VSN) MODULES= alarm_handler sasl sasl_report \ sasl_report_file_h sasl_report_tty_h format_lib_supp \ misc_supp rb rb_format_supp release_handler \ - release_handler_1 si si_sasl_supp systools \ + release_handler_1 systools \ systools_make systools_rc systools_relup systools_lib \ erlsrv diff --git a/lib/sasl/src/erlsrv.erl b/lib/sasl/src/erlsrv.erl index 29d40d362f..e0bbd37ee3 100644 --- a/lib/sasl/src/erlsrv.erl +++ b/lib/sasl/src/erlsrv.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. +%% Copyright Ericsson AB 1998-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -34,7 +34,7 @@ erlsrv(EVer) -> filename:join([Root, "erts-" ++ EVer, "bin", "erlsrv.exe"]). current_version() -> - hd(string:tokens(erlang:system_info(version),"_ ")). + hd(string:lexemes(erlang:system_info(version),"_ ")). %%% Returns {ok, Output} | failed | {error, Reason} run_erlsrv(Command) -> @@ -107,7 +107,7 @@ get_all_services() -> []; {ok, [_H|T]} -> F = fun(X) -> - hd(string:tokens(X,"\t ")) + hd(string:lexemes(X,"\t ")) end, lists:map(F,T); _ -> @@ -191,8 +191,8 @@ get_service(EVer, ServiceName) -> %%% have in the environment list... EnvParts = lists:map( fun(S) -> - X = string:strip(S,left,$\t), - case hd(string:tokens(X,"=")) of + X = string:trim(S, leading, "$\t"), + case hd(string:lexemes(X,"=")) of X -> %% Can this happen? {X,""}; @@ -371,7 +371,7 @@ split_arglist([H|T]) -> parse_arglist(Str) -> lists:reverse(parse_arglist(Str,[])). parse_arglist(Str,Accum) -> - Stripped = string:strip(Str,left), + Stripped = string:trim(Str, leading), case length(Stripped) of 0 -> Accum; @@ -432,14 +432,9 @@ split_by_env(Data) -> splitline(Line) -> - case string:chr(Line,$:) of - 0 -> + case string:split(Line, ":") of + [_] -> {Line, ""}; - N -> - case length(string:substr(Line,N)) of - 1 -> - {string:substr(Line,1,N-1),""}; - _ -> - {string:substr(Line,1,N-1),string:substr(Line,N+2)} - end + [N, V] -> + {N, string:slice(V, 1)} end. diff --git a/lib/sasl/src/format_lib_supp.erl b/lib/sasl/src/format_lib_supp.erl index 80dcdc91da..2d37dfe117 100644 --- a/lib/sasl/src/format_lib_supp.erl +++ b/lib/sasl/src/format_lib_supp.erl @@ -86,8 +86,10 @@ print_data(Device, Line, [{Key, Value}|T]) -> print_data(Device, Line, [Value|T]) -> Modifier = misc_supp:modifier(Device), io:format(Device, "~"++Modifier++"p~n", [Value]), - print_data(Device, Line, T). - + print_data(Device, Line, T); +print_data(Device, _Line, Value) -> + Modifier = misc_supp:modifier(Device), + io:format(Device, "~"++Modifier++"p~n", [Value]). print_items(Device, Line, {Name, Items}) -> print_items(Device, Line, Name, Items). @@ -100,13 +102,13 @@ print_newlines(Device, N) when N > 0 -> print_one_line(Device, Line, Key, Value) -> Modifier = misc_supp:modifier(Device), StrKey = term_to_string(Key,Modifier), - KeyLen = lists:min([length(StrKey), Line]), + KeyLen = lists:min([string:length(StrKey), Line]), ValueLen = Line - KeyLen, Format1 = lists:concat(["~-", KeyLen, Modifier, "s"]), Format2 = lists:concat(["~", ValueLen, Modifier, "s~n"]), io:format(Device, Format1, [StrKey]), Try = term_to_string(Value,Modifier), - Length = length(Try), + Length = string:length(Try), if Length < ValueLen -> io:format(Device, Format2, [Try]); @@ -117,7 +119,7 @@ print_one_line(Device, Line, Key, Value) -> end. term_to_string(Value,Modifier) -> - lists:flatten(io_lib:format(get_format(Value,Modifier), [Value])). + io_lib:format(get_format(Value,Modifier), [Value]). get_format([],_) -> "~p"; diff --git a/lib/sasl/src/rb.erl b/lib/sasl/src/rb.erl index 6595d29a9c..28829132a1 100644 --- a/lib/sasl/src/rb.erl +++ b/lib/sasl/src/rb.erl @@ -586,14 +586,14 @@ find_widths([], _Modifier, DescrWidth, DateWidth, Data) -> {DescrWidth+1, DateWidth+1, lists:reverse(Data)}; find_widths([H|T], Modifier, DescrWidth, DateWidth, Data) -> DescrTerm = element(3,H), - Descr = lists:flatten(io_lib:format("~"++Modifier++"w", [DescrTerm])), - DescrTry = length(Descr), + Descr = io_lib:format("~"++Modifier++"w", [DescrTerm]), + DescrTry = string:length(Descr), NewDescrWidth = if DescrTry > DescrWidth -> DescrTry; true -> DescrWidth end, - DateTry = length(element(4, H)), + DateTry = string:length(element(4, H)), NewDateWitdh = if DateTry > DateWidth -> DateTry; diff --git a/lib/sasl/src/rb_format_supp.erl b/lib/sasl/src/rb_format_supp.erl index 1eda43dae4..b5b7aba151 100644 --- a/lib/sasl/src/rb_format_supp.erl +++ b/lib/sasl/src/rb_format_supp.erl @@ -108,7 +108,7 @@ print(Date, Report, Device) -> format_h(Line, Header, Pid, Date) -> NHeader = lists:flatten(io_lib:format("~s ~w", [Header, Pid])), - DateLen = length(Date), + DateLen = string:length(Date), HeaderLen = Line - DateLen, Format = lists:concat(["~-", HeaderLen, "s~", DateLen, "s"]), io_lib:format(Format, [NHeader, Date]). diff --git a/lib/sasl/src/release_handler.erl b/lib/sasl/src/release_handler.erl index d0a7c7332d..bfa49fc05d 100644 --- a/lib/sasl/src/release_handler.erl +++ b/lib/sasl/src/release_handler.erl @@ -420,7 +420,7 @@ upgrade_app(App, NewDir) -> %% located in the ebin dir of the _current_ version %%----------------------------------------------------------------- downgrade_app(App, OldDir) -> - case string:tokens(filename:basename(OldDir), "-") of + case string:lexemes(filename:basename(OldDir), "-") of [_AppS, OldVsn] -> downgrade_app(App, OldVsn, OldDir); _ -> @@ -1174,8 +1174,8 @@ new_emulator_rm_tmp_release(_,_,_,_,Releases,_) -> %% Rename the tempoarary service (for erts ugprade) to the real ToVsn rename_tmp_service(EVsn,TmpVsn,NewVsn) -> - FromName = hd(string:tokens(atom_to_list(node()),"@")) ++ "_" ++ TmpVsn, - ToName = hd(string:tokens(atom_to_list(node()),"@")) ++ "_" ++ NewVsn, + FromName = hd(string:lexemes(atom_to_list(node()),"@")) ++ "_" ++ TmpVsn, + ToName = hd(string:lexemes(atom_to_list(node()),"@")) ++ "_" ++ NewVsn, case erlsrv:get_service(EVsn,ToName) of {error, _Error} -> ok; @@ -1207,9 +1207,9 @@ rename_service(EVsn,FromName,ToName) -> %%% in which case we try to rename the old service to the new name and try %%% to update heart's view of what service we are really running. do_make_services_permanent(PermanentVsn,Vsn, PermanentEVsn, EVsn) -> - PermName = hd(string:tokens(atom_to_list(node()),"@")) + PermName = hd(string:lexemes(atom_to_list(node()),"@")) ++ "_" ++ PermanentVsn, - Name = hd(string:tokens(atom_to_list(node()),"@")) + Name = hd(string:lexemes(atom_to_list(node()),"@")) ++ "_" ++ Vsn, case erlsrv:get_service(EVsn,Name) of {error, _Error} -> @@ -1296,7 +1296,7 @@ do_make_permanent(#state{releases = Releases, do_back_service(OldVersion, CurrentVersion,OldEVsn,CurrentEVsn) -> - NN = hd(string:tokens(atom_to_list(node()),"@")), + NN = hd(string:lexemes(atom_to_list(node()),"@")), OldName = NN ++ "_" ++ OldVersion, CurrentName = NN ++ "_" ++ CurrentVersion, UpdData = case erlsrv:get_service(CurrentEVsn,CurrentName) of @@ -1385,7 +1385,7 @@ do_remove_service(Vsn) -> %% Very unconditionally remove the service. %% Note that the service could already have been removed when %% making another release permanent. - ServiceName = hd(string:tokens(atom_to_list(node()),"@")) + ServiceName = hd(string:lexemes(atom_to_list(node()),"@")) ++ "_" ++ Vsn, case erlsrv:get_service(ServiceName) of {error, _Error} -> @@ -1670,9 +1670,9 @@ flush() -> prepare_restart_nt(#release{erts_vsn = EVsn, vsn = Vsn}, #release{erts_vsn = PermEVsn, vsn = PermVsn}, DataFileName) -> - CurrentServiceName = hd(string:tokens(atom_to_list(node()),"@")) + CurrentServiceName = hd(string:lexemes(atom_to_list(node()),"@")) ++ "_" ++ PermVsn, - FutureServiceName = hd(string:tokens(atom_to_list(node()),"@")) + FutureServiceName = hd(string:lexemes(atom_to_list(node()),"@")) ++ "_" ++ Vsn, CurrentService = case erlsrv:get_service(PermEVsn,CurrentServiceName) of {error, _} = Error1 -> diff --git a/lib/sasl/src/sasl.app.src b/lib/sasl/src/sasl.app.src index b7bb9133ff..1e8e58a978 100644 --- a/lib/sasl/src/sasl.app.src +++ b/lib/sasl/src/sasl.app.src @@ -32,8 +32,6 @@ sasl_report, sasl_report_tty_h, sasl_report_file_h, - si, - si_sasl_supp, systools, systools_make, systools_rc, diff --git a/lib/sasl/src/sasl.appup.src b/lib/sasl/src/sasl.appup.src index dcb568c413..94af164b20 100644 --- a/lib/sasl/src/sasl.appup.src +++ b/lib/sasl/src/sasl.appup.src @@ -18,11 +18,7 @@ %% %CopyrightEnd% {"%VSN%", %% Up from - max one major revision back - [{<<"3\\.0((\\.[0-3])(\\.[0-9]+)*)?">>,[restart_new_emulator]}, % OTP-19.* - {<<"3\\.0\\.[4-9](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.0* - {<<"3\\.1(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-20.1* + [{<<"3\\.0\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-20.* %% Down to - max one major revision back - [{<<"3\\.0((\\.[0-3])(\\.[0-9]+)*)?">>,[restart_new_emulator]}, % OTP-19.* - {<<"3\\.0\\.[4-9](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.0* - {<<"3\\.1(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-20.1* + [{<<"3\\.0\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-20.* }. diff --git a/lib/sasl/src/si.erl b/lib/sasl/src/si.erl deleted file mode 100644 index 275c6d508b..0000000000 --- a/lib/sasl/src/si.erl +++ /dev/null @@ -1,169 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%%----------------------------------------------------------------- -%% l(format_lib_supp), l(si_sasl_supp), l(si), l(si_ms_aos_supp), l(misc_supp). -%% c(format_lib_supp), c(si_sasl_supp), c(si), c(si_ms_aos_supp), c(misc_supp). -%%----------------------------------------------------------------- - - -%%-------------------------------------------------- -%% Description: -%% Status Inspection, main module. -%%-------------------------------------------------- - --module(si). - - -%% External exports --export([h/0, help/0, start/0, start/1, start_log/1, stop_log/0, - abbrevs/0, pi/1, pi/2, pi/3, pi/4, ppi/1, ppi/3, stop/0]). - -%% Internal exports --export([pi_impl/2, test/0]). - - -%%-------------------------------------------------- -%% Table of contents -%% 1. Interface -%% 2. Implementation - - --import(si_sasl_supp, [status_info/1, make_pid/1, p/1]). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% 1. Interface -%%-------------------------------------------------- - -h() -> print_help(). -help() -> print_help(). - -start() -> si_sasl_supp:start(). -start(Options) -> si_sasl_supp:start(Options). - -stop() -> si_sasl_supp:stop(). - -start_log(FileName) -> - si_sasl_supp:start_log(FileName). - -stop_log() -> - si_sasl_supp:stop_log(). - -%%%----------------------------------------------------------------- -%%% All functions can be called with an option 'normal' or 'all'; -%%% default is 'normal'. -%%%----------------------------------------------------------------- - -abbrevs() -> - io:format("~p", [lists:append(si_sasl_supp:process_abbrevs(), - process_abbrevs())]). - -%%----------------------------------------------------------------- -%% Process Info that tries to determine processtype (=Module), then -%% it uses this Module:format_info to format data from status_info/1. -%%----------------------------------------------------------------- -pi(XPid) -> - si_sasl_supp:si_exec({si, pi_impl}, [normal, XPid]). - -pi(Opt, XPid) -> - si_sasl_supp:si_exec({si, pi_impl}, [si_sasl_supp:valid_opt(Opt), XPid]). - -pi(A, B, C) when is_integer(A), is_integer(B), is_integer(C) -> - si_sasl_supp:si_exec({si, pi_impl}, [normal, {A, B, C}]). - -pi(Opt, A, B, C) when is_integer(A), is_integer(B), is_integer(C) -> - si_sasl_supp:si_exec({si, pi_impl}, [si_sasl_supp:valid_opt(Opt), {A, B, C}]). - -%%----------------------------------------------------------------- -%% Pretty print Process_Info. -%%----------------------------------------------------------------- -ppi(XPid) -> - si_sasl_supp:ppi(XPid). -ppi(A, B, C) -> - si_sasl_supp:ppi(A, B, C). - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% 2. Implementation -%%-------------------------------------------------- - -print_help() -> - p("~nStatus Inspection tool - usage"), - p("=============================="), - p(" For all these functions, Opt is an optional argument"), - p(" which can be 'normal' or 'all'; default is 'normal'."), - p(" If 'all', all information will be printed."), - p(" A Pid can be: \"<A.B.C>\", {A, B, C}, B, a registered_name or an abbrev."), - p("ANY PROCESS"), - p("si:pi([Opt,] Pid) - Formatted information about any process that"), - p(" SI recognises."), - p("si:pi([Opt,] A,B,C) - Same as si:pi({A, B, C})."), - p("si:ppi(Pid) - Pretty formating of process_info."), - p(" Works for any process."), - p("MISC"), - p("si:abbrevs() - Lists valid abbreviations."), - p("si:start_log(Filename) - Logging to file."), - p("si:stop_log()"), - p("si:start() - Starts Status Inspection (the si_server)."), - p("si:start([{start_log, FileName}])"), - p("si:stop() - Shut down SI."). - - -%%-------------------------------------------------- -%% Copied (and modified) code from si_sasl_supp. -%%-------------------------------------------------- -pi_impl(Opt, XPid) -> - case make_pid(try_local_expand_abbrev(XPid)) of - Pid when is_pid(Pid) -> - case status_info(Pid) of - {status_info, Pid, {module, Module}, Data} -> - si_sasl_supp:do_best_printout(Opt, Pid, Module, Data); - {error, Reason} -> - _ = si_sasl_supp:ppi_impl(Pid), - {error, {"can not get status info from process:", - XPid, - Reason}}; - Else -> - {error, {"unknown status info", Else}} - end; - {error, Reason} -> - {error, Reason} - end. - -%%-------------------------------------------------- -%% Functions for handling of abbreviations -%%-------------------------------------------------- -try_local_expand_abbrev(Abbrev) -> - case si_sasl_supp:expand_abbrev(Abbrev, process_abbrevs()) of - {value, {_, RealName}} -> RealName; - _ -> Abbrev - end. - -process_abbrevs() -> - []. - -%% Test get_status_info/format_status_info for all implemented servers. -test() -> - lists:foreach(fun test_all_registered/1, - lists:append(si_sasl_supp:process_abbrevs(), - process_abbrevs())). - -test_all_registered({Al, _Ful}) -> - si:pi(all, Al). diff --git a/lib/sasl/src/si_sasl_supp.erl b/lib/sasl/src/si_sasl_supp.erl deleted file mode 100644 index cce628f8c4..0000000000 --- a/lib/sasl/src/si_sasl_supp.erl +++ /dev/null @@ -1,380 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(si_sasl_supp). - --behaviour(gen_server). - -%%%--------------------------------------------------------------------------- -%%% Description: -%%% This module contains the BOS specific parts of the Status Inspection Tool. -%%%--------------------------------------------------------------------------- - - -%% user interface --export([h/0, help/0, start_log/1, stop_log/0, abbrevs/0, pi/1, pi/2, pi/3, - pi/4, ppi/1, ppi/3, start/0, start/1, stop/0, start_link/1]). - -%% intermodule exports --export([make_pid/1, make_pid/3, process_abbrevs/0, expand_abbrev/2, - status_info/1, valid_opt/1, p/1, do_best_printout/4, - si_exec/2, handle_call/3, terminate/2]). - -%% exports for use within module --export([init/1, start_log_impl/1, pi_impl/2, ppi_impl/1]). - -%% other gen_server callbacks (not used) --export([handle_cast/2, handle_info/2, code_change/3]). - -%%-------------------------------------------------- -%% Table of contents -%% 1. Interface -%% 2. SI - Server -%% 3. Code -%% 4. Selectors -%%-------------------------------------------------- - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% 1. Interface -%% ----------------------------------------------------- - -h() -> print_help(). -help() -> print_help(). - -si_exec(Fun, Args) -> call({si_exec, Fun, Args}). - -start_log(FileName) -> - call({start_log, FileName}). - -stop_log() -> - call(stop_log). - -abbrevs() -> - io:format("~p", [process_abbrevs()]). - -%%----------------------------------------------------------------- -%% All functions can be called with an option 'normal' or 'all'; -%% default is 'normal'. -%%----------------------------------------------------------------- -%% Process Info that tries to determine processtype (=Module), then -%% it uses this Module:format_info to format data from status_info/1. -%%----------------------------------------------------------------- -pi(XPid) -> - si_exec({si_sasl_supp, pi_impl}, [normal, XPid]). - -pi(Opt, XPid) -> - si_exec({si_sasl_supp, pi_impl}, [valid_opt(Opt), XPid]). - -pi(A, B, C) when is_integer(A), is_integer(B), is_integer(C) -> - si_exec({si_sasl_supp, pi_impl}, [normal, {A, B, C}]). - -pi(Opt, A, B, C) when is_integer(A), is_integer(B), is_integer(C) -> - si_exec({si_sasl_supp, pi_impl}, [valid_opt(Opt), {A, B, C}]). - -%%----------------------------------------------------------------- -%% Pretty print Process_Info. -%%----------------------------------------------------------------- -ppi(XPid) -> - case whereis(si_server) of - undefined -> % You can always run ppi. - ppi_impl(XPid); % if si_server is down, use standard_io - _ -> - si_exec({si_sasl_supp, ppi_impl}, [XPid]) - end. -ppi(A, B, C) -> - case whereis(si_server) of - undefined -> % You can always run ppi. - ppi_impl({A, B, C}); % if si_server is down, use standard_io - _ -> - si_exec({si_sasl_supp, ppi_impl}, [{A, B, C}]) - end. - - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% 2. SI - Server -%%-------------------------------------------------- --record(state, {}). - -start() -> start([]). -start(Options) -> - supervisor:start_child(sasl_sup, - {si_server, {si_sasl_supp, start_link, [Options]}, - temporary, brutal_kill, worker, [si_sasl_supp]}). - -start_link(_Options) -> - gen_server:start_link({local, si_server}, si_sasl_supp, [], []). - -stop() -> - call(stop), - supervisor:delete_child(sasl_sup, si_server). - - -init(Options) -> - process_flag(trap_exit, true), - start_log_impl(get_option(Options, start_log, standard_io)), - {ok, #state{}}. - -%%----------------------------------------------------------------- -%% If an error occurs and we're logging to file: write the error -%% to the file. -%% Always return the error. -%% The only data held by the si_server is the device in its process dictionary. -%%----------------------------------------------------------------- -handle_call({si_exec, Fun, Args}, _From, State) -> - case catch apply(Fun, Args) of - {'EXIT', Reason} -> - print_error(get(device), - "SI internal error. Reason: ~w~n", - [Reason]), - {stop, shutdown, {internal_error, Reason}, State}; - {error, Reason} -> - print_error(get(device), "~nSI error: ~w~n", [Reason]), - {reply, {error, Reason}, State}; - X -> - {reply, X, State} - end; -handle_call({start_log, FileName}, _From, State) -> - start_log_impl(FileName), - {reply, ok, State}; -handle_call(stop_log, _From, State) -> - start_log_impl(standard_io), - {reply, ok, State}; -handle_call(stop, _From, State) -> - start_log_impl(standard_io), - {stop, normal, stopped, State}. - -terminate(_Reason, _State) -> - _ = close_device(get(device)), - ok. - -handle_cast(_Msg, State) -> - {noreply, State}. -handle_info(_Info, State) -> - {noreply, State}. -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - -close_device(standard_io) -> ok; -close_device(Fd) -> file:close(Fd). - -print_error(standard_io, _, _) -> ok; -print_error(Device, Format, Args) -> - io:format(Device, Format, Args). - -get_option(Options, Key, Default) -> - case lists:keysearch(Key, 1, Options) of - {value, {_Key, Value}} -> Value; - _ -> Default - end. - -open_log_file(undefined, NewFile) -> - open_log_file(NewFile); -open_log_file(standard_io, NewFile) -> - open_log_file(NewFile); -open_log_file(OldFile, NewFile) -> - _ = file:close(OldFile), - open_log_file(NewFile). - -open_log_file(standard_io) -> standard_io; -open_log_file(FileName) -> - case file:open(FileName, [write]) of - {ok, Fd} -> Fd; - Error -> - io:format("si_sasl_supp: Cannot open file '~s' (~w).~n", - [FileName, Error]), - io:format("si_sasl_supp: Using standard_io~n"), - standard_io - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% 3. Code -%%-------------------------------------------------- - -%%----------------------------------------------------------------- -%% call(Request) -> Term -%%----------------------------------------------------------------- -call(Req) -> - gen_server:call(si_server, Req, infinity). - -%%-------------------------------------------------- -%% Makes a Pid of almost anything. -%% Returns: Pid|{error, Reason} -%% Fails: Never. -%%-------------------------------------------------- -make_pid(A,B,C) when is_integer(A), is_integer(B), is_integer(C) -> - list_to_pid(lists:concat(["<",A,".",B,".",C,">"])). -make_pid(P) when is_pid(P) -> P; -make_pid(undefined) -> undefined; -make_pid(P) when is_atom(P) -> - case whereis(P) of - undefined -> - case expand_abbrev(P, process_abbrevs()) of - {error, Reason} -> {error, Reason}; - {value, {_Abbrev, FullName}} -> - case whereis(FullName) of - undefined -> - {error, {'process not registered', P}}; - Pid -> Pid - end - end; - Pid -> Pid - end; -make_pid(P) when is_list(P) -> list_to_pid(P); -make_pid({A, B, C}) -> make_pid(A, B, C); -make_pid(X) -> {error, {'can not make a pid of', X}}. - -process_abbrevs() -> - [{init, init}, - {fs, file_server}]. - -%%-------------------------------------------------- -%% Args: Abbrevs is an assoc-list of {Abbrev, RealName} -%% Returns: {value, {Abbrev, FullName}}|{error, Reason} -%%-------------------------------------------------- -expand_abbrev(ProcessName, Abbrevs) -> - case lists:keysearch(ProcessName, 1, Abbrevs) of - {value, {Abbrev, FullName}} -> - {value, {Abbrev, FullName}}; - _ -> - case lists:keysearch(ProcessName, 2, Abbrevs) of - {value, {Abbrev, FullName}} -> - {value, {Abbrev, FullName}}; - _ -> - {error, {'invalid process name', ProcessName}} - end - end. - -%%----------------------------------------------------------------- -%% This is the function that actually gets the information out -%% of the agent/server/... -%% Returns: {status_info, Pid, Type, Data} -%% | {error, Reason} -%%----------------------------------------------------------------- -status_info(Pid) when is_pid(Pid) -> - case catch sys:get_status(Pid, 5000) of - {status, Pid, Type, Info} -> - {status_info, Pid, Type, Info}; - _ -> - {error, {'process does not respond', Pid}} - end; - -status_info(X) -> - {error, {'not a pid', X}}. - -%%-------------------------------------------------- -%% Implementation starts here. -%%-------------------------------------------------- -start_log_impl(FileName) -> - put(device, open_log_file(get(device), FileName)). - -valid_opt(all) -> all; -valid_opt(_Opt) -> normal. - - -print_help() -> - p("- - - - - - - - PROCESSES - - - - - - - - - "), - p("si_sasl_supp:pi([Opt,] Pid) - Formatted information about any process that"), - p(" SI recognises."), - p("si_sasl_supp:pi([Opt,] A,B,C) - Same as si_sasl_supp:pi({A, B, C})."), - p("si_sasl_supp:ppi(Pid) - Pretty formating of process_info."), - p(" Works for any process."), - p("- - - - - - - - MISC - - - - - - - - - - - "), - p("si_sasl_supp:abbrevs() - Lists valid abbreviations."), - p("si_sasl_supp:start_log(FileNname)"), - p("si_sasl_supp:stop_log()"), - p("si_sasl_supp:start() - Starts Status Inspection (the si_server)."), - p("si_sasl_supp:start([{start_log, FileName}])"), - p("si_sasl_supp:stop() - Shut down SI."). - - - -%% Convenient shorthand -p(X) -> - io:format(lists:append(X, "~n")). - -pi_impl(Opt, XPid) -> - case make_pid(XPid) of - Pid when is_pid(Pid) -> - case status_info(Pid) of - {status_info, Pid, {module, Module}, Data} -> - do_best_printout(Opt, Pid, Module, Data); - {error, Reason} -> - _ = ppi_impl(Pid), - {error, {"can not get status info from process:", - XPid, - Reason}} - end; - {error, Reason} -> - {error, Reason} - end. - -%%-------------------------------------------------- -%% Is there a format_info for this process? In that case, run it! -%% Return ok|{error, Reason} -%% Fails: Never. -%%-------------------------------------------------- -do_best_printout(Opt, Pid, Mod, Data) when is_pid(Pid) -> - case print_info(get(device), Pid, {Mod, format_status}, Opt, Data) of - ok -> ok; - {error, Reason} -> - _ = ppi_impl(Pid), - {error, Reason} - end. - -ppi_impl(XPid) -> - case make_pid(XPid) of - P when is_pid(P) -> - case process_info(P) of - undefined -> - {error, {'dead process', P}}; - PI -> - Device = case get(device) of - undefined -> standard_io; - X -> X - end, - io:format(Device, "~nPretty Process Info~n", []), - io:format(Device, "-------------------~n", []), - io:format(Device, "~p~n", [PI]) - end; - _ -> {error, {no_pid, XPid}} - end. - -print_info(Device, Pid, {Module, Func}, Opt, Data) -> - case erlang:function_exported(Module, Func, 2) of - true -> - case catch apply(Module, Func, [Opt, Data]) of - Format when is_list(Format) -> - format_lib_supp:print_info(Device, 79, - add_pid_to_format(Pid, Format)), - ok; - Other -> {error, {'invalid format', Other}} - end; - _ -> - {error, {no_such_function, Module, Func}} - end. - -add_pid_to_format(Pid, [{header, H} | T]) -> - [{header, H}, {data, [{"Pid", Pid}]} | T]; -add_pid_to_format(Pid, List) -> - [{data, [{"Pid", Pid}]} | List]. - - diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl index 391b1fb5cc..9d960b7361 100644 --- a/lib/sasl/src/systools_make.erl +++ b/lib/sasl/src/systools_make.erl @@ -1501,7 +1501,7 @@ preloaded() -> [erl_prim_loader,erl_tracer,erlang, erts_code_purger,erts_dirty_process_code_checker, erts_internal,erts_literal_area_collector, - init,otp_ring0,prim_eval,prim_file, + init,otp_ring0,prim_buffer,prim_eval,prim_file, prim_inet,prim_zip,zlib]. %%______________________________________________________________________ diff --git a/lib/sasl/test/rb_SUITE.erl b/lib/sasl/test/rb_SUITE.erl index 426dedbab5..4ba2540545 100644 --- a/lib/sasl/test/rb_SUITE.erl +++ b/lib/sasl/test/rb_SUITE.erl @@ -36,6 +36,7 @@ no_group_cases() -> groups() -> [{running_error_logger,[shuffle],[show, + show_other, list, rescan, start_stop_log, @@ -165,6 +166,23 @@ show(Config) -> ok. +show_other(Config) -> + PrivDir = ?config(priv_dir,Config), + OutFile = filename:join(PrivDir,"rb_SUITE_log.txt"), + + %% Insert some reports in the error log and start rb + error_logger:info_report([rb_test_term_in_list]), + error_logger:info_report(rb_test_term_no_list), + ok = start_rb(OutFile), + + %% Show by type and check content + [{_,I1},{_,I2}] = check_report(fun() -> rb:show(info_report) end,OutFile), + + true = contains(I1,"rb_test_term_no_list"), + true = contains(I2,"rb_test_term_in_list"), + + ok. + list(Config) -> PrivDir = ?config(priv_dir,Config), OutFile = filename:join(PrivDir,"rb_SUITE_log.txt"), diff --git a/lib/sasl/test/release_handler_SUITE.erl b/lib/sasl/test/release_handler_SUITE.erl index 50932e89e4..4935782cf2 100644 --- a/lib/sasl/test/release_handler_SUITE.erl +++ b/lib/sasl/test/release_handler_SUITE.erl @@ -1384,9 +1384,9 @@ upgrade_supervisor(Conf) when is_list(Conf) -> %% Check that the restart strategy and child spec is updated {status, _, {module, _}, [_, _, _, _, [_,_,{data,[{"State",State}]}|_]]} = rpc:call(Node,sys,get_status,[a_sup]), - {state,_,RestartStrategy,[Child],_,_,_,_,_,_,_} = State, + {state,_,RestartStrategy,{[a],Db},_,_,_,_,_,_,_} = State, one_for_all = RestartStrategy, % changed from one_for_one - {child,_,_,_,_,brutal_kill,_,_} = Child, % changed from timeout 2000 + {child,_,_,_,_,brutal_kill,_,_} = maps:get(a,Db), % changed from timeout 2000 ok. @@ -1835,24 +1835,32 @@ otp_10463_upgrade_script_regexp(cleanup,Config) -> code:del_path(filename:join([DataDir,regexp_appup,app1,ebin])), ok. -no_dot_erlang(Conf) -> - PrivDir = ?config(data_dir,Conf), - {ok, OrigWd} = file:get_cwd(), - try - ok = file:set_cwd(PrivDir), - - {ok, Wd} = file:get_cwd(), - io:format("Dir ~ts~n", [Wd]), +no_dot_erlang(_Conf) -> + case init:get_argument(home) of + {ok,[[Home]]} when is_list(Home) -> + no_dot_erlang_1(Home); + _ -> ok + end. +no_dot_erlang_1(Home) -> + DotErlang = filename:join(Home, ".erlang"), + BupErlang = filename:join(Home, ".erlang_testbup"), + try + {ok, Wd} = file:get_cwd(), + case filelib:is_file(DotErlang) of + true -> {ok, _} = file:copy(DotErlang, BupErlang); + false -> ok + end, Erl0 = filename:join([code:root_dir(),"bin","erl"]), Erl = filename:nativename(Erl0), Quote = "\"", Args = " -noinput -run c pwd -run erlang halt", - ok = file:write_file(".erlang", <<"io:put_chars(\"DOT_ERLANG_READ\\n\").\n">>), + ok = file:write_file(DotErlang, <<"io:put_chars(\"DOT_ERLANG_READ\\n\").\n">>), CMD1 = Quote ++ Erl ++ Quote ++ Args , case os:cmd(CMD1) of - "DOT_ERLANG_READ" ++ _ -> ok; + "DOT_ERLANG_READ" ++ _ -> + io:format("~p: Success~n", [?LINE]); Other1 -> io:format("Failed: ~ts~n",[CMD1]), io:format("Expected: ~s ++ _~n",["DOT_ERLANG_READ "]), @@ -1862,7 +1870,7 @@ no_dot_erlang(Conf) -> NO_DOT_ERL = " -boot no_dot_erlang", CMD2 = Quote ++ Erl ++ Quote ++ NO_DOT_ERL ++ Args, case lists:prefix(Wd, Other2 = os:cmd(CMD2)) of - true -> ok; + true -> io:format("~p: Success~n", [?LINE]); false -> io:format("Failed: ~ts~n",[CMD2]), io:format("Expected: ~s~n",["TESTOK"]), @@ -1870,9 +1878,13 @@ no_dot_erlang(Conf) -> exit({failed_to_start, no_dot_erlang}) end after - _ = file:delete(".erlang"), - ok = file:set_cwd(OrigWd), - ok + case filelib:is_file(BupErlang) of + true -> + {ok, _} = file:copy(BupErlang, DotErlang), + _ = file:delete(BupErlang); + false -> + _ = file:delete(DotErlang) + end end. %%%----------------------------------------------------------------- diff --git a/lib/sasl/test/test_lib.hrl b/lib/sasl/test/test_lib.hrl index 9a54937f96..f5210d4f27 100644 --- a/lib/sasl/test/test_lib.hrl +++ b/lib/sasl/test/test_lib.hrl @@ -1,3 +1,3 @@ -define(ertsvsn,"4.4"). --define(kernelvsn,"5.0"). --define(stdlibvsn,"3.0"). +-define(kernelvsn,"5.3"). +-define(stdlibvsn,"3.4"). diff --git a/lib/sasl/vsn.mk b/lib/sasl/vsn.mk index e980a42688..2488197ec5 100644 --- a/lib/sasl/vsn.mk +++ b/lib/sasl/vsn.mk @@ -1 +1 @@ -SASL_VSN = 3.1 +SASL_VSN = 3.1.1 diff --git a/lib/snmp/doc/src/Makefile b/lib/snmp/doc/src/Makefile index 9ea5dba0c5..3ebee792f9 100644 --- a/lib/snmp/doc/src/Makefile +++ b/lib/snmp/doc/src/Makefile @@ -1,9 +1,9 @@ #-*-makefile-*- ; force emacs to enter makefile-mode # %CopyrightBegin% -# -# Copyright Ericsson AB 1997-2016. All Rights Reserved. -# +# +# Copyright Ericsson AB 1997-2017. All Rights Reserved. +# # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at @@ -15,7 +15,7 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. -# +# # %CopyrightEnd% include $(ERL_TOP)/make/target.mk @@ -66,7 +66,6 @@ HTML_REF6_FILES = $(XML_REF6_FILES:%.xml=$(HTMLDIR)/%.html) HTML_CHAP_FILES = $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html) EXTRA_FILES = \ - summary.html.src \ $(DEFAULT_HTML_FILES) \ $(HTML_REF1_FILES) \ $(HTML_REF3_FILES) \ @@ -85,18 +84,14 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -INDEX_FILE = index.html -INDEX_SRC = $(INDEX_FILE).src -INDEX_TARGET = $(DOCDIR)/$(INDEX_FILE) - GIF_TARGETS = $(GIF_FILES:%=$(HTMLDIR)/%) # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += +XML_FLAGS += +DVIPS_FLAGS += # ---------------------------------------------------- # Targets @@ -106,21 +101,17 @@ $(HTMLDIR)/%.gif: %.gif # Copy them to ../html docs: pdf html man -ldocs: local_docs $(INDEX_TARGET) +ldocs: local_docs $(TOP_PDF_FILE): $(XML_FILES) pdf: $(TOP_PDF_FILE) html: gifs $(HTML_REF_MAN_FILE) -html2: html $(INDEX_TARGET) clean clean_docs: clean_html clean_man clean_pdf rm -f errs core *~ -$(INDEX_TARGET): $(INDEX_SRC) ../../vsn.mk # Create top make file - $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ # inserting version number - man: man1 man3 man6 man7 man1: $(MAN1_FILES) @@ -133,7 +124,7 @@ man7: $(MAN7_FILES) gifs: $(GIF_TARGETS) -debug opt: +debug opt: clean_pdf: @echo "cleaning pdf:" @@ -149,7 +140,6 @@ clean_man: clean_html: @echo "cleaning html:" rm -rf $(HTMLDIR)/* - rm -f $(INDEX_TARGET) $(MAN7DIR)/%.7: $(MIBSDIR)/%.mib @echo "processing $*" @@ -162,7 +152,7 @@ $(MAN7DIR)/%.7: $(MIBSDIR)/%.mib # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- $(MAN1DIR)/snmpc.1: snmpc_cmd.xml date=`date +"%B %e %Y"`; \ @@ -194,7 +184,7 @@ info: info_xml info_man info_html @echo "MAN6DIR: $(MAN6DIR)" @echo "MAN7DIR: $(MAN7DIR)" -info_man: +info_man: @echo "man files:" @echo "MAN1_FILES = $(MAN1_FILES)" @echo "MAN3_FILES = $(MAN3_FILES)" @@ -203,7 +193,7 @@ info_man: @echo "" @echo "MIB_FILES = $(MIB_FILES)" -info_xml: +info_xml: @echo "xml files:" # @echo "XML_REF1_FILES = $(XML_REF1_FILES)" @echo "XML_REF3_FILES = $(XML_REF3_FILES)" @@ -221,9 +211,7 @@ info_xml: info_html: @echo "html files:" @echo "DOCDIR = $(DOCDIR)" - @echo "INDEX_FILE = $(INDEX_FILE)" - @echo "INDEX_SRC = $(INDEX_SRC)" - @echo "INDEX_TARGET = $(INDEX_TARGET)" + @echo "HTML_REF_MAN_FILE = $(HTML_REF_MAN_FILE)" @echo "" @echo "HTMLDIR = $(HTMLDIR)" @echo "HTML_APP_FILES = $(HTML_APP_FILES)" diff --git a/lib/snmp/doc/src/book.gif b/lib/snmp/doc/src/book.gif Binary files differdeleted file mode 100644 index 94b3868792..0000000000 --- a/lib/snmp/doc/src/book.gif +++ /dev/null diff --git a/lib/snmp/doc/src/fascicules.xml b/lib/snmp/doc/src/fascicules.xml deleted file mode 100644 index 37feca543f..0000000000 --- a/lib/snmp/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/snmp/doc/src/files.mk b/lib/snmp/doc/src/files.mk index 5aeae19105..f364cb6fa5 100644 --- a/lib/snmp/doc/src/files.mk +++ b/lib/snmp/doc/src/files.mk @@ -1,9 +1,9 @@ #-*-makefile-*- ; force emacs to enter makefile-mode # %CopyrightBegin% -# -# Copyright Ericsson AB 2001-2016. All Rights Reserved. -# +# +# Copyright Ericsson AB 2001-2017. All Rights Reserved. +# # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at @@ -15,7 +15,7 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. -# +# # %CopyrightEnd% XML_APPLICATION_FILES = \ @@ -81,9 +81,7 @@ XML_REF3_FILES = \ XML_REF6_FILES = snmp_app.xml XML_PART_FILES = \ - part.xml \ - part_notes.xml \ - part_notes_history.xml + part.xml XML_CHAPTER_FILES = \ snmp_intro.xml \ @@ -115,23 +113,16 @@ XML_FILES = $(BOOK_FILES) \ $(XML_REF6_FILES) \ $(XML_APPLICATION_FILES) -GIF_FILES = book.gif \ +GIF_FILES = \ getnext1.gif \ getnext2.gif \ getnext3.gif \ getnext4.gif \ snmp_agent_netif_1.gif \ snmp_manager_netif_1.gif \ - min_head.gif \ - note.gif \ - notes.gif \ - ref_man.gif \ snmp-um-1-image-1.gif \ snmp-um-1-image-2.gif \ snmp-um-1-image-3.gif \ - snmp.gif \ - user_guide.gif \ - warning.gif \ MIB_mechanism.gif PS_FILES = getnext1.ps \ diff --git a/lib/snmp/doc/src/index.html.src b/lib/snmp/doc/src/index.html.src deleted file mode 100644 index e1b6be4d1f..0000000000 --- a/lib/snmp/doc/src/index.html.src +++ /dev/null @@ -1,99 +0,0 @@ -<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"> -<!-- This file is obsolete --> -<HTML> -<!-- - ``Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - The Initial Developer of the Original Code is Ericsson Utvecklings AB. - Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings - AB. All Rights Reserved.'' - - $Id$ ---> -<HEAD> -<TITLE>SNMP %VSN%</TITLE> -</HEAD> - -<BODY BGCOLOR="#FFFFFF"> - -<CENTER> -<A HREF="http://www.erlang.se/"><IMG ALT="Erlang/OTP" BORDER=0 SRC="html/min_head.gif"></A><BR> - -<FONT SIZE="-1"> -[<A HREF="../../../doc/index.html">Up</A> | -<A HREF="http://www.erlang.se/">Erlang/OTP</A>] -</FONT><BR> - -<P><FONT SIZE="+3"> -SNMP -</FONT><BR> -Version %VSN% -</CENTER> - -<P><TABLE> -<TR> -<TD> -<IMG ALIGN=LEFT ALT="SNMP" SRC="html/snmp.gif"> -</TD> - -<TD> -<P>A bilingual Simple Network Management Protocol application, - featuring an Extensible Agent, a simple manager, a MIB compiler - and facilities for implementing SNMP MIBs etc. -</TD> -</TR> -</TABLE> - -<P><CENTER> -<TABLE CELLPADDING=15> -<TR> -<TD ALIGN=CENTER> -<A HREF="html/users_guide.html"><IMG ALT="User's Guide" BORDER=0 SRC="html/user_guide.gif"></A><BR> -<FONT SIZE="-1"> -<A HREF="html/users_guide.html">User's Guide</A> -</FONT> -</TD> - -<TD ALIGN=CENTER> -<A HREF="html/index.html"><IMG ALT="Reference Manual" BORDER=0 SRC="html/ref_man.gif"></A><BR> -<FONT SIZE="-1"> -<A HREF="html/index.html">Reference Manual</A> -</FONT> -</TD> - -<TD ALIGN=CENTER> -<A HREF="html/release_notes.html"><IMG ALT="Release Notes" BORDER=0 SRC="html/notes.gif"></A><BR> -<FONT SIZE="-1"> -<A HREF="html/release_notes.html">Release Notes</A> -</FONT> -</TD> - -<TD ALIGN=CENTER> -<A HREF="pdf/snmp-%VSN%.pdf"><IMG ALT="Off-Print" BORDER=0 SRC="html/book.gif"></A><BR> -<FONT SIZE="-1"> -<A HREF="pdf/snmp-%VSN%.pdf">Off-Print</A> -</FONT> -</TD> -</TR> -</TABLE> -</CENTER> - -<P><CENTER> -<HR> -<FONT SIZE="-1"> -Copyright © 1991-2001 -<A HREF="http://www.erlang.se/">Ericsson Utvecklings AB</A> -</FONT> -</CENTER> -</BODY> -</HTML> diff --git a/lib/snmp/doc/src/min_head.gif b/lib/snmp/doc/src/min_head.gif Binary files differdeleted file mode 100644 index 67948a6378..0000000000 --- a/lib/snmp/doc/src/min_head.gif +++ /dev/null diff --git a/lib/snmp/doc/src/note.gif b/lib/snmp/doc/src/note.gif Binary files differdeleted file mode 100644 index 6fffe30419..0000000000 --- a/lib/snmp/doc/src/note.gif +++ /dev/null diff --git a/lib/snmp/doc/src/notes.gif b/lib/snmp/doc/src/notes.gif Binary files differdeleted file mode 100644 index e000cca26a..0000000000 --- a/lib/snmp/doc/src/notes.gif +++ /dev/null diff --git a/lib/snmp/doc/src/notes.xml b/lib/snmp/doc/src/notes.xml index 5cd20bad87..1b5f94ed07 100644 --- a/lib/snmp/doc/src/notes.xml +++ b/lib/snmp/doc/src/notes.xml @@ -11,7 +11,7 @@ Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at - + http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software @@ -19,7 +19,7 @@ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. - + </legalnotice> <title>SNMP Release Notes</title> @@ -34,7 +34,22 @@ </header> - <section><title>SNMP 5.2.8</title> + <section><title>SNMP 5.2.9</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Removed all old unused files in the documentation. + </p> + <p> + Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p> + </item> + </list> + </section> + +</section> + +<section><title>SNMP 5.2.8</title> <section><title>Fixed Bugs and Malfunctions</title> <list> @@ -253,8 +268,8 @@ <list type="bulleted"> <item> <p>[compiler] Refinement of type Opaque was not allowed. </p> - <p>MIB constructs such as '<c>SYNTAX Opaque (SIZE(0..65535))</c>' - was previously not allowed, + <p>MIB constructs such as '<c>SYNTAX Opaque (SIZE(0..65535))</c>' + was previously not allowed, see the standard <c>ALARM-MIB</c> for eaxmple. </p> <p>Own Id: OTP-12066</p> <p>Aux Id: Seq 12669</p> @@ -271,8 +286,8 @@ <!-- <list type="bulleted"> <item> - <p>[agent] - see <seealso marker="snmpa#load_mibs">load_mibs</seealso> and + <p>[agent] + see <seealso marker="snmpa#load_mibs">load_mibs</seealso> and <seealso marker="snmpa#unload_mibs">unload_mibs</seealso>. </p> <p>Own Id: OTP-11216</p> </item> @@ -403,18 +418,18 @@ <!-- <list type="bulleted"> <item> - <p>Wrong block cypher type used for AES ('aes_cbf128' - instead of 'aes_cfb128') when performing AES block - encrypt/decrypt which breaks SNMP usmAesCfb128Protocol + <p>Wrong block cypher type used for AES ('aes_cbf128' + instead of 'aes_cfb128') when performing AES block + encrypt/decrypt which breaks SNMP usmAesCfb128Protocol in agent and manager. </p> <p>Own Id: OTP-11412</p> </item> <item> - <p>[manager] When performing the AES encryption, invalid values for + <p>[manager] When performing the AES encryption, invalid values for the EngineBoots and EngineTime was used. </p> - <p>The values of the local agent was used, which would have produced - "some" values if an agent was actually running. + <p>The values of the local agent was used, which would have produced + "some" values if an agent was actually running. If not it would have caused a crash. </p> <p>Own Id: OTP-11413</p> </item> @@ -458,16 +473,16 @@ <list type="bulleted"> <item> <p>[agent] Enable SNMP to create missing database directories. </p> - <p>Add + <p>Add <seealso marker="snmp_app#db_init_error"> - {db_init_error, create_db_and_dir}</seealso> option to SNMP - <seealso marker="snmp_app#manager_opts_and_types">manager</seealso> + {db_init_error, create_db_and_dir}</seealso> option to SNMP + <seealso marker="snmp_app#manager_opts_and_types">manager</seealso> and - <seealso marker="snmp_app#agent_opts_and_types">agent</seealso>. + <seealso marker="snmp_app#agent_opts_and_types">agent</seealso>. This allows them to create any missing parent directories for - <c>db_dir</c>, rather than treating any missing directories + <c>db_dir</c>, rather than treating any missing directories as a fatal error. - The default for <c>db_init_error</c>, which is <c>terminate</c>, + The default for <c>db_init_error</c>, which is <c>terminate</c>, is unchanged. </p> <p>Steve Vinoski</p> <p>Own Id: OTP-11352</p> @@ -477,7 +492,7 @@ <p>[manager] Improved handling of unexpected return values from <seealso marker="snmpm_user">snmpm_user</seealso> callback functions. </p> - <p>Violations of the documented API (crashes or invalid return + <p>Violations of the documented API (crashes or invalid return values) will now result in an error message. </p> <p>Own Id: OTP-11307</p> </item> @@ -485,16 +500,16 @@ <item> <p>Add (atl) log conversion block option. </p> <p>It is now possible to request that the Audit Trail Log should - be blocked during conversion (<c>log_to_txt</c> or <c>log_to_io</c>). - This could be usefull when coverting an entire large log (when + be blocked during conversion (<c>log_to_txt</c> or <c>log_to_io</c>). + This could be usefull when coverting an entire large log (when there is a chance it may otherwise wrap during conversion). </p> - <p>See - agent + <p>See + agent <seealso marker="snmpa#log_to_txt">log_to_txt</seealso> and - <seealso marker="snmpa#log_to_io">log_to_io</seealso> and also - manager + <seealso marker="snmpa#log_to_io">log_to_io</seealso> and also + manager <seealso marker="snmpm#log_to_txt">log_to_txt</seealso> and - <seealso marker="snmpm#log_to_io">log_to_io</seealso> + <seealso marker="snmpm#log_to_io">log_to_io</seealso> for details. </p> <p>Own Id: OTP-11396</p> <p>Own Id: seq12433</p> @@ -503,9 +518,9 @@ <item> <p>When converting an Audit Trail Log to text, a corrupt log entry could cause the entire conversion to fail. </p> - <p>Also, for a log with sequence numbers, failing to + <p>Also, for a log with sequence numbers, failing to decode a log entry would cause the conversion to fail - (not because of the failed decode, but because of the + (not because of the failed decode, but because of the failure to write the error message). </p> <p>Own Id: OTP-111453</p> <p>Aux Id: Seq 12459</p> @@ -523,18 +538,18 @@ <list type="bulleted"> <item> - <p>Wrong block cypher type used for AES ('aes_cbf128' - instead of 'aes_cfb128') when performing AES block - encrypt/decrypt which breaks SNMP usmAesCfb128Protocol + <p>Wrong block cypher type used for AES ('aes_cbf128' + instead of 'aes_cfb128') when performing AES block + encrypt/decrypt which breaks SNMP usmAesCfb128Protocol in agent and manager. </p> <p>Own Id: OTP-11412</p> </item> <item> - <p>[manager] When performing the AES encryption, invalid values for + <p>[manager] When performing the AES encryption, invalid values for the EngineBoots and EngineTime was used. </p> - <p>The values of the local agent was used, which would have produced - "some" values if an agent was actually running. + <p>The values of the local agent was used, which would have produced + "some" values if an agent was actually running. If not it would have caused a crash. </p> <p>Own Id: OTP-11413</p> </item> @@ -576,14 +591,14 @@ <list type="bulleted"> <item> - <p>[agent] Improved documentation for the functions for - loading and unloading mibs, - see <seealso marker="snmpa#load_mibs">load_mibs</seealso> and - <seealso marker="snmpa#unload_mibs">unload_mibs</seealso> for + <p>[agent] Improved documentation for the functions for + loading and unloading mibs, + see <seealso marker="snmpa#load_mibs">load_mibs</seealso> and + <seealso marker="snmpa#unload_mibs">unload_mibs</seealso> for more info. </p> - <p>Also added new functions for loading and unloading a single mib, - see <seealso marker="snmpa#load_mib">load_mib</seealso> and - <seealso marker="snmpa#unload_mib">unload_mib</seealso> for + <p>Also added new functions for loading and unloading a single mib, + see <seealso marker="snmpa#load_mib">load_mib</seealso> and + <seealso marker="snmpa#unload_mib">unload_mib</seealso> for more info. </p> <p>Own Id: OTP-11216</p> </item> @@ -599,8 +614,8 @@ <!-- <list type="bulleted"> <item> - <p>[agent] - see <seealso marker="snmpa#load_mibs">load_mibs</seealso> and + <p>[agent] + see <seealso marker="snmpa#load_mibs">load_mibs</seealso> and <seealso marker="snmpa#unload_mibs">unload_mibs</seealso>. </p> <p>Own Id: OTP-11216</p> </item> @@ -626,7 +641,7 @@ </list> --> </section> - + </section> <!-- 4.24.2 --> @@ -659,29 +674,29 @@ <list type="bulleted"> <item> - <p>[agent] Reading the value of the vacmViewTreeFamilyMask returns + <p>[agent] Reading the value of the vacmViewTreeFamilyMask returns it in the wrong (internal bitlist) format. </p> <p>The vacmViewTreeFamilyMask is defined as a bit string in the MIB - (OCTET STRING). Internally a bitlist (list of 1's and 0's, + (OCTET STRING). Internally a bitlist (list of 1's and 0's, see <seealso marker="snmp_agent_config_files#vacm">vacm config file</seealso> - for more info) is used. + for more info) is used. However, the MIB implementation assumed the latter, effectively rendering all attempts to read/set masks via SNMP unsuccessful. </p> - <p>Since the mask is used in hot paths (e.g. access permission checks - for each SNMP operation, the bitlist representation of the mask has - benefits (e.g. faster processing). Reading/writing the view mask - objects is less time-critical. Therefore, to fix the issue, convert - between the bitlist (internal) representation and bitstring + <p>Since the mask is used in hot paths (e.g. access permission checks + for each SNMP operation, the bitlist representation of the mask has + benefits (e.g. faster processing). Reading/writing the view mask + objects is less time-critical. Therefore, to fix the issue, convert + between the bitlist (internal) representation and bitstring (external) when the vacmViewTreeFamilyMask objects are accessed. </p> - <p>Also, the check of the vacm config file was invalid with - regard to the mask value. It was assumed to be a proper oid, which + <p>Also, the check of the vacm config file was invalid with + regard to the mask value. It was assumed to be a proper oid, which is not strictly the case (see bitlist above). </p> <p>Own Id: OTP-11177</p> <p>Stefan Zegenhagen</p> </item> <item> - <p>[agent] The counter increment function in the local-db was + <p>[agent] The counter increment function in the local-db was incorrect. It did not handle counter wrap correctly. </p> <p>Own Id: OTP-11192</p> </item> @@ -728,26 +743,26 @@ </item> <item> - <p>[agent] Introduced a documented behaviour for the mib-server - <seealso marker="snmpa_mib_data">mib-data backend</seealso>. + <p>[agent] Introduced a documented behaviour for the mib-server + <seealso marker="snmpa_mib_data">mib-data backend</seealso>. At present only the default module (<c>snmpa_mib_data_tttn</c>) is provided. </p> - <p>A config option for the (agent) - <seealso marker="snmp_config#agent_mib_server">mib-servers</seealso> - mib-data backend module has been added to the agent config options, + <p>A config option for the (agent) + <seealso marker="snmp_config#agent_mib_server">mib-servers</seealso> + mib-data backend module has been added to the agent config options, <seealso marker="snmp_config#agent_ms_data_module">data_module</seealso>. </p> <p>Own Id: OTP-11101</p> </item> <item> - <p>[agent] Introduced a documented behaviour for the - <seealso marker="snmpa_mib_storage">mib storage</seealso>. - At present there are three simple modules - (<c>snmpa_mib_storage_ets</c>, <c>snmpa_mib_storage_dets</c> and + <p>[agent] Introduced a documented behaviour for the + <seealso marker="snmpa_mib_storage">mib storage</seealso>. + At present there are three simple modules + (<c>snmpa_mib_storage_ets</c>, <c>snmpa_mib_storage_dets</c> and <c>snmpa_mib_storage_mnesia</c>) implementing this behaviour, provided with the app. </p> - <p>A config option for the (agent) - <seealso marker="snmp_config#agent_mib_storage">mib storage</seealso> + <p>A config option for the (agent) + <seealso marker="snmp_config#agent_mib_storage">mib storage</seealso> has been added to the agent config options. </p> <p>Own Id: OTP-11107</p> </item> @@ -805,14 +820,14 @@ <list type="bulleted"> <item> <p>[agent] Errors in <c>vacmAccessTable</c> RowStatus handling. - There are problems with the handling of vacmAccessTableStatus + There are problems with the handling of vacmAccessTableStatus that cause some SNMP test suites to report errors. - Most notably, erroneous set operations frequently cause "genErr" - errors to be returned. These "genErr" errors are usually caused - by badmatch exceptions coming from - <c>{ok, Row} = snmpa_vacm:get_row(RowIndex)</c> + Most notably, erroneous set operations frequently cause "genErr" + errors to be returned. These "genErr" errors are usually caused + by badmatch exceptions coming from + <c>{ok, Row} = snmpa_vacm:get_row(RowIndex)</c> if the row does not exist. </p> - <p>The semantics of the RowStatus handling in that table has + <p>The semantics of the RowStatus handling in that table has been adjusted to be compliant with the RowStatus textual description of SNPMv2-TC MIB. </p> <p>Stefan Zegenhagen</p> @@ -836,7 +851,7 @@ </item> <item> - <p>[compiler] The MIB compiler could not handle a table index + <p>[compiler] The MIB compiler could not handle a table index that was defined later in the MIB. </p> <p>Own Id: OTP-10808</p> </item> @@ -869,7 +884,7 @@ <title>SNMP Development Toolkit 4.23</title> <!-- <p>Version 4.23 supports code replacement in runtime from/to - version 4.22.1, + version 4.22.1, 4.22, 4.21.7 4.21.6 4.21.5, 4.21.4, 4.21.3, 4.21.2, 4.21.1 and 4.21. </p> --> @@ -881,14 +896,14 @@ <list type="bulleted"> <item> - <p>[manager] Polish return values of snmpm_user_default according + <p>[manager] Polish return values of snmpm_user_default according to snmpm_user doc.</p> <p>Luca Favatella</p> <p>Own Id: OTP-10671</p> </item> <item> - <p>[agent] Remove runtime warning in snmpa_agent because of + <p>[agent] Remove runtime warning in snmpa_agent because of tuple fun usage. </p> <p>Luca Favatella</p> <p>Own Id: OTP-10672</p> @@ -910,10 +925,10 @@ <!-- <list type="bulleted"> <item> - <p>[agent] Simultaneous - <seealso marker="snmpa#backup">snmpa:backup/1,2</seealso> + <p>[agent] Simultaneous + <seealso marker="snmpa#backup">snmpa:backup/1,2</seealso> calls can interfere. - The master agent did not check if a backup was already in + The master agent did not check if a backup was already in progress when a backup request was accepted. </p> <p>Own Id: OTP-9884</p> <p>Aux Id: Seq 11995</p> @@ -946,7 +961,7 @@ <section> <title>SNMP Development Toolkit 4.22.1</title> <p>Version 4.22.1 supports code replacement in runtime from/to - version 4.22, 4.21.7 4.21.6 4.21.5, 4.21.4, 4.21.3, 4.21.2, 4.21.1 and + version 4.22, 4.21.7 4.21.6 4.21.5, 4.21.4, 4.21.3, 4.21.2, 4.21.1 and 4.21. </p> <section> @@ -958,15 +973,15 @@ <list type="bulleted"> <item> <p>[agent] Sematic fixes to SNMP-USER-BASED-SM-MIB. - The semantics allow the <c>usmUserAuthKeyChange</c> and - <c>usmUserPrivKeyChange</c> objects to be written to in the - same set requests that also creates and clones the user. - This was not possible beforehand, causing test tools checking + The semantics allow the <c>usmUserAuthKeyChange</c> and + <c>usmUserPrivKeyChange</c> objects to be written to in the + same set requests that also creates and clones the user. + This was not possible beforehand, causing test tools checking semantic SNMPv3 behaviour to fail on a lot of test cases. </p> - <p>Furthermore, once the user has been cloned by writing to an - instance of <c>usmUserCloneFrom</c>, further set-operations to - the same object will not return an error, but be no-ops. - Especially, it must be avoided to copy security parameters + <p>Furthermore, once the user has been cloned by writing to an + instance of <c>usmUserCloneFrom</c>, further set-operations to + the same object will not return an error, but be no-ops. + Especially, it must be avoided to copy security parameters again (possibly even from a different user). </p> <p>Stefan Zegenhagen</p> <p>Own Id: OTP-10166</p> @@ -974,14 +989,14 @@ <item> <p>[agent] Errors in <c>vacmAccessTable</c> RowStatus handling. - There are problems with the handling of vacmAccessTableStatus + There are problems with the handling of vacmAccessTableStatus that cause some SNMP test suites to report errors. - Most notably, erroneous set operations frequently cause "genErr" - errors to be returned. These "genErr" errors are usually caused - by badmatch exceptions coming from - <c>{ok, Row} = snmpa_vacm:get_row(RowIndex)</c> + Most notably, erroneous set operations frequently cause "genErr" + errors to be returned. These "genErr" errors are usually caused + by badmatch exceptions coming from + <c>{ok, Row} = snmpa_vacm:get_row(RowIndex)</c> if the row does not exist. </p> - <p>The semantics of the RowStatus handling in that table has + <p>The semantics of the RowStatus handling in that table has been adjusted to be compliant with the RowStatus textual description of SNPMv2-TC MIB. </p> <p>Stefan Zegenhagen</p> @@ -1000,24 +1015,24 @@ <list type="bulleted"> <item> <p>[agent] Fix walk over vacmAccessTable. - Fix the get_next implementation of vacmAccessTable to + Fix the get_next implementation of vacmAccessTable to return all table entries. </p> - <p>The get_next implementation of vacmAccessTable did not return - all available table data. Instead, it only returned the first + <p>The get_next implementation of vacmAccessTable did not return + all available table data. Instead, it only returned the first column for each row, and all columns for the last row available. </p> <p>Stefan Zegenhagen</p> <p>Own Id: OTP-10165</p> </item> <item> - <p>[manager] - <seealso marker="snmpm#log_to_io">snmpm:log_to_io/6</seealso> + <p>[manager] + <seealso marker="snmpm#log_to_io">snmpm:log_to_io/6</seealso> did not use the LogName argument. </p> <p>Own Id: OTP-10066</p> </item> <item> - <p>Incorrect TimeTicks decode. Also bad handling of + <p>Incorrect TimeTicks decode. Also bad handling of invalid encode (value outside of value range) for both <c>TimeTicks</c> and <c>Unsigned32</c>. </p> <p>Own Id: OTP-10132</p> @@ -1048,38 +1063,38 @@ <list type="bulleted"> <item> - <p>[compiler] The table information the MIB compiler provides with - augmented tables has been extended with <c>nbr_of_cols</c>, + <p>[compiler] The table information the MIB compiler provides with + augmented tables has been extended with <c>nbr_of_cols</c>, <c>first_accessible</c> and <c>not_accessible</c>. </p> <p>Own Id: OTP-9969</p> </item> <item> - <p>Added the <c>log_to_io</c> audit-trail-log converter function - to the api modules of both the - <seealso marker="snmpm#log_to_io">manager</seealso> - and + <p>Added the <c>log_to_io</c> audit-trail-log converter function + to the api modules of both the + <seealso marker="snmpm#log_to_io">manager</seealso> + and <seealso marker="snmpa#log_to_io">agent</seealso>. </p> <p>Own Id: OTP-9940</p> </item> <item> - <p>[manager] Introduced a new transport module, - <c>snmpm_net_if_mt</c>, - which handles all incomming and outgoing + <p>[manager] Introduced a new transport module, + <c>snmpm_net_if_mt</c>, + which handles all incomming and outgoing traffic in newly created processes. The message/request is processed and then the process exits. </p> <p>Own Id: OTP-9876</p> </item> <item> - <p>[agent] Documenting previously existing but undocumented function, + <p>[agent] Documenting previously existing but undocumented function, <seealso marker="snmp_generic#get_table_info">snmp_generic:get_table_info/2</seealso>. </p> <p>Own Id: OTP-9942</p> </item> <item> - <p>[agent] Improve error handling while reading agent config files. + <p>[agent] Improve error handling while reading agent config files. Some files contain mandatory information and is therefor themself mandatory. </p> <p>Own Id: OTP-9943</p> @@ -1095,10 +1110,10 @@ <!-- <list type="bulleted"> <item> - <p>[agent] Simultaneous - <seealso marker="snmpa#backup">snmpa:backup/1,2</seealso> + <p>[agent] Simultaneous + <seealso marker="snmpa#backup">snmpa:backup/1,2</seealso> calls can interfere. - The master agent did not check if a backup was already in + The master agent did not check if a backup was already in progress when a backup request was accepted. </p> <p>Own Id: OTP-9884</p> <p>Aux Id: Seq 11995</p> @@ -1120,7 +1135,7 @@ <section> <title>SNMP Development Toolkit 4.21.7</title> <p>Version 4.21.7 supports code replacement in runtime from/to - version 4.21.6, 4.21.5, 4.21.4, 4.21.3, 4.21.2, 4.21.1, 4.21, 4.20.1 and + version 4.21.6, 4.21.5, 4.21.4, 4.21.3, 4.21.2, 4.21.1, 4.21, 4.20.1 and 4.20. </p> <section> @@ -1130,13 +1145,13 @@ <!-- <list type="bulleted"> <item> - <p>[agent] DoS attack using GET-BULK with large value of + <p>[agent] DoS attack using GET-BULK with large value of MaxRepetitions. - A preventive method has been implementing by simply - limit the number of varbinds that can be included in - a Get-BULK response message. This is specified by the - new config option, - <seealso marker="snmp_app#agent_gb_max_vbs">gb_max_vbs</seealso>. + A preventive method has been implementing by simply + limit the number of varbinds that can be included in + a Get-BULK response message. This is specified by the + new config option, + <seealso marker="snmp_app#agent_gb_max_vbs">gb_max_vbs</seealso>. </p> <p>Own Id: OTP-9700</p> </item> @@ -1154,10 +1169,10 @@ <list type="bulleted"> <item> - <p>[agent] Simultaneous - <seealso marker="snmpa#backup">snmpa:backup/1,2</seealso> + <p>[agent] Simultaneous + <seealso marker="snmpa#backup">snmpa:backup/1,2</seealso> calls can interfere. - The master agent did not check if a backup was already in + The master agent did not check if a backup was already in progress when a backup request was accepted. </p> <p>Own Id: OTP-9884</p> <p>Aux Id: Seq 11995</p> @@ -1178,7 +1193,7 @@ <section> <title>SNMP Development Toolkit 4.21.6</title> <p>Version 4.21.6 supports code replacement in runtime from/to - version 4.21.5, 4.21.4, 4.21.3, 4.21.2, 4.21.1, 4.21, 4.20.1 and + version 4.21.5, 4.21.4, 4.21.3, 4.21.2, 4.21.1, 4.21, 4.20.1 and 4.20. </p> <section> @@ -1189,13 +1204,13 @@ <list type="bulleted"> <item> - <p>[agent] DoS attack using GET-BULK with large value of + <p>[agent] DoS attack using GET-BULK with large value of MaxRepetitions. - A preventive method has been implementing by simply - limit the number of varbinds that can be included in - a Get-BULK response message. This is specified by the - new config option, - <seealso marker="snmp_app#agent_gb_max_vbs">gb_max_vbs</seealso>. + A preventive method has been implementing by simply + limit the number of varbinds that can be included in + a Get-BULK response message. This is specified by the + new config option, + <seealso marker="snmp_app#agent_gb_max_vbs">gb_max_vbs</seealso>. </p> <p>Own Id: OTP-9700</p> </item> @@ -1212,11 +1227,11 @@ <list type="bulleted"> <item> - <p>[agent] Mib server cache gclimit update function incorrectly calls - age update function. - The gclimit update function, - <seealso marker="snmpa#update_mibs_cache_gclimit">update_mibs_cache_gclimit/1</seealso>, - <em>incorrectly</em> called the age update function, + <p>[agent] Mib server cache gclimit update function incorrectly calls + age update function. + The gclimit update function, + <seealso marker="snmpa#update_mibs_cache_gclimit">update_mibs_cache_gclimit/1</seealso>, + <em>incorrectly</em> called the age update function, <seealso marker="snmpa#update_mibs_cache_age">update_mibs_cache_age/2</seealso>. </p> <p>Johan Claesson</p> <p>Own Id: OTP-9868</p> @@ -1258,18 +1273,18 @@ <section> <title>Fixed Bugs and Malfunctions</title> <!-- - <p>-</p> + <p>-</p> --> <list type="bulleted"> <item> - <p>[agent] Repeated vacm table dumping fails due to file name - conflict. When dumping the vacm table to disk, a temoporary - file with a fixed name was used. If the table dumping - (snmpa_vacm:dump_table/0) was initiated from several different - processes in rapid succesion, the dumping could fail because the - different processes was simultaniously trying to write to the - same file. This problem has been eliminated by creating a unique + <p>[agent] Repeated vacm table dumping fails due to file name + conflict. When dumping the vacm table to disk, a temoporary + file with a fixed name was used. If the table dumping + (snmpa_vacm:dump_table/0) was initiated from several different + processes in rapid succesion, the dumping could fail because the + different processes was simultaniously trying to write to the + same file. This problem has been eliminated by creating a unique name for the temporary file. </p> <p>Own Id: OTP-9851</p> <p>Aux Id: Seq 11980</p> @@ -1310,7 +1325,7 @@ <!-- <list type="bulleted"> <item> - <p>[compiler] Improved version info printout from the + <p>[compiler] Improved version info printout from the <seealso marker="snmpc(command)#">MIB compiler frontend escript</seealso>. </p> <p>Own Id: OTP-9618</p> </item> @@ -1323,7 +1338,7 @@ <section> <title>Fixed Bugs and Malfunctions</title> <!-- - <p>-</p> + <p>-</p> --> <list type="bulleted"> @@ -1367,7 +1382,7 @@ <list type="bulleted"> <item> - <p>[compiler] Improved version info printout from the + <p>[compiler] Improved version info printout from the <seealso marker="snmpc(command)#">MIB compiler frontend escript</seealso>. </p> <p>Own Id: OTP-9618</p> </item> @@ -1379,27 +1394,27 @@ <section> <title>Fixed Bugs and Malfunctions</title> <!-- - <p>-</p> + <p>-</p> --> <list type="bulleted"> <item> - <p>[agent] Version 4.20 introduced a change that broke trap - sending from subagents. Due to a bug in the test code, + <p>[agent] Version 4.20 introduced a change that broke trap + sending from subagents. Due to a bug in the test code, this was not discovered, until that bug was fixed. </p> <p>Own Id: OTP-9745</p> </item> <item> - <p>[agent] When sending an error message (reply) regarding + <p>[agent] When sending an error message (reply) regarding <c>snmpUnknownPDUHandlers</c>, the agent used the wrong OID. </p> <p>Own Id: OTP-9747</p> </item> <item> - <p>[compiler] Fix the <c>--warnings/--W</c> option parsing in the + <p>[compiler] Fix the <c>--warnings/--W</c> option parsing in the <seealso marker="snmpc(command)#option_warnings">snmpc</seealso> - wrapper (e)script. + wrapper (e)script. The short warning option was incorrectly <c>--w</c>, instead of as documented <c>--W</c>. This has now been corrected. </p> <p>*** POTENTIAL INCOMPATIBILITY ***</p> @@ -1419,7 +1434,7 @@ <list type="bulleted"> <item> - <p>[compiler] The short warning option has been changed from + <p>[compiler] The short warning option has been changed from <c>--w</c> to <c>--W</c> to comply with the documentation. </p> <p>Tuncer Ayaz</p> <p>Own Id: OTP-9718</p> @@ -1443,7 +1458,7 @@ <!-- <list type="bulleted"> <item> - <p>Bad note store GC timer deactivation. + <p>Bad note store GC timer deactivation. Wrong field in the state record was set (timeout instead active). </p> <p>Stefan Grundmann</p> <p>Own Id: OTP-9690</p> @@ -1457,12 +1472,12 @@ <section> <title>Fixed Bugs and Malfunctions</title> <!-- - <p>-</p> + <p>-</p> --> <list type="bulleted"> <item> - <p>Bad note store GC timer deactivation. + <p>Bad note store GC timer deactivation. Wrong field in the state record was set (timeout instead active). </p> <p>Stefan Grundmann</p> <p>Own Id: OTP-9690</p> @@ -1492,13 +1507,13 @@ --> <list type="bulleted"> <item> - <p>[compiler] Used wrong variable name (for - warnings-as-errors variable), which caused the + <p>[compiler] Used wrong variable name (for + warnings-as-errors variable), which caused the compiler to crash when using the snmpc (e)script. </p> - <p>Also added the option + <p>Also added the option <seealso marker="snmpc(command)#option_werror">--Werror</seealso> - for the SNMP MIB compiler (escript) frontend (to mimic - <seealso marker="erts:erlc">erlc</seealso>), + for the SNMP MIB compiler (escript) frontend (to mimic + <seealso marker="erts:erlc">erlc</seealso>), which specifies whether warnings should be treated as errors. </p> <p>Own Id: OTP-9447</p> </item> @@ -1513,12 +1528,12 @@ <section> <title>Fixed Bugs and Malfunctions</title> - <p>-</p> + <p>-</p> <!-- <list type="bulleted"> <item> - <p>The snmp config tool could not handle (manager) audit trail config + <p>The snmp config tool could not handle (manager) audit trail config because the option seqno was not handled. </p> <p>Own Id: OTP-9354</p> </item> @@ -1548,15 +1563,15 @@ --> <list type="bulleted"> <item> - <p>[manager] There was no way to specify transport domain. + <p>[manager] There was no way to specify transport domain. The transport domains was assumed to be IPv4 (transportDomainUdpIpv4). - This has now been changed so that it can also be IPv6 - (transportDomainUdpIpv6). - To facilitate this, the transport domain, <c>tdomain</c>, - is now a (new) valid option when + This has now been changed so that it can also be IPv6 + (transportDomainUdpIpv6). + To facilitate this, the transport domain, <c>tdomain</c>, + is now a (new) valid option when <seealso marker="snmpm#register_agent">registering</seealso> - a new agent (and - <seealso marker="snmpm#update_agent_info">updating</seealso> + a new agent (and + <seealso marker="snmpm#update_agent_info">updating</seealso> agent info). </p> <p>This also mean that the transport behaviour has changed. </p> <p>Own Id: OTP-9305</p> @@ -1564,10 +1579,10 @@ </item> <item> - <p>[compiler] Added the option - <seealso marker="snmpc#compile">warnings_as_errors</seealso> - (for the SNMP MIB compiler (escript) frontend, the option - <seealso marker="snmpc(command)#option_wae">--wae</seealso> is used) + <p>[compiler] Added the option + <seealso marker="snmpc#compile">warnings_as_errors</seealso> + (for the SNMP MIB compiler (escript) frontend, the option + <seealso marker="snmpc(command)#option_wae">--wae</seealso> is used) which specifies whether warnings should be treated as errors. </p> <p>Tuncer Ayaz</p> <p>Own Id: OTP-9437</p> @@ -1579,12 +1594,12 @@ <section> <title>Fixed Bugs and Malfunctions</title> <!-- - <p>-</p> + <p>-</p> --> <list type="bulleted"> <item> - <p>The snmp config tool could not handle (manager) audit trail config + <p>The snmp config tool could not handle (manager) audit trail config because the option seqno was not handled. </p> <p>Own Id: OTP-9354</p> </item> @@ -1638,11 +1653,11 @@ <section> <title>Fixed Bugs and Malfunctions</title> <!-- - <p>-</p> + <p>-</p> --> <list type="bulleted"> <item> - <p>[agent] Did not handle transport domains properly in some cases, + <p>[agent] Did not handle transport domains properly in some cases, for instance trap sending. </p> <p>Own Id: OTP-9400</p> </item> @@ -1679,9 +1694,9 @@ <list type="bulleted"> <item> <p>[agent] Added support for sending traps to IPv6 targets. </p> - <p>See the - <seealso marker="snmp_agent_config_files#target_addr">target address config file</seealso>, - the <seealso marker="snmpa_conf#target_addr_entry">target_addr_entry/11</seealso> function or + <p>See the + <seealso marker="snmp_agent_config_files#target_addr">target address config file</seealso>, + the <seealso marker="snmpa_conf#target_addr_entry">target_addr_entry/11</seealso> function or <seealso marker="snmp_target_mib#add_addr">add_addr/11</seealso> for more info. </p> <p>Own Id: OTP-9088</p> <p>Aux Id: Seq 11790</p> @@ -1690,7 +1705,7 @@ <item> <p>[agent] To be able to handle multiple engine-id(s) when - sending trap(s), the function + sending trap(s), the function <seealso marker="snmp_community_mib#add_community"> add_community/6</seealso> has been added. </p> <p>Own Id: OTP-9119</p> @@ -1700,14 +1715,14 @@ <item> <p>[manager] The API for snmp requests has been augmented to allow the caller to override some configuration. </p> - <p>This has been done by introducing a new set of API functions, see - <seealso marker="snmpm#sync_get2">sync_get2/3,4</seealso>, - <seealso marker="snmpm#async_get2">async_get2/3,4</seealso>, - <seealso marker="snmpm#sync_get_next2">sync_get_next2/3,4</seealso>, - <seealso marker="snmpm#async_get_next2">async_get_next2/3,4</seealso>, - <seealso marker="snmpm#sync_get_bulk2">sync_get_bulk2/5,6</seealso>, - <seealso marker="snmpm#async_get_bulk2">async_get_bulk2/5,6</seealso>, - <seealso marker="snmpm#sync_set2">sync_set2/3,4</seealso> and + <p>This has been done by introducing a new set of API functions, see + <seealso marker="snmpm#sync_get2">sync_get2/3,4</seealso>, + <seealso marker="snmpm#async_get2">async_get2/3,4</seealso>, + <seealso marker="snmpm#sync_get_next2">sync_get_next2/3,4</seealso>, + <seealso marker="snmpm#async_get_next2">async_get_next2/3,4</seealso>, + <seealso marker="snmpm#sync_get_bulk2">sync_get_bulk2/5,6</seealso>, + <seealso marker="snmpm#async_get_bulk2">async_get_bulk2/5,6</seealso>, + <seealso marker="snmpm#sync_set2">sync_set2/3,4</seealso> and <seealso marker="snmpm#async_set2">async_set2/3,4</seealso> for more info. </p> <p>Own Id: OTP-9162</p> @@ -1715,8 +1730,8 @@ <item> <p>[manager] The old API functions (for get and set - requests: - snmpm:g/3,4,5,6,7, snmpm:ag/3,4,5,6,7, + requests: + snmpm:g/3,4,5,6,7, snmpm:ag/3,4,5,6,7, snmpm:gn/3,4,5,6,7, snmpm:agn/3,4,5,6,7, snmpm:s/3,4,5,6,7, snmpm:s/3,4,5,6,7, snmpm:gb/5,6,7,8,9 and snmpm:agb/5,6,7,8,9) @@ -1728,12 +1743,12 @@ <item> <p>[agent] Pass extra info through the agent to the net-if process when sending notifications. </p> - <p>See + <p>See <seealso marker="snmpa#send_notification2"> - snmpa:send_notification2/3</seealso> for more info. - See also the incomming net-if messages when sending a - <seealso marker="snmp_agent_netif#im_send_pdu">trap</seealso> - (send_pdu message) and + snmpa:send_notification2/3</seealso> for more info. + See also the incomming net-if messages when sending a + <seealso marker="snmp_agent_netif#im_send_pdu">trap</seealso> + (send_pdu message) and <seealso marker="snmp_agent_netif#im_send_pdu_req"> notification</seealso> (send_pdu_req message). </p> <p>Own Id: OTP-9183</p> @@ -1751,15 +1766,15 @@ <section> <title>Fixed Bugs and Malfunctions</title> <!-- - <p>-</p> + <p>-</p> --> <list type="bulleted"> <item> <p>Fixed endode/decode of values of type <c>Counter32</c>. </p> - <p>This type (<c>Counter32</c>) is an unsigned integer 32, - but is actually encoded as an signed integer 32. - The encode/decode functions however, treated it as if it was + <p>This type (<c>Counter32</c>) is an unsigned integer 32, + but is actually encoded as an signed integer 32. + The encode/decode functions however, treated it as if it was encodeded as an unsigned integer 32. </p> <p>Own Id: OTP-9022</p> </item> @@ -1774,12 +1789,4 @@ </section> </section> <!-- 4.20 --> - - - <!-- section> - <title>Release notes history</title> - <p>For information about older versions see - <url href="part_notes_history_frame.html">release notes history</url>.</p> - </section --> </chapter> - diff --git a/lib/snmp/doc/src/part_notes.xml b/lib/snmp/doc/src/part_notes.xml deleted file mode 100644 index d149044169..0000000000 --- a/lib/snmp/doc/src/part_notes.xml +++ /dev/null @@ -1,41 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>1997</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>SNMP Release Notes</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - <file>part_notes.xml</file> - </header> - <description> - <p>A multilingual Simple Network Management Protocol application, - featuring an Extensible Agent, a simple manager and a MIB - compiler and facilities for implementing SNMP MIBs etc.</p> - <p>For information about older versions see - <url href="part_notes_history_frame.html">release notes history</url>.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/snmp/doc/src/part_notes_history.xml b/lib/snmp/doc/src/part_notes_history.xml deleted file mode 100644 index aa5276dc94..0000000000 --- a/lib/snmp/doc/src/part_notes_history.xml +++ /dev/null @@ -1,42 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part> - <header> - <copyright> - <year>2004</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>SNMP Release Notes History</title> - <prepared></prepared> - <responsible></responsible> - <docno></docno> - <approved></approved> - <checked></checked> - <date></date> - <rev></rev> - <file>part_notes_history.xml</file> - </header> - <description> - <p>A multilingual Simple Network Management Protocol application, - featuring an Extensible Agent, a simple manager and a MIB - compiler and facilities for implementing SNMP MIBs etc.</p> - </description> - <include file="notes_history"></include> -</part> - diff --git a/lib/snmp/doc/src/ref_man.gif b/lib/snmp/doc/src/ref_man.gif Binary files differdeleted file mode 100644 index b13c4efd53..0000000000 --- a/lib/snmp/doc/src/ref_man.gif +++ /dev/null diff --git a/lib/snmp/doc/src/snmp.gif b/lib/snmp/doc/src/snmp.gif Binary files differdeleted file mode 100644 index d9985f990b..0000000000 --- a/lib/snmp/doc/src/snmp.gif +++ /dev/null diff --git a/lib/snmp/doc/src/summary.html.src b/lib/snmp/doc/src/summary.html.src deleted file mode 100644 index 9bad4adbeb..0000000000 --- a/lib/snmp/doc/src/summary.html.src +++ /dev/null @@ -1 +0,0 @@ -Simple Network Management Protocol (SNMP) support including a MIB compiler, a simple SNMP manager and tools for creating SNMP agents diff --git a/lib/snmp/doc/src/user_guide.gif b/lib/snmp/doc/src/user_guide.gif Binary files differdeleted file mode 100644 index e6275a803d..0000000000 --- a/lib/snmp/doc/src/user_guide.gif +++ /dev/null diff --git a/lib/snmp/doc/src/warning.gif b/lib/snmp/doc/src/warning.gif Binary files differdeleted file mode 100644 index 96af52360e..0000000000 --- a/lib/snmp/doc/src/warning.gif +++ /dev/null diff --git a/lib/snmp/test/snmp_agent_test.erl b/lib/snmp/test/snmp_agent_test.erl index 3c1a6f2afd..2ed2c4580c 100644 --- a/lib/snmp/test/snmp_agent_test.erl +++ b/lib/snmp/test/snmp_agent_test.erl @@ -605,7 +605,12 @@ init_per_group(multiple_reqs_3 = GroupName, Config) -> init_per_group(test_multi_threaded = GroupName, Config) -> init_mt(snmp_test_lib:init_group_top_dir(GroupName, Config)); init_per_group(test_v3 = GroupName, Config) -> - init_v3(snmp_test_lib:init_group_top_dir(GroupName, Config)); + case snmp_test_lib:crypto_start() of + ok -> + init_v3(snmp_test_lib:init_group_top_dir(GroupName, Config)); + _ -> + {skip, "Crypto did not start"} + end; init_per_group(test_v1_v2 = GroupName, Config) -> init_v1_v2(snmp_test_lib:init_group_top_dir(GroupName, Config)); init_per_group(test_v2 = GroupName, Config) -> @@ -631,11 +636,26 @@ init_per_group(mib_storage_varm_dets = GroupName, Config) -> init_varm_mib_storage_dets( snmp_test_lib:init_group_top_dir(GroupName, Config)); init_per_group(mib_storage_size_check_mnesia = GroupName, Config) -> - init_size_check_msm(snmp_test_lib:init_group_top_dir(GroupName, Config)); + case snmp_test_lib:crypto_start() of + ok -> + init_size_check_msm(snmp_test_lib:init_group_top_dir(GroupName, Config)); + _ -> + {skip, "Crypto did not start"} + end; init_per_group(mib_storage_size_check_dets = GroupName, Config) -> - init_size_check_msd(snmp_test_lib:init_group_top_dir(GroupName, Config)); + case snmp_test_lib:crypto_start() of + ok -> + init_size_check_msm(snmp_test_lib:init_group_top_dir(GroupName, Config)); + _ -> + {skip, "Crypto did not start"} + end; init_per_group(mib_storage_size_check_ets = GroupName, Config) -> - init_size_check_mse(snmp_test_lib:init_group_top_dir(GroupName, Config)); + case snmp_test_lib:crypto_start() of + ok -> + init_size_check_msm(snmp_test_lib:init_group_top_dir(GroupName, Config)); + _ -> + {skip, "Crypto did not start"} + end; init_per_group(mib_storage_mnesia = GroupName, Config) -> init_mib_storage_mnesia(snmp_test_lib:init_group_top_dir(GroupName, Config)); diff --git a/lib/snmp/test/snmp_manager_test.erl b/lib/snmp/test/snmp_manager_test.erl index 4bfeb0f8d1..6ced55f0cc 100644 --- a/lib/snmp/test/snmp_manager_test.erl +++ b/lib/snmp/test/snmp_manager_test.erl @@ -156,16 +156,25 @@ init_per_suite(Config0) when is_list(Config0) -> ?DBG("init_per_suite -> entry with" "~n Config0: ~p", [Config0]), - Config1 = snmp_test_lib:init_suite_top_dir(?MODULE, Config0), - Config2 = snmp_test_lib:fix_data_dir(Config1), - - %% Mib-dirs - %% data_dir is trashed by the test-server / common-test - %% so there is no point in fixing it... - MibDir = snmp_test_lib:lookup(data_dir, Config2), - StdMibDir = filename:join([code:priv_dir(snmp), "mibs"]), - - [{mib_dir, MibDir}, {std_mib_dir, StdMibDir} | Config2]. + %% Preferably this test SUITE should be divided into groups + %% so that if crypto does not work only v3 tests that + %% need crypto will be skipped, but as this is only a + %% problem with one legacy test machine, we will procrastinate + %% until we have a more important reason to fix this. + case snmp_test_lib:crypto_start() of + ok -> + Config1 = snmp_test_lib:init_suite_top_dir(?MODULE, Config0), + Config2 = snmp_test_lib:fix_data_dir(Config1), + %% Mib-dirs + %% data_dir is trashed by the test-server / common-test + %% so there is no point in fixing it... + MibDir = snmp_test_lib:lookup(data_dir, Config2), + StdMibDir = filename:join([code:priv_dir(snmp), "mibs"]), + + [{mib_dir, MibDir}, {std_mib_dir, StdMibDir} | Config2]; + _ -> + {skip, "Crypto did not start"} + end. end_per_suite(Config) when is_list(Config) -> diff --git a/lib/snmp/test/snmp_to_snmpnet_SUITE.erl b/lib/snmp/test/snmp_to_snmpnet_SUITE.erl index 24c14d86ea..6a3466b6e4 100644 --- a/lib/snmp/test/snmp_to_snmpnet_SUITE.erl +++ b/lib/snmp/test/snmp_to_snmpnet_SUITE.erl @@ -88,8 +88,17 @@ groups() -> ]. init_per_suite(Config) -> - [{agent_port, ?AGENT_PORT}, {manager_port, ?MANAGER_PORT} | Config]. - + case re:run(os:cmd("snmpd -v"),"NET-SNMP", [{capture, first}]) of + nomatch -> + {skip, "snmpd is NOT NET-SNMP"}; + {match, _} -> + case re:run(os:cmd("snmpd -v"),"5.4|5.6.2.1", [{capture, first}]) of + nomatch -> + [{agent_port, ?AGENT_PORT}, {manager_port, ?MANAGER_PORT} | Config]; + {match, _} -> + {skip, "buggy snmpd"} + end + end. end_per_suite(_Config) -> ok. @@ -322,7 +331,7 @@ snmpget(Oid, Transport, Config) -> Args = ["-c", "public", net_snmp_version(Versions), - "-m", "", + "-m", ":", "-Cf", net_snmp_addr_str(Transport), oid_str(Oid)], @@ -353,11 +362,13 @@ start_snmpd(Community, SysDescr, Config) -> ["--rocommunity"++domain_suffix(Domain)++"=" ++Community++" "++inet_parse:ntoa(Ip) || {Domain, {Ip, _}} <- Targets], + SnmpdArgs = - ["-f", "-r", %"-Dverbose", - "-c", filename:join(DataDir, "snmpd.conf"), - "-C", "-Lo", - "-m", "", + ["-f", "-r", %"-Dverbose", + "-c", filename:join(DataDir, "snmpd.conf"), + "-C", + "-Lo", + "-m", ":", "--sysDescr="++SysDescr, "--agentXSocket=tcp:localhost:"++integer_to_list(Port)] ++ CommunityArgs diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk index ef48608bda..c195f9f5d9 100644 --- a/lib/snmp/vsn.mk +++ b/lib/snmp/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = snmp -SNMP_VSN = 5.2.8 +SNMP_VSN = 5.2.9 PRE_VSN = APP_VSN = "$(APPLICATION)-$(SNMP_VSN)$(PRE_VSN)" diff --git a/lib/ssh/doc/src/Makefile b/lib/ssh/doc/src/Makefile index adbda5a030..f54f5e0708 100644 --- a/lib/ssh/doc/src/Makefile +++ b/lib/ssh/doc/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2004-2016. All Rights Reserved. +# Copyright Ericsson AB 2004-2017. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -48,18 +48,18 @@ XML_REF3_FILES = ssh.xml \ XML_REF6_FILES = ssh_app.xml -XML_PART_FILES = part_notes.xml \ +XML_PART_FILES = \ usersguide.xml XML_CHAPTER_FILES = notes.xml \ introduction.xml \ - ssh_protocol.xml \ using_ssh.xml \ configure_algos.xml +# ssh_protocol.xml \ BOOK_FILES = book.xml XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) $(XML_REF6_FILES)\ - $(XML_PART_FILES) $(XML_CHAPTER_FILES) + $(XML_PART_FILES) $(XML_CHAPTER_FILES) IMAGE_FILES = SSH_protocols.png @@ -85,10 +85,10 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += +XML_FLAGS += +DVIPS_FLAGS += # ---------------------------------------------------- # Targets @@ -116,12 +116,12 @@ clean clean_docs: man: $(MAN3_FILES) $(MAN6_FILES) -debug opt: +debug opt: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs diff --git a/lib/ssh/doc/src/fascicules.xml b/lib/ssh/doc/src/fascicules.xml deleted file mode 100644 index 7e99398c16..0000000000 --- a/lib/ssh/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="usersguide" href="usersguide_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index 216f7b1bff..4c8cbab858 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -30,6 +30,48 @@ <file>notes.xml</file> </header> +<section><title>Ssh 4.6.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Passphrase option for ecdsa public keys was missing.</p> + <p> + Own Id: OTP-14602</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + The host and user public key handling is hardened so that + a faulty plugin can't deliver a key of wrong type.</p> + <p> + Better checks in the server of the available hostkey's + types at start and at each accept.</p> + <p> + Better checks in the client of the available user public + key types at connect.</p> + <p> + Own Id: OTP-14676 Aux Id: ERIERL-52, OTP-14570 </p> + </item> + <item> + <p> + SSH can now fetch the host key from the private keys + stored in an Engine. See the crypto application for + details about Engines.</p> + <p> + Own Id: OTP-14757</p> + </item> + </list> + </section> + +</section> + <section><title>Ssh 4.6.2</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -57,7 +99,6 @@ </section> <section><title>Ssh 4.6.1</title> - <section><title>Fixed Bugs and Malfunctions</title> <list> <item> diff --git a/lib/ssh/doc/src/part_notes.xml b/lib/ssh/doc/src/part_notes.xml deleted file mode 100644 index aaca8ca9f2..0000000000 --- a/lib/ssh/doc/src/part_notes.xml +++ /dev/null @@ -1,38 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2004</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>SSH Release Notes</title> - <prepared>Jakob Cederlund</prepared> - <docno></docno> - <date></date> - <rev>%VSN%</rev> - <file>part_notes.sgml</file> - </header> - <description> - <p>This document describes the changes made to the SSH application. - </p> - </description> - <xi:include file="notes.xml"/> -</part> - diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index d9516fff12..337f4094cc 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -178,6 +178,12 @@ supplied with this option. </p> </item> + <tag><c><![CDATA[{ecdsa_pass_phrase, string()}]]></c></tag> + <item> + <p>If the user ECDSA key is protected by a passphrase, it can be + supplied with this option. + </p> + </item> <tag> <c><![CDATA[{silently_accept_hosts, boolean()}]]></c> <br/> <c><![CDATA[{silently_accept_hosts, CallbackFun}]]></c> <br/> diff --git a/lib/ssh/doc/src/ssh_client_key_api.xml b/lib/ssh/doc/src/ssh_client_key_api.xml index a1cd9d4b02..98a1676ca4 100644 --- a/lib/ssh/doc/src/ssh_client_key_api.xml +++ b/lib/ssh/doc/src/ssh_client_key_api.xml @@ -56,11 +56,17 @@ <tag><c>string() =</c></tag> <item><p><c>[byte()]</c></p></item> <tag><c>public_key() =</c></tag> - <item><p><c>#'RSAPublicKey'{}| {integer(), #'Dss-Parms'{}}| term()</c></p></item> + <item><p><c>#'RSAPublicKey'{} + | {integer(),#'Dss-Parms'{}} + | {#'ECPoint'{},{namedCurve,Curve::string()}}</c></p></item> <tag><c>private_key() =</c></tag> - <item><p><c>#'RSAPrivateKey'{} | #'DSAPrivateKey'{} | term()</c></p></item> + <item><p><c>#'RSAPrivateKey'{} + | #'DSAPrivateKey'{} + | #'ECPrivateKey'{}</c></p></item> <tag><c>public_key_algorithm() =</c></tag> - <item><p><c>'ssh-rsa'| 'ssh-dss' | atom()</c></p></item> + <item><p><c>'ssh-rsa' | 'ssh-dss' + | 'rsa-sha2-256' | 'rsa-sha2-384' | 'rsa-sha2-512' + | 'ecdsa-sha2-nistp256' | 'ecdsa-sha2-nistp384' | 'ecdsa-sha2-nistp521' </c></p></item> </taglist> </section> @@ -73,10 +79,11 @@ <d>Description of the host that owns the <c>PublicKey</c>.</d> <v>Key = public_key()</v> - <d>Normally an RSA or DSA public key, but handling of other public keys can be added.</d> + <d>Normally an RSA, DSA or ECDSA public key, but handling of other public keys can be added.</d> <v>ConnectOptions = proplists:proplist()</v> - <d>Options provided to <seealso marker="ssh#connect-3">ssh:connect/[3,4]</seealso></d> + <d>Options provided to <seealso marker="ssh#connect-3">ssh:connect/[3,4]</seealso>. The option list given in + the <c>key_cb</c> option is available with the key <c>key_cb_private</c>.</d> <v>Reason = term().</v> </type> <desc> @@ -89,17 +96,17 @@ <fsummary>Checks if a host key is trusted.</fsummary> <type> <v>Key = public_key() </v> - <d>Normally an RSA or DSA public key, but handling of other public keys can be added.</d> + <d>Normally an RSA, DSA or ECDSA public key, but handling of other public keys can be added.</d> <v>Host = string()</v> <d>Description of the host.</d> <v>Algorithm = public_key_algorithm()</v> - <d>Host key algorithm. Is to support <c>'ssh-rsa'| 'ssh-dss'</c>, but more algorithms - can be handled.</d> + <d>Host key algorithm.</d> <v>ConnectOptions = proplists:proplist() </v> - <d>Options provided to <seealso marker="ssh#connect-3">ssh:connect/[3,4]</seealso>.</d> + <d>Options provided to <seealso marker="ssh#connect-3">ssh:connect/[3,4]</seealso>. The option list given in + the <c>key_cb</c> option is available with the key <c>key_cb_private</c>.</d> <v>Result = boolean()</v> </type> @@ -110,15 +117,15 @@ <func> <name>Module:user_key(Algorithm, ConnectOptions) -> - {ok, PrivateKey} | {error, Reason}</name> + {ok, PrivateKey} | {error, Reason}</name> <fsummary>Fetches the users <em>public key</em> matching the <c>Algorithm</c>.</fsummary> <type> <v>Algorithm = public_key_algorithm()</v> - <d>Host key algorithm. Is to support <c>'ssh-rsa'| 'ssh-dss'</c> but more algorithms - can be handled.</d> + <d>Host key algorithm.</d> <v>ConnectOptions = proplists:proplist()</v> - <d>Options provided to <seealso marker="ssh#connect-3">ssh:connect/[3,4]</seealso></d> + <d>Options provided to <seealso marker="ssh#connect-3">ssh:connect/[3,4]</seealso>. The option list given in + the <c>key_cb</c> option is available with the key <c>key_cb_private</c>.</d> <v>PrivateKey = private_key()</v> <d>Private key of the user matching the <c>Algorithm</c>.</d> diff --git a/lib/ssh/doc/src/ssh_server_key_api.xml b/lib/ssh/doc/src/ssh_server_key_api.xml index a0694ca8d9..c6808b95d1 100644 --- a/lib/ssh/doc/src/ssh_server_key_api.xml +++ b/lib/ssh/doc/src/ssh_server_key_api.xml @@ -57,11 +57,17 @@ <tag><c>string() =</c></tag> <item><p><c>[byte()]</c></p></item> <tag><c>public_key() =</c></tag> - <item><p><c>#'RSAPublicKey'{}| {integer(), #'Dss-Parms'{}}| term()</c></p></item> + <item><p><c>#'RSAPublicKey'{} + | {integer(),#'Dss-Parms'{}} + | {#'ECPoint'{},{namedCurve,Curve::string()}}</c></p></item> <tag><c>private_key() =</c></tag> - <item><p><c>#'RSAPrivateKey'{} | #'DSAPrivateKey'{} | term()</c></p></item> + <item><p><c>#'RSAPrivateKey'{} + | #'DSAPrivateKey'{} + | #'ECPrivateKey'{}</c></p></item> <tag><c>public_key_algorithm() =</c></tag> - <item><p><c>'ssh-rsa'| 'ssh-dss' | atom()</c></p></item> + <item><p><c>'ssh-rsa' | 'ssh-dss' + | 'rsa-sha2-256' | 'rsa-sha2-384' | 'rsa-sha2-512' + | 'ecdsa-sha2-nistp256' | 'ecdsa-sha2-nistp384' | 'ecdsa-sha2-nistp521' </c></p></item> </taglist> </section> @@ -72,12 +78,13 @@ <fsummary>Fetches the host’s private key.</fsummary> <type> <v>Algorithm = public_key_algorithm()</v> - <d>Host key algorithm. Is to support <c>'ssh-rsa' | 'ssh-dss'</c>, but more algorithms - can be handled.</d> + <d>Host key algorithm.</d> <v>DaemonOptions = proplists:proplist()</v> - <d>Options provided to <seealso marker="ssh#daemon-2">ssh:daemon/[2,3]</seealso>.</d> - <v>Key = private_key()</v> - <d>Private key of the host matching the <c>Algorithm</c>.</d> + <d>Options provided to <seealso marker="ssh#daemon-2">ssh:daemon/[2,3]</seealso>. The option list given in + the <c>key_cb</c> option is available with the key <c>key_cb_private</c>.</d> + <v>Key = private_key() | crypto:engine_key_ref()</v> + <d>Private key of the host matching the <c>Algorithm</c>. + It may be a reference to a 'ssh-rsa', rsa-sha2-* or 'ssh-dss' (NOT ecdsa) key stored in a loaded Engine.</d> <v>Reason = term()</v> </type> <desc> @@ -90,11 +97,12 @@ <fsummary>Checks if the user key is authorized.</fsummary> <type> <v>Key = public_key()</v> - <d>Normally an RSA or DSA public key, but handling of other public keys can be added</d> + <d>Normally an RSA, DSA or ECDSA public key, but handling of other public keys can be added</d> <v>User = string()</v> <d>User owning the public key.</d> <v>DaemonOptions = proplists:proplist()</v> - <d>Options provided to <seealso marker="ssh#daemon-2">ssh:daemon/[2,3]</seealso>.</d> + <d>Options provided to <seealso marker="ssh#daemon-2">ssh:daemon/[2,3]</seealso>. The option list given in + the <c>key_cb</c> option is available with the key <c>key_cb_private</c>.</d> <v>Result = boolean()</v> </type> <desc> diff --git a/lib/ssh/src/ssh.app.src b/lib/ssh/src/ssh.app.src index 974292fde1..4a22322333 100644 --- a/lib/ssh/src/ssh.app.src +++ b/lib/ssh/src/ssh.app.src @@ -42,10 +42,10 @@ {env, []}, {mod, {ssh_app, []}}, {runtime_dependencies, [ - "crypto-3.7.3", + "crypto-4.2", "erts-6.0", "kernel-3.0", - "public_key-1.4", + "public_key-1.5.2", "stdlib-3.3" ]}]}. diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index 1a5d48baca..032d87bdad 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -188,6 +188,7 @@ daemon(Port) -> daemon(Socket, UserOptions) when is_port(Socket) -> try #{} = Options = ssh_options:handle_options(server, UserOptions), + case valid_socket_to_use(Socket, ?GET_OPT(transport,Options)) of ok -> {ok, {IP,Port}} = inet:sockname(Socket), @@ -461,6 +462,9 @@ open_listen_socket(_Host0, Port0, Options0) -> %%%---------------------------------------------------------------- finalize_start(Host, Port, Profile, Options0, F) -> try + %% throws error:Error if no usable hostkey is found + ssh_connection_handler:available_hkey_algorithms(server, Options0), + sshd_sup:start_child(Host, Port, Profile, Options0) of {error, {already_started, _}} -> @@ -470,6 +474,8 @@ finalize_start(Host, Port, Profile, Options0, F) -> Result = {ok,_} -> F(Options0, Result) catch + error:{shutdown,Err} -> + {error,Err}; exit:{noproc, _} -> {error, ssh_not_started} end. diff --git a/lib/ssh/src/ssh.hrl b/lib/ssh/src/ssh.hrl index d6d412db43..3dee1c5521 100644 --- a/lib/ssh/src/ssh.hrl +++ b/lib/ssh/src/ssh.hrl @@ -63,8 +63,8 @@ -define(uint16(X), << ?UINT16(X) >> ). -define(uint32(X), << ?UINT32(X) >> ). -define(uint64(X), << ?UINT64(X) >> ). --define(string(X), << ?STRING(list_to_binary(X)) >> ). -define(string_utf8(X), << ?STRING(unicode:characters_to_binary(X)) >> ). +-define(string(X), ?string_utf8(X)). -define(binary(X), << ?STRING(X) >>). %% Cipher details diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl index ac64a7bf14..894877f8bf 100644 --- a/lib/ssh/src/ssh_auth.erl +++ b/lib/ssh/src/ssh_auth.erl @@ -145,14 +145,17 @@ get_public_key(SigAlg, #ssh{opts = Opts}) -> case KeyCb:user_key(KeyAlg, [{key_cb_private,KeyCbOpts}|UserOpts]) of {ok, PrivKey} -> try + %% Check the key - the KeyCb may be a buggy plugin + true = ssh_transport:valid_key_sha_alg(PrivKey, KeyAlg), Key = ssh_transport:extract_public_key(PrivKey), public_key:ssh_encode(Key, ssh2_pubkey) of PubKeyBlob -> {ok,{PrivKey,PubKeyBlob}} catch _:_ -> - not_ok + not_ok end; + _Error -> not_ok end. diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 54fce6bd99..0ca960ef96 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -46,6 +46,7 @@ %%% Internal application API -export([start_connection/4, + available_hkey_algorithms/2, open_channel/6, request/6, request/7, reply_request/3, @@ -442,13 +443,12 @@ init_ssh_record(Role, Socket, Opts) -> init_ssh_record(Role, Socket, PeerAddr, Opts). init_ssh_record(Role, _Socket, PeerAddr, Opts) -> - KeyCb = ?GET_OPT(key_cb, Opts), AuthMethods = ?GET_OPT(auth_methods, Opts), S0 = #ssh{role = Role, - key_cb = KeyCb, + key_cb = ?GET_OPT(key_cb, Opts), opts = Opts, userauth_supported_methods = AuthMethods, - available_host_keys = supported_host_keys(Role, KeyCb, Opts), + available_host_keys = available_hkey_algorithms(Role, Opts), random_length_padding = ?GET_OPT(max_random_length_padding, Opts) }, @@ -1569,44 +1569,42 @@ peer_role(client) -> server; peer_role(server) -> client. %%-------------------------------------------------------------------- -supported_host_keys(client, _, Options) -> - try - find_sup_hkeys(Options) - of - [] -> +available_hkey_algorithms(Role, Options) -> + KeyCb = ?GET_OPT(key_cb, Options), + case [A || A <- available_hkey_algos(Options), + (Role==client) orelse available_host_key(KeyCb, A, Options) + ] of + + [] when Role==client -> error({shutdown, "No public key algs"}); - Algs -> - [atom_to_list(A) || A<-Algs] - catch - exit:Reason -> - error({shutdown, Reason}) - end; -supported_host_keys(server, KeyCb, Options) -> - [atom_to_list(A) || A <- find_sup_hkeys(Options), - available_host_key(KeyCb, A, Options) - ]. + [] when Role==server -> + error({shutdown, "No host key available"}); -find_sup_hkeys(Options) -> - case proplists:get_value(public_key, - ?GET_OPT(preferred_algorithms,Options) - ) - of - undefined -> - ssh_transport:default_algorithms(public_key); - L -> - NonSupported = L--ssh_transport:supported_algorithms(public_key), - L -- NonSupported + Algs -> + [atom_to_list(A) || A<-Algs] end. +available_hkey_algos(Options) -> + SupAlgos = ssh_transport:supported_algorithms(public_key), + HKeys = proplists:get_value(public_key, + ?GET_OPT(preferred_algorithms,Options) + ), + NonSupported = HKeys -- SupAlgos, + AvailableAndSupported = HKeys -- NonSupported, + AvailableAndSupported. + %% Alg :: atom() available_host_key({KeyCb,KeyCbOpts}, Alg, Opts) -> UserOpts = ?GET_OPT(user_options, Opts), case KeyCb:host_key(Alg, [{key_cb_private,KeyCbOpts}|UserOpts]) of - {ok,_} -> true; - _ -> false + {ok,Key} -> + %% Check the key - the KeyCb may be a buggy plugin + ssh_transport:valid_key_sha_alg(Key, Alg); + _ -> + false end. diff --git a/lib/ssh/src/ssh_dbg.erl b/lib/ssh/src/ssh_dbg.erl index 3f742ad9b6..af9ad52d68 100644 --- a/lib/ssh/src/ssh_dbg.erl +++ b/lib/ssh/src/ssh_dbg.erl @@ -24,6 +24,8 @@ -export([messages/0, messages/1, messages/2, messages/3, auth/0, auth/1, auth/2, auth/3, + algs/0, algs/1, algs/2, algs/3, + hostkey/0, hostkey/1, hostkey/2, hostkey/3, stop/0 ]). @@ -46,6 +48,16 @@ auth(F) -> start(auth,F). auth(F,X) -> start(auth,F,X). auth(F,M,I) -> start(auth,F,M,I). +algs() -> start(algs). +algs(F) -> start(algs,F). +algs(F,X) -> start(algs,F,X). +algs(F,M,I) -> start(algs,F,M,I). + +hostkey() -> start(hostkey). +hostkey(F) -> start(hostkey,F). +hostkey(F,X) -> start(hostkey,F,X). +hostkey(F,M,I) -> start(hostkey,F,M,I). + stop() -> dbg:stop(). %%%---------------------------------------------------------------- @@ -71,23 +83,49 @@ fmt_fun(F) -> fun(Fmt,Args,Data) -> F(Fmt,Args), Data end. id_fun() -> fun(X) -> X end. %%%---------------------------------------------------------------- -dbg_ssh(msg) -> - dbg_ssh(auth), - dbg:tp(ssh_message,encode,1, x), - dbg:tp(ssh_message,decode,1, x), - dbg:tpl(ssh_transport,select_algorithm,4, x), - dbg:tp(ssh_transport,hello_version_msg,1, x), - dbg:tp(ssh_transport,handle_hello_version,1, x), - dbg:tpl(ssh_connection_handler,ext_info,2, x); +dbg_ssh(What) -> + case [E || E <- lists:flatten(dbg_ssh0(What)), + element(1,E) =/= ok] of + [] -> ok; + Other -> Other + end. + + +dbg_ssh0(auth) -> + [dbg:tp(ssh_transport,hello_version_msg,1, x), + dbg:tp(ssh_transport,handle_hello_version,1, x), + dbg:tp(ssh_message,encode,1, x), + dbg:tpl(ssh_transport,select_algorithm,4, x), + dbg:tpl(ssh_connection_handler,ext_info,2, x), + lists:map(fun(F) -> dbg:tp(ssh_auth, F, x) end, + [publickey_msg, password_msg, keyboard_interactive_msg]) + ]; + +dbg_ssh0(algs) -> + [dbg:tpl(ssh_transport,select_algorithm,4, x), + dbg:tpl(ssh_connection_handler,ext_info,2, x) + ]; + +dbg_ssh0(hostkey) -> + [dbg:tpl(ssh_transport, verify_host_key, 4, x), + dbg:tp(ssh_transport, verify, 4, x), + dbg:tpl(ssh_transport, known_host_key, 3, x), +%% dbg:tpl(ssh_transport, accepted_host, 4, x), + dbg:tpl(ssh_transport, add_host_key, 4, x), + dbg:tpl(ssh_transport, is_host_key, 5, x) + ]; + +dbg_ssh0(msg) -> + [dbg_ssh0(hostkey), + dbg_ssh0(auth), + dbg:tp(ssh_message,encode,1, x), + dbg:tp(ssh_message,decode,1, x), + dbg:tpl(ssh_transport,select_algorithm,4, x), + dbg:tp(ssh_transport,hello_version_msg,1, x), + dbg:tp(ssh_transport,handle_hello_version,1, x), + dbg:tpl(ssh_connection_handler,ext_info,2, x) + ]. -dbg_ssh(auth) -> - dbg:tp(ssh_transport,hello_version_msg,1, x), - dbg:tp(ssh_transport,handle_hello_version,1, x), - dbg:tp(ssh_message,encode,1, x), - dbg:tpl(ssh_transport,select_algorithm,4, x), - dbg:tpl(ssh_connection_handler,ext_info,2, x), - lists:foreach(fun(F) -> dbg:tp(ssh_auth, F, x) end, - [publickey_msg, password_msg, keyboard_interactive_msg]). %%%================================================================ cond_start(Type, WriteFun, MangleArgFun, Init) -> @@ -110,10 +148,10 @@ msg_formater(msg, {trace_ts,_Pid,call,{ssh_message,decode,_},_TS}, D) -> msg_formater(msg, {trace_ts,Pid,return_from,{ssh_message,decode,1},Msg,TS}, D) -> fmt("~n~s ~p RECV ~s~n", [ts(TS),Pid,wr_record(shrink_bin(Msg))], D); -msg_formater(auth, {trace_ts,Pid,return_from,{ssh_message,decode,1},#ssh_msg_userauth_failure{authentications=As},TS}, D) -> +msg_formater(_auth, {trace_ts,Pid,return_from,{ssh_message,decode,1},#ssh_msg_userauth_failure{authentications=As},TS}, D) -> fmt("~n~s ~p Client login FAILURE. Try ~s~n", [ts(TS),Pid,As], D); -msg_formater(auth, {trace_ts,Pid,return_from,{ssh_message,decode,1},#ssh_msg_userauth_success{},TS}, D) -> +msg_formater(_auth, {trace_ts,Pid,return_from,{ssh_message,decode,1},#ssh_msg_userauth_success{},TS}, D) -> fmt("~n~s ~p Client login SUCCESS~n", [ts(TS),Pid], D); @@ -155,10 +193,50 @@ msg_formater(_, {trace_ts,Pid,return_from,{ssh_connection_handler,ext_info,2},St D end; +msg_formater(_, {trace_ts,Pid,call, {ssh_transport,verify_host_key,[_Ssh,_PK,_Dgst,{AlgStr,_Sign}]},TS}, D) -> + fmt("~n~s ~p Client got a ~s hostkey. Will try to verify it~n", [ts(TS),Pid,AlgStr], D); +msg_formater(_, {trace_ts,Pid,return_from, {ssh_transport,verify_host_key,4}, Result, TS}, D) -> + case Result of + ok -> fmt("~n~s ~p Hostkey verified.~n", [ts(TS),Pid], D); + {error,E} -> + fmt("~n~s ~p ***** Hostkey NOT verified: ~p ******!~n", [ts(TS),Pid,E], D); + _ -> fmt("~n~s ~p ***** Hostkey is NOT verified: ~p ******!~n", [ts(TS),Pid,Result], D) + end; + +msg_formater(_, {trace_ts,Pid,return_from, {ssh_transport,verify,4}, Result, TS}, D) -> + case Result of + true -> D; + _ -> fmt("~n~s ~p Couldn't verify the signature!~n", [ts(TS),Pid], D) + end; + +msg_formater(_, {trace_ts,_Pid,call, {ssh_transport,is_host_key,_}, _TS}, D) -> D; +msg_formater(_, {trace_ts,Pid,return_from, {ssh_transport,is_host_key,5}, {CbMod,Result}, TS}, D) -> + case Result of + true -> fmt("~n~s ~p Hostkey found by ~p.~n", [ts(TS),Pid,CbMod], D); + _ -> fmt("~n~s ~p Hostkey NOT found by ~p.~n", [ts(TS),Pid,CbMod], D) + end; + +msg_formater(_, {trace_ts,_Pid,call, {ssh_transport,add_host_key,_}, _TS}, D) -> D; +msg_formater(_, {trace_ts,Pid,return_from, {ssh_transport,add_host_key,4}, {CbMod,Result}, TS}, D) -> + case Result of + ok -> fmt("~n~s ~p New hostkey added by ~p.~n", [ts(TS),Pid,CbMod], D); + _ -> D + end; + +msg_formater(_, {trace_ts,_Pid,call,{ssh_transport,known_host_key,_},_TS}, D) -> D; +msg_formater(_, {trace_ts,Pid,return_from, {ssh_transport,known_host_key,3}, Result, TS}, D) -> + case Result of + ok -> D; + {error,E} -> fmt("~n~s ~p Hostkey addition failed: ~p~n", [ts(TS),Pid,E], D); + _ -> fmt("~n~s ~p Hostkey addition: ~p~n", [ts(TS),Pid,Result], D) + end; + msg_formater(_, {trace_ts,Pid,call,{ssh_auth,publickey_msg,[[SigAlg,#ssh{user=User}]]},TS}, D) -> fmt("~n~s ~p Client will try to login user ~p with public key algorithm ~p~n", [ts(TS),Pid,User,SigAlg], D); msg_formater(_, {trace_ts,Pid,return_from,{ssh_auth,publickey_msg,1},{not_ok,#ssh{user=User}},TS}, D) -> fmt("~s ~p User ~p can't login with that kind of public key~n", [ts(TS),Pid,User], D); +msg_formater(_, {trace_ts,Pid,return_from,{ssh_auth,publickey_msg,1},{_,#ssh{user=User}},TS}, D) -> + fmt("~s ~p User ~p logged in~n", [ts(TS),Pid,User], D); msg_formater(_, {trace_ts,Pid,call,{ssh_auth,password_msg,[[#ssh{user=User}]]},TS}, D) -> fmt("~n~s ~p Client will try to login user ~p with password~n", [ts(TS),Pid,User], D); @@ -187,26 +265,20 @@ msg_formater(msg, {trace_ts,Pid,'receive',ErlangMsg,TS}, D) -> fmt("~n~s ~p ERL MSG RECEIVE~n ~p~n", [ts(TS),Pid,shrink_bin(ErlangMsg)], D); -%% msg_formater(_, {trace_ts,_Pid,return_from,MFA,_Ret,_TS}=M, D) -> -%% case lists:member(MFA, [{ssh_auth,keyboard_interactive_msg,1}, -%% {ssh_auth,password_msg,1}, -%% {ssh_auth,publickey_msg,1}]) of -%% true -> -%% D; -%% false -> -%% fmt("~nDBG ~n~p~n", [shrink_bin(M)], D) -%% end; - -%% msg_formater(_, M, D) -> -%% fmt("~nDBG ~n~p~n", [shrink_bin(M)], D). - -msg_formater(_, _, D) -> - D. +msg_formater(_, _M, D) -> + fmt("~nDBG other ~n~p~n", [shrink_bin(_M)], D), + D. %%%---------------------------------------------------------------- -record(data, {writer, + initialized, acc}). +fmt(Fmt, Args, D=#data{initialized=false}) -> + fmt(Fmt, Args, + D#data{acc = (D#data.writer)("~s~n", [initial_info()], D#data.acc), + initialized = true} + ); fmt(Fmt, Args, D=#data{writer=Write, acc=Acc}) -> D#data{acc = Write(Fmt,Args,Acc)}. @@ -221,10 +293,47 @@ setup_tracer(Type, WriteFun, MangleArgFun, Init) -> msg_formater(Type, MangleArgFun(Arg), D) end, InitialData = #data{writer = WriteFun, + initialized = false, acc = Init}, {ok,_} = dbg:tracer(process, {Handler, InitialData}), ok. + +initial_info() -> + Lines = + [ts(erlang:timestamp()), + "", + "SSH:"] + ++ as_list_of_lines(case application:get_key(ssh,vsn) of + {ok,Vsn} -> Vsn; + _ -> "(ssh not started)" + end) + ++ ["", + "Cryptolib:"] + ++ as_list_of_lines(crypto:info_lib()) + ++ ["", + "Crypto app:"] + ++ as_list_of_lines(crypto:supports()), + W = max_len(Lines), + append_lines([line_of($*, W+4)] + ++ prepend_lines("* ", Lines) + ++ [line_of($-, W+4)], + io_lib:nl() + ). + + +as_list_of_lines(Term) -> + prepend_lines(" ", + string:tokens(lists:flatten(io_lib:format("~p",[Term])), + io_lib:nl() % Get line endings in current OS + ) + ). + +line_of(Char,W) -> lists:duplicate(W,Char). +max_len(L) -> lists:max([length(S) || S<-L]). +append_lines(L, X) -> [S++X || S<-L]. +prepend_lines(X, L) -> [X++S || S<-L]. + %%%---------------------------------------------------------------- shrink_bin(B) when is_binary(B), size(B)>256 -> {'*** SHRINKED BIN', size(B), diff --git a/lib/ssh/src/ssh_message.erl b/lib/ssh/src/ssh_message.erl index b1fc05ae33..eb06f05a4a 100644 --- a/lib/ssh/src/ssh_message.erl +++ b/lib/ssh/src/ssh_message.erl @@ -252,12 +252,12 @@ encode(#ssh_msg_kexdh_init{e = E}) -> <<?Ebyte(?SSH_MSG_KEXDH_INIT), ?Empint(E)>>; encode(#ssh_msg_kexdh_reply{ - public_host_key = Key, + public_host_key = {Key,SigAlg}, f = F, h_sig = Signature }) -> EncKey = public_key:ssh_encode(Key, ssh2_pubkey), - EncSign = encode_signature(Key, Signature), + EncSign = encode_signature(Key, SigAlg, Signature), <<?Ebyte(?SSH_MSG_KEXDH_REPLY), ?Ebinary(EncKey), ?Empint(F), ?Ebinary(EncSign)>>; encode(#ssh_msg_kex_dh_gex_request{ @@ -278,20 +278,20 @@ encode(#ssh_msg_kex_dh_gex_init{e = Public}) -> encode(#ssh_msg_kex_dh_gex_reply{ %% Will be private key encode_host_key extracts only the public part! - public_host_key = Key, + public_host_key = {Key,SigAlg}, f = F, h_sig = Signature }) -> EncKey = public_key:ssh_encode(Key, ssh2_pubkey), - EncSign = encode_signature(Key, Signature), + EncSign = encode_signature(Key, SigAlg, Signature), <<?Ebyte(?SSH_MSG_KEX_DH_GEX_REPLY), ?Ebinary(EncKey), ?Empint(F), ?Ebinary(EncSign)>>; encode(#ssh_msg_kex_ecdh_init{q_c = Q_c}) -> <<?Ebyte(?SSH_MSG_KEX_ECDH_INIT), ?Empint(Q_c)>>; -encode(#ssh_msg_kex_ecdh_reply{public_host_key = Key, q_s = Q_s, h_sig = Sign}) -> +encode(#ssh_msg_kex_ecdh_reply{public_host_key = {Key,SigAlg}, q_s = Q_s, h_sig = Sign}) -> EncKey = public_key:ssh_encode(Key, ssh2_pubkey), - EncSign = encode_signature(Key, Sign), + EncSign = encode_signature(Key, SigAlg, Sign), <<?Ebyte(?SSH_MSG_KEX_ECDH_REPLY), ?Ebinary(EncKey), ?Empint(Q_s), ?Ebinary(EncSign)>>; encode(#ssh_msg_ignore{data = Data}) -> @@ -602,12 +602,12 @@ decode_signature(<<?DEC_BIN(Alg,__0), ?UINT32(_), Signature/binary>>) -> {binary_to_list(Alg), Signature}. -encode_signature({#'RSAPublicKey'{},Sign}, Signature) -> - SignName = list_to_binary(atom_to_list(Sign)), +encode_signature(#'RSAPublicKey'{}, SigAlg, Signature) -> + SignName = list_to_binary(atom_to_list(SigAlg)), <<?Ebinary(SignName), ?Ebinary(Signature)>>; -encode_signature({{_, #'Dss-Parms'{}},_}, Signature) -> +encode_signature({_, #'Dss-Parms'{}}, _SigAlg, Signature) -> <<?Ebinary(<<"ssh-dss">>), ?Ebinary(Signature)>>; -encode_signature({{#'ECPoint'{}, {namedCurve,OID}},_}, Signature) -> +encode_signature({#'ECPoint'{}, {namedCurve,OID}}, _SigAlg, Signature) -> CurveName = public_key:oid2ssh_curvename(OID), <<?Ebinary(<<"ecdsa-sha2-",CurveName/binary>>), ?Ebinary(Signature)>>. diff --git a/lib/ssh/src/ssh_options.erl b/lib/ssh/src/ssh_options.erl index 6939094401..68c99743ee 100644 --- a/lib/ssh/src/ssh_options.erl +++ b/lib/ssh/src/ssh_options.erl @@ -421,6 +421,12 @@ default(client) -> class => user_options }, + {ecdsa_pass_phrase, def} => + #{default => undefined, + chk => fun check_string/1, + class => user_options + }, + {silently_accept_hosts, def} => #{default => false, chk => fun check_silently_accept_hosts/1, diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 6d158537d4..90a94a7e86 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -426,7 +426,7 @@ handle_kexdh_init(#ssh_msg_kexdh_init{e = E}, K = compute_key(dh, E, Private, [P,G]), MyPrivHostKey = get_host_key(Ssh0, SignAlg), MyPubHostKey = extract_public_key(MyPrivHostKey), - H = kex_hash(Ssh0, MyPubHostKey, SignAlg, sha(Kex), {E,Public,K}), + H = kex_hash(Ssh0, MyPubHostKey, sha(Kex), {E,Public,K}), H_SIG = sign(H, sha(SignAlg), MyPrivHostKey), {SshPacket, Ssh1} = ssh_packet(#ssh_msg_kexdh_reply{public_host_key = {MyPubHostKey,SignAlg}, @@ -451,13 +451,12 @@ handle_kexdh_reply(#ssh_msg_kexdh_reply{public_host_key = PeerPubHostKey, f = F, h_sig = H_SIG}, #ssh{keyex_key = {{Private, Public}, {G, P}}, - algorithms = #alg{kex=Kex, - hkey=SignAlg}} = Ssh0) -> + algorithms = #alg{kex=Kex}} = Ssh0) -> %% client if 1=<F, F=<(P-1)-> K = compute_key(dh, F, Private, [P,G]), - H = kex_hash(Ssh0, PeerPubHostKey, SignAlg, sha(Kex), {Public,F,K}), + H = kex_hash(Ssh0, PeerPubHostKey, sha(Kex), {Public,F,K}), case verify_host_key(Ssh0, PeerPubHostKey, H, H_SIG) of ok -> {SshPacket, Ssh} = ssh_packet(#ssh_msg_newkeys{}, Ssh0), @@ -590,7 +589,7 @@ handle_kex_dh_gex_init(#ssh_msg_kex_dh_gex_init{e = E}, 1<K, K<(P-1) -> MyPrivHostKey = get_host_key(Ssh0, SignAlg), MyPubHostKey = extract_public_key(MyPrivHostKey), - H = kex_hash(Ssh0, MyPubHostKey, SignAlg, sha(Kex), {Min,NBits,Max,P,G,E,Public,K}), + H = kex_hash(Ssh0, MyPubHostKey, sha(Kex), {Min,NBits,Max,P,G,E,Public,K}), H_SIG = sign(H, sha(SignAlg), MyPrivHostKey), {SshPacket, Ssh} = ssh_packet(#ssh_msg_kex_dh_gex_reply{public_host_key = {MyPubHostKey,SignAlg}, @@ -620,8 +619,7 @@ handle_kex_dh_gex_reply(#ssh_msg_kex_dh_gex_reply{public_host_key = PeerPubHostK h_sig = H_SIG}, #ssh{keyex_key = {{Private, Public}, {G, P}}, keyex_info = {Min, Max, NBits}, - algorithms = #alg{kex=Kex, - hkey=SignAlg}} = + algorithms = #alg{kex=Kex}} = Ssh0) -> %% client if @@ -629,7 +627,7 @@ handle_kex_dh_gex_reply(#ssh_msg_kex_dh_gex_reply{public_host_key = PeerPubHostK K = compute_key(dh, F, Private, [P,G]), if 1<K, K<(P-1) -> - H = kex_hash(Ssh0, PeerPubHostKey, SignAlg, sha(Kex), {Min,NBits,Max,P,G,Public,F,K}), + H = kex_hash(Ssh0, PeerPubHostKey, sha(Kex), {Min,NBits,Max,P,G,Public,F,K}), case verify_host_key(Ssh0, PeerPubHostKey, H, H_SIG) of ok -> {SshPacket, Ssh} = ssh_packet(#ssh_msg_newkeys{}, Ssh0), @@ -676,7 +674,7 @@ handle_kex_ecdh_init(#ssh_msg_kex_ecdh_init{q_c = PeerPublic}, K -> MyPrivHostKey = get_host_key(Ssh0, SignAlg), MyPubHostKey = extract_public_key(MyPrivHostKey), - H = kex_hash(Ssh0, MyPubHostKey, SignAlg, sha(Curve), {PeerPublic, MyPublic, K}), + H = kex_hash(Ssh0, MyPubHostKey, sha(Curve), {PeerPublic, MyPublic, K}), H_SIG = sign(H, sha(SignAlg), MyPrivHostKey), {SshPacket, Ssh1} = ssh_packet(#ssh_msg_kex_ecdh_reply{public_host_key = {MyPubHostKey,SignAlg}, @@ -699,15 +697,15 @@ handle_kex_ecdh_init(#ssh_msg_kex_ecdh_init{q_c = PeerPublic}, handle_kex_ecdh_reply(#ssh_msg_kex_ecdh_reply{public_host_key = PeerPubHostKey, q_s = PeerPublic, h_sig = H_SIG}, - #ssh{keyex_key = {{MyPublic,MyPrivate}, Curve}, - algorithms = #alg{hkey=SignAlg}} = Ssh0 + #ssh{keyex_key = {{MyPublic,MyPrivate}, Curve} + } = Ssh0 ) -> %% at client try compute_key(ecdh, PeerPublic, MyPrivate, Curve) of K -> - H = kex_hash(Ssh0, PeerPubHostKey, SignAlg, sha(Curve), {MyPublic,PeerPublic,K}), + H = kex_hash(Ssh0, PeerPubHostKey, sha(Curve), {MyPublic,PeerPublic,K}), case verify_host_key(Ssh0, PeerPubHostKey, H, H_SIG) of ok -> {SshPacket, Ssh} = ssh_packet(#ssh_msg_newkeys{}, Ssh0), @@ -797,8 +795,14 @@ get_host_key(SSH, SignAlg) -> #ssh{key_cb = {KeyCb,KeyCbOpts}, opts = Opts} = SSH, UserOpts = ?GET_OPT(user_options, Opts), case KeyCb:host_key(SignAlg, [{key_cb_private,KeyCbOpts}|UserOpts]) of - {ok, PrivHostKey} -> PrivHostKey; - Result -> exit({error, {Result, unsupported_key_type}}) + {ok, PrivHostKey} -> + %% Check the key - the KeyCb may be a buggy plugin + case valid_key_sha_alg(PrivHostKey, SignAlg) of + true -> PrivHostKey; + false -> exit({error, bad_hostkey}) + end; + Result -> + exit({error, {Result, unsupported_key_type}}) end. extract_public_key(#'RSAPrivateKey'{modulus = N, publicExponent = E}) -> @@ -807,7 +811,15 @@ extract_public_key(#'DSAPrivateKey'{y = Y, p = P, q = Q, g = G}) -> {Y, #'Dss-Parms'{p=P, q=Q, g=G}}; extract_public_key(#'ECPrivateKey'{parameters = {namedCurve,OID}, publicKey = Q}) -> - {#'ECPoint'{point=Q}, {namedCurve,OID}}. + {#'ECPoint'{point=Q}, {namedCurve,OID}}; +extract_public_key(#{engine:=_, key_id:=_, algorithm:=Alg} = M) -> + case {Alg, crypto:privkey_to_pubkey(Alg, M)} of + {rsa, [E,N]} -> + #'RSAPublicKey'{modulus = N, publicExponent = E}; + {dss, [P,Q,G,Y]} -> + {Y, #'Dss-Parms'{p=P, q=Q, g=G}} + end. + verify_host_key(#ssh{algorithms=Alg}=SSH, PublicKey, Digest, {AlgStr,Signature}) -> @@ -824,6 +836,7 @@ verify_host_key(#ssh{algorithms=Alg}=SSH, PublicKey, Digest, {AlgStr,Signature}) end. +%%% -> boolean() | {error,_} accepted_host(Ssh, PeerName, Public, Opts) -> case ?GET_OPT(silently_accept_hosts, Opts) of @@ -845,11 +858,16 @@ accepted_host(Ssh, PeerName, Public, Opts) -> %% Call-back alternatives: A user provided fun is called for the decision: F when is_function(F,2) -> - true == (catch F(PeerName, public_key:ssh_hostkey_fingerprint(Public))); + case catch F(PeerName, public_key:ssh_hostkey_fingerprint(Public)) of + true -> true; + _ -> {error, fingerprint_check_failed} + end; {DigestAlg,F} when is_function(F,2) -> - true == (catch F(PeerName, public_key:ssh_hostkey_fingerprint(DigestAlg,Public))) - + case catch F(PeerName, public_key:ssh_hostkey_fingerprint(DigestAlg,Public)) of + true -> true; + _ -> {error, {fingerprint_check_failed,DigestAlg}} + end end. @@ -867,18 +885,27 @@ fmt_hostkey(X) -> X. known_host_key(#ssh{opts = Opts, key_cb = {KeyCb,KeyCbOpts}, peer = {PeerName,_}} = Ssh, Public, Alg) -> UserOpts = ?GET_OPT(user_options, Opts), - case KeyCb:is_host_key(Public, PeerName, Alg, [{key_cb_private,KeyCbOpts}|UserOpts]) of - true -> + case is_host_key(KeyCb, Public, PeerName, Alg, [{key_cb_private,KeyCbOpts}|UserOpts]) of + {_,true} -> ok; - false -> + {_,false} -> case accepted_host(Ssh, PeerName, Public, Opts) of true -> - KeyCb:add_host_key(PeerName, Public, [{key_cb_private,KeyCbOpts}|UserOpts]); + {_,R} = add_host_key(KeyCb, PeerName, Public, [{key_cb_private,KeyCbOpts}|UserOpts]), + R; false -> - {error, rejected} + {error, rejected_by_user}; + {error,E} -> + {error,E} end end. +is_host_key(KeyCb, Public, PeerName, Alg, Data) -> + {KeyCb, KeyCb:is_host_key(Public, PeerName, Alg, Data)}. + +add_host_key(KeyCb, PeerName, Public, Data) -> + {KeyCb, KeyCb:add_host_key(PeerName, Public, Data)}. + %% Each of the algorithm strings MUST be a comma-separated list of %% algorithm names (see ''Algorithm Naming'' in [SSH-ARCH]). Each @@ -1242,10 +1269,12 @@ payload(<<PacketLen:32, PaddingLen:8, PayloadAndPadding/binary>>) -> <<Payload:PayloadLen/binary, _/binary>> = PayloadAndPadding, Payload. +sign(SigData, HashAlg, #{algorithm:=dss} = Key) -> + mk_dss_sig(crypto:sign(dss, HashAlg, SigData, Key)); +sign(SigData, HashAlg, #{algorithm:=SigAlg} = Key) -> + crypto:sign(SigAlg, HashAlg, SigData, Key); sign(SigData, HashAlg, #'DSAPrivateKey'{} = Key) -> - DerSignature = public_key:sign(SigData, HashAlg, Key), - #'Dss-Sig-Value'{r = R, s = S} = public_key:der_decode('Dss-Sig-Value', DerSignature), - <<R:160/big-unsigned-integer, S:160/big-unsigned-integer>>; + mk_dss_sig(public_key:sign(SigData, HashAlg, Key)); sign(SigData, HashAlg, Key = #'ECPrivateKey'{}) -> DerEncodedSign = public_key:sign(SigData, HashAlg, Key), #'ECDSA-Sig-Value'{r=R, s=S} = public_key:der_decode('ECDSA-Sig-Value', DerEncodedSign), @@ -1253,6 +1282,12 @@ sign(SigData, HashAlg, Key = #'ECPrivateKey'{}) -> sign(SigData, HashAlg, Key) -> public_key:sign(SigData, HashAlg, Key). + +mk_dss_sig(DerSignature) -> + #'Dss-Sig-Value'{r = R, s = S} = public_key:der_decode('Dss-Sig-Value', DerSignature), + <<R:160/big-unsigned-integer, S:160/big-unsigned-integer>>. + + verify(PlainText, HashAlg, Sig, {_, #'Dss-Parms'{}} = Key) -> case Sig of <<R:160/big-unsigned-integer, S:160/big-unsigned-integer>> -> @@ -1779,11 +1814,11 @@ hash(K, H, Ki, N, HashAlg) -> hash(K, H, <<Ki/binary, Kj/binary>>, N-128, HashAlg). %%%---------------------------------------------------------------- -kex_hash(SSH, Key, SignAlg, HashAlg, Args) -> - crypto:hash(HashAlg, kex_plaintext(SSH,Key,SignAlg,Args)). +kex_hash(SSH, Key, HashAlg, Args) -> + crypto:hash(HashAlg, kex_plaintext(SSH,Key,Args)). -kex_plaintext(SSH, Key, SignAlg, Args) -> - EncodedKey = public_key:ssh_encode({Key,SignAlg}, ssh2_pubkey), +kex_plaintext(SSH, Key, Args) -> + EncodedKey = public_key:ssh_encode(Key, ssh2_pubkey), <<?Estring(SSH#ssh.c_version), ?Estring(SSH#ssh.s_version), ?Ebinary(SSH#ssh.c_keyinit), ?Ebinary(SSH#ssh.s_keyinit), ?Ebinary(EncodedKey), @@ -1804,6 +1839,8 @@ kex_alg_dependent({Min, NBits, Max, Prime, Gen, E, F, K}) -> %%%---------------------------------------------------------------- +valid_key_sha_alg(#{engine:=_, key_id:=_}, _Alg) -> true; % Engine key + valid_key_sha_alg(#'RSAPublicKey'{}, 'rsa-sha2-512') -> true; valid_key_sha_alg(#'RSAPublicKey'{}, 'rsa-sha2-384') -> true; valid_key_sha_alg(#'RSAPublicKey'{}, 'rsa-sha2-256') -> true; @@ -1817,11 +1854,14 @@ valid_key_sha_alg(#'RSAPrivateKey'{}, 'ssh-rsa' ) -> true; valid_key_sha_alg({_, #'Dss-Parms'{}}, 'ssh-dss') -> true; valid_key_sha_alg(#'DSAPrivateKey'{}, 'ssh-dss') -> true; -valid_key_sha_alg({#'ECPoint'{},{namedCurve,OID}}, Alg) -> sha(OID) == sha(Alg); -valid_key_sha_alg(#'ECPrivateKey'{parameters = {namedCurve,OID}}, Alg) -> sha(OID) == sha(Alg); +valid_key_sha_alg({#'ECPoint'{},{namedCurve,OID}}, Alg) -> valid_key_sha_alg_ec(OID, Alg); +valid_key_sha_alg(#'ECPrivateKey'{parameters = {namedCurve,OID}}, Alg) -> valid_key_sha_alg_ec(OID, Alg); valid_key_sha_alg(_, _) -> false. - +valid_key_sha_alg_ec(OID, Alg) -> + Curve = public_key:oid2ssh_curvename(OID), + Alg == list_to_atom("ecdsa-sha2-" ++ binary_to_list(Curve)). + public_algo(#'RSAPublicKey'{}) -> 'ssh-rsa'; % FIXME: Not right with draft-curdle-rsa-sha2 public_algo({_, #'Dss-Parms'{}}) -> 'ssh-dss'; diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile index 32e76cf077..a18383d148 100644 --- a/lib/ssh/test/Makefile +++ b/lib/ssh/test/Makefile @@ -38,7 +38,9 @@ MODULES= \ ssh_basic_SUITE \ ssh_bench_SUITE \ ssh_connection_SUITE \ + ssh_engine_SUITE \ ssh_protocol_SUITE \ + ssh_property_test_SUITE \ ssh_sftp_SUITE \ ssh_sftpd_SUITE \ ssh_sftpd_erlclient_SUITE \ @@ -48,6 +50,7 @@ MODULES= \ ssh_test_lib \ ssh_key_cb \ ssh_key_cb_options \ + ssh_key_cb_engine_keys \ ssh_trpt_test_lib \ ssh_echo_server \ ssh_bench_dev_null \ diff --git a/lib/ssh/test/property_test/ssh_eqc_client_info_timing.erl b/lib/ssh/test/property_test/ssh_eqc_client_info_timing.erl index c07140dc43..19e2754eba 100644 --- a/lib/ssh/test/property_test/ssh_eqc_client_info_timing.erl +++ b/lib/ssh/test/property_test/ssh_eqc_client_info_timing.erl @@ -57,9 +57,9 @@ %%% Properties: -prop_seq(_Config) -> +prop_seq(Config) -> {ok,Pid} = ssh_eqc_event_handler:add_report_handler(), - {_, _, Port} = init_daemon(), + {_, _, Port} = init_daemon(Config), numtests(1000, ?FORALL(Delay, choose(0,100),%% Micro seconds try @@ -86,7 +86,8 @@ any_relevant_error_report(Pid) -> end, Reports). %%%================================================================ -init_daemon() -> +init_daemon(Config) -> ok = begin ssh:stop(), ssh:start() end, - ssh_test_lib:daemon([]). + DataDir = proplists:get_value(data_dir, Config), + ssh_test_lib:daemon([{system_dir,DataDir}]). diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index 62e2a585e4..202b0afe57 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -46,6 +46,7 @@ exec_key_differs2/1, exec_key_differs3/1, exec_key_differs_fail/1, + fail_daemon_start/1, idle_time_client/1, idle_time_server/1, inet6_option/1, @@ -99,9 +100,13 @@ all() -> {group, ecdsa_sha2_nistp521_key}, {group, dsa_pass_key}, {group, rsa_pass_key}, + {group, ecdsa_sha2_nistp256_pass_key}, + {group, ecdsa_sha2_nistp384_pass_key}, + {group, ecdsa_sha2_nistp521_pass_key}, {group, host_user_key_differs}, {group, key_cb}, {group, internal_error}, + {group, rsa_host_key_is_actualy_ecdsa}, daemon_already_started, double_close, daemon_opt_fd, @@ -118,12 +123,16 @@ groups() -> {ecdsa_sha2_nistp256_key, [], basic_tests()}, {ecdsa_sha2_nistp384_key, [], basic_tests()}, {ecdsa_sha2_nistp521_key, [], basic_tests()}, + {rsa_host_key_is_actualy_ecdsa, [], [fail_daemon_start]}, {host_user_key_differs, [], [exec_key_differs1, exec_key_differs2, exec_key_differs3, exec_key_differs_fail]}, {dsa_pass_key, [], [pass_phrase]}, {rsa_pass_key, [], [pass_phrase]}, + {ecdsa_sha2_nistp256_pass_key, [], [pass_phrase]}, + {ecdsa_sha2_nistp384_pass_key, [], [pass_phrase]}, + {ecdsa_sha2_nistp521_pass_key, [], [pass_phrase]}, {key_cb, [], [key_callback, key_callback_options]}, {internal_error, [], [internal_error]}, {login_bad_pwd_no_retry, [], [login_bad_pwd_no_retry1, @@ -174,6 +183,31 @@ init_per_group(rsa_key, Config) -> false -> {skip, unsupported_pub_key} end; +init_per_group(rsa_host_key_is_actualy_ecdsa, Config) -> + case + lists:member('ssh-rsa', + ssh_transport:default_algorithms(public_key)) and + lists:member('ecdsa-sha2-nistp256', + ssh_transport:default_algorithms(public_key)) + of + true -> + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), + ssh_test_lib:setup_ecdsa("256", DataDir, PrivDir), + %% The following sets up bad rsa keys: + begin + UserDir = PrivDir, + System = filename:join(UserDir, "system"), + file:copy(filename:join(DataDir, "id_rsa"), filename:join(UserDir, "id_rsa")), + file:rename(filename:join(System, "ssh_host_ecdsa_key"), filename:join(System, "ssh_host_rsa_key")), + file:rename(filename:join(System, "ssh_host_ecdsa_key.pub"), filename:join(System, "ssh_host_rsa_key.pub")), + ssh_test_lib:setup_rsa_known_host(DataDir, UserDir), + ssh_test_lib:setup_rsa_auth_keys(DataDir, UserDir) + end, + Config; + false -> + {skip, unsupported_pub_key} + end; init_per_group(ecdsa_sha2_nistp256_key, Config) -> case lists:member('ecdsa-sha2-nistp256', ssh_transport:default_algorithms(public_key)) of @@ -229,6 +263,45 @@ init_per_group(dsa_pass_key, Config) -> false -> {skip, unsupported_pub_key} end; +init_per_group(ecdsa_sha2_nistp256_pass_key, Config) -> + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), + case lists:member('ecdsa-sha2-nistp256', + ssh_transport:default_algorithms(public_key)) + andalso + ssh_test_lib:setup_ecdsa_pass_phrase("256", DataDir, PrivDir, "Password") + of + true -> + [{pass_phrase, {ecdsa_pass_phrase, "Password"}}| Config]; + false -> + {skip, unsupported_pub_key} + end; +init_per_group(ecdsa_sha2_nistp384_pass_key, Config) -> + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), + case lists:member('ecdsa-sha2-nistp384', + ssh_transport:default_algorithms(public_key)) + andalso + ssh_test_lib:setup_ecdsa_pass_phrase("384", DataDir, PrivDir, "Password") + of + true -> + [{pass_phrase, {ecdsa_pass_phrase, "Password"}}| Config]; + false -> + {skip, unsupported_pub_key} + end; +init_per_group(ecdsa_sha2_nistp521_pass_key, Config) -> + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), + case lists:member('ecdsa-sha2-nistp521', + ssh_transport:default_algorithms(public_key)) + andalso + ssh_test_lib:setup_ecdsa_pass_phrase("521", DataDir, PrivDir, "Password") + of + true -> + [{pass_phrase, {ecdsa_pass_phrase, "Password"}}| Config]; + false -> + {skip, unsupported_pub_key} + end; init_per_group(host_user_key_differs, Config) -> Data = proplists:get_value(data_dir, Config), Sys = filename:join(proplists:get_value(priv_dir, Config), system_rsa), @@ -241,7 +314,7 @@ init_per_group(host_user_key_differs, Config) -> file:copy(filename:join(Data, "ssh_host_rsa_key.pub"), filename:join(Sys, "ssh_host_rsa_key.pub")), file:copy(filename:join(Data, "id_ecdsa256"), filename:join(Usr, "id_ecdsa")), file:copy(filename:join(Data, "id_ecdsa256.pub"), filename:join(Usr, "id_ecdsa.pub")), - ssh_test_lib:setup_ecdsa_auth_keys("256", Usr, SysUsr), + ssh_test_lib:setup_ecdsa_auth_keys("256", Data, SysUsr), ssh_test_lib:setup_rsa_known_host(Sys, Usr), Config; init_per_group(key_cb, Config) -> @@ -259,7 +332,8 @@ init_per_group(internal_error, Config) -> DataDir = proplists:get_value(data_dir, Config), PrivDir = proplists:get_value(priv_dir, Config), ssh_test_lib:setup_dsa(DataDir, PrivDir), - file:delete(filename:join(PrivDir, "system/ssh_host_dsa_key")), + %% In the test case the key will be deleted after the daemon start: + %% ... file:delete(filename:join(PrivDir, "system/ssh_host_dsa_key")), Config; init_per_group(dir_options, Config) -> PrivDir = proplists:get_value(priv_dir, Config), @@ -306,6 +380,7 @@ init_per_group(dir_options, Config) -> init_per_group(_, Config) -> Config. + end_per_group(dsa_key, Config) -> PrivDir = proplists:get_value(priv_dir, Config), ssh_test_lib:clean_dsa(PrivDir), @@ -822,12 +897,17 @@ key_callback_options(Config) when is_list(Config) -> %%% Test that client does not hang if disconnects due to internal error internal_error(Config) when is_list(Config) -> process_flag(trap_exit, true), - SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), + PrivDir = proplists:get_value(priv_dir, Config), UserDir = proplists:get_value(priv_dir, Config), + SystemDir = filename:join(PrivDir, system), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {user_dir, UserDir}, {failfun, fun ssh_test_lib:failfun/2}]), + + %% Now provoke an error in the following connect: + file:delete(filename:join(PrivDir, "system/ssh_host_dsa_key")), + {error, Error} = ssh:connect(Host, Port, [{silently_accept_hosts, true}, {user_dir, UserDir}, @@ -856,6 +936,17 @@ send(Config) when is_list(Config) -> %%-------------------------------------------------------------------- +%%% +fail_daemon_start(Config) when is_list(Config) -> + process_flag(trap_exit, true), + SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), + UserDir = proplists:get_value(priv_dir, Config), + + {error,_} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {user_dir, UserDir}, + {failfun, fun ssh_test_lib:failfun/2}]). + +%%-------------------------------------------------------------------- %%% Test ssh:connection_info([peername, sockname]) peername_sockname(Config) when is_list(Config) -> process_flag(trap_exit, true), @@ -1254,14 +1345,11 @@ shell_exit_status(Config) when is_list(Config) -> %%-------------------------------------------------------------------- %% Due to timing the error message may or may not be delivered to %% the "tcp-application" before the socket closed message is recived -check_error("Invalid state") -> - ok; -check_error("Connection closed") -> - ok; -check_error("Selection of key exchange algorithm failed"++_) -> - ok; -check_error(Error) -> - ct:fail(Error). +check_error("Invalid state") -> ok; +check_error("Connection closed") -> ok; +check_error("Selection of key exchange algorithm failed"++_) -> ok; +check_error("No host key available") -> ok; +check_error(Error) -> ct:fail(Error). basic_test(Config) -> ClientOpts = proplists:get_value(client_opts, Config), diff --git a/lib/ssh/test/ssh_bench_SUITE.erl b/lib/ssh/test/ssh_bench_SUITE.erl index 2c0cd8fc8e..b6c6147646 100644 --- a/lib/ssh/test/ssh_bench_SUITE.erl +++ b/lib/ssh/test/ssh_bench_SUITE.erl @@ -57,12 +57,19 @@ init_per_suite(Config) -> ok -> DataSize = 1000000, SystemDir = proplists:get_value(data_dir, Config), - Algs = insert_none(ssh:default_algorithms()), + Algs = ssh:default_algorithms(), {_ServerPid, _Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {user_passwords, [{?UID,?PWD}]}, {failfun, fun ssh_test_lib:failfun/2}, {preferred_algorithms, Algs}, + {modify_algorithms,[{prepend,[{cipher,[none]}, + {mac,[none]} + ]}, + {rm, [{cipher,['[email protected]', + '[email protected]']} + ]} + ]}, {max_random_length_padding, 0}, {subsystems, [{"/dev/null", {ssh_bench_dev_null,[DataSize]}}]} ]), @@ -175,11 +182,34 @@ gen_data(DataSz) -> %% {suite, ?MODULE}, %% {name, mk_name(["Transfer 1M bytes ",Cipher,"/",Mac," [µs]"])}]); connect_measure(Port, Cipher, Mac, Data, Options) -> + AES_GCM = {cipher,['[email protected]', + '[email protected]']}, + + AlgOpt = case {Cipher,Mac} of + {none,none} -> + [{modify_algorithms,[{prepend, [{cipher,[Cipher]}, + {mac,[Mac]}]}, + {rm,[AES_GCM]} + ]}]; + {none,_} -> + [{modify_algorithms,[{prepend, [{cipher,[Cipher]}]}, + {rm,[AES_GCM]} + ]}, + {preferred_algorithms, [{mac,[Mac]}]}]; + {_,none} -> + [{modify_algorithms,[{prepend, [{mac,[Mac]}]}, + {rm,[AES_GCM]} + ]}, + {preferred_algorithms, [{cipher,[Cipher]}]}]; + _ -> + [{preferred_algorithms, [{cipher,[Cipher]}, + {mac,[Mac]}]}, + {modify_algorithms, [{rm,[AES_GCM]}]} + ] + end, Times = [begin - {ok,C} = ssh:connect("localhost", Port, [{preferred_algorithms, [{cipher,[Cipher]}, - {mac,[Mac]}]} - |Options]), + {ok,C} = ssh:connect("localhost", Port, AlgOpt ++ Options), {ok,Ch} = ssh_connection:session_channel(C, 10000), success = ssh_connection:subsystem(C, Ch, "/dev/null", 10000), {Time,ok} = timer:tc(?MODULE, send_wait_acc, [C, Ch, Data]), @@ -205,16 +235,6 @@ send_wait_acc(C, Ch, Data) -> %%% %%%---------------------------------------------------------------- -insert_none(L) -> - lists:foldl(fun insert_none/2, [], L). - -insert_none({T,L}, Acc) when T==cipher ; - T==mac -> - [{T, [{T1,L1++[none]} || {T1,L1} <- L]} | Acc]; -insert_none(_, Acc) -> - Acc. - -%%%---------------------------------------------------------------- mk_name(Name) -> [char(C) || C <- lists:concat(Name)]. char($-) -> $_; diff --git a/lib/ssh/test/ssh_engine_SUITE.erl b/lib/ssh/test/ssh_engine_SUITE.erl new file mode 100644 index 0000000000..daf93891e9 --- /dev/null +++ b/lib/ssh/test/ssh_engine_SUITE.erl @@ -0,0 +1,140 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% + +-module(ssh_engine_SUITE). + +-include_lib("common_test/include/ct.hrl"). +-include("ssh_test_lib.hrl"). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{seconds,40}}]. + +all() -> + [{group, dsa_key}, + {group, rsa_key} + ]. + +groups() -> + [{dsa_key, [], basic_tests()}, + {rsa_key, [], basic_tests()} + ]. + +basic_tests() -> + [simple_connect + ]. + + +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + ssh:start(), + ?CHECK_CRYPTO( + case load_engine() of + {ok,E} -> + [{engine,E}|Config]; + {error, notsup} -> + {skip, "Engine not supported on this OpenSSL version"}; + {error, bad_engine_id} -> + {skip, "Dynamic Engine not supported"}; + Other -> + ct:log("Engine load failed: ~p",[Other]), + {fail, "Engine load failed"} + end + ). + +end_per_suite(Config) -> + catch crypto:engine_unload( proplists:get_value(engine,Config) ), + ssh:stop(). + +%%-------------------------------------------------------------------- +init_per_group(dsa_key, Config) -> + case lists:member('ssh-dss', + ssh_transport:default_algorithms(public_key)) of + true -> + start_daemon(Config, 'ssh-dss', "dsa_private_key.pem"); + false -> + {skip, unsupported_pub_key} + end; +init_per_group(rsa_key, Config) -> + case lists:member('ssh-rsa', + ssh_transport:default_algorithms(public_key)) of + true -> + start_daemon(Config, 'ssh-rsa', "rsa_private_key.pem"); + false -> + {skip, unsupported_pub_key} + end. + +start_daemon(Config, KeyType, KeyId) -> + SystemDir = proplists:get_value(data_dir, Config), + FullKeyId = filename:join(SystemDir, KeyId), + KeyCBOpts = [{engine, proplists:get_value(engine,Config)}, + {KeyType, FullKeyId} + ], + Opts = [{key_cb, {ssh_key_cb_engine_keys, KeyCBOpts}}], + {Pid, Host, Port} = ssh_test_lib:std_daemon(Config, Opts), + [{host_port,{Host,Port}}, {daemon_pid,Pid}| Config]. + + +end_per_group(_, Config) -> + catch ssh:stop_daemon(proplists:get_value(daemon_pid,Config)), + Config. + +%%-------------------------------------------------------------------- +%% Test Cases -------------------------------------------------------- +%%-------------------------------------------------------------------- + +%% A simple exec call +simple_connect(Config) -> + {Host,Port} = proplists:get_value(host_port, Config), + CRef = ssh_test_lib:std_connect(Config, Host, Port, []), + ssh:close(CRef). + +%%-------------------------------------------------------------------- +%%-------------------------------------------------------------------- +load_engine() -> + case crypto:get_test_engine() of + {ok, Engine} -> + try crypto:engine_load(<<"dynamic">>, + [{<<"SO_PATH">>, Engine}, + <<"LOAD">>], + []) + catch + error:notsup -> + {error, notsup} + end; + + {error, Error} -> + {error, Error} + end. + +start_std_daemon(Opts, Config) -> + ct:log("starting std_daemon",[]), + {Pid, Host, Port} = ssh_test_lib:std_daemon(Config, Opts), + ct:log("started ~p:~p ~p",[Host,Port,Opts]), + [{srvr_pid,Pid},{srvr_addr,{Host,Port}} | Config]. diff --git a/lib/ssh/test/ssh_engine_SUITE_data/dsa_private_key.pem b/lib/ssh/test/ssh_engine_SUITE_data/dsa_private_key.pem new file mode 100644 index 0000000000..778ffac675 --- /dev/null +++ b/lib/ssh/test/ssh_engine_SUITE_data/dsa_private_key.pem @@ -0,0 +1,9 @@ +-----BEGIN PRIVATE KEY----- +MIIBSwIBADCCASwGByqGSM44BAEwggEfAoGBAMyitTMR7vPbpqyAXJpqnB0AhFwQ +F87IE+JKFl5bD/MSkhhRV5sM73HUU1ooXY0FjhZ+cdLUCATuZR5ta4ydANqWIcAB +gX3IwF1B4zf5SXEKTWkUYneL9dOKtiZLtoG28swrk8xMxwX+0fLHkltCEj6FiTW9 +PFrv8GmIfV6DjcI9AhUAqXWbb3RtoN9Ld28fVMhGZrj3LJUCgYEAwnxGHGBMpJaF +2w7zAw3jHjL8PMYlV6vnufGHQlwF0ZUXJxRsvagMb/X1qACTu2VPYEVoLQGM3cfH +EhHoQmvSXGAyTfR7Bmn3gf1n/s/DcFbdZduUCZ/rAyIrfd0eSbc1I+kZk85UCsKK +w/IYdlqcuYa4Cgm2TapT5uEMqH4jhzEEFgIULh8swEUWmU8aJNWsrWl4eCiuUUg= +-----END PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_engine_SUITE_data/ecdsa_private_key.pem b/lib/ssh/test/ssh_engine_SUITE_data/ecdsa_private_key.pem new file mode 100644 index 0000000000..a45522064f --- /dev/null +++ b/lib/ssh/test/ssh_engine_SUITE_data/ecdsa_private_key.pem @@ -0,0 +1,8 @@ +-----BEGIN PRIVATE KEY----- +MIHuAgEAMBAGByqGSM49AgEGBSuBBAAjBIHWMIHTAgEBBEIBparGjr0KcdNrVM2J +G0mW5ltP1QyvxDqBMyWLWo3fruRZv6Qoohl5skd1u4O+KJoM/UrrSTOXI/MDR7NN +i1yl7O+hgYkDgYYABAG8K2XVsK0ahG9+HIIPwCO0pJY8ulwSTXwIjkCGyB2lpglh +8qJmRzuyGcfRTslv8wfv0sPlT9H9PKDvgrTUL7rvQQDdOODNgVPXSecUoXoPn+X+ +eqxs77bjx+A5x0t/i3m5PfkaNPh5MZ1H/bWuOOdj2ZXZw0R4rlVc0zVrgnPU8L8S +BQ== +-----END PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_engine_SUITE_data/rsa_private_key.pem b/lib/ssh/test/ssh_engine_SUITE_data/rsa_private_key.pem new file mode 100644 index 0000000000..ea0e3d3958 --- /dev/null +++ b/lib/ssh/test/ssh_engine_SUITE_data/rsa_private_key.pem @@ -0,0 +1,28 @@ +-----BEGIN PRIVATE KEY----- +MIIEvwIBADANBgkqhkiG9w0BAQEFAASCBKkwggSlAgEAAoIBAQCwwb0/ddXGXTFK +4FLxXdV6a/WJMSoPPS55RvZIAHFsiTtvPLbJ8LxDsZ6wSVZLN0/UQ4wdWn9jftyj +U5/IxBVG8XOtKimTMvm3/ZOzVLueGHBbrLYscRv9oL85ulTKHWgrZDu0lBX5JJTI +v5UTCErzJRQbka9DG1GaBgDb1PlXfkzBWMwfsBZmwoC77KvCcIGCgbW/XCY03TP2 +3Tg8drvpByMStddP2FQ4fZ91qFUzPu8uhZEsqSQTFlmhgGEx7dLlky0xvu62RuAD +RTpINpcWZtWDHTdssOqu653LwwqBY8lBopCZ/4Af8QR3ZYkQhen1YLEbVheXRuzI +LSCZIiJNAgMBAAECggEBAJH4/fxpqQkvr2Shy33Pu1xlyhnpw01gfn/jrcKasxEq +aC4eWup86E2TY3U8q4pkfIXU3uLi+O9HNpmflwargNLc1mY8uqb44ygiv5bLNEKE +9k2PXcdoBfC4jxPyoNFl5cBn/7LK1TazEjiTl15na9ZPWcLG1pG5/vMPYCgsQ1sP +8J3c4E3aaXIj9QceYxBprl490OCzieGyZlRipncz3g4UShRc/b4cycvDZOJpmAy4 +zbWTcBcSMPVPi5coF0K8UcimiqZkotfb/2RLc433i34IdsIXMM+brdq+g8rmjg5a ++oQPy02M6tFApBruEhAz8DGgaLtDY6MLtyZAt3SjXnUCgYEA1zLgamdTHOqrrmIi +eIQBnAJiyIfcY8B9SX1OsLGYFCHiPVwgUY35B2c7MavMsGcExJhtE+uxU7o5djtM +R6r9cRHOXJ6EQwa8OwzzPqbM17/YqNDeK39bc9WOFUqRWrhDhVMPy6z8rmZr73mG +IUC7mBNx/1GBdVYXIlsXzC96dI8CgYEA0kUAhz6I5nyPa70NDEUYHLHf3IW1BCmE +UoVbraSePJtIEY/IqFx7oDuFo30d4n5z+8ICCtyid1h/Cp3mf3akOiqltYUfgV1G +JgcEjKKYWEnO7cfFyO7LB7Y3GYYDJNy6EzVWPiwTGk9ZTfFJEESmHC45Unxgd17m +Dx/R58rFgWMCgYBQXQWFdtSI5fH7C1bIHrPjKNju/h2FeurOuObcAVZDnmu4cmD3 +U8d9xkVKxVeJQM99A1coq0nrdI3k4zwXP3mp8fZYjDHkPe2pN6rW6L9yiohEcsuk +/siON1/5/4DMmidM8LnjW9R45HLGWWGHpX7oyco2iJ+Jy/6Tq+T1MX3PbQKBgQCm +hdsbQJ0u3CrBSmFQ/E9SOlRt0r4+45pVuCOY6yweF2QF9HcXTtbhWQJHLclDHJ5C +Ha18aKuKFN3XzKFFBPKe1jOSBDGlQ/dQGnKx5fr8wMdObM3oiaTlIJuWbRmEUgJT +QARjDIi8Z2b0YUhZx+Q9oSXoe3PyVYehJrQX+/BavQKBgQCIr7Zp0rQPbfqcTL+M +OYHUoNcb14f9f8hXeXHQOqVpsGwxGdRQAU9wbx/4+obKB5xIkzBsVNcJwavisNja +hegnGjTB/9Hc4m+5bMGwH0bhS2eQO4o+YYM2ypDmFQqDLRfFUlZ5PVHffm/aA9+g +GanNBCsmtoHtV6CJ1UZ7NmBuIA== +-----END PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_engine_SUITE_data/rsa_private_key_pwd.pem b/lib/ssh/test/ssh_engine_SUITE_data/rsa_private_key_pwd.pem new file mode 100644 index 0000000000..501662fc35 --- /dev/null +++ b/lib/ssh/test/ssh_engine_SUITE_data/rsa_private_key_pwd.pem @@ -0,0 +1,30 @@ +-----BEGIN ENCRYPTED PRIVATE KEY----- +MIIFDjBABgkqhkiG9w0BBQ0wMzAbBgkqhkiG9w0BBQwwDgQIh888Iq6gxuMCAggA +MBQGCCqGSIb3DQMHBAic/11YZ8Nt5gSCBMjG/Jb4qiMoBS50iQvHXqcETPE+0NBr +jhsn9w94LkdRBstMPAsoKmY98Er96Rnde/NfmqlU9CupKTkd7Ce5poBf72Y6KMED +cPURyjbGRFsu6x9skXB2obhyKYEqAEF2oQAg4Qbe5v1qXBIgDuC/NgiJnM+w2zCZ +LkHSZB2/NmcnvDzcgPF7TM8pTO23xCJ33m37qjfWvHsgocVqZmL9wQ4+wr/NMYjJ +pJvX1OHW1vBsZsXh40WchalYRSB1VeO368QfsE8coRJztqbMzdce9EQdMB6Q6jlO +cetd3moLIoMP4I7HW0/SgokbycTbRiYSvRyU1TGc2WbW6BrFZV24IckcnnVUFatf +6HKUcaYLG68dJcRgs5QMGkcmgVvlddENHFmHZlo0eym/xSiUl/AT8/5odscm6ML8 +wW5sneax+TF4J2eYmiN7yjAUCodXVTNYNDVKo6uUhntlymbM0o4UitVIbPIfTDHl +sxJAEZ7vpuPqeNMxUk6G6zipuEjqsVbnuFSBSZmgKiGYcifRPUmqqINa3DdS4WVx +xaPWdHbHVRD//ze3h/FsA+1lIE5q2kUE0xXseJA1ISog++kJp14XeaaL2j/tx3Ob +OsbcaOAD/IUw/ItDt9kn0qzfnar7sS0Wov8AmJQxHmH7Lm93jHTLM05yE0AR/eBr +Mig2ZdC+9OqVC+GPuBkRjSs8NpltQIDroz6EV9IMwPwXm0szSYoyoPLmlHJUdnLs +ZUef+au6hYkEJBrvuisagnq5eT/fCV3hsjD7yODebNU2CmBTo6X2PRx/xsBHRMWl +QkoM9PBdSCnKv6HpHl4pchuoqU2NpFjN0BCaad6aHfZSTnqgzK4bEh1oO6dI8/rB +/eh71JyFFG5J4xbpaqz5Su01V1iwU5leK5bDwqals4M4+ZGHGciou7qnXUmX2fJl +r6DlMUa/xy+A2ZG0NuZR05yk2oB3+KVNMgp6zFty3XaxwoNtc8GTLtLnBnIh2rlP +mE1+I65LRWwrNQalPeOAUrYuEzhyp2Df7a8Ykas5PUH7MGR/S0Ge/dLxtE2bJuK4 +znbLAsGhvo/SbNxYqIp6D4iDtd3va6yUGncy41paA/vTKFVvXZDrXcwJQYYCVOGT +OwdzNuozU8Dc7oxsd8oakfC46kvmVaOrGvZbm56PFfprcaL/Hslska5xxEni/eZe +WRxZbCBhAVqS1pn5zkDQVUe9uFlR/x39Qi01HIlKLBsjpSs6qQsFArMe8hgXmXLG +xP+dyVuOE18NzSewdEjeqSRKIM7Qi8EOjZsI4HdSRBY7bh9VhmaVXDZiCSf33TTE +3y8nimzQAeuGoYg6WqHmWWC2Qnpki2HlaIH/ayXEyQWkP/qvg61e8ovdg9Fy8JOO +0AacXVt5zj0q00AW5bKx7usi4NIjZedi86hUm6H19aBm7r86BKjwYTEI/GOcdrbV +9HC/8ayOimgwiAG3gq+aLioWym+Z6KnsbVd7XReVbvM/InQx54WA2y5im0A+/c67 +oQFFPV84XGX9waeqv/K4Wzkm6HW+qVAEM67482VGOf0PVrlQMno6dOotT/Y7ljoZ +2iz0LmN9yylJnLPDrr1i6gzbs5OhhUgbF5LI2YP2wWdCZTl/DrKSIvQZWl8U+tw3 +ciA= +-----END ENCRYPTED PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_key_cb_engine_keys.erl b/lib/ssh/test/ssh_key_cb_engine_keys.erl new file mode 100644 index 0000000000..fc9cbfd49b --- /dev/null +++ b/lib/ssh/test/ssh_key_cb_engine_keys.erl @@ -0,0 +1,62 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% +%%---------------------------------------------------------------------- + +%% Note: This module is used by ssh_basic_SUITE + +-module(ssh_key_cb_engine_keys). +-behaviour(ssh_server_key_api). +-compile(export_all). + +host_key(SshAlg, Options) -> + KBopts = proplists:get_value(key_cb_private, Options, []), + Engine = proplists:get_value(engine, KBopts), + case proplists:get_value(SshAlg, KBopts) of + undefined -> + {error, {unknown_alg,SshAlg}}; + KeyId -> + case crypto_alg(SshAlg) of + undefined -> + {error, {unsupported_alg,SshAlg}}; + CryptoAlg -> + PrivKey = #{engine => Engine, + key_id => KeyId, + algorithm => CryptoAlg}, + %% Is there a key with this reference ? + case crypto:privkey_to_pubkey(CryptoAlg, PrivKey) of + [_|_] -> + {ok, PrivKey}; + _ -> + {error, {no_hostkey,SshAlg}} + end + end + end. + +is_auth_key(_PublicUserKey, _User, _Options) -> + false. + + + +crypto_alg('ssh-rsa') -> rsa; +crypto_alg('ssh-dss') -> dss; +crypto_alg(_) -> undefined. + diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl index 7da921adb2..3e3e151781 100644 --- a/lib/ssh/test/ssh_protocol_SUITE.erl +++ b/lib/ssh/test/ssh_protocol_SUITE.erl @@ -630,11 +630,12 @@ client_handles_keyboard_interactive_0_pwds(Config) -> %%%-------------------------------------------------------------------- -client_info_line(_Config) -> +client_info_line(Config) -> %% A client must not send an info-line. If it does, the server should handle %% handle this gracefully {ok,Pid} = ssh_eqc_event_handler:add_report_handler(), - {_, _, Port} = ssh_test_lib:daemon([]), + DataDir = proplists:get_value(data_dir, Config), + {_, _, Port} = ssh_test_lib:daemon([{system_dir,DataDir}]), %% Fake client: {ok,S} = gen_tcp:connect("localhost",Port,[]), @@ -884,9 +885,9 @@ chk_pref_algs(Config, filter_supported(K, Algs) -> Algs -- (Algs--supported(K)). -supported(K) -> proplists:get_value( - server2client, - ssh_transport:supported_algorithms(cipher)). +supported(_K) -> proplists:get_value( + server2client, + ssh_transport:supported_algorithms(cipher)). to_lists(L) -> lists:map(fun erlang:atom_to_list/1, L). diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index 7b273fecef..83819b97a5 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -404,7 +404,7 @@ setup_ecdsa(Size, DataDir, UserDir) -> file:copy(filename:join(DataDir, "ssh_host_ecdsa_key"++Size++".pub"), filename:join(System, "ssh_host_ecdsa_key.pub")), ct:log("DataDir ~p:~n ~p~n~nSystDir ~p:~n ~p~n~nUserDir ~p:~n ~p",[DataDir, file:list_dir(DataDir), System, file:list_dir(System), UserDir, file:list_dir(UserDir)]), setup_ecdsa_known_host(Size, System, UserDir), - setup_ecdsa_auth_keys(Size, UserDir, UserDir). + setup_ecdsa_auth_keys(Size, DataDir, UserDir). clean_dsa(UserDir) -> del_dirs(filename:join(UserDir, "system")), @@ -438,6 +438,29 @@ setup_rsa_pass_pharse(DataDir, UserDir, Phrase) -> setup_rsa_known_host(DataDir, UserDir), setup_rsa_auth_keys(DataDir, UserDir). +setup_ecdsa_pass_phrase(Size, DataDir, UserDir, Phrase) -> + try + {ok, KeyBin} = + case file:read_file(F=filename:join(DataDir, "id_ecdsa"++Size)) of + {error,E} -> + ct:log("Failed (~p) to read ~p~nFiles: ~p", [E,F,file:list_dir(DataDir)]), + file:read_file(filename:join(DataDir, "id_ecdsa")); + Other -> + Other + end, + setup_pass_pharse(KeyBin, filename:join(UserDir, "id_ecdsa"), Phrase), + System = filename:join(UserDir, "system"), + file:make_dir(System), + file:copy(filename:join(DataDir, "ssh_host_ecdsa_key"++Size), filename:join(System, "ssh_host_ecdsa_key")), + file:copy(filename:join(DataDir, "ssh_host_ecdsa_key"++Size++".pub"), filename:join(System, "ssh_host_ecdsa_key.pub")), + setup_ecdsa_known_host(Size, System, UserDir), + setup_ecdsa_auth_keys(Size, DataDir, UserDir) + of + _ -> true + catch + _:_ -> false + end. + setup_pass_pharse(KeyBin, OutFile, Phrase) -> [{KeyType, _,_} = Entry0] = public_key:pem_decode(KeyBin), Key = public_key:pem_entry_decode(Entry0), @@ -489,8 +512,15 @@ setup_rsa_auth_keys(Dir, UserDir) -> PKey = #'RSAPublicKey'{publicExponent = E, modulus = N}, setup_auth_keys([{ PKey, [{comment, "Test"}]}], UserDir). -setup_ecdsa_auth_keys(_Size, Dir, UserDir) -> - {ok, Pem} = file:read_file(filename:join(Dir, "id_ecdsa")), +setup_ecdsa_auth_keys(Size, Dir, UserDir) -> + {ok, Pem} = + case file:read_file(F=filename:join(Dir, "id_ecdsa"++Size)) of + {error,E} -> + ct:log("Failed (~p) to read ~p~nFiles: ~p", [E,F,file:list_dir(Dir)]), + file:read_file(filename:join(Dir, "id_ecdsa")); + Other -> + Other + end, ECDSA = public_key:pem_entry_decode(hd(public_key:pem_decode(Pem))), #'ECPrivateKey'{publicKey = Q, parameters = Param = {namedCurve,_Id0}} = ECDSA, @@ -572,7 +602,6 @@ check_ssh_client_support2(P) -> {P, {exit_status, E}} -> E after 5000 -> - ct:log("Openssh command timed out ~n"), -1 end. diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index 4d6aa93d4e..75d5b5e296 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -332,7 +332,7 @@ erlang_client_openssh_server_publickey_dsa(Config) -> erlang_client_openssh_server_publickey_X(Config, 'ssh-dss'). -erlang_client_openssh_server_publickey_X(Config, Alg) -> +erlang_client_openssh_server_publickey_X(_Config, Alg) -> ConnectionRef = ssh_test_lib:connect(?SSH_DEFAULT_PORT, [{pref_public_key_algs, [Alg]}, diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 59775d2d7f..668d2358c0 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 4.6.2 +SSH_VSN = 4.6.3 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/Makefile b/lib/ssl/doc/src/Makefile index 669062779e..f9128e8e45 100644 --- a/lib/ssl/doc/src/Makefile +++ b/lib/ssl/doc/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2015. All Rights Reserved. +# Copyright Ericsson AB 1999-2017. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -38,25 +38,25 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = refman.xml -XML_REF3_FILES = ssl.xml ssl_crl_cache.xml ssl_crl_cache_api.xml ssl_session_cache_api.xml +XML_REF3_FILES = ssl.xml ssl_crl_cache.xml ssl_crl_cache_api.xml ssl_session_cache_api.xml XML_REF6_FILES = ssl_app.xml -XML_PART_FILES = release_notes.xml usersguide.xml +XML_PART_FILES = usersguide.xml XML_CHAPTER_FILES = \ + ssl_introduction.xml \ ssl_protocol.xml \ using_ssl.xml \ - pkix_certs.xml \ ssl_distribution.xml \ notes.xml BOOK_FILES = book.xml XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) $(XML_REF6_FILES) \ - $(XML_PART_FILES) $(XML_CHAPTER_FILES) + $(XML_PART_FILES) $(XML_CHAPTER_FILES) -GIF_FILES = warning.gif +GIF_FILES = -PS_FILES = +PS_FILES = XML_FLAGS += -defs cite cite.defs -booksty otpA4 @@ -81,10 +81,10 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += +XML_FLAGS += +DVIPS_FLAGS += # ---------------------------------------------------- # Targets @@ -110,11 +110,11 @@ man: $(MAN3_FILES) $(MAN6_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) -debug opt: +debug opt: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs diff --git a/lib/ssl/doc/src/fascicules.xml b/lib/ssl/doc/src/fascicules.xml deleted file mode 100644 index 7a60e8dd1f..0000000000 --- a/lib/ssl/doc/src/fascicules.xml +++ /dev/null @@ -1,19 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="usersguide" href="usersguide_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="refman" href="refman_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="release_notes" href="release_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - - diff --git a/lib/ssl/doc/src/note.gif b/lib/ssl/doc/src/note.gif Binary files differdeleted file mode 100644 index 6fffe30419..0000000000 --- a/lib/ssl/doc/src/note.gif +++ /dev/null diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index a8450c2630..79176f5edf 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -27,9 +27,62 @@ </header> <p>This document describes the changes made to the SSL application.</p> +<section><title>SSL 8.2.3</title> -<section><title>SSL 8.2.2</title> + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Packet options cannot be supported for unreliable + transports, that is, packet option for DTLS over udp will + not be supported.</p> + <p> + Own Id: OTP-14664</p> + </item> + <item> + <p> + Ensure data delivery before close if possible. This fix + is related to fix in PR-1479.</p> + <p> + Own Id: OTP-14794</p> + </item> + </list> + </section> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + The crypto API is extended to use private/public keys + stored in an Engine for sign/verify or encrypt/decrypt + operations.</p> + <p> + The ssl application provides an API to use this new + engine concept in TLS.</p> + <p> + Own Id: OTP-14448</p> + </item> + <item> + <p> + Implemented renegotiation for DTLS</p> + <p> + Own Id: OTP-14563</p> + </item> + <item> + <p> + A new command line option <c>-ssl_dist_optfile</c> has + been added to facilitate specifying the many options + needed when using SSL as the distribution protocol.</p> + <p> + Own Id: OTP-14657</p> + </item> + </list> + </section> + +</section> + +<section><title>SSL 8.2.2</title> <section><title>Fixed Bugs and Malfunctions</title> <list> <item> @@ -89,7 +142,6 @@ </list> </section> - <section><title>Improvements and New Features</title> <list> <item> @@ -253,9 +305,59 @@ </item> </list> </section> - </section> +<section><title>SSL 8.1.3.1</title> + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> An erlang TLS server configured with cipher suites + using rsa key exchange, may be vulnerable to an Adaptive + Chosen Ciphertext attack (AKA Bleichenbacher attack) + against RSA, which when exploited, may result in + plaintext recovery of encrypted messages and/or a + Man-in-the-middle (MiTM) attack, despite the attacker not + having gained access to the server’s private key + itself. <url + href="https://nvd.nist.gov/vuln/detail/CVE-2017-1000385">CVE-2017-1000385</url> + </p> <p> Exploiting this vulnerability to perform + plaintext recovery of encrypted messages will, in most + practical cases, allow an attacker to read the plaintext + only after the session has completed. Only TLS sessions + established using RSA key exchange are vulnerable to this + attack. </p> <p> Exploiting this vulnerability to conduct + a MiTM attack requires the attacker to complete the + initial attack, which may require thousands of server + requests, during the handshake phase of the targeted + session within the window of the configured handshake + timeout. This attack may be conducted against any TLS + session using RSA signatures, but only if cipher suites + using RSA key exchange are also enabled on the server. + The limited window of opportunity, limitations in + bandwidth, and latency make this attack significantly + more difficult to execute. </p> <p> RSA key exchange is + enabled by default although least prioritized if server + order is honored. For such a cipher suite to be chosen it + must also be supported by the client and probably the + only shared cipher suite. </p> <p> Captured TLS sessions + encrypted with ephemeral cipher suites (DHE or ECDHE) are + not at risk for subsequent decryption due to this + vulnerability. </p> <p> As a workaround if default cipher + suite configuration was used you can configure the server + to not use vulnerable suites with the ciphers option like + this: </p> <c> {ciphers, [Suite || Suite <- + ssl:cipher_suites(), element(1,Suite) =/= rsa]} </c> <p> + that is your code will look somethingh like this: </p> + <c> ssl:listen(Port, [{ciphers, [Suite || Suite <- + ssl:cipher_suites(), element(1,S) =/= rsa]} | Options]). + </c> <p> Thanks to Hanno Böck, Juraj Somorovsky and + Craig Young for reporting this vulnerability. </p> + <p> + Own Id: OTP-14748</p> + </item> + </list> + </section> +</section> <section><title>SSL 8.1.3</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -634,6 +736,60 @@ </section> + <section><title>SSL 7.3.3.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> An erlang TLS server configured with cipher suites + using rsa key exchange, may be vulnerable to an Adaptive + Chosen Ciphertext attack (AKA Bleichenbacher attack) + against RSA, which when exploited, may result in + plaintext recovery of encrypted messages and/or a + Man-in-the-middle (MiTM) attack, despite the attacker not + having gained access to the server’s private key + itself. <url + href="https://nvd.nist.gov/vuln/detail/CVE-2017-1000385">CVE-2017-1000385</url> + </p> <p> Exploiting this vulnerability to perform + plaintext recovery of encrypted messages will, in most + practical cases, allow an attacker to read the plaintext + only after the session has completed. Only TLS sessions + established using RSA key exchange are vulnerable to this + attack. </p> <p> Exploiting this vulnerability to conduct + a MiTM attack requires the attacker to complete the + initial attack, which may require thousands of server + requests, during the handshake phase of the targeted + session within the window of the configured handshake + timeout. This attack may be conducted against any TLS + session using RSA signatures, but only if cipher suites + using RSA key exchange are also enabled on the server. + The limited window of opportunity, limitations in + bandwidth, and latency make this attack significantly + more difficult to execute. </p> <p> RSA key exchange is + enabled by default although least prioritized if server + order is honored. For such a cipher suite to be chosen it + must also be supported by the client and probably the + only shared cipher suite. </p> <p> Captured TLS sessions + encrypted with ephemeral cipher suites (DHE or ECDHE) are + not at risk for subsequent decryption due to this + vulnerability. </p> <p> As a workaround if default cipher + suite configuration was used you can configure the server + to not use vulnerable suites with the ciphers option like + this: </p> <c> {ciphers, [Suite || Suite <- + ssl:cipher_suites(), element(1,Suite) =/= rsa]} </c> <p> + that is your code will look somethingh like this: </p> + <c> ssl:listen(Port, [{ciphers, [Suite || Suite <- + ssl:cipher_suites(), element(1,S) =/= rsa]} | Options]). + </c> <p> Thanks to Hanno Böck, Juraj Somorovsky and + Craig Young for reporting this vulnerability. </p> + <p> + Own Id: OTP-14748</p> + </item> + </list> + </section> + + </section> + <section><title>SSL 7.3.3</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -663,7 +819,59 @@ </list> </section> + <section><title>SSL 7.3.3.0.1</title> + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> An erlang TLS server configured with cipher suites + using rsa key exchange, may be vulnerable to an Adaptive + Chosen Ciphertext attack (AKA Bleichenbacher attack) + against RSA, which when exploited, may result in + plaintext recovery of encrypted messages and/or a + Man-in-the-middle (MiTM) attack, despite the attacker not + having gained access to the server’s private key + itself. <url + href="https://nvd.nist.gov/vuln/detail/CVE-2017-1000385">CVE-2017-1000385</url> + </p> <p> Exploiting this vulnerability to perform + plaintext recovery of encrypted messages will, in most + practical cases, allow an attacker to read the plaintext + only after the session has completed. Only TLS sessions + established using RSA key exchange are vulnerable to this + attack. </p> <p> Exploiting this vulnerability to conduct + a MiTM attack requires the attacker to complete the + initial attack, which may require thousands of server + requests, during the handshake phase of the targeted + session within the window of the configured handshake + timeout. This attack may be conducted against any TLS + session using RSA signatures, but only if cipher suites + using RSA key exchange are also enabled on the server. + The limited window of opportunity, limitations in + bandwidth, and latency make this attack significantly + more difficult to execute. </p> <p> RSA key exchange is + enabled by default although least prioritized if server + order is honored. For such a cipher suite to be chosen it + must also be supported by the client and probably the + only shared cipher suite. </p> <p> Captured TLS sessions + encrypted with ephemeral cipher suites (DHE or ECDHE) are + not at risk for subsequent decryption due to this + vulnerability. </p> <p> As a workaround if default cipher + suite configuration was used you can configure the server + to not use vulnerable suites with the ciphers option like + this: </p> <c> {ciphers, [Suite || Suite <- + ssl:cipher_suites(), element(1,Suite) =/= rsa]} </c> <p> + that is your code will look somethingh like this: </p> + <c> ssl:listen(Port, [{ciphers, [Suite || Suite <- + ssl:cipher_suites(), element(1,S) =/= rsa]} | Options]). + </c> <p> Thanks to Hanno Böck, Juraj Somorovsky and + Craig Young for reporting this vulnerability. </p> + <p> + Own Id: OTP-14748</p> + </item> + </list> + </section> + + </section> <section><title>Improvements and New Features</title> <list> <item> diff --git a/lib/ssl/doc/src/pkix_certs.xml b/lib/ssl/doc/src/pkix_certs.xml deleted file mode 100644 index f365acef4d..0000000000 --- a/lib/ssl/doc/src/pkix_certs.xml +++ /dev/null @@ -1,59 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2003</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>PKIX Certificates</title> - <prepared>UAB/F/P Peter Högfeldt</prepared> - <docno></docno> - <date>2003-06-09</date> - <rev>A</rev> - <file>pkix_certs.xml</file> - </header> - - <section> - <title>Introduction to Certificates</title> - <p>Certificates were originally defined by ITU (CCITT) and the latest - definitions are described in <cite id="X.509"></cite>, but those definitions - are (as always) not working. - </p> - <p>Working certificate definitions for the Internet Community are found - in the the PKIX RFCs <cite id="rfc3279"></cite> and <cite id="rfc3280"></cite>. - The parsing of certificates in the Erlang/OTP SSL application is - based on those RFCS. - </p> - <p>Certificates are defined in terms of ASN.1 (<cite id="X.680"></cite>). - For an introduction to ASN.1 see <url href="http://asn1.elibel.tm.fr/">ASN.1 Information Site</url>. - </p> - </section> - - <section> - <title>PKIX Certificates</title> - <p>Certificate handling is now handled by the <c>public_key</c> application.</p> - <p> - DER encoded certificates returned by <c>ssl:peercert/1</c> can for example - be decoded by the <c>public_key:pkix_decode_cert/2</c> function. - </p> - </section> -</chapter> - - diff --git a/lib/ssl/doc/src/release_notes.xml b/lib/ssl/doc/src/release_notes.xml deleted file mode 100644 index 2e263c69a7..0000000000 --- a/lib/ssl/doc/src/release_notes.xml +++ /dev/null @@ -1,50 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>1999</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>SSL Release Notes</title> - <prepared>Peter Högfeldt</prepared> - <docno></docno> - <date>2003-05-26</date> - <rev>A</rev> - <file>release_notes.sgml</file> - </header> - <description> - <p>The SSL application provides secure communication over sockets. - </p> - <p>This product includes software developed by the OpenSSL Project for - use in the OpenSSL Toolkit (http://www.openssl.org/). - </p> - <p>This product includes cryptographic software written by Eric Young - ([email protected]). - </p> - <p>This product includes software written by Tim Hudson - ([email protected]). - </p> - <p>For full OpenSSL and SSLeay license texts, see <seealso marker="licenses#licenses">Licenses</seealso>. - </p> - </description> - <xi:include href="notes.xml"/> -</part> - - diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index e80fd59a7f..8fcda78ed5 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -69,7 +69,9 @@ <p><c>| {cert, public_key:der_encoded()}</c></p> <p><c>| {certfile, path()}</c></p> <p><c>| {key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'ECPrivateKey' - | 'PrivateKeyInfo', public_key:der_encoded()}}</c></p> + | 'PrivateKeyInfo', public_key:der_encoded()} | + #{algorithm := rsa | dss | ecdsa, + engine := crypto:engine_ref(), key_id := crypto:key_id(), password => crypto:password()}</c></p> <p><c>| {keyfile, path()}</c></p> <p><c>| {password, string()}</c></p> <p><c>| {cacerts, [public_key:der_encoded()]}</c></p> @@ -201,9 +203,15 @@ <tag><c>{certfile, path()}</c></tag> <item><p>Path to a file containing the user certificate.</p></item> - <tag><c>{key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'ECPrivateKey' - |'PrivateKeyInfo', public_key:der_encoded()}}</c></tag> - <item><p>The DER-encoded user's private key. If this option + <tag> + <marker id="key_option_def"/> + <c>{key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'ECPrivateKey' + |'PrivateKeyInfo', public_key:der_encoded()} | #{algorithm := rsa | dss | ecdsa, + engine := crypto:engine_ref(), key_id := crypto:key_id(), password => crypto:password()}</c></tag> + <item><p>The DER-encoded user's private key or a map refering to a crypto + engine and its key reference that optionally can be password protected, + seealso <seealso marker="crypto:crypto#engine_load-4"> crypto:engine_load/4 + </seealso> and <seealso marker="crypto:engine_load"> Crypto's Users Guide</seealso>. If this option is supplied, it overrides option <c>keyfile</c>.</p></item> <tag><c>{keyfile, path()}</c></tag> diff --git a/lib/ssl/doc/src/ssl_distribution.xml b/lib/ssl/doc/src/ssl_distribution.xml index 61f88e3860..7f8a08f704 100644 --- a/lib/ssl/doc/src/ssl_distribution.xml +++ b/lib/ssl/doc/src/ssl_distribution.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2000</year><year>2016</year> + <year>2000</year><year>2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -180,10 +180,96 @@ Eshell V5.0 (abort with ^G) <section> <title>Specifying SSL Options</title> - <p>For SSL to work, at least - a public key and a certificate must be specified for the server - side. In the following example, the PEM-files consist of two - entries, the server certificate and its private key.</p> + + <p> + The SSL distribution options can be written into a file + that is consulted when the node is started. This file name + is then specified with the command line argument + <c>-ssl_dist_optfile</c>. + </p> + <p> + Any available SSL option can be specified in an options file, + but note that options that take a <c>fun()</c> has to use + the syntax <c>fun Mod:Func/Arity</c> since a function + body can not be compiled when consulting a file. + </p> + <p> + Do not tamper with the socket options + <c>list</c>, <c>binary</c>, <c>active</c>, <c>packet</c>, + <c>nodelay</c> and <c>deliver</c> since they are used + by the distribution protocol handler itself. + Other raw socket options such as <c>packet_size</c> may + interfere severely, so beware! + </p> + <p> + For SSL to work, at least a public key and a certificate + must be specified for the server side. + In the following example, the PEM file + <c>"/home/me/ssl/erlserver.pem"</c> contains both + the server certificate and its private key. + </p> + <p> + Create a file named for example + <c>"/home/me/ssl/[email protected]"</c>: + </p> + <code type="none"><![CDATA[ +[{server, + [{certfile, "/home/me/ssl/erlserver.pem"}, + {secure_renegotiate, true}]}, + {client, + [{secure_renegotiate, true}]}].]]> + </code> + <p> + And then start the node like this + (line breaks in the command are for readability, + and shall not be there when typed): + </p> + <code type="none"><![CDATA[ +$ erl -boot /home/me/ssl/start_ssl -proto_dist inet_tls + -ssl_dist_optfile "/home/me/ssl/[email protected]" + -sname ssl_test]]> + </code> + <p> + The options in the <c>{server, Opts}</c> tuple are used + when calling <c>ssl:ssl_accept/3</c>, and the options in the + <c>{client, Opts}</c> tuple are used when calling + <c>ssl:connect/4</c>. + </p> + <p> + For the client, the option + <c>{server_name_indication, atom_to_list(TargetNode)}</c> + is added when connecting. + This makes it possible to use the client option + <c>{verify, verify_peer}</c>, + and the client will verify that the certificate matches + the node name you are connecting to. + This only works if the the server certificate is issued + to the name <c>atom_to_list(TargetNode)</c>. + </p> + <p> + For the server it is also possible to use the option + <c>{verify, verify_peer}</c> and the server will only accept + client connections with certificates that are trusted by + a root certificate that the server knows. + A client that presents an untrusted certificate will be rejected. + This option is preferably combined with + <c>{fail_if_no_peer_cert, true}</c> or a client will + still be accepted if it does not present any certificate. + </p> + <p> + A node started in this way is fully functional, using SSL + as the distribution protocol. + </p> + </section> + + <section> + <title>Specifying SSL Options (Legacy)</title> + + <p> + As in the previous section the PEM file + <c>"/home/me/ssl/erlserver.pem"</c> contains both + the server certificate and its private key. + </p> <p>On the <c>erl</c> command line you can specify options that the SSL distribution adds when creating a socket.</p> @@ -226,24 +312,26 @@ Eshell V5.0 (abort with ^G) SSL options and their values. Argument <c>-ssl_dist_opt</c> can be repeated any number of times.</p> - <p>An example command line can now look as follows + <p> + An example command line doing the same as the example + in the previous section can now look as follows (line breaks in the command are for readability, - and are not be there when typed):</p> - <code type="none"> + and shall not be there when typed): + </p> + <code type="none"><![CDATA[ $ erl -boot /home/me/ssl/start_ssl -proto_dist inet_tls - -ssl_dist_opt server_certfile "/home/me/ssl/erlserver.pem" + -ssl_dist_opt server_certfile "/home/me/ssl/erlserver.pem" -ssl_dist_opt server_secure_renegotiate true client_secure_renegotiate true -sname ssl_test Erlang (BEAM) emulator version 5.0 [source] - + Eshell V5.0 (abort with ^G) -(ssl_test@myhost)1> </code> - <p>A node started in this way is fully functional, using SSL - as the distribution protocol.</p> +(ssl_test@myhost)1>]]> + </code> </section> <section> - <title>Setting up Environment to Always Use SSL</title> + <title>Setting up Environment to Always Use SSL (Legacy)</title> <p>A convenient way to specify arguments to Erlang is to use environment variable <c>ERL_FLAGS</c>. All the flags needed to use the SSL distribution can be specified in that variable and are @@ -285,15 +373,11 @@ Eshell V5.0 (abort with ^G) variable.</p> <p>An example command line with this option would look like this:</p> - <code type="none"> + <code type="none"><![CDATA[ $ erl -boot /home/me/ssl/start_ssl -proto_dist inet6_tls - -ssl_dist_opt server_certfile "/home/me/ssl/erlserver.pem" - -ssl_dist_opt server_secure_renegotiate true client_secure_renegotiate true - -sname ssl_test -Erlang (BEAM) emulator version 5.0 [source] - -Eshell V5.0 (abort with ^G) -(ssl_test@myhost)1> </code> + -ssl_dist_optfile "/home/me/ssl/[email protected]" + -sname ssl_test]]> + </code> <p>A node started in this way will only be able to communicate with other nodes using SSL distribution over IPv6.</p> diff --git a/lib/ssl/doc/src/warning.gif b/lib/ssl/doc/src/warning.gif Binary files differdeleted file mode 100644 index 96af52360e..0000000000 --- a/lib/ssl/doc/src/warning.gif +++ /dev/null diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile index 2e7df9792e..8eba5cf347 100644 --- a/lib/ssl/src/Makefile +++ b/lib/ssl/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2016. All Rights Reserved. +# Copyright Ericsson AB 1999-2017. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -87,8 +87,7 @@ MODULES= \ ssl_v2 \ ssl_v3 \ tls_v1 \ - dtls_v1 \ - ssl_tls_dist_proxy + dtls_v1 INTERNAL_HRL_FILES = \ ssl_alert.hrl ssl_cipher.hrl \ diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index 78458f8379..e5760e7951 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -39,20 +39,18 @@ -export([start_fsm/8, start_link/7, init/1]). %% State transition handling --export([next_record/1, next_event/3, next_event/4]). +-export([next_record/1, next_event/3, next_event/4, handle_common_event/4]). %% Handshake handling --export([renegotiate/2, - reinit_handshake_data/1, - send_handshake/2, queue_handshake/2, queue_change_cipher/2, - select_sni_extension/1]). +-export([renegotiate/2, send_handshake/2, + queue_handshake/2, queue_change_cipher/2, + reinit_handshake_data/1, select_sni_extension/1, empty_connection_state/2]). %% Alert and close handling -export([encode_alert/3,send_alert/2, close/5, protocol_name/0]). %% Data handling - --export([encode_data/3, passive_receive/2, next_record_if_active/1, handle_common_event/4, +-export([encode_data/3, passive_receive/2, next_record_if_active/1, send/3, socket/5, setopts/3, getopts/3]). %% gen_statem state functions @@ -64,6 +62,9 @@ %%==================================================================== %% Internal application API +%%==================================================================== +%%==================================================================== +%% Setup %%==================================================================== start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker} = Opts, User, {CbModule, _,_, _} = CbInfo, @@ -79,9 +80,221 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker} Error end. -send_handshake(Handshake, #state{connection_states = ConnectionStates} = States) -> +%%-------------------------------------------------------------------- +-spec start_link(atom(), host(), inet:port_number(), port(), list(), pid(), tuple()) -> + {ok, pid()} | ignore | {error, reason()}. +%% +%% Description: Creates a gen_statem process which calls Module:init/1 to +%% initialize. +%%-------------------------------------------------------------------- +start_link(Role, Host, Port, Socket, Options, User, CbInfo) -> + {ok, proc_lib:spawn_link(?MODULE, init, [[Role, Host, Port, Socket, Options, User, CbInfo]])}. + +init([Role, Host, Port, Socket, Options, User, CbInfo]) -> + process_flag(trap_exit, true), + State0 = initial_state(Role, Host, Port, Socket, Options, User, CbInfo), + try + State = ssl_connection:ssl_config(State0#state.ssl_options, Role, State0), + gen_statem:enter_loop(?MODULE, [], init, State) + catch + throw:Error -> + gen_statem:enter_loop(?MODULE, [], error, {Error,State0}) + end. +%%==================================================================== +%% State transition handling +%%==================================================================== +next_record(#state{unprocessed_handshake_events = N} = State) when N > 0 -> + {no_record, State#state{unprocessed_handshake_events = N-1}}; + +next_record(#state{protocol_buffers = + #protocol_buffers{dtls_cipher_texts = [#ssl_tls{epoch = Epoch} = CT | Rest]} + = Buffers, + connection_states = #{current_read := #{epoch := Epoch}} = ConnectionStates} = State) -> + CurrentRead = dtls_record:get_connection_state_by_epoch(Epoch, ConnectionStates, read), + case dtls_record:replay_detect(CT, CurrentRead) of + false -> + decode_cipher_text(State#state{connection_states = ConnectionStates}) ; + true -> + %% Ignore replayed record + next_record(State#state{protocol_buffers = + Buffers#protocol_buffers{dtls_cipher_texts = Rest}, + connection_states = ConnectionStates}) + end; +next_record(#state{protocol_buffers = + #protocol_buffers{dtls_cipher_texts = [#ssl_tls{epoch = Epoch} | Rest]} + = Buffers, + connection_states = #{current_read := #{epoch := CurrentEpoch}} = ConnectionStates} = State) + when Epoch > CurrentEpoch -> + %% TODO Buffer later Epoch message, drop it for now + next_record(State#state{protocol_buffers = + Buffers#protocol_buffers{dtls_cipher_texts = Rest}, + connection_states = ConnectionStates}); +next_record(#state{protocol_buffers = + #protocol_buffers{dtls_cipher_texts = [ _ | Rest]} + = Buffers, + connection_states = ConnectionStates} = State) -> + %% Drop old epoch message + next_record(State#state{protocol_buffers = + Buffers#protocol_buffers{dtls_cipher_texts = Rest}, + connection_states = ConnectionStates}); +next_record(#state{role = server, + socket = {Listener, {Client, _}}, + transport_cb = gen_udp} = State) -> + dtls_udp_listener:active_once(Listener, Client, self()), + {no_record, State}; +next_record(#state{role = client, + socket = {_Server, Socket}, + transport_cb = Transport} = State) -> + dtls_socket:setopts(Transport, Socket, [{active,once}]), + {no_record, State}; +next_record(State) -> + {no_record, State}. + +next_event(StateName, Record, State) -> + next_event(StateName, Record, State, []). + +next_event(connection = StateName, no_record, + #state{connection_states = #{current_read := #{epoch := CurrentEpoch}}} = State0, Actions) -> + case next_record_if_active(State0) of + {no_record, State} -> + ssl_connection:hibernate_after(StateName, State, Actions); + {#ssl_tls{epoch = CurrentEpoch, + type = ?HANDSHAKE, + version = Version} = Record, State1} -> + State = dtls_version(StateName, Version, State1), + {next_state, StateName, State, + [{next_event, internal, {protocol_record, Record}} | Actions]}; + {#ssl_tls{epoch = CurrentEpoch} = Record, State} -> + {next_state, StateName, State, [{next_event, internal, {protocol_record, Record}} | Actions]}; + {#ssl_tls{epoch = Epoch, + type = ?HANDSHAKE, + version = _Version}, State1} = _Record when Epoch == CurrentEpoch-1 -> + {State2, MoreActions} = send_handshake_flight(State1, CurrentEpoch), + {NextRecord, State} = next_record(State2), + next_event(StateName, NextRecord, State, Actions ++ MoreActions); + %% From FLIGHT perspective CHANGE_CIPHER_SPEC is treated as a handshake + {#ssl_tls{epoch = Epoch, + type = ?CHANGE_CIPHER_SPEC, + version = _Version}, State1} = _Record when Epoch == CurrentEpoch-1 -> + {State2, MoreActions} = send_handshake_flight(State1, CurrentEpoch), + {NextRecord, State} = next_record(State2), + next_event(StateName, NextRecord, State, Actions ++ MoreActions); + {#ssl_tls{epoch = _Epoch, + version = _Version}, State1} -> + %% TODO maybe buffer later epoch + {Record, State} = next_record(State1), + next_event(StateName, Record, State, Actions); + {#alert{} = Alert, State} -> + {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} + end; +next_event(connection = StateName, Record, + #state{connection_states = #{current_read := #{epoch := CurrentEpoch}}} = State0, Actions) -> + case Record of + #ssl_tls{epoch = CurrentEpoch, + type = ?HANDSHAKE, + version = Version} = Record -> + State = dtls_version(StateName, Version, State0), + {next_state, StateName, State, + [{next_event, internal, {protocol_record, Record}} | Actions]}; + #ssl_tls{epoch = CurrentEpoch} -> + {next_state, StateName, State0, [{next_event, internal, {protocol_record, Record}} | Actions]}; + #ssl_tls{epoch = Epoch, + type = ?HANDSHAKE, + version = _Version} when Epoch == CurrentEpoch-1 -> + {State1, MoreActions} = send_handshake_flight(State0, CurrentEpoch), + {NextRecord, State} = next_record(State1), + next_event(StateName, NextRecord, State, Actions ++ MoreActions); + %% From FLIGHT perspective CHANGE_CIPHER_SPEC is treated as a handshake + #ssl_tls{epoch = Epoch, + type = ?CHANGE_CIPHER_SPEC, + version = _Version} when Epoch == CurrentEpoch-1 -> + {State1, MoreActions} = send_handshake_flight(State0, CurrentEpoch), + {NextRecord, State} = next_record(State1), + next_event(StateName, NextRecord, State, Actions ++ MoreActions); + _ -> + next_event(StateName, no_record, State0, Actions) + end; +next_event(StateName, Record, + #state{connection_states = #{current_read := #{epoch := CurrentEpoch}}} = State0, Actions) -> + case Record of + no_record -> + {next_state, StateName, State0, Actions}; + #ssl_tls{epoch = CurrentEpoch, + version = Version} = Record -> + State = dtls_version(StateName, Version, State0), + {next_state, StateName, State, + [{next_event, internal, {protocol_record, Record}} | Actions]}; + #ssl_tls{epoch = _Epoch, + version = _Version} = _Record -> + %% TODO maybe buffer later epoch + {Record, State} = next_record(State0), + next_event(StateName, Record, State, Actions); + #alert{} = Alert -> + {next_state, StateName, State0, [{next_event, internal, Alert} | Actions]} + end. + +handle_common_event(internal, #alert{} = Alert, StateName, + #state{negotiated_version = Version} = State) -> + handle_own_alert(Alert, Version, StateName, State); +%%% DTLS record protocol level handshake messages +handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE, + fragment = Data}, + StateName, + #state{protocol_buffers = Buffers0, + negotiated_version = Version} = State0) -> + try + case dtls_handshake:get_dtls_handshake(Version, Data, Buffers0) of + {[], Buffers} -> + {Record, State} = next_record(State0#state{protocol_buffers = Buffers}), + next_event(StateName, Record, State); + {Packets, Buffers} -> + State = State0#state{protocol_buffers = Buffers}, + Events = dtls_handshake_events(Packets), + {next_state, StateName, + State#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events} + end + catch throw:#alert{} = Alert -> + handle_own_alert(Alert, Version, StateName, State0) + end; +%%% DTLS record protocol level application data messages +handle_common_event(internal, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName, State) -> + {next_state, StateName, State, [{next_event, internal, {application_data, Data}}]}; +%%% DTLS record protocol level change cipher messages +handle_common_event(internal, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = Data}, StateName, State) -> + {next_state, StateName, State, [{next_event, internal, #change_cipher_spec{type = Data}}]}; +%%% DTLS record protocol level Alert messages +handle_common_event(internal, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, StateName, + #state{negotiated_version = Version} = State) -> + case decode_alerts(EncAlerts) of + Alerts = [_|_] -> + handle_alerts(Alerts, {next_state, StateName, State}); + #alert{} = Alert -> + handle_own_alert(Alert, Version, StateName, State) + end; +%% Ignore unknown TLS record level protocol messages +handle_common_event(internal, #ssl_tls{type = _Unknown}, StateName, State) -> + {next_state, StateName, State}. + +%%==================================================================== +%% Handshake handling +%%==================================================================== + +renegotiate(#state{role = client} = State, Actions) -> + %% Handle same way as if server requested + %% the renegotiation + {next_state, connection, State, + [{next_event, internal, #hello_request{}} | Actions]}; + +renegotiate(#state{role = server} = State0, Actions) -> + HelloRequest = ssl_handshake:hello_request(), + State1 = prepare_flight(State0), + {State2, MoreActions} = send_handshake(HelloRequest, State1), + {Record, State} = next_record(State2), + next_event(hello, Record, State, Actions ++ MoreActions). + +send_handshake(Handshake, #state{connection_states = ConnectionStates} = State) -> #{epoch := Epoch} = ssl_record:current_connection_state(ConnectionStates, write), - send_handshake_flight(queue_handshake(Handshake, States), Epoch). + send_handshake_flight(queue_handshake(Handshake, State), Epoch). queue_handshake(Handshake0, #state{tls_handshake_history = Hist0, negotiated_version = Version, @@ -104,69 +317,39 @@ queue_handshake(Handshake0, #state{tls_handshake_history = Hist0, next_sequence => Seq +1}, tls_handshake_history = Hist}. - -send_handshake_flight(#state{socket = Socket, - transport_cb = Transport, - flight_buffer = #{handshakes := Flight, - change_cipher_spec := undefined}, - negotiated_version = Version, - connection_states = ConnectionStates0} = State0, Epoch) -> - %% TODO remove hardcoded Max size - {Encoded, ConnectionStates} = - encode_handshake_flight(lists:reverse(Flight), Version, 1400, Epoch, ConnectionStates0), - send(Transport, Socket, Encoded), - {State0#state{connection_states = ConnectionStates}, []}; - -send_handshake_flight(#state{socket = Socket, - transport_cb = Transport, - flight_buffer = #{handshakes := [_|_] = Flight0, - change_cipher_spec := ChangeCipher, - handshakes_after_change_cipher_spec := []}, - negotiated_version = Version, - connection_states = ConnectionStates0} = State0, Epoch) -> - {HsBefore, ConnectionStates1} = - encode_handshake_flight(lists:reverse(Flight0), Version, 1400, Epoch, ConnectionStates0), - {EncChangeCipher, ConnectionStates} = encode_change_cipher(ChangeCipher, Version, Epoch, ConnectionStates1), - - send(Transport, Socket, [HsBefore, EncChangeCipher]), - {State0#state{connection_states = ConnectionStates}, []}; - -send_handshake_flight(#state{socket = Socket, - transport_cb = Transport, - flight_buffer = #{handshakes := [_|_] = Flight0, - change_cipher_spec := ChangeCipher, - handshakes_after_change_cipher_spec := Flight1}, - negotiated_version = Version, - connection_states = ConnectionStates0} = State0, Epoch) -> - {HsBefore, ConnectionStates1} = - encode_handshake_flight(lists:reverse(Flight0), Version, 1400, Epoch-1, ConnectionStates0), - {EncChangeCipher, ConnectionStates2} = - encode_change_cipher(ChangeCipher, Version, Epoch-1, ConnectionStates1), - {HsAfter, ConnectionStates} = - encode_handshake_flight(lists:reverse(Flight1), Version, 1400, Epoch, ConnectionStates2), - send(Transport, Socket, [HsBefore, EncChangeCipher, HsAfter]), - {State0#state{connection_states = ConnectionStates}, []}; - -send_handshake_flight(#state{socket = Socket, - transport_cb = Transport, - flight_buffer = #{handshakes := [], - change_cipher_spec := ChangeCipher, - handshakes_after_change_cipher_spec := Flight1}, - negotiated_version = Version, - connection_states = ConnectionStates0} = State0, Epoch) -> - {EncChangeCipher, ConnectionStates1} = - encode_change_cipher(ChangeCipher, Version, Epoch-1, ConnectionStates0), - {HsAfter, ConnectionStates} = - encode_handshake_flight(lists:reverse(Flight1), Version, 1400, Epoch, ConnectionStates1), - send(Transport, Socket, [EncChangeCipher, HsAfter]), - {State0#state{connection_states = ConnectionStates}, []}. - queue_change_cipher(ChangeCipher, #state{flight_buffer = Flight, connection_states = ConnectionStates0} = State) -> ConnectionStates = dtls_record:next_epoch(ConnectionStates0, write), State#state{flight_buffer = Flight#{change_cipher_spec => ChangeCipher}, connection_states = ConnectionStates}. +reinit_handshake_data(#state{protocol_buffers = Buffers} = State) -> + State#state{premaster_secret = undefined, + public_key_info = undefined, + tls_handshake_history = ssl_handshake:init_handshake_history(), + flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT}, + flight_buffer = new_flight(), + protocol_buffers = + Buffers#protocol_buffers{ + dtls_handshake_next_seq = 0, + dtls_handshake_next_fragments = [], + dtls_handshake_later_fragments = [] + }}. + +select_sni_extension(#client_hello{extensions = HelloExtensions}) -> + HelloExtensions#hello_extensions.sni; +select_sni_extension(_) -> + undefined. + +empty_connection_state(ConnectionEnd, BeastMitigation) -> + Empty = ssl_record:empty_connection_state(ConnectionEnd, BeastMitigation), + dtls_record:empty_connection_state(Empty). + +%%==================================================================== +%% Alert and close handling +%%==================================================================== +encode_alert(#alert{} = Alert, Version, ConnectionStates) -> + dtls_record:encode_alert_record(Alert, Version, ConnectionStates). send_alert(Alert, #state{negotiated_version = Version, socket = Socket, @@ -183,67 +366,55 @@ close(downgrade, _,_,_,_) -> close(_, Socket, Transport, _,_) -> dtls_socket:close(Transport,Socket). -reinit_handshake_data(#state{protocol_buffers = Buffers} = State) -> - State#state{premaster_secret = undefined, - public_key_info = undefined, - tls_handshake_history = ssl_handshake:init_handshake_history(), - flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT}, - protocol_buffers = - Buffers#protocol_buffers{ - dtls_handshake_next_seq = 0, - dtls_handshake_next_fragments = [], - dtls_handshake_later_fragments = [] - }}. +protocol_name() -> + "DTLS". + +%%==================================================================== +%% Data handling +%%==================================================================== -select_sni_extension(#client_hello{extensions = HelloExtensions}) -> - HelloExtensions#hello_extensions.sni; -select_sni_extension(_) -> - undefined. +encode_data(Data, Version, ConnectionStates0)-> + dtls_record:encode_data(Data, Version, ConnectionStates0). + +passive_receive(State0 = #state{user_data_buffer = Buffer}, StateName) -> + case Buffer of + <<>> -> + {Record, State} = next_record(State0), + next_event(StateName, Record, State); + _ -> + {Record, State} = ssl_connection:read_application_data(<<>>, State0), + next_event(StateName, Record, State) + end. +next_record_if_active(State = + #state{socket_options = + #socket_options{active = false}}) -> + {no_record ,State}; + +next_record_if_active(State) -> + next_record(State). + +send(Transport, {_, {{_,_}, _} = Socket}, Data) -> + send(Transport, Socket, Data); +send(Transport, Socket, Data) -> + dtls_socket:send(Transport, Socket, Data). socket(Pid, Transport, Socket, Connection, _) -> dtls_socket:socket(Pid, Transport, Socket, Connection). setopts(Transport, Socket, Other) -> dtls_socket:setopts(Transport, Socket, Other). + getopts(Transport, Socket, Tag) -> dtls_socket:getopts(Transport, Socket, Tag). -protocol_name() -> - "DTLS". - -%%==================================================================== -%% tls_connection_sup API -%%==================================================================== - %%-------------------------------------------------------------------- --spec start_link(atom(), host(), inet:port_number(), port(), list(), pid(), tuple()) -> - {ok, pid()} | ignore | {error, reason()}. -%% -%% Description: Creates a gen_fsm process which calls Module:init/1 to -%% initialize. To ensure a synchronized start-up procedure, this function -%% does not return until Module:init/1 has returned. +%% State functions %%-------------------------------------------------------------------- -start_link(Role, Host, Port, Socket, Options, User, CbInfo) -> - {ok, proc_lib:spawn_link(?MODULE, init, [[Role, Host, Port, Socket, Options, User, CbInfo]])}. - -init([Role, Host, Port, Socket, Options, User, CbInfo]) -> - process_flag(trap_exit, true), - State0 = initial_state(Role, Host, Port, Socket, Options, User, CbInfo), - try - State = ssl_connection:ssl_config(State0#state.ssl_options, Role, State0), - gen_statem:enter_loop(?MODULE, [], init, State) - catch - throw:Error -> - gen_statem:enter_loop(?MODULE, [], error, {Error,State0}) - end. - -callback_mode() -> - [state_functions, state_enter]. - %%-------------------------------------------------------------------- -%% State functions +-spec init(gen_statem:event_type(), + {start, timeout()} | term(), #state{}) -> + gen_statem:state_function_result(). %%-------------------------------------------------------------------- - init(enter, _, State) -> {keep_state, State}; init({call, From}, {start, Timeout}, @@ -273,28 +444,33 @@ init({call, From}, {start, Timeout}, {Record, State} = next_record(State3), next_event(hello, Record, State, Actions); init({call, _} = Type, Event, #state{role = server, transport_cb = gen_udp} = State) -> - Result = ssl_connection:?FUNCTION_NAME(Type, Event, - State#state{flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT}, - protocol_specific = #{current_cookie_secret => dtls_v1:cookie_secret(), - previous_cookie_secret => <<>>, - ignored_alerts => 0, - max_ignored_alerts => 10}}, - ?MODULE), + Result = gen_handshake(?FUNCTION_NAME, Type, Event, + State#state{flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT}, + protocol_specific = #{current_cookie_secret => dtls_v1:cookie_secret(), + previous_cookie_secret => <<>>, + ignored_alerts => 0, + max_ignored_alerts => 10}}), erlang:send_after(dtls_v1:cookie_timeout(), self(), new_cookie_secret), Result; init({call, _} = Type, Event, #state{role = server} = State) -> %% I.E. DTLS over sctp - ssl_connection:?FUNCTION_NAME(Type, Event, State#state{flight_state = reliable}, ?MODULE); + gen_handshake(?FUNCTION_NAME, Type, Event, State#state{flight_state = reliable}); init(Type, Event, State) -> - ssl_connection:?FUNCTION_NAME(Type, Event, State, ?MODULE). - + gen_handshake(?FUNCTION_NAME, Type, Event, State). + +%%-------------------------------------------------------------------- +-spec error(gen_statem:event_type(), + {start, timeout()} | term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- error(enter, _, State) -> {keep_state, State}; error({call, From}, {start, _Timeout}, {Error, State}) -> - {stop_and_reply, normal, {reply, From, {error, Error}}, State}; -error({call, From}, Msg, State) -> - handle_call(Msg, From, ?FUNCTION_NAME, State); + ssl_connection:stop_and_reply( + normal, {reply, From, {error, Error}}, State); +error({call, _} = Call, Msg, State) -> + gen_handshake(?FUNCTION_NAME, Call, Msg, State); error(_, _, _) -> {keep_state_and_data, [postpone]}. @@ -355,13 +531,14 @@ hello(internal, #hello_verify_request{cookie = Cookie}, #state{role = client, session_cache = Cache, session_cache_cb = CacheCb } = State0) -> - State1 = prepare_flight(State0#state{tls_handshake_history = ssl_handshake:init_handshake_history()}), + Hello = dtls_handshake:client_hello(Host, Port, Cookie, ConnectionStates0, SslOpts, Cache, CacheCb, Renegotiation, OwnCert), Version = Hello#client_hello.client_version, - HelloVersion = dtls_record:lowest_protocol_version(SslOpts#ssl_options.versions), - {State2, Actions} = send_handshake(Hello, State1#state{negotiated_version = HelloVersion}), + State1 = prepare_flight(State0#state{tls_handshake_history = ssl_handshake:init_handshake_history()}), + + {State2, Actions} = send_handshake(Hello, State1), State3 = State2#state{negotiated_version = Version, %% Requested version session = Session0#session{session_id = @@ -388,49 +565,60 @@ hello(internal, {handshake, {#hello_verify_request{} = Handshake, _}}, State) -> %% hello_verify should not be in handshake history {next_state, ?FUNCTION_NAME, State, [{next_event, internal, Handshake}]}; hello(info, Event, State) -> - handle_info(Event, ?FUNCTION_NAME, State); + gen_info(Event, ?FUNCTION_NAME, State); hello(state_timeout, Event, State) -> handle_state_timeout(Event, ?FUNCTION_NAME, State); hello(Type, Event, State) -> - ssl_connection:?FUNCTION_NAME(Type, Event, State, ?MODULE). + gen_handshake(?FUNCTION_NAME, Type, Event, State). +%%-------------------------------------------------------------------- +-spec abbreviated(gen_statem:event_type(), term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- abbreviated(enter, _, State0) -> {State, Actions} = handle_flight_timer(State0), {keep_state, State, Actions}; abbreviated(info, Event, State) -> - handle_info(Event, ?FUNCTION_NAME, State); + gen_info(Event, ?FUNCTION_NAME, State); abbreviated(internal = Type, #change_cipher_spec{type = <<1>>} = Event, #state{connection_states = ConnectionStates0} = State) -> ConnectionStates1 = dtls_record:save_current_connection_state(ConnectionStates0, read), ConnectionStates = dtls_record:next_epoch(ConnectionStates1, read), - ssl_connection:?FUNCTION_NAME(Type, Event, State#state{connection_states = ConnectionStates}, ?MODULE); + gen_handshake(?FUNCTION_NAME, Type, Event, State#state{connection_states = ConnectionStates}); abbreviated(internal = Type, #finished{} = Event, #state{connection_states = ConnectionStates} = State) -> - ssl_connection:?FUNCTION_NAME(Type, Event, - prepare_flight(State#state{connection_states = ConnectionStates, - flight_state = connection}), ?MODULE); + gen_handshake(?FUNCTION_NAME, Type, Event, + prepare_flight(State#state{connection_states = ConnectionStates, + flight_state = connection})); abbreviated(state_timeout, Event, State) -> handle_state_timeout(Event, ?FUNCTION_NAME, State); abbreviated(Type, Event, State) -> - ssl_connection:?FUNCTION_NAME(Type, Event, State, ?MODULE). - + gen_handshake(?FUNCTION_NAME, Type, Event, State). +%%-------------------------------------------------------------------- +-spec certify(gen_statem:event_type(), term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- certify(enter, _, State0) -> {State, Actions} = handle_flight_timer(State0), {keep_state, State, Actions}; certify(info, Event, State) -> - handle_info(Event, ?FUNCTION_NAME, State); + gen_info(Event, ?FUNCTION_NAME, State); certify(internal = Type, #server_hello_done{} = Event, State) -> ssl_connection:certify(Type, Event, prepare_flight(State), ?MODULE); certify(state_timeout, Event, State) -> handle_state_timeout(Event, ?FUNCTION_NAME, State); certify(Type, Event, State) -> - ssl_connection:?FUNCTION_NAME(Type, Event, State, ?MODULE). + gen_handshake(?FUNCTION_NAME, Type, Event, State). +%%-------------------------------------------------------------------- +-spec cipher(gen_statem:event_type(), term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- cipher(enter, _, State0) -> {State, Actions} = handle_flight_timer(State0), {keep_state, State, Actions}; cipher(info, Event, State) -> - handle_info(Event, ?FUNCTION_NAME, State); + gen_info(Event, ?FUNCTION_NAME, State); cipher(internal = Type, #change_cipher_spec{type = <<1>>} = Event, #state{connection_states = ConnectionStates0} = State) -> ConnectionStates1 = dtls_record:save_current_connection_state(ConnectionStates0, read), @@ -446,22 +634,32 @@ cipher(state_timeout, Event, State) -> cipher(Type, Event, State) -> ssl_connection:?FUNCTION_NAME(Type, Event, State, ?MODULE). +%%-------------------------------------------------------------------- +-spec connection(gen_statem:event_type(), + #hello_request{} | #client_hello{}| term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- connection(enter, _, State) -> {keep_state, State}; connection(info, Event, State) -> - handle_info(Event, ?FUNCTION_NAME, State); + gen_info(Event, ?FUNCTION_NAME, State); connection(internal, #hello_request{}, #state{host = Host, port = Port, - session = #session{own_certificate = Cert} = Session0, - session_cache = Cache, session_cache_cb = CacheCb, - ssl_options = SslOpts, - connection_states = ConnectionStates0, - renegotiation = {Renegotiation, _}} = State0) -> + session = #session{own_certificate = Cert} = Session0, + session_cache = Cache, session_cache_cb = CacheCb, + ssl_options = SslOpts, + connection_states = ConnectionStates0, + renegotiation = {Renegotiation, _}} = State0) -> + Hello = dtls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts, Cache, CacheCb, Renegotiation, Cert), - {State1, Actions} = send_handshake(Hello, State0), + Version = Hello#client_hello.client_version, + HelloVersion = dtls_record:hello_version(Version, SslOpts#ssl_options.versions), + State1 = prepare_flight(State0), + {State2, Actions} = send_handshake(Hello, State1#state{negotiated_version = HelloVersion}), {Record, State} = next_record( - State1#state{session = Session0#session{session_id + State2#state{flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT}, + session = Session0#session{session_id = Hello#client_hello.session_id}}), next_event(hello, Record, State, Actions); connection(internal, #client_hello{} = Hello, #state{role = server, allow_renegotiate = true} = State) -> @@ -471,7 +669,8 @@ connection(internal, #client_hello{} = Hello, #state{role = server, allow_renego %% initiated renegotiation we will disallow many client initiated %% renegotiations immediately after each other. erlang:send_after(?WAIT_TO_ALLOW_RENEGOTIATION, self(), allow_renegotiate), - {next_state, hello, State#state{allow_renegotiate = false}, [{next_event, internal, Hello}]}; + {next_state, hello, State#state{allow_renegotiate = false, renegotiation = {true, peer}}, + [{next_event, internal, Hello}]}; connection(internal, #client_hello{}, #state{role = server, allow_renegotiate = false} = State0) -> Alert = ?ALERT_REC(?WARNING, ?NO_RENEGOTIATION), State1 = send_alert(Alert, State0), @@ -481,137 +680,24 @@ connection(Type, Event, State) -> ssl_connection:?FUNCTION_NAME(Type, Event, State, ?MODULE). %%TODO does this make sense for DTLS ? +%%-------------------------------------------------------------------- +-spec downgrade(gen_statem:event_type(), term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- downgrade(enter, _, State) -> {keep_state, State}; downgrade(Type, Event, State) -> ssl_connection:?FUNCTION_NAME(Type, Event, State, ?MODULE). %%-------------------------------------------------------------------- -%% Description: This function is called by a gen_fsm when it receives any -%% other message than a synchronous or asynchronous event -%% (or a system message). +%% gen_statem callbacks %%-------------------------------------------------------------------- +callback_mode() -> + [state_functions, state_enter]. -%% raw data from socket, unpack records -handle_info({Protocol, _, _, _, Data}, StateName, - #state{data_tag = Protocol} = State0) -> - case next_dtls_record(Data, State0) of - {Record, State} -> - next_event(StateName, Record, State); - #alert{} = Alert -> - ssl_connection:handle_normal_shutdown(Alert, StateName, State0), - {stop, {shutdown, own_alert}} - end; -handle_info({CloseTag, Socket}, StateName, - #state{socket = Socket, - socket_options = #socket_options{active = Active}, - protocol_buffers = #protocol_buffers{dtls_cipher_texts = CTs}, - close_tag = CloseTag, - negotiated_version = Version} = State) -> - %% Note that as of DTLS 1.2 (TLS 1.1), - %% failure to properly close a connection no longer requires that a - %% session not be resumed. This is a change from DTLS 1.0 to conform - %% with widespread implementation practice. - case (Active == false) andalso (CTs =/= []) of - false -> - case Version of - {254, N} when N =< 253 -> - ok; - _ -> - %% As invalidate_sessions here causes performance issues, - %% we will conform to the widespread implementation - %% practice and go aginst the spec - %%invalidate_session(Role, Host, Port, Session) - ok - end, - ssl_connection:handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State), - {stop, {shutdown, transport_closed}}; - true -> - %% Fixes non-delivery of final DTLS record in {active, once}. - %% Basically allows the application the opportunity to set {active, once} again - %% and then receive the final message. - next_event(StateName, no_record, State) - end; - -handle_info(new_cookie_secret, StateName, - #state{protocol_specific = #{current_cookie_secret := Secret} = CookieInfo} = State) -> - erlang:send_after(dtls_v1:cookie_timeout(), self(), new_cookie_secret), - {next_state, StateName, State#state{protocol_specific = - CookieInfo#{current_cookie_secret => dtls_v1:cookie_secret(), - previous_cookie_secret => Secret}}}; -handle_info(Msg, StateName, State) -> - ssl_connection:handle_info(Msg, StateName, State). - - -handle_call(Event, From, StateName, State) -> - ssl_connection:handle_call(Event, From, StateName, State, ?MODULE). - -handle_common_event(internal, #alert{} = Alert, StateName, - #state{negotiated_version = Version} = State) -> - handle_own_alert(Alert, Version, StateName, State); -%%% DTLS record protocol level handshake messages -handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE, - fragment = Data}, - StateName, - #state{protocol_buffers = Buffers0, - negotiated_version = Version} = State0) -> - try - case dtls_handshake:get_dtls_handshake(Version, Data, Buffers0) of - {[], Buffers} -> - {Record, State} = next_record(State0#state{protocol_buffers = Buffers}), - next_event(StateName, Record, State); - {Packets, Buffers} -> - State = State0#state{protocol_buffers = Buffers}, - Events = dtls_handshake_events(Packets), - {next_state, StateName, - State#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events} - end - catch throw:#alert{} = Alert -> - handle_own_alert(Alert, Version, StateName, State0) - end; -%%% DTLS record protocol level application data messages -handle_common_event(internal, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName, State) -> - {next_state, StateName, State, [{next_event, internal, {application_data, Data}}]}; -%%% DTLS record protocol level change cipher messages -handle_common_event(internal, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = Data}, StateName, State) -> - {next_state, StateName, State, [{next_event, internal, #change_cipher_spec{type = Data}}]}; -%%% DTLS record protocol level Alert messages -handle_common_event(internal, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, StateName, - #state{negotiated_version = Version} = State) -> - case decode_alerts(EncAlerts) of - Alerts = [_|_] -> - handle_alerts(Alerts, {next_state, StateName, State}); - #alert{} = Alert -> - handle_own_alert(Alert, Version, StateName, State) - end; -%% Ignore unknown TLS record level protocol messages -handle_common_event(internal, #ssl_tls{type = _Unknown}, StateName, State) -> - {next_state, StateName, State}. - -handle_state_timeout(flight_retransmission_timeout, StateName, - #state{flight_state = {retransmit, NextTimeout}} = State0) -> - {State1, Actions} = send_handshake_flight(State0#state{flight_state = {retransmit, NextTimeout}}, - retransmit_epoch(StateName, State0)), - {Record, State} = next_record(State1), - next_event(StateName, Record, State, Actions). - -send(Transport, {_, {{_,_}, _} = Socket}, Data) -> - send(Transport, Socket, Data); -send(Transport, Socket, Data) -> - dtls_socket:send(Transport, Socket, Data). -%%-------------------------------------------------------------------- -%% Description:This function is called by a gen_fsm when it is about -%% to terminate. It should be the opposite of Module:init/1 and do any -%% necessary cleaning up. When it returns, the gen_fsm terminates with -%% Reason. The return value is ignored. -%%-------------------------------------------------------------------- terminate(Reason, StateName, State) -> ssl_connection:terminate(Reason, StateName, State). -%%-------------------------------------------------------------------- -%% code_change(OldVsn, StateName, State, Extra) -> {ok, StateName, NewState} -%% Description: Convert process state when code is changed -%%-------------------------------------------------------------------- code_change(_OldVsn, StateName, State, _Extra) -> {ok, StateName, State}. @@ -621,56 +707,6 @@ format_status(Type, Data) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -handle_client_hello(#client_hello{client_version = ClientVersion} = Hello, - #state{connection_states = ConnectionStates0, - port = Port, session = #session{own_certificate = Cert} = Session0, - renegotiation = {Renegotiation, _}, - session_cache = Cache, - session_cache_cb = CacheCb, - negotiated_protocol = CurrentProtocol, - key_algorithm = KeyExAlg, - ssl_options = SslOpts} = State0) -> - - case dtls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb, - ConnectionStates0, Cert, KeyExAlg}, Renegotiation) of - #alert{} = Alert -> - handle_own_alert(Alert, ClientVersion, hello, State0); - {Version, {Type, Session}, - ConnectionStates, Protocol0, ServerHelloExt, HashSign} -> - Protocol = case Protocol0 of - undefined -> CurrentProtocol; - _ -> Protocol0 - end, - - State = prepare_flight(State0#state{connection_states = ConnectionStates, - negotiated_version = Version, - client_hello_version = ClientVersion, - hashsign_algorithm = HashSign, - session = Session, - negotiated_protocol = Protocol}), - - ssl_connection:hello(internal, {common_client_hello, Type, ServerHelloExt}, - State, ?MODULE) - end. - -encode_handshake_flight(Flight, Version, MaxFragmentSize, Epoch, ConnectionStates) -> - Fragments = lists:map(fun(Handshake) -> - dtls_handshake:fragment_handshake(Handshake, MaxFragmentSize) - end, Flight), - dtls_record:encode_handshake(Fragments, Version, Epoch, ConnectionStates). - -encode_change_cipher(#change_cipher_spec{}, Version, Epoch, ConnectionStates) -> - dtls_record:encode_change_cipher_spec(Version, Epoch, ConnectionStates). - -encode_data(Data, Version, ConnectionStates0)-> - dtls_record:encode_data(Data, Version, ConnectionStates0). - -encode_alert(#alert{} = Alert, Version, ConnectionStates) -> - dtls_record:encode_alert_record(Alert, Version, ConnectionStates). - -decode_alerts(Bin) -> - ssl_alert:decode(Bin). - initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, _}, User, {CbModule, DataTag, CloseTag, ErrorTag}) -> #ssl_options{beast_mitigation = BeastMitigation} = SSLOptions, @@ -724,141 +760,10 @@ next_dtls_record(Data, #state{protocol_buffers = #protocol_buffers{ Alert end. -next_record(#state{unprocessed_handshake_events = N} = State) when N > 0 -> - {no_record, State#state{unprocessed_handshake_events = N-1}}; - -next_record(#state{protocol_buffers = - #protocol_buffers{dtls_cipher_texts = [#ssl_tls{epoch = Epoch} = CT | Rest]} - = Buffers, - connection_states = #{current_read := #{epoch := Epoch}} = ConnectionStates} = State) -> - CurrentRead = dtls_record:get_connection_state_by_epoch(Epoch, ConnectionStates, read), - case dtls_record:replay_detect(CT, CurrentRead) of - false -> - decode_cipher_text(State#state{connection_states = ConnectionStates}) ; - true -> - %% Ignore replayed record - next_record(State#state{protocol_buffers = - Buffers#protocol_buffers{dtls_cipher_texts = Rest}, - connection_states = ConnectionStates}) - end; -next_record(#state{protocol_buffers = - #protocol_buffers{dtls_cipher_texts = [#ssl_tls{epoch = Epoch} | Rest]} - = Buffers, - connection_states = #{current_read := #{epoch := CurrentEpoch}} = ConnectionStates} = State) - when Epoch > CurrentEpoch -> - %% TODO Buffer later Epoch message, drop it for now - next_record(State#state{protocol_buffers = - Buffers#protocol_buffers{dtls_cipher_texts = Rest}, - connection_states = ConnectionStates}); -next_record(#state{protocol_buffers = - #protocol_buffers{dtls_cipher_texts = [ _ | Rest]} - = Buffers, - connection_states = ConnectionStates} = State) -> - %% Drop old epoch message - next_record(State#state{protocol_buffers = - Buffers#protocol_buffers{dtls_cipher_texts = Rest}, - connection_states = ConnectionStates}); -next_record(#state{role = server, - socket = {Listener, {Client, _}}, - transport_cb = gen_udp} = State) -> - dtls_udp_listener:active_once(Listener, Client, self()), - {no_record, State}; -next_record(#state{role = client, - socket = {_Server, Socket}, - transport_cb = Transport} = State) -> - dtls_socket:setopts(Transport, Socket, [{active,once}]), - {no_record, State}; -next_record(State) -> - {no_record, State}. - -next_record_if_active(State = - #state{socket_options = - #socket_options{active = false}}) -> - {no_record ,State}; - -next_record_if_active(State) -> - next_record(State). - -passive_receive(State0 = #state{user_data_buffer = Buffer}, StateName) -> - case Buffer of - <<>> -> - {Record, State} = next_record(State0), - next_event(StateName, Record, State); - _ -> - {Record, State} = ssl_connection:read_application_data(<<>>, State0), - next_event(StateName, Record, State) - end. - -next_event(StateName, Record, State) -> - next_event(StateName, Record, State, []). - -next_event(connection = StateName, no_record, - #state{connection_states = #{current_read := #{epoch := CurrentEpoch}}} = State0, Actions) -> - case next_record_if_active(State0) of - {no_record, State} -> - ssl_connection:hibernate_after(StateName, State, Actions); - {#ssl_tls{epoch = CurrentEpoch} = Record, State} -> - {next_state, StateName, State, [{next_event, internal, {protocol_record, Record}} | Actions]}; - {#ssl_tls{epoch = Epoch, - type = ?HANDSHAKE, - version = _Version}, State1} = _Record when Epoch == CurrentEpoch-1 -> - {State2, MoreActions} = send_handshake_flight(State1, CurrentEpoch), - {NextRecord, State} = next_record(State2), - next_event(StateName, NextRecord, State, Actions ++ MoreActions); - %% From FLIGHT perspective CHANGE_CIPHER_SPEC is treated as a handshake - {#ssl_tls{epoch = Epoch, - type = ?CHANGE_CIPHER_SPEC, - version = _Version}, State1} = _Record when Epoch == CurrentEpoch-1 -> - {State2, MoreActions} = send_handshake_flight(State1, CurrentEpoch), - {NextRecord, State} = next_record(State2), - next_event(StateName, NextRecord, State, Actions ++ MoreActions); - {#ssl_tls{epoch = _Epoch, - version = _Version}, State1} -> - %% TODO maybe buffer later epoch - {Record, State} = next_record(State1), - next_event(StateName, Record, State, Actions); - {#alert{} = Alert, State} -> - {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} - end; -next_event(connection = StateName, Record, - #state{connection_states = #{current_read := #{epoch := CurrentEpoch}}} = State0, Actions) -> - case Record of - #ssl_tls{epoch = CurrentEpoch} -> - {next_state, StateName, State0, [{next_event, internal, {protocol_record, Record}} | Actions]}; - #ssl_tls{epoch = Epoch, - type = ?HANDSHAKE, - version = _Version} when Epoch == CurrentEpoch-1 -> - {State1, MoreActions} = send_handshake_flight(State0, CurrentEpoch), - {NextRecord, State} = next_record(State1), - next_event(StateName, NextRecord, State, Actions ++ MoreActions); - %% From FLIGHT perspective CHANGE_CIPHER_SPEC is treated as a handshake - #ssl_tls{epoch = Epoch, - type = ?CHANGE_CIPHER_SPEC, - version = _Version} when Epoch == CurrentEpoch-1 -> - {State1, MoreActions} = send_handshake_flight(State0, CurrentEpoch), - {NextRecord, State} = next_record(State1), - next_event(StateName, NextRecord, State, Actions ++ MoreActions); - _ -> - next_event(StateName, no_record, State0, Actions) - end; -next_event(StateName, Record, - #state{connection_states = #{current_read := #{epoch := CurrentEpoch}}} = State0, Actions) -> - case Record of - no_record -> - {next_state, StateName, State0, Actions}; - #ssl_tls{epoch = CurrentEpoch, - version = Version} = Record -> - {next_state, StateName, - dtls_version(StateName, Version, State0), - [{next_event, internal, {protocol_record, Record}} | Actions]}; - #ssl_tls{epoch = _Epoch, - version = _Version} = _Record -> - %% TODO maybe buffer later epoch - {Record, State} = next_record(State0), - next_event(StateName, Record, State, Actions); - #alert{} = Alert -> - {next_state, StateName, State0, [{next_event, internal, Alert} | Actions]} - end. +dtls_handshake_events(Packets) -> + lists:map(fun(Packet) -> + {next_event, internal, {handshake, Packet}} + end, Packets). decode_cipher_text(#state{protocol_buffers = #protocol_buffers{dtls_cipher_texts = [ CT | Rest]} = Buffers, connection_states = ConnStates0} = State) -> @@ -876,6 +781,176 @@ dtls_version(hello, Version, #state{role = server} = State) -> dtls_version(_,_, State) -> State. +handle_client_hello(#client_hello{client_version = ClientVersion} = Hello, + #state{connection_states = ConnectionStates0, + port = Port, session = #session{own_certificate = Cert} = Session0, + renegotiation = {Renegotiation, _}, + session_cache = Cache, + session_cache_cb = CacheCb, + negotiated_protocol = CurrentProtocol, + key_algorithm = KeyExAlg, + ssl_options = SslOpts} = State0) -> + + case dtls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb, + ConnectionStates0, Cert, KeyExAlg}, Renegotiation) of + #alert{} = Alert -> + handle_own_alert(Alert, ClientVersion, hello, State0); + {Version, {Type, Session}, + ConnectionStates, Protocol0, ServerHelloExt, HashSign} -> + Protocol = case Protocol0 of + undefined -> CurrentProtocol; + _ -> Protocol0 + end, + + State = prepare_flight(State0#state{connection_states = ConnectionStates, + negotiated_version = Version, + hashsign_algorithm = HashSign, + client_hello_version = ClientVersion, + session = Session, + negotiated_protocol = Protocol}), + + ssl_connection:hello(internal, {common_client_hello, Type, ServerHelloExt}, + State, ?MODULE) + end. + + +%% raw data from socket, unpack records +handle_info({Protocol, _, _, _, Data}, StateName, + #state{data_tag = Protocol} = State0) -> + case next_dtls_record(Data, State0) of + {Record, State} -> + next_event(StateName, Record, State); + #alert{} = Alert -> + ssl_connection:handle_normal_shutdown(Alert, StateName, State0), + ssl_connection:stop({shutdown, own_alert}, State0) + end; +handle_info({CloseTag, Socket}, StateName, + #state{socket = Socket, + socket_options = #socket_options{active = Active}, + protocol_buffers = #protocol_buffers{dtls_cipher_texts = CTs}, + close_tag = CloseTag, + negotiated_version = Version} = State) -> + %% Note that as of DTLS 1.2 (TLS 1.1), + %% failure to properly close a connection no longer requires that a + %% session not be resumed. This is a change from DTLS 1.0 to conform + %% with widespread implementation practice. + case (Active == false) andalso (CTs =/= []) of + false -> + case Version of + {254, N} when N =< 253 -> + ok; + _ -> + %% As invalidate_sessions here causes performance issues, + %% we will conform to the widespread implementation + %% practice and go aginst the spec + %%invalidate_session(Role, Host, Port, Session) + ok + end, + ssl_connection:handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State), + ssl_connection:stop({shutdown, transport_closed}, State); + true -> + %% Fixes non-delivery of final DTLS record in {active, once}. + %% Basically allows the application the opportunity to set {active, once} again + %% and then receive the final message. + next_event(StateName, no_record, State) + end; + +handle_info(new_cookie_secret, StateName, + #state{protocol_specific = #{current_cookie_secret := Secret} = CookieInfo} = State) -> + erlang:send_after(dtls_v1:cookie_timeout(), self(), new_cookie_secret), + {next_state, StateName, State#state{protocol_specific = + CookieInfo#{current_cookie_secret => dtls_v1:cookie_secret(), + previous_cookie_secret => Secret}}}; +handle_info(Msg, StateName, State) -> + ssl_connection:StateName(info, Msg, State, ?MODULE). + +handle_state_timeout(flight_retransmission_timeout, StateName, + #state{flight_state = {retransmit, NextTimeout}} = State0) -> + {State1, Actions} = send_handshake_flight(State0#state{flight_state = {retransmit, NextTimeout}}, + retransmit_epoch(StateName, State0)), + {Record, State} = next_record(State1), + next_event(StateName, Record, State, Actions). + +handle_alerts([], Result) -> + Result; +handle_alerts(_, {stop, _, _} = Stop) -> + Stop; +handle_alerts([Alert | Alerts], {next_state, StateName, State}) -> + handle_alerts(Alerts, ssl_connection:handle_alert(Alert, StateName, State)); +handle_alerts([Alert | Alerts], {next_state, StateName, State, _Actions}) -> + handle_alerts(Alerts, ssl_connection:handle_alert(Alert, StateName, State)). + +handle_own_alert(Alert, Version, StateName, #state{transport_cb = gen_udp, + role = Role, + ssl_options = Options} = State0) -> + case ignore_alert(Alert, State0) of + {true, State} -> + log_ignore_alert(Options#ssl_options.log_alert, StateName, Alert, Role), + {next_state, StateName, State}; + {false, State} -> + ssl_connection:handle_own_alert(Alert, Version, StateName, State) + end; +handle_own_alert(Alert, Version, StateName, State) -> + ssl_connection:handle_own_alert(Alert, Version, StateName, State). + +encode_handshake_flight(Flight, Version, MaxFragmentSize, Epoch, ConnectionStates) -> + Fragments = lists:map(fun(Handshake) -> + dtls_handshake:fragment_handshake(Handshake, MaxFragmentSize) + end, Flight), + dtls_record:encode_handshake(Fragments, Version, Epoch, ConnectionStates). + +encode_change_cipher(#change_cipher_spec{}, Version, Epoch, ConnectionStates) -> + dtls_record:encode_change_cipher_spec(Version, Epoch, ConnectionStates). + +decode_alerts(Bin) -> + ssl_alert:decode(Bin). + +gen_handshake(StateName, Type, Event, + #state{negotiated_version = Version} = State) -> + try ssl_connection:StateName(Type, Event, State, ?MODULE) of + Result -> + Result + catch + _:_ -> + ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, + malformed_handshake_data), + Version, StateName, State) + end. + +gen_info(Event, connection = StateName, #state{negotiated_version = Version} = State) -> + try handle_info(Event, StateName, State) of + Result -> + Result + catch + _:_ -> + ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?INTERNAL_ERROR, + malformed_data), + Version, StateName, State) + end; + +gen_info(Event, StateName, #state{negotiated_version = Version} = State) -> + try handle_info(Event, StateName, State) of + Result -> + Result + catch + _:_ -> + ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, + malformed_handshake_data), + Version, StateName, State) + end. +unprocessed_events(Events) -> + %% The first handshake event will be processed immediately + %% as it is entered first in the event queue and + %% when it is processed there will be length(Events)-1 + %% handshake events left to process before we should + %% process more TLS-records received on the socket. + erlang:length(Events)-1. + +update_handshake_history(#hello_verify_request{}, _, Hist) -> + Hist; +update_handshake_history(_, Handshake, Hist) -> + %% DTLS never needs option "v2_hello_compatible" to be true + ssl_handshake:update_handshake_history(Hist, iolist_to_binary(Handshake), false). prepare_flight(#state{flight_buffer = Flight, connection_states = ConnectionStates0, protocol_buffers = @@ -896,7 +971,7 @@ next_flight(Flight) -> Flight#{handshakes => [], change_cipher_spec => undefined, handshakes_after_change_cipher_spec => []}. - + handle_flight_timer(#state{transport_cb = gen_udp, flight_state = {retransmit, Timeout}} = State) -> start_retransmision_timer(Timeout, State); @@ -916,74 +991,67 @@ new_timeout(N) when N =< 30 -> new_timeout(_) -> 60. -dtls_handshake_events(Packets) -> - lists:map(fun(Packet) -> - {next_event, internal, {handshake, Packet}} - end, Packets). +send_handshake_flight(#state{socket = Socket, + transport_cb = Transport, + flight_buffer = #{handshakes := Flight, + change_cipher_spec := undefined}, + negotiated_version = Version, + connection_states = ConnectionStates0} = State0, Epoch) -> + %% TODO remove hardcoded Max size + {Encoded, ConnectionStates} = + encode_handshake_flight(lists:reverse(Flight), Version, 1400, Epoch, ConnectionStates0), + send(Transport, Socket, Encoded), + {State0#state{connection_states = ConnectionStates}, []}; -renegotiate(#state{role = client} = State, Actions) -> - %% Handle same way as if server requested - %% the renegotiation - Hs0 = ssl_handshake:init_handshake_history(), - {next_state, connection, State#state{tls_handshake_history = Hs0, - protocol_buffers = #protocol_buffers{}}, - [{next_event, internal, #hello_request{}} | Actions]}; +send_handshake_flight(#state{socket = Socket, + transport_cb = Transport, + flight_buffer = #{handshakes := [_|_] = Flight0, + change_cipher_spec := ChangeCipher, + handshakes_after_change_cipher_spec := []}, + negotiated_version = Version, + connection_states = ConnectionStates0} = State0, Epoch) -> + {HsBefore, ConnectionStates1} = + encode_handshake_flight(lists:reverse(Flight0), Version, 1400, Epoch, ConnectionStates0), + {EncChangeCipher, ConnectionStates} = encode_change_cipher(ChangeCipher, Version, Epoch, ConnectionStates1), -renegotiate(#state{role = server, - connection_states = CS0} = State0, Actions) -> - HelloRequest = ssl_handshake:hello_request(), - CS = CS0#{write_msg_seq => 0}, - {State1, MoreActions} = send_handshake(HelloRequest, - State0#state{connection_states = - CS}), - Hs0 = ssl_handshake:init_handshake_history(), - {Record, State} = next_record(State1#state{tls_handshake_history = Hs0, - protocol_buffers = #protocol_buffers{}}), - next_event(hello, Record, State, Actions ++ MoreActions). + send(Transport, Socket, [HsBefore, EncChangeCipher]), + {State0#state{connection_states = ConnectionStates}, []}; -handle_alerts([], Result) -> - Result; -handle_alerts(_, {stop,_} = Stop) -> - Stop; -handle_alerts([Alert | Alerts], {next_state, StateName, State}) -> - handle_alerts(Alerts, ssl_connection:handle_alert(Alert, StateName, State)); -handle_alerts([Alert | Alerts], {next_state, StateName, State, _Actions}) -> - handle_alerts(Alerts, ssl_connection:handle_alert(Alert, StateName, State)). +send_handshake_flight(#state{socket = Socket, + transport_cb = Transport, + flight_buffer = #{handshakes := [_|_] = Flight0, + change_cipher_spec := ChangeCipher, + handshakes_after_change_cipher_spec := Flight1}, + negotiated_version = Version, + connection_states = ConnectionStates0} = State0, Epoch) -> + {HsBefore, ConnectionStates1} = + encode_handshake_flight(lists:reverse(Flight0), Version, 1400, Epoch-1, ConnectionStates0), + {EncChangeCipher, ConnectionStates2} = + encode_change_cipher(ChangeCipher, Version, Epoch-1, ConnectionStates1), + {HsAfter, ConnectionStates} = + encode_handshake_flight(lists:reverse(Flight1), Version, 1400, Epoch, ConnectionStates2), + send(Transport, Socket, [HsBefore, EncChangeCipher, HsAfter]), + {State0#state{connection_states = ConnectionStates}, []}; + +send_handshake_flight(#state{socket = Socket, + transport_cb = Transport, + flight_buffer = #{handshakes := [], + change_cipher_spec := ChangeCipher, + handshakes_after_change_cipher_spec := Flight1}, + negotiated_version = Version, + connection_states = ConnectionStates0} = State0, Epoch) -> + {EncChangeCipher, ConnectionStates1} = + encode_change_cipher(ChangeCipher, Version, Epoch-1, ConnectionStates0), + {HsAfter, ConnectionStates} = + encode_handshake_flight(lists:reverse(Flight1), Version, 1400, Epoch, ConnectionStates1), + send(Transport, Socket, [EncChangeCipher, HsAfter]), + {State0#state{connection_states = ConnectionStates}, []}. retransmit_epoch(_StateName, #state{connection_states = ConnectionStates}) -> #{epoch := Epoch} = ssl_record:current_connection_state(ConnectionStates, write), Epoch. - -update_handshake_history(#hello_verify_request{}, _, Hist) -> - Hist; -update_handshake_history(_, Handshake, Hist) -> - %% DTLS never needs option "v2_hello_compatible" to be true - ssl_handshake:update_handshake_history(Hist, iolist_to_binary(Handshake), false). - -unprocessed_events(Events) -> - %% The first handshake event will be processed immediately - %% as it is entered first in the event queue and - %% when it is processed there will be length(Events)-1 - %% handshake events left to process before we should - %% process more TLS-records received on the socket. - erlang:length(Events)-1. - -handle_own_alert(Alert, Version, StateName, #state{transport_cb = gen_udp, - role = Role, - ssl_options = Options} = State0) -> - case ignore_alert(Alert, State0) of - {true, State} -> - log_ignore_alert(Options#ssl_options.log_alert, StateName, Alert, Role), - {next_state, StateName, State}; - {false, State} -> - ssl_connection:handle_own_alert(Alert, Version, StateName, State) - end; -handle_own_alert(Alert, Version, StateName, State) -> - ssl_connection:handle_own_alert(Alert, Version, StateName, State). - - ignore_alert(#alert{level = ?FATAL}, #state{protocol_specific = #{ignored_alerts := N, max_ignored_alerts := N}} = State) -> {false, State}; diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl index 37a46b862e..5e8f5c2ca0 100644 --- a/lib/ssl/src/dtls_handshake.erl +++ b/lib/ssl/src/dtls_handshake.erl @@ -16,6 +16,11 @@ %% limitations under the License. %% %% %CopyrightEnd% + +%%---------------------------------------------------------------------- +%% Purpose: Help funtions for handling the DTLS (specific parts of) +%%% SSL/TLS/DTLS handshake protocol +%%---------------------------------------------------------------------- -module(dtls_handshake). -include("dtls_connection.hrl"). @@ -24,15 +29,21 @@ -include("ssl_internal.hrl"). -include("ssl_alert.hrl"). +%% Handshake handling -export([client_hello/8, client_hello/9, cookie/4, hello/4, - hello_verify_request/2, get_dtls_handshake/3, fragment_handshake/2, - handshake_bin/2, encode_handshake/3]). + hello_verify_request/2]). + +%% Handshake encoding +-export([fragment_handshake/2, encode_handshake/3]). + +%% Handshake decodeing +-export([get_dtls_handshake/3]). -type dtls_handshake() :: #client_hello{} | #hello_verify_request{} | ssl_handshake:ssl_handshake(). %%==================================================================== -%% Internal application API +%% Handshake handling %%==================================================================== %%-------------------------------------------------------------------- -spec client_hello(host(), inet:port_number(), ssl_record:connection_states(), @@ -66,7 +77,8 @@ client_hello(Host, Port, Cookie, ConnectionStates, CipherSuites = ssl_handshake:available_suites(UserSuites, TLSVersion), Extensions = ssl_handshake:client_hello_extensions(TLSVersion, CipherSuites, - SslOpts, ConnectionStates, Renegotiation), + SslOpts, ConnectionStates, + Renegotiation), Id = ssl_session:client_id({Host, Port, SslOpts}, Cache, CacheCb, OwnCert), #client_hello{session_id = Id, @@ -87,11 +99,11 @@ hello(#server_hello{server_version = Version, random = Random, case dtls_record:is_acceptable_version(Version, SupportedVersions) of true -> handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, - Compression, HelloExt, SslOpt, ConnectionStates0, Renegotiation); + Compression, HelloExt, SslOpt, + ConnectionStates0, Renegotiation); false -> ?ALERT_REC(?FATAL, ?PROTOCOL_VERSION) end; - hello(#client_hello{client_version = ClientVersion} = Hello, #ssl_options{versions = Versions} = SslOpts, Info, Renegotiation) -> @@ -107,7 +119,7 @@ cookie(Key, Address, Port, #client_hello{client_version = {Major, Minor}, <<?BYTE(Major), ?BYTE(Minor)>>, Random, SessionId, CipherSuites, CompressionMethods], crypto:hmac(sha, Key, CookieData). - +%%-------------------------------------------------------------------- -spec hello_verify_request(binary(), dtls_record:dtls_version()) -> #hello_verify_request{}. %% %% Description: Creates a hello verify request message sent by server to @@ -117,11 +129,8 @@ hello_verify_request(Cookie, Version) -> #hello_verify_request{protocol_version = Version, cookie = Cookie}. %%-------------------------------------------------------------------- - -encode_handshake(Handshake, Version, Seq) -> - {MsgType, Bin} = enc_handshake(Handshake, Version), - Len = byte_size(Bin), - [MsgType, ?uint24(Len), ?uint16(Seq), ?uint24(0), ?uint24(Len), Bin]. +%%% Handshake encoding +%%-------------------------------------------------------------------- fragment_handshake(Bin, _) when is_binary(Bin)-> %% This is the change_cipher_spec not a "real handshake" but part of the flight @@ -129,10 +138,15 @@ fragment_handshake(Bin, _) when is_binary(Bin)-> fragment_handshake([MsgType, Len, Seq, _, Len, Bin], Size) -> Bins = bin_fragments(Bin, Size), handshake_fragments(MsgType, Seq, Len, Bins, []). +encode_handshake(Handshake, Version, Seq) -> + {MsgType, Bin} = enc_handshake(Handshake, Version), + Len = byte_size(Bin), + [MsgType, ?uint24(Len), ?uint16(Seq), ?uint24(0), ?uint24(Len), Bin]. + +%%-------------------------------------------------------------------- +%%% Handshake decodeing +%%-------------------------------------------------------------------- -handshake_bin([Type, Length, Data], Seq) -> - handshake_bin(Type, Length, Seq, Data). - %%-------------------------------------------------------------------- -spec get_dtls_handshake(dtls_record:dtls_version(), binary(), #protocol_buffers{}) -> {[dtls_handshake()], #protocol_buffers{}}. @@ -147,16 +161,19 @@ get_dtls_handshake(Version, Fragment, ProtocolBuffers) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -handle_client_hello(Version, #client_hello{session_id = SugesstedId, - cipher_suites = CipherSuites, - compression_methods = Compressions, - random = Random, - extensions = - #hello_extensions{elliptic_curves = Curves, - signature_algs = ClientHashSigns} = HelloExt}, +handle_client_hello(Version, + #client_hello{session_id = SugesstedId, + cipher_suites = CipherSuites, + compression_methods = Compressions, + random = Random, + extensions = + #hello_extensions{elliptic_curves = Curves, + signature_algs = ClientHashSigns} + = HelloExt}, #ssl_options{versions = Versions, signature_algs = SupportedHashSigns} = SslOpts, - {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert, _}, Renegotiation) -> + {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert, _}, + Renegotiation) -> case dtls_record:is_acceptable_version(Version, Versions) of true -> TLSVersion = dtls_v1:corresponding_tls_version(Version), @@ -164,14 +181,15 @@ handle_client_hello(Version, #client_hello{session_id = SugesstedId, ClientHashSigns, SupportedHashSigns, Cert,TLSVersion), ECCCurve = ssl_handshake:select_curve(Curves, ssl_handshake:supported_ecc(TLSVersion)), {Type, #session{cipher_suite = CipherSuite} = Session1} - = ssl_handshake:select_session(SugesstedId, CipherSuites, AvailableHashSigns, Compressions, + = ssl_handshake:select_session(SugesstedId, CipherSuites, + AvailableHashSigns, Compressions, Port, Session0#session{ecc = ECCCurve}, TLSVersion, SslOpts, Cache, CacheCb, Cert), case CipherSuite of no_suite -> ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY); _ -> - {KeyExAlg,_,_,_} = ssl_cipher:suite_definition(CipherSuite), + #{key_exchange := KeyExAlg} = ssl_cipher:suite_definition(CipherSuite), case ssl_handshake:select_hashsign(ClientHashSigns, Cert, KeyExAlg, SupportedHashSigns, TLSVersion) of #alert{} = Alert -> @@ -190,7 +208,8 @@ handle_client_hello_extensions(Version, Type, Random, CipherSuites, HelloExt, SslOpts, Session0, ConnectionStates0, Renegotiation, HashSign) -> try ssl_handshake:handle_client_hello_extensions(dtls_record, Random, CipherSuites, HelloExt, dtls_v1:corresponding_tls_version(Version), - SslOpts, Session0, ConnectionStates0, Renegotiation) of + SslOpts, Session0, + ConnectionStates0, Renegotiation) of #alert{} = Alert -> Alert; {Session, ConnectionStates, Protocol, ServerHelloExt} -> @@ -212,7 +231,7 @@ handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, end. -%%%%%%% Encodeing %%%%%%%%%%%%% +%%-------------------------------------------------------------------- enc_handshake(#hello_verify_request{protocol_version = {Major, Minor}, cookie = Cookie}, _Version) -> @@ -220,7 +239,6 @@ enc_handshake(#hello_verify_request{protocol_version = {Major, Minor}, {?HELLO_VERIFY_REQUEST, <<?BYTE(Major), ?BYTE(Minor), ?BYTE(CookieLength), Cookie:CookieLength/binary>>}; - enc_handshake(#hello_request{}, _Version) -> {?HELLO_REQUEST, <<>>}; enc_handshake(#client_hello{client_version = {Major, Minor}, @@ -243,19 +261,29 @@ enc_handshake(#client_hello{client_version = {Major, Minor}, ?BYTE(CookieLength), Cookie/binary, ?UINT16(CsLength), BinCipherSuites/binary, ?BYTE(CmLength), BinCompMethods/binary, ExtensionsBin/binary>>}; - enc_handshake(#server_hello{} = HandshakeMsg, Version) -> {Type, <<?BYTE(Major), ?BYTE(Minor), Rest/binary>>} = ssl_handshake:encode_handshake(HandshakeMsg, Version), {DTLSMajor, DTLSMinor} = dtls_v1:corresponding_dtls_version({Major, Minor}), {Type, <<?BYTE(DTLSMajor), ?BYTE(DTLSMinor), Rest/binary>>}; - enc_handshake(HandshakeMsg, Version) -> ssl_handshake:encode_handshake(HandshakeMsg, dtls_v1:corresponding_tls_version(Version)). +handshake_bin(#handshake_fragment{ + type = Type, + length = Len, + message_seq = Seq, + fragment_length = Len, + fragment_offset = 0, + fragment = Fragment}) -> + handshake_bin(Type, Len, Seq, Fragment). +handshake_bin(Type, Length, Seq, FragmentData) -> + <<?BYTE(Type), ?UINT24(Length), + ?UINT16(Seq), ?UINT24(0), ?UINT24(Length), + FragmentData:Length/binary>>. + bin_fragments(Bin, Size) -> bin_fragments(Bin, size(Bin), Size, 0, []). - bin_fragments(Bin, BinSize, FragSize, Offset, Fragments) -> case (BinSize - Offset - FragSize) > 0 of true -> @@ -279,7 +307,7 @@ address_to_bin({A,B,C,D}, Port) -> address_to_bin({A,B,C,D,E,F,G,H}, Port) -> <<A:16,B:16,C:16,D:16,E:16,F:16,G:16,H:16,Port:16>>. -%%%%%%% Decodeing %%%%%%%%%%%%% +%%-------------------------------------------------------------------- handle_fragments(Version, FragmentData, Buffers0, Acc) -> Fragments = decode_handshake_fragments(FragmentData), @@ -322,7 +350,6 @@ decode_handshake(_Version, ?CLIENT_HELLO, <<?UINT24(_), ?UINT16(_), compression_methods = Comp_methods, extensions = DecodedExtensions }; - decode_handshake(_Version, ?HELLO_VERIFY_REQUEST, <<?UINT24(_), ?UINT16(_), ?UINT24(_), ?UINT24(_), ?BYTE(Major), ?BYTE(Minor), @@ -330,7 +357,6 @@ decode_handshake(_Version, ?HELLO_VERIFY_REQUEST, <<?UINT24(_), ?UINT16(_), Cookie:CookieLength/binary>>) -> #hello_verify_request{protocol_version = {Major, Minor}, cookie = Cookie}; - decode_handshake(Version, Tag, <<?UINT24(_), ?UINT16(_), ?UINT24(_), ?UINT24(_), Msg/binary>>) -> %% DTLS specifics stripped @@ -370,9 +396,10 @@ reassemble(Version, #handshake_fragment{message_seq = Seq} = Fragment, end; reassemble(_, #handshake_fragment{message_seq = FragSeq} = Fragment, #protocol_buffers{dtls_handshake_next_seq = Seq, - dtls_handshake_later_fragments = LaterFragments} = Buffers0) when FragSeq > Seq-> - {more_data, - Buffers0#protocol_buffers{dtls_handshake_later_fragments = [Fragment | LaterFragments]}}; + dtls_handshake_later_fragments = LaterFragments} + = Buffers0) when FragSeq > Seq-> + {more_data, + Buffers0#protocol_buffers{dtls_handshake_later_fragments = [Fragment | LaterFragments]}}; reassemble(_, _, Buffers) -> %% Disregard fragments FragSeq < Seq {more_data, Buffers}. @@ -396,26 +423,6 @@ merge_fragment(Frag0, [Frag1 | Rest]) -> Frag -> merge_fragment(Frag, Rest) end. - -is_complete_handshake(#handshake_fragment{length = Length, fragment_length = Length}) -> - true; -is_complete_handshake(_) -> - false. - -next_fragments(LaterFragments) -> - case lists:keysort(#handshake_fragment.message_seq, LaterFragments) of - [] -> - {[], []}; - [#handshake_fragment{message_seq = Seq} | _] = Fragments -> - split_frags(Fragments, Seq, []) - end. - -split_frags([#handshake_fragment{message_seq = Seq} = Frag | Rest], Seq, Acc) -> - split_frags(Rest, Seq, [Frag | Acc]); -split_frags(Frags, _, Acc) -> - {lists:reverse(Acc), Frags}. - - %% Duplicate merge_fragments(#handshake_fragment{ fragment_offset = PreviousOffSet, @@ -486,17 +493,26 @@ merge_fragments(#handshake_fragment{ %% No merge there is a gap merge_fragments(Previous, Current) -> [Previous, Current]. - -handshake_bin(#handshake_fragment{ - type = Type, - length = Len, - message_seq = Seq, - fragment_length = Len, - fragment_offset = 0, - fragment = Fragment}) -> - handshake_bin(Type, Len, Seq, Fragment). -handshake_bin(Type, Length, Seq, FragmentData) -> - <<?BYTE(Type), ?UINT24(Length), - ?UINT16(Seq), ?UINT24(0), ?UINT24(Length), - FragmentData:Length/binary>>. +next_fragments(LaterFragments) -> + case lists:keysort(#handshake_fragment.message_seq, LaterFragments) of + [] -> + {[], []}; + [#handshake_fragment{message_seq = Seq} | _] = Fragments -> + split_frags(Fragments, Seq, []) + end. + +split_frags([#handshake_fragment{message_seq = Seq} = Frag | Rest], Seq, Acc) -> + split_frags(Rest, Seq, [Frag | Acc]); +split_frags(Frags, _, Acc) -> + {lists:reverse(Acc), Frags}. + +is_complete_handshake(#handshake_fragment{length = Length, fragment_length = Length}) -> + true; +is_complete_handshake(_) -> + false. + + + + + diff --git a/lib/ssl/src/dtls_record.erl b/lib/ssl/src/dtls_record.erl index 8a7f8c1d0a..2dcc6efc91 100644 --- a/lib/ssl/src/dtls_record.erl +++ b/lib/ssl/src/dtls_record.erl @@ -30,15 +30,17 @@ -include("ssl_cipher.hrl"). %% Handling of incoming data --export([get_dtls_records/2, init_connection_states/2]). +-export([get_dtls_records/2, init_connection_states/2, empty_connection_state/1]). -%% Decoding --export([decode_cipher_text/2]). +-export([save_current_connection_state/2, next_epoch/2, get_connection_state_by_epoch/3, replay_detect/2, + init_connection_state_seq/2, current_connection_state_epoch/2]). %% Encoding -export([encode_handshake/4, encode_alert_record/3, - encode_change_cipher_spec/3, encode_data/3]). --export([encode_plain_text/5]). + encode_change_cipher_spec/3, encode_data/3, encode_plain_text/5]). + +%% Decoding +-export([decode_cipher_text/2]). %% Protocol version handling -export([protocol_version/1, lowest_protocol_version/1, lowest_protocol_version/2, @@ -46,9 +48,6 @@ is_higher/2, supported_protocol_versions/0, is_acceptable_version/2, hello_version/2]). --export([save_current_connection_state/2, next_epoch/2, get_connection_state_by_epoch/3, replay_detect/2]). - --export([init_connection_state_seq/2, current_connection_state_epoch/2]). -export_type([dtls_version/0, dtls_atom_version/0]). @@ -60,7 +59,7 @@ -compile(inline). %%==================================================================== -%% Internal application API +%% Handling of incoming data %%==================================================================== %%-------------------------------------------------------------------- -spec init_connection_states(client | server, one_n_minus_one | zero_n | disabled) -> @@ -75,7 +74,7 @@ init_connection_states(Role, BeastMitigation) -> Initial = initial_connection_state(ConnectionEnd, BeastMitigation), Current = Initial#{epoch := 0}, InitialPending = ssl_record:empty_connection_state(ConnectionEnd, BeastMitigation), - Pending = InitialPending#{epoch => undefined, replay_window => init_replay_window(?REPLAY_WINDOW_SIZE)}, + Pending = empty_connection_state(InitialPending), #{saved_read => Current, current_read => Current, pending_read => Pending, @@ -83,6 +82,9 @@ init_connection_states(Role, BeastMitigation) -> current_write => Current, pending_write => Pending}. +empty_connection_state(Empty) -> + Empty#{epoch => undefined, replay_window => init_replay_window(?REPLAY_WINDOW_SIZE)}. + %%-------------------------------------------------------------------- -spec save_current_connection_state(ssl_record:connection_states(), read | write) -> ssl_record:connection_states(). @@ -133,6 +135,34 @@ set_connection_state_by_epoch(ReadState, Epoch, #{saved_read := #{epoch := Epoch States#{saved_read := ReadState}. %%-------------------------------------------------------------------- +-spec init_connection_state_seq(dtls_version(), ssl_record:connection_states()) -> + ssl_record:connection_state(). +%% +%% Description: Copy the read sequence number to the write sequence number +%% This is only valid for DTLS in the first client_hello +%%-------------------------------------------------------------------- +init_connection_state_seq({254, _}, + #{current_read := #{epoch := 0, sequence_number := Seq}, + current_write := #{epoch := 0} = Write} = ConnnectionStates0) -> + ConnnectionStates0#{current_write => Write#{sequence_number => Seq}}; +init_connection_state_seq(_, ConnnectionStates) -> + ConnnectionStates. + +%%-------------------------------------------------------- +-spec current_connection_state_epoch(ssl_record:connection_states(), read | write) -> + integer(). +%% +%% Description: Returns the epoch the connection_state record +%% that is currently defined as the current connection state. +%%-------------------------------------------------------------------- +current_connection_state_epoch(#{current_read := #{epoch := Epoch}}, + read) -> + Epoch; +current_connection_state_epoch(#{current_write := #{epoch := Epoch}}, + write) -> + Epoch. + +%%-------------------------------------------------------------------- -spec get_dtls_records(binary(), binary()) -> {[binary()], binary()} | #alert{}. %% %% Description: Given old buffer and new data from UDP/SCTP, packs up a records @@ -144,55 +174,10 @@ get_dtls_records(Data, <<>>) -> get_dtls_records(Data, Buffer) -> get_dtls_records_aux(list_to_binary([Buffer, Data]), []). -get_dtls_records_aux(<<?BYTE(?APPLICATION_DATA),?BYTE(MajVer),?BYTE(MinVer), - ?UINT16(Epoch), ?UINT48(SequenceNumber), - ?UINT16(Length), Data:Length/binary, Rest/binary>>, - Acc) -> - get_dtls_records_aux(Rest, [#ssl_tls{type = ?APPLICATION_DATA, - version = {MajVer, MinVer}, - epoch = Epoch, sequence_number = SequenceNumber, - fragment = Data} | Acc]); -get_dtls_records_aux(<<?BYTE(?HANDSHAKE),?BYTE(MajVer),?BYTE(MinVer), - ?UINT16(Epoch), ?UINT48(SequenceNumber), - ?UINT16(Length), - Data:Length/binary, Rest/binary>>, Acc) when MajVer >= 128 -> - get_dtls_records_aux(Rest, [#ssl_tls{type = ?HANDSHAKE, - version = {MajVer, MinVer}, - epoch = Epoch, sequence_number = SequenceNumber, - fragment = Data} | Acc]); -get_dtls_records_aux(<<?BYTE(?ALERT),?BYTE(MajVer),?BYTE(MinVer), - ?UINT16(Epoch), ?UINT48(SequenceNumber), - ?UINT16(Length), Data:Length/binary, - Rest/binary>>, Acc) -> - get_dtls_records_aux(Rest, [#ssl_tls{type = ?ALERT, - version = {MajVer, MinVer}, - epoch = Epoch, sequence_number = SequenceNumber, - fragment = Data} | Acc]); -get_dtls_records_aux(<<?BYTE(?CHANGE_CIPHER_SPEC),?BYTE(MajVer),?BYTE(MinVer), - ?UINT16(Epoch), ?UINT48(SequenceNumber), - ?UINT16(Length), Data:Length/binary, Rest/binary>>, - Acc) -> - get_dtls_records_aux(Rest, [#ssl_tls{type = ?CHANGE_CIPHER_SPEC, - version = {MajVer, MinVer}, - epoch = Epoch, sequence_number = SequenceNumber, - fragment = Data} | Acc]); -get_dtls_records_aux(<<0:1, _CT:7, ?BYTE(_MajVer), ?BYTE(_MinVer), - ?UINT16(Length), _/binary>>, - _Acc) when Length > ?MAX_CIPHER_TEXT_LENGTH -> - ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW); - -get_dtls_records_aux(<<1:1, Length0:15, _/binary>>,_Acc) - when Length0 > ?MAX_CIPHER_TEXT_LENGTH -> - ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW); - -get_dtls_records_aux(Data, Acc) -> - case size(Data) =< ?MAX_CIPHER_TEXT_LENGTH + ?INITIAL_BYTES of - true -> - {lists:reverse(Acc), Data}; - false -> - ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE) - end. +%%==================================================================== +%% Encoding DTLS records +%%==================================================================== %%-------------------------------------------------------------------- -spec encode_handshake(iolist(), dtls_version(), integer(), ssl_record:connection_states()) -> @@ -241,11 +226,19 @@ encode_plain_text(Type, Version, Epoch, Data, ConnectionStates) -> {CipherText, Write} = encode_dtls_cipher_text(Type, Version, CipherFragment, Write1), {CipherText, set_connection_state_by_epoch(Write, Epoch, ConnectionStates, write)}. +%%==================================================================== +%% Decoding +%%==================================================================== decode_cipher_text(#ssl_tls{epoch = Epoch} = CipherText, ConnnectionStates0) -> ReadState = get_connection_state_by_epoch(Epoch, ConnnectionStates0, read), decode_cipher_text(CipherText, ReadState, ConnnectionStates0). + +%%==================================================================== +%% Protocol version handling +%%==================================================================== + %%-------------------------------------------------------------------- -spec protocol_version(dtls_atom_version() | dtls_version()) -> dtls_version() | dtls_atom_version(). @@ -377,35 +370,6 @@ supported_protocol_versions([_|_] = Vsns) -> is_acceptable_version(Version, Versions) -> lists:member(Version, Versions). - -%%-------------------------------------------------------------------- --spec init_connection_state_seq(dtls_version(), ssl_record:connection_states()) -> - ssl_record:connection_state(). -%% -%% Description: Copy the read sequence number to the write sequence number -%% This is only valid for DTLS in the first client_hello -%%-------------------------------------------------------------------- -init_connection_state_seq({254, _}, - #{current_read := #{epoch := 0, sequence_number := Seq}, - current_write := #{epoch := 0} = Write} = ConnnectionStates0) -> - ConnnectionStates0#{current_write => Write#{sequence_number => Seq}}; -init_connection_state_seq(_, ConnnectionStates) -> - ConnnectionStates. - -%%-------------------------------------------------------- --spec current_connection_state_epoch(ssl_record:connection_states(), read | write) -> - integer(). -%% -%% Description: Returns the epoch the connection_state record -%% that is currently defined as the current connection state. -%%-------------------------------------------------------------------- -current_connection_state_epoch(#{current_read := #{epoch := Epoch}}, - read) -> - Epoch; -current_connection_state_epoch(#{current_write := #{epoch := Epoch}}, - write) -> - Epoch. - -spec hello_version(dtls_version(), [dtls_version()]) -> dtls_version(). hello_version(Version, Versions) -> case dtls_v1:corresponding_tls_version(Version) of @@ -434,15 +398,93 @@ initial_connection_state(ConnectionEnd, BeastMitigation) -> server_verify_data => undefined }. -lowest_list_protocol_version(Ver, []) -> - Ver; -lowest_list_protocol_version(Ver1, [Ver2 | Rest]) -> - lowest_list_protocol_version(lowest_protocol_version(Ver1, Ver2), Rest). +get_dtls_records_aux(<<?BYTE(?APPLICATION_DATA),?BYTE(MajVer),?BYTE(MinVer), + ?UINT16(Epoch), ?UINT48(SequenceNumber), + ?UINT16(Length), Data:Length/binary, Rest/binary>>, + Acc) -> + get_dtls_records_aux(Rest, [#ssl_tls{type = ?APPLICATION_DATA, + version = {MajVer, MinVer}, + epoch = Epoch, sequence_number = SequenceNumber, + fragment = Data} | Acc]); +get_dtls_records_aux(<<?BYTE(?HANDSHAKE),?BYTE(MajVer),?BYTE(MinVer), + ?UINT16(Epoch), ?UINT48(SequenceNumber), + ?UINT16(Length), + Data:Length/binary, Rest/binary>>, Acc) when MajVer >= 128 -> + get_dtls_records_aux(Rest, [#ssl_tls{type = ?HANDSHAKE, + version = {MajVer, MinVer}, + epoch = Epoch, sequence_number = SequenceNumber, + fragment = Data} | Acc]); +get_dtls_records_aux(<<?BYTE(?ALERT),?BYTE(MajVer),?BYTE(MinVer), + ?UINT16(Epoch), ?UINT48(SequenceNumber), + ?UINT16(Length), Data:Length/binary, + Rest/binary>>, Acc) -> + get_dtls_records_aux(Rest, [#ssl_tls{type = ?ALERT, + version = {MajVer, MinVer}, + epoch = Epoch, sequence_number = SequenceNumber, + fragment = Data} | Acc]); +get_dtls_records_aux(<<?BYTE(?CHANGE_CIPHER_SPEC),?BYTE(MajVer),?BYTE(MinVer), + ?UINT16(Epoch), ?UINT48(SequenceNumber), + ?UINT16(Length), Data:Length/binary, Rest/binary>>, + Acc) -> + get_dtls_records_aux(Rest, [#ssl_tls{type = ?CHANGE_CIPHER_SPEC, + version = {MajVer, MinVer}, + epoch = Epoch, sequence_number = SequenceNumber, + fragment = Data} | Acc]); -highest_list_protocol_version(Ver, []) -> - Ver; -highest_list_protocol_version(Ver1, [Ver2 | Rest]) -> - highest_list_protocol_version(highest_protocol_version(Ver1, Ver2), Rest). +get_dtls_records_aux(<<0:1, _CT:7, ?BYTE(_MajVer), ?BYTE(_MinVer), + ?UINT16(Length), _/binary>>, + _Acc) when Length > ?MAX_CIPHER_TEXT_LENGTH -> + ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW); + +get_dtls_records_aux(<<1:1, Length0:15, _/binary>>,_Acc) + when Length0 > ?MAX_CIPHER_TEXT_LENGTH -> + ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW); + +get_dtls_records_aux(Data, Acc) -> + case size(Data) =< ?MAX_CIPHER_TEXT_LENGTH + ?INITIAL_BYTES of + true -> + {lists:reverse(Acc), Data}; + false -> + ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE) + end. +%%-------------------------------------------------------------------- + +init_replay_window(Size) -> + #{size => Size, + top => Size, + bottom => 0, + mask => 0 bsl 64 + }. + +replay_detect(#ssl_tls{sequence_number = SequenceNumber}, #{replay_window := Window}) -> + is_replay(SequenceNumber, Window). + + +is_replay(SequenceNumber, #{bottom := Bottom}) when SequenceNumber < Bottom -> + true; +is_replay(SequenceNumber, #{size := Size, + top := Top, + bottom := Bottom, + mask := Mask}) when (SequenceNumber >= Bottom) andalso (SequenceNumber =< Top) -> + Index = (SequenceNumber rem Size), + (Index band Mask) == 1; + +is_replay(_, _) -> + false. + +update_replay_window(SequenceNumber, #{replay_window := #{size := Size, + top := Top, + bottom := Bottom, + mask := Mask0} = Window0} = ConnectionStates) -> + NoNewBits = SequenceNumber - Top, + Index = SequenceNumber rem Size, + Mask = (Mask0 bsl NoNewBits) bor Index, + Window = Window0#{top => SequenceNumber, + bottom => Bottom + NoNewBits, + mask => Mask}, + ConnectionStates#{replay_window := Window}. + +%%-------------------------------------------------------------------- encode_dtls_cipher_text(Type, {MajVer, MinVer}, Fragment, #{epoch := Epoch, sequence_number := Seq} = WriteState) -> @@ -486,6 +528,7 @@ encode_plain_text(Type, Version, Fragment, #{compression_state := CompS0, ssl_cipher:cipher(BulkCipherAlgo, CipherS0, MAC, Fragment, TLSVersion), {CipherFragment, WriteState0#{cipher_state => CipherS1}}. +%%-------------------------------------------------------------------- decode_cipher_text(#ssl_tls{type = Type, version = Version, epoch = Epoch, sequence_number = Seq, @@ -537,6 +580,7 @@ decode_cipher_text(#ssl_tls{type = Type, version = Version, false -> ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) end. +%%-------------------------------------------------------------------- calc_mac_hash(Type, Version, #{mac_secret := MacSecret, security_parameters := #security_parameters{mac_algorithm = MacAlg}}, @@ -545,16 +589,6 @@ calc_mac_hash(Type, Version, #{mac_secret := MacSecret, mac_hash(Version, MacAlg, MacSecret, Epoch, SeqNo, Type, Length, Fragment). -highest_protocol_version() -> - highest_protocol_version(supported_protocol_versions()). - -lowest_protocol_version() -> - lowest_protocol_version(supported_protocol_versions()). - -sufficient_dtlsv1_2_crypto_support() -> - CryptoSupport = crypto:supports(), - proplists:get_bool(sha256, proplists:get_value(hashs, CryptoSupport)). - mac_hash({Major, Minor}, MacAlg, MacSecret, Epoch, SeqNo, Type, Length, Fragment) -> Value = [<<?UINT16(Epoch), ?UINT48(SeqNo), ?BYTE(Type), ?BYTE(Major), ?BYTE(Minor), ?UINT16(Length)>>, @@ -564,37 +598,25 @@ mac_hash({Major, Minor}, MacAlg, MacSecret, Epoch, SeqNo, Type, Length, Fragment calc_aad(Type, {MajVer, MinVer}, Epoch, SeqNo) -> <<?UINT16(Epoch), ?UINT48(SeqNo), ?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer)>>. -init_replay_window(Size) -> - #{size => Size, - top => Size, - bottom => 0, - mask => 0 bsl 64 - }. +%%-------------------------------------------------------------------- -replay_detect(#ssl_tls{sequence_number = SequenceNumber}, #{replay_window := Window}) -> - is_replay(SequenceNumber, Window). +lowest_list_protocol_version(Ver, []) -> + Ver; +lowest_list_protocol_version(Ver1, [Ver2 | Rest]) -> + lowest_list_protocol_version(lowest_protocol_version(Ver1, Ver2), Rest). +highest_list_protocol_version(Ver, []) -> + Ver; +highest_list_protocol_version(Ver1, [Ver2 | Rest]) -> + highest_list_protocol_version(highest_protocol_version(Ver1, Ver2), Rest). -is_replay(SequenceNumber, #{bottom := Bottom}) when SequenceNumber < Bottom -> - true; -is_replay(SequenceNumber, #{size := Size, - top := Top, - bottom := Bottom, - mask := Mask}) when (SequenceNumber >= Bottom) andalso (SequenceNumber =< Top) -> - Index = (SequenceNumber rem Size), - (Index band Mask) == 1; +highest_protocol_version() -> + highest_protocol_version(supported_protocol_versions()). -is_replay(_, _) -> - false. +lowest_protocol_version() -> + lowest_protocol_version(supported_protocol_versions()). + +sufficient_dtlsv1_2_crypto_support() -> + CryptoSupport = crypto:supports(), + proplists:get_bool(sha256, proplists:get_value(hashs, CryptoSupport)). -update_replay_window(SequenceNumber, #{replay_window := #{size := Size, - top := Top, - bottom := Bottom, - mask := Mask0} = Window0} = ConnectionStates) -> - NoNewBits = SequenceNumber - Top, - Index = SequenceNumber rem Size, - Mask = (Mask0 bsl NoNewBits) bor Index, - Window = Window0#{top => SequenceNumber, - bottom => Bottom + NoNewBits, - mask => Mask}, - ConnectionStates#{replay_window := Window}. diff --git a/lib/ssl/src/dtls_socket.erl b/lib/ssl/src/dtls_socket.erl index 5f854fbb4b..0e4ab089dc 100644 --- a/lib/ssl/src/dtls_socket.erl +++ b/lib/ssl/src/dtls_socket.erl @@ -24,7 +24,7 @@ -export([send/3, listen/3, accept/3, connect/4, socket/4, setopts/3, getopts/3, getstat/3, peername/2, sockname/2, port/2, close/2]). --export([emulated_options/0, internal_inet_values/0, default_inet_values/0, default_cb_info/0]). +-export([emulated_options/0, emulated_options/1, internal_inet_values/0, default_inet_values/0, default_cb_info/0]). send(Transport, {{IP,Port},Socket}, Data) -> Transport:send(Socket, IP, Port, Data). @@ -133,6 +133,9 @@ port(Transport, Socket) -> emulated_options() -> [mode, active, packet, packet_size]. +emulated_options(Opts) -> + emulated_options(Opts, internal_inet_values(), default_inet_values()). + internal_inet_values() -> [{active, false}, {mode,binary}]. @@ -158,3 +161,29 @@ emulated_socket_options(InetValues, #socket_options{ packet_size = proplists:get_value(packet_size, InetValues, PacketSize), active = proplists:get_value(active, InetValues, Active) }. + +emulated_options([{mode, Value} = Opt |Opts], Inet, Emulated) -> + validate_inet_option(mode, Value), + emulated_options(Opts, Inet, [Opt | proplists:delete(mode, Emulated)]); +emulated_options([{header, _} = Opt | _], _, _) -> + throw({error, {options, {not_supported, Opt}}}); +emulated_options([{active, Value} = Opt |Opts], Inet, Emulated) -> + validate_inet_option(active, Value), + emulated_options(Opts, Inet, [Opt | proplists:delete(active, Emulated)]); +emulated_options([{packet, _} = Opt | _], _, _) -> + throw({error, {options, {not_supported, Opt}}}); +emulated_options([{packet_size, _} = Opt | _], _, _) -> + throw({error, {options, {not_supported, Opt}}}); +emulated_options([Opt|Opts], Inet, Emulated) -> + emulated_options(Opts, [Opt|Inet], Emulated); +emulated_options([], Inet,Emulated) -> + {Inet, Emulated}. + +validate_inet_option(mode, Value) + when Value =/= list, Value =/= binary -> + throw({error, {options, {mode,Value}}}); +validate_inet_option(active, Value) + when Value =/= true, Value =/= false, Value =/= once -> + throw({error, {options, {active,Value}}}); +validate_inet_option(_, _) -> + ok. diff --git a/lib/ssl/src/dtls_udp_listener.erl b/lib/ssl/src/dtls_udp_listener.erl index c789a32087..c9e04767aa 100644 --- a/lib/ssl/src/dtls_udp_listener.erl +++ b/lib/ssl/src/dtls_udp_listener.erl @@ -35,7 +35,7 @@ -record(state, {port, - listner, + listener, dtls_options, emulated_options, dtls_msq_queues = kv_new(), @@ -81,7 +81,7 @@ init([Port, EmOpts, InetOptions, DTLSOptions]) -> first = true, dtls_options = DTLSOptions, emulated_options = EmOpts, - listner = Socket, + listener = Socket, close = false}} catch _:_ -> {error, closed} @@ -91,7 +91,7 @@ handle_call({accept, _}, _, #state{close = true} = State) -> handle_call({accept, Accepter}, From, #state{first = true, accepters = Accepters, - listner = Socket} = State0) -> + listener = Socket} = State0) -> next_datagram(Socket), State = State0#state{first = false, accepters = queue:in({Accepter, From}, Accepters)}, @@ -100,7 +100,7 @@ handle_call({accept, Accepter}, From, #state{first = true, handle_call({accept, Accepter}, From, #state{accepters = Accepters} = State0) -> State = State0#state{accepters = queue:in({Accepter, From}, Accepters)}, {noreply, State}; -handle_call(sockname, _, #state{listner = Socket} = State) -> +handle_call(sockname, _, #state{listener = Socket} = State) -> Reply = inet:sockname(Socket), {reply, Reply, State}; handle_call(close, _, #state{dtls_processes = Processes, @@ -114,7 +114,7 @@ handle_call(close, _, #state{dtls_processes = Processes, end, queue:to_list(Accepters)), {reply, ok, State#state{close = true, accepters = queue:new()}} end; -handle_call({get_sock_opts, {SocketOptNames, EmOptNames}}, _, #state{listner = Socket, +handle_call({get_sock_opts, {SocketOptNames, EmOptNames}}, _, #state{listener = Socket, emulated_options = EmOpts} = State) -> case get_socket_opts(Socket, SocketOptNames) of {ok, Opts} -> @@ -125,7 +125,7 @@ handle_call({get_sock_opts, {SocketOptNames, EmOptNames}}, _, #state{listner = S handle_call(get_all_opts, _, #state{dtls_options = DTLSOptions, emulated_options = EmOpts} = State) -> {reply, {ok, EmOpts, DTLSOptions}, State}; -handle_call({set_sock_opts, {SocketOpts, NewEmOpts}}, _, #state{listner = Socket, emulated_options = EmOpts0} = State) -> +handle_call({set_sock_opts, {SocketOpts, NewEmOpts}}, _, #state{listener = Socket, emulated_options = EmOpts0} = State) -> set_socket_opts(Socket, SocketOpts), EmOpts = do_set_emulated_opts(NewEmOpts, EmOpts0), {reply, ok, State#state{emulated_options = EmOpts}}. @@ -134,7 +134,7 @@ handle_cast({active_once, Client, Pid}, State0) -> State = handle_active_once(Client, Pid, State0), {noreply, State}. -handle_info({udp, Socket, IP, InPortNo, _} = Msg, #state{listner = Socket} = State0) -> +handle_info({udp, Socket, IP, InPortNo, _} = Msg, #state{listener = Socket} = State0) -> State = handle_datagram({IP, InPortNo}, Msg, State0), next_datagram(Socket), {noreply, State}; @@ -142,11 +142,11 @@ handle_info({udp, Socket, IP, InPortNo, _} = Msg, #state{listner = Socket} = Sta %% UDP socket does not have a connection and should not receive an econnreset %% This does however happens on on some windows versions. Just ignoring it %% appears to make things work as expected! -handle_info({udp_error, Socket, econnreset = Error}, #state{listner = Socket} = State) -> +handle_info({udp_error, Socket, econnreset = Error}, #state{listener = Socket} = State) -> Report = io_lib:format("Ignore SSL UDP Listener: Socket error: ~p ~n", [Error]), error_logger:info_report(Report), {noreply, State}; -handle_info({udp_error, Socket, Error}, #state{listner = Socket} = State) -> +handle_info({udp_error, Socket, Error}, #state{listener = Socket} = State) -> Report = io_lib:format("SSL UDP Listener shutdown: Socket error: ~p ~n", [Error]), error_logger:info_report(Report), {noreply, State#state{close=true}}; @@ -225,10 +225,10 @@ setup_new_connection(User, From, Client, Msg, #state{dtls_processes = Processes, dtls_msq_queues = MsgQueues, dtls_options = DTLSOpts, port = Port, - listner = Socket, + listener = Socket, emulated_options = EmOpts} = State) -> ConnArgs = [server, "localhost", Port, {self(), {Client, Socket}}, - {DTLSOpts, EmOpts, udp_listner}, User, dtls_socket:default_cb_info()], + {DTLSOpts, EmOpts, udp_listener}, User, dtls_socket:default_cb_info()], case dtls_connection_sup:start_child(ConnArgs) of {ok, Pid} -> erlang:monitor(process, Pid), diff --git a/lib/ssl/src/inet6_tls_dist.erl b/lib/ssl/src/inet6_tls_dist.erl index ffd7296f93..96ce4d493a 100644 --- a/lib/ssl/src/inet6_tls_dist.erl +++ b/lib/ssl/src/inet6_tls_dist.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2015. All Rights Reserved. +%% Copyright Ericsson AB 2015-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -21,7 +21,8 @@ %% -module(inet6_tls_dist). --export([childspecs/0, listen/1, accept/1, accept_connection/5, +-export([childspecs/0]). +-export([listen/1, accept/1, accept_connection/5, setup/5, close/1, select/1]). childspecs() -> @@ -43,4 +44,4 @@ setup(Node, Type, MyNode, LongOrShortNames,SetupTime) -> inet_tls_dist:gen_setup(inet6_tcp, Node, Type, MyNode, LongOrShortNames,SetupTime). close(Socket) -> - inet_tls_dist:close(Socket). + inet_tls_dist:gen_close(inet6_tcp, Socket). diff --git a/lib/ssl/src/inet_tls_dist.erl b/lib/ssl/src/inet_tls_dist.erl index 0da4b3587f..8e605bec65 100644 --- a/lib/ssl/src/inet_tls_dist.erl +++ b/lib/ssl/src/inet_tls_dist.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2016. All Rights Reserved. +%% Copyright Ericsson AB 2011-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -21,17 +21,26 @@ %% -module(inet_tls_dist). --export([childspecs/0, listen/1, accept/1, accept_connection/5, +-export([childspecs/0]). +-export([listen/1, accept/1, accept_connection/5, setup/5, close/1, select/1, is_node_name/1]). %% Generalized dist API -export([gen_listen/2, gen_accept/2, gen_accept_connection/6, - gen_setup/6, gen_select/2]). + gen_setup/6, gen_close/2, gen_select/2]). + +-export([split_node/1, nodelay/0]). + +-export([dbg/0]). % Debug -include_lib("kernel/include/net_address.hrl"). -include_lib("kernel/include/dist.hrl"). -include_lib("kernel/include/dist_util.hrl"). +-include("ssl_api.hrl"). + +%% ------------------------------------------------------------------------- + childspecs() -> {ok, [{ssl_dist_sup,{ssl_dist_sup, start_link, []}, permanent, infinity, supervisor, [ssl_dist_sup]}]}. @@ -40,123 +49,398 @@ select(Node) -> gen_select(inet_tcp, Node). gen_select(Driver, Node) -> - case split_node(atom_to_list(Node), $@, []) of - [_, Host] -> - case inet:getaddr(Host, Driver:family()) of + case split_node(Node) of + false -> + false; + Host -> + case Driver:getaddr(Host) of {ok, _} -> true; _ -> false - end; - _ -> - false + end end. -is_node_name(Node) when is_atom(Node) -> - select(Node); -is_node_name(_) -> - false. +%% ------------------------------------------------------------------------- + +is_node_name(Node) -> + case split_node(Node) of + false -> + false; + _Host -> + true + end. + +%% ------------------------------------------------------------------------- + +hs_data_common(#sslsocket{pid = DistCtrl} = SslSocket) -> + #hs_data{ + f_send = + fun (Ctrl, Packet) when Ctrl == DistCtrl -> + f_send(SslSocket, Packet) + end, + f_recv = + fun (Ctrl, Length, Timeout) when Ctrl == DistCtrl -> + f_recv(SslSocket, Length, Timeout) + end, + f_setopts_pre_nodeup = + fun (Ctrl) when Ctrl == DistCtrl -> + f_setopts_pre_nodeup(SslSocket) + end, + f_setopts_post_nodeup = + fun (Ctrl) when Ctrl == DistCtrl -> +%%% sys:trace(Ctrl, true), + f_setopts_post_nodeup(SslSocket) + end, + f_getll = + fun (Ctrl) when Ctrl == DistCtrl -> + f_getll(DistCtrl) + end, + f_address = + fun (Ctrl, Node) when Ctrl == DistCtrl -> + f_address(SslSocket, Node) + end, + mf_tick = + fun (Ctrl) when Ctrl == DistCtrl -> + mf_tick(DistCtrl) + end, + mf_getstat = + fun (Ctrl) when Ctrl == DistCtrl -> + mf_getstat(SslSocket) + end, + mf_setopts = + fun (Ctrl, Opts) when Ctrl == DistCtrl -> + mf_setopts(SslSocket, Opts) + end, + mf_getopts = + fun (Ctrl, Opts) when Ctrl == DistCtrl -> + mf_getopts(SslSocket, Opts) + end, + f_handshake_complete = + fun (Ctrl, Node, DHandle) when Ctrl == DistCtrl -> + f_handshake_complete(DistCtrl, Node, DHandle) + end}. + +f_send(SslSocket, Packet) -> + ssl:send(SslSocket, Packet). + +f_recv(SslSocket, Length, Timeout) -> + case ssl:recv(SslSocket, Length, Timeout) of + {ok, Bin} when is_binary(Bin) -> + {ok, binary_to_list(Bin)}; + Other -> + Other + end. + +f_setopts_pre_nodeup(_SslSocket) -> + ok. + +f_setopts_post_nodeup(_SslSocket) -> + ok. + +f_getll(DistCtrl) -> + {ok, DistCtrl}. + +f_address(SslSocket, Node) -> + case ssl:peername(SslSocket) of + {ok, Address} -> + case split_node(Node) of + false -> + {error, no_node}; + Host -> + #net_address{ + address=Address, host=Host, + protocol=tls, family=inet} + end + end. + +mf_tick(DistCtrl) -> + DistCtrl ! tick, + ok. + +mf_getstat(SslSocket) -> + case ssl:getstat( + SslSocket, [recv_cnt, send_cnt, send_pend]) of + {ok, Stat} -> + split_stat(Stat,0,0,0); + Error -> + Error + end. + +mf_setopts(SslSocket, Opts) -> + case setopts_filter(Opts) of + [] -> + ssl:setopts(SslSocket, Opts); + Opts1 -> + {error, {badopts,Opts1}} + end. + +mf_getopts(SslSocket, Opts) -> + ssl:getopts(SslSocket, Opts). + +f_handshake_complete(DistCtrl, Node, DHandle) -> + ssl_connection:handshake_complete(DistCtrl, Node, DHandle). + + +setopts_filter(Opts) -> + [Opt || {K,_} = Opt <- Opts, + K =:= active orelse K =:= deliver orelse K =:= packet]. + +split_stat([{recv_cnt, R}|Stat], _, W, P) -> + split_stat(Stat, R, W, P); +split_stat([{send_cnt, W}|Stat], R, _, P) -> + split_stat(Stat, R, W, P); +split_stat([{send_pend, P}|Stat], R, W, _) -> + split_stat(Stat, R, W, P); +split_stat([], R, W, P) -> + {ok, R, W, P}. + +%% ------------------------------------------------------------------------- listen(Name) -> gen_listen(inet_tcp, Name). gen_listen(Driver, Name) -> - ssl_tls_dist_proxy:listen(Driver, Name). + case inet_tcp_dist:gen_listen(Driver, Name) of + {ok, {Socket, Address, Creation}} -> + inet:setopts(Socket, [{packet, 4}]), + {ok, {Socket, Address#net_address{protocol=tls}, Creation}}; + Other -> + Other + end. + +%% ------------------------------------------------------------------------- accept(Listen) -> gen_accept(inet_tcp, Listen). gen_accept(Driver, Listen) -> - ssl_tls_dist_proxy:accept(Driver, Listen). + Kernel = self(), + monitor_pid( + spawn_opt( + fun () -> + accept_loop(Driver, Listen, Kernel) + end, + [link, {priority, max}])). -accept_connection(AcceptPid, Socket, MyNode, Allowed, SetupTime) -> - gen_accept_connection(inet_tcp, AcceptPid, Socket, MyNode, Allowed, SetupTime). +accept_loop(Driver, Listen, Kernel) -> + case Driver:accept(Listen) of + {ok, Socket} -> + Opts = get_ssl_options(server), + wait_for_code_server(), + case ssl:ssl_accept( + Socket, [{active, false}, {packet, 4}] ++ Opts, + net_kernel:connecttime()) of + {ok, #sslsocket{pid = DistCtrl} = SslSocket} -> + monitor_pid(DistCtrl), + trace( + Kernel ! + {accept, self(), DistCtrl, + Driver:family(), tls}), + receive + {Kernel, controller, Pid} -> + ok = ssl:controlling_process(SslSocket, Pid), + trace( + Pid ! {self(), controller}); + {Kernel, unsupported_protocol} -> + exit(trace(unsupported_protocol)) + end, + accept_loop(Driver, Listen, Kernel); + {error, {options, _}} = Error -> + %% Bad options: that's probably our fault. + %% Let's log that. + error_logger:error_msg( + "Cannot accept TLS distribution connection: ~s~n", + [ssl:format_error(Error)]), + _ = trace(Error), + gen_tcp:close(Socket); + Other -> + _ = trace(Other), + gen_tcp:close(Socket) + end; + Error -> + exit(trace(Error)) + end, + accept_loop(Driver, Listen, Kernel). + +wait_for_code_server() -> + %% This is an ugly hack. Upgrading a socket to TLS requires the + %% crypto module to be loaded. Loading the crypto module triggers + %% its on_load function, which calls code:priv_dir/1 to find the + %% directory where its NIF library is. However, distribution is + %% started earlier than the code server, so the code server is not + %% necessarily started yet, and code:priv_dir/1 might fail because + %% of that, if we receive an incoming connection on the + %% distribution port early enough. + %% + %% If the on_load function of a module fails, the module is + %% unloaded, and the function call that triggered loading it fails + %% with 'undef', which is rather confusing. + %% + %% Thus, the accept process will terminate, and be + %% restarted by ssl_dist_sup. However, it won't have any memory + %% of being asked by net_kernel to listen for incoming + %% connections. Hence, the node will believe that it's open for + %% distribution, but it actually isn't. + %% + %% So let's avoid that by waiting for the code server to start. + case whereis(code_server) of + undefined -> + timer:sleep(10), + wait_for_code_server(); + Pid when is_pid(Pid) -> + ok + end. -gen_accept_connection(Driver, AcceptPid, Socket, MyNode, Allowed, SetupTime) -> +%% ------------------------------------------------------------------------- + +accept_connection(AcceptPid, DistCtrl, MyNode, Allowed, SetupTime) -> + gen_accept_connection( + inet_tcp, AcceptPid, DistCtrl, MyNode, Allowed, SetupTime). + +gen_accept_connection( + Driver, AcceptPid, DistCtrl, MyNode, Allowed, SetupTime) -> Kernel = self(), - spawn_link(fun() -> do_accept(Driver, Kernel, AcceptPid, Socket, - MyNode, Allowed, SetupTime) end). + monitor_pid( + spawn_opt( + fun() -> + do_accept( + Driver, Kernel, AcceptPid, DistCtrl, + MyNode, Allowed, SetupTime) + end, + [link, {priority, max}])). + +do_accept(Driver, Kernel, AcceptPid, DistCtrl, MyNode, Allowed, SetupTime) -> + SslSocket = ssl_connection:get_sslsocket(DistCtrl), + receive + {AcceptPid, controller} -> + Timer = dist_util:start_timer(SetupTime), + case check_ip(Driver, SslSocket) of + true -> + HSData0 = hs_data_common(SslSocket), + HSData = + HSData0#hs_data{ + kernel_pid = Kernel, + this_node = MyNode, + socket = DistCtrl, + timer = Timer, + this_flags = 0, + allowed = Allowed}, + link(DistCtrl), + dist_util:handshake_other_started(trace(HSData)); + {false,IP} -> + error_logger:error_msg( + "** Connection attempt from " + "disallowed IP ~w ** ~n", [IP]), + ?shutdown2(no_node, trace({disallowed, IP})) + end + end. -setup(Node, Type, MyNode, LongOrShortNames,SetupTime) -> - gen_setup(inet_tcp, Node, Type, MyNode, LongOrShortNames,SetupTime). -gen_setup(Driver, Node, Type, MyNode, LongOrShortNames,SetupTime) -> + +setup(Node, Type, MyNode, LongOrShortNames, SetupTime) -> + gen_setup(inet_tcp, Node, Type, MyNode, LongOrShortNames, SetupTime). + +gen_setup(Driver, Node, Type, MyNode, LongOrShortNames, SetupTime) -> Kernel = self(), - spawn_opt(fun() -> do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) end, [link, {priority, max}]). - + monitor_pid( + spawn_opt( + fun() -> + do_setup( + Driver, Kernel, Node, Type, + MyNode, LongOrShortNames, SetupTime) + end, + [link, {priority, max}])). + do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) -> [Name, Address] = splitnode(Driver, Node, LongOrShortNames), - case inet:getaddr(Address, Driver:family()) of + case Driver:getaddr(Address) of {ok, Ip} -> - Timer = dist_util:start_timer(SetupTime), + Timer = trace(dist_util:start_timer(SetupTime)), ErlEpmd = net_kernel:epmd_module(), case ErlEpmd:port_please(Name, Ip) of {port, TcpPort, Version} -> - ?trace("port_please(~p) -> version ~p~n", - [Node,Version]), + Opts = + trace( + connect_options( + [{server_name_indication, atom_to_list(Node)} + |get_ssl_options(client)])), dist_util:reset_timer(Timer), - case ssl_tls_dist_proxy:connect(Driver, Ip, TcpPort) of - {ok, Socket} -> - HSData = connect_hs_data(Kernel, Node, MyNode, Socket, - Timer, Version, Ip, TcpPort, Address, - Type), - dist_util:handshake_we_started(HSData); + case ssl:connect( + Address, TcpPort, + [binary, {active, false}, {packet, 4}, + Driver:family(), nodelay()] ++ Opts, + net_kernel:connecttime()) of + {ok, #sslsocket{pid = DistCtrl} = SslSocket} -> + monitor_pid(DistCtrl), + ok = ssl:controlling_process(SslSocket, self()), + HSData0 = hs_data_common(SslSocket), + HSData = + HSData0#hs_data{ + kernel_pid = Kernel, + other_node = Node, + this_node = MyNode, + socket = DistCtrl, + timer = Timer, + this_flags = 0, + other_version = Version, + request_type = Type}, + link(DistCtrl), + dist_util:handshake_we_started(trace(HSData)); Other -> %% Other Node may have closed since %% port_please ! - ?trace("other node (~p) " - "closed since port_please.~n", - [Node]), - ?shutdown2(Node, {shutdown, {connect_failed, Other}}) + ?shutdown2( + Node, + trace( + {ssl_connect_failed, Ip, TcpPort, Other})) end; Other -> - ?trace("port_please (~p) " - "failed.~n", [Node]), - ?shutdown2(Node, {shutdown, {port_please_failed, Other}}) + ?shutdown2( + Node, + trace( + {port_please_failed, ErlEpmd, Name, Ip, Other})) end; Other -> - ?trace("inet_getaddr(~p) " - "failed (~p).~n", [Node,Other]), - ?shutdown2(Node, {shutdown, {inet_getaddr_failed, Other}}) + ?shutdown2( + Node, + trace({getaddr_failed, Driver, Address, Other})) end. close(Socket) -> - gen_tcp:close(Socket), - ok. + gen_close(inet, Socket). + +gen_close(Driver, Socket) -> + trace(Driver:close(Socket)). -do_accept(Driver, Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) -> - process_flag(priority, max), - receive - {AcceptPid, controller} -> - Timer = dist_util:start_timer(SetupTime), - case check_ip(Driver, Socket) of - true -> - HSData = accept_hs_data(Kernel, MyNode, Socket, Timer, Allowed), - dist_util:handshake_other_started(HSData); - {false,IP} -> - error_logger:error_msg("** Connection attempt from " - "disallowed IP ~w ** ~n", [IP]), - ?shutdown(no_node) - end - end. %% ------------------------------------------------------------ %% Do only accept new connection attempts from nodes at our %% own LAN, if the check_ip environment parameter is true. %% ------------------------------------------------------------ -check_ip(Driver, Socket) -> +check_ip(Driver, SslSocket) -> case application:get_env(check_ip) of {ok, true} -> - case get_ifs(Socket) of + case get_ifs(SslSocket) of {ok, IFs, IP} -> check_ip(Driver, IFs, IP); - _ -> - ?shutdown(no_node) + Other -> + ?shutdown2( + no_node, trace({check_ip_failed, SslSocket, Other})) end; _ -> true end. -get_ifs(Socket) -> +check_ip(Driver, [{OwnIP, _, Netmask}|IFs], PeerIP) -> + case {Driver:mask(Netmask, PeerIP), Driver:mask(Netmask, OwnIP)} of + {M, M} -> true; + _ -> check_ip(IFs, PeerIP) + end; +check_ip(_Driver, [], PeerIP) -> + {false, PeerIP}. + +get_ifs(#sslsocket{fd = {gen_tcp, Socket, _}}) -> case inet:peername(Socket) of {ok, {IP, _}} -> + %% XXX this is seriously broken for IPv6 case inet:getif(Socket) of {ok, IFs} -> {ok, IFs, IP}; Error -> Error @@ -165,125 +449,217 @@ get_ifs(Socket) -> Error end. -check_ip(Driver, [{OwnIP, _, Netmask}|IFs], PeerIP) -> - case {Driver:mask(Netmask, PeerIP), Driver:mask(Netmask, OwnIP)} of - {M, M} -> true; - _ -> check_ip(IFs, PeerIP) - end; -check_ip(_Driver, [], PeerIP) -> - {false, PeerIP}. - %% If Node is illegal terminate the connection setup!! splitnode(Driver, Node, LongOrShortNames) -> - case split_node(atom_to_list(Node), $@, []) of - [Name|Tail] when Tail =/= [] -> - Host = lists:append(Tail), + case string:split(atom_to_list(Node), "@") of + [Name, Host] when Host =/= [] -> check_node(Driver, Name, Node, Host, LongOrShortNames); [_] -> - error_logger:error_msg("** Nodename ~p illegal, no '@' character **~n", - [Node]), - ?shutdown(Node); + error_logger:error_msg( + "** Nodename ~p illegal, no '@' character **~n", + [Node]), + ?shutdown2(Node, trace({illegal_node_n@me, Node})); _ -> - error_logger:error_msg("** Nodename ~p illegal **~n", [Node]), - ?shutdown(Node) + error_logger:error_msg( + "** Nodename ~p illegal **~n", [Node]), + ?shutdown2(Node, trace({illegal_node_name, Node})) end. check_node(Driver, Name, Node, Host, LongOrShortNames) -> - case split_node(Host, $., []) of + case string:split(Host, ".") of [_] when LongOrShortNames == longnames -> case Driver:parse_address(Host) of {ok, _} -> [Name, Host]; _ -> - error_logger:error_msg("** System running to use " - "fully qualified " - "hostnames **~n" - "** Hostname ~s is illegal **~n", - [Host]), - ?shutdown(Node) + error_logger:error_msg( + "** System running to use " + "fully qualified hostnames **~n" + "** Hostname ~s is illegal **~n", + [Host]), + ?shutdown2(Node, trace({not_longnames, Host})) end; - [_, _ | _] when LongOrShortNames == shortnames -> - error_logger:error_msg("** System NOT running to use fully qualified " - "hostnames **~n" - "** Hostname ~s is illegal **~n", - [Host]), - ?shutdown(Node); + [_, _] when LongOrShortNames == shortnames -> + error_logger:error_msg( + "** System NOT running to use " + "fully qualified hostnames **~n" + "** Hostname ~s is illegal **~n", + [Host]), + ?shutdown2(Node, trace({not_shortnames, Host})); _ -> [Name, Host] end. -split_node([Chr|T], Chr, Ack) -> - [lists:reverse(Ack)|split_node(T, Chr, [])]; -split_node([H|T], Chr, Ack) -> - split_node(T, Chr, [H|Ack]); -split_node([], _, Ack) -> - [lists:reverse(Ack)]. - -connect_hs_data(Kernel, Node, MyNode, Socket, Timer, Version, Ip, TcpPort, Address, Type) -> - common_hs_data(Kernel, MyNode, Socket, Timer, - #hs_data{other_node = Node, - other_version = Version, - f_address = - fun(_,_) -> - #net_address{address = {Ip,TcpPort}, - host = Address, - protocol = proxy, - family = inet} - end, - request_type = Type - }). - -accept_hs_data(Kernel, MyNode, Socket, Timer, Allowed) -> - common_hs_data(Kernel, MyNode, Socket, Timer, #hs_data{ - allowed = Allowed, - f_address = fun get_remote_id/2 - }). - -common_hs_data(Kernel, MyNode, Socket, Timer, HsData) -> - HsData#hs_data{ - kernel_pid = Kernel, - this_node = MyNode, - socket = Socket, - timer = Timer, - this_flags = 0, - f_send = - fun(S,D) -> - gen_tcp:send(S,D) - end, - f_recv = - fun(S,N,T) -> - gen_tcp:recv(S,N,T) - end, - f_setopts_pre_nodeup = - fun(S) -> - inet:setopts(S, [{active, false}, {packet, 4}]) - end, - f_setopts_post_nodeup = - fun(S) -> - inet:setopts(S, [{deliver, port},{active, true}]) - end, - f_getll = - fun(S) -> - inet:getll(S) - end, - mf_tick = - fun(S) -> - gen_tcp:send(S, <<>>) - end, - mf_getstat = - fun(S) -> - {ok, Stats} = inet:getstat(S, [recv_cnt, send_cnt, send_pend]), - R = proplists:get_value(recv_cnt, Stats, 0), - W = proplists:get_value(send_cnt, Stats, 0), - P = proplists:get_value(send_pend, Stats, 0), - {ok, R,W,P} - end}. - -get_remote_id(Socket, _Node) -> - case ssl_tls_dist_proxy:get_tcp_address(Socket) of - {ok, Address} -> - Address; - {error, _Reason} -> - ?shutdown(no_node) +split_node(Node) when is_atom(Node) -> + case string:split(atom_to_list(Node), "@") of + [Name, Host] when Name =/= [], Host =/= [] -> + Host; + _ -> + false + end; +split_node(_) -> + false. + +%% ------------------------------------------------------------------------- + +connect_options(Opts) -> + case application:get_env(kernel, inet_dist_connect_options) of + {ok,ConnectOpts} -> + lists:ukeysort(1, ConnectOpts ++ Opts); + _ -> + Opts + end. + +%% we may not always want the nodelay behaviour +%% for performance reasons +nodelay() -> + case application:get_env(kernel, dist_nodelay) of + undefined -> + {nodelay, true}; + {ok, true} -> + {nodelay, true}; + {ok, false} -> + {nodelay, false}; + _ -> + {nodelay, true} end. + + +get_ssl_options(Type) -> + try ets:lookup(ssl_dist_opts, Type) of + [{Type, Opts}] -> + [{erl_dist, true} | Opts]; + _ -> + get_ssl_dist_arguments(Type) + catch + error:badarg -> + get_ssl_dist_arguments(Type) + end. + +get_ssl_dist_arguments(Type) -> + case init:get_argument(ssl_dist_opt) of + {ok, Args} -> + [{erl_dist, true} | ssl_options(Type, lists:append(Args))]; + _ -> + [{erl_dist, true}] + end. + +ssl_options(_,[]) -> + []; +ssl_options(server, ["client_" ++ _, _Value |T]) -> + ssl_options(server,T); +ssl_options(client, ["server_" ++ _, _Value|T]) -> + ssl_options(client,T); +ssl_options(server, ["server_certfile", Value|T]) -> + [{certfile, Value} | ssl_options(server,T)]; +ssl_options(client, ["client_certfile", Value | T]) -> + [{certfile, Value} | ssl_options(client,T)]; +ssl_options(server, ["server_cacertfile", Value|T]) -> + [{cacertfile, Value} | ssl_options(server,T)]; +ssl_options(client, ["client_cacertfile", Value|T]) -> + [{cacertfile, Value} | ssl_options(client,T)]; +ssl_options(server, ["server_keyfile", Value|T]) -> + [{keyfile, Value} | ssl_options(server,T)]; +ssl_options(client, ["client_keyfile", Value|T]) -> + [{keyfile, Value} | ssl_options(client,T)]; +ssl_options(server, ["server_password", Value|T]) -> + [{password, Value} | ssl_options(server,T)]; +ssl_options(client, ["client_password", Value|T]) -> + [{password, Value} | ssl_options(client,T)]; +ssl_options(server, ["server_verify", Value|T]) -> + [{verify, atomize(Value)} | ssl_options(server,T)]; +ssl_options(client, ["client_verify", Value|T]) -> + [{verify, atomize(Value)} | ssl_options(client,T)]; +ssl_options(server, ["server_verify_fun", Value|T]) -> + [{verify_fun, verify_fun(Value)} | ssl_options(server,T)]; +ssl_options(client, ["client_verify_fun", Value|T]) -> + [{verify_fun, verify_fun(Value)} | ssl_options(client,T)]; +ssl_options(server, ["server_crl_check", Value|T]) -> + [{crl_check, atomize(Value)} | ssl_options(server,T)]; +ssl_options(client, ["client_crl_check", Value|T]) -> + [{crl_check, atomize(Value)} | ssl_options(client,T)]; +ssl_options(server, ["server_crl_cache", Value|T]) -> + [{crl_cache, termify(Value)} | ssl_options(server,T)]; +ssl_options(client, ["client_crl_cache", Value|T]) -> + [{crl_cache, termify(Value)} | ssl_options(client,T)]; +ssl_options(server, ["server_reuse_sessions", Value|T]) -> + [{reuse_sessions, atomize(Value)} | ssl_options(server,T)]; +ssl_options(client, ["client_reuse_sessions", Value|T]) -> + [{reuse_sessions, atomize(Value)} | ssl_options(client,T)]; +ssl_options(server, ["server_secure_renegotiate", Value|T]) -> + [{secure_renegotiate, atomize(Value)} | ssl_options(server,T)]; +ssl_options(client, ["client_secure_renegotiate", Value|T]) -> + [{secure_renegotiate, atomize(Value)} | ssl_options(client,T)]; +ssl_options(server, ["server_depth", Value|T]) -> + [{depth, list_to_integer(Value)} | ssl_options(server,T)]; +ssl_options(client, ["client_depth", Value|T]) -> + [{depth, list_to_integer(Value)} | ssl_options(client,T)]; +ssl_options(server, ["server_hibernate_after", Value|T]) -> + [{hibernate_after, list_to_integer(Value)} | ssl_options(server,T)]; +ssl_options(client, ["client_hibernate_after", Value|T]) -> + [{hibernate_after, list_to_integer(Value)} | ssl_options(client,T)]; +ssl_options(server, ["server_ciphers", Value|T]) -> + [{ciphers, Value} | ssl_options(server,T)]; +ssl_options(client, ["client_ciphers", Value|T]) -> + [{ciphers, Value} | ssl_options(client,T)]; +ssl_options(server, ["server_dhfile", Value|T]) -> + [{dhfile, Value} | ssl_options(server,T)]; +ssl_options(server, ["server_fail_if_no_peer_cert", Value|T]) -> + [{fail_if_no_peer_cert, atomize(Value)} | ssl_options(server,T)]; +ssl_options(Type, Opts) -> + error(malformed_ssl_dist_opt, [Type, Opts]). + +atomize(List) when is_list(List) -> + list_to_atom(List); +atomize(Atom) when is_atom(Atom) -> + Atom. + +termify(String) when is_list(String) -> + {ok, Tokens, _} = erl_scan:string(String ++ "."), + {ok, Term} = erl_parse:parse_term(Tokens), + Term. + +verify_fun(Value) -> + case termify(Value) of + {Mod, Func, State} when is_atom(Mod), is_atom(Func) -> + Fun = fun Mod:Func/3, + {Fun, State}; + _ -> + error(malformed_ssl_dist_opt, [Value]) + end. + +%% ------------------------------------------------------------------------- + +%% Trace point +trace(Term) -> Term. + +%% Keep an eye on distribution Pid:s we know of +monitor_pid(Pid) -> + %%spawn( + %% fun () -> + %% MRef = erlang:monitor(process, Pid), + %% receive + %% {'DOWN', MRef, _, _, normal} -> + %% error_logger:error_report( + %% [dist_proc_died, + %% {reason, normal}, + %% {pid, Pid}]); + %% {'DOWN', MRef, _, _, Reason} -> + %% error_logger:info_report( + %% [dist_proc_died, + %% {reason, Reason}, + %% {pid, Pid}]) + %% end + %% end), + Pid. + +dbg() -> + dbg:stop(), + dbg:tracer(), + dbg:p(all, c), + dbg:tpl(?MODULE, cx), + dbg:tpl(erlang, dist_ctrl_get_data_notification, cx), + dbg:tpl(erlang, dist_ctrl_get_data, cx), + dbg:tpl(erlang, dist_ctrl_put_data, cx), + ok. diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src index 51407ef3b9..3c6cd254c1 100644 --- a/lib/ssl/src/ssl.app.src +++ b/lib/ssl/src/ssl.app.src @@ -37,7 +37,6 @@ %% Erlang Distribution over SSL/TLS inet_tls_dist, inet6_tls_dist, - ssl_tls_dist_proxy, ssl_dist_sup, ssl_dist_connection_sup, ssl_dist_admin_sup, @@ -63,7 +62,5 @@ {applications, [crypto, public_key, kernel, stdlib]}, {env, []}, {mod, {ssl_app, []}}, - {runtime_dependencies, ["stdlib-3.2","public_key-1.5","kernel-3.0", - "erts-7.0","crypto-3.3", "inets-5.10.7"]}]}. - - + {runtime_dependencies, ["stdlib-3.2","public_key-1.5","kernel-6.0", + "erts-10.0","crypto-4.2", "inets-5.10.7"]}]}. diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 054e3b7ae3..656ed94ea5 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -374,13 +374,12 @@ negotiated_protocol(#sslsocket{pid = Pid}) -> ssl_connection:negotiated_protocol(Pid). %%-------------------------------------------------------------------- --spec cipher_suites() -> [ssl_cipher:erl_cipher_suite()] | [string()]. +-spec cipher_suites() -> [ssl_cipher:old_erl_cipher_suite()] | [string()]. %%-------------------------------------------------------------------- cipher_suites() -> cipher_suites(erlang). %%-------------------------------------------------------------------- --spec cipher_suites(erlang | openssl | all) -> [ssl_cipher:erl_cipher_suite()] | - [string()]. +-spec cipher_suites(erlang | openssl | all) -> [ssl_cipher:old_erl_cipher_suite() | string()]. %% Description: Returns all supported cipher suites. %%-------------------------------------------------------------------- cipher_suites(erlang) -> @@ -896,7 +895,8 @@ validate_option(key, {KeyType, Value}) when is_binary(Value), KeyType == 'ECPrivateKey'; KeyType == 'PrivateKeyInfo' -> {KeyType, Value}; - +validate_option(key, #{algorithm := _} = Value) -> + Value; validate_option(keyfile, undefined) -> <<>>; validate_option(keyfile, Value) when is_binary(Value) -> @@ -991,17 +991,21 @@ validate_option(next_protocols_advertised, Value) when is_list(Value) -> Value; validate_option(next_protocols_advertised, undefined) -> undefined; -validate_option(server_name_indication = Opt, Value) when is_list(Value) -> +validate_option(server_name_indication, Value) when is_list(Value) -> %% RFC 6066, Section 3: Currently, the only server names supported are %% DNS hostnames - case inet_parse:domain(Value) of - false -> - throw({error, {options, {{Opt, Value}}}}); - true -> - Value - end; -validate_option(server_name_indication, undefined = Value) -> + %% case inet_parse:domain(Value) of + %% false -> + %% throw({error, {options, {{Opt, Value}}}}); + %% true -> + %% Value + %% end; + %% + %% But the definition seems very diffuse, so let all strings through + %% and leave it up to public_key to decide... Value; +validate_option(server_name_indication, undefined) -> + undefined; validate_option(server_name_indication, disable) -> disable; @@ -1113,24 +1117,6 @@ dtls_validate_versions([Version | Rest], Versions) when Version == 'dtlsv1'; dtls_validate_versions([Ver| _], Versions) -> throw({error, {options, {Ver, {versions, Versions}}}}). -validate_inet_option(mode, Value) - when Value =/= list, Value =/= binary -> - throw({error, {options, {mode,Value}}}); -validate_inet_option(packet, Value) - when not (is_atom(Value) orelse is_integer(Value)) -> - throw({error, {options, {packet,Value}}}); -validate_inet_option(packet_size, Value) - when not is_integer(Value) -> - throw({error, {options, {packet_size,Value}}}); -validate_inet_option(header, Value) - when not is_integer(Value) -> - throw({error, {options, {header,Value}}}); -validate_inet_option(active, Value) - when Value =/= true, Value =/= false, Value =/= once -> - throw({error, {options, {active,Value}}}); -validate_inet_option(_, _) -> - ok. - %% The option cacerts overrides cacertsfile ca_cert_default(_,_, [_|_]) -> undefined; @@ -1145,31 +1131,11 @@ ca_cert_default(verify_peer, undefined, _) -> emulated_options(Protocol, Opts) -> case Protocol of tls -> - emulated_options(Opts, tls_socket:internal_inet_values(), tls_socket:default_inet_values()); + tls_socket:emulated_options(Opts); dtls -> - emulated_options(Opts, dtls_socket:internal_inet_values(), dtls_socket:default_inet_values()) + dtls_socket:emulated_options(Opts) end. -emulated_options([{mode, Value} = Opt |Opts], Inet, Emulated) -> - validate_inet_option(mode, Value), - emulated_options(Opts, Inet, [Opt | proplists:delete(mode, Emulated)]); -emulated_options([{header, Value} = Opt | Opts], Inet, Emulated) -> - validate_inet_option(header, Value), - emulated_options(Opts, Inet, [Opt | proplists:delete(header, Emulated)]); -emulated_options([{active, Value} = Opt |Opts], Inet, Emulated) -> - validate_inet_option(active, Value), - emulated_options(Opts, Inet, [Opt | proplists:delete(active, Emulated)]); -emulated_options([{packet, Value} = Opt |Opts], Inet, Emulated) -> - validate_inet_option(packet, Value), - emulated_options(Opts, Inet, [Opt | proplists:delete(packet, Emulated)]); -emulated_options([{packet_size, Value} = Opt | Opts], Inet, Emulated) -> - validate_inet_option(packet_size, Value), - emulated_options(Opts, Inet, [Opt | proplists:delete(packet_size, Emulated)]); -emulated_options([Opt|Opts], Inet, Emulated) -> - emulated_options(Opts, [Opt|Inet], Emulated); -emulated_options([], Inet,Emulated) -> - {Inet, Emulated}. - handle_cipher_option(Value, Version) when is_list(Value) -> try binary_cipher_suites(Version, Value) of Suites -> @@ -1186,9 +1152,8 @@ binary_cipher_suites(Version, []) -> %% not require explicit configuration ssl_cipher:filter_suites(ssl_cipher:suites(tls_version(Version))); binary_cipher_suites(Version, [Tuple|_] = Ciphers0) when is_tuple(Tuple) -> - Ciphers = [ssl_cipher:suite(C) || C <- Ciphers0], + Ciphers = [ssl_cipher:suite(tuple_to_map(C)) || C <- Ciphers0], binary_cipher_suites(Version, Ciphers); - binary_cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) -> All = ssl_cipher:all_suites(tls_version(Version)), case [Cipher || Cipher <- Ciphers0, lists:member(Cipher, All)] of @@ -1205,9 +1170,20 @@ binary_cipher_suites(Version, [Head | _] = Ciphers0) when is_list(Head) -> binary_cipher_suites(Version, Ciphers); binary_cipher_suites(Version, Ciphers0) -> %% Format: "RC4-SHA:RC4-MD5" - Ciphers = [ssl_cipher:openssl_suite(C) || C <- string:tokens(Ciphers0, ":")], + Ciphers = [ssl_cipher:openssl_suite(C) || C <- string:lexemes(Ciphers0, ":")], binary_cipher_suites(Version, Ciphers). +tuple_to_map({Kex, Cipher, Mac}) -> + #{key_exchange => Kex, + cipher => Cipher, + mac => Mac, + prf => default_prf}; +tuple_to_map({Kex, Cipher, Mac, Prf}) -> + #{key_exchange => Kex, + cipher => Cipher, + mac => Mac, + prf => Prf}. + handle_eccs_option(Value, Version) when is_list(Value) -> {_Major, Minor} = tls_version(Version), try tls_v1:ecc_curves(Minor, Value) of diff --git a/lib/ssl/src/ssl_alert.erl b/lib/ssl/src/ssl_alert.erl index db415a3666..95ab955ad0 100644 --- a/lib/ssl/src/ssl_alert.erl +++ b/lib/ssl/src/ssl_alert.erl @@ -57,7 +57,7 @@ decode(Bin) -> reason_code(#alert{description = ?CLOSE_NOTIFY}, _) -> closed; reason_code(#alert{description = Description}, _) -> - {tls_alert, string:to_lower(description_txt(Description))}. + {tls_alert, string:casefold(description_txt(Description))}. %%-------------------------------------------------------------------- -spec own_alert_txt(#alert{}) -> string(). @@ -66,7 +66,7 @@ reason_code(#alert{description = Description}, _) -> %% by the erlang implementation. %%-------------------------------------------------------------------- own_alert_txt(#alert{level = Level, description = Description, where = {Mod,Line}, reason = undefined, role = Role}) -> - "at " ++ Mod ++ ":" ++ integer_to_list(Line) ++ " generated " ++ string:to_upper(atom_to_list(Role)) ++ " ALERT: " ++ + "at " ++ Mod ++ ":" ++ integer_to_list(Line) ++ " generated " ++ string:uppercase(atom_to_list(Role)) ++ " ALERT: " ++ level_txt(Level) ++ description_txt(Description); own_alert_txt(#alert{reason = Reason} = Alert) -> BaseTxt = own_alert_txt(Alert#alert{reason = undefined}), @@ -81,7 +81,7 @@ own_alert_txt(#alert{reason = Reason} = Alert) -> %% the peer. %%-------------------------------------------------------------------- alert_txt(#alert{level = Level, description = Description, reason = undefined, role = Role}) -> - "received " ++ string:to_upper(atom_to_list(Role)) ++ " ALERT: " ++ + "received " ++ string:uppercase(atom_to_list(Role)) ++ " ALERT: " ++ level_txt(Level) ++ description_txt(Description); alert_txt(#alert{reason = Reason} = Alert) -> BaseTxt = alert_txt(Alert#alert{reason = undefined}), diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 50c5f0d755..b0e38fb9ad 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -44,20 +44,21 @@ is_stream_ciphersuite/1]). -export_type([cipher_suite/0, - erl_cipher_suite/0, openssl_cipher_suite/0, + erl_cipher_suite/0, old_erl_cipher_suite/0, openssl_cipher_suite/0, hash/0, key_algo/0, sign_algo/0]). --type cipher() :: null |rc4_128 | des_cbc | '3des_ede_cbc' - | aes_128_cbc | aes_256_cbc | aes_128_gcm | aes_256_gcm | chacha20_poly1305. +-type cipher() :: null |rc4_128 | des_cbc | '3des_ede_cbc' | aes_128_cbc | aes_256_cbc | aes_128_gcm | aes_256_gcm | chacha20_poly1305. -type hash() :: null | md5 | sha | sha224 | sha256 | sha384 | sha512. -type sign_algo() :: rsa | dsa | ecdsa. --type key_algo() :: null | rsa | dhe_rsa | dhe_dss | ecdhe_ecdsa| ecdh_ecdsa | ecdh_rsa| srp_rsa| srp_dss | - psk | dhe_psk | rsa_psk | dh_anon | ecdh_anon | srp_anon. --type erl_cipher_suite() :: {key_algo(), cipher(), hash()} % Pre TLS 1.2 - %% TLS 1.2, internally PRE TLS 1.2 will use default_prf - | {key_algo(), cipher(), hash(), hash() | default_prf}. - - +-type key_algo() :: null | rsa | dhe_rsa | dhe_dss | ecdhe_ecdsa| ecdh_ecdsa | ecdh_rsa| srp_rsa| srp_dss | psk | dhe_psk | rsa_psk | dh_anon | ecdh_anon | srp_anon. +-type erl_cipher_suite() :: #{key_exchange := key_algo(), + cipher := cipher(), + mac := hash(), + prf := hash() | default_prf %% Old cipher suites, version dependent + }. +-type old_erl_cipher_suite() :: {key_algo(), cipher(), hash()} % Pre TLS 1.2 + %% TLS 1.2, internally PRE TLS 1.2 will use default_prf + | {key_algo(), cipher(), hash(), hash() | default_prf}. -type cipher_suite() :: binary(). -type cipher_enum() :: integer(). -type openssl_cipher_suite() :: string(). @@ -83,7 +84,8 @@ security_parameters(?TLS_NULL_WITH_NULL_NULL = CipherSuite, SecParams) -> %% cipher values has been updated according to <CipherSuite> %%------------------------------------------------------------------- security_parameters(Version, CipherSuite, SecParams) -> - { _, Cipher, Hash, PrfHashAlg} = suite_definition(CipherSuite), + #{cipher := Cipher, mac := Hash, + prf := PrfHashAlg} = suite_definition(CipherSuite), SecParams#security_parameters{ cipher_suite = CipherSuite, bulk_cipher_algorithm = bulk_cipher_algorithm(Cipher), @@ -375,30 +377,38 @@ psk_suites({3, N}) -> psk_suites(N) when N >= 3 -> [ + ?TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384, ?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384, ?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384, ?TLS_PSK_WITH_AES_256_GCM_SHA384, + ?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384, ?TLS_DHE_PSK_WITH_AES_256_CBC_SHA384, ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384, ?TLS_PSK_WITH_AES_256_CBC_SHA384, + ?TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256, ?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256, ?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256, ?TLS_PSK_WITH_AES_128_GCM_SHA256, + ?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256, ?TLS_DHE_PSK_WITH_AES_128_CBC_SHA256, ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256, ?TLS_PSK_WITH_AES_128_CBC_SHA256 ] ++ psk_suites(0); psk_suites(_) -> - [?TLS_DHE_PSK_WITH_AES_256_CBC_SHA, + [?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA, + ?TLS_DHE_PSK_WITH_AES_256_CBC_SHA, ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA, ?TLS_PSK_WITH_AES_256_CBC_SHA, + ?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA, ?TLS_DHE_PSK_WITH_AES_128_CBC_SHA, ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA, ?TLS_PSK_WITH_AES_128_CBC_SHA, + ?TLS_ECDHE_PSK_WITH_3DES_EDE_CBC_SHA, ?TLS_DHE_PSK_WITH_3DES_EDE_CBC_SHA, ?TLS_RSA_PSK_WITH_3DES_EDE_CBC_SHA, ?TLS_PSK_WITH_3DES_EDE_CBC_SHA, + ?TLS_ECDHE_PSK_WITH_RC4_128_SHA, ?TLS_DHE_PSK_WITH_RC4_128_SHA, ?TLS_RSA_PSK_WITH_RC4_128_SHA, ?TLS_PSK_WITH_RC4_128_SHA]. @@ -457,314 +467,740 @@ des_suites(_)-> %%------------------------------------------------------------------- %% TLS v1.1 suites suite_definition(?TLS_NULL_WITH_NULL_NULL) -> - {null, null, null, null}; + #{key_exchange => null, + cipher => null, + mac => null, + prf => null}; %% RFC 5746 - Not a real cipher suite used to signal empty "renegotiation_info" extension %% to avoid handshake failure from old servers that do not ignore %% hello extension data as they should. suite_definition(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV) -> - {null, null, null, null}; -%% suite_definition(?TLS_RSA_WITH_NULL_MD5) -> -%% {rsa, null, md5, default_prf}; -%% suite_definition(?TLS_RSA_WITH_NULL_SHA) -> -%% {rsa, null, sha, default_prf}; + #{key_exchange => null, + cipher => null, + mac => null, + prf => null}; suite_definition(?TLS_RSA_WITH_RC4_128_MD5) -> - {rsa, rc4_128, md5, default_prf}; + #{key_exchange => rsa, + cipher => rc4_128, + mac => md5, + prf => default_prf}; suite_definition(?TLS_RSA_WITH_RC4_128_SHA) -> - {rsa, rc4_128, sha, default_prf}; + #{key_exchange => rsa, + cipher => rc4_128, + mac => sha, + prf => default_prf}; suite_definition(?TLS_RSA_WITH_DES_CBC_SHA) -> - {rsa, des_cbc, sha, default_prf}; + #{key_exchange => rsa, + cipher => des_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_RSA_WITH_3DES_EDE_CBC_SHA) -> - {rsa, '3des_ede_cbc', sha, default_prf}; + #{key_exchange => rsa, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; suite_definition(?TLS_DHE_DSS_WITH_DES_CBC_SHA) -> - {dhe_dss, des_cbc, sha, default_prf}; + #{key_exchange => dhe_dss, + cipher => des_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA) -> - {dhe_dss, '3des_ede_cbc', sha, default_prf}; + #{key_exchange => dhe_dss, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; suite_definition(?TLS_DHE_RSA_WITH_DES_CBC_SHA) -> - {dhe_rsa, des_cbc, sha, default_prf}; + #{key_exchange => dhe_rsa, + cipher => des_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA) -> - {dhe_rsa, '3des_ede_cbc', sha, default_prf}; - + #{key_exchange => dhe_rsa, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; %%% TSL V1.1 AES suites suite_definition(?TLS_RSA_WITH_AES_128_CBC_SHA) -> - {rsa, aes_128_cbc, sha, default_prf}; + #{key_exchange => rsa, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_DHE_DSS_WITH_AES_128_CBC_SHA) -> - {dhe_dss, aes_128_cbc, sha, default_prf}; + #{key_exchange => dhe_dss, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_DHE_RSA_WITH_AES_128_CBC_SHA) -> - {dhe_rsa, aes_128_cbc, sha, default_prf}; + #{key_exchange => dhe_rsa, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_RSA_WITH_AES_256_CBC_SHA) -> - {rsa, aes_256_cbc, sha, default_prf}; + #{key_exchange => rsa, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_DHE_DSS_WITH_AES_256_CBC_SHA) -> - {dhe_dss, aes_256_cbc, sha, default_prf}; + #{key_exchange => dhe_dss, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA) -> - {dhe_rsa, aes_256_cbc, sha, default_prf}; - + #{key_exchange => dhe_rsa, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; %% TLS v1.2 suites - %% suite_definition(?TLS_RSA_WITH_NULL_SHA) -> %% {rsa, null, sha, default_prf}; suite_definition(?TLS_RSA_WITH_AES_128_CBC_SHA256) -> - {rsa, aes_128_cbc, sha256, default_prf}; + #{key_exchange => rsa, + cipher => aes_128_cbc, + mac => sha256, + prf => default_prf}; suite_definition(?TLS_RSA_WITH_AES_256_CBC_SHA256) -> - {rsa, aes_256_cbc, sha256, default_prf}; + #{key_exchange => rsa, + cipher => aes_256_cbc, + mac => sha256, + prf => default_prf}; suite_definition(?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256) -> - {dhe_dss, aes_128_cbc, sha256, default_prf}; + #{key_exchange => dhe_dss, + cipher => aes_128_cbc, + mac => sha256, + prf => default_prf}; suite_definition(?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256) -> - {dhe_rsa, aes_128_cbc, sha256, default_prf}; + #{key_exchange => dhe_rsa, + cipher => aes_128_cbc, + mac => sha256, + prf => default_prf}; suite_definition(?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256) -> - {dhe_dss, aes_256_cbc, sha256, default_prf}; + #{key_exchange => dhe_dss, + cipher => aes_256_cbc, + mac => sha256, + prf => default_prf}; suite_definition(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256) -> - {dhe_rsa, aes_256_cbc, sha256, default_prf}; - + #{key_exchange => dhe_rsa, + cipher => aes_256_cbc, + mac => sha256, + prf => default_prf}; %% not defined YET: %% TLS_DH_DSS_WITH_AES_128_CBC_SHA256 DH_DSS AES_128_CBC SHA256 %% TLS_DH_RSA_WITH_AES_128_CBC_SHA256 DH_RSA AES_128_CBC SHA256 %% TLS_DH_DSS_WITH_AES_256_CBC_SHA256 DH_DSS AES_256_CBC SHA256 %% TLS_DH_RSA_WITH_AES_256_CBC_SHA256 DH_RSA AES_256_CBC SHA256 - %%% DH-ANON deprecated by TLS spec and not available %%% by default, but good for testing purposes. suite_definition(?TLS_DH_anon_WITH_RC4_128_MD5) -> - {dh_anon, rc4_128, md5, default_prf}; + #{key_exchange => dh_anon, + cipher => rc4_128, + mac => md5, + prf => default_prf}; suite_definition(?TLS_DH_anon_WITH_DES_CBC_SHA) -> - {dh_anon, des_cbc, sha, default_prf}; + #{key_exchange => dh_anon, + cipher => des_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA) -> - {dh_anon, '3des_ede_cbc', sha, default_prf}; + #{key_exchange => dh_anon, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; suite_definition(?TLS_DH_anon_WITH_AES_128_CBC_SHA) -> - {dh_anon, aes_128_cbc, sha, default_prf}; + #{key_exchange => dh_anon, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_DH_anon_WITH_AES_256_CBC_SHA) -> - {dh_anon, aes_256_cbc, sha, default_prf}; + #{key_exchange => dh_anon, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_DH_anon_WITH_AES_128_CBC_SHA256) -> - {dh_anon, aes_128_cbc, sha256, default_prf}; + #{key_exchange => dh_anon, + cipher => aes_128_cbc, + mac => sha256, + prf => default_prf}; suite_definition(?TLS_DH_anon_WITH_AES_256_CBC_SHA256) -> - {dh_anon, aes_256_cbc, sha256, default_prf}; - + #{key_exchange => dh_anon, + cipher => aes_256_cbc, + mac => sha256, + prf => default_prf}; %%% PSK Cipher Suites RFC 4279 - suite_definition(?TLS_PSK_WITH_RC4_128_SHA) -> - {psk, rc4_128, sha, default_prf}; + #{key_exchange => psk, + cipher => rc4_128, + mac => sha, + prf => default_prf}; suite_definition(?TLS_PSK_WITH_3DES_EDE_CBC_SHA) -> - {psk, '3des_ede_cbc', sha, default_prf}; + #{key_exchange => psk, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; suite_definition(?TLS_PSK_WITH_AES_128_CBC_SHA) -> - {psk, aes_128_cbc, sha, default_prf}; + #{key_exchange => psk, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_PSK_WITH_AES_256_CBC_SHA) -> - {psk, aes_256_cbc, sha, default_prf}; + #{key_exchange => psk, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_DHE_PSK_WITH_RC4_128_SHA) -> - {dhe_psk, rc4_128, sha, default_prf}; + #{key_exchange => dhe_psk, + cipher => rc4_128, + mac => sha, + prf => default_prf}; suite_definition(?TLS_DHE_PSK_WITH_3DES_EDE_CBC_SHA) -> - {dhe_psk, '3des_ede_cbc', sha, default_prf}; + #{key_exchange => dhe_psk, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; suite_definition(?TLS_DHE_PSK_WITH_AES_128_CBC_SHA) -> - {dhe_psk, aes_128_cbc, sha, default_prf}; + #{key_exchange => dhe_psk, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_DHE_PSK_WITH_AES_256_CBC_SHA) -> - {dhe_psk, aes_256_cbc, sha, default_prf}; + #{key_exchange => dhe_psk, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_RSA_PSK_WITH_RC4_128_SHA) -> - {rsa_psk, rc4_128, sha, default_prf}; + #{key_exchange => rsa_psk, + cipher => rc4_128, + mac => sha, + prf => default_prf}; suite_definition(?TLS_RSA_PSK_WITH_3DES_EDE_CBC_SHA) -> - {rsa_psk, '3des_ede_cbc', sha, default_prf}; + #{key_exchange => rsa_psk, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; suite_definition(?TLS_RSA_PSK_WITH_AES_128_CBC_SHA) -> - {rsa_psk, aes_128_cbc, sha, default_prf}; + #{key_exchange => rsa_psk, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_RSA_PSK_WITH_AES_256_CBC_SHA) -> - {rsa_psk, aes_256_cbc, sha, default_prf}; - + #{key_exchange => rsa_psk, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; +%%% PSK NULL Cipher Suites RFC 4785 +suite_definition(?TLS_PSK_WITH_NULL_SHA) -> + #{key_exchange => psk, + cipher => null, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_DHE_PSK_WITH_NULL_SHA) -> + #{key_exchange => dhe_psk, + cipher => null, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_RSA_PSK_WITH_NULL_SHA) -> + #{key_exchange => rsa_psk, + cipher => null, + mac => sha, + prf => default_prf}; %%% TLS 1.2 PSK Cipher Suites RFC 5487 - suite_definition(?TLS_PSK_WITH_AES_128_GCM_SHA256) -> - {psk, aes_128_gcm, null, sha256}; + #{key_exchange => psk, + cipher => aes_128_gcm, + mac => null, + prf => sha256}; suite_definition(?TLS_PSK_WITH_AES_256_GCM_SHA384) -> - {psk, aes_256_gcm, null, sha384}; + #{key_exchange => psk, + cipher => aes_256_gcm, + mac => null, + prf => sha384}; suite_definition(?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256) -> - {dhe_psk, aes_128_gcm, null, sha256}; + #{key_exchange => dhe_psk, + cipher => aes_128_gcm, + mac => null, + prf => sha256}; suite_definition(?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384) -> - {dhe_psk, aes_256_gcm, null, sha384}; + #{key_exchange => dhe_psk, + cipher => aes_256_gcm, + mac => null, + prf => sha384}; suite_definition(?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256) -> - {rsa_psk, aes_128_gcm, null, sha256}; + #{key_exchange => rsa_psk, + cipher => aes_128_gcm, + mac => null, + prf => sha256}; suite_definition(?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384) -> - {rsa_psk, aes_256_gcm, null, sha384}; - + #{key_exchange => rsa_psk, + cipher => aes_256_gcm, + mac => null, + prf => sha384}; suite_definition(?TLS_PSK_WITH_AES_128_CBC_SHA256) -> - {psk, aes_128_cbc, sha256, default_prf}; + #{key_exchange => psk, + cipher => aes_128_cbc, + mac => sha256, + prf => default_prf}; suite_definition(?TLS_PSK_WITH_AES_256_CBC_SHA384) -> - {psk, aes_256_cbc, sha384, default_prf}; + #{key_exchange => psk, + cipher => aes_256_cbc, + mac => sha384, + prf => default_prf}; suite_definition(?TLS_DHE_PSK_WITH_AES_128_CBC_SHA256) -> - {dhe_psk, aes_128_cbc, sha256, default_prf}; + #{key_exchange => dhe_psk, + cipher => aes_128_cbc, + mac => sha256, + prf => default_prf}; suite_definition(?TLS_DHE_PSK_WITH_AES_256_CBC_SHA384) -> - {dhe_psk, aes_256_cbc, sha384, default_prf}; + #{key_exchange => dhe_psk, + cipher => aes_256_cbc, + mac => sha384, + prf => default_prf}; suite_definition(?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256) -> - {rsa_psk, aes_128_cbc, sha256, default_prf}; + #{key_exchange => rsa_psk, + cipher => aes_128_cbc, + mac => sha256, + prf => default_prf}; suite_definition(?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384) -> - {rsa_psk, aes_256_cbc, sha384, default_prf}; - + #{key_exchange => rsa_psk, + cipher => aes_256_cbc, + mac => sha384, + prf => default_prf}; suite_definition(?TLS_PSK_WITH_NULL_SHA256) -> - {psk, null, sha256, default_prf}; + #{key_exchange => psk, + cipher => null, + mac => sha256, + prf => default_prf}; suite_definition(?TLS_PSK_WITH_NULL_SHA384) -> - {psk, null, sha384, default_prf}; + #{key_exchange => psk, + cipher => null, + mac => sha384, + prf => default_prf}; suite_definition(?TLS_DHE_PSK_WITH_NULL_SHA256) -> - {dhe_psk, null, sha256, default_prf}; + #{key_exchange => dhe_psk, + cipher => null, + mac => sha256, + prf => default_prf}; suite_definition(?TLS_DHE_PSK_WITH_NULL_SHA384) -> - {dhe_psk, null, sha384, default_prf}; + #{key_exchange => dhe_psk, + cipher => null, + mac => sha384, + prf => default_prf}; suite_definition(?TLS_RSA_PSK_WITH_NULL_SHA256) -> - {rsa_psk, null, sha256, default_prf}; + #{key_exchange => rsa_psk, + cipher => null, + mac => sha256, + prf => default_prf}; suite_definition(?TLS_RSA_PSK_WITH_NULL_SHA384) -> - {rsa_psk, null, sha384, default_prf}; - + #{key_exchange => rsa_psk, + cipher => null, + mac => sha384, + prf => default_prf}; +%%% ECDHE PSK Cipher Suites RFC 5489 +suite_definition(?TLS_ECDHE_PSK_WITH_RC4_128_SHA) -> + #{key_exchange => ecdhe_psk, + cipher => rc4_128, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDHE_PSK_WITH_3DES_EDE_CBC_SHA) -> + #{key_exchange => ecdhe_psk, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA) -> + #{key_exchange => ecdhe_psk, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA) -> + #{key_exchange => ecdhe_psk, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256) -> + #{key_exchange => ecdhe_psk, + cipher => aes_128_cbc, + mac => sha256, + prf => default_prf}; +suite_definition(?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384) -> + #{key_exchange => ecdhe_psk, + cipher => aes_256_cbc, + mac => sha384, + prf => default_prf}; +suite_definition(?TLS_ECDHE_PSK_WITH_NULL_SHA256) -> + #{key_exchange => ecdhe_psk, + cipher => null, + mac => sha256, + prf => default_prf}; +suite_definition(?TLS_ECDHE_PSK_WITH_NULL_SHA384) -> + #{key_exchange => ecdhe_psk, + cipher => null, mac => sha384, + prf => default_prf}; +%%% ECDHE_PSK with AES-GCM and AES-CCM Cipher Suites, draft-ietf-tls-ecdhe-psk-aead-05 +suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256) -> + #{key_exchange => ecdhe_psk, + cipher => aes_128_gcm, + mac => null, + prf => sha256}; +suite_definition(?TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384) -> + #{key_exchange => ecdhe_psk, + cipher => aes_256_gcm, + mac => null, + prf => sha384}; +%% suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256) -> +%% #{key_exchange => ecdhe_psk, +%% cipher => aes_128_ccm, +%% mac => null, +%% prf =>sha256}; +%% suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256) -> +%% #{key_exchange => ecdhe_psk, +%% cipher => aes_256_ccm, +%% mac => null, +%% prf => sha256}; %%% SRP Cipher Suites RFC 5054 - suite_definition(?TLS_SRP_SHA_WITH_3DES_EDE_CBC_SHA) -> - {srp_anon, '3des_ede_cbc', sha, default_prf}; + #{key_exchange => srp_anon, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; suite_definition(?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA) -> - {srp_rsa, '3des_ede_cbc', sha, default_prf}; + #{key_exchange => srp_rsa, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; suite_definition(?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA) -> - {srp_dss, '3des_ede_cbc', sha, default_prf}; + #{key_exchange => srp_dss, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; suite_definition(?TLS_SRP_SHA_WITH_AES_128_CBC_SHA) -> - {srp_anon, aes_128_cbc, sha, default_prf}; + #{key_exchange => srp_anon, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_SRP_SHA_RSA_WITH_AES_128_CBC_SHA) -> - {srp_rsa, aes_128_cbc, sha, default_prf}; + #{key_exchange => srp_rsa, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_SRP_SHA_DSS_WITH_AES_128_CBC_SHA) -> - {srp_dss, aes_128_cbc, sha, default_prf}; + #{key_exchange => srp_dss, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_SRP_SHA_WITH_AES_256_CBC_SHA) -> - {srp_anon, aes_256_cbc, sha, default_prf}; + #{key_exchange => srp_anon, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA) -> - {srp_rsa, aes_256_cbc, sha, default_prf}; + #{key_exchange => srp_rsa, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA) -> - {srp_dss, aes_256_cbc, sha, default_prf}; - + #{key_exchange => srp_dss, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; %% RFC 4492 EC TLS suites suite_definition(?TLS_ECDH_ECDSA_WITH_NULL_SHA) -> - {ecdh_ecdsa, null, sha, default_prf}; + #{key_exchange => ecdh_ecdsa, + cipher => null, + mac => sha, + prf => default_prf}; suite_definition(?TLS_ECDH_ECDSA_WITH_RC4_128_SHA) -> - {ecdh_ecdsa, rc4_128, sha, default_prf}; + #{key_exchange => ecdh_ecdsa, + cipher => rc4_128, + mac => sha, + prf => default_prf}; suite_definition(?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA) -> - {ecdh_ecdsa, '3des_ede_cbc', sha, default_prf}; + #{key_exchange => ecdh_ecdsa, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; suite_definition(?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA) -> - {ecdh_ecdsa, aes_128_cbc, sha, default_prf}; + #{key_exchange => ecdh_ecdsa, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA) -> - {ecdh_ecdsa, aes_256_cbc, sha, default_prf}; - + #{key_exchange => ecdh_ecdsa, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_ECDHE_ECDSA_WITH_NULL_SHA) -> - {ecdhe_ecdsa, null, sha, default_prf}; + #{key_exchange => ecdhe_ecdsa, + cipher => null, + mac => sha, + prf => default_prf}; suite_definition(?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA) -> - {ecdhe_ecdsa, rc4_128, sha, default_prf}; + #{key_exchange => ecdhe_ecdsa, + cipher => rc4_128, + mac => sha, + prf => default_prf}; suite_definition(?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA) -> - {ecdhe_ecdsa, '3des_ede_cbc', sha, default_prf}; + #{key_exchange => ecdhe_ecdsa, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA) -> - {ecdhe_ecdsa, aes_128_cbc, sha, default_prf}; + #{key_exchange => ecdhe_ecdsa, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA) -> - {ecdhe_ecdsa, aes_256_cbc, sha, default_prf}; - + #{key_exchange => ecdhe_ecdsa, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_ECDH_RSA_WITH_NULL_SHA) -> - {ecdh_rsa, null, sha, default_prf}; + #{key_exchange => ecdh_rsa, + cipher => null, + mac => sha, + prf => default_prf}; suite_definition(?TLS_ECDH_RSA_WITH_RC4_128_SHA) -> - {ecdh_rsa, rc4_128, sha, default_prf}; + #{key_exchange => ecdh_rsa, + cipher => rc4_128, + mac => sha, + prf => default_prf}; suite_definition(?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA) -> - {ecdh_rsa, '3des_ede_cbc', sha, default_prf}; + #{key_exchange => ecdh_rsa, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; suite_definition(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA) -> - {ecdh_rsa, aes_128_cbc, sha, default_prf}; + #{key_exchange => ecdh_rsa, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA) -> - {ecdh_rsa, aes_256_cbc, sha, default_prf}; - + #{key_exchange => ecdh_rsa, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_ECDHE_RSA_WITH_NULL_SHA) -> - {ecdhe_rsa, null, sha, default_prf}; + #{key_exchange => ecdhe_rsa, + cipher => null, + mac => sha, + prf => default_prf}; suite_definition(?TLS_ECDHE_RSA_WITH_RC4_128_SHA) -> - {ecdhe_rsa, rc4_128, sha, default_prf}; + #{key_exchange => ecdhe_rsa, + cipher => rc4_128, + mac => sha, + prf => default_prf}; suite_definition(?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA) -> - {ecdhe_rsa, '3des_ede_cbc', sha, default_prf}; + #{key_exchange => ecdhe_rsa, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; suite_definition(?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA) -> - {ecdhe_rsa, aes_128_cbc, sha, default_prf}; + #{key_exchange => ecdhe_rsa, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA) -> - {ecdhe_rsa, aes_256_cbc, sha, default_prf}; - + #{key_exchange => ecdhe_rsa, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_ECDH_anon_WITH_NULL_SHA) -> - {ecdh_anon, null, sha, default_prf}; + #{key_exchange => ecdh_anon, + cipher => null, + mac => sha, + prf => default_prf}; suite_definition(?TLS_ECDH_anon_WITH_RC4_128_SHA) -> - {ecdh_anon, rc4_128, sha, default_prf}; + #{key_exchange => ecdh_anon, + cipher => rc4_128, + mac => sha, + prf => default_prf}; suite_definition(?TLS_ECDH_anon_WITH_3DES_EDE_CBC_SHA) -> - {ecdh_anon, '3des_ede_cbc', sha, default_prf}; + #{key_exchange => ecdh_anon, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; suite_definition(?TLS_ECDH_anon_WITH_AES_128_CBC_SHA) -> - {ecdh_anon, aes_128_cbc, sha, default_prf}; + #{key_exchange => ecdh_anon, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; suite_definition(?TLS_ECDH_anon_WITH_AES_256_CBC_SHA) -> - {ecdh_anon, aes_256_cbc, sha, default_prf}; - + #{key_exchange => ecdh_anon, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; %% RFC 5289 EC TLS suites suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256) -> - {ecdhe_ecdsa, aes_128_cbc, sha256, sha256}; + #{key_exchange => ecdhe_ecdsa, + cipher => aes_128_cbc, + mac => sha256, + prf => sha256}; suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384) -> - {ecdhe_ecdsa, aes_256_cbc, sha384, sha384}; + #{key_exchange => ecdhe_ecdsa, + cipher => aes_256_cbc, + mac => sha384, + prf => sha384}; suite_definition(?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256) -> - {ecdh_ecdsa, aes_128_cbc, sha256, sha256}; + #{key_exchange => ecdh_ecdsa, + cipher => aes_128_cbc, + mac => sha256, + prf => sha256}; suite_definition(?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384) -> - {ecdh_ecdsa, aes_256_cbc, sha384, sha384}; + #{key_exchange => ecdh_ecdsa, + cipher => aes_256_cbc, + mac => sha384, + prf => sha384}; suite_definition(?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256) -> - {ecdhe_rsa, aes_128_cbc, sha256, sha256}; + #{key_exchange => ecdhe_rsa, + cipher => aes_128_cbc, + mac => sha256, + prf => sha256}; suite_definition(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384) -> - {ecdhe_rsa, aes_256_cbc, sha384, sha384}; + #{key_exchange => ecdhe_rsa, + cipher => aes_256_cbc, + mac => sha384, + prf => sha384}; suite_definition(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256) -> - {ecdh_rsa, aes_128_cbc, sha256, sha256}; + #{key_exchange => ecdh_rsa, + cipher => aes_128_cbc, + mac => sha256, + prf => sha256}; suite_definition(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384) -> - {ecdh_rsa, aes_256_cbc, sha384, sha384}; - + #{key_exchange => ecdh_rsa, + cipher => aes_256_cbc, + mac => sha384, + prf => sha384}; %% RFC 5288 AES-GCM Cipher Suites suite_definition(?TLS_RSA_WITH_AES_128_GCM_SHA256) -> - {rsa, aes_128_gcm, null, sha256}; + #{key_exchange => rsa, + cipher => aes_128_gcm, + mac => null, + prf => sha256}; suite_definition(?TLS_RSA_WITH_AES_256_GCM_SHA384) -> - {rsa, aes_256_gcm, null, sha384}; + #{key_exchange => rsa, + cipher => aes_256_gcm, + mac => null, + prf => sha384}; suite_definition(?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256) -> - {dhe_rsa, aes_128_gcm, null, sha256}; + #{key_exchange => dhe_rsa, + cipher => aes_128_gcm, + mac => null, + prf => sha256}; suite_definition(?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384) -> - {dhe_rsa, aes_256_gcm, null, sha384}; + #{key_exchange => dhe_rsa, + cipher => aes_256_gcm, + mac => null, + prf => sha384}; suite_definition(?TLS_DH_RSA_WITH_AES_128_GCM_SHA256) -> - {dh_rsa, aes_128_gcm, null, sha256}; + #{key_exchange => dh_rsa, + cipher => aes_128_gcm, + mac => null, + prf => sha256}; suite_definition(?TLS_DH_RSA_WITH_AES_256_GCM_SHA384) -> - {dh_rsa, aes_256_gcm, null, sha384}; + #{key_exchange => dh_rsa, + cipher => aes_256_gcm, + mac => null, + prf => sha384}; suite_definition(?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256) -> - {dhe_dss, aes_128_gcm, null, sha256}; + #{key_exchange => dhe_dss, + cipher => aes_128_gcm, + mac => null, + prf => sha256}; suite_definition(?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384) -> - {dhe_dss, aes_256_gcm, null, sha384}; + #{key_exchange => dhe_dss, + cipher => aes_256_gcm, + mac => null, + prf => sha384}; suite_definition(?TLS_DH_DSS_WITH_AES_128_GCM_SHA256) -> - {dh_dss, aes_128_gcm, null, sha256}; + #{key_exchange => dh_dss, + cipher => aes_128_gcm, + mac => null, + prf => sha256}; suite_definition(?TLS_DH_DSS_WITH_AES_256_GCM_SHA384) -> - {dh_dss, aes_256_gcm, null, sha384}; + #{key_exchange => dh_dss, + cipher => aes_256_gcm, + mac => null, + prf => sha384}; suite_definition(?TLS_DH_anon_WITH_AES_128_GCM_SHA256) -> - {dh_anon, aes_128_gcm, null, sha256}; + #{key_exchange => dh_anon, + cipher => aes_128_gcm, + mac => null, + prf => sha256}; suite_definition(?TLS_DH_anon_WITH_AES_256_GCM_SHA384) -> - {dh_anon, aes_256_gcm, null, sha384}; - + #{key_exchange => dh_anon, + cipher => aes_256_gcm, + mac => null, + prf => sha384}; %% RFC 5289 ECC AES-GCM Cipher Suites suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256) -> - {ecdhe_ecdsa, aes_128_gcm, null, sha256}; + #{key_exchange => ecdhe_ecdsa, + cipher => aes_128_gcm, + mac => null, + prf => sha256}; suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384) -> - {ecdhe_ecdsa, aes_256_gcm, null, sha384}; + #{key_exchange => ecdhe_ecdsa, + cipher => aes_256_gcm, + mac => null, + prf => sha384}; suite_definition(?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256) -> - {ecdh_ecdsa, aes_128_gcm, null, sha256}; + #{key_exchange => ecdh_ecdsa, + cipher => aes_128_gcm, + mac => null, + prf => sha256}; suite_definition(?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384) -> - {ecdh_ecdsa, aes_256_gcm, null, sha384}; + #{key_exchange => ecdh_ecdsa, + cipher => aes_256_gcm, + mac => null, + prf => sha384}; suite_definition(?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256) -> - {ecdhe_rsa, aes_128_gcm, null, sha256}; + #{key_exchange => ecdhe_rsa, + cipher => aes_128_gcm, + mac => null, + prf => sha256}; suite_definition(?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) -> - {ecdhe_rsa, aes_256_gcm, null, sha384}; + #{key_exchange => ecdhe_rsa, + cipher => aes_256_gcm, + mac => null, + prf => sha384}; suite_definition(?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256) -> - {ecdh_rsa, aes_128_gcm, null, sha256}; + #{key_exchange => ecdh_rsa, + cipher => aes_128_gcm, + mac => null, + prf => sha256}; suite_definition(?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384) -> - {ecdh_rsa, aes_256_gcm, null, sha384}; - + #{key_exchange => ecdh_rsa, + cipher => aes_256_gcm, + mac => null, + prf => sha384}; %% draft-agl-tls-chacha20poly1305-04 Chacha20/Poly1305 Suites suite_definition(?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> - {ecdhe_rsa, chacha20_poly1305, null, sha256}; + #{key_exchange => ecdhe_rsa, + cipher => chacha20_poly1305, + mac => null, + prf => sha256}; suite_definition(?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256) -> - {ecdhe_ecdsa, chacha20_poly1305, null, sha256}; + #{key_exchange => ecdhe_ecdsa, + cipher => chacha20_poly1305, + mac => null, + prf => sha256}; suite_definition(?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> - {dhe_rsa, chacha20_poly1305, null, sha256}. + #{key_exchange => dhe_rsa, + cipher => chacha20_poly1305, + mac => null, + prf => sha256}. %%-------------------------------------------------------------------- --spec erl_suite_definition(cipher_suite()) -> erl_cipher_suite(). +-spec erl_suite_definition(cipher_suite() | erl_cipher_suite()) -> old_erl_cipher_suite(). %% %% Description: Return erlang cipher suite definition. Filters last value %% for now (compatibility reasons). %%-------------------------------------------------------------------- -erl_suite_definition(S) -> - case suite_definition(S) of - {KeyExchange, Cipher, Hash, default_prf} -> +erl_suite_definition(Bin) when is_binary(Bin) -> + erl_suite_definition(suite_definition(Bin)); +erl_suite_definition(#{key_exchange := KeyExchange, cipher := Cipher, + mac := Hash, prf := Prf}) -> + case Prf of + default_prf -> {KeyExchange, Cipher, Hash}; - Suite -> - Suite + _ -> + {KeyExchange, Cipher, Hash, Prf} end. %%-------------------------------------------------------------------- @@ -772,288 +1208,607 @@ erl_suite_definition(S) -> %% %% Description: Return TLS cipher suite definition. %%-------------------------------------------------------------------- - %% TLS v1.1 suites -%%suite({rsa, null, md5}) -> -%% ?TLS_RSA_WITH_NULL_MD5; -%%suite({rsa, null, sha}) -> -%% ?TLS_RSA_WITH_NULL_SHA; -suite({rsa, rc4_128, md5}) -> +suite(#{key_exchange := rsa, + cipher := rc4_128, + mac := md5}) -> ?TLS_RSA_WITH_RC4_128_MD5; -suite({rsa, rc4_128, sha}) -> +suite(#{key_exchange := rsa, + cipher := rc4_128, + mac := sha}) -> ?TLS_RSA_WITH_RC4_128_SHA; -suite({rsa, des_cbc, sha}) -> +suite(#{key_exchange := rsa, + cipher := des_cbc, + mac := sha}) -> ?TLS_RSA_WITH_DES_CBC_SHA; -suite({rsa, '3des_ede_cbc', sha}) -> +suite(#{key_exchange := rsa, + cipher :='3des_ede_cbc', + mac := sha}) -> ?TLS_RSA_WITH_3DES_EDE_CBC_SHA; -suite({dhe_dss, des_cbc, sha}) -> +suite(#{key_exchange := dhe_dss, + cipher:= des_cbc, + mac := sha}) -> ?TLS_DHE_DSS_WITH_DES_CBC_SHA; -suite({dhe_dss, '3des_ede_cbc', sha}) -> +suite(#{key_exchange := dhe_dss, + cipher:= '3des_ede_cbc', + mac := sha}) -> ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA; -suite({dhe_rsa, des_cbc, sha}) -> +suite(#{key_exchange := dhe_rsa, + cipher:= des_cbc, + mac := sha}) -> ?TLS_DHE_RSA_WITH_DES_CBC_SHA; -suite({dhe_rsa, '3des_ede_cbc', sha}) -> +suite(#{key_exchange := dhe_rsa, + cipher:= '3des_ede_cbc', + mac := sha}) -> ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA; -suite({dh_anon, rc4_128, md5}) -> +suite(#{key_exchange := dh_anon, + cipher:= rc4_128, + mac := md5}) -> ?TLS_DH_anon_WITH_RC4_128_MD5; -suite({dh_anon, des_cbc, sha}) -> +suite(#{key_exchange := dh_anon, + cipher:= des_cbc, + mac := sha}) -> ?TLS_DH_anon_WITH_DES_CBC_SHA; -suite({dh_anon, '3des_ede_cbc', sha}) -> +suite(#{key_exchange := dh_anon, + cipher:= '3des_ede_cbc', + mac := sha}) -> ?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA; - %%% TSL V1.1 AES suites -suite({rsa, aes_128_cbc, sha}) -> +suite(#{key_exchange := rsa, + cipher := aes_128_cbc, + mac := sha}) -> ?TLS_RSA_WITH_AES_128_CBC_SHA; -suite({dhe_dss, aes_128_cbc, sha}) -> +suite(#{key_exchange := dhe_dss, + cipher := aes_128_cbc, + mac := sha}) -> ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA; -suite({dhe_rsa, aes_128_cbc, sha}) -> +suite(#{key_exchange := dhe_rsa, + cipher := aes_128_cbc, + mac := sha}) -> ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA; -suite({dh_anon, aes_128_cbc, sha}) -> +suite(#{key_exchange := dh_anon, + cipher := aes_128_cbc, + mac := sha}) -> ?TLS_DH_anon_WITH_AES_128_CBC_SHA; -suite({rsa, aes_256_cbc, sha}) -> +suite(#{key_exchange := rsa, + cipher := aes_256_cbc, + mac := sha}) -> ?TLS_RSA_WITH_AES_256_CBC_SHA; -suite({dhe_dss, aes_256_cbc, sha}) -> +suite(#{key_exchange := dhe_dss, + cipher := aes_256_cbc, + mac := sha}) -> ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA; -suite({dhe_rsa, aes_256_cbc, sha}) -> +suite(#{key_exchange := dhe_rsa, + cipher := aes_256_cbc, + mac := sha}) -> ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA; -suite({dh_anon, aes_256_cbc, sha}) -> +suite(#{key_exchange := dh_anon, + cipher := aes_256_cbc, + mac := sha}) -> ?TLS_DH_anon_WITH_AES_256_CBC_SHA; - %% TLS v1.2 suites - -%% suite_definition(?TLS_RSA_WITH_NULL_SHA) -> -%% {rsa, null, sha, sha256}; -suite({rsa, aes_128_cbc, sha256}) -> +suite(#{key_exchange := rsa, + cipher := aes_128_cbc, + mac := sha256}) -> ?TLS_RSA_WITH_AES_128_CBC_SHA256; -suite({rsa, aes_256_cbc, sha256}) -> +suite(#{key_exchange := rsa, + cipher := aes_256_cbc, + mac := sha256}) -> ?TLS_RSA_WITH_AES_256_CBC_SHA256; -suite({dhe_dss, aes_128_cbc, sha256}) -> +suite(#{key_exchange := dhe_dss, + cipher := aes_128_cbc, + mac := sha256}) -> ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256; -suite({dhe_rsa, aes_128_cbc, sha256}) -> +suite(#{key_exchange := dhe_rsa, + cipher := aes_128_cbc, + mac := sha256}) -> ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256; -suite({dhe_dss, aes_256_cbc, sha256}) -> +suite(#{key_exchange := dhe_dss, + cipher := aes_256_cbc, + mac := sha256}) -> ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256; -suite({dhe_rsa, aes_256_cbc, sha256}) -> +suite(#{key_exchange := dhe_rsa, + cipher := aes_256_cbc, + mac := sha256}) -> ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256; -suite({dh_anon, aes_128_cbc, sha256}) -> +suite(#{key_exchange := dh_anon, + cipher := aes_128_cbc, + mac := sha256}) -> ?TLS_DH_anon_WITH_AES_128_CBC_SHA256; -suite({dh_anon, aes_256_cbc, sha256}) -> +suite(#{key_exchange := dh_anon, + cipher := aes_256_cbc, + mac := sha256}) -> ?TLS_DH_anon_WITH_AES_256_CBC_SHA256; - %%% PSK Cipher Suites RFC 4279 - -suite({psk, rc4_128,sha}) -> +suite(#{key_exchange := psk, + cipher := rc4_128, + mac := sha}) -> ?TLS_PSK_WITH_RC4_128_SHA; -suite({psk, '3des_ede_cbc',sha}) -> +suite(#{key_exchange := psk, + cipher := '3des_ede_cbc', + mac := sha}) -> ?TLS_PSK_WITH_3DES_EDE_CBC_SHA; -suite({psk, aes_128_cbc,sha}) -> +suite(#{key_exchange := psk, + cipher := aes_128_cbc, + mac := sha}) -> ?TLS_PSK_WITH_AES_128_CBC_SHA; -suite({psk, aes_256_cbc,sha}) -> +suite(#{key_exchange := psk, + cipher := aes_256_cbc, + mac := sha}) -> ?TLS_PSK_WITH_AES_256_CBC_SHA; -suite({dhe_psk, rc4_128,sha}) -> +suite(#{key_exchange := dhe_psk, + cipher := rc4_128, + mac := sha}) -> ?TLS_DHE_PSK_WITH_RC4_128_SHA; -suite({dhe_psk, '3des_ede_cbc',sha}) -> +suite(#{key_exchange := dhe_psk, + cipher := '3des_ede_cbc', + mac := sha}) -> ?TLS_DHE_PSK_WITH_3DES_EDE_CBC_SHA; -suite({dhe_psk, aes_128_cbc,sha}) -> +suite(#{key_exchange := dhe_psk, + cipher := aes_128_cbc, + mac := sha}) -> ?TLS_DHE_PSK_WITH_AES_128_CBC_SHA; -suite({dhe_psk, aes_256_cbc,sha}) -> +suite(#{key_exchange := dhe_psk, + cipher := aes_256_cbc, + mac := sha}) -> ?TLS_DHE_PSK_WITH_AES_256_CBC_SHA; -suite({rsa_psk, rc4_128,sha}) -> +suite(#{key_exchange := rsa_psk, + cipher := rc4_128, + mac := sha}) -> ?TLS_RSA_PSK_WITH_RC4_128_SHA; -suite({rsa_psk, '3des_ede_cbc',sha}) -> +suite(#{key_exchange := rsa_psk, + cipher := '3des_ede_cbc', + mac := sha}) -> ?TLS_RSA_PSK_WITH_3DES_EDE_CBC_SHA; -suite({rsa_psk, aes_128_cbc,sha}) -> +suite(#{key_exchange := rsa_psk, + cipher := aes_128_cbc, + mac := sha}) -> ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA; -suite({rsa_psk, aes_256_cbc,sha}) -> +suite(#{key_exchange := rsa_psk, + cipher := aes_256_cbc, + mac := sha}) -> ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA; - +%%% PSK NULL Cipher Suites RFC 4785 +suite(#{key_exchange := psk, + cipher := null, + mac := sha}) -> + ?TLS_PSK_WITH_NULL_SHA; +suite(#{key_exchange := dhe_psk, + cipher := null, + mac := sha}) -> + ?TLS_DHE_PSK_WITH_NULL_SHA; +suite(#{key_exchange := rsa_psk, + cipher := null, + mac := sha}) -> + ?TLS_RSA_PSK_WITH_NULL_SHA; %%% TLS 1.2 PSK Cipher Suites RFC 5487 - -suite({psk, aes_128_gcm, null, sha256}) -> +suite(#{key_exchange := psk, + cipher := aes_128_gcm, + mac := null, + prf := sha256}) -> ?TLS_PSK_WITH_AES_128_GCM_SHA256; -suite({psk, aes_256_gcm, null, sha384}) -> +suite(#{key_exchange := psk, + cipher := aes_256_gcm, + mac := null, + prf := sha384}) -> ?TLS_PSK_WITH_AES_256_GCM_SHA384; -suite({dhe_psk, aes_128_gcm, null, sha256}) -> +suite(#{key_exchange := dhe_psk, + cipher := aes_128_gcm, + mac := null, + prf := sha256}) -> ?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256; -suite({dhe_psk, aes_256_gcm, null, sha384}) -> +suite(#{key_exchange := dhe_psk, + cipher := aes_256_gcm, + mac := null, + prf := sha384}) -> ?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384; -suite({rsa_psk, aes_128_gcm, null, sha256}) -> +suite(#{key_exchange := rsa_psk, + cipher := aes_128_gcm, + mac := null, + prf := sha256}) -> ?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256; -suite({rsa_psk, aes_256_gcm, null, sha384}) -> +suite(#{key_exchange := rsa_psk, + cipher := aes_256_gcm, + mac := null, + prf := sha384}) -> ?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384; - -suite({psk, aes_128_cbc, sha256}) -> +suite(#{key_exchange := psk, + cipher := aes_128_cbc, + mac := sha256}) -> ?TLS_PSK_WITH_AES_128_CBC_SHA256; -suite({psk, aes_256_cbc, sha384}) -> +suite(#{key_exchange := psk, + cipher := aes_256_cbc, + mac := sha384}) -> ?TLS_PSK_WITH_AES_256_CBC_SHA384; -suite({dhe_psk, aes_128_cbc, sha256}) -> +suite(#{key_exchange := dhe_psk, + cipher := aes_128_cbc, + mac := sha256}) -> ?TLS_DHE_PSK_WITH_AES_128_CBC_SHA256; -suite({dhe_psk, aes_256_cbc, sha384}) -> +suite(#{key_exchange := dhe_psk, + cipher := aes_256_cbc, + mac := sha384}) -> ?TLS_DHE_PSK_WITH_AES_256_CBC_SHA384; -suite({rsa_psk, aes_128_cbc, sha256}) -> +suite(#{key_exchange := rsa_psk, + cipher := aes_128_cbc, + mac := sha256}) -> ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256; -suite({rsa_psk, aes_256_cbc, sha384}) -> +suite(#{key_exchange := rsa_psk, + cipher := aes_256_cbc, + mac := sha384}) -> ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384; - -suite({psk, null, sha256}) -> +suite(#{key_exchange := psk, + cipher := null, + mac := sha256}) -> ?TLS_PSK_WITH_NULL_SHA256; -suite({psk, null, sha384}) -> +suite(#{key_exchange := psk, + cipher := null, + mac := sha384}) -> ?TLS_PSK_WITH_NULL_SHA384; -suite({dhe_psk, null, sha256}) -> +suite(#{key_exchange := dhe_psk, + cipher := null, + mac := sha256}) -> ?TLS_DHE_PSK_WITH_NULL_SHA256; -suite({dhe_psk, null, sha384}) -> +suite(#{key_exchange := dhe_psk, + cipher := null, + mac := sha384}) -> ?TLS_DHE_PSK_WITH_NULL_SHA384; -suite({rsa_psk, null, sha256}) -> +suite(#{key_exchange := rsa_psk, + cipher := null, + mac := sha256}) -> ?TLS_RSA_PSK_WITH_NULL_SHA256; -suite({rsa_psk, null, sha384}) -> +suite(#{key_exchange := rsa_psk, + cipher := null, + mac := sha384}) -> ?TLS_RSA_PSK_WITH_NULL_SHA384; - +%%% ECDHE PSK Cipher Suites RFC 5489 +suite(#{key_exchange := ecdhe_psk, + cipher := rc4_128, + mac := sha}) -> + ?TLS_ECDHE_PSK_WITH_RC4_128_SHA; +suite(#{key_exchange := ecdhe_psk, + cipher :='3des_ede_cbc', + mac := sha}) -> + ?TLS_ECDHE_PSK_WITH_3DES_EDE_CBC_SHA; +suite(#{key_exchange := ecdhe_psk, + cipher := aes_128_cbc, + mac := sha}) -> + ?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA; +suite(#{key_exchange := ecdhe_psk, + cipher := aes_256_cbc, + mac := sha}) -> + ?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA; +suite(#{key_exchange := ecdhe_psk, + cipher := aes_128_cbc, + mac := sha256}) -> + ?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256; +suite(#{key_exchange := ecdhe_psk, + cipher := aes_256_cbc, + mac := sha384}) -> + ?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384; +suite(#{key_exchange := ecdhe_psk, + cipher := null, + mac := sha256}) -> + ?TLS_ECDHE_PSK_WITH_NULL_SHA256; +suite(#{key_exchange := ecdhe_psk, + cipher := null, + mac := sha384}) -> + ?TLS_ECDHE_PSK_WITH_NULL_SHA384; +%%% ECDHE_PSK with AES-GCM and AES-CCM Cipher Suites, draft-ietf-tls-ecdhe-psk-aead-05 +suite(#{key_exchange := ecdhe_psk, + cipher := aes_128_gcm, + mac := null, + prf := sha256}) -> + ?TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256; +suite(#{key_exchange := ecdhe_psk, + cipher := aes_256_gcm, + mac := null, + prf := sha384}) -> + ?TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384; + %% suite(#{key_exchange := ecdhe_psk, + %% cipher := aes_128_ccm, + %% mac := null, + %% prf := sha256}) -> + %% ?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256; + %% suite(#{key_exchange := ecdhe_psk, + %% cipher := aes_256_ccm, + %% mac := null, + %% prf := sha256}) -> + %% ?TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256; %%% SRP Cipher Suites RFC 5054 - -suite({srp_anon, '3des_ede_cbc', sha}) -> +suite(#{key_exchange := srp_anon, + cipher := '3des_ede_cbc', + mac := sha}) -> ?TLS_SRP_SHA_WITH_3DES_EDE_CBC_SHA; -suite({srp_rsa, '3des_ede_cbc', sha}) -> +suite(#{key_exchange := srp_rsa, + cipher := '3des_ede_cbc', + mac := sha}) -> ?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA; -suite({srp_dss, '3des_ede_cbc', sha}) -> +suite(#{key_exchange := srp_dss, + cipher := '3des_ede_cbc', + mac := sha}) -> ?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA; -suite({srp_anon, aes_128_cbc, sha}) -> +suite(#{key_exchange := srp_anon, + cipher := aes_128_cbc, + mac := sha}) -> ?TLS_SRP_SHA_WITH_AES_128_CBC_SHA; -suite({srp_rsa, aes_128_cbc, sha}) -> +suite(#{key_exchange := srp_rsa, + cipher := aes_128_cbc, + mac := sha}) -> ?TLS_SRP_SHA_RSA_WITH_AES_128_CBC_SHA; -suite({srp_dss, aes_128_cbc, sha}) -> +suite(#{key_exchange := srp_dss, + cipher := aes_128_cbc, + mac := sha}) -> ?TLS_SRP_SHA_DSS_WITH_AES_128_CBC_SHA; -suite({srp_anon, aes_256_cbc, sha}) -> +suite(#{key_exchange := srp_anon, + cipher := aes_256_cbc, + mac := sha}) -> ?TLS_SRP_SHA_WITH_AES_256_CBC_SHA; -suite({srp_rsa, aes_256_cbc, sha}) -> +suite(#{key_exchange := srp_rsa, + cipher := aes_256_cbc, + mac := sha}) -> ?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA; -suite({srp_dss, aes_256_cbc, sha}) -> +suite(#{key_exchange := srp_dss, + cipher := aes_256_cbc, + mac := sha}) -> ?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA; - %%% RFC 4492 EC TLS suites -suite({ecdh_ecdsa, null, sha}) -> +suite(#{key_exchange := ecdh_ecdsa, + cipher := null, + mac := sha}) -> ?TLS_ECDH_ECDSA_WITH_NULL_SHA; -suite({ecdh_ecdsa, rc4_128, sha}) -> +suite(#{key_exchange := ecdh_ecdsa, + cipher := rc4_128, + mac := sha}) -> ?TLS_ECDH_ECDSA_WITH_RC4_128_SHA; -suite({ecdh_ecdsa, '3des_ede_cbc', sha}) -> +suite(#{key_exchange := ecdh_ecdsa, + cipher := '3des_ede_cbc', + mac := sha}) -> ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA; -suite({ecdh_ecdsa, aes_128_cbc, sha}) -> +suite(#{key_exchange := ecdh_ecdsa, + cipher := aes_128_cbc, + mac := sha}) -> ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA; -suite({ecdh_ecdsa, aes_256_cbc, sha}) -> +suite(#{key_exchange := ecdh_ecdsa, + cipher := aes_256_cbc, + mac := sha}) -> ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA; - -suite({ecdhe_ecdsa, null, sha}) -> +suite(#{key_exchange := ecdhe_ecdsa, + cipher := null, + mac := sha}) -> ?TLS_ECDHE_ECDSA_WITH_NULL_SHA; -suite({ecdhe_ecdsa, rc4_128, sha}) -> +suite(#{key_exchange := ecdhe_ecdsa, + cipher := rc4_128, + mac := sha}) -> ?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA; -suite({ecdhe_ecdsa, '3des_ede_cbc', sha}) -> +suite(#{key_exchange := ecdhe_ecdsa, + cipher := '3des_ede_cbc', + mac := sha}) -> ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA; -suite({ecdhe_ecdsa, aes_128_cbc, sha}) -> +suite(#{key_exchange := ecdhe_ecdsa, + cipher := aes_128_cbc, + mac := sha}) -> ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA; -suite({ecdhe_ecdsa, aes_256_cbc, sha}) -> +suite(#{key_exchange := ecdhe_ecdsa, + cipher := aes_256_cbc, + mac := sha}) -> ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA; - -suite({ecdh_rsa, null, sha}) -> +suite(#{key_exchange := ecdh_rsa, + cipher := null, + mac := sha}) -> ?TLS_ECDH_RSA_WITH_NULL_SHA; -suite({ecdh_rsa, rc4_128, sha}) -> +suite(#{key_exchange := ecdh_rsa, + cipher := rc4_128, + mac := sha}) -> ?TLS_ECDH_RSA_WITH_RC4_128_SHA; -suite({ecdh_rsa, '3des_ede_cbc', sha}) -> +suite(#{key_exchange := ecdh_rsa, + cipher := '3des_ede_cbc', mac := sha}) -> ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA; -suite({ecdh_rsa, aes_128_cbc, sha}) -> +suite(#{key_exchange := ecdh_rsa, + cipher := aes_128_cbc, + mac := sha}) -> ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA; -suite({ecdh_rsa, aes_256_cbc, sha}) -> +suite(#{key_exchange := ecdh_rsa, + cipher := aes_256_cbc, + mac := sha}) -> ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA; - -suite({ecdhe_rsa, null, sha}) -> +suite(#{key_exchange := ecdhe_rsa, + cipher := null, + mac := sha}) -> ?TLS_ECDHE_RSA_WITH_NULL_SHA; -suite({ecdhe_rsa, rc4_128, sha}) -> +suite(#{key_exchange := ecdhe_rsa, + cipher := rc4_128, + mac := sha}) -> ?TLS_ECDHE_RSA_WITH_RC4_128_SHA; -suite({ecdhe_rsa, '3des_ede_cbc', sha}) -> +suite(#{key_exchange := ecdhe_rsa, + cipher := '3des_ede_cbc', + mac := sha}) -> ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA; -suite({ecdhe_rsa, aes_128_cbc, sha}) -> +suite(#{key_exchange := ecdhe_rsa, + cipher := aes_128_cbc, + mac := sha}) -> ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA; -suite({ecdhe_rsa, aes_256_cbc, sha}) -> +suite(#{key_exchange := ecdhe_rsa, + cipher := aes_256_cbc, + mac := sha}) -> ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA; - -suite({ecdh_anon, null, sha}) -> +suite(#{key_exchange := ecdh_anon, + cipher := null, + mac := sha}) -> ?TLS_ECDH_anon_WITH_NULL_SHA; -suite({ecdh_anon, rc4_128, sha}) -> +suite(#{key_exchange := ecdh_anon, + cipher := rc4_128, + mac := sha}) -> ?TLS_ECDH_anon_WITH_RC4_128_SHA; -suite({ecdh_anon, '3des_ede_cbc', sha}) -> +suite(#{key_exchange := ecdh_anon, + cipher := '3des_ede_cbc', + mac := sha}) -> ?TLS_ECDH_anon_WITH_3DES_EDE_CBC_SHA; -suite({ecdh_anon, aes_128_cbc, sha}) -> +suite(#{key_exchange := ecdh_anon, + cipher := aes_128_cbc, + mac := sha}) -> ?TLS_ECDH_anon_WITH_AES_128_CBC_SHA; -suite({ecdh_anon, aes_256_cbc, sha}) -> +suite(#{key_exchange := ecdh_anon, + cipher := aes_256_cbc, + mac := sha}) -> ?TLS_ECDH_anon_WITH_AES_256_CBC_SHA; - %%% RFC 5289 EC TLS suites -suite({ecdhe_ecdsa, aes_128_cbc, sha256, sha256}) -> +suite(#{key_exchange := ecdhe_ecdsa, + cipher := aes_128_cbc, + mac:= sha256, + prf := sha256}) -> ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256; -suite({ecdhe_ecdsa, aes_256_cbc, sha384, sha384}) -> +suite(#{key_exchange := ecdhe_ecdsa, + cipher := aes_256_cbc, + mac := sha384, + prf := sha384}) -> ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384; -suite({ecdh_ecdsa, aes_128_cbc, sha256, sha256}) -> +suite(#{key_exchange := ecdh_ecdsa, + cipher := aes_128_cbc, + mac := sha256, + prf := sha256}) -> ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256; -suite({ecdh_ecdsa, aes_256_cbc, sha384, sha384}) -> +suite(#{key_exchange := ecdh_ecdsa, + cipher := aes_256_cbc, + mac := sha384, + prf := sha384}) -> ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384; -suite({ecdhe_rsa, aes_128_cbc, sha256, sha256}) -> +suite(#{key_exchange := ecdhe_rsa, + cipher := aes_128_cbc, + mac := sha256, + prf := sha256}) -> ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256; -suite({ecdhe_rsa, aes_256_cbc, sha384, sha384}) -> +suite(#{key_exchange := ecdhe_rsa, + cipher := aes_256_cbc, + mac := sha384, + prf := sha384}) -> ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384; -suite({ecdh_rsa, aes_128_cbc, sha256, sha256}) -> +suite(#{key_exchange := ecdh_rsa, + cipher := aes_128_cbc, + mac := sha256, + prf := sha256}) -> ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256; -suite({ecdh_rsa, aes_256_cbc, sha384, sha384}) -> +suite(#{key_exchange := ecdh_rsa, + cipher := aes_256_cbc, + mac := sha384, + prf := sha384}) -> ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384; - %% RFC 5288 AES-GCM Cipher Suites -suite({rsa, aes_128_gcm, null, sha256}) -> +suite(#{key_exchange := rsa, + cipher := aes_128_gcm, + mac := null, + prf := sha256}) -> ?TLS_RSA_WITH_AES_128_GCM_SHA256; -suite({rsa, aes_256_gcm, null, sha384}) -> +suite(#{key_exchange := rsa, + cipher := aes_256_gcm, + mac := null, + prf := sha384}) -> ?TLS_RSA_WITH_AES_256_GCM_SHA384; -suite({dhe_rsa, aes_128_gcm, null, sha256}) -> +suite(#{key_exchange := dhe_rsa, + cipher := aes_128_gcm, + mac := null, + prf := sha256}) -> ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256; -suite({dhe_rsa, aes_256_gcm, null, sha384}) -> +suite(#{key_exchange := dhe_rsa, + cipher := aes_256_gcm, + mac := null, + prf := sha384}) -> ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384; -suite({dh_rsa, aes_128_gcm, null, sha256}) -> +suite(#{key_exchange := dh_rsa, + cipher := aes_128_gcm, + mac := null, + prf := sha256}) -> ?TLS_DH_RSA_WITH_AES_128_GCM_SHA256; -suite({dh_rsa, aes_256_gcm, null, sha384}) -> +suite(#{key_exchange := dh_rsa, + cipher := aes_256_gcm, + mac := null, + prf := sha384}) -> ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384; -suite({dhe_dss, aes_128_gcm, null, sha256}) -> +suite(#{key_exchange := dhe_dss, + cipher := aes_128_gcm, + mac := null, + prf := sha256}) -> ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256; -suite({dhe_dss, aes_256_gcm, null, sha384}) -> +suite(#{key_exchange := dhe_dss, + cipher := aes_256_gcm, + mac := null, + prf := sha384}) -> ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384; -suite({dh_dss, aes_128_gcm, null, sha256}) -> +suite(#{key_exchange := dh_dss, + cipher := aes_128_gcm, + mac := null, + prf := sha256}) -> ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256; -suite({dh_dss, aes_256_gcm, null, sha384}) -> +suite(#{key_exchange := dh_dss, + cipher := aes_256_gcm, + mac := null, + prf := sha384}) -> ?TLS_DH_DSS_WITH_AES_256_GCM_SHA384; -suite({dh_anon, aes_128_gcm, null, sha256}) -> +suite(#{key_exchange := dh_anon, + cipher := aes_128_gcm, + mac := null, + prf := sha256}) -> ?TLS_DH_anon_WITH_AES_128_GCM_SHA256; -suite({dh_anon, aes_256_gcm, null, sha384}) -> +suite(#{key_exchange := dh_anon, + cipher := aes_256_gcm, + mac := null, + prf := sha384}) -> ?TLS_DH_anon_WITH_AES_256_GCM_SHA384; - %% RFC 5289 ECC AES-GCM Cipher Suites -suite({ecdhe_ecdsa, aes_128_gcm, null, sha256}) -> +suite(#{key_exchange := ecdhe_ecdsa, + cipher := aes_128_gcm, + mac := null, + prf := sha256}) -> ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256; -suite({ecdhe_ecdsa, aes_256_gcm, null, sha384}) -> +suite(#{key_exchange := ecdhe_ecdsa, + cipher := aes_256_gcm, + mac := null, + prf := sha384}) -> ?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384; -suite({ecdh_ecdsa, aes_128_gcm, null, sha256}) -> +suite(#{key_exchange := ecdh_ecdsa, + cipher := aes_128_gcm, + mac := null, + prf := sha256}) -> ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256; -suite({ecdh_ecdsa, aes_256_gcm, null, sha384}) -> +suite(#{key_exchange := ecdh_ecdsa, + cipher := aes_256_gcm, + mac := null, + prf := sha384}) -> ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384; -suite({ecdhe_rsa, aes_128_gcm, null, sha256}) -> +suite(#{key_exchange := ecdhe_rsa, + cipher := aes_128_gcm, + mac := null, + prf := sha256}) -> ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256; -suite({ecdhe_rsa, aes_256_gcm, null, sha384}) -> +suite(#{key_exchange := ecdhe_rsa, + cipher := aes_256_gcm, + mac := null, + prf := sha384}) -> ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384; -suite({ecdh_rsa, aes_128_gcm, null, sha256}) -> +suite(#{key_exchange := ecdh_rsa, + cipher := aes_128_gcm, + mac := null, + prf := sha256}) -> ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256; -suite({ecdh_rsa, aes_256_gcm, null, sha384}) -> +suite(#{key_exchange := ecdh_rsa, + cipher := aes_256_gcm, + mac := null, + prf := sha384}) -> ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384; - - %% draft-agl-tls-chacha20poly1305-04 Chacha20/Poly1305 Suites -suite({ecdhe_rsa, chacha20_poly1305, null, sha256}) -> +suite(#{key_exchange := ecdhe_rsa, + cipher := chacha20_poly1305, + mac := null, + prf := sha256}) -> ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256; -suite({ecdhe_ecdsa, chacha20_poly1305, null, sha256}) -> +suite(#{key_exchange := ecdhe_ecdsa, + cipher := chacha20_poly1305, + mac := null, + prf := sha256}) -> ?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256; -suite({dhe_rsa, chacha20_poly1305, null, sha256}) -> +suite(#{key_exchange := dhe_rsa, + cipher := chacha20_poly1305, + mac := null, + prf := sha256}) -> ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256. %%-------------------------------------------------------------------- @@ -1430,14 +2185,13 @@ filter(DerCert, Ciphers) -> %% %% Description: Filter suites for algorithms supported by crypto. %%------------------------------------------------------------------- -filter_suites(Suites = [Value|_]) when is_tuple(Value) -> +filter_suites(Suites = [Value|_]) when is_map(Value) -> Algos = crypto:supports(), Hashs = proplists:get_value(hashs, Algos), - lists:filter(fun({KeyExchange, Cipher, Hash}) -> - is_acceptable_keyexchange(KeyExchange, proplists:get_value(public_keys, Algos)) andalso - is_acceptable_cipher(Cipher, proplists:get_value(ciphers, Algos)) andalso - is_acceptable_hash(Hash, proplists:get_value(hashs, Algos)); - ({KeyExchange, Cipher, Hash, Prf}) -> + lists:filter(fun(#{key_exchange := KeyExchange, + cipher := Cipher, + mac := Hash, + prf := Prf}) -> is_acceptable_keyexchange(KeyExchange, proplists:get_value(public_keys, Algos)) andalso is_acceptable_cipher(Cipher, proplists:get_value(ciphers, Algos)) andalso is_acceptable_hash(Hash, Hashs) andalso @@ -1448,9 +2202,12 @@ filter_suites(Suites) -> Algos = crypto:supports(), Hashs = proplists:get_value(hashs, Algos), lists:filter(fun(Suite) -> - {KeyExchange, Cipher, Hash, Prf} = ssl_cipher:suite_definition(Suite), + #{key_exchange := KeyExchange, + cipher := Cipher, + mac := Hash, + prf := Prf} = suite_definition(Suite), is_acceptable_keyexchange(KeyExchange, proplists:get_value(public_keys, Algos)) andalso - is_acceptable_cipher(Cipher, proplists:get_value(ciphers, Algos)) andalso + is_acceptable_cipher(Cipher, proplists:get_value(ciphers, Algos)) andalso is_acceptable_hash(Hash, Hashs) andalso is_acceptable_prf(Prf, Hashs) end, Suites). @@ -1467,7 +2224,8 @@ is_acceptable_keyexchange(dhe_dss, Algos) -> is_acceptable_keyexchange(dhe_rsa, Algos) -> proplists:get_bool(dh, Algos) andalso proplists:get_bool(rsa, Algos); -is_acceptable_keyexchange(ecdh_anon, Algos) -> +is_acceptable_keyexchange(KeyExchange, Algos) when KeyExchange == ecdh_anon; + KeyExchange == ecdhe_psk -> proplists:get_bool(ecdh, Algos); is_acceptable_keyexchange(KeyExchange, Algos) when KeyExchange == ecdh_ecdsa; KeyExchange == ecdhe_ecdsa -> diff --git a/lib/ssl/src/ssl_cipher.hrl b/lib/ssl/src/ssl_cipher.hrl index 8e8f3d9c67..e5462d8402 100644 --- a/lib/ssl/src/ssl_cipher.hrl +++ b/lib/ssl/src/ssl_cipher.hrl @@ -399,6 +399,17 @@ %% TLS_RSA_PSK_WITH_AES_256_CBC_SHA = { 0x00, 0x95 }; -define(TLS_RSA_PSK_WITH_AES_256_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#95)>>). +%%% PSK NULL Cipher Suites RFC 4785 + +%% TLS_PSK_WITH_NULL_SHA = { 0x00, 0x2C }; +-define(TLS_PSK_WITH_NULL_SHA, <<?BYTE(16#00), ?BYTE(16#2C)>>). + +%% TLS_DHE_PSK_WITH_NULL_SHA = { 0x00, 0x2D }; +-define(TLS_DHE_PSK_WITH_NULL_SHA, <<?BYTE(16#00), ?BYTE(16#2D)>>). + +%% TLS_RSA_PSK_WITH_NULL_SHA = { 0x00, 0x2E }; +-define(TLS_RSA_PSK_WITH_NULL_SHA, <<?BYTE(16#00), ?BYTE(16#2E)>>). + %%% TLS 1.2 PSK Cipher Suites RFC 5487 %% TLS_PSK_WITH_AES_128_GCM_SHA256 = {0x00,0xA8}; @@ -455,6 +466,46 @@ %% TLS_RSA_PSK_WITH_NULL_SHA384 = {0x00,0xB9}; -define(TLS_RSA_PSK_WITH_NULL_SHA384, <<?BYTE(16#00), ?BYTE(16#B9)>>). +%%% ECDHE PSK Cipher Suites RFC 5489 + +%% TLS_ECDHE_PSK_WITH_RC4_128_SHA = {0xC0,0x33}; +-define(TLS_ECDHE_PSK_WITH_RC4_128_SHA, <<?BYTE(16#C0), ?BYTE(16#33)>>). + +%% TLS_ECDHE_PSK_WITH_3DES_EDE_CBC_SHA = {0xC0,0x34}; +-define(TLS_ECDHE_PSK_WITH_3DES_EDE_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#34)>>). + +%% TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA = {0xC0,0x35}; +-define(TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#35)>>). + +%% TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA = {0xC0,0x36}; +-define(TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#36)>>). + +%% TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256 = {0xC0,0x37}; +-define(TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256, <<?BYTE(16#C0), ?BYTE(16#37)>>). + +%% TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384 = {0xC0,0x38}; +-define(TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384, <<?BYTE(16#C0), ?BYTE(16#38)>>). + +%% TLS_ECDHE_PSK_WITH_NULL_SHA256 = {0xC0,0x3A}; +-define(TLS_ECDHE_PSK_WITH_NULL_SHA256, <<?BYTE(16#C0), ?BYTE(16#3A)>>). + +%% TLS_ECDHE_PSK_WITH_NULL_SHA384 = {0xC0,0x3B}; +-define(TLS_ECDHE_PSK_WITH_NULL_SHA384, <<?BYTE(16#C0), ?BYTE(16#3B)>>). + +%%% ECDHE_PSK with AES-GCM and AES-CCM Cipher Suites, draft-ietf-tls-ecdhe-psk-aead-05 + +%% TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256 = {0xTBD; 0xTBD} {0xD0,0x01}; +-define(TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256, <<?BYTE(16#D0), ?BYTE(16#01)>>). + +%% TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384 = {0xTBD; 0xTBD} {0xD0,0x02}; +-define(TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384, <<?BYTE(16#D0), ?BYTE(16#02)>>). + +%% TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256 = {0xTBD; 0xTBD} {0xD0,0x03}; +-define(TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256, <<?BYTE(16#D0), ?BYTE(16#03)>>). + +%% TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256 = {0xTBD; 0xTBD} {0xD0,0x05}; +-define(TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256, <<?BYTE(16#D0), ?BYTE(16#05)>>). + %%% SRP Cipher Suites RFC 5054 %% TLS_SRP_SHA_WITH_3DES_EDE_CBC_SHA = { 0xC0,0x1A }; diff --git a/lib/ssl/src/ssl_config.erl b/lib/ssl/src/ssl_config.erl index e4611995ec..022fb7eac0 100644 --- a/lib/ssl/src/ssl_config.erl +++ b/lib/ssl/src/ssl_config.erl @@ -91,7 +91,15 @@ init_certificates(undefined, #{pem_cache := PemCache} = Config, CertFile, server end; init_certificates(Cert, Config, _, _) -> {ok, Config#{own_certificate => Cert}}. - +init_private_key(_, #{algorithm := Alg} = Key, <<>>, _Password, _Client) when Alg == ecdsa; + Alg == rsa; + Alg == dss -> + case maps:is_key(engine, Key) andalso maps:is_key(key_id, Key) of + true -> + Key; + false -> + throw({key, {invalid_key_id, Key}}) + end; init_private_key(_, undefined, <<>>, _Password, _Client) -> undefined; init_private_key(DbHandle, undefined, KeyFile, Password, _) -> diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 6a1df3c56d..d046145dff 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -44,31 +44,35 @@ -export([send/2, recv/3, close/2, shutdown/2, new_user/2, get_opts/2, set_opts/2, peer_certificate/1, renegotiation/1, negotiated_protocol/1, prf/5, - connection_information/2, handle_common_event/5 + connection_information/2 ]). +%% Alert and close handling +-export([handle_own_alert/4, handle_alert/3, + handle_normal_shutdown/3, stop/2, stop_and_reply/3 + ]). + +%% Data handling +-export([write_application_data/3, read_application_data/2]). + +%% Help functions for tls|dtls_connection.erl +-export([handle_session/7, ssl_config/3, + prepare_connection/2, hibernate_after/3]). + %% General gen_statem state functions with extra callback argument %% to determine if it is an SSL/TLS or DTLS gen_statem machine --export([init/4, hello/4, abbreviated/4, certify/4, cipher/4, connection/4, downgrade/4]). +-export([init/4, error/4, hello/4, abbreviated/4, certify/4, cipher/4, + connection/4, death_row/4, downgrade/4]). %% gen_statem callbacks -export([terminate/3, format_status/2]). -%% --export([handle_info/3, handle_call/5, handle_session/7, ssl_config/3, - prepare_connection/2, hibernate_after/3]). - -%% Alert and close handling --export([handle_own_alert/4,handle_alert/3, - handle_normal_shutdown/3 - ]). - -%% Data handling --export([write_application_data/3, read_application_data/2]). +%% Erlang Distribution export +-export([get_sslsocket/1, handshake_complete/3]). %%==================================================================== -%% Internal application API -%%==================================================================== +%% Setup +%%==================================================================== %%-------------------------------------------------------------------- -spec connect(tls_connection | dtls_connection, host(), inet:port_number(), @@ -146,8 +150,8 @@ socket_control(Connection, Socket, Pid, Transport) -> -spec socket_control(tls_connection | dtls_connection, port(), pid(), atom(), pid()| undefined) -> {ok, #sslsocket{}} | {error, reason()}. %%-------------------------------------------------------------------- -socket_control(Connection, Socket, Pid, Transport, udp_listner) -> - %% dtls listner process must have the socket control +socket_control(Connection, Socket, Pid, Transport, udp_listener) -> + %% dtls listener process must have the socket control {ok, Connection:socket(Pid, Transport, Socket, Connection, undefined)}; socket_control(tls_connection = Connection, Socket, Pid, Transport, ListenTracker) -> @@ -164,6 +168,16 @@ socket_control(dtls_connection = Connection, {_, Socket}, Pid, Transport, Listen {error, Reason} -> {error, Reason} end. + +start_or_recv_cancel_timer(infinity, _RecvFrom) -> + undefined; +start_or_recv_cancel_timer(Timeout, RecvFrom) -> + erlang:send_after(Timeout, self(), {cancel_start_or_recv, RecvFrom}). + +%%==================================================================== +%% User events +%%==================================================================== + %%-------------------------------------------------------------------- -spec send(pid(), iodata()) -> ok | {error, reason()}. %% @@ -262,6 +276,13 @@ peer_certificate(ConnectionPid) -> renegotiation(ConnectionPid) -> call(ConnectionPid, renegotiate). + +get_sslsocket(ConnectionPid) -> + call(ConnectionPid, get_sslsocket). + +handshake_complete(ConnectionPid, Node, DHandle) -> + call(ConnectionPid, {handshake_complete, Node, DHandle}). + %%-------------------------------------------------------------------- -spec prf(pid(), binary() | 'master_secret', binary(), [binary() | ssl:prf_random()], non_neg_integer()) -> @@ -272,6 +293,197 @@ renegotiation(ConnectionPid) -> prf(ConnectionPid, Secret, Label, Seed, WantedLength) -> call(ConnectionPid, {prf, Secret, Label, Seed, WantedLength}). +%%==================================================================== +%% Alert and close handling +%%==================================================================== +handle_own_alert(Alert, Version, StateName, + #state{role = Role, + transport_cb = Transport, + socket = Socket, + protocol_cb = Connection, + connection_states = ConnectionStates, + ssl_options = SslOpts} = State) -> + try %% Try to tell the other side + {BinMsg, _} = + Connection:encode_alert(Alert, Version, ConnectionStates), + Connection:send(Transport, Socket, BinMsg) + catch _:_ -> %% Can crash if we are in a uninitialized state + ignore + end, + try %% Try to tell the local user + log_alert(SslOpts#ssl_options.log_alert, Role, Connection:protocol_name(), StateName, Alert#alert{role = Role}), + handle_normal_shutdown(Alert,StateName, State) + catch _:_ -> + ok + end, + stop({shutdown, own_alert}, State). + +handle_normal_shutdown(Alert, _, #state{socket = Socket, + transport_cb = Transport, + protocol_cb = Connection, + start_or_recv_from = StartFrom, + tracker = Tracker, + role = Role, renegotiation = {false, first}}) -> + alert_user(Transport, Tracker,Socket, StartFrom, Alert, Role, Connection); + +handle_normal_shutdown(Alert, StateName, #state{socket = Socket, + socket_options = Opts, + transport_cb = Transport, + protocol_cb = Connection, + user_application = {_Mon, Pid}, + tracker = Tracker, + start_or_recv_from = RecvFrom, role = Role}) -> + alert_user(Transport, Tracker, Socket, StateName, Opts, Pid, RecvFrom, Alert, Role, Connection). + +handle_alert(#alert{level = ?FATAL} = Alert, StateName, + #state{socket = Socket, transport_cb = Transport, + protocol_cb = Connection, + ssl_options = SslOpts, start_or_recv_from = From, host = Host, + port = Port, session = Session, user_application = {_Mon, Pid}, + role = Role, socket_options = Opts, tracker = Tracker} = State) -> + invalidate_session(Role, Host, Port, Session), + log_alert(SslOpts#ssl_options.log_alert, Role, Connection:protocol_name(), + StateName, Alert#alert{role = opposite_role(Role)}), + alert_user(Transport, Tracker, Socket, StateName, Opts, Pid, From, Alert, Role, Connection), + stop(normal, State); + +handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert, + StateName, State) -> + handle_normal_shutdown(Alert, StateName, State), + stop({shutdown, peer_close}, State); + +handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName, + #state{role = Role, ssl_options = SslOpts, protocol_cb = Connection, renegotiation = {true, internal}} = State) -> + log_alert(SslOpts#ssl_options.log_alert, Role, + Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}), + handle_normal_shutdown(Alert, StateName, State), + stop({shutdown, peer_close}, State); + +handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName, + #state{role = Role, + ssl_options = SslOpts, renegotiation = {true, From}, + protocol_cb = Connection} = State0) -> + log_alert(SslOpts#ssl_options.log_alert, Role, + Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}), + gen_statem:reply(From, {error, renegotiation_rejected}), + {Record, State1} = Connection:next_record(State0), + %% Go back to connection! + State = Connection:reinit_handshake_data(State1#state{renegotiation = undefined}), + Connection:next_event(connection, Record, State); + +%% Gracefully log and ignore all other warning alerts +handle_alert(#alert{level = ?WARNING} = Alert, StateName, + #state{ssl_options = SslOpts, protocol_cb = Connection, role = Role} = State0) -> + log_alert(SslOpts#ssl_options.log_alert, Role, + Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}), + {Record, State} = Connection:next_record(State0), + Connection:next_event(StateName, Record, State). + +%%==================================================================== +%% Data handling +%%==================================================================== +write_application_data(Data0, {FromPid, _} = From, + #state{socket = Socket, + negotiated_version = Version, + protocol_cb = Connection, + transport_cb = Transport, + connection_states = ConnectionStates0, + socket_options = SockOpts, + ssl_options = #ssl_options{renegotiate_at = RenegotiateAt}} = State) -> + Data = encode_packet(Data0, SockOpts), + + case time_to_renegotiate(Data, ConnectionStates0, RenegotiateAt) of + true -> + Connection:renegotiate(State#state{renegotiation = {true, internal}}, + [{next_event, {call, From}, {application_data, Data0}}]); + false -> + {Msgs, ConnectionStates} = + Connection:encode_data(Data, Version, ConnectionStates0), + NewState = State#state{connection_states = ConnectionStates}, + case Connection:send(Transport, Socket, Msgs) of + ok when FromPid =:= self() -> + hibernate_after(connection, NewState, []); + Error when FromPid =:= self() -> + stop({shutdown, Error}, NewState); + ok -> + hibernate_after(connection, NewState, [{reply, From, ok}]); + Result -> + hibernate_after(connection, NewState, [{reply, From, Result}]) + end + end. + +read_application_data(Data, #state{user_application = {_Mon, Pid}, + socket = Socket, + protocol_cb = Connection, + transport_cb = Transport, + socket_options = SOpts, + bytes_to_read = BytesToRead, + start_or_recv_from = RecvFrom, + timer = Timer, + user_data_buffer = Buffer0, + tracker = Tracker} = State0) -> + Buffer1 = if + Buffer0 =:= <<>> -> Data; + Data =:= <<>> -> Buffer0; + true -> <<Buffer0/binary, Data/binary>> + end, + case get_data(SOpts, BytesToRead, Buffer1) of + {ok, ClientData, Buffer} -> % Send data + case State0 of + #state{ + ssl_options = #ssl_options{erl_dist = true}, + protocol_specific = #{d_handle := DHandle}} -> + State = + State0#state{ + user_data_buffer = Buffer, + bytes_to_read = undefined}, + try erlang:dist_ctrl_put_data(DHandle, ClientData) of + _ + when SOpts#socket_options.active =:= false; + Buffer =:= <<>> -> + %% Passive mode, wait for active once or recv + %% Active and empty, get more data + Connection:next_record_if_active(State); + _ -> %% We have more data + read_application_data(<<>>, State) + catch error:_ -> + death_row(State, disconnect) + end; + _ -> + SocketOpt = + deliver_app_data( + Transport, Socket, SOpts, + ClientData, Pid, RecvFrom, Tracker, Connection), + cancel_timer(Timer), + State = + State0#state{ + user_data_buffer = Buffer, + start_or_recv_from = undefined, + timer = undefined, + bytes_to_read = undefined, + socket_options = SocketOpt + }, + if + SocketOpt#socket_options.active =:= false; + Buffer =:= <<>> -> + %% Passive mode, wait for active once or recv + %% Active and empty, get more data + Connection:next_record_if_active(State); + true -> %% We have more data + read_application_data(<<>>, State) + end + end; + {more, Buffer} -> % no reply, we need more data + Connection:next_record(State0#state{user_data_buffer = Buffer}); + {passive, Buffer} -> + Connection:next_record_if_active(State0#state{user_data_buffer = Buffer}); + {error,_Reason} -> %% Invalid packet in packet mode + deliver_packet_error(Transport, Socket, SOpts, Buffer1, Pid, RecvFrom, Tracker, Connection), + stop(normal, State0) + end. +%%==================================================================== +%% Help functions for tls|dtls_connection.erl +%%==================================================================== %%-------------------------------------------------------------------- -spec handle_session(#server_hello{}, ssl_record:ssl_version(), binary(), ssl_record:connection_states(), _,_, #state{}) -> @@ -283,7 +495,7 @@ handle_session(#server_hello{cipher_suite = CipherSuite, #state{session = #session{session_id = OldId}, negotiated_version = ReqVersion, negotiated_protocol = CurrentProtocol} = State0) -> - {KeyAlgorithm, _, _, _} = + #{key_exchange := KeyAlgorithm} = ssl_cipher:suite_definition(CipherSuite), PremasterSecret = make_premaster_secret(ReqVersion, KeyAlgorithm), @@ -340,7 +552,7 @@ ssl_config(Opts, Role, State) -> ssl_options = Opts}. %%==================================================================== -%% gen_statem state functions +%% gen_statem general state functions with connection cb argument %%==================================================================== %%-------------------------------------------------------------------- -spec init(gen_statem:event_type(), @@ -359,11 +571,17 @@ init({call, From}, {start, {Opts, EmOpts}, Timeout}, socket_options = SockOpts} = State0, Connection) -> try SslOpts = ssl:handle_options(Opts, OrigSSLOptions), + case SslOpts of + #ssl_options{erl_dist = true} -> + process_flag(priority, max); + _ -> + ok + end, State = ssl_config(SslOpts, Role, State0), init({call, From}, {start, Timeout}, State#state{ssl_options = SslOpts, socket_options = new_emulated(EmOpts, SockOpts)}, Connection) catch throw:Error -> - {stop_and_reply, normal, {reply, From, {error, Error}}} + stop_and_reply(normal, {reply, From, {error, Error}}, State0) end; init({call, From}, Msg, State, Connection) -> handle_call(Msg, From, ?FUNCTION_NAME, State, Connection); @@ -371,6 +589,15 @@ init(_Type, _Event, _State, _Connection) -> {keep_state_and_data, [postpone]}. %%-------------------------------------------------------------------- +-spec error(gen_statem:event_type(), + {start, timeout()} | term(), #state{}, + tls_connection | dtls_connection) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +error({call, From}, Msg, State, Connection) -> + handle_call(Msg, From, ?FUNCTION_NAME, State, Connection). + +%%-------------------------------------------------------------------- -spec hello(gen_statem:event_type(), #hello_request{} | #server_hello{} | term(), #state{}, tls_connection | dtls_connection) -> @@ -393,7 +620,6 @@ hello(Type, Msg, State, Connection) -> %%-------------------------------------------------------------------- abbreviated({call, From}, Msg, State, Connection) -> handle_call(Msg, From, ?FUNCTION_NAME, State, Connection); - abbreviated(internal, #finished{verify_data = Data} = Finished, #state{role = server, negotiated_version = Version, @@ -414,7 +640,6 @@ abbreviated(internal, #finished{verify_data = Data} = Finished, #alert{} = Alert -> handle_own_alert(Alert, Version, ?FUNCTION_NAME, State0) end; - abbreviated(internal, #finished{verify_data = Data} = Finished, #state{role = client, tls_handshake_history = Handshake0, session = #session{master_secret = MasterSecret}, @@ -434,7 +659,6 @@ abbreviated(internal, #finished{verify_data = Data} = Finished, #alert{} = Alert -> handle_own_alert(Alert, Version, ?FUNCTION_NAME, State0) end; - %% only allowed to send next_protocol message after change cipher spec %% & before finished message and it is not allowed during renegotiation abbreviated(internal, #next_protocol{selected_protocol = SelectedProtocol}, @@ -448,7 +672,7 @@ abbreviated(internal, #change_cipher_spec{type = <<1>>}, #state{connection_states = ConnectionStates0} = State0, Connection) -> ConnectionStates1 = - ssl_record:activate_pending_connection_state(ConnectionStates0, read), + ssl_record:activate_pending_connection_state(ConnectionStates0, read, Connection), {Record, State} = Connection:next_record(State0#state{connection_states = ConnectionStates1}), Connection:next_event(?FUNCTION_NAME, Record, State#state{expecting_finished = true}); @@ -475,7 +699,6 @@ certify(internal, #certificate{asn1_certificates = []}, State, _) -> Alert = ?ALERT_REC(?FATAL,?HANDSHAKE_FAILURE), handle_own_alert(Alert, Version, ?FUNCTION_NAME, State); - certify(internal, #certificate{asn1_certificates = []}, #state{role = server, ssl_options = #ssl_options{verify = verify_peer, @@ -484,7 +707,6 @@ certify(internal, #certificate{asn1_certificates = []}, {Record, State} = Connection:next_record(State0#state{client_certificate_requested = false}), Connection:next_event(?FUNCTION_NAME, Record, State); - certify(internal, #certificate{}, #state{role = server, negotiated_version = Version, @@ -492,7 +714,6 @@ certify(internal, #certificate{}, State, _) -> Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE, unrequested_certificate), handle_own_alert(Alert, Version, ?FUNCTION_NAME, State); - certify(internal, #certificate{} = Cert, #state{negotiated_version = Version, role = Role, @@ -509,7 +730,6 @@ certify(internal, #certificate{} = Cert, #alert{} = Alert -> handle_own_alert(Alert, Version, ?FUNCTION_NAME, State) end; - certify(internal, #server_key_exchange{exchange_keys = Keys}, #state{role = client, negotiated_version = Version, key_algorithm = Alg, @@ -518,7 +738,7 @@ certify(internal, #server_key_exchange{exchange_keys = Keys}, when Alg == dhe_dss; Alg == dhe_rsa; Alg == ecdhe_rsa; Alg == ecdhe_ecdsa; Alg == dh_anon; Alg == ecdh_anon; - Alg == psk; Alg == dhe_psk; Alg == rsa_psk; + Alg == psk; Alg == dhe_psk; Alg == ecdhe_psk; Alg == rsa_psk; Alg == srp_dss; Alg == srp_rsa; Alg == srp_anon -> Params = ssl_handshake:decode_server_key(Keys, Alg, ssl:tls_version(Version)), @@ -542,7 +762,14 @@ certify(internal, #server_key_exchange{exchange_keys = Keys}, Version, ?FUNCTION_NAME, State) end end; - +certify(internal, #certificate_request{}, + #state{role = client, negotiated_version = Version, + key_algorithm = Alg} = State, _) + when Alg == dh_anon; Alg == ecdh_anon; + Alg == psk; Alg == dhe_psk; Alg == ecdhe_psk; Alg == rsa_psk; + Alg == srp_dss; Alg == srp_rsa; Alg == srp_anon -> + handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE), + Version, ?FUNCTION_NAME, State); certify(internal, #certificate_request{} = CertRequest, #state{session = #session{own_certificate = Cert}, role = client, @@ -556,7 +783,6 @@ certify(internal, #certificate_request{} = CertRequest, Connection:next_event(?FUNCTION_NAME, Record, State#state{cert_hashsign_algorithm = NegotiatedHashSign}) end; - %% PSK and RSA_PSK might bypass the Server-Key-Exchange certify(internal, #server_hello_done{}, #state{session = #session{master_secret = undefined}, @@ -575,7 +801,6 @@ certify(internal, #server_hello_done{}, State0#state{premaster_secret = PremasterSecret}), client_certify_and_key_exchange(State, Connection) end; - certify(internal, #server_hello_done{}, #state{session = #session{master_secret = undefined}, ssl_options = #ssl_options{user_lookup_fun = PSKLookup}, @@ -596,7 +821,6 @@ certify(internal, #server_hello_done{}, State0#state{premaster_secret = RSAPremasterSecret}), client_certify_and_key_exchange(State, Connection) end; - %% Master secret was determined with help of server-key exchange msg certify(internal, #server_hello_done{}, #state{session = #session{master_secret = MasterSecret} = Session, @@ -612,7 +836,6 @@ certify(internal, #server_hello_done{}, #alert{} = Alert -> handle_own_alert(Alert, Version, ?FUNCTION_NAME, State0) end; - %% Master secret is calculated from premaster_secret certify(internal, #server_hello_done{}, #state{session = Session0, @@ -630,7 +853,6 @@ certify(internal, #server_hello_done{}, #alert{} = Alert -> handle_own_alert(Alert, Version, ?FUNCTION_NAME, State0) end; - certify(internal = Type, #client_key_exchange{} = Msg, #state{role = server, client_certificate_requested = true, @@ -638,7 +860,6 @@ certify(internal = Type, #client_key_exchange{} = Msg, Connection) -> %% We expect a certificate here handle_common_event(Type, Msg, ?FUNCTION_NAME, State, Connection); - certify(internal, #client_key_exchange{exchange_keys = Keys}, State = #state{key_algorithm = KeyAlg, negotiated_version = Version}, Connection) -> try @@ -648,7 +869,6 @@ certify(internal, #client_key_exchange{exchange_keys = Keys}, #alert{} = Alert -> handle_own_alert(Alert, Version, ?FUNCTION_NAME, State) end; - certify(Type, Msg, State, Connection) -> handle_common_event(Type, Msg, ?FUNCTION_NAME, State, Connection). @@ -660,10 +880,8 @@ certify(Type, Msg, State, Connection) -> %%-------------------------------------------------------------------- cipher({call, From}, Msg, State, Connection) -> handle_call(Msg, From, ?FUNCTION_NAME, State, Connection); - cipher(info, Msg, State, _) -> handle_info(Msg, ?FUNCTION_NAME, State); - cipher(internal, #certificate_verify{signature = Signature, hashsign_algorithm = CertHashSign}, #state{role = server, @@ -686,14 +904,12 @@ cipher(internal, #certificate_verify{signature = Signature, #alert{} = Alert -> handle_own_alert(Alert, Version, ?FUNCTION_NAME, State0) end; - %% client must send a next protocol message if we are expecting it cipher(internal, #finished{}, #state{role = server, expecting_next_protocol_negotiation = true, negotiated_protocol = undefined, negotiated_version = Version} = State0, _Connection) -> handle_own_alert(?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), Version, ?FUNCTION_NAME, State0); - cipher(internal, #finished{verify_data = Data} = Finished, #state{negotiated_version = Version, host = Host, @@ -716,7 +932,6 @@ cipher(internal, #finished{verify_data = Data} = Finished, #alert{} = Alert -> handle_own_alert(Alert, Version, ?FUNCTION_NAME, State) end; - %% only allowed to send next_protocol message after change cipher spec %% & before finished message and it is not allowed during renegotiation cipher(internal, #next_protocol{selected_protocol = SelectedProtocol}, @@ -729,7 +944,7 @@ cipher(internal, #next_protocol{selected_protocol = SelectedProtocol}, cipher(internal, #change_cipher_spec{type = <<1>>}, #state{connection_states = ConnectionStates0} = State0, Connection) -> ConnectionStates1 = - ssl_record:activate_pending_connection_state(ConnectionStates0, read), + ssl_record:activate_pending_connection_state(ConnectionStates0, read, Connection), {Record, State} = Connection:next_record(State0#state{connection_states = ConnectionStates1}), Connection:next_event(?FUNCTION_NAME, Record, State#state{expecting_finished = true}); @@ -741,7 +956,7 @@ cipher(Type, Msg, State, Connection) -> #state{}, tls_connection | dtls_connection) -> gen_statem:state_function_result(). %%-------------------------------------------------------------------- -connection({call, From}, {application_data, Data}, +connection({call, {FromPid, _} = From}, {application_data, Data}, #state{protocol_cb = Connection} = State, Connection) -> %% We should look into having a worker process to do this to %% parallize send and receive decoding and not block the receiver @@ -749,7 +964,13 @@ connection({call, From}, {application_data, Data}, try write_application_data(Data, From, State) catch throw:Error -> - hibernate_after(?FUNCTION_NAME, State, [{reply, From, Error}]) + case self() of + FromPid -> + stop({shutdown, Error}, State); + _ -> + hibernate_after( + ?FUNCTION_NAME, State, [{reply, From, Error}]) + end end; connection({call, RecvFrom}, {recv, N, Timeout}, #state{protocol_cb = Connection, socket_options = @@ -777,8 +998,64 @@ connection({call, From}, negotiated_protocol, #state{negotiated_protocol = SelectedProtocol} = State, _) -> hibernate_after(?FUNCTION_NAME, State, [{reply, From, {ok, SelectedProtocol}}]); +connection( + {call, From}, {handshake_complete, _Node, DHandle}, + #state{ + ssl_options = #ssl_options{erl_dist = true}, + socket_options = SockOpts, + protocol_specific = ProtocolSpecific} = State, + Connection) -> + %% From now on we execute on normal priority + process_flag(priority, normal), + try erlang:dist_ctrl_get_data_notification(DHandle) of + _ -> + NewState = + State#state{ + socket_options = + SockOpts#socket_options{active = true}, + protocol_specific = + ProtocolSpecific#{d_handle => DHandle}}, + {Record, NewerState} = Connection:next_record_if_active(NewState), + Connection:next_event(connection, Record, NewerState, [{reply, From, ok}]) + catch error:_ -> + death_row(State, disconnect) + end; connection({call, From}, Msg, State, Connection) -> handle_call(Msg, From, ?FUNCTION_NAME, State, Connection); +connection( + info, dist_data = Msg, + #state{ + ssl_options = #ssl_options{erl_dist = true}, + protocol_specific = #{d_handle := DHandle}} = State, + _) -> + eat_msgs(Msg), + try send_dist_data(?FUNCTION_NAME, State, DHandle, []) + catch error:_ -> + death_row(State, disconnect) + end; +connection( + info, {send, From, Ref, Data}, + #state{ + ssl_options = #ssl_options{erl_dist = true}, + protocol_specific = #{d_handle := _}}, + _) -> + %% This is for testing only! + %% + %% Needed by some OTP distribution + %% test suites... + From ! {Ref, ok}, + {keep_state_and_data, + [{next_event, {call, {self(), undefined}}, + {application_data, iolist_to_binary(Data)}}]}; +connection( + info, tick = Msg, + #state{ + ssl_options = #ssl_options{erl_dist = true}, + protocol_specific = #{d_handle := _}}, + _) -> + eat_msgs(Msg), + {keep_state_and_data, + [{next_event, {call, {self(), undefined}}, {application_data, <<>>}}]}; connection(info, Msg, State, _) -> handle_info(Msg, ?FUNCTION_NAME, State); connection(internal, {recv, _}, State, Connection) -> @@ -787,6 +1064,32 @@ connection(Type, Msg, State, Connection) -> handle_common_event(Type, Msg, ?FUNCTION_NAME, State, Connection). %%-------------------------------------------------------------------- +-spec death_row(gen_statem:event_type(), term(), + #state{}, tls_connection | dtls_connection) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +%% We just wait for the owner to die which triggers the monitor, +%% or the socket may die too +death_row( + info, {'DOWN', MonitorRef, _, _, Reason}, + #state{user_application={MonitorRef,_Pid}}, + _) -> + {stop, {shutdown, Reason}}; +death_row( + info, {'EXIT', Socket, Reason}, #state{socket = Socket}, _) -> + {stop, {shutdown, Reason}}; +death_row(state_timeout, Reason, _State, _Connection) -> + {stop, {shutdown,Reason}}; +death_row(_Type, _Msg, _State, _Connection) -> + %% Waste all other events + keep_state_and_data. + +%% State entry function +death_row(State, Reason) -> + {next_state, death_row, State, + [{state_timeout, 5000, Reason}]}. + +%%-------------------------------------------------------------------- -spec downgrade(gen_statem:event_type(), term(), #state{}, tls_connection | dtls_connection) -> gen_statem:state_function_result(). @@ -797,10 +1100,10 @@ downgrade(internal, #alert{description = ?CLOSE_NOTIFY}, tls_socket:setopts(Transport, Socket, [{active, false}, {packet, 0}, {mode, binary}]), Transport:controlling_process(Socket, Pid), gen_statem:reply(From, {ok, Socket}), - {stop, normal, State}; + stop(normal, State); downgrade(timeout, downgrade, #state{downgrade = {_, From}} = State, _) -> gen_statem:reply(From, {error, timeout}), - {stop, normal, State}; + stop(normal, State); downgrade(Type, Event, State, Connection) -> handle_common_event(Type, Event, ?FUNCTION_NAME, State, Connection). @@ -815,7 +1118,7 @@ handle_common_event(internal, {handshake, {#hello_request{} = Handshake, _}}, co handle_common_event(internal, {handshake, {#hello_request{}, _}}, StateName, #state{role = client}, _) when StateName =/= connection -> {keep_state_and_data}; -handle_common_event(internal, {handshake, {Handshake, Raw}}, StateName, +handle_common_event(internal, {handshake, {Handshake, Raw}}, StateName, #state{tls_handshake_history = Hs0, ssl_options = #ssl_options{v2_hello_compatible = V2HComp}} = State0, Connection) -> @@ -834,8 +1137,8 @@ handle_common_event(timeout, hibernate, _, _, _) -> {keep_state_and_data, [hibernate]}; handle_common_event(internal, {application_data, Data}, StateName, State0, Connection) -> case read_application_data(Data, State0) of - {stop, Reason, State} -> - {stop, Reason, State}; + {stop, _, _} = Stop-> + Stop; {Record, State} -> Connection:next_event(StateName, Record, State) end; @@ -864,13 +1167,14 @@ handle_call({close, _} = Close, From, StateName, State, Connection) -> %% Run terminate before returning so that the reuseaddr %% inet-option works properly Result = Connection:terminate(Close, StateName, State#state{terminated = true}), - {stop_and_reply, {shutdown, normal}, - {reply, From, Result}, State}; + stop_and_reply( + {shutdown, normal}, + {reply, From, Result}, State); handle_call({shutdown, How0}, From, _, #state{transport_cb = Transport, negotiated_version = Version, connection_states = ConnectionStates, - socket = Socket}, Connection) -> + socket = Socket} = State, Connection) -> case How0 of How when How == write; How == both -> Alert = ?ALERT_REC(?WARNING, ?CLOSE_NOTIFY), @@ -886,7 +1190,7 @@ handle_call({shutdown, How0}, From, _, {keep_state_and_data, [{reply, From, ok}]}; Error -> gen_statem:reply(From, {error, Error}), - {stop, normal} + stop(normal, State) end; handle_call({recv, _N, _Timeout}, From, _, #state{socket_options = @@ -921,6 +1225,15 @@ handle_call({set_opts, Opts0}, From, StateName, handle_call(renegotiate, From, StateName, _, _) when StateName =/= connection -> {keep_state_and_data, [{reply, From, {error, already_renegotiating}}]}; + +handle_call( + get_sslsocket, From, _StateName, + #state{transport_cb = Transport, socket = Socket, tracker = Tracker}, + Connection) -> + SslSocket = + Connection:socket(self(), Transport, Socket, Connection, Tracker), + {keep_state_and_data, [{reply, From, SslSocket}]}; + handle_call({prf, Secret, Label, Seed, WantedLength}, From, _, #state{connection_states = ConnectionStates, negotiated_version = Version}, _) -> @@ -957,40 +1270,55 @@ handle_info({ErrorTag, Socket, econnaborted}, StateName, tracker = Tracker} = State) when StateName =/= connection -> alert_user(Transport, Tracker,Socket, StartFrom, ?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), Role, Connection), - {stop, normal, State}; + stop(normal, State); handle_info({ErrorTag, Socket, Reason}, StateName, #state{socket = Socket, error_tag = ErrorTag} = State) -> Report = io_lib:format("SSL: Socket error: ~p ~n", [Reason]), - error_logger:info_report(Report), + error_logger:error_report(Report), handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State), - {stop, normal, State}; - -handle_info({'DOWN', MonitorRef, _, _, _}, _, - State = #state{user_application={MonitorRef,_Pid}}) -> - {stop, normal, State}; + stop(normal, State); + +handle_info( + {'DOWN', MonitorRef, _, _, Reason}, _, + #state{ + user_application = {MonitorRef, _Pid}, + ssl_options = #ssl_options{erl_dist = true}}) -> + {stop, {shutdown, Reason}}; +handle_info( + {'DOWN', MonitorRef, _, _, _}, _, + #state{user_application = {MonitorRef, _Pid}}) -> + {stop, normal}; +handle_info( + {'EXIT', Pid, _Reason}, StateName, + #state{user_application = {_MonitorRef, Pid}} = State) -> + %% It seems the user application has linked to us + %% - ignore that and let the monitor handle this + {next_state, StateName, State}; %%% So that terminate will be run when supervisor issues shutdown handle_info({'EXIT', _Sup, shutdown}, _StateName, State) -> - {stop, shutdown, State}; + stop(shutdown, State); handle_info({'EXIT', Socket, normal}, _StateName, #state{socket = Socket} = State) -> %% Handle as transport close" - {stop, {shutdown, transport_closed}, State}; + stop({shutdown, transport_closed}, State); +handle_info({'EXIT', Socket, Reason}, _StateName, #state{socket = Socket} = State) -> + stop({shutdown, Reason}, State); handle_info(allow_renegotiate, StateName, State) -> {next_state, StateName, State#state{allow_renegotiate = true}}; handle_info({cancel_start_or_recv, StartFrom}, StateName, #state{renegotiation = {false, first}} = State) when StateName =/= connection -> - {stop_and_reply, {shutdown, user_timeout}, - {reply, StartFrom, {error, timeout}}, State#state{timer = undefined}}; - + stop_and_reply( + {shutdown, user_timeout}, + {reply, StartFrom, {error, timeout}}, + State#state{timer = undefined}); handle_info({cancel_start_or_recv, RecvFrom}, StateName, #state{start_or_recv_from = RecvFrom} = State) when RecvFrom =/= undefined -> {next_state, StateName, State#state{start_or_recv_from = undefined, bytes_to_read = undefined, timer = undefined}, [{reply, RecvFrom, {error, timeout}}]}; - handle_info({cancel_start_or_recv, _RecvFrom}, StateName, State) -> {next_state, StateName, State#state{timer = undefined}}; @@ -999,9 +1327,9 @@ handle_info(Msg, StateName, #state{socket = Socket, error_tag = Tag} = State) -> error_logger:info_report(Report), {next_state, StateName, State}. -%%-------------------------------------------------------------------- -%% gen_statem callbacks -%%-------------------------------------------------------------------- +%%==================================================================== +%% general gen_statem callbacks +%%==================================================================== terminate(_, _, #state{terminated = true}) -> %% Happens when user closes the connection using ssl:close/1 %% we want to guarantee that Transport:close has been called @@ -1010,7 +1338,6 @@ terminate(_, _, #state{terminated = true}) -> %% returning. In both cases terminate has been run manually %% before run by gen_statem which will end up here ok; - terminate({shutdown, transport_closed} = Reason, _StateName, #state{protocol_cb = Connection, socket = Socket, transport_cb = Transport} = State) -> @@ -1037,7 +1364,6 @@ terminate(Reason, connection, #state{negotiated_version = Version, {BinAlert, ConnectionStates} = terminate_alert(Reason, Version, ConnectionStates0, Connection), Connection:send(Transport, Socket, BinAlert), Connection:close(Reason, Socket, Transport, ConnectionStates, Check); - terminate(Reason, _StateName, #state{transport_cb = Transport, protocol_cb = Connection, socket = Socket } = State) -> @@ -1071,118 +1397,6 @@ format_status(terminate, [_, StateName, State]) -> }}]}]. %%-------------------------------------------------------------------- -%%% -%%-------------------------------------------------------------------- -write_application_data(Data0, From, - #state{socket = Socket, - negotiated_version = Version, - protocol_cb = Connection, - transport_cb = Transport, - connection_states = ConnectionStates0, - socket_options = SockOpts, - ssl_options = #ssl_options{renegotiate_at = RenegotiateAt}} = State) -> - Data = encode_packet(Data0, SockOpts), - - case time_to_renegotiate(Data, ConnectionStates0, RenegotiateAt) of - true -> - Connection:renegotiate(State#state{renegotiation = {true, internal}}, - [{next_event, {call, From}, {application_data, Data0}}]); - false -> - {Msgs, ConnectionStates} = Connection:encode_data(Data, Version, ConnectionStates0), - Result = Connection:send(Transport, Socket, Msgs), - ssl_connection:hibernate_after(connection, State#state{connection_states = ConnectionStates}, - [{reply, From, Result}]) - end. - -read_application_data(Data, #state{user_application = {_Mon, Pid}, - socket = Socket, - protocol_cb = Connection, - transport_cb = Transport, - socket_options = SOpts, - bytes_to_read = BytesToRead, - start_or_recv_from = RecvFrom, - timer = Timer, - user_data_buffer = Buffer0, - tracker = Tracker} = State0) -> - Buffer1 = if - Buffer0 =:= <<>> -> Data; - Data =:= <<>> -> Buffer0; - true -> <<Buffer0/binary, Data/binary>> - end, - case get_data(SOpts, BytesToRead, Buffer1) of - {ok, ClientData, Buffer} -> % Send data - SocketOpt = deliver_app_data(Transport, Socket, SOpts, - ClientData, Pid, RecvFrom, Tracker, Connection), - cancel_timer(Timer), - State = State0#state{user_data_buffer = Buffer, - start_or_recv_from = undefined, - timer = undefined, - bytes_to_read = undefined, - socket_options = SocketOpt - }, - if - SocketOpt#socket_options.active =:= false; Buffer =:= <<>> -> - %% Passive mode, wait for active once or recv - %% Active and empty, get more data - Connection:next_record_if_active(State); - true -> %% We have more data - read_application_data(<<>>, State) - end; - {more, Buffer} -> % no reply, we need more data - Connection:next_record(State0#state{user_data_buffer = Buffer}); - {passive, Buffer} -> - Connection:next_record_if_active(State0#state{user_data_buffer = Buffer}); - {error,_Reason} -> %% Invalid packet in packet mode - deliver_packet_error(Transport, Socket, SOpts, Buffer1, Pid, RecvFrom, Tracker, Connection), - {stop, normal, State0} - end. -%%-------------------------------------------------------------------- -%%% -%%-------------------------------------------------------------------- -handle_alert(#alert{level = ?FATAL} = Alert, StateName, - #state{socket = Socket, transport_cb = Transport, - protocol_cb = Connection, - ssl_options = SslOpts, start_or_recv_from = From, host = Host, - port = Port, session = Session, user_application = {_Mon, Pid}, - role = Role, socket_options = Opts, tracker = Tracker}) -> - invalidate_session(Role, Host, Port, Session), - log_alert(SslOpts#ssl_options.log_alert, Role, Connection:protocol_name(), - StateName, Alert#alert{role = opposite_role(Role)}), - alert_user(Transport, Tracker, Socket, StateName, Opts, Pid, From, Alert, Role, Connection), - {stop, normal}; - -handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert, - StateName, State) -> - handle_normal_shutdown(Alert, StateName, State), - {stop, {shutdown, peer_close}}; - -handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName, - #state{role = Role, ssl_options = SslOpts, protocol_cb = Connection, renegotiation = {true, internal}} = State) -> - log_alert(SslOpts#ssl_options.log_alert, Role, - Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}), - handle_normal_shutdown(Alert, StateName, State), - {stop, {shutdown, peer_close}}; - -handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName, - #state{role = Role, - ssl_options = SslOpts, renegotiation = {true, From}, - protocol_cb = Connection} = State0) -> - log_alert(SslOpts#ssl_options.log_alert, Role, - Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}), - gen_statem:reply(From, {error, renegotiation_rejected}), - {Record, State} = Connection:next_record(State0), - %% Go back to connection! - Connection:next_event(connection, Record, State); - -%% Gracefully log and ignore all other warning alerts -handle_alert(#alert{level = ?WARNING} = Alert, StateName, - #state{ssl_options = SslOpts, protocol_cb = Connection, role = Role} = State0) -> - log_alert(SslOpts#ssl_options.log_alert, Role, - Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}), - {Record, State} = Connection:next_record(State0), - Connection:next_event(StateName, Record, State). - -%%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- connection_info(#state{sni_hostname = SNIHostname, @@ -1192,9 +1406,9 @@ connection_info(#state{sni_hostname = SNIHostname, negotiated_version = {_,_} = Version, ssl_options = Opts}) -> RecordCB = record_cb(Connection), - CipherSuiteDef = ssl_cipher:erl_suite_definition(CipherSuite), - IsNamedCurveSuite = lists:member(element(1,CipherSuiteDef), - [ecdh_ecdsa, ecdhe_ecdsa, ecdh_anon]), + CipherSuiteDef = #{key_exchange := KexAlg} = ssl_cipher:suite_definition(CipherSuite), + IsNamedCurveSuite = lists:member(KexAlg, + [ecdh_ecdsa, ecdhe_ecdsa, ecdh_anon]), CurveInfo = case ECCCurve of {namedCurve, Curve} when IsNamedCurveSuite -> [{ecc, {named_curve, pubkey_cert_records:namedCurves(Curve)}}]; @@ -1203,7 +1417,7 @@ connection_info(#state{sni_hostname = SNIHostname, end, [{protocol, RecordCB:protocol_version(Version)}, {session_id, SessionId}, - {cipher_suite, CipherSuiteDef}, + {cipher_suite, ssl_cipher:erl_suite_definition(CipherSuiteDef)}, {sni_hostname, SNIHostname} | CurveInfo] ++ ssl_options_list(Opts). security_info(#state{connection_states = ConnectionStates}) -> @@ -1271,7 +1485,7 @@ resumed_server_hello(#state{session = Session, server_hello(ServerHello, State0, Connection) -> CipherSuite = ServerHello#server_hello.cipher_suite, - {KeyAlgorithm, _, _, _} = ssl_cipher:suite_definition(CipherSuite), + #{key_exchange := KeyAlgorithm} = ssl_cipher:suite_definition(CipherSuite), State = Connection:queue_handshake(ServerHello, State0), State#state{key_algorithm = KeyAlgorithm}. @@ -1285,8 +1499,8 @@ handle_peer_cert(Role, PeerCert, PublicKeyInfo, State1 = State0#state{session = Session#session{peer_certificate = PeerCert}, public_key_info = PublicKeyInfo}, - {KeyAlg,_,_,_} = ssl_cipher:suite_definition(CipherSuite), - State2 = handle_peer_cert_key(Role, PeerCert, PublicKeyInfo, KeyAlg, State1), + #{key_exchange := KeyAlgorithm} = ssl_cipher:suite_definition(CipherSuite), + State2 = handle_peer_cert_key(Role, PeerCert, PublicKeyInfo, KeyAlgorithm, State1), {Record, State} = Connection:next_record(State2), Connection:next_event(certify, Record, State). @@ -1299,7 +1513,6 @@ handle_peer_cert_key(client, _, ECDHKey = public_key:generate_key(PublicKeyParams), PremasterSecret = ssl_handshake:premaster_secret(PublicKey, ECDHKey), master_secret(PremasterSecret, 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. @@ -1319,7 +1532,6 @@ certify_client(#state{client_certificate_requested = true, role = client, = State, Connection) -> Certificate = ssl_handshake:certificate(OwnCert, CertDbHandle, CertDbRef, client), Connection:queue_handshake(Certificate, State); - certify_client(#state{client_certificate_requested = false} = State, _) -> State. @@ -1370,26 +1582,25 @@ server_certify_and_key_exchange(State0, Connection) -> certify_client_key_exchange(#encrypted_premaster_secret{premaster_secret= EncPMS}, #state{private_key = Key, client_hello_version = {Major, Minor} = Version} = State, Connection) -> - + FakeSecret = make_premaster_secret(Version, rsa), %% Countermeasure for Bleichenbacher attack always provide some kind of premaster secret %% and fail handshake later.RFC 5246 section 7.4.7.1. PremasterSecret = try ssl_handshake:premaster_secret(EncPMS, Key) of Secret when erlang:byte_size(Secret) == ?NUM_OF_PREMASTERSECRET_BYTES -> case Secret of - <<?BYTE(Major), ?BYTE(Minor), _/binary>> -> %% Correct - Secret; + <<?BYTE(Major), ?BYTE(Minor), Rest/binary>> -> %% Correct + <<?BYTE(Major), ?BYTE(Minor), Rest/binary>>; <<?BYTE(_), ?BYTE(_), Rest/binary>> -> %% Version mismatch <<?BYTE(Major), ?BYTE(Minor), Rest/binary>> end; _ -> %% erlang:byte_size(Secret) =/= ?NUM_OF_PREMASTERSECRET_BYTES - make_premaster_secret(Version, rsa) + FakeSecret catch #alert{description = ?DECRYPT_ERROR} -> - make_premaster_secret(Version, rsa) - end, + FakeSecret + end, calculate_master_secret(PremasterSecret, State, Connection, certify, cipher); - certify_client_key_exchange(#client_diffie_hellman_public{dh_public = ClientPublicDhKey}, #state{diffie_hellman_params = #'DHParameter'{} = Params, diffie_hellman_keys = {_, ServerDhPrivateKey}} = State, @@ -1401,14 +1612,12 @@ certify_client_key_exchange(#client_ec_diffie_hellman_public{dh_public = ClientP #state{diffie_hellman_keys = ECDHKey} = State, Connection) -> PremasterSecret = ssl_handshake:premaster_secret(#'ECPoint'{point = ClientPublicEcDhPoint}, ECDHKey), calculate_master_secret(PremasterSecret, State, Connection, certify, cipher); - certify_client_key_exchange(#client_psk_identity{} = ClientKey, #state{ssl_options = #ssl_options{user_lookup_fun = PSKLookup}} = State0, Connection) -> PremasterSecret = ssl_handshake:premaster_secret(ClientKey, PSKLookup), calculate_master_secret(PremasterSecret, State0, Connection, certify, cipher); - certify_client_key_exchange(#client_dhe_psk_identity{} = ClientKey, #state{diffie_hellman_params = #'DHParameter'{} = Params, diffie_hellman_keys = {_, ServerDhPrivateKey}, @@ -1418,6 +1627,14 @@ certify_client_key_exchange(#client_dhe_psk_identity{} = ClientKey, PremasterSecret = ssl_handshake:premaster_secret(ClientKey, ServerDhPrivateKey, Params, PSKLookup), calculate_master_secret(PremasterSecret, State0, Connection, certify, cipher); +certify_client_key_exchange(#client_ecdhe_psk_identity{} = ClientKey, + #state{diffie_hellman_keys = ServerEcDhPrivateKey, + ssl_options = + #ssl_options{user_lookup_fun = PSKLookup}} = State, + Connection) -> + PremasterSecret = + ssl_handshake:premaster_secret(ClientKey, ServerEcDhPrivateKey, PSKLookup), + calculate_master_secret(PremasterSecret, State, Connection, certify, cipher); certify_client_key_exchange(#client_rsa_psk_identity{} = ClientKey, #state{private_key = Key, ssl_options = @@ -1425,7 +1642,6 @@ certify_client_key_exchange(#client_rsa_psk_identity{} = ClientKey, Connection) -> PremasterSecret = ssl_handshake:premaster_secret(ClientKey, Key, PSKLookup), calculate_master_secret(PremasterSecret, State0, Connection, certify, cipher); - certify_client_key_exchange(#client_srp_public{} = ClientKey, #state{srp_params = Params, srp_keys = Key @@ -1437,9 +1653,9 @@ certify_server(#state{key_algorithm = Algo} = State, _) when Algo == dh_anon; Algo == ecdh_anon; Algo == psk; Algo == dhe_psk; + Algo == ecdhe_psk; Algo == srp_anon -> State; - certify_server(#state{cert_db = CertDbHandle, cert_db_ref = CertDbRef, session = #session{own_certificate = OwnCert}} = State, Connection) -> @@ -1473,7 +1689,6 @@ key_exchange(#state{role = server, key_algorithm = Algo, PrivateKey}), State = Connection:queue_handshake(Msg, State0), State#state{diffie_hellman_keys = DHKeys}; - key_exchange(#state{role = server, private_key = Key, key_algorithm = Algo} = State, _) when Algo == ecdh_ecdsa; Algo == ecdh_rsa -> State#state{diffie_hellman_keys = Key}; @@ -1499,7 +1714,6 @@ key_exchange(#state{role = server, key_algorithm = Algo, PrivateKey}), State = Connection:queue_handshake(Msg, State0), State#state{diffie_hellman_keys = ECDHKeys}; - key_exchange(#state{role = server, key_algorithm = psk, ssl_options = #ssl_options{psk_identity = undefined}} = State, _) -> State; @@ -1520,7 +1734,6 @@ key_exchange(#state{role = server, key_algorithm = psk, ServerRandom, PrivateKey}), Connection:queue_handshake(Msg, State0); - key_exchange(#state{role = server, key_algorithm = dhe_psk, ssl_options = #ssl_options{psk_identity = PskIdentityHint}, hashsign_algorithm = HashSignAlgo, @@ -1542,7 +1755,27 @@ key_exchange(#state{role = server, key_algorithm = dhe_psk, PrivateKey}), State = Connection:queue_handshake(Msg, State0), State#state{diffie_hellman_keys = DHKeys}; - +key_exchange(#state{role = server, key_algorithm = ecdhe_psk, + ssl_options = #ssl_options{psk_identity = PskIdentityHint}, + hashsign_algorithm = HashSignAlgo, + private_key = PrivateKey, + session = #session{ecc = ECCCurve}, + connection_states = ConnectionStates0, + negotiated_version = Version + } = State0, Connection) -> + ECDHKeys = public_key:generate_key(ECCCurve), + #{security_parameters := SecParams} = + ssl_record:pending_connection_state(ConnectionStates0, read), + #security_parameters{client_random = ClientRandom, + server_random = ServerRandom} = SecParams, + Msg = ssl_handshake:key_exchange(server, ssl:tls_version(Version), + {ecdhe_psk, + PskIdentityHint, ECDHKeys, + HashSignAlgo, ClientRandom, + ServerRandom, + PrivateKey}), + State = Connection:queue_handshake(Msg, State0), + State#state{diffie_hellman_keys = ECDHKeys}; key_exchange(#state{role = server, key_algorithm = rsa_psk, ssl_options = #ssl_options{psk_identity = undefined}} = State, _) -> State; @@ -1563,7 +1796,6 @@ key_exchange(#state{role = server, key_algorithm = rsa_psk, ServerRandom, PrivateKey}), Connection:queue_handshake(Msg, State0); - key_exchange(#state{role = server, key_algorithm = Algo, ssl_options = #ssl_options{user_lookup_fun = LookupFun}, hashsign_algorithm = HashSignAlgo, @@ -1594,7 +1826,6 @@ key_exchange(#state{role = server, key_algorithm = Algo, State = Connection:queue_handshake(Msg, State0), State#state{srp_params = SrpParams, srp_keys = Keys}; - key_exchange(#state{role = client, key_algorithm = rsa, public_key_info = PublicKeyInfo, @@ -1602,7 +1833,6 @@ key_exchange(#state{role = client, premaster_secret = PremasterSecret} = State0, Connection) -> Msg = rsa_key_exchange(ssl:tls_version(Version), PremasterSecret, PublicKeyInfo), Connection:queue_handshake(Msg, State0); - key_exchange(#state{role = client, key_algorithm = Algorithm, negotiated_version = Version, @@ -1623,7 +1853,6 @@ key_exchange(#state{role = client, Algorithm == ecdh_anon -> Msg = ssl_handshake:key_exchange(client, ssl:tls_version(Version), {ecdh, Keys}), Connection:queue_handshake(Msg, State0); - key_exchange(#state{role = client, ssl_options = SslOpts, key_algorithm = psk, @@ -1631,7 +1860,6 @@ key_exchange(#state{role = client, Msg = ssl_handshake:key_exchange(client, ssl:tls_version(Version), {psk, SslOpts#ssl_options.psk_identity}), Connection:queue_handshake(Msg, State0); - key_exchange(#state{role = client, ssl_options = SslOpts, key_algorithm = dhe_psk, @@ -1641,6 +1869,17 @@ key_exchange(#state{role = client, {dhe_psk, SslOpts#ssl_options.psk_identity, DhPubKey}), Connection:queue_handshake(Msg, State0); + +key_exchange(#state{role = client, + ssl_options = SslOpts, + key_algorithm = ecdhe_psk, + negotiated_version = Version, + diffie_hellman_keys = ECDHKeys} = State0, Connection) -> + Msg = ssl_handshake:key_exchange(client, ssl:tls_version(Version), + {ecdhe_psk, + SslOpts#ssl_options.psk_identity, ECDHKeys}), + Connection:queue_handshake(Msg, State0); + key_exchange(#state{role = client, ssl_options = SslOpts, key_algorithm = rsa_psk, @@ -1651,7 +1890,6 @@ key_exchange(#state{role = client, Msg = rsa_psk_key_exchange(ssl:tls_version(Version), SslOpts#ssl_options.psk_identity, PremasterSecret, PublicKeyInfo), Connection:queue_handshake(Msg, State0); - key_exchange(#state{role = client, key_algorithm = Algorithm, negotiated_version = Version, @@ -1696,6 +1934,12 @@ rsa_psk_key_exchange(Version, PskIdentity, PremasterSecret, rsa_psk_key_exchange(_, _, _, _) -> throw (?ALERT_REC(?FATAL,?HANDSHAKE_FAILURE, pub_key_is_not_rsa)). +request_client_cert(#state{key_algorithm = Alg} = State, _) + when Alg == dh_anon; Alg == ecdh_anon; + Alg == psk; Alg == dhe_psk; Alg == ecdhe_psk; Alg == rsa_psk; + Alg == srp_dss; Alg == srp_rsa; Alg == srp_anon -> + State; + request_client_cert(#state{ssl_options = #ssl_options{verify = verify_peer, signature_algs = SupportedHashSigns}, connection_states = ConnectionStates0, @@ -1740,7 +1984,7 @@ finalize_handshake(State0, StateName, Connection) -> ConnectionStates = ssl_record:activate_pending_connection_state(ConnectionStates0, - write), + write, Connection), State2 = State1#state{connection_states = ConnectionStates}, State = next_protocol(State2, Connection), @@ -1817,6 +2061,18 @@ calculate_secret(#server_dhe_psk_params{ calculate_master_secret(PremasterSecret, State#state{diffie_hellman_keys = Keys}, Connection, certify, certify); +calculate_secret(#server_ecdhe_psk_params{ + dh_params = #server_ecdh_params{curve = ECCurve}} = ServerKey, + #state{ssl_options = #ssl_options{user_lookup_fun = PSKLookup}} = + State=#state{session=Session}, Connection) -> + ECDHKeys = public_key:generate_key(ECCurve), + + PremasterSecret = ssl_handshake:premaster_secret(ServerKey, ECDHKeys, PSKLookup), + calculate_master_secret(PremasterSecret, + State#state{diffie_hellman_keys = ECDHKeys, + session = Session#session{ecc = ECCurve}}, + Connection, certify, certify); + calculate_secret(#server_srp_params{srp_n = Prime, srp_g = Generator} = ServerKey, #state{ssl_options = #ssl_options{srp_identity = SRPId}} = State, Connection) -> @@ -1901,6 +2157,7 @@ is_anonymous(Algo) when Algo == dh_anon; Algo == ecdh_anon; Algo == psk; Algo == dhe_psk; + Algo == ecdhe_psk; Algo == rsa_psk; Algo == srp_anon -> true; @@ -2021,10 +2278,7 @@ set_socket_opts(_,_, _, [{active, _} = Opt| _], SockOpts, _) -> set_socket_opts(ConnectionCb, Transport, Socket, [Opt | Opts], SockOpts, Other) -> set_socket_opts(ConnectionCb, Transport, Socket, Opts, SockOpts, [Opt | Other]). -start_or_recv_cancel_timer(infinity, _RecvFrom) -> - undefined; -start_or_recv_cancel_timer(Timeout, RecvFrom) -> - erlang:send_after(Timeout, self(), {cancel_start_or_recv, RecvFrom}). + hibernate_after(connection = StateName, #state{ssl_options=#ssl_options{hibernate_after = HibernateAfter}} = State, @@ -2203,8 +2457,8 @@ handle_active_option(_, connection = StateName0, To, Reply, #state{protocol_cb = hibernate_after(StateName, State, [{reply, To, Reply}]); {next_state, StateName, State, Actions} -> hibernate_after(StateName, State, [{reply, To, Reply} | Actions]); - {stop, Reason, State} -> - {stop, Reason, State} + {stop, _, _} = Stop -> + Stop end; handle_active_option(_, StateName, To, Reply, #state{user_data_buffer = <<>>} = State) -> %% Active once already set @@ -2213,8 +2467,8 @@ handle_active_option(_, StateName, To, Reply, #state{user_data_buffer = <<>>} = %% user_data_buffer =/= <<>> handle_active_option(_, StateName0, To, Reply, #state{protocol_cb = Connection} = State0) -> case read_application_data(<<>>, State0) of - {stop, Reason, State} -> - {stop, Reason, State}; + {stop, _, _} = Stop -> + Stop; {Record, State1} -> %% Note: Renogotiation may cause StateName0 =/= StateName case Connection:next_event(StateName0, Record, State1) of @@ -2372,7 +2626,8 @@ send_or_reply(_, Pid, _From, Data) -> send_user(Pid, Data). send_user(Pid, Msg) -> - Pid ! Msg. + Pid ! Msg, + ok. alert_user(Transport, Tracker, Socket, connection, Opts, Pid, From, Alert, Role, Connection) -> alert_user(Transport, Tracker, Socket, Opts#socket_options.active, Pid, From, Alert, Role, Connection); @@ -2409,45 +2664,6 @@ log_alert(true, Role, ProtocolName, StateName, Alert) -> log_alert(false, _, _, _, _) -> ok. -handle_own_alert(Alert, Version, StateName, - #state{role = Role, - transport_cb = Transport, - socket = Socket, - protocol_cb = Connection, - connection_states = ConnectionStates, - ssl_options = SslOpts} = State) -> - try %% Try to tell the other side - {BinMsg, _} = - Connection:encode_alert(Alert, Version, ConnectionStates), - Connection:send(Transport, Socket, BinMsg) - catch _:_ -> %% Can crash if we are in a uninitialized state - ignore - end, - try %% Try to tell the local user - log_alert(SslOpts#ssl_options.log_alert, Role, Connection:protocol_name(), StateName, Alert#alert{role = Role}), - handle_normal_shutdown(Alert,StateName, State) - catch _:_ -> - ok - end, - {stop, {shutdown, own_alert}}. - -handle_normal_shutdown(Alert, _, #state{socket = Socket, - transport_cb = Transport, - protocol_cb = Connection, - start_or_recv_from = StartFrom, - tracker = Tracker, - role = Role, renegotiation = {false, first}}) -> - alert_user(Transport, Tracker,Socket, StartFrom, Alert, Role, Connection); - -handle_normal_shutdown(Alert, StateName, #state{socket = Socket, - socket_options = Opts, - transport_cb = Transport, - protocol_cb = Connection, - user_application = {_Mon, Pid}, - tracker = Tracker, - start_or_recv_from = RecvFrom, role = Role}) -> - alert_user(Transport, Tracker, Socket, StateName, Opts, Pid, RecvFrom, Alert, Role, Connection). - invalidate_session(client, Host, Port, Session) -> ssl_manager:invalidate_session(Host, Port, Session); invalidate_session(server, _, Port, Session) -> @@ -2504,3 +2720,42 @@ new_emulated([], EmOpts) -> EmOpts; new_emulated(NewEmOpts, _) -> NewEmOpts. +%%---------------Erlang distribution -------------------------------------- + +send_dist_data(StateName, State, DHandle, Acc) -> + case erlang:dist_ctrl_get_data(DHandle) of + none -> + erlang:dist_ctrl_get_data_notification(DHandle), + hibernate_after(StateName, State, lists:reverse(Acc)); + Data -> + send_dist_data( + StateName, State, DHandle, + [{next_event, {call, {self(), undefined}}, {application_data, Data}} + |Acc]) + end. + +%% Overload mitigation +eat_msgs(Msg) -> + receive Msg -> eat_msgs(Msg) + after 0 -> ok + end. + +%% When acting as distribution controller map the exit reason +%% to follow the documented nodedown_reason for net_kernel +stop(Reason, State) -> + {stop, erl_dist_stop_reason(Reason, State), State}. + +stop_and_reply(Reason, Replies, State) -> + {stop_and_reply, erl_dist_stop_reason(Reason, State), Replies, State}. + +erl_dist_stop_reason( + Reason, #state{ssl_options = #ssl_options{erl_dist = true}}) -> + case Reason of + normal -> + %% We can not exit with normal since that will not bring + %% down the rest of the distribution processes + {shutdown, normal}; + _ -> Reason + end; +erl_dist_stop_reason(Reason, _State) -> + Reason. diff --git a/lib/ssl/src/ssl_crl_cache.erl b/lib/ssl/src/ssl_crl_cache.erl index 86c0207515..8817b0c884 100644 --- a/lib/ssl/src/ssl_crl_cache.erl +++ b/lib/ssl/src/ssl_crl_cache.erl @@ -94,7 +94,7 @@ delete({der, CRLs}) -> delete(URI) -> case http_uri:parse(URI) of {ok, {http, _, _ , _, Path,_}} -> - ssl_manager:delete_crls(string:strip(Path, left, $/)); + ssl_manager:delete_crls(string:trim(Path, leading, "/")); _ -> {error, {only_http_distribution_points_supported, URI}} end. @@ -105,7 +105,7 @@ delete(URI) -> do_insert(URI, CRLs) -> case http_uri:parse(URI) of {ok, {http, _, _ , _, Path,_}} -> - ssl_manager:insert_crls(string:strip(Path, left, $/), CRLs); + ssl_manager:insert_crls(string:trim(Path, leading, "/"), CRLs); _ -> {error, {only_http_distribution_points_supported, URI}} end. @@ -162,7 +162,7 @@ cache_lookup(_, undefined) -> []; cache_lookup(URL, {{Cache, _}, _}) -> {ok, {_, _, _ , _, Path,_}} = http_uri:parse(URL), - case ssl_pkix_db:lookup(string:strip(Path, left, $/), Cache) of + case ssl_pkix_db:lookup(string:trim(Path, leading, "/"), Cache) of undefined -> []; CRLs -> diff --git a/lib/ssl/src/ssl_dist_sup.erl b/lib/ssl/src/ssl_dist_sup.erl index 690b896919..bea67935d8 100644 --- a/lib/ssl/src/ssl_dist_sup.erl +++ b/lib/ssl/src/ssl_dist_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2016. All Rights Reserved. +%% Copyright Ericsson AB 2011-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -30,6 +30,9 @@ %% Supervisor callback -export([init/1]). +%% Debug +-export([consult/1]). + %%%========================================================================= %%% API %%%========================================================================= @@ -37,7 +40,18 @@ -spec start_link() -> {ok, pid()} | ignore | {error, term()}. start_link() -> - supervisor:start_link({local, ?MODULE}, ?MODULE, []). + case init:get_argument(ssl_dist_optfile) of + {ok, [File]} -> + DistOpts = consult(File), + TabOpts = [set, protected, named_table], + Tab = ets:new(ssl_dist_opts, TabOpts), + true = ets:insert(Tab, DistOpts), + supervisor:start_link({local, ?MODULE}, ?MODULE, []); + {ok, BadArg} -> + error({bad_ssl_dist_optfile, BadArg}); + error -> + supervisor:start_link({local, ?MODULE}, ?MODULE, []) + end. %%%========================================================================= %%% Supervisor callback @@ -46,8 +60,7 @@ start_link() -> init([]) -> AdminSup = ssl_admin_child_spec(), ConnectionSup = ssl_connection_sup(), - ProxyServer = proxy_server_child_spec(), - {ok, {{one_for_all, 10, 3600}, [AdminSup, ProxyServer, ConnectionSup]}}. + {ok, {{one_for_all, 10, 3600}, [AdminSup, ConnectionSup]}}. %%-------------------------------------------------------------------- %%% Internal functions @@ -70,11 +83,51 @@ ssl_connection_sup() -> Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -proxy_server_child_spec() -> - Name = ssl_tls_dist_proxy, - StartFunc = {ssl_tls_dist_proxy, start_link, []}, - Restart = permanent, - Shutdown = 4000, - Modules = [ssl_tls_dist_proxy], - Type = worker, - {Name, StartFunc, Restart, Shutdown, Type, Modules}. +consult(File) -> + case erl_prim_loader:get_file(File) of + {ok, Binary, _FullName} -> + Encoding = + case epp:read_encoding_from_binary(Binary) of + none -> latin1; + Enc -> Enc + end, + case unicode:characters_to_list(Binary, Encoding) of + {error, _String, Rest} -> + error( + {bad_ssl_dist_optfile, {encoding_error, Rest}}); + {incomplete, _String, Rest} -> + error( + {bad_ssl_dist_optfile, {encoding_incomplete, Rest}}); + String when is_list(String) -> + consult_string(String) + end; + error -> + error({bad_ssl_dist_optfile, File}) + end. + +consult_string(String) -> + case erl_scan:string(String) of + {error, Info, Location} -> + error({bad_ssl_dist_optfile, {scan_error, Info, Location}}); + {ok, Tokens, _EndLocation} -> + consult_tokens(Tokens) + end. + +consult_tokens(Tokens) -> + case erl_parse:parse_exprs(Tokens) of + {error, Info} -> + error({bad_ssl_dist_optfile, {parse_error, Info}}); + {ok, [Expr]} -> + consult_expr(Expr); + {ok, Other} -> + error({bad_ssl_dist_optfile, {parse_error, Other}}) + end. + +consult_expr(Expr) -> + {value, Value, Bs} = erl_eval:expr(Expr, erl_eval:new_bindings()), + case erl_eval:bindings(Bs) of + [] -> + Value; + Other -> + error({bad_ssl_dist_optfile, {bindings, Other}}) + end. diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 0ee9ee3322..61d61b53dd 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -44,46 +44,44 @@ #client_key_exchange{} | #finished{} | #certificate_verify{} | #hello_request{} | #next_protocol{}. -%% Handshake messages +%% Create handshake messages -export([hello_request/0, server_hello/4, server_hello_done/0, - certificate/4, certificate_request/5, key_exchange/3, + certificate/4, client_certificate_verify/6, certificate_request/5, key_exchange/3, finished/5, next_protocol/1]). %% Handle handshake messages --export([certify/7, client_certificate_verify/6, certificate_verify/6, verify_signature/5, +-export([certify/7, certificate_verify/6, verify_signature/5, master_secret/4, server_key_exchange_hash/2, verify_connection/6, - init_handshake_history/0, update_handshake_history/3, verify_server_key/5 + init_handshake_history/0, update_handshake_history/3, verify_server_key/5, + select_version/3 ]). -%% Encode/Decode +%% Encode -export([encode_handshake/2, encode_hello_extensions/1, - encode_client_protocol_negotiation/2, encode_protocols_advertised_on_server/1, - decode_handshake/3, decode_hello_extensions/1, + encode_client_protocol_negotiation/2, encode_protocols_advertised_on_server/1]). +%% Decode +-export([decode_handshake/3, decode_hello_extensions/1, decode_server_key/3, decode_client_key/3, decode_suites/2 ]). %% Cipher suites handling --export([available_suites/2, available_signature_algs/2, cipher_suites/2, - select_session/11, supported_ecc/1, available_signature_algs/4]). +-export([available_suites/2, available_signature_algs/2, available_signature_algs/4, + cipher_suites/2, prf/6, select_session/11, supported_ecc/1, + premaster_secret/2, premaster_secret/3, premaster_secret/4]). %% Extensions handling -export([client_hello_extensions/5, handle_client_hello_extensions/9, %% Returns server hello extensions - handle_server_hello_extensions/9, select_curve/2, select_curve/3 + handle_server_hello_extensions/9, select_curve/2, select_curve/3, + select_hashsign/4, select_hashsign/5, + select_hashsign_algs/3 ]). -%% MISC --export([select_version/3, prf/6, select_hashsign/4, select_hashsign/5, - select_hashsign_algs/3, - premaster_secret/2, premaster_secret/3, premaster_secret/4]). - %%==================================================================== -%% Internal application API +%% Create handshake messages %%==================================================================== -%% ---------- Create handshake messages ---------- - %%-------------------------------------------------------------------- -spec hello_request() -> #hello_request{}. %% @@ -119,31 +117,6 @@ server_hello(SessionId, Version, ConnectionStates, Extensions) -> server_hello_done() -> #server_hello_done{}. -client_hello_extensions(Version, CipherSuites, - #ssl_options{signature_algs = SupportedHashSigns, - eccs = SupportedECCs} = SslOpts, ConnectionStates, Renegotiation) -> - {EcPointFormats, EllipticCurves} = - case advertises_ec_ciphers(lists:map(fun ssl_cipher:suite_definition/1, CipherSuites)) of - true -> - client_ecc_extensions(SupportedECCs); - false -> - {undefined, undefined} - end, - SRP = srp_user(SslOpts), - - #hello_extensions{ - renegotiation_info = renegotiation_info(tls_record, client, - ConnectionStates, Renegotiation), - srp = SRP, - signature_algs = available_signature_algs(SupportedHashSigns, Version), - ec_point_formats = EcPointFormats, - elliptic_curves = EllipticCurves, - alpn = encode_alpn(SslOpts#ssl_options.alpn_advertised_protocols, Renegotiation), - next_protocol_negotiation = - encode_client_protocol_negotiation(SslOpts#ssl_options.next_protocol_selector, - Renegotiation), - sni = sni(SslOpts#ssl_options.server_name_indication)}. - %%-------------------------------------------------------------------- -spec certificate(der_cert(), db_handle(), certdb_ref(), client | server) -> #certificate{} | #alert{}. %% @@ -171,14 +144,6 @@ certificate(OwnCert, CertDbHandle, CertDbRef, server) -> end. %%-------------------------------------------------------------------- --spec next_protocol(binary()) -> #next_protocol{}. -%% -%% Description: Creates a next protocol message -%%------------------------------------------------------------------- -next_protocol(SelectedProtocol) -> - #next_protocol{selected_protocol = SelectedProtocol}. - -%%-------------------------------------------------------------------- -spec client_certificate_verify(undefined | der_cert(), binary(), ssl_record:ssl_version(), term(), public_key:private_key(), ssl_handshake_history()) -> @@ -227,6 +192,7 @@ certificate_request(CipherSuite, CertDbHandle, CertDbRef, HashSigns, Version) -> {ecdh, #'ECPrivateKey'{}} | {psk, binary()} | {dhe_psk, binary(), binary()} | + {ecdhe_psk, binary(), #'ECPrivateKey'{}} | {srp, {binary(), binary()}, #srp_user{}, {HashAlgo::atom(), SignAlgo::atom()}, binary(), binary(), public_key:private_key()}) -> #client_key_exchange{} | #server_key_exchange{}. @@ -264,6 +230,13 @@ key_exchange(client, _Version, {dhe_psk, Identity, PublicKey}) -> dh_public = PublicKey} }; +key_exchange(client, _Version, {ecdhe_psk, Identity, #'ECPrivateKey'{publicKey = ECPublicKey}}) -> + #client_key_exchange{ + exchange_keys = #client_ecdhe_psk_identity{ + identity = Identity, + dh_public = ECPublicKey} + }; + key_exchange(client, _Version, {psk_premaster_secret, PskIdentity, Secret, {_, PublicKey, _}}) -> EncPremasterSecret = encrypted_premaster_secret(Secret, PublicKey), @@ -310,6 +283,16 @@ key_exchange(server, Version, {dhe_psk, PskIdentityHint, {PublicKey, _}, enc_server_key_exchange(Version, ServerEDHPSKParams, HashSign, ClientRandom, ServerRandom, PrivateKey); +key_exchange(server, Version, {ecdhe_psk, PskIdentityHint, + #'ECPrivateKey'{publicKey = ECPublicKey, + parameters = ECCurve}, + HashSign, ClientRandom, ServerRandom, PrivateKey}) -> + ServerECDHEPSKParams = #server_ecdhe_psk_params{ + hint = PskIdentityHint, + dh_params = #server_ecdh_params{curve = ECCurve, public = ECPublicKey}}, + enc_server_key_exchange(Version, ServerECDHEPSKParams, HashSign, + ClientRandom, ServerRandom, PrivateKey); + key_exchange(server, Version, {srp, {PublicKey, _}, #srp_user{generator = Generator, prime = Prime, salt = Salt}, @@ -328,22 +311,51 @@ key_exchange(server, Version, {srp, {PublicKey, _}, finished(Version, Role, PrfAlgo, MasterSecret, {Handshake, _}) -> % use the current handshake #finished{verify_data = calc_finished(Version, Role, PrfAlgo, MasterSecret, Handshake)}. +%%-------------------------------------------------------------------- +-spec next_protocol(binary()) -> #next_protocol{}. +%% +%% Description: Creates a next protocol message +%%------------------------------------------------------------------- +next_protocol(SelectedProtocol) -> + #next_protocol{selected_protocol = SelectedProtocol}. -%% ---------- Handle handshake messages ---------- +%%==================================================================== +%% Handle handshake messages +%%==================================================================== +%%-------------------------------------------------------------------- +-spec certify(#certificate{}, db_handle(), certdb_ref(), #ssl_options{}, term(), + client | server, inet:hostname() | inet:ip_address()) -> {der_cert(), public_key_info()} | #alert{}. +%% +%% Description: Handles a certificate handshake message +%%-------------------------------------------------------------------- +certify(#certificate{asn1_certificates = ASN1Certs}, CertDbHandle, CertDbRef, + Opts, CRLDbHandle, Role, Host) -> -verify_server_key(#server_key_params{params_bin = EncParams, - signature = Signature}, - HashSign = {HashAlgo, _}, - ConnectionStates, Version, PubKeyInfo) -> - #{security_parameters := SecParams} = - ssl_record:pending_connection_state(ConnectionStates, read), - #security_parameters{client_random = ClientRandom, - server_random = ServerRandom} = SecParams, - Hash = server_key_exchange_hash(HashAlgo, - <<ClientRandom/binary, - ServerRandom/binary, - EncParams/binary>>), - verify_signature(Version, Hash, HashSign, Signature, PubKeyInfo). + ServerName = server_name(Opts#ssl_options.server_name_indication, Host, Role), + [PeerCert | _] = ASN1Certs, + try + {TrustedCert, CertPath} = + ssl_certificate:trusted_cert_and_path(ASN1Certs, CertDbHandle, CertDbRef, + Opts#ssl_options.partial_chain), + ValidationFunAndState = validation_fun_and_state(Opts#ssl_options.verify_fun, Role, + CertDbHandle, CertDbRef, ServerName, + Opts#ssl_options.crl_check, CRLDbHandle, CertPath), + case public_key:pkix_path_validation(TrustedCert, + CertPath, + [{max_path_length, Opts#ssl_options.depth}, + {verify_fun, ValidationFunAndState}]) of + {ok, {PublicKeyInfo,_}} -> + {PeerCert, PublicKeyInfo}; + {error, Reason} -> + path_validation_alert(Reason) + end + catch + error:{badmatch,{asn1, Asn1Reason}} -> + %% ASN-1 decode of certificate somehow failed + ?ALERT_REC(?FATAL, ?CERTIFICATE_UNKNOWN, {failed_to_decode_certificate, Asn1Reason}); + error:OtherReason -> + ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {unexpected_error, OtherReason}) + end. %%-------------------------------------------------------------------- -spec certificate_verify(binary(), public_key_info(), ssl_record:ssl_version(), term(), @@ -386,43 +398,55 @@ verify_signature(_, Hash, {HashAlgo, _SignAlg}, Signature, {?'id-ecPublicKey', PublicKey, PublicKeyParams}) -> public_key:verify({digest, Hash}, HashAlgo, Signature, {PublicKey, PublicKeyParams}). - %%-------------------------------------------------------------------- --spec certify(#certificate{}, db_handle(), certdb_ref(), #ssl_options{}, term(), - client | server, inet:hostname() | inet:ip_address()) -> {der_cert(), public_key_info()} | #alert{}. +-spec master_secret(ssl_record:ssl_version(), #session{} | binary(), ssl_record:connection_states(), + client | server) -> {binary(), ssl_record:connection_states()} | #alert{}. %% -%% Description: Handles a certificate handshake message -%%-------------------------------------------------------------------- -certify(#certificate{asn1_certificates = ASN1Certs}, CertDbHandle, CertDbRef, - Opts, CRLDbHandle, Role, Host) -> +%% Description: Sets or calculates the master secret and calculate keys, +%% updating the pending connection states. The Mastersecret and the update +%% connection states are returned or an alert if the calculation fails. +%%------------------------------------------------------------------- +master_secret(Version, #session{master_secret = Mastersecret}, + ConnectionStates, Role) -> + #{security_parameters := SecParams} = + ssl_record:pending_connection_state(ConnectionStates, read), + try master_secret(Version, Mastersecret, SecParams, + ConnectionStates, Role) + catch + exit:_ -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, key_calculation_failure) + end; - ServerName = server_name(Opts#ssl_options.server_name_indication, Host, Role), - [PeerCert | _] = ASN1Certs, - try - {TrustedCert, CertPath} = - ssl_certificate:trusted_cert_and_path(ASN1Certs, CertDbHandle, CertDbRef, - Opts#ssl_options.partial_chain), - ValidationFunAndState = validation_fun_and_state(Opts#ssl_options.verify_fun, Role, - CertDbHandle, CertDbRef, ServerName, - Opts#ssl_options.crl_check, CRLDbHandle, CertPath), - case public_key:pkix_path_validation(TrustedCert, - CertPath, - [{max_path_length, Opts#ssl_options.depth}, - {verify_fun, ValidationFunAndState}]) of - {ok, {PublicKeyInfo,_}} -> - {PeerCert, PublicKeyInfo}; - {error, Reason} -> - path_validation_alert(Reason) - end +master_secret(Version, PremasterSecret, ConnectionStates, Role) -> + #{security_parameters := SecParams} = + ssl_record:pending_connection_state(ConnectionStates, read), + + #security_parameters{prf_algorithm = PrfAlgo, + client_random = ClientRandom, + server_random = ServerRandom} = SecParams, + try master_secret(Version, + calc_master_secret(Version,PrfAlgo,PremasterSecret, + ClientRandom, ServerRandom), + SecParams, ConnectionStates, Role) catch - error:{badmatch,{asn1, Asn1Reason}} -> - %% ASN-1 decode of certificate somehow failed - ?ALERT_REC(?FATAL, ?CERTIFICATE_UNKNOWN, {failed_to_decode_certificate, Asn1Reason}); - error:OtherReason -> - ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {unexpected_error, OtherReason}) + exit:_ -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, master_secret_calculation_failure) end. %%-------------------------------------------------------------------- +-spec server_key_exchange_hash(md5sha | md5 | sha | sha224 |sha256 | sha384 | sha512, binary()) -> binary(). +%% +%% Description: Calculate server key exchange hash +%%-------------------------------------------------------------------- +server_key_exchange_hash(md5sha, Value) -> + MD5 = crypto:hash(md5, Value), + SHA = crypto:hash(sha, Value), + <<MD5/binary, SHA/binary>>; + +server_key_exchange_hash(Hash, Value) -> + crypto:hash(Hash, Value). + +%%-------------------------------------------------------------------- -spec verify_connection(ssl_record:ssl_version(), #finished{}, client | server, integer(), binary(), ssl_handshake_history()) -> verified | #alert{}. %% @@ -469,275 +493,31 @@ update_handshake_history(Handshake, % special-case SSL2 client hello update_handshake_history({Handshake0, _Prev}, Data, _) -> {[Data|Handshake0], Handshake0}. -%% %%-------------------------------------------------------------------- -%% -spec decrypt_premaster_secret(binary(), #'RSAPrivateKey'{}) -> binary(). - -%% %% -%% %% Description: Public key decryption using the private key. -%% %%-------------------------------------------------------------------- -%% decrypt_premaster_secret(Secret, RSAPrivateKey) -> -%% try public_key:decrypt_private(Secret, RSAPrivateKey, -%% [{rsa_pad, rsa_pkcs1_padding}]) -%% catch -%% _:_ -> -%% throw(?ALERT_REC(?FATAL, ?DECRYPT_ERROR)) -%% end. - -premaster_secret(OtherPublicDhKey, MyPrivateKey, #'DHParameter'{} = Params) -> - try - public_key:compute_key(OtherPublicDhKey, MyPrivateKey, Params) - catch - error:computation_failed -> - throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)) - end; -premaster_secret(PublicDhKey, PrivateDhKey, #server_dh_params{dh_p = Prime, dh_g = Base}) -> - try - crypto:compute_key(dh, PublicDhKey, PrivateDhKey, [Prime, Base]) - catch - error:computation_failed -> - throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)) - end; -premaster_secret(#client_srp_public{srp_a = ClientPublicKey}, ServerKey, #srp_user{prime = Prime, - verifier = Verifier}) -> - case crypto:compute_key(srp, ClientPublicKey, ServerKey, {host, [Verifier, Prime, '6a']}) of - error -> - throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)); - PremasterSecret -> - PremasterSecret - end; -premaster_secret(#server_srp_params{srp_n = Prime, srp_g = Generator, srp_s = Salt, srp_b = Public}, - ClientKeys, {Username, Password}) -> - case ssl_srp_primes:check_srp_params(Generator, Prime) of - ok -> - DerivedKey = crypto:hash(sha, [Salt, crypto:hash(sha, [Username, <<$:>>, Password])]), - case crypto:compute_key(srp, Public, ClientKeys, {user, [DerivedKey, Prime, Generator, '6a']}) of - error -> - throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)); - PremasterSecret -> - PremasterSecret - end; - _ -> - throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)) - end; -premaster_secret(#client_rsa_psk_identity{ - identity = PSKIdentity, - exchange_keys = #encrypted_premaster_secret{premaster_secret = EncPMS} - }, #'RSAPrivateKey'{} = Key, PSKLookup) -> - PremasterSecret = premaster_secret(EncPMS, Key), - psk_secret(PSKIdentity, PSKLookup, PremasterSecret); -premaster_secret(#server_dhe_psk_params{ - hint = IdentityHint, - dh_params = #server_dh_params{dh_y = PublicDhKey} = Params}, - PrivateDhKey, - LookupFun) -> - PremasterSecret = premaster_secret(PublicDhKey, PrivateDhKey, Params), - psk_secret(IdentityHint, LookupFun, PremasterSecret); -premaster_secret({rsa_psk, PSKIdentity}, PSKLookup, RSAPremasterSecret) -> - psk_secret(PSKIdentity, PSKLookup, RSAPremasterSecret). - -premaster_secret(#client_dhe_psk_identity{ - identity = PSKIdentity, - dh_public = PublicDhKey}, PrivateKey, #'DHParameter'{} = Params, PSKLookup) -> - PremasterSecret = premaster_secret(PublicDhKey, PrivateKey, Params), - psk_secret(PSKIdentity, PSKLookup, PremasterSecret). -premaster_secret(#client_psk_identity{identity = PSKIdentity}, PSKLookup) -> - psk_secret(PSKIdentity, PSKLookup); -premaster_secret({psk, PSKIdentity}, PSKLookup) -> - psk_secret(PSKIdentity, PSKLookup); -premaster_secret(#'ECPoint'{} = ECPoint, #'ECPrivateKey'{} = ECDHKeys) -> - public_key:compute_key(ECPoint, ECDHKeys); -premaster_secret(EncSecret, #'RSAPrivateKey'{} = RSAPrivateKey) -> - try public_key:decrypt_private(EncSecret, RSAPrivateKey, - [{rsa_pad, rsa_pkcs1_padding}]) - catch - _:_ -> - throw(?ALERT_REC(?FATAL, ?DECRYPT_ERROR)) - end. -%%-------------------------------------------------------------------- --spec server_key_exchange_hash(md5sha | md5 | sha | sha224 |sha256 | sha384 | sha512, binary()) -> binary(). -%% -%% Description: Calculate server key exchange hash -%%-------------------------------------------------------------------- -server_key_exchange_hash(md5sha, Value) -> - MD5 = crypto:hash(md5, Value), - SHA = crypto:hash(sha, Value), - <<MD5/binary, SHA/binary>>; - -server_key_exchange_hash(Hash, Value) -> - crypto:hash(Hash, Value). -%%-------------------------------------------------------------------- --spec prf(ssl_record:ssl_version(), non_neg_integer(), binary(), binary(), [binary()], non_neg_integer()) -> - {ok, binary()} | {error, undefined}. -%% -%% Description: use the TLS PRF to generate key material -%%-------------------------------------------------------------------- -prf({3,0}, _, _, _, _, _) -> - {error, undefined}; -prf({3,_N}, PRFAlgo, Secret, Label, Seed, WantedLength) -> - {ok, tls_v1:prf(PRFAlgo, Secret, Label, Seed, WantedLength)}. - - -%%-------------------------------------------------------------------- --spec select_hashsign(#hash_sign_algos{} | undefined, undefined | binary(), - atom(), [atom()], ssl_record:ssl_version()) -> - {atom(), atom()} | undefined | #alert{}. - -%% -%% Description: Handles signature_algorithms hello extension (server) -%%-------------------------------------------------------------------- -select_hashsign(_, undefined, _, _, _Version) -> - {null, anon}; -%% The signature_algorithms extension was introduced with TLS 1.2. Ignore it if we have -%% negotiated a lower version. -select_hashsign(HashSigns, Cert, KeyExAlgo, - undefined, {Major, Minor} = Version) when Major >= 3 andalso Minor >= 3-> - select_hashsign(HashSigns, Cert, KeyExAlgo, tls_v1:default_signature_algs(Version), Version); -select_hashsign(#hash_sign_algos{hash_sign_algos = HashSigns}, Cert, KeyExAlgo, SupportedHashSigns, - {Major, Minor}) when Major >= 3 andalso Minor >= 3 -> - #'OTPCertificate'{tbsCertificate = TBSCert} = public_key:pkix_decode_cert(Cert, otp), - #'OTPCertificate'{tbsCertificate = TBSCert, - signatureAlgorithm = {_,SignAlgo, _}} = public_key:pkix_decode_cert(Cert, otp), - #'OTPSubjectPublicKeyInfo'{algorithm = {_, SubjAlgo, _}} = - TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo, - - Sign = sign_algo(SignAlgo), - SubSing = sign_algo(SubjAlgo), - - case lists:filter(fun({_, S} = Algos) when S == Sign -> - is_acceptable_hash_sign(Algos, Sign, - SubSing, KeyExAlgo, SupportedHashSigns); - (_) -> - false - end, HashSigns) of - [] -> - ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_signature_algorithm); - [HashSign | _] -> - HashSign - end; -select_hashsign(_, Cert, _, _, Version) -> - #'OTPCertificate'{tbsCertificate = TBSCert} = public_key:pkix_decode_cert(Cert, otp), - #'OTPSubjectPublicKeyInfo'{algorithm = {_,Algo, _}} = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo, - select_hashsign_algs(undefined, Algo, Version). -%%-------------------------------------------------------------------- --spec select_hashsign(#certificate_request{}, binary(), - [atom()], ssl_record:ssl_version()) -> - {atom(), atom()} | #alert{}. - -%% -%% Description: Handles signature algorithms selection for certificate requests (client) -%%-------------------------------------------------------------------- -select_hashsign(#certificate_request{}, undefined, _, {Major, Minor}) when Major >= 3 andalso Minor >= 3-> - %% There client does not have a certificate and will send an empty reply, the server may fail - %% or accept the connection by its own preference. No signature algorihms needed as there is - %% no certificate to verify. - {undefined, undefined}; - -select_hashsign(#certificate_request{hashsign_algorithms = #hash_sign_algos{hash_sign_algos = HashSigns}, - certificate_types = Types}, Cert, SupportedHashSigns, - {Major, Minor}) when Major >= 3 andalso Minor >= 3-> - #'OTPCertificate'{tbsCertificate = TBSCert} = public_key:pkix_decode_cert(Cert, otp), - #'OTPCertificate'{tbsCertificate = TBSCert, - signatureAlgorithm = {_,SignAlgo, _}} = public_key:pkix_decode_cert(Cert, otp), - #'OTPSubjectPublicKeyInfo'{algorithm = {_, SubjAlgo, _}} = - TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo, - - Sign = sign_algo(SignAlgo), - SubSign = sign_algo(SubjAlgo), - - case is_acceptable_cert_type(SubSign, HashSigns, Types) andalso is_supported_sign(Sign, HashSigns) of - true -> - case lists:filter(fun({_, S} = Algos) when S == SubSign -> - is_acceptable_hash_sign(Algos, SupportedHashSigns); - (_) -> - false - end, HashSigns) of - [] -> - ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_signature_algorithm); - [HashSign | _] -> - HashSign - end; - false -> - ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_signature_algorithm) - end; -select_hashsign(#certificate_request{}, Cert, _, Version) -> - select_hashsign(undefined, Cert, undefined, [], Version). - -%%-------------------------------------------------------------------- --spec select_hashsign_algs({atom(), atom()}| undefined, oid(), ssl_record:ssl_version()) -> - {atom(), atom()}. - -%% Description: For TLS 1.2 hash function and signature algorithm pairs can be -%% negotiated with the signature_algorithms extension, -%% for previous versions always use appropriate defaults. -%% 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: (e.i defaults for TLS 1.2) -%% -%% - If the negotiated key exchange algorithm is one of (RSA, DHE_RSA, -%% DH_RSA, RSA_PSK, ECDH_RSA, ECDHE_RSA), behave as if client had -%% sent the value {sha1,rsa}. -%% -%% - If the negotiated key exchange algorithm is one of (DHE_DSS, -%% DH_DSS), behave as if the client had sent the value {sha1,dsa}. -%% -%% - If the negotiated key exchange algorithm is one of (ECDH_ECDSA, -%% ECDHE_ECDSA), behave as if the client had sent value {sha1,ecdsa}. - -%%-------------------------------------------------------------------- -select_hashsign_algs(HashSign, _, {Major, Minor}) when HashSign =/= undefined andalso - Major >= 3 andalso Minor >= 3 -> - HashSign; -select_hashsign_algs(undefined, ?rsaEncryption, {Major, Minor}) when Major >= 3 andalso Minor >= 3 -> - {sha, rsa}; -select_hashsign_algs(undefined,?'id-ecPublicKey', _) -> - {sha, ecdsa}; -select_hashsign_algs(undefined, ?rsaEncryption, _) -> - {md5sha, rsa}; -select_hashsign_algs(undefined, ?'id-dsa', _) -> - {sha, dsa}. - - -%%-------------------------------------------------------------------- --spec master_secret(ssl_record:ssl_version(), #session{} | binary(), ssl_record:connection_states(), - client | server) -> {binary(), ssl_record:connection_states()} | #alert{}. -%% -%% Description: Sets or calculates the master secret and calculate keys, -%% updating the pending connection states. The Mastersecret and the update -%% connection states are returned or an alert if the calculation fails. -%%------------------------------------------------------------------- -master_secret(Version, #session{master_secret = Mastersecret}, - ConnectionStates, Role) -> - #{security_parameters := SecParams} = - ssl_record:pending_connection_state(ConnectionStates, read), - try master_secret(Version, Mastersecret, SecParams, - ConnectionStates, Role) - catch - exit:_ -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, key_calculation_failure) - end; - -master_secret(Version, PremasterSecret, ConnectionStates, Role) -> +verify_server_key(#server_key_params{params_bin = EncParams, + signature = Signature}, + HashSign = {HashAlgo, _}, + ConnectionStates, Version, PubKeyInfo) -> #{security_parameters := SecParams} = ssl_record:pending_connection_state(ConnectionStates, read), - - #security_parameters{prf_algorithm = PrfAlgo, - client_random = ClientRandom, + #security_parameters{client_random = ClientRandom, server_random = ServerRandom} = SecParams, - try master_secret(Version, - calc_master_secret(Version,PrfAlgo,PremasterSecret, - ClientRandom, ServerRandom), - SecParams, ConnectionStates, Role) - catch - exit:_ -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, master_secret_calculation_failure) - end. + Hash = server_key_exchange_hash(HashAlgo, + <<ClientRandom/binary, + ServerRandom/binary, + EncParams/binary>>), + verify_signature(Version, Hash, HashSign, Signature, PubKeyInfo). + +select_version(RecordCB, ClientVersion, Versions) -> + do_select_version(RecordCB, ClientVersion, Versions). + +%%==================================================================== +%% Encode handshake +%%==================================================================== -%%-------------Encode/Decode -------------------------------- encode_handshake(#next_protocol{selected_protocol = SelectedProtocol}, _Version) -> PaddingLength = 32 - ((byte_size(SelectedProtocol) + 2) rem 32), {?NEXT_PROTOCOL, <<?BYTE((byte_size(SelectedProtocol))), SelectedProtocol/binary, ?BYTE(PaddingLength), 0:(PaddingLength * 8)>>}; - encode_handshake(#server_hello{server_version = {Major, Minor}, random = Random, session_id = Session_ID, @@ -859,70 +639,6 @@ encode_hello_extensions([#sni{hostname = Hostname} | Rest], Acc) -> ?UINT16(HostLen), HostnameBin/binary, Acc/binary>>). -enc_server_key_exchange(Version, Params, {HashAlgo, SignAlgo}, - ClientRandom, ServerRandom, PrivateKey) -> - EncParams = encode_server_key(Params), - case HashAlgo of - null -> - #server_key_params{params = Params, - params_bin = EncParams, - hashsign = {null, anon}, - signature = <<>>}; - _ -> - Hash = - server_key_exchange_hash(HashAlgo, <<ClientRandom/binary, - ServerRandom/binary, - EncParams/binary>>), - Signature = digitally_signed(Version, Hash, HashAlgo, PrivateKey), - #server_key_params{params = Params, - params_bin = EncParams, - hashsign = {HashAlgo, SignAlgo}, - signature = Signature} - end. - -%%-------------------------------------------------------------------- --spec decode_client_key(binary(), ssl_cipher:key_algo(), ssl_record:ssl_version()) -> - #encrypted_premaster_secret{} - | #client_diffie_hellman_public{} - | #client_ec_diffie_hellman_public{} - | #client_psk_identity{} - | #client_dhe_psk_identity{} - | #client_rsa_psk_identity{} - | #client_srp_public{}. -%% -%% Description: Decode client_key data and return appropriate type -%%-------------------------------------------------------------------- -decode_client_key(ClientKey, Type, Version) -> - dec_client_key(ClientKey, key_exchange_alg(Type), Version). - -%%-------------------------------------------------------------------- --spec decode_server_key(binary(), ssl_cipher:key_algo(), ssl_record:ssl_version()) -> - #server_key_params{}. -%% -%% Description: Decode server_key data and return appropriate type -%%-------------------------------------------------------------------- -decode_server_key(ServerKey, Type, Version) -> - dec_server_key(ServerKey, key_exchange_alg(Type), Version). - -%% -%% Description: Encode and decode functions for ALPN extension data. -%%-------------------------------------------------------------------- - -%% While the RFC opens the door to allow ALPN during renegotiation, in practice -%% this does not work and it is recommended to ignore any ALPN extension during -%% renegotiation, as done here. -encode_alpn(_, true) -> - undefined; -encode_alpn(undefined, _) -> - undefined; -encode_alpn(Protocols, _) -> - #alpn{extension_data = lists:foldl(fun encode_protocol/2, <<>>, Protocols)}. - -decode_alpn(undefined) -> - undefined; -decode_alpn(#alpn{extension_data=Data}) -> - decode_protocols(Data, []). - encode_client_protocol_negotiation(undefined, _) -> undefined; encode_client_protocol_negotiation(_, false) -> @@ -936,6 +652,10 @@ encode_protocols_advertised_on_server(undefined) -> encode_protocols_advertised_on_server(Protocols) -> #next_protocol_negotiation{extension_data = lists:foldl(fun encode_protocol/2, <<>>, Protocols)}. +%%==================================================================== +%% Decode handshake +%%==================================================================== + decode_handshake(_, ?HELLO_REQUEST, <<>>) -> #hello_request{}; decode_handshake(_, ?NEXT_PROTOCOL, <<?BYTE(SelectedProtocolLength), @@ -968,7 +688,6 @@ decode_handshake(_Version, ?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:3 cipher_suite = Cipher_suite, compression_method = Comp_method, extensions = HelloExtensions}; - decode_handshake(_Version, ?CERTIFICATE, <<?UINT24(ACLen), ASN1Certs:ACLen/binary>>) -> #certificate{asn1_certificates = certs_to_list(ASN1Certs)}; decode_handshake(_Version, ?SERVER_KEY_EXCHANGE, Keys) -> @@ -1015,66 +734,30 @@ decode_hello_extensions({client, <<?UINT16(ExtLen), Extensions:ExtLen/binary>>}) decode_hello_extensions(Extensions) -> dec_hello_extensions(Extensions, #hello_extensions{}). -dec_server_key(<<?UINT16(PLen), P:PLen/binary, - ?UINT16(GLen), G:GLen/binary, - ?UINT16(YLen), Y:YLen/binary, _/binary>> = KeyStruct, - ?KEY_EXCHANGE_DIFFIE_HELLMAN, Version) -> - Params = #server_dh_params{dh_p = P, dh_g = G, dh_y = Y}, - {BinMsg, HashSign, Signature} = dec_server_key_params(PLen + GLen + YLen + 6, KeyStruct, Version), - #server_key_params{params = Params, - params_bin = BinMsg, - hashsign = HashSign, - signature = Signature}; -%% ECParameters with named_curve -%% TODO: explicit curve -dec_server_key(<<?BYTE(?NAMED_CURVE), ?UINT16(CurveID), - ?BYTE(PointLen), ECPoint:PointLen/binary, - _/binary>> = KeyStruct, - ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN, Version) -> - Params = #server_ecdh_params{curve = {namedCurve, tls_v1:enum_to_oid(CurveID)}, - public = ECPoint}, - {BinMsg, HashSign, Signature} = dec_server_key_params(PointLen + 4, KeyStruct, Version), - #server_key_params{params = Params, - params_bin = BinMsg, - hashsign = HashSign, - signature = Signature}; -dec_server_key(<<?UINT16(Len), PskIdentityHint:Len/binary, _/binary>> = KeyStruct, - KeyExchange, Version) - when KeyExchange == ?KEY_EXCHANGE_PSK; KeyExchange == ?KEY_EXCHANGE_RSA_PSK -> - Params = #server_psk_params{ - hint = PskIdentityHint}, - {BinMsg, HashSign, Signature} = dec_server_key_params(Len + 2, KeyStruct, Version), - #server_key_params{params = Params, - params_bin = BinMsg, - hashsign = HashSign, - signature = Signature}; -dec_server_key(<<?UINT16(Len), IdentityHint:Len/binary, - ?UINT16(PLen), P:PLen/binary, - ?UINT16(GLen), G:GLen/binary, - ?UINT16(YLen), Y:YLen/binary, _/binary>> = KeyStruct, - ?KEY_EXCHANGE_DHE_PSK, Version) -> - DHParams = #server_dh_params{dh_p = P, dh_g = G, dh_y = Y}, - Params = #server_dhe_psk_params{ - hint = IdentityHint, - dh_params = DHParams}, - {BinMsg, HashSign, Signature} = dec_server_key_params(Len + PLen + GLen + YLen + 8, KeyStruct, Version), - #server_key_params{params = Params, - params_bin = BinMsg, - hashsign = HashSign, - signature = Signature}; -dec_server_key(<<?UINT16(NLen), N:NLen/binary, - ?UINT16(GLen), G:GLen/binary, - ?BYTE(SLen), S:SLen/binary, - ?UINT16(BLen), B:BLen/binary, _/binary>> = KeyStruct, - ?KEY_EXCHANGE_SRP, Version) -> - Params = #server_srp_params{srp_n = N, srp_g = G, srp_s = S, srp_b = B}, - {BinMsg, HashSign, Signature} = dec_server_key_params(NLen + GLen + SLen + BLen + 7, KeyStruct, Version), - #server_key_params{params = Params, - params_bin = BinMsg, - hashsign = HashSign, - signature = Signature}; -dec_server_key(_, KeyExchange, _) -> - throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, {unknown_or_malformed_key_exchange, KeyExchange})). +%%-------------------------------------------------------------------- +-spec decode_server_key(binary(), ssl_cipher:key_algo(), ssl_record:ssl_version()) -> + #server_key_params{}. +%% +%% Description: Decode server_key data and return appropriate type +%%-------------------------------------------------------------------- +decode_server_key(ServerKey, Type, Version) -> + dec_server_key(ServerKey, key_exchange_alg(Type), Version). + +%%-------------------------------------------------------------------- +-spec decode_client_key(binary(), ssl_cipher:key_algo(), ssl_record:ssl_version()) -> + #encrypted_premaster_secret{} + | #client_diffie_hellman_public{} + | #client_ec_diffie_hellman_public{} + | #client_psk_identity{} + | #client_dhe_psk_identity{} + | #client_ecdhe_psk_identity{} + | #client_rsa_psk_identity{} + | #client_srp_public{}. +%% +%% Description: Decode client_key data and return appropriate type +%%-------------------------------------------------------------------- +decode_client_key(ClientKey, Type, Version) -> + dec_client_key(ClientKey, key_exchange_alg(Type), Version). %%-------------------------------------------------------------------- -spec decode_suites('2_bytes'|'3_bytes', binary()) -> list(). @@ -1086,7 +769,9 @@ decode_suites('2_bytes', Dec) -> decode_suites('3_bytes', Dec) -> from_3bytes(Dec). -%%-------------Cipeher suite handling -------------------------------- +%%==================================================================== +%% Cipher suite handling +%%==================================================================== available_suites(UserSuites, Version) -> lists:filtermap(fun(Suite) -> @@ -1099,60 +784,37 @@ available_suites(ServerCert, UserSuites, Version, undefined, Curve) -> available_suites(ServerCert, UserSuites, Version, HashSigns, Curve) -> Suites = available_suites(ServerCert, UserSuites, Version, undefined, Curve), filter_hashsigns(Suites, [ssl_cipher:suite_definition(Suite) || Suite <- Suites], HashSigns, []). -filter_hashsigns([], [], _, Acc) -> - lists:reverse(Acc); -filter_hashsigns([Suite | Suites], [{KeyExchange,_,_,_} | Algos], HashSigns, - Acc) when KeyExchange == dhe_ecdsa; - KeyExchange == ecdhe_ecdsa -> - do_filter_hashsigns(ecdsa, Suite, Suites, Algos, HashSigns, Acc); - -filter_hashsigns([Suite | Suites], [{KeyExchange,_,_,_} | Algos], HashSigns, - Acc) when KeyExchange == rsa; - KeyExchange == dhe_rsa; - KeyExchange == ecdhe_rsa; - KeyExchange == srp_rsa; - KeyExchange == rsa_psk -> - do_filter_hashsigns(rsa, Suite, Suites, Algos, HashSigns, Acc); -filter_hashsigns([Suite | Suites], [{KeyExchange,_,_,_} | Algos], HashSigns, Acc) when - KeyExchange == dhe_dss; - KeyExchange == srp_dss -> - do_filter_hashsigns(dsa, Suite, Suites, Algos, HashSigns, Acc); -filter_hashsigns([Suite | Suites], [{KeyExchange,_,_,_} | Algos], HashSigns, Acc) when - KeyExchange == dh_dss; - KeyExchange == dh_rsa; - KeyExchange == dh_ecdsa; - KeyExchange == ecdh_rsa; - KeyExchange == ecdh_ecdsa -> - %% Fixed DH certificates MAY be signed with any hash/signature - %% algorithm pair appearing in the hash_sign extension. The names - %% DH_DSS, DH_RSA, ECDH_ECDSA, and ECDH_RSA are historical. - filter_hashsigns(Suites, Algos, HashSigns, [Suite| Acc]); -filter_hashsigns([Suite | Suites], [{KeyExchange,_,_,_} | Algos], HashSigns, Acc) when - KeyExchange == dh_anon; - KeyExchange == ecdh_anon; - KeyExchange == srp_anon; - KeyExchange == psk; - KeyExchange == dhe_psk -> - %% In this case hashsigns is not used as the kexchange is anonaymous - filter_hashsigns(Suites, Algos, HashSigns, [Suite| Acc]). -do_filter_hashsigns(SignAlgo, Suite, Suites, Algos, HashSigns, Acc) -> - case lists:keymember(SignAlgo, 2, HashSigns) of - true -> - filter_hashsigns(Suites, Algos, HashSigns, [Suite| Acc]); - false -> - filter_hashsigns(Suites, Algos, HashSigns, Acc) - end. - -unavailable_ecc_suites(no_curve) -> - ssl_cipher:ec_keyed_suites(); -unavailable_ecc_suites(_) -> - []. +available_signature_algs(undefined, _) -> + undefined; +available_signature_algs(SupportedHashSigns, Version) when Version >= {3, 3} -> + #hash_sign_algos{hash_sign_algos = SupportedHashSigns}; +available_signature_algs(_, _) -> + undefined. +available_signature_algs(undefined, SupportedHashSigns, _, Version) when + Version >= {3,3} -> + SupportedHashSigns; +available_signature_algs(#hash_sign_algos{hash_sign_algos = ClientHashSigns}, SupportedHashSigns, + _, Version) when Version >= {3,3} -> + sets:to_list(sets:intersection(sets:from_list(ClientHashSigns), + sets:from_list(SupportedHashSigns))); +available_signature_algs(_, _, _, _) -> + undefined. cipher_suites(Suites, false) -> [?TLS_EMPTY_RENEGOTIATION_INFO_SCSV | Suites]; cipher_suites(Suites, true) -> Suites. +%%-------------------------------------------------------------------- +-spec prf(ssl_record:ssl_version(), non_neg_integer(), binary(), binary(), [binary()], non_neg_integer()) -> + {ok, binary()} | {error, undefined}. +%% +%% Description: use the TLS PRF to generate key material +%%-------------------------------------------------------------------- +prf({3,0}, _, _, _, _, _) -> + {error, undefined}; +prf({3,_N}, PRFAlgo, Secret, Label, Seed, WantedLength) -> + {ok, tls_v1:prf(PRFAlgo, Secret, Label, Seed, WantedLength)}. select_session(SuggestedSessionId, CipherSuites, HashSigns, Compressions, Port, #session{ecc = ECCCurve} = Session, Version, @@ -1173,68 +835,121 @@ select_session(SuggestedSessionId, CipherSuites, HashSigns, Compressions, Port, {resumed, Resumed} end. -%% Deprecated? supported_ecc({Major, Minor}) when ((Major == 3) and (Minor >= 1)) orelse (Major > 3) -> Curves = tls_v1:ecc_curves(Minor), #elliptic_curves{elliptic_curve_list = Curves}; supported_ecc(_) -> #elliptic_curves{elliptic_curve_list = []}. -%%-------------certificate handling -------------------------------- - -certificate_types(_, {N, M}) when N >= 3 andalso M >= 3 -> - case proplists:get_bool(ecdsa, - proplists:get_value(public_keys, crypto:supports())) of - true -> - <<?BYTE(?ECDSA_SIGN), ?BYTE(?RSA_SIGN), ?BYTE(?DSS_SIGN)>>; - false -> - <<?BYTE(?RSA_SIGN), ?BYTE(?DSS_SIGN)>> +premaster_secret(OtherPublicDhKey, MyPrivateKey, #'DHParameter'{} = Params) -> + try + public_key:compute_key(OtherPublicDhKey, MyPrivateKey, Params) + catch + error:computation_failed -> + throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)) + end; +premaster_secret(PublicDhKey, PrivateDhKey, #server_dh_params{dh_p = Prime, dh_g = Base}) -> + try + crypto:compute_key(dh, PublicDhKey, PrivateDhKey, [Prime, Base]) + catch + error:computation_failed -> + throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)) end; +premaster_secret(#client_srp_public{srp_a = ClientPublicKey}, ServerKey, #srp_user{prime = Prime, + verifier = Verifier}) -> + case crypto:compute_key(srp, ClientPublicKey, ServerKey, {host, [Verifier, Prime, '6a']}) of + error -> + throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)); + PremasterSecret -> + PremasterSecret + end; +premaster_secret(#server_srp_params{srp_n = Prime, srp_g = Generator, srp_s = Salt, srp_b = Public}, + ClientKeys, {Username, Password}) -> + case ssl_srp_primes:check_srp_params(Generator, Prime) of + ok -> + DerivedKey = crypto:hash(sha, [Salt, crypto:hash(sha, [Username, <<$:>>, Password])]), + case crypto:compute_key(srp, Public, ClientKeys, {user, [DerivedKey, Prime, Generator, '6a']}) of + error -> + throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)); + PremasterSecret -> + PremasterSecret + end; + _ -> + throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)) + end; +premaster_secret(#client_rsa_psk_identity{ + identity = PSKIdentity, + exchange_keys = #encrypted_premaster_secret{premaster_secret = EncPMS} + }, #'RSAPrivateKey'{} = Key, PSKLookup) -> + PremasterSecret = premaster_secret(EncPMS, Key), + psk_secret(PSKIdentity, PSKLookup, PremasterSecret); +premaster_secret(#server_dhe_psk_params{ + hint = IdentityHint, + dh_params = #server_dh_params{dh_y = PublicDhKey} = Params}, + PrivateDhKey, + LookupFun) -> + PremasterSecret = premaster_secret(PublicDhKey, PrivateDhKey, Params), + psk_secret(IdentityHint, LookupFun, PremasterSecret); +premaster_secret(#server_ecdhe_psk_params{ + hint = IdentityHint, + dh_params = #server_ecdh_params{ + public = ECServerPubKey}}, + PrivateEcDhKey, + LookupFun) -> + PremasterSecret = premaster_secret(#'ECPoint'{point = ECServerPubKey}, PrivateEcDhKey), + psk_secret(IdentityHint, LookupFun, PremasterSecret); +premaster_secret({rsa_psk, PSKIdentity}, PSKLookup, RSAPremasterSecret) -> + psk_secret(PSKIdentity, PSKLookup, RSAPremasterSecret); +premaster_secret(#client_ecdhe_psk_identity{ + identity = PSKIdentity, + dh_public = PublicEcDhPoint}, PrivateEcDhKey, PSKLookup) -> + PremasterSecret = premaster_secret(#'ECPoint'{point = PublicEcDhPoint}, PrivateEcDhKey), + psk_secret(PSKIdentity, PSKLookup, PremasterSecret). +premaster_secret(#client_dhe_psk_identity{ + identity = PSKIdentity, + dh_public = PublicDhKey}, PrivateKey, #'DHParameter'{} = Params, PSKLookup) -> + PremasterSecret = premaster_secret(PublicDhKey, PrivateKey, Params), + psk_secret(PSKIdentity, PSKLookup, PremasterSecret). +premaster_secret(#client_psk_identity{identity = PSKIdentity}, PSKLookup) -> + psk_secret(PSKIdentity, PSKLookup); +premaster_secret({psk, PSKIdentity}, PSKLookup) -> + psk_secret(PSKIdentity, PSKLookup); +premaster_secret(#'ECPoint'{} = ECPoint, #'ECPrivateKey'{} = ECDHKeys) -> + public_key:compute_key(ECPoint, ECDHKeys); +premaster_secret(EncSecret, #'RSAPrivateKey'{} = RSAPrivateKey) -> + try public_key:decrypt_private(EncSecret, RSAPrivateKey, + [{rsa_pad, rsa_pkcs1_padding}]) + catch + _:_ -> + throw(?ALERT_REC(?FATAL, ?DECRYPT_ERROR)) + end. +%%==================================================================== +%% Extensions handling +%%==================================================================== +client_hello_extensions(Version, CipherSuites, + #ssl_options{signature_algs = SupportedHashSigns, + eccs = SupportedECCs} = SslOpts, ConnectionStates, Renegotiation) -> + {EcPointFormats, EllipticCurves} = + case advertises_ec_ciphers(lists:map(fun ssl_cipher:suite_definition/1, CipherSuites)) of + true -> + client_ecc_extensions(SupportedECCs); + false -> + {undefined, undefined} + end, + SRP = srp_user(SslOpts), -certificate_types({KeyExchange, _, _, _}, _) when KeyExchange == rsa; - KeyExchange == dh_rsa; - KeyExchange == dhe_rsa; - KeyExchange == ecdhe_rsa -> - <<?BYTE(?RSA_SIGN)>>; - -certificate_types({KeyExchange, _, _, _}, _) when KeyExchange == dh_dss; - KeyExchange == dhe_dss; - KeyExchange == srp_dss -> - <<?BYTE(?DSS_SIGN)>>; - -certificate_types({KeyExchange, _, _, _}, _) when KeyExchange == dh_ecdsa; - KeyExchange == dhe_ecdsa; - KeyExchange == ecdh_ecdsa; - KeyExchange == ecdhe_ecdsa -> - <<?BYTE(?ECDSA_SIGN)>>; - -certificate_types(_, _) -> - <<?BYTE(?RSA_SIGN)>>. - -certificate_authorities(CertDbHandle, CertDbRef) -> - Authorities = certificate_authorities_from_db(CertDbHandle, CertDbRef), - Enc = fun(#'OTPCertificate'{tbsCertificate=TBSCert}) -> - OTPSubj = TBSCert#'OTPTBSCertificate'.subject, - DNEncodedBin = public_key:pkix_encode('Name', OTPSubj, otp), - DNEncodedLen = byte_size(DNEncodedBin), - <<?UINT16(DNEncodedLen), DNEncodedBin/binary>> - end, - list_to_binary([Enc(Cert) || {_, Cert} <- Authorities]). - -certificate_authorities_from_db(CertDbHandle, CertDbRef) when is_reference(CertDbRef) -> - ConnectionCerts = fun({{Ref, _, _}, Cert}, Acc) when Ref == CertDbRef -> - [Cert | Acc]; - (_, Acc) -> - Acc - end, - ssl_pkix_db:foldl(ConnectionCerts, [], CertDbHandle); -certificate_authorities_from_db(_CertDbHandle, {extracted, CertDbData}) -> - %% Cache disabled, Ref contains data - lists:foldl(fun({decoded, {_Key,Cert}}, Acc) -> [Cert | Acc] end, - [], CertDbData). - - -%%-------------Extension handling -------------------------------- + #hello_extensions{ + renegotiation_info = renegotiation_info(tls_record, client, + ConnectionStates, Renegotiation), + srp = SRP, + signature_algs = available_signature_algs(SupportedHashSigns, Version), + ec_point_formats = EcPointFormats, + elliptic_curves = EllipticCurves, + alpn = encode_alpn(SslOpts#ssl_options.alpn_advertised_protocols, Renegotiation), + next_protocol_negotiation = + encode_client_protocol_negotiation(SslOpts#ssl_options.next_protocol_selector, + Renegotiation), + sni = sni(SslOpts#ssl_options.server_name_indication)}. handle_client_hello_extensions(RecordCB, Random, ClientCipherSuites, #hello_extensions{renegotiation_info = Info, @@ -1311,231 +1026,207 @@ handle_server_hello_extensions(RecordCB, Random, CipherSuite, Compression, ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, too_many_protocols_in_server_hello) end. -select_version(RecordCB, ClientVersion, Versions) -> - do_select_version(RecordCB, ClientVersion, Versions). - -do_select_version(_, ClientVersion, []) -> - ClientVersion; -do_select_version(RecordCB, ClientVersion, [Version | Versions]) -> - case RecordCB:is_higher(Version, ClientVersion) of - true -> - %% Version too high for client - keep looking - do_select_version(RecordCB, ClientVersion, Versions); - false -> - %% Version ok for client - look for a higher - do_select_version(RecordCB, ClientVersion, Versions, Version) - end. -%% -do_select_version(_, _, [], GoodVersion) -> - GoodVersion; -do_select_version( - RecordCB, ClientVersion, [Version | Versions], GoodVersion) -> - BetterVersion = - case RecordCB:is_higher(Version, ClientVersion) of - true -> - %% Version too high for client - GoodVersion; - false -> - %% Version ok for client - case RecordCB:is_higher(Version, GoodVersion) of - true -> - %% Use higher version - Version; - false -> - GoodVersion - end - end, - do_select_version(RecordCB, ClientVersion, Versions, BetterVersion). +select_curve(Client, Server) -> + select_curve(Client, Server, false). -renegotiation_info(_, client, _, false) -> - #renegotiation_info{renegotiated_connection = undefined}; -renegotiation_info(_RecordCB, server, ConnectionStates, false) -> - ConnectionState = ssl_record:current_connection_state(ConnectionStates, read), - case maps:get(secure_renegotiation, ConnectionState) of - true -> - #renegotiation_info{renegotiated_connection = ?byte(0)}; - false -> - #renegotiation_info{renegotiated_connection = undefined} - end; -renegotiation_info(_RecordCB, client, ConnectionStates, true) -> - ConnectionState = ssl_record:current_connection_state(ConnectionStates, read), - case maps:get(secure_renegotiation, ConnectionState) of - true -> - Data = maps:get(client_verify_data, ConnectionState), - #renegotiation_info{renegotiated_connection = Data}; - false -> - #renegotiation_info{renegotiated_connection = undefined} +select_curve(#elliptic_curves{elliptic_curve_list = ClientCurves}, + #elliptic_curves{elliptic_curve_list = ServerCurves}, + ServerOrder) -> + case ServerOrder of + false -> + select_shared_curve(ClientCurves, ServerCurves); + true -> + select_shared_curve(ServerCurves, ClientCurves) end; +select_curve(undefined, _, _) -> + %% Client did not send ECC extension use default curve if + %% ECC cipher is negotiated + {namedCurve, ?secp256r1}. -renegotiation_info(_RecordCB, server, ConnectionStates, true) -> - ConnectionState = ssl_record:current_connection_state(ConnectionStates, read), - case maps:get(secure_renegotiation, ConnectionState) of - true -> - CData = maps:get(client_verify_data, ConnectionState), - SData = maps:get(server_verify_data, ConnectionState), - #renegotiation_info{renegotiated_connection = <<CData/binary, SData/binary>>}; - false -> - #renegotiation_info{renegotiated_connection = undefined} - end. +%%-------------------------------------------------------------------- +-spec select_hashsign(#hash_sign_algos{} | undefined, undefined | binary(), + atom(), [atom()], ssl_record:ssl_version()) -> + {atom(), atom()} | undefined | #alert{}. -handle_renegotiation_info(_RecordCB, _, #renegotiation_info{renegotiated_connection = ?byte(0)}, - ConnectionStates, false, _, _) -> - {ok, ssl_record:set_renegotiation_flag(true, ConnectionStates)}; +%% +%% Description: Handles signature_algorithms hello extension (server) +%%-------------------------------------------------------------------- +select_hashsign(_, undefined, _, _, _Version) -> + {null, anon}; +%% The signature_algorithms extension was introduced with TLS 1.2. Ignore it if we have +%% negotiated a lower version. +select_hashsign(HashSigns, Cert, KeyExAlgo, + undefined, {Major, Minor} = Version) when Major >= 3 andalso Minor >= 3-> + select_hashsign(HashSigns, Cert, KeyExAlgo, tls_v1:default_signature_algs(Version), Version); +select_hashsign(#hash_sign_algos{hash_sign_algos = HashSigns}, Cert, KeyExAlgo, SupportedHashSigns, + {Major, Minor}) when Major >= 3 andalso Minor >= 3 -> + #'OTPCertificate'{tbsCertificate = TBSCert} = public_key:pkix_decode_cert(Cert, otp), + #'OTPCertificate'{tbsCertificate = TBSCert, + signatureAlgorithm = {_,SignAlgo, _}} = public_key:pkix_decode_cert(Cert, otp), + #'OTPSubjectPublicKeyInfo'{algorithm = {_, SubjAlgo, _}} = + TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo, -handle_renegotiation_info(_RecordCB, server, undefined, ConnectionStates, _, _, CipherSuites) -> - case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of - true -> - {ok, ssl_record:set_renegotiation_flag(true, ConnectionStates)}; - false -> - {ok, ssl_record:set_renegotiation_flag(false, ConnectionStates)} + Sign = sign_algo(SignAlgo), + SubSing = sign_algo(SubjAlgo), + + case lists:filter(fun({_, S} = Algos) when S == Sign -> + is_acceptable_hash_sign(Algos, Sign, + SubSing, KeyExAlgo, SupportedHashSigns); + (_) -> + false + end, HashSigns) of + [] -> + ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_signature_algorithm); + [HashSign | _] -> + HashSign end; +select_hashsign(_, Cert, _, _, Version) -> + #'OTPCertificate'{tbsCertificate = TBSCert} = public_key:pkix_decode_cert(Cert, otp), + #'OTPSubjectPublicKeyInfo'{algorithm = {_,Algo, _}} = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo, + select_hashsign_algs(undefined, Algo, Version). +%%-------------------------------------------------------------------- +-spec select_hashsign(#certificate_request{}, binary(), + [atom()], ssl_record:ssl_version()) -> + {atom(), atom()} | #alert{}. -handle_renegotiation_info(_RecordCB, _, undefined, ConnectionStates, false, _, _) -> - {ok, ssl_record:set_renegotiation_flag(false, ConnectionStates)}; +%% +%% Description: Handles signature algorithms selection for certificate requests (client) +%%-------------------------------------------------------------------- +select_hashsign(#certificate_request{}, undefined, _, {Major, Minor}) when Major >= 3 andalso Minor >= 3-> + %% There client does not have a certificate and will send an empty reply, the server may fail + %% or accept the connection by its own preference. No signature algorihms needed as there is + %% no certificate to verify. + {undefined, undefined}; + +select_hashsign(#certificate_request{hashsign_algorithms = #hash_sign_algos{hash_sign_algos = HashSigns}, + certificate_types = Types}, Cert, SupportedHashSigns, + {Major, Minor}) when Major >= 3 andalso Minor >= 3-> + #'OTPCertificate'{tbsCertificate = TBSCert} = public_key:pkix_decode_cert(Cert, otp), + #'OTPCertificate'{tbsCertificate = TBSCert, + signatureAlgorithm = {_,SignAlgo, _}} = public_key:pkix_decode_cert(Cert, otp), + #'OTPSubjectPublicKeyInfo'{algorithm = {_, SubjAlgo, _}} = + TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo, -handle_renegotiation_info(_RecordCB, client, #renegotiation_info{renegotiated_connection = ClientServerVerify}, - ConnectionStates, true, _, _) -> - ConnectionState = ssl_record:current_connection_state(ConnectionStates, read), - CData = maps:get(client_verify_data, ConnectionState), - SData = maps:get(server_verify_data, ConnectionState), - case <<CData/binary, SData/binary>> == ClientServerVerify of + Sign = sign_algo(SignAlgo), + SubSign = sign_algo(SubjAlgo), + + case is_acceptable_cert_type(SubSign, HashSigns, Types) andalso is_supported_sign(Sign, HashSigns) of true -> - {ok, ConnectionStates}; + case lists:filter(fun({_, S} = Algos) when S == SubSign -> + is_acceptable_hash_sign(Algos, SupportedHashSigns); + (_) -> + false + end, HashSigns) of + [] -> + ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_signature_algorithm); + [HashSign | _] -> + HashSign + end; false -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, client_renegotiation) + ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_signature_algorithm) end; -handle_renegotiation_info(_RecordCB, server, #renegotiation_info{renegotiated_connection = ClientVerify}, - ConnectionStates, true, _, CipherSuites) -> - - case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of - true -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, {server_renegotiation, empty_renegotiation_info_scsv}); - false -> - ConnectionState = ssl_record:current_connection_state(ConnectionStates, read), - Data = maps:get(client_verify_data, ConnectionState), - case Data == ClientVerify of - true -> - {ok, ConnectionStates}; - false -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, server_renegotiation) - end - end; - -handle_renegotiation_info(RecordCB, client, undefined, ConnectionStates, true, SecureRenegotation, _) -> - handle_renegotiation_info(RecordCB, ConnectionStates, SecureRenegotation); +select_hashsign(#certificate_request{}, Cert, _, Version) -> + select_hashsign(undefined, Cert, undefined, [], Version). -handle_renegotiation_info(RecordCB, server, undefined, ConnectionStates, true, SecureRenegotation, CipherSuites) -> - case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of - true -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, {server_renegotiation, empty_renegotiation_info_scsv}); - false -> - handle_renegotiation_info(RecordCB, ConnectionStates, SecureRenegotation) - end. +%%-------------------------------------------------------------------- +-spec select_hashsign_algs({atom(), atom()}| undefined, oid(), ssl_record:ssl_version()) -> + {atom(), atom()}. -handle_renegotiation_info(_RecordCB, ConnectionStates, SecureRenegotation) -> - ConnectionState = ssl_record:current_connection_state(ConnectionStates, read), - case {SecureRenegotation, maps:get(secure_renegotiation, ConnectionState)} of - {_, true} -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, already_secure); - {true, false} -> - ?ALERT_REC(?FATAL, ?NO_RENEGOTIATION); - {false, false} -> - {ok, ConnectionStates} - end. +%% Description: For TLS 1.2 hash function and signature algorithm pairs can be +%% negotiated with the signature_algorithms extension, +%% for previous versions always use appropriate defaults. +%% 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: (e.i defaults for TLS 1.2) +%% +%% - If the negotiated key exchange algorithm is one of (RSA, DHE_RSA, +%% DH_RSA, RSA_PSK, ECDH_RSA, ECDHE_RSA), behave as if client had +%% sent the value {sha1,rsa}. +%% +%% - If the negotiated key exchange algorithm is one of (DHE_DSS, +%% DH_DSS), behave as if the client had sent the value {sha1,dsa}. +%% +%% - If the negotiated key exchange algorithm is one of (ECDH_ECDSA, +%% ECDHE_ECDSA), behave as if the client had sent value {sha1,ecdsa}. -hello_extensions_list(#hello_extensions{renegotiation_info = RenegotiationInfo, - srp = SRP, - signature_algs = HashSigns, - ec_point_formats = EcPointFormats, - elliptic_curves = EllipticCurves, - alpn = ALPN, - next_protocol_negotiation = NextProtocolNegotiation, - sni = Sni}) -> - [Ext || Ext <- [RenegotiationInfo, SRP, HashSigns, - EcPointFormats, EllipticCurves, ALPN, NextProtocolNegotiation, Sni], Ext =/= undefined]. +%%-------------------------------------------------------------------- +select_hashsign_algs(HashSign, _, {Major, Minor}) when HashSign =/= undefined andalso + Major >= 3 andalso Minor >= 3 -> + HashSign; +select_hashsign_algs(undefined, ?rsaEncryption, {Major, Minor}) when Major >= 3 andalso Minor >= 3 -> + {sha, rsa}; +select_hashsign_algs(undefined,?'id-ecPublicKey', _) -> + {sha, ecdsa}; +select_hashsign_algs(undefined, ?rsaEncryption, _) -> + {md5sha, rsa}; +select_hashsign_algs(undefined, ?'id-dsa', _) -> + {sha, dsa}. srp_user(#ssl_options{srp_identity = {UserName, _}}) -> #srp{username = UserName}; srp_user(_) -> undefined. -client_ecc_extensions(SupportedECCs) -> - CryptoSupport = proplists:get_value(public_keys, crypto:supports()), - case proplists:get_bool(ecdh, CryptoSupport) of - true -> - EcPointFormats = #ec_point_formats{ec_point_format_list = [?ECPOINT_UNCOMPRESSED]}, - EllipticCurves = SupportedECCs, - {EcPointFormats, EllipticCurves}; - _ -> - {undefined, undefined} - end. +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +%%------------- Create handshake messages ---------------------------- -server_ecc_extension(_Version, EcPointFormats) -> - CryptoSupport = proplists:get_value(public_keys, crypto:supports()), - case proplists:get_bool(ecdh, CryptoSupport) of +int_to_bin(I) -> + L = (length(integer_to_list(I, 16)) + 1) div 2, + <<I:(L*8)>>. + +certificate_types(_, {N, M}) when N >= 3 andalso M >= 3 -> + case proplists:get_bool(ecdsa, + proplists:get_value(public_keys, crypto:supports())) of true -> - handle_ecc_point_fmt_extension(EcPointFormats); + <<?BYTE(?ECDSA_SIGN), ?BYTE(?RSA_SIGN), ?BYTE(?DSS_SIGN)>>; false -> - undefined - end. - -handle_ecc_point_fmt_extension(undefined) -> - undefined; -handle_ecc_point_fmt_extension(_) -> - #ec_point_formats{ec_point_format_list = [?ECPOINT_UNCOMPRESSED]}. + <<?BYTE(?RSA_SIGN), ?BYTE(?DSS_SIGN)>> + end; -advertises_ec_ciphers([]) -> - false; -advertises_ec_ciphers([{ecdh_ecdsa, _,_,_} | _]) -> - true; -advertises_ec_ciphers([{ecdhe_ecdsa, _,_,_} | _]) -> - true; -advertises_ec_ciphers([{ecdh_rsa, _,_,_} | _]) -> - true; -advertises_ec_ciphers([{ecdhe_rsa, _,_,_} | _]) -> - true; -advertises_ec_ciphers([{ecdh_anon, _,_,_} | _]) -> - true; -advertises_ec_ciphers([_| Rest]) -> - advertises_ec_ciphers(Rest). +certificate_types(#{key_exchange := KeyExchange}, _) when KeyExchange == rsa; + KeyExchange == dh_rsa; + KeyExchange == dhe_rsa; + KeyExchange == ecdhe_rsa -> + <<?BYTE(?RSA_SIGN)>>; -select_curve(Client, Server) -> - select_curve(Client, Server, false). +certificate_types(#{key_exchange := KeyExchange}, _) when KeyExchange == dh_dss; + KeyExchange == dhe_dss; + KeyExchange == srp_dss -> + <<?BYTE(?DSS_SIGN)>>; -select_curve(#elliptic_curves{elliptic_curve_list = ClientCurves}, - #elliptic_curves{elliptic_curve_list = ServerCurves}, - ServerOrder) -> - case ServerOrder of - false -> - select_shared_curve(ClientCurves, ServerCurves); - true -> - select_shared_curve(ServerCurves, ClientCurves) - end; -select_curve(undefined, _, _) -> - %% Client did not send ECC extension use default curve if - %% ECC cipher is negotiated - {namedCurve, ?secp256r1}. +certificate_types(#{key_exchange := KeyExchange}, _) when KeyExchange == dh_ecdsa; + KeyExchange == dhe_ecdsa; + KeyExchange == ecdh_ecdsa; + KeyExchange == ecdhe_ecdsa -> + <<?BYTE(?ECDSA_SIGN)>>; +certificate_types(_, _) -> + <<?BYTE(?RSA_SIGN)>>. -select_shared_curve([], _) -> - no_curve; -select_shared_curve([Curve | Rest], Curves) -> - case lists:member(Curve, Curves) of - true -> - {namedCurve, Curve}; - false -> - select_shared_curve(Rest, Curves) - end. +certificate_authorities(CertDbHandle, CertDbRef) -> + Authorities = certificate_authorities_from_db(CertDbHandle, CertDbRef), + Enc = fun(#'OTPCertificate'{tbsCertificate=TBSCert}) -> + OTPSubj = TBSCert#'OTPTBSCertificate'.subject, + DNEncodedBin = public_key:pkix_encode('Name', OTPSubj, otp), + DNEncodedLen = byte_size(DNEncodedBin), + <<?UINT16(DNEncodedLen), DNEncodedBin/binary>> + end, + list_to_binary([Enc(Cert) || {_, Cert} <- Authorities]). -sni(undefined) -> - undefined; -sni(disable) -> - undefined; -sni(Hostname) -> - #sni{hostname = Hostname}. +certificate_authorities_from_db(CertDbHandle, CertDbRef) when is_reference(CertDbRef) -> + ConnectionCerts = fun({{Ref, _, _}, Cert}, Acc) when Ref == CertDbRef -> + [Cert | Acc]; + (_, Acc) -> + Acc + end, + ssl_pkix_db:foldl(ConnectionCerts, [], CertDbHandle); +certificate_authorities_from_db(_CertDbHandle, {extracted, CertDbData}) -> + %% Cache disabled, Ref contains data + lists:foldl(fun({decoded, {_Key,Cert}}, Acc) -> [Cert | Acc] end, + [], CertDbData). -%%-------------------------------------------------------------------- -%%% Internal functions -%%-------------------------------------------------------------------- +%%-------------Handle handshake messages -------------------------------- validation_fun_and_state({Fun, UserState0}, Role, CertDbHandle, CertDbRef, ServerNameIndication, CRLCheck, CRLDbHandle, CertPath) -> {fun(OtpCert, {extension, _} = Extension, {SslState, UserState}) -> @@ -1627,17 +1318,6 @@ path_validation_alert({bad_cert, unknown_ca}) -> path_validation_alert(Reason) -> ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, Reason). -encrypted_premaster_secret(Secret, RSAPublicKey) -> - try - PreMasterSecret = public_key:encrypt_public(Secret, RSAPublicKey, - [{rsa_pad, - rsa_pkcs1_padding}]), - #encrypted_premaster_secret{premaster_secret = PreMasterSecret} - catch - _:_-> - throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, premaster_encryption_failed)) - end. - digitally_signed(Version, Hashes, HashAlgo, PrivateKey) -> try do_digitally_signed(Version, Hashes, HashAlgo, PrivateKey) of Signature -> @@ -1646,17 +1326,123 @@ digitally_signed(Version, Hashes, HashAlgo, PrivateKey) -> error:badkey-> throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, bad_key(PrivateKey))) end. - +do_digitally_signed({3, Minor}, Hash, HashAlgo, #{algorithm := Alg} = Engine) + when Minor >= 3 -> + crypto:sign(Alg, HashAlgo, {digest, Hash}, maps:remove(algorithm, Engine)); do_digitally_signed({3, Minor}, Hash, HashAlgo, Key) when Minor >= 3 -> public_key:sign({digest, Hash}, HashAlgo, Key); -do_digitally_signed(_Version, Hash, HashAlgo, #'DSAPrivateKey'{} = Key) -> - public_key:sign({digest, Hash}, HashAlgo, Key); do_digitally_signed(_Version, Hash, _HashAlgo, #'RSAPrivateKey'{} = Key) -> public_key:encrypt_private(Hash, Key, [{rsa_pad, rsa_pkcs1_padding}]); +do_digitally_signed({3, _}, Hash, _, + #{algorithm := rsa} = Engine) -> + crypto:private_encrypt(rsa, Hash, maps:remove(algorithm, Engine), + rsa_pkcs1_padding); +do_digitally_signed({3, _}, Hash, HashAlgo, #{algorithm := Alg} = Engine) -> + crypto:sign(Alg, HashAlgo, {digest, Hash}, maps:remove(algorithm, Engine)); do_digitally_signed(_Version, Hash, HashAlgo, Key) -> public_key:sign({digest, Hash}, HashAlgo, Key). +bad_key(#'DSAPrivateKey'{}) -> + unacceptable_dsa_key; +bad_key(#'RSAPrivateKey'{}) -> + unacceptable_rsa_key; +bad_key(#'ECPrivateKey'{}) -> + unacceptable_ecdsa_key. + +crl_check(_, false, _,_,_, _, _) -> + valid; +crl_check(_, peer, _, _,_, valid, _) -> %% Do not check CAs with this option. + valid; +crl_check(OtpCert, Check, CertDbHandle, CertDbRef, {Callback, CRLDbHandle}, _, CertPath) -> + Options = [{issuer_fun, {fun(_DP, CRL, Issuer, DBInfo) -> + ssl_crl:trusted_cert_and_path(CRL, Issuer, {CertPath, + DBInfo}) + end, {CertDbHandle, CertDbRef}}}, + {update_crl, fun(DP, CRL) -> Callback:fresh_crl(DP, CRL) end}, + {undetermined_details, true} + ], + case dps_and_crls(OtpCert, Callback, CRLDbHandle, ext) of + no_dps -> + crl_check_same_issuer(OtpCert, Check, + dps_and_crls(OtpCert, Callback, CRLDbHandle, same_issuer), + Options); + DpsAndCRLs -> %% This DP list may be empty if relevant CRLs existed + %% but could not be retrived, will result in {bad_cert, revocation_status_undetermined} + case public_key:pkix_crls_validate(OtpCert, DpsAndCRLs, Options) of + {bad_cert, {revocation_status_undetermined, _}} -> + crl_check_same_issuer(OtpCert, Check, dps_and_crls(OtpCert, Callback, + CRLDbHandle, same_issuer), Options); + Other -> + Other + end + end. + +crl_check_same_issuer(OtpCert, best_effort, Dps, Options) -> + case public_key:pkix_crls_validate(OtpCert, Dps, Options) of + {bad_cert, {revocation_status_undetermined, _}} -> + valid; + Other -> + Other + end; +crl_check_same_issuer(OtpCert, _, Dps, Options) -> + public_key:pkix_crls_validate(OtpCert, Dps, Options). + +dps_and_crls(OtpCert, Callback, CRLDbHandle, ext) -> + case public_key:pkix_dist_points(OtpCert) of + [] -> + no_dps; + DistPoints -> + Issuer = OtpCert#'OTPCertificate'.tbsCertificate#'OTPTBSCertificate'.issuer, + CRLs = distpoints_lookup(DistPoints, Issuer, Callback, CRLDbHandle), + dps_and_crls(DistPoints, CRLs, []) + end; + +dps_and_crls(OtpCert, Callback, CRLDbHandle, same_issuer) -> + DP = #'DistributionPoint'{distributionPoint = {fullName, GenNames}} = + public_key:pkix_dist_point(OtpCert), + CRLs = lists:flatmap(fun({directoryName, Issuer}) -> + Callback:select(Issuer, CRLDbHandle); + (_) -> + [] + end, GenNames), + [{DP, {CRL, public_key:der_decode('CertificateList', CRL)}} || CRL <- CRLs]. + +dps_and_crls([], _, Acc) -> + Acc; +dps_and_crls([DP | Rest], CRLs, Acc) -> + DpCRL = [{DP, {CRL, public_key:der_decode('CertificateList', CRL)}} || CRL <- CRLs], + dps_and_crls(Rest, CRLs, DpCRL ++ Acc). + +distpoints_lookup([],_, _, _) -> + []; +distpoints_lookup([DistPoint | Rest], Issuer, Callback, CRLDbHandle) -> + Result = + try Callback:lookup(DistPoint, Issuer, CRLDbHandle) + catch + error:undef -> + %% The callback module still uses the 2-argument + %% version of the lookup function. + Callback:lookup(DistPoint, CRLDbHandle) + end, + case Result of + not_available -> + distpoints_lookup(Rest, Issuer, Callback, CRLDbHandle); + CRLs -> + CRLs + end. + +encrypted_premaster_secret(Secret, RSAPublicKey) -> + try + PreMasterSecret = public_key:encrypt_public(Secret, RSAPublicKey, + [{rsa_pad, + rsa_pkcs1_padding}]), + #encrypted_premaster_secret{premaster_secret = PreMasterSecret} + catch + _:_-> + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, premaster_encryption_failed)) + end. + calc_certificate_verify({3, 0}, HashAlgo, MasterSecret, Handshake) -> ssl_v3:certificate_verify(HashAlgo, MasterSecret, lists:reverse(Handshake)); calc_certificate_verify({3, N}, HashAlgo, _MasterSecret, Handshake) -> @@ -1709,24 +1495,7 @@ calc_master_secret({3,0}, _PrfAlgo, PremasterSecret, ClientRandom, ServerRandom) calc_master_secret({3,_}, PrfAlgo, PremasterSecret, ClientRandom, ServerRandom) -> tls_v1:master_secret(PrfAlgo, PremasterSecret, ClientRandom, ServerRandom). - -handle_renegotiation_extension(Role, RecordCB, Version, Info, Random, NegotiatedCipherSuite, - ClientCipherSuites, Compression, - ConnectionStates0, Renegotiation, SecureRenegotation) -> - case handle_renegotiation_info(RecordCB, Role, Info, ConnectionStates0, - Renegotiation, SecureRenegotation, - ClientCipherSuites) of - {ok, ConnectionStates} -> - hello_pending_connection_states(RecordCB, Role, - Version, - NegotiatedCipherSuite, - Random, - Compression, - ConnectionStates); - #alert{} = Alert -> - throw(Alert) - end. - + %% Update pending connection states with parameters exchanged via %% hello messages %% NOTE : Role is the role of the receiver of the hello message @@ -1766,7 +1535,43 @@ hello_security_parameters(server, Version, #{security_parameters := SecParams}, compression_algorithm = Compression }. -%%-------------Encode/Decode -------------------------------- +select_compression(_CompressionMetodes) -> + ?NULL. + +do_select_version(_, ClientVersion, []) -> + ClientVersion; +do_select_version(RecordCB, ClientVersion, [Version | Versions]) -> + case RecordCB:is_higher(Version, ClientVersion) of + true -> + %% Version too high for client - keep looking + do_select_version(RecordCB, ClientVersion, Versions); + false -> + %% Version ok for client - look for a higher + do_select_version(RecordCB, ClientVersion, Versions, Version) + end. +%% +do_select_version(_, _, [], GoodVersion) -> + GoodVersion; +do_select_version( + RecordCB, ClientVersion, [Version | Versions], GoodVersion) -> + BetterVersion = + case RecordCB:is_higher(Version, ClientVersion) of + true -> + %% Version too high for client + GoodVersion; + false -> + %% Version ok for client + case RecordCB:is_higher(Version, GoodVersion) of + true -> + %% Use higher version + Version; + false -> + GoodVersion + end + end, + do_select_version(RecordCB, ClientVersion, Versions, BetterVersion). + +%%-------------Encode handshakes -------------------------------- encode_server_key(#server_dh_params{dh_p = P, dh_g = G, dh_y = Y}) -> PLen = byte_size(P), @@ -1792,6 +1597,18 @@ encode_server_key(#server_dhe_psk_params{ YLen = byte_size(Y), <<?UINT16(Len), PskIdentityHint/binary, ?UINT16(PLen), P/binary, ?UINT16(GLen), G/binary, ?UINT16(YLen), Y/binary>>; +encode_server_key(Params = #server_ecdhe_psk_params{hint = undefined}) -> + encode_server_key(Params#server_ecdhe_psk_params{hint = <<>>}); +encode_server_key(#server_ecdhe_psk_params{ + hint = PskIdentityHint, + dh_params = #server_ecdh_params{ + curve = {namedCurve, ECCurve}, public = ECPubKey}}) -> + %%TODO: support arbitrary keys + Len = byte_size(PskIdentityHint), + KLen = size(ECPubKey), + <<?UINT16(Len), PskIdentityHint/binary, + ?BYTE(?NAMED_CURVE), ?UINT16((tls_v1:oid_to_enum(ECCurve))), + ?BYTE(KLen), ECPubKey/binary>>; encode_server_key(#server_srp_params{srp_n = N, srp_g = G, srp_s = S, srp_b = B}) -> NLen = byte_size(N), GLen = byte_size(G), @@ -1824,6 +1641,12 @@ encode_client_key(#client_dhe_psk_identity{identity = Id, dh_public = DHPublic}, Len = byte_size(Id), DHLen = byte_size(DHPublic), <<?UINT16(Len), Id/binary, ?UINT16(DHLen), DHPublic/binary>>; +encode_client_key(Identity = #client_ecdhe_psk_identity{identity = undefined}, Version) -> + encode_client_key(Identity#client_ecdhe_psk_identity{identity = <<"psk_identity">>}, Version); +encode_client_key(#client_ecdhe_psk_identity{identity = Id, dh_public = DHPublic}, _) -> + Len = byte_size(Id), + DHLen = byte_size(DHPublic), + <<?UINT16(Len), Id/binary, ?BYTE(DHLen), DHPublic/binary>>; encode_client_key(Identity = #client_rsa_psk_identity{identity = undefined}, Version) -> encode_client_key(Identity#client_rsa_psk_identity{identity = <<"psk_identity">>}, Version); encode_client_key(#client_rsa_psk_identity{identity = Id, exchange_keys = ExchangeKeys}, Version) -> @@ -1854,6 +1677,126 @@ encode_protocol(Protocol, Acc) -> Len = byte_size(Protocol), <<Acc/binary, ?BYTE(Len), Protocol/binary>>. +enc_server_key_exchange(Version, Params, {HashAlgo, SignAlgo}, + ClientRandom, ServerRandom, PrivateKey) -> + EncParams = encode_server_key(Params), + case HashAlgo of + null -> + #server_key_params{params = Params, + params_bin = EncParams, + hashsign = {null, anon}, + signature = <<>>}; + _ -> + Hash = + server_key_exchange_hash(HashAlgo, <<ClientRandom/binary, + ServerRandom/binary, + EncParams/binary>>), + Signature = digitally_signed(Version, Hash, HashAlgo, PrivateKey), + #server_key_params{params = Params, + params_bin = EncParams, + hashsign = {HashAlgo, SignAlgo}, + signature = Signature} + end. + +%% While the RFC opens the door to allow ALPN during renegotiation, in practice +%% this does not work and it is recommended to ignore any ALPN extension during +%% renegotiation, as done here. +encode_alpn(_, true) -> + undefined; +encode_alpn(undefined, _) -> + undefined; +encode_alpn(Protocols, _) -> + #alpn{extension_data = lists:foldl(fun encode_protocol/2, <<>>, Protocols)}. + +hello_extensions_list(#hello_extensions{renegotiation_info = RenegotiationInfo, + srp = SRP, + signature_algs = HashSigns, + ec_point_formats = EcPointFormats, + elliptic_curves = EllipticCurves, + alpn = ALPN, + next_protocol_negotiation = NextProtocolNegotiation, + sni = Sni}) -> + [Ext || Ext <- [RenegotiationInfo, SRP, HashSigns, + EcPointFormats, EllipticCurves, ALPN, NextProtocolNegotiation, Sni], Ext =/= undefined]. + +%%-------------Decode handshakes--------------------------------- +dec_server_key(<<?UINT16(PLen), P:PLen/binary, + ?UINT16(GLen), G:GLen/binary, + ?UINT16(YLen), Y:YLen/binary, _/binary>> = KeyStruct, + ?KEY_EXCHANGE_DIFFIE_HELLMAN, Version) -> + Params = #server_dh_params{dh_p = P, dh_g = G, dh_y = Y}, + {BinMsg, HashSign, Signature} = dec_server_key_params(PLen + GLen + YLen + 6, KeyStruct, Version), + #server_key_params{params = Params, + params_bin = BinMsg, + hashsign = HashSign, + signature = Signature}; +%% ECParameters with named_curve +%% TODO: explicit curve +dec_server_key(<<?BYTE(?NAMED_CURVE), ?UINT16(CurveID), + ?BYTE(PointLen), ECPoint:PointLen/binary, + _/binary>> = KeyStruct, + ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN, Version) -> + Params = #server_ecdh_params{curve = {namedCurve, tls_v1:enum_to_oid(CurveID)}, + public = ECPoint}, + {BinMsg, HashSign, Signature} = dec_server_key_params(PointLen + 4, KeyStruct, Version), + #server_key_params{params = Params, + params_bin = BinMsg, + hashsign = HashSign, + signature = Signature}; +dec_server_key(<<?UINT16(Len), PskIdentityHint:Len/binary, _/binary>> = KeyStruct, + KeyExchange, Version) + when KeyExchange == ?KEY_EXCHANGE_PSK; KeyExchange == ?KEY_EXCHANGE_RSA_PSK -> + Params = #server_psk_params{ + hint = PskIdentityHint}, + {BinMsg, HashSign, Signature} = dec_server_key_params(Len + 2, KeyStruct, Version), + #server_key_params{params = Params, + params_bin = BinMsg, + hashsign = HashSign, + signature = Signature}; +dec_server_key(<<?UINT16(Len), IdentityHint:Len/binary, + ?UINT16(PLen), P:PLen/binary, + ?UINT16(GLen), G:GLen/binary, + ?UINT16(YLen), Y:YLen/binary, _/binary>> = KeyStruct, + ?KEY_EXCHANGE_DHE_PSK, Version) -> + DHParams = #server_dh_params{dh_p = P, dh_g = G, dh_y = Y}, + Params = #server_dhe_psk_params{ + hint = IdentityHint, + dh_params = DHParams}, + {BinMsg, HashSign, Signature} = dec_server_key_params(Len + PLen + GLen + YLen + 8, KeyStruct, Version), + #server_key_params{params = Params, + params_bin = BinMsg, + hashsign = HashSign, + signature = Signature}; +dec_server_key(<<?UINT16(Len), IdentityHint:Len/binary, + ?BYTE(?NAMED_CURVE), ?UINT16(CurveID), + ?BYTE(PointLen), ECPoint:PointLen/binary, + _/binary>> = KeyStruct, + ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN_PSK, Version) -> + DHParams = #server_ecdh_params{ + curve = {namedCurve, tls_v1:enum_to_oid(CurveID)}, + public = ECPoint}, + Params = #server_ecdhe_psk_params{ + hint = IdentityHint, + dh_params = DHParams}, + {BinMsg, HashSign, Signature} = dec_server_key_params(Len + 2 + PointLen + 4, KeyStruct, Version), + #server_key_params{params = Params, + params_bin = BinMsg, + hashsign = HashSign, + signature = Signature}; +dec_server_key(<<?UINT16(NLen), N:NLen/binary, + ?UINT16(GLen), G:GLen/binary, + ?BYTE(SLen), S:SLen/binary, + ?UINT16(BLen), B:BLen/binary, _/binary>> = KeyStruct, + ?KEY_EXCHANGE_SRP, Version) -> + Params = #server_srp_params{srp_n = N, srp_g = G, srp_s = S, srp_b = B}, + {BinMsg, HashSign, Signature} = dec_server_key_params(NLen + GLen + SLen + BLen + 7, KeyStruct, Version), + #server_key_params{params = Params, + params_bin = BinMsg, + hashsign = HashSign, + signature = Signature}; +dec_server_key(_, KeyExchange, _) -> + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, {unknown_or_malformed_key_exchange, KeyExchange})). + dec_client_key(PKEPMS, ?KEY_EXCHANGE_RSA, {3, 0}) -> #encrypted_premaster_secret{premaster_secret = PKEPMS}; dec_client_key(<<?UINT16(_), PKEPMS/binary>>, ?KEY_EXCHANGE_RSA, _) -> @@ -1875,6 +1818,10 @@ dec_client_key(<<?UINT16(Len), Id:Len/binary, ?UINT16(DH_YLen), DH_Y:DH_YLen/binary>>, ?KEY_EXCHANGE_DHE_PSK, _) -> #client_dhe_psk_identity{identity = Id, dh_public = DH_Y}; +dec_client_key(<<?UINT16(Len), Id:Len/binary, + ?BYTE(DH_YLen), DH_Y:DH_YLen/binary>>, + ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN_PSK, _) -> + #client_ecdhe_psk_identity{identity = Id, dh_public = DH_Y}; dec_client_key(<<?UINT16(Len), Id:Len/binary, PKEPMS/binary>>, ?KEY_EXCHANGE_RSA_PSK, {3, 0}) -> #client_rsa_psk_identity{identity = Id, @@ -1995,6 +1942,11 @@ dec_sni(<<?BYTE(?SNI_NAMETYPE_HOST_NAME), ?UINT16(Len), dec_sni(<<?BYTE(_), ?UINT16(Len), _:Len, Rest/binary>>) -> dec_sni(Rest); dec_sni(_) -> undefined. +decode_alpn(undefined) -> + undefined; +decode_alpn(#alpn{extension_data=Data}) -> + decode_protocols(Data, []). + decode_next_protocols({next_protocol_negotiation, Protocols}) -> decode_protocols(Protocols, []). @@ -2039,6 +1991,7 @@ from_2bytes(<<>>, Acc) -> lists:reverse(Acc); from_2bytes(<<?UINT16(N), Rest/binary>>, Acc) -> from_2bytes(Rest, [?uint16(N) | Acc]). + key_exchange_alg(rsa) -> ?KEY_EXCHANGE_RSA; key_exchange_alg(Alg) when Alg == dhe_rsa; Alg == dhe_dss; @@ -2052,6 +2005,8 @@ key_exchange_alg(psk) -> ?KEY_EXCHANGE_PSK; key_exchange_alg(dhe_psk) -> ?KEY_EXCHANGE_DHE_PSK; +key_exchange_alg(ecdhe_psk) -> + ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN_PSK; key_exchange_alg(rsa_psk) -> ?KEY_EXCHANGE_RSA_PSK; key_exchange_alg(Alg) @@ -2060,8 +2015,123 @@ key_exchange_alg(Alg) key_exchange_alg(_) -> ?NULL. +%%-------------Cipher suite handling ----------------------------- +select_cipher_suite(CipherSuites, Suites, false) -> + select_cipher_suite(CipherSuites, Suites); +select_cipher_suite(CipherSuites, Suites, true) -> + select_cipher_suite(Suites, CipherSuites). + +select_cipher_suite([], _) -> + no_suite; +select_cipher_suite([Suite | ClientSuites], SupportedSuites) -> + case is_member(Suite, SupportedSuites) of + true -> + Suite; + false -> + select_cipher_suite(ClientSuites, SupportedSuites) + end. + +is_member(Suite, SupportedSuites) -> + lists:member(Suite, SupportedSuites). + +psk_secret(PSKIdentity, PSKLookup) -> + case handle_psk_identity(PSKIdentity, PSKLookup) of + {ok, PSK} when is_binary(PSK) -> + Len = erlang:byte_size(PSK), + <<?UINT16(Len), 0:(Len*8), ?UINT16(Len), PSK/binary>>; + #alert{} = Alert -> + Alert; + _ -> + throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)) + end. + +psk_secret(PSKIdentity, PSKLookup, PremasterSecret) -> + case handle_psk_identity(PSKIdentity, PSKLookup) of + {ok, PSK} when is_binary(PSK) -> + Len = erlang:byte_size(PremasterSecret), + PSKLen = erlang:byte_size(PSK), + <<?UINT16(Len), PremasterSecret/binary, ?UINT16(PSKLen), PSK/binary>>; + #alert{} = Alert -> + Alert; + _ -> + throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)) + end. + +handle_psk_identity(_PSKIdentity, LookupFun) + when LookupFun == undefined -> + error; +handle_psk_identity(PSKIdentity, {Fun, UserState}) -> + Fun(psk, PSKIdentity, UserState). + +filter_hashsigns([], [], _, Acc) -> + lists:reverse(Acc); +filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], HashSigns, + Acc) when KeyExchange == dhe_ecdsa; + KeyExchange == ecdhe_ecdsa -> + do_filter_hashsigns(ecdsa, Suite, Suites, Algos, HashSigns, Acc); + +filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], HashSigns, + Acc) when KeyExchange == rsa; + KeyExchange == dhe_rsa; + KeyExchange == ecdhe_rsa; + KeyExchange == srp_rsa; + KeyExchange == rsa_psk -> + do_filter_hashsigns(rsa, Suite, Suites, Algos, HashSigns, Acc); +filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], HashSigns, Acc) when + KeyExchange == dhe_dss; + KeyExchange == srp_dss -> + do_filter_hashsigns(dsa, Suite, Suites, Algos, HashSigns, Acc); +filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], HashSigns, Acc) when + KeyExchange == dh_dss; + KeyExchange == dh_rsa; + KeyExchange == dh_ecdsa; + KeyExchange == ecdh_rsa; + KeyExchange == ecdh_ecdsa -> + %% Fixed DH certificates MAY be signed with any hash/signature + %% algorithm pair appearing in the hash_sign extension. The names + %% DH_DSS, DH_RSA, ECDH_ECDSA, and ECDH_RSA are historical. + filter_hashsigns(Suites, Algos, HashSigns, [Suite| Acc]); +filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], HashSigns, Acc) when + KeyExchange == dh_anon; + KeyExchange == ecdh_anon; + KeyExchange == srp_anon; + KeyExchange == psk; + KeyExchange == dhe_psk; + KeyExchange == ecdhe_psk -> + %% In this case hashsigns is not used as the kexchange is anonaymous + filter_hashsigns(Suites, Algos, HashSigns, [Suite| Acc]). + +do_filter_hashsigns(SignAlgo, Suite, Suites, Algos, HashSigns, Acc) -> + case lists:keymember(SignAlgo, 2, HashSigns) of + true -> + filter_hashsigns(Suites, Algos, HashSigns, [Suite| Acc]); + false -> + filter_hashsigns(Suites, Algos, HashSigns, Acc) + end. + +unavailable_ecc_suites(no_curve) -> + ssl_cipher:ec_keyed_suites(); +unavailable_ecc_suites(_) -> + []. %%-------------Extension handling -------------------------------- +handle_renegotiation_extension(Role, RecordCB, Version, Info, Random, NegotiatedCipherSuite, + ClientCipherSuites, Compression, + ConnectionStates0, Renegotiation, SecureRenegotation) -> + case handle_renegotiation_info(RecordCB, Role, Info, ConnectionStates0, + Renegotiation, SecureRenegotation, + ClientCipherSuites) of + {ok, ConnectionStates} -> + hello_pending_connection_states(RecordCB, Role, + Version, + NegotiatedCipherSuite, + Random, + Compression, + ConnectionStates); + #alert{} = Alert -> + throw(Alert) + end. + %% Receive protocols, choose one from the list, return it. handle_alpn_extension(_, {error, Reason}) -> ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, Reason); @@ -2124,150 +2194,6 @@ handle_srp_extension(undefined, Session) -> handle_srp_extension(#srp{username = Username}, Session) -> Session#session{srp_username = Username}. -%%-------------Misc -------------------------------- - -select_cipher_suite(CipherSuites, Suites, false) -> - select_cipher_suite(CipherSuites, Suites); -select_cipher_suite(CipherSuites, Suites, true) -> - select_cipher_suite(Suites, CipherSuites). - -select_cipher_suite([], _) -> - no_suite; -select_cipher_suite([Suite | ClientSuites], SupportedSuites) -> - case is_member(Suite, SupportedSuites) of - true -> - Suite; - false -> - select_cipher_suite(ClientSuites, SupportedSuites) - end. - -int_to_bin(I) -> - L = (length(integer_to_list(I, 16)) + 1) div 2, - <<I:(L*8)>>. - -is_member(Suite, SupportedSuites) -> - lists:member(Suite, SupportedSuites). - -select_compression(_CompressionMetodes) -> - ?NULL. - -available_signature_algs(undefined, _) -> - undefined; -available_signature_algs(SupportedHashSigns, Version) when Version >= {3, 3} -> - #hash_sign_algos{hash_sign_algos = SupportedHashSigns}; -available_signature_algs(_, _) -> - undefined. - -psk_secret(PSKIdentity, PSKLookup) -> - case handle_psk_identity(PSKIdentity, PSKLookup) of - {ok, PSK} when is_binary(PSK) -> - Len = erlang:byte_size(PSK), - <<?UINT16(Len), 0:(Len*8), ?UINT16(Len), PSK/binary>>; - #alert{} = Alert -> - Alert; - _ -> - throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)) - end. - -psk_secret(PSKIdentity, PSKLookup, PremasterSecret) -> - case handle_psk_identity(PSKIdentity, PSKLookup) of - {ok, PSK} when is_binary(PSK) -> - Len = erlang:byte_size(PremasterSecret), - PSKLen = erlang:byte_size(PSK), - <<?UINT16(Len), PremasterSecret/binary, ?UINT16(PSKLen), PSK/binary>>; - #alert{} = Alert -> - Alert; - _ -> - throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)) - end. - -handle_psk_identity(_PSKIdentity, LookupFun) - when LookupFun == undefined -> - error; -handle_psk_identity(PSKIdentity, {Fun, UserState}) -> - Fun(psk, PSKIdentity, UserState). - -crl_check(_, false, _,_,_, _, _) -> - valid; -crl_check(_, peer, _, _,_, valid, _) -> %% Do not check CAs with this option. - valid; -crl_check(OtpCert, Check, CertDbHandle, CertDbRef, {Callback, CRLDbHandle}, _, CertPath) -> - Options = [{issuer_fun, {fun(_DP, CRL, Issuer, DBInfo) -> - ssl_crl:trusted_cert_and_path(CRL, Issuer, {CertPath, - DBInfo}) - end, {CertDbHandle, CertDbRef}}}, - {update_crl, fun(DP, CRL) -> Callback:fresh_crl(DP, CRL) end}, - {undetermined_details, true} - ], - case dps_and_crls(OtpCert, Callback, CRLDbHandle, ext) of - no_dps -> - crl_check_same_issuer(OtpCert, Check, - dps_and_crls(OtpCert, Callback, CRLDbHandle, same_issuer), - Options); - DpsAndCRLs -> %% This DP list may be empty if relevant CRLs existed - %% but could not be retrived, will result in {bad_cert, revocation_status_undetermined} - case public_key:pkix_crls_validate(OtpCert, DpsAndCRLs, Options) of - {bad_cert, {revocation_status_undetermined, _}} -> - crl_check_same_issuer(OtpCert, Check, dps_and_crls(OtpCert, Callback, - CRLDbHandle, same_issuer), Options); - Other -> - Other - end - end. - -crl_check_same_issuer(OtpCert, best_effort, Dps, Options) -> - case public_key:pkix_crls_validate(OtpCert, Dps, Options) of - {bad_cert, {revocation_status_undetermined, _}} -> - valid; - Other -> - Other - end; -crl_check_same_issuer(OtpCert, _, Dps, Options) -> - public_key:pkix_crls_validate(OtpCert, Dps, Options). - -dps_and_crls(OtpCert, Callback, CRLDbHandle, ext) -> - case public_key:pkix_dist_points(OtpCert) of - [] -> - no_dps; - DistPoints -> - Issuer = OtpCert#'OTPCertificate'.tbsCertificate#'OTPTBSCertificate'.issuer, - CRLs = distpoints_lookup(DistPoints, Issuer, Callback, CRLDbHandle), - dps_and_crls(DistPoints, CRLs, []) - end; - -dps_and_crls(OtpCert, Callback, CRLDbHandle, same_issuer) -> - DP = #'DistributionPoint'{distributionPoint = {fullName, GenNames}} = - public_key:pkix_dist_point(OtpCert), - CRLs = lists:flatmap(fun({directoryName, Issuer}) -> - Callback:select(Issuer, CRLDbHandle); - (_) -> - [] - end, GenNames), - [{DP, {CRL, public_key:der_decode('CertificateList', CRL)}} || CRL <- CRLs]. - -dps_and_crls([], _, Acc) -> - Acc; -dps_and_crls([DP | Rest], CRLs, Acc) -> - DpCRL = [{DP, {CRL, public_key:der_decode('CertificateList', CRL)}} || CRL <- CRLs], - dps_and_crls(Rest, CRLs, DpCRL ++ Acc). - -distpoints_lookup([],_, _, _) -> - []; -distpoints_lookup([DistPoint | Rest], Issuer, Callback, CRLDbHandle) -> - Result = - try Callback:lookup(DistPoint, Issuer, CRLDbHandle) - catch - error:undef -> - %% The callback module still uses the 2-argument - %% version of the lookup function. - Callback:lookup(DistPoint, CRLDbHandle) - end, - case Result of - not_available -> - distpoints_lookup(Rest, Issuer, Callback, CRLDbHandle); - CRLs -> - CRLs - end. sign_algo(?rsaEncryption) -> rsa; @@ -2310,6 +2236,7 @@ is_acceptable_hash_sign({_, ecdsa} = Algos, ecdsa, ecdsa, ecdhe_ecdsa, Supported is_acceptable_hash_sign(_, _, _, KeyExAlgo, _) when KeyExAlgo == psk; KeyExAlgo == dhe_psk; + KeyExAlgo == ecdhe_psk; KeyExAlgo == srp_anon; KeyExAlgo == dh_anon; KeyExAlgo == ecdhe_anon @@ -2317,7 +2244,6 @@ is_acceptable_hash_sign(_, _, _, KeyExAlgo, _) when true; is_acceptable_hash_sign(_,_, _,_,_) -> false. - is_acceptable_hash_sign(Algos, SupportedHashSigns) -> lists:member(Algos, SupportedHashSigns). @@ -2337,27 +2263,164 @@ sign_type(dsa) -> sign_type(ecdsa) -> ?ECDSA_SIGN. - -bad_key(#'DSAPrivateKey'{}) -> - unacceptable_dsa_key; -bad_key(#'RSAPrivateKey'{}) -> - unacceptable_rsa_key; -bad_key(#'ECPrivateKey'{}) -> - unacceptable_ecdsa_key. - -available_signature_algs(undefined, SupportedHashSigns, _, Version) when - Version >= {3,3} -> - SupportedHashSigns; -available_signature_algs(#hash_sign_algos{hash_sign_algos = ClientHashSigns}, SupportedHashSigns, - _, Version) when Version >= {3,3} -> - sets:to_list(sets:intersection(sets:from_list(ClientHashSigns), - sets:from_list(SupportedHashSigns))); -available_signature_algs(_, _, _, _) -> - undefined. - server_name(_, _, server) -> undefined; %% Not interesting to check your own name. server_name(undefined, Host, client) -> {fallback, Host}; %% Fallback to Host argument to connect server_name(SNI, _, client) -> SNI. %% If Server Name Indication is available + +client_ecc_extensions(SupportedECCs) -> + CryptoSupport = proplists:get_value(public_keys, crypto:supports()), + case proplists:get_bool(ecdh, CryptoSupport) of + true -> + EcPointFormats = #ec_point_formats{ec_point_format_list = [?ECPOINT_UNCOMPRESSED]}, + EllipticCurves = SupportedECCs, + {EcPointFormats, EllipticCurves}; + _ -> + {undefined, undefined} + end. + +server_ecc_extension(_Version, EcPointFormats) -> + CryptoSupport = proplists:get_value(public_keys, crypto:supports()), + case proplists:get_bool(ecdh, CryptoSupport) of + true -> + handle_ecc_point_fmt_extension(EcPointFormats); + false -> + undefined + end. + +handle_ecc_point_fmt_extension(undefined) -> + undefined; +handle_ecc_point_fmt_extension(_) -> + #ec_point_formats{ec_point_format_list = [?ECPOINT_UNCOMPRESSED]}. + +advertises_ec_ciphers([]) -> + false; +advertises_ec_ciphers([#{key_exchange := ecdh_ecdsa} | _]) -> + true; +advertises_ec_ciphers([#{key_exchange := ecdhe_ecdsa} | _]) -> + true; +advertises_ec_ciphers([#{key_exchange := ecdh_rsa} | _]) -> + true; +advertises_ec_ciphers([#{key_exchange := ecdhe_rsa} | _]) -> + true; +advertises_ec_ciphers([#{key_exchange := ecdh_anon} | _]) -> + true; +advertises_ec_ciphers([{ecdhe_psk, _,_,_} | _]) -> + true; +advertises_ec_ciphers([_| Rest]) -> + advertises_ec_ciphers(Rest). + +select_shared_curve([], _) -> + no_curve; +select_shared_curve([Curve | Rest], Curves) -> + case lists:member(Curve, Curves) of + true -> + {namedCurve, Curve}; + false -> + select_shared_curve(Rest, Curves) + end. + +sni(undefined) -> + undefined; +sni(disable) -> + undefined; +sni(Hostname) -> + #sni{hostname = Hostname}. + +renegotiation_info(_, client, _, false) -> + #renegotiation_info{renegotiated_connection = undefined}; +renegotiation_info(_RecordCB, server, ConnectionStates, false) -> + ConnectionState = ssl_record:current_connection_state(ConnectionStates, read), + case maps:get(secure_renegotiation, ConnectionState) of + true -> + #renegotiation_info{renegotiated_connection = ?byte(0)}; + false -> + #renegotiation_info{renegotiated_connection = undefined} + end; +renegotiation_info(_RecordCB, client, ConnectionStates, true) -> + ConnectionState = ssl_record:current_connection_state(ConnectionStates, read), + case maps:get(secure_renegotiation, ConnectionState) of + true -> + Data = maps:get(client_verify_data, ConnectionState), + #renegotiation_info{renegotiated_connection = Data}; + false -> + #renegotiation_info{renegotiated_connection = undefined} + end; + +renegotiation_info(_RecordCB, server, ConnectionStates, true) -> + ConnectionState = ssl_record:current_connection_state(ConnectionStates, read), + case maps:get(secure_renegotiation, ConnectionState) of + true -> + CData = maps:get(client_verify_data, ConnectionState), + SData = maps:get(server_verify_data, ConnectionState), + #renegotiation_info{renegotiated_connection = <<CData/binary, SData/binary>>}; + false -> + #renegotiation_info{renegotiated_connection = undefined} + end. + +handle_renegotiation_info(_RecordCB, _, #renegotiation_info{renegotiated_connection = ?byte(0)}, + ConnectionStates, false, _, _) -> + {ok, ssl_record:set_renegotiation_flag(true, ConnectionStates)}; + +handle_renegotiation_info(_RecordCB, server, undefined, ConnectionStates, _, _, CipherSuites) -> + case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of + true -> + {ok, ssl_record:set_renegotiation_flag(true, ConnectionStates)}; + false -> + {ok, ssl_record:set_renegotiation_flag(false, ConnectionStates)} + end; + +handle_renegotiation_info(_RecordCB, _, undefined, ConnectionStates, false, _, _) -> + {ok, ssl_record:set_renegotiation_flag(false, ConnectionStates)}; + +handle_renegotiation_info(_RecordCB, client, #renegotiation_info{renegotiated_connection = ClientServerVerify}, + ConnectionStates, true, _, _) -> + ConnectionState = ssl_record:current_connection_state(ConnectionStates, read), + CData = maps:get(client_verify_data, ConnectionState), + SData = maps:get(server_verify_data, ConnectionState), + case <<CData/binary, SData/binary>> == ClientServerVerify of + true -> + {ok, ConnectionStates}; + false -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, client_renegotiation) + end; +handle_renegotiation_info(_RecordCB, server, #renegotiation_info{renegotiated_connection = ClientVerify}, + ConnectionStates, true, _, CipherSuites) -> + + case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of + true -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, {server_renegotiation, empty_renegotiation_info_scsv}); + false -> + ConnectionState = ssl_record:current_connection_state(ConnectionStates, read), + Data = maps:get(client_verify_data, ConnectionState), + case Data == ClientVerify of + true -> + {ok, ConnectionStates}; + false -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, server_renegotiation) + end + end; + +handle_renegotiation_info(RecordCB, client, undefined, ConnectionStates, true, SecureRenegotation, _) -> + handle_renegotiation_info(RecordCB, ConnectionStates, SecureRenegotation); + +handle_renegotiation_info(RecordCB, server, undefined, ConnectionStates, true, SecureRenegotation, CipherSuites) -> + case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of + true -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, {server_renegotiation, empty_renegotiation_info_scsv}); + false -> + handle_renegotiation_info(RecordCB, ConnectionStates, SecureRenegotation) + end. + +handle_renegotiation_info(_RecordCB, ConnectionStates, SecureRenegotation) -> + ConnectionState = ssl_record:current_connection_state(ConnectionStates, read), + case {SecureRenegotation, maps:get(secure_renegotiation, ConnectionState)} of + {_, true} -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, already_secure); + {true, false} -> + ?ALERT_REC(?FATAL, ?NO_RENEGOTIATION); + {false, false} -> + {ok, ConnectionStates} + end. diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl index 324b7dbde3..a191fcf766 100644 --- a/lib/ssl/src/ssl_handshake.hrl +++ b/lib/ssl/src/ssl_handshake.hrl @@ -133,6 +133,7 @@ -define(KEY_EXCHANGE_DIFFIE_HELLMAN, 1). -define(KEY_EXCHANGE_EC_DIFFIE_HELLMAN, 6). -define(KEY_EXCHANGE_PSK, 2). +-define(KEY_EXCHANGE_EC_DIFFIE_HELLMAN_PSK, 7). -define(KEY_EXCHANGE_DHE_PSK, 3). -define(KEY_EXCHANGE_RSA_PSK, 4). -define(KEY_EXCHANGE_SRP, 5). @@ -162,6 +163,11 @@ dh_params }). +-record(server_ecdhe_psk_params, { + hint, + dh_params + }). + -record(server_srp_params, { srp_n, %% opaque srp_N<1..2^16-1> srp_g, %% opaque srp_g<1..2^16-1> @@ -254,6 +260,11 @@ dh_public }). +-record(client_ecdhe_psk_identity, { + identity, + dh_public + }). + -record(client_rsa_psk_identity, { identity, exchange_keys diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 24ac34653e..9bb1cbaeb0 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -95,7 +95,8 @@ certfile :: binary(), cert :: public_key:der_encoded() | secret_printout() | 'undefined', keyfile :: binary(), - key :: {'RSAPrivateKey' | 'DSAPrivateKey' | 'ECPrivateKey' | 'PrivateKeyInfo', public_key:der_encoded()} | secret_printout() | 'undefined', + key :: {'RSAPrivateKey' | 'DSAPrivateKey' | 'ECPrivateKey' | 'PrivateKeyInfo', + public_key:der_encoded()} | key_map() | secret_printout() | 'undefined', password :: string() | secret_printout() | 'undefined', cacerts :: [public_key:der_encoded()] | secret_printout() | 'undefined', cacertfile :: binary(), @@ -164,7 +165,15 @@ connection_cb }). - +-type key_map() :: #{algorithm := rsa | dss | ecdsa, + %% engine and key_id ought to + %% be :=, but putting it in + %% the spec gives dialyzer warning + %% of correct code! + engine => crypto:engine_ref(), + key_id => crypto:key_id(), + password => crypto:password() + }. -type state_name() :: hello | abbreviated | certify | cipher | connection. -type gen_fsm_state_return() :: {next_state, state_name(), term()} | {next_state, state_name(), term(), timeout()} | diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index 62c2ffce8b..dd6a3e8521 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -31,7 +31,7 @@ %% Connection state handling -export([initial_security_params/1, current_connection_state/2, pending_connection_state/2, - activate_pending_connection_state/2, + activate_pending_connection_state/3, set_security_params/3, set_mac_secret/4, set_master_secret/2, @@ -53,11 +53,11 @@ -type ssl_atom_version() :: tls_record:tls_atom_version(). -type connection_states() :: term(). %% Map -type connection_state() :: term(). %% Map + %%==================================================================== -%% Internal application API +%% Connection state handling %%==================================================================== - %%-------------------------------------------------------------------- -spec current_connection_state(connection_states(), read | write) -> connection_state(). @@ -83,7 +83,7 @@ pending_connection_state(ConnectionStates, write) -> maps:get(pending_write, ConnectionStates). %%-------------------------------------------------------------------- --spec activate_pending_connection_state(connection_states(), read | write) -> +-spec activate_pending_connection_state(connection_states(), read | write, tls_connection | dtls_connection) -> connection_states(). %% %% Description: Creates a new instance of the connection_states record @@ -91,13 +91,13 @@ pending_connection_state(ConnectionStates, write) -> %%-------------------------------------------------------------------- activate_pending_connection_state(#{current_read := Current, pending_read := Pending} = States, - read) -> + read, Connection) -> #{secure_renegotiation := SecureRenegotation} = Current, #{beast_mitigation := BeastMitigation, security_parameters := SecParams} = Pending, NewCurrent = Pending#{sequence_number => 0}, ConnectionEnd = SecParams#security_parameters.connection_end, - EmptyPending = empty_connection_state(ConnectionEnd, BeastMitigation), + EmptyPending = Connection:empty_connection_state(ConnectionEnd, BeastMitigation), NewPending = EmptyPending#{secure_renegotiation => SecureRenegotation}, States#{current_read => NewCurrent, pending_read => NewPending @@ -105,13 +105,13 @@ activate_pending_connection_state(#{current_read := Current, activate_pending_connection_state(#{current_write := Current, pending_write := Pending} = States, - write) -> + write, Connection) -> NewCurrent = Pending#{sequence_number => 0}, #{secure_renegotiation := SecureRenegotation} = Current, #{beast_mitigation := BeastMitigation, security_parameters := SecParams} = Pending, ConnectionEnd = SecParams#security_parameters.connection_end, - EmptyPending = empty_connection_state(ConnectionEnd, BeastMitigation), + EmptyPending = Connection:empty_connection_state(ConnectionEnd, BeastMitigation), NewPending = EmptyPending#{secure_renegotiation => SecureRenegotation}, States#{current_write => NewCurrent, pending_write => NewPending @@ -267,6 +267,9 @@ set_pending_cipher_state(#{pending_read := Read, pending_read => Read#{cipher_state => ServerState}, pending_write => Write#{cipher_state => ClientState}}. +%%==================================================================== +%% Compression +%%==================================================================== uncompress(?NULL, Data, CS) -> {Data, CS}. @@ -282,6 +285,11 @@ compress(?NULL, Data, CS) -> compressions() -> [?byte(?NULL)]. + +%%==================================================================== +%% Payload encryption/decryption +%%==================================================================== + %%-------------------------------------------------------------------- -spec cipher(ssl_version(), iodata(), connection_state(), MacHash::binary()) -> {CipherFragment::binary(), connection_state()}. diff --git a/lib/ssl/src/ssl_tls_dist_proxy.erl b/lib/ssl/src/ssl_tls_dist_proxy.erl deleted file mode 100644 index 08947f24dd..0000000000 --- a/lib/ssl/src/ssl_tls_dist_proxy.erl +++ /dev/null @@ -1,479 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2011-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(ssl_tls_dist_proxy). - - --export([listen/2, accept/2, connect/3, get_tcp_address/1]). --export([init/1, start_link/0, handle_call/3, handle_cast/2, handle_info/2, - terminate/2, code_change/3, ssl_options/2]). - --include_lib("kernel/include/net_address.hrl"). - --record(state, - {listen, - accept_loop - }). - --define(PPRE, 4). --define(PPOST, 4). - - -%%==================================================================== -%% Internal application API -%%==================================================================== - -listen(Driver, Name) -> - gen_server:call(?MODULE, {listen, Driver, Name}, infinity). - -accept(Driver, Listen) -> - gen_server:call(?MODULE, {accept, Driver, Listen}, infinity). - -connect(Driver, Ip, Port) -> - gen_server:call(?MODULE, {connect, Driver, Ip, Port}, infinity). - - -do_listen(Options) -> - {First,Last} = case application:get_env(kernel,inet_dist_listen_min) of - {ok,N} when is_integer(N) -> - case application:get_env(kernel, - inet_dist_listen_max) of - {ok,M} when is_integer(M) -> - {N,M}; - _ -> - {N,N} - end; - _ -> - {0,0} - end, - do_listen(First, Last, listen_options([{backlog,128}|Options])). - -do_listen(First,Last,_) when First > Last -> - {error,eaddrinuse}; -do_listen(First,Last,Options) -> - case gen_tcp:listen(First, Options) of - {error, eaddrinuse} -> - do_listen(First+1,Last,Options); - Other -> - Other - end. - -listen_options(Opts0) -> - Opts1 = - case application:get_env(kernel, inet_dist_use_interface) of - {ok, Ip} -> - [{ip, Ip} | Opts0]; - _ -> - Opts0 - end, - case application:get_env(kernel, inet_dist_listen_options) of - {ok,ListenOpts} -> - ListenOpts ++ Opts1; - _ -> - Opts1 - end. - -connect_options(Opts) -> - case application:get_env(kernel, inet_dist_connect_options) of - {ok,ConnectOpts} -> - lists:ukeysort(1, ConnectOpts ++ Opts); - _ -> - Opts - end. - -%%==================================================================== -%% gen_server callbacks -%%==================================================================== - -start_link() -> - gen_server:start_link({local, ?MODULE}, ?MODULE, [], []). - -init([]) -> - process_flag(priority, max), - {ok, #state{}}. - -handle_call({listen, Driver, Name}, _From, State) -> - case gen_tcp:listen(0, [{active, false}, {packet,?PPRE}, {ip, loopback}]) of - {ok, Socket} -> - {ok, World} = do_listen([{active, false}, binary, {packet,?PPRE}, {reuseaddr, true}, - Driver:family()]), - {ok, TcpAddress} = get_tcp_address(Socket), - {ok, WorldTcpAddress} = get_tcp_address(World), - {_,Port} = WorldTcpAddress#net_address.address, - ErlEpmd = net_kernel:epmd_module(), - case ErlEpmd:register_node(Name, Port, Driver) of - {ok, Creation} -> - {reply, {ok, {Socket, TcpAddress, Creation}}, - State#state{listen={Socket, World}}}; - {error, _} = Error -> - {reply, Error, State} - end; - Error -> - {reply, Error, State} - end; - -handle_call({accept, _Driver, Listen}, {From, _}, State = #state{listen={_, World}}) -> - Self = self(), - ErtsPid = spawn_link(fun() -> accept_loop(Self, erts, Listen, From) end), - WorldPid = spawn_link(fun() -> accept_loop(Self, world, World, Listen) end), - {reply, ErtsPid, State#state{accept_loop={ErtsPid, WorldPid}}}; - -handle_call({connect, Driver, Ip, Port}, {From, _}, State) -> - Me = self(), - Pid = spawn_link(fun() -> setup_proxy(Driver, Ip, Port, Me) end), - receive - {Pid, go_ahead, LPort} -> - Res = {ok, Socket} = try_connect(LPort), - case gen_tcp:controlling_process(Socket, From) of - {error, badarg} = Error -> {reply, Error, State}; % From is dead anyway. - ok -> - flush_old_controller(From, Socket), - {reply, Res, State} - end; - {Pid, Error} -> - {reply, Error, State} - end; - -handle_call(_What, _From, State) -> - {reply, ok, State}. - -handle_cast(_What, State) -> - {noreply, State}. - -handle_info(_What, State) -> - {noreply, State}. - -terminate(_Reason, _St) -> - ok. - -code_change(_OldVsn, St, _Extra) -> - {ok, St}. - -%%-------------------------------------------------------------------- -%%% Internal functions -%%-------------------------------------------------------------------- -get_tcp_address(Socket) -> - case inet:sockname(Socket) of - {ok, Address} -> - {ok, Host} = inet:gethostname(), - NetAddress = #net_address{ - address = Address, - host = Host, - protocol = proxy, - family = inet - }, - {ok, NetAddress}; - {error, _} = Error -> Error - end. - -accept_loop(Proxy, erts = Type, Listen, Extra) -> - process_flag(priority, max), - case gen_tcp:accept(Listen) of - {ok, Socket} -> - Extra ! {accept,self(),Socket,inet,proxy}, - receive - {_Kernel, controller, Pid} -> - inet:setopts(Socket, [nodelay()]), - ok = gen_tcp:controlling_process(Socket, Pid), - flush_old_controller(Pid, Socket), - Pid ! {self(), controller}; - {_Kernel, unsupported_protocol} -> - exit(unsupported_protocol) - end; - {error, closed} -> - %% The listening socket is closed: the proxy process is - %% shutting down. Exit normally, to avoid generating a - %% spurious error report. - exit(normal); - Error -> - exit(Error) - end, - accept_loop(Proxy, Type, Listen, Extra); - -accept_loop(Proxy, world = Type, Listen, Extra) -> - process_flag(priority, max), - case gen_tcp:accept(Listen) of - {ok, Socket} -> - Opts = get_ssl_options(server), - wait_for_code_server(), - case ssl:ssl_accept(Socket, Opts) of - {ok, SslSocket} -> - PairHandler = - spawn_link(fun() -> - setup_connection(SslSocket, Extra) - end), - ok = ssl:controlling_process(SslSocket, PairHandler), - flush_old_controller(PairHandler, SslSocket); - {error, {options, _}} = Error -> - %% Bad options: that's probably our fault. Let's log that. - error_logger:error_msg("Cannot accept TLS distribution connection: ~s~n", - [ssl:format_error(Error)]), - gen_tcp:close(Socket); - _ -> - gen_tcp:close(Socket) - end; - Error -> - exit(Error) - end, - accept_loop(Proxy, Type, Listen, Extra). - -wait_for_code_server() -> - %% This is an ugly hack. Upgrading a socket to TLS requires the - %% crypto module to be loaded. Loading the crypto module triggers - %% its on_load function, which calls code:priv_dir/1 to find the - %% directory where its NIF library is. However, distribution is - %% started earlier than the code server, so the code server is not - %% necessarily started yet, and code:priv_dir/1 might fail because - %% of that, if we receive an incoming connection on the - %% distribution port early enough. - %% - %% If the on_load function of a module fails, the module is - %% unloaded, and the function call that triggered loading it fails - %% with 'undef', which is rather confusing. - %% - %% Thus, the ssl_tls_dist_proxy process will terminate, and be - %% restarted by ssl_dist_sup. However, it won't have any memory - %% of being asked by net_kernel to listen for incoming - %% connections. Hence, the node will believe that it's open for - %% distribution, but it actually isn't. - %% - %% So let's avoid that by waiting for the code server to start. - case whereis(code_server) of - undefined -> - timer:sleep(10), - wait_for_code_server(); - Pid when is_pid(Pid) -> - ok - end. - -try_connect(Port) -> - case gen_tcp:connect({127,0,0,1}, Port, [{active, false}, {packet,?PPRE}, nodelay()]) of - R = {ok, _S} -> - R; - {error, _R} -> - try_connect(Port) - end. - -setup_proxy(Driver, Ip, Port, Parent) -> - process_flag(trap_exit, true), - Opts = connect_options(get_ssl_options(client)), - case ssl:connect(Ip, Port, [{active, true}, binary, {packet,?PPRE}, nodelay(), - Driver:family()] ++ Opts) of - {ok, World} -> - {ok, ErtsL} = gen_tcp:listen(0, [{active, true}, {ip, loopback}, binary, {packet,?PPRE}]), - {ok, #net_address{address={_,LPort}}} = get_tcp_address(ErtsL), - Parent ! {self(), go_ahead, LPort}, - case gen_tcp:accept(ErtsL) of - {ok, Erts} -> - %% gen_tcp:close(ErtsL), - loop_conn_setup(World, Erts); - Err -> - Parent ! {self(), Err} - end; - {error, {options, _}} = Err -> - %% Bad options: that's probably our fault. Let's log that. - error_logger:error_msg("Cannot open TLS distribution connection: ~s~n", - [ssl:format_error(Err)]), - Parent ! {self(), Err}; - Err -> - Parent ! {self(), Err} - end. - - -%% we may not always want the nodelay behaviour -%% %% for performance reasons - -nodelay() -> - case application:get_env(kernel, dist_nodelay) of - undefined -> - {nodelay, true}; - {ok, true} -> - {nodelay, true}; - {ok, false} -> - {nodelay, false}; - _ -> - {nodelay, true} - end. - -setup_connection(World, ErtsListen) -> - process_flag(trap_exit, true), - {ok, TcpAddress} = get_tcp_address(ErtsListen), - {_Addr,Port} = TcpAddress#net_address.address, - {ok, Erts} = gen_tcp:connect({127,0,0,1}, Port, [{active, true}, binary, {packet,?PPRE}, nodelay()]), - ssl:setopts(World, [{active,true}, {packet,?PPRE}, nodelay()]), - loop_conn_setup(World, Erts). - -loop_conn_setup(World, Erts) -> - receive - {ssl, World, Data = <<$a, _/binary>>} -> - gen_tcp:send(Erts, Data), - ssl:setopts(World, [{packet,?PPOST}, nodelay()]), - inet:setopts(Erts, [{packet,?PPOST}, nodelay()]), - loop_conn(World, Erts); - {tcp, Erts, Data = <<$a, _/binary>>} -> - ssl:send(World, Data), - ssl:setopts(World, [{packet,?PPOST}, nodelay()]), - inet:setopts(Erts, [{packet,?PPOST}, nodelay()]), - loop_conn(World, Erts); - {ssl, World, Data = <<_, _/binary>>} -> - gen_tcp:send(Erts, Data), - loop_conn_setup(World, Erts); - {tcp, Erts, Data = <<_, _/binary>>} -> - ssl:send(World, Data), - loop_conn_setup(World, Erts); - {ssl, World, Data} -> - gen_tcp:send(Erts, Data), - loop_conn_setup(World, Erts); - {tcp, Erts, Data} -> - ssl:send(World, Data), - loop_conn_setup(World, Erts); - {tcp_closed, Erts} -> - ssl:close(World); - {ssl_closed, World} -> - gen_tcp:close(Erts); - {ssl_error, World, _} -> - - ssl:close(World) - end. - -loop_conn(World, Erts) -> - receive - {ssl, World, Data} -> - gen_tcp:send(Erts, Data), - loop_conn(World, Erts); - {tcp, Erts, Data} -> - ssl:send(World, Data), - loop_conn(World, Erts); - {tcp_closed, Erts} -> - ssl:close(World); - {ssl_closed, World} -> - gen_tcp:close(Erts); - {ssl_error, World, _} -> - ssl:close(World) - end. - -get_ssl_options(Type) -> - case init:get_argument(ssl_dist_opt) of - {ok, Args} -> - [{erl_dist, true} | ssl_options(Type, lists:append(Args))]; - _ -> - [{erl_dist, true}] - end. - -ssl_options(_,[]) -> - []; -ssl_options(server, ["client_" ++ _, _Value |T]) -> - ssl_options(server,T); -ssl_options(client, ["server_" ++ _, _Value|T]) -> - ssl_options(client,T); -ssl_options(server, ["server_certfile", Value|T]) -> - [{certfile, Value} | ssl_options(server,T)]; -ssl_options(client, ["client_certfile", Value | T]) -> - [{certfile, Value} | ssl_options(client,T)]; -ssl_options(server, ["server_cacertfile", Value|T]) -> - [{cacertfile, Value} | ssl_options(server,T)]; -ssl_options(client, ["client_cacertfile", Value|T]) -> - [{cacertfile, Value} | ssl_options(client,T)]; -ssl_options(server, ["server_keyfile", Value|T]) -> - [{keyfile, Value} | ssl_options(server,T)]; -ssl_options(client, ["client_keyfile", Value|T]) -> - [{keyfile, Value} | ssl_options(client,T)]; -ssl_options(server, ["server_password", Value|T]) -> - [{password, Value} | ssl_options(server,T)]; -ssl_options(client, ["client_password", Value|T]) -> - [{password, Value} | ssl_options(client,T)]; -ssl_options(server, ["server_verify", Value|T]) -> - [{verify, atomize(Value)} | ssl_options(server,T)]; -ssl_options(client, ["client_verify", Value|T]) -> - [{verify, atomize(Value)} | ssl_options(client,T)]; -ssl_options(server, ["server_verify_fun", Value|T]) -> - [{verify_fun, verify_fun(Value)} | ssl_options(server,T)]; -ssl_options(client, ["client_verify_fun", Value|T]) -> - [{verify_fun, verify_fun(Value)} | ssl_options(client,T)]; -ssl_options(server, ["server_crl_check", Value|T]) -> - [{crl_check, atomize(Value)} | ssl_options(server,T)]; -ssl_options(client, ["client_crl_check", Value|T]) -> - [{crl_check, atomize(Value)} | ssl_options(client,T)]; -ssl_options(server, ["server_crl_cache", Value|T]) -> - [{crl_cache, termify(Value)} | ssl_options(server,T)]; -ssl_options(client, ["client_crl_cache", Value|T]) -> - [{crl_cache, termify(Value)} | ssl_options(client,T)]; -ssl_options(server, ["server_reuse_sessions", Value|T]) -> - [{reuse_sessions, atomize(Value)} | ssl_options(server,T)]; -ssl_options(client, ["client_reuse_sessions", Value|T]) -> - [{reuse_sessions, atomize(Value)} | ssl_options(client,T)]; -ssl_options(server, ["server_secure_renegotiate", Value|T]) -> - [{secure_renegotiate, atomize(Value)} | ssl_options(server,T)]; -ssl_options(client, ["client_secure_renegotiate", Value|T]) -> - [{secure_renegotiate, atomize(Value)} | ssl_options(client,T)]; -ssl_options(server, ["server_depth", Value|T]) -> - [{depth, list_to_integer(Value)} | ssl_options(server,T)]; -ssl_options(client, ["client_depth", Value|T]) -> - [{depth, list_to_integer(Value)} | ssl_options(client,T)]; -ssl_options(server, ["server_hibernate_after", Value|T]) -> - [{hibernate_after, list_to_integer(Value)} | ssl_options(server,T)]; -ssl_options(client, ["client_hibernate_after", Value|T]) -> - [{hibernate_after, list_to_integer(Value)} | ssl_options(client,T)]; -ssl_options(server, ["server_ciphers", Value|T]) -> - [{ciphers, Value} | ssl_options(server,T)]; -ssl_options(client, ["client_ciphers", Value|T]) -> - [{ciphers, Value} | ssl_options(client,T)]; -ssl_options(server, ["server_dhfile", Value|T]) -> - [{dhfile, Value} | ssl_options(server,T)]; -ssl_options(server, ["server_fail_if_no_peer_cert", Value|T]) -> - [{fail_if_no_peer_cert, atomize(Value)} | ssl_options(server,T)]; -ssl_options(Type, Opts) -> - error(malformed_ssl_dist_opt, [Type, Opts]). - -atomize(List) when is_list(List) -> - list_to_atom(List); -atomize(Atom) when is_atom(Atom) -> - Atom. - -termify(String) when is_list(String) -> - {ok, Tokens, _} = erl_scan:string(String ++ "."), - {ok, Term} = erl_parse:parse_term(Tokens), - Term. - -verify_fun(Value) -> - case termify(Value) of - {Mod, Func, State} when is_atom(Mod), is_atom(Func) -> - Fun = fun Mod:Func/3, - {Fun, State}; - _ -> - error(malformed_ssl_dist_opt, [Value]) - end. - -flush_old_controller(Pid, Socket) -> - receive - {tcp, Socket, Data} -> - Pid ! {tcp, Socket, Data}, - flush_old_controller(Pid, Socket); - {tcp_closed, Socket} -> - Pid ! {tcp_closed, Socket}, - flush_old_controller(Pid, Socket); - {ssl, Socket, Data} -> - Pid ! {ssl, Socket, Data}, - flush_old_controller(Pid, Socket); - {ssl_closed, Socket} -> - Pid ! {ssl_closed, Socket}, - flush_old_controller(Pid, Socket) - after 0 -> - ok - end. diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index b566551143..406a095d2e 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -45,33 +45,34 @@ %% Setup -export([start_fsm/8, start_link/7, init/1]). --export([encode_data/3, encode_alert/3]). - %% State transition handling --export([next_record/1, next_event/3, next_event/4]). +-export([next_record/1, next_event/3, next_event/4, handle_common_event/4]). %% Handshake handling -export([renegotiate/2, send_handshake/2, queue_handshake/2, queue_change_cipher/2, - reinit_handshake_data/1, select_sni_extension/1]). + reinit_handshake_data/1, select_sni_extension/1, empty_connection_state/2]). %% Alert and close handling --export([send_alert/2, close/5, protocol_name/0]). +-export([encode_alert/3, send_alert/2, close/5, protocol_name/0]). %% Data handling --export([passive_receive/2, next_record_if_active/1, handle_common_event/4, send/3, - socket/5, setopts/3, getopts/3]). +-export([encode_data/3, passive_receive/2, next_record_if_active/1, send/3, + socket/5, setopts/3, getopts/3]). %% gen_statem state functions -export([init/3, error/3, downgrade/3, %% Initiation and take down states hello/3, certify/3, cipher/3, abbreviated/3, %% Handshake states - connection/3]). + connection/3, death_row/3]). %% gen_statem callbacks -export([callback_mode/0, terminate/3, code_change/4, format_status/2]). %%==================================================================== %% Internal application API %%==================================================================== +%%==================================================================== +%% Setup +%%==================================================================== start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker} = Opts, User, {CbModule, _,_, _} = CbInfo, Timeout) -> @@ -100,6 +101,165 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_, Tracker} = Error end. +%%-------------------------------------------------------------------- +-spec start_link(atom(), host(), inet:port_number(), port(), list(), pid(), tuple()) -> + {ok, pid()} | ignore | {error, reason()}. +%% +%% Description: Creates a gen_statem process which calls Module:init/1 to +%% initialize. +%%-------------------------------------------------------------------- +start_link(Role, Host, Port, Socket, Options, User, CbInfo) -> + {ok, proc_lib:spawn_link(?MODULE, init, [[Role, Host, Port, Socket, Options, User, CbInfo]])}. + +init([Role, Host, Port, Socket, Options, User, CbInfo]) -> + process_flag(trap_exit, true), + State0 = initial_state(Role, Host, Port, Socket, Options, User, CbInfo), + try + State = ssl_connection:ssl_config(State0#state.ssl_options, Role, State0), + gen_statem:enter_loop(?MODULE, [], init, State) + catch throw:Error -> + gen_statem:enter_loop(?MODULE, [], error, {Error, State0}) + end. +%%==================================================================== +%% State transition handling +%%==================================================================== +next_record(#state{unprocessed_handshake_events = N} = State) when N > 0 -> + {no_record, State#state{unprocessed_handshake_events = N-1}}; + +next_record(#state{protocol_buffers = + #protocol_buffers{tls_packets = [], tls_cipher_texts = [CT | Rest]} + = Buffers, + connection_states = ConnStates0, + ssl_options = #ssl_options{padding_check = Check}} = State) -> + case tls_record:decode_cipher_text(CT, ConnStates0, Check) of + {Plain, ConnStates} -> + {Plain, State#state{protocol_buffers = + Buffers#protocol_buffers{tls_cipher_texts = Rest}, + connection_states = ConnStates}}; + #alert{} = Alert -> + {Alert, State} + end; +next_record(#state{protocol_buffers = #protocol_buffers{tls_packets = [], tls_cipher_texts = []}, + socket = Socket, + close_tag = CloseTag, + transport_cb = Transport} = State) -> + case tls_socket:setopts(Transport, Socket, [{active,once}]) of + ok -> + {no_record, State}; + _ -> + self() ! {CloseTag, Socket}, + {no_record, State} + end; +next_record(State) -> + {no_record, State}. + +next_event(StateName, Record, State) -> + next_event(StateName, Record, State, []). + +next_event(connection = StateName, no_record, State0, Actions) -> + case next_record_if_active(State0) of + {no_record, State} -> + ssl_connection:hibernate_after(StateName, State, Actions); + {#ssl_tls{} = Record, State} -> + {next_state, StateName, State, [{next_event, internal, {protocol_record, Record}} | Actions]}; + {#alert{} = Alert, State} -> + {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} + end; +next_event(StateName, Record, State, Actions) -> + case Record of + no_record -> + {next_state, StateName, State, Actions}; + #ssl_tls{} = Record -> + {next_state, StateName, State, [{next_event, internal, {protocol_record, Record}} | Actions]}; + #alert{} = Alert -> + {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} + end. + +handle_common_event(internal, #alert{} = Alert, StateName, + #state{negotiated_version = Version} = State) -> + ssl_connection:handle_own_alert(Alert, Version, StateName, State); +%%% TLS record protocol level handshake messages +handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, + StateName, #state{protocol_buffers = + #protocol_buffers{tls_handshake_buffer = Buf0} = Buffers, + negotiated_version = Version, + ssl_options = Options} = State0) -> + try + {Packets, Buf} = tls_handshake:get_tls_handshake(Version,Data,Buf0, Options), + State1 = + State0#state{protocol_buffers = + Buffers#protocol_buffers{tls_handshake_buffer = Buf}}, + case Packets of + [] -> + assert_buffer_sanity(Buf, Options), + {Record, State} = next_record(State1), + next_event(StateName, Record, State); + _ -> + Events = tls_handshake_events(Packets), + case StateName of + connection -> + ssl_connection:hibernate_after(StateName, State1, Events); + _ -> + {next_state, StateName, + State1#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events} + end + end + catch throw:#alert{} = Alert -> + ssl_connection:handle_own_alert(Alert, Version, StateName, State0) + end; +%%% TLS record protocol level application data messages +handle_common_event(internal, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName, State) -> + {next_state, StateName, State, [{next_event, internal, {application_data, Data}}]}; +%%% TLS record protocol level change cipher messages +handle_common_event(internal, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = Data}, StateName, State) -> + {next_state, StateName, State, [{next_event, internal, #change_cipher_spec{type = Data}}]}; +%%% TLS record protocol level Alert messages +handle_common_event(internal, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, StateName, + #state{negotiated_version = Version} = State) -> + try decode_alerts(EncAlerts) of + Alerts = [_|_] -> + handle_alerts(Alerts, {next_state, StateName, State}); + [] -> + ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, empty_alert), + Version, StateName, State); + #alert{} = Alert -> + ssl_connection:handle_own_alert(Alert, Version, StateName, State) + catch + _:_ -> + ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, alert_decode_error), + Version, StateName, State) + + end; +%% Ignore unknown TLS record level protocol messages +handle_common_event(internal, #ssl_tls{type = _Unknown}, StateName, State) -> + {next_state, StateName, State}. +%%==================================================================== +%% Handshake handling +%%==================================================================== +renegotiate(#state{role = client} = State, Actions) -> + %% Handle same way as if server requested + %% the renegotiation + Hs0 = ssl_handshake:init_handshake_history(), + {next_state, connection, State#state{tls_handshake_history = Hs0}, + [{next_event, internal, #hello_request{}} | Actions]}; + +renegotiate(#state{role = server, + socket = Socket, + transport_cb = Transport, + negotiated_version = Version, + connection_states = ConnectionStates0} = State0, Actions) -> + HelloRequest = ssl_handshake:hello_request(), + Frag = tls_handshake:encode_handshake(HelloRequest, Version), + Hs0 = ssl_handshake:init_handshake_history(), + {BinMsg, ConnectionStates} = + tls_record:encode_handshake(Frag, Version, ConnectionStates0), + send(Transport, Socket, BinMsg), + State1 = State0#state{connection_states = + ConnectionStates, + tls_handshake_history = Hs0}, + {Record, State} = next_record(State1), + next_event(hello, Record, State, Actions). + send_handshake(Handshake, State) -> send_handshake_flight(queue_handshake(Handshake, State)). @@ -128,15 +288,6 @@ queue_change_cipher(Msg, #state{negotiated_version = Version, State0#state{connection_states = ConnectionStates, flight_buffer = Flight0 ++ [BinChangeCipher]}. -send_alert(Alert, #state{negotiated_version = Version, - socket = Socket, - transport_cb = Transport, - connection_states = ConnectionStates0} = State0) -> - {BinMsg, ConnectionStates} = - encode_alert(Alert, Version, ConnectionStates0), - send(Transport, Socket, BinMsg), - State0#state{connection_states = ConnectionStates}. - reinit_handshake_data(State) -> %% premaster_secret, public_key_info and tls_handshake_info %% are only needed during the handshake phase. @@ -152,8 +303,20 @@ select_sni_extension(#client_hello{extensions = HelloExtensions}) -> select_sni_extension(_) -> undefined. -encode_data(Data, Version, ConnectionStates0)-> - tls_record:encode_data(Data, Version, ConnectionStates0). +empty_connection_state(ConnectionEnd, BeastMitigation) -> + ssl_record:empty_connection_state(ConnectionEnd, BeastMitigation). + +%%==================================================================== +%% Alert and close handling +%%==================================================================== +send_alert(Alert, #state{negotiated_version = Version, + socket = Socket, + transport_cb = Transport, + connection_states = ConnectionStates0} = State0) -> + {BinMsg, ConnectionStates} = + encode_alert(Alert, Version, ConnectionStates0), + send(Transport, Socket, BinMsg), + State0#state{connection_states = ConnectionStates}. %%-------------------------------------------------------------------- -spec encode_alert(#alert{}, ssl_record:ssl_version(), ssl_record:connection_states()) -> @@ -163,42 +326,66 @@ encode_data(Data, Version, ConnectionStates0)-> %%-------------------------------------------------------------------- encode_alert(#alert{} = Alert, Version, ConnectionStates) -> tls_record:encode_alert_record(Alert, Version, ConnectionStates). - +%% User closes or recursive call! +close({close, Timeout}, Socket, Transport = gen_tcp, _,_) -> + tls_socket:setopts(Transport, Socket, [{active, false}]), + Transport:shutdown(Socket, write), + _ = Transport:recv(Socket, 0, Timeout), + ok; +%% Peer closed socket +close({shutdown, transport_closed}, Socket, Transport = gen_tcp, ConnectionStates, Check) -> + close({close, 0}, Socket, Transport, ConnectionStates, Check); +%% We generate fatal alert +close({shutdown, own_alert}, Socket, Transport = gen_tcp, ConnectionStates, Check) -> + %% Standard trick to try to make sure all + %% data sent to the tcp port is really delivered to the + %% peer application before tcp port is closed so that the peer will + %% get the correct TLS alert message and not only a transport close. + %% Will return when other side has closed or after timout millisec + %% e.g. we do not want to hang if something goes wrong + %% with the network but we want to maximise the odds that + %% peer application gets all data sent on the tcp connection. + close({close, ?DEFAULT_TIMEOUT}, Socket, Transport, ConnectionStates, Check); +close(downgrade, _,_,_,_) -> + ok; +%% Other +close(_, Socket, Transport, _,_) -> + Transport:close(Socket). protocol_name() -> "TLS". -%%==================================================================== -%% tls_connection_sup API -%%==================================================================== -%%-------------------------------------------------------------------- --spec start_link(atom(), host(), inet:port_number(), port(), list(), pid(), tuple()) -> - {ok, pid()} | ignore | {error, reason()}. -%% -%% Description: Creates a gen_fsm process which calls Module:init/1 to -%% initialize. To ensure a synchronized start-up procedure, this function -%% does not return until Module:init/1 has returned. -%%-------------------------------------------------------------------- -start_link(Role, Host, Port, Socket, Options, User, CbInfo) -> - {ok, proc_lib:spawn_link(?MODULE, init, [[Role, Host, Port, Socket, Options, User, CbInfo]])}. +%%==================================================================== +%% Data handling +%%==================================================================== +encode_data(Data, Version, ConnectionStates0)-> + tls_record:encode_data(Data, Version, ConnectionStates0). -init([Role, Host, Port, Socket, Options, User, CbInfo]) -> - process_flag(trap_exit, true), - State0 = initial_state(Role, Host, Port, Socket, Options, User, CbInfo), - try - State = ssl_connection:ssl_config(State0#state.ssl_options, Role, State0), - gen_statem:enter_loop(?MODULE, [], init, State) - catch throw:Error -> - gen_statem:enter_loop(?MODULE, [], error, {Error, State0}) +passive_receive(State0 = #state{user_data_buffer = Buffer}, StateName) -> + case Buffer of + <<>> -> + {Record, State} = next_record(State0), + next_event(StateName, Record, State); + _ -> + {Record, State} = ssl_connection:read_application_data(<<>>, State0), + next_event(StateName, Record, State) end. -callback_mode() -> - state_functions. +next_record_if_active(State = + #state{socket_options = + #socket_options{active = false}}) -> + {no_record ,State}; +next_record_if_active(State) -> + next_record(State). + +send(Transport, Socket, Data) -> + tls_socket:send(Transport, Socket, Data). socket(Pid, Transport, Socket, Connection, Tracker) -> tls_socket:socket(Pid, Transport, Socket, Connection, Tracker). setopts(Transport, Socket, Other) -> tls_socket:setopts(Transport, Socket, Other). + getopts(Transport, Socket, Tag) -> tls_socket:getopts(Transport, Socket, Tag). @@ -241,7 +428,7 @@ init({call, From}, {start, Timeout}, {Record, State} = next_record(State1), next_event(hello, Record, State); init(Type, Event, State) -> - gen_handshake(ssl_connection, ?FUNCTION_NAME, Type, Event, State). + gen_handshake(?FUNCTION_NAME, Type, Event, State). %%-------------------------------------------------------------------- -spec error(gen_statem:event_type(), @@ -250,9 +437,10 @@ init(Type, Event, State) -> %%-------------------------------------------------------------------- error({call, From}, {start, _Timeout}, {Error, State}) -> - {stop_and_reply, normal, {reply, From, {error, Error}}, State}; -error({call, From}, Msg, State) -> - handle_call(Msg, From, ?FUNCTION_NAME, State); + ssl_connection:stop_and_reply( + normal, {reply, From, {error, Error}}, State); +error({call, _} = Call, Msg, State) -> + gen_handshake(?FUNCTION_NAME, Call, Msg, State); error(_, _, _) -> {keep_state_and_data, [postpone]}. @@ -282,14 +470,13 @@ hello(internal, #client_hello{client_version = ClientVersion} = Hello, undefined -> CurrentProtocol; _ -> Protocol0 end, - - gen_handshake(ssl_connection, hello, internal, {common_client_hello, Type, ServerHelloExt}, - State#state{connection_states = ConnectionStates, - negotiated_version = Version, - client_hello_version = ClientVersion, - hashsign_algorithm = HashSign, - session = Session, - negotiated_protocol = Protocol}) + gen_handshake(?FUNCTION_NAME, internal, {common_client_hello, Type, ServerHelloExt}, + State#state{connection_states = ConnectionStates, + negotiated_version = Version, + hashsign_algorithm = HashSign, + client_hello_version = ClientVersion, + session = Session, + negotiated_protocol = Protocol}) end; hello(internal, #server_hello{} = Hello, #state{connection_states = ConnectionStates0, @@ -307,7 +494,7 @@ hello(internal, #server_hello{} = Hello, hello(info, Event, State) -> gen_info(Event, ?FUNCTION_NAME, State); hello(Type, Event, State) -> - gen_handshake(ssl_connection, ?FUNCTION_NAME, Type, Event, State). + gen_handshake(?FUNCTION_NAME, Type, Event, State). %%-------------------------------------------------------------------- -spec abbreviated(gen_statem:event_type(), term(), #state{}) -> @@ -316,7 +503,7 @@ hello(Type, Event, State) -> abbreviated(info, Event, State) -> gen_info(Event, ?FUNCTION_NAME, State); abbreviated(Type, Event, State) -> - gen_handshake(ssl_connection, ?FUNCTION_NAME, Type, Event, State). + gen_handshake(?FUNCTION_NAME, Type, Event, State). %%-------------------------------------------------------------------- -spec certify(gen_statem:event_type(), term(), #state{}) -> @@ -325,7 +512,7 @@ abbreviated(Type, Event, State) -> certify(info, Event, State) -> gen_info(Event, ?FUNCTION_NAME, State); certify(Type, Event, State) -> - gen_handshake(ssl_connection, ?FUNCTION_NAME, Type, Event, State). + gen_handshake(?FUNCTION_NAME, Type, Event, State). %%-------------------------------------------------------------------- -spec cipher(gen_statem:event_type(), term(), #state{}) -> @@ -334,7 +521,7 @@ certify(Type, Event, State) -> cipher(info, Event, State) -> gen_info(Event, ?FUNCTION_NAME, State); cipher(Type, Event, State) -> - gen_handshake(ssl_connection, ?FUNCTION_NAME, Type, Event, State). + gen_handshake(?FUNCTION_NAME, Type, Event, State). %%-------------------------------------------------------------------- -spec connection(gen_statem:event_type(), @@ -379,162 +566,37 @@ connection(Type, Event, State) -> ssl_connection:?FUNCTION_NAME(Type, Event, State, ?MODULE). %%-------------------------------------------------------------------- --spec downgrade(gen_statem:event_type(), term(), #state{}) -> +-spec death_row(gen_statem:event_type(), term(), #state{}) -> gen_statem:state_function_result(). %%-------------------------------------------------------------------- -downgrade(Type, Event, State) -> - ssl_connection:?FUNCTION_NAME(Type, Event, State, ?MODULE). +death_row(Type, Event, State) -> + ssl_connection:death_row(Type, Event, State, ?MODULE). %%-------------------------------------------------------------------- -%% Event handling functions called by state functions to handle -%% common or unexpected events for the state. +-spec downgrade(gen_statem:event_type(), term(), #state{}) -> + gen_statem:state_function_result(). %%-------------------------------------------------------------------- -handle_call(Event, From, StateName, State) -> - ssl_connection:handle_call(Event, From, StateName, State, ?MODULE). - -%% raw data from socket, unpack records -handle_info({Protocol, _, Data}, StateName, - #state{data_tag = Protocol} = State0) -> - case next_tls_record(Data, State0) of - {Record, State} -> - next_event(StateName, Record, State); - #alert{} = Alert -> - ssl_connection:handle_normal_shutdown(Alert, StateName, State0), - {stop, {shutdown, own_alert}} - end; -handle_info({CloseTag, Socket}, StateName, - #state{socket = Socket, close_tag = CloseTag, - socket_options = #socket_options{active = Active}, - protocol_buffers = #protocol_buffers{tls_cipher_texts = CTs}, - negotiated_version = Version} = State) -> - - %% Note that as of TLS 1.1, - %% failure to properly close a connection no longer requires that a - %% session not be resumed. This is a change from TLS 1.0 to conform - %% with widespread implementation practice. - - case (Active == false) andalso (CTs =/= []) of - false -> - case Version of - {1, N} when N >= 1 -> - ok; - _ -> - %% As invalidate_sessions here causes performance issues, - %% we will conform to the widespread implementation - %% practice and go aginst the spec - %%invalidate_session(Role, Host, Port, Session) - ok - end, - - ssl_connection:handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State), - {stop, {shutdown, transport_closed}}; - true -> - %% Fixes non-delivery of final TLS record in {active, once}. - %% Basically allows the application the opportunity to set {active, once} again - %% and then receive the final message. - next_event(StateName, no_record, State) - end; -handle_info(Msg, StateName, State) -> - ssl_connection:handle_info(Msg, StateName, State). - -handle_common_event(internal, #alert{} = Alert, StateName, - #state{negotiated_version = Version} = State) -> - ssl_connection:handle_own_alert(Alert, Version, StateName, State); - -%%% TLS record protocol level handshake messages -handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, - StateName, #state{protocol_buffers = - #protocol_buffers{tls_handshake_buffer = Buf0} = Buffers, - negotiated_version = Version, - ssl_options = Options} = State0) -> - try - {Packets, Buf} = tls_handshake:get_tls_handshake(Version,Data,Buf0, Options), - State1 = - State0#state{protocol_buffers = - Buffers#protocol_buffers{tls_handshake_buffer = Buf}}, - case Packets of - [] -> - assert_buffer_sanity(Buf, Options), - {Record, State} = next_record(State1), - next_event(StateName, Record, State); - _ -> - Events = tls_handshake_events(Packets), - case StateName of - connection -> - ssl_connection:hibernate_after(StateName, State1, Events); - _ -> - {next_state, StateName, - State1#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events} - end - end - catch throw:#alert{} = Alert -> - ssl_connection:handle_own_alert(Alert, Version, StateName, State0) - end; -%%% TLS record protocol level application data messages -handle_common_event(internal, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName, State) -> - {next_state, StateName, State, [{next_event, internal, {application_data, Data}}]}; -%%% TLS record protocol level change cipher messages -handle_common_event(internal, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = Data}, StateName, State) -> - {next_state, StateName, State, [{next_event, internal, #change_cipher_spec{type = Data}}]}; -%%% TLS record protocol level Alert messages -handle_common_event(internal, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, StateName, - #state{negotiated_version = Version} = State) -> - try decode_alerts(EncAlerts) of - Alerts = [_|_] -> - handle_alerts(Alerts, {next_state, StateName, State}); - [] -> - ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, empty_alert), - Version, StateName, State); - #alert{} = Alert -> - ssl_connection:handle_own_alert(Alert, Version, StateName, State) - catch - _:_ -> - ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, alert_decode_error), - Version, StateName, State) - - end; -%% Ignore unknown TLS record level protocol messages -handle_common_event(internal, #ssl_tls{type = _Unknown}, StateName, State) -> - {next_state, StateName, State}. - -send(Transport, Socket, Data) -> - tls_socket:send(Transport, Socket, Data). +downgrade(Type, Event, State) -> + ssl_connection:?FUNCTION_NAME(Type, Event, State, ?MODULE). -%%-------------------------------------------------------------------- +%-------------------------------------------------------------------- %% gen_statem callbacks %%-------------------------------------------------------------------- +callback_mode() -> + state_functions. + terminate(Reason, StateName, State) -> catch ssl_connection:terminate(Reason, StateName, State). format_status(Type, Data) -> ssl_connection:format_status(Type, Data). -%%-------------------------------------------------------------------- -%% code_change(OldVsn, StateName, State, Extra) -> {ok, StateName, NewState} -%% Description: Convert process state when code is changed -%%-------------------------------------------------------------------- -code_change(_OldVsn, StateName, State0, {Direction, From, To}) -> - State = convert_state(State0, Direction, From, To), - {ok, StateName, State}; code_change(_OldVsn, StateName, State, _) -> {ok, StateName, State}. %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -encode_handshake(Handshake, Version, ConnectionStates0, Hist0, V2HComp) -> - Frag = tls_handshake:encode_handshake(Handshake, Version), - Hist = ssl_handshake:update_handshake_history(Hist0, Frag, V2HComp), - {Encoded, ConnectionStates} = - tls_record:encode_handshake(Frag, Version, ConnectionStates0), - {Encoded, ConnectionStates, Hist}. - -encode_change_cipher(#change_cipher_spec{}, Version, ConnectionStates) -> - tls_record:encode_change_cipher_spec(Version, ConnectionStates). - -decode_alerts(Bin) -> - ssl_alert:decode(Bin). - initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, Tracker}, User, {CbModule, DataTag, CloseTag, ErrorTag}) -> #ssl_options{beast_mitigation = BeastMitigation} = SSLOptions, @@ -584,159 +646,82 @@ next_tls_record(Data, #state{protocol_buffers = #protocol_buffers{tls_record_buf #alert{} = Alert -> Alert end. -next_record(#state{unprocessed_handshake_events = N} = State) when N > 0 -> - {no_record, State#state{unprocessed_handshake_events = N-1}}; - -next_record(#state{protocol_buffers = - #protocol_buffers{tls_packets = [], tls_cipher_texts = [CT | Rest]} - = Buffers, - connection_states = ConnStates0, - ssl_options = #ssl_options{padding_check = Check}} = State) -> - case tls_record:decode_cipher_text(CT, ConnStates0, Check) of - {Plain, ConnStates} -> - {Plain, State#state{protocol_buffers = - Buffers#protocol_buffers{tls_cipher_texts = Rest}, - connection_states = ConnStates}}; - #alert{} = Alert -> - {Alert, State} - end; -next_record(#state{protocol_buffers = #protocol_buffers{tls_packets = [], tls_cipher_texts = []}, - socket = Socket, - transport_cb = Transport} = State) -> - case tls_socket:setopts(Transport, Socket, [{active,once}]) of - ok -> - {no_record, State}; - _ -> - {socket_closed, State} - end; -next_record(State) -> - {no_record, State}. - -next_record_if_active(State = - #state{socket_options = - #socket_options{active = false}}) -> - {no_record ,State}; - -next_record_if_active(State) -> - next_record(State). - -passive_receive(State0 = #state{user_data_buffer = Buffer}, StateName) -> - case Buffer of - <<>> -> - {Record, State} = next_record(State0), - next_event(StateName, Record, State); - _ -> - {Record, State} = ssl_connection:read_application_data(<<>>, State0), - next_event(StateName, Record, State) - end. - -next_event(StateName, Record, State) -> - next_event(StateName, Record, State, []). - -next_event(StateName, socket_closed, State, _) -> - ssl_connection:handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State), - {stop, {shutdown, transport_closed}, State}; -next_event(connection = StateName, no_record, State0, Actions) -> - case next_record_if_active(State0) of - {no_record, State} -> - ssl_connection:hibernate_after(StateName, State, Actions); - {socket_closed, State} -> - next_event(StateName, socket_closed, State, Actions); - {#ssl_tls{} = Record, State} -> - {next_state, StateName, State, [{next_event, internal, {protocol_record, Record}} | Actions]}; - {#alert{} = Alert, State} -> - {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} - end; -next_event(StateName, Record, State, Actions) -> - case Record of - no_record -> - {next_state, StateName, State, Actions}; - #ssl_tls{} = Record -> - {next_state, StateName, State, [{next_event, internal, {protocol_record, Record}} | Actions]}; - #alert{} = Alert -> - {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} - end. tls_handshake_events(Packets) -> lists:map(fun(Packet) -> {next_event, internal, {handshake, Packet}} end, Packets). +%% raw data from socket, upack records +handle_info({Protocol, _, Data}, StateName, + #state{data_tag = Protocol} = State0) -> + case next_tls_record(Data, State0) of + {Record, State} -> + next_event(StateName, Record, State); + #alert{} = Alert -> + ssl_connection:handle_normal_shutdown(Alert, StateName, State0), + ssl_connection:stop({shutdown, own_alert}, State0) + end; +handle_info({CloseTag, Socket}, StateName, + #state{socket = Socket, close_tag = CloseTag, + socket_options = #socket_options{active = Active}, + protocol_buffers = #protocol_buffers{tls_cipher_texts = CTs}, + negotiated_version = Version} = State) -> -renegotiate(#state{role = client} = State, Actions) -> - %% Handle same way as if server requested - %% the renegotiation - Hs0 = ssl_handshake:init_handshake_history(), - {next_state, connection, State#state{tls_handshake_history = Hs0}, - [{next_event, internal, #hello_request{}} | Actions]}; + %% Note that as of TLS 1.1, + %% failure to properly close a connection no longer requires that a + %% session not be resumed. This is a change from TLS 1.0 to conform + %% with widespread implementation practice. -renegotiate(#state{role = server, - socket = Socket, - transport_cb = Transport, - negotiated_version = Version, - connection_states = ConnectionStates0} = State0, Actions) -> - HelloRequest = ssl_handshake:hello_request(), - Frag = tls_handshake:encode_handshake(HelloRequest, Version), - Hs0 = ssl_handshake:init_handshake_history(), - {BinMsg, ConnectionStates} = - tls_record:encode_handshake(Frag, Version, ConnectionStates0), - send(Transport, Socket, BinMsg), - State1 = State0#state{connection_states = - ConnectionStates, - tls_handshake_history = Hs0}, - {Record, State} = next_record(State1), - next_event(hello, Record, State, Actions). + case (Active == false) andalso (CTs =/= []) of + false -> + case Version of + {1, N} when N >= 1 -> + ok; + _ -> + %% As invalidate_sessions here causes performance issues, + %% we will conform to the widespread implementation + %% practice and go aginst the spec + %%invalidate_session(Role, Host, Port, Session) + ok + end, + + ssl_connection:handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State), + ssl_connection:stop({shutdown, transport_closed}, State); + true -> + %% Fixes non-delivery of final TLS record in {active, once}. + %% Basically allows the application the opportunity to set {active, once} again + %% and then receive the final message. + next_event(StateName, no_record, State) + end; +handle_info(Msg, StateName, State) -> + ssl_connection:StateName(info, Msg, State, ?MODULE). handle_alerts([], Result) -> Result; -handle_alerts(_, {stop,_} = Stop) -> +handle_alerts(_, {stop, _, _} = Stop) -> Stop; handle_alerts([Alert | Alerts], {next_state, StateName, State}) -> handle_alerts(Alerts, ssl_connection:handle_alert(Alert, StateName, State)); handle_alerts([Alert | Alerts], {next_state, StateName, State, _Actions}) -> handle_alerts(Alerts, ssl_connection:handle_alert(Alert, StateName, State)). +encode_handshake(Handshake, Version, ConnectionStates0, Hist0, V2HComp) -> + Frag = tls_handshake:encode_handshake(Handshake, Version), + Hist = ssl_handshake:update_handshake_history(Hist0, Frag, V2HComp), + {Encoded, ConnectionStates} = + tls_record:encode_handshake(Frag, Version, ConnectionStates0), + {Encoded, ConnectionStates, Hist}. -%% User closes or recursive call! -close({close, Timeout}, Socket, Transport = gen_tcp, _,_) -> - tls_socket:setopts(Transport, Socket, [{active, false}]), - Transport:shutdown(Socket, write), - _ = Transport:recv(Socket, 0, Timeout), - ok; -%% Peer closed socket -close({shutdown, transport_closed}, Socket, Transport = gen_tcp, ConnectionStates, Check) -> - close({close, 0}, Socket, Transport, ConnectionStates, Check); -%% We generate fatal alert -close({shutdown, own_alert}, Socket, Transport = gen_tcp, ConnectionStates, Check) -> - %% Standard trick to try to make sure all - %% data sent to the tcp port is really delivered to the - %% peer application before tcp port is closed so that the peer will - %% get the correct TLS alert message and not only a transport close. - %% Will return when other side has closed or after timout millisec - %% e.g. we do not want to hang if something goes wrong - %% with the network but we want to maximise the odds that - %% peer application gets all data sent on the tcp connection. - close({close, ?DEFAULT_TIMEOUT}, Socket, Transport, ConnectionStates, Check); -close(downgrade, _,_,_,_) -> - ok; -%% Other -close(_, Socket, Transport, _,_) -> - Transport:close(Socket). - -convert_state(#state{ssl_options = Options} = State, up, "5.3.5", "5.3.6") -> - State#state{ssl_options = convert_options_partial_chain(Options, up)}; -convert_state(#state{ssl_options = Options} = State, down, "5.3.6", "5.3.5") -> - State#state{ssl_options = convert_options_partial_chain(Options, down)}. +encode_change_cipher(#change_cipher_spec{}, Version, ConnectionStates) -> + tls_record:encode_change_cipher_spec(Version, ConnectionStates). -convert_options_partial_chain(Options, up) -> - {Head, Tail} = lists:split(5, tuple_to_list(Options)), - list_to_tuple(Head ++ [{partial_chain, fun(_) -> unknown_ca end}] ++ Tail); -convert_options_partial_chain(Options, down) -> - list_to_tuple(proplists:delete(partial_chain, tuple_to_list(Options))). +decode_alerts(Bin) -> + ssl_alert:decode(Bin). -gen_handshake(GenConnection, StateName, Type, Event, +gen_handshake(StateName, Type, Event, #state{negotiated_version = Version} = State) -> - try GenConnection:StateName(Type, Event, State, ?MODULE) of + try ssl_connection:StateName(Type, Event, State, ?MODULE) of Result -> Result catch diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index b54540393a..d59e817ffb 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -32,13 +32,19 @@ -include("ssl_cipher.hrl"). -include_lib("public_key/include/public_key.hrl"). --export([client_hello/8, hello/4, - get_tls_handshake/4, encode_handshake/2, decode_handshake/4]). +%% Handshake handling +-export([client_hello/8, hello/4]). + +%% Handshake encoding +-export([encode_handshake/2]). + +%% Handshake decodeing +-export([get_tls_handshake/4, decode_handshake/4]). -type tls_handshake() :: #client_hello{} | ssl_handshake:ssl_handshake(). %%==================================================================== -%% Internal application API +%% Handshake handling %%==================================================================== %%-------------------------------------------------------------------- -spec client_hello(host(), inet:port_number(), ssl_record:connection_states(), @@ -54,15 +60,18 @@ client_hello(Host, Port, ConnectionStates, } = SslOpts, Cache, CacheCb, Renegotiation, OwnCert) -> Version = tls_record:highest_protocol_version(Versions), - #{security_parameters := SecParams} = ssl_record:pending_connection_state(ConnectionStates, read), + #{security_parameters := SecParams} = + ssl_record:pending_connection_state(ConnectionStates, read), AvailableCipherSuites = ssl_handshake:available_suites(UserSuites, Version), Extensions = ssl_handshake:client_hello_extensions(Version, AvailableCipherSuites, - SslOpts, ConnectionStates, Renegotiation), + SslOpts, ConnectionStates, + Renegotiation), CipherSuites = case Fallback of true -> - [?TLS_FALLBACK_SCSV | ssl_handshake:cipher_suites(AvailableCipherSuites, Renegotiation)]; + [?TLS_FALLBACK_SCSV | + ssl_handshake:cipher_suites(AvailableCipherSuites, Renegotiation)]; false -> ssl_handshake:cipher_suites(AvailableCipherSuites, Renegotiation) end, @@ -85,8 +94,8 @@ client_hello(Host, Port, ConnectionStates, ssl_record:connection_states(), alpn | npn, binary() | undefined}| {tls_record:tls_version(), {resumed | new, #session{}}, ssl_record:connection_states(), binary() | undefined, - #hello_extensions{}, {ssl_cipher:hash(), ssl_cipher:sign_algo()} | undefined} | - #alert{}. + #hello_extensions{}, {ssl_cipher:hash(), ssl_cipher:sign_algo()} | + undefined} | #alert{}. %% %% Description: Handles a received hello message %%-------------------------------------------------------------------- @@ -99,7 +108,8 @@ hello(#server_hello{server_version = Version, random = Random, case tls_record:is_acceptable_version(Version, SupportedVersions) of true -> handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, - Compression, HelloExt, SslOpt, ConnectionStates0, Renegotiation); + Compression, HelloExt, SslOpt, + ConnectionStates0, Renegotiation); false -> ?ALERT_REC(?FATAL, ?PROTOCOL_VERSION) end; @@ -127,18 +137,29 @@ hello(#client_hello{client_version = ClientVersion, ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, malformed_handshake_data) end. + +%%-------------------------------------------------------------------- +%%% Handshake encodeing +%%-------------------------------------------------------------------- + %%-------------------------------------------------------------------- -spec encode_handshake(tls_handshake(), tls_record:tls_version()) -> iolist(). %% %% Description: Encode a handshake packet -%%--------------------------------------------------------------------x +%%-------------------------------------------------------------------- encode_handshake(Package, Version) -> {MsgType, Bin} = enc_handshake(Package, Version), Len = byte_size(Bin), [MsgType, ?uint24(Len), Bin]. + +%%-------------------------------------------------------------------- +%%% Handshake decodeing +%%-------------------------------------------------------------------- + %%-------------------------------------------------------------------- --spec get_tls_handshake(tls_record:tls_version(), binary(), binary() | iolist(), #ssl_options{}) -> +-spec get_tls_handshake(tls_record:tls_version(), binary(), binary() | iolist(), + #ssl_options{}) -> {[tls_handshake()], binary()}. %% %% Description: Given buffered and new data from ssl_record, collects @@ -153,37 +174,45 @@ get_tls_handshake(Version, Data, Buffer, Options) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -handle_client_hello(Version, #client_hello{session_id = SugesstedId, - cipher_suites = CipherSuites, - compression_methods = Compressions, - random = Random, - extensions = #hello_extensions{elliptic_curves = Curves, - signature_algs = ClientHashSigns} = HelloExt}, +handle_client_hello(Version, + #client_hello{session_id = SugesstedId, + cipher_suites = CipherSuites, + compression_methods = Compressions, + random = Random, + extensions = + #hello_extensions{elliptic_curves = Curves, + signature_algs = ClientHashSigns} + = HelloExt}, #ssl_options{versions = Versions, signature_algs = SupportedHashSigns, eccs = SupportedECCs, honor_ecc_order = ECCOrder} = SslOpts, - {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert, _}, Renegotiation) -> + {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert, _}, + Renegotiation) -> case tls_record:is_acceptable_version(Version, Versions) of true -> AvailableHashSigns = ssl_handshake:available_signature_algs( ClientHashSigns, SupportedHashSigns, Cert, Version), ECCCurve = ssl_handshake:select_curve(Curves, SupportedECCs, ECCOrder), {Type, #session{cipher_suite = CipherSuite} = Session1} - = ssl_handshake:select_session(SugesstedId, CipherSuites, AvailableHashSigns, Compressions, - Port, Session0#session{ecc = ECCCurve}, Version, - SslOpts, Cache, CacheCb, Cert), + = ssl_handshake:select_session(SugesstedId, CipherSuites, + AvailableHashSigns, Compressions, + Port, Session0#session{ecc = ECCCurve}, + Version, SslOpts, Cache, CacheCb, Cert), case CipherSuite of no_suite -> ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_ciphers); _ -> - {KeyExAlg,_,_,_} = ssl_cipher:suite_definition(CipherSuite), - case ssl_handshake:select_hashsign(ClientHashSigns, Cert, KeyExAlg, SupportedHashSigns, Version) of + #{key_exchange := KeyExAlg} = ssl_cipher:suite_definition(CipherSuite), + case ssl_handshake:select_hashsign(ClientHashSigns, Cert, KeyExAlg, + SupportedHashSigns, Version) of #alert{} = Alert -> Alert; HashSign -> - handle_client_hello_extensions(Version, Type, Random, CipherSuites, HelloExt, - SslOpts, Session1, ConnectionStates0, + handle_client_hello_extensions(Version, Type, Random, + CipherSuites, HelloExt, + SslOpts, Session1, + ConnectionStates0, Renegotiation, HashSign) end end; @@ -191,6 +220,59 @@ handle_client_hello(Version, #client_hello{session_id = SugesstedId, ?ALERT_REC(?FATAL, ?PROTOCOL_VERSION) end. +handle_client_hello_extensions(Version, Type, Random, CipherSuites, + HelloExt, SslOpts, Session0, ConnectionStates0, + Renegotiation, HashSign) -> + try ssl_handshake:handle_client_hello_extensions(tls_record, Random, CipherSuites, + HelloExt, Version, SslOpts, + Session0, ConnectionStates0, + Renegotiation) of + #alert{} = Alert -> + Alert; + {Session, ConnectionStates, Protocol, ServerHelloExt} -> + {Version, {Type, Session}, ConnectionStates, Protocol, + ServerHelloExt, HashSign} + catch throw:Alert -> + Alert + end. + + +handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, + Compression, HelloExt, SslOpt, ConnectionStates0, Renegotiation) -> + case ssl_handshake:handle_server_hello_extensions(tls_record, Random, CipherSuite, + Compression, HelloExt, Version, + SslOpt, ConnectionStates0, + Renegotiation) of + #alert{} = Alert -> + Alert; + {ConnectionStates, ProtoExt, Protocol} -> + {Version, SessionId, ConnectionStates, ProtoExt, Protocol} + end. +%%-------------------------------------------------------------------- +enc_handshake(#hello_request{}, _Version) -> + {?HELLO_REQUEST, <<>>}; +enc_handshake(#client_hello{client_version = {Major, Minor}, + random = Random, + session_id = SessionID, + cipher_suites = CipherSuites, + compression_methods = CompMethods, + extensions = HelloExtensions}, _Version) -> + SIDLength = byte_size(SessionID), + BinCompMethods = list_to_binary(CompMethods), + CmLength = byte_size(BinCompMethods), + BinCipherSuites = list_to_binary(CipherSuites), + CsLength = byte_size(BinCipherSuites), + ExtensionsBin = ssl_handshake:encode_hello_extensions(HelloExtensions), + + {?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, + ?BYTE(SIDLength), SessionID/binary, + ?UINT16(CsLength), BinCipherSuites/binary, + ?BYTE(CmLength), BinCompMethods/binary, ExtensionsBin/binary>>}; + +enc_handshake(HandshakeMsg, Version) -> + ssl_handshake:encode_handshake(HandshakeMsg, Version). + +%%-------------------------------------------------------------------- get_tls_handshake_aux(Version, <<?BYTE(Type), ?UINT24(Length), Body:Length/binary,Rest/binary>>, #ssl_options{v2_hello_compatible = V2Hello} = Opts, Acc) -> @@ -219,11 +301,12 @@ decode_handshake(_Version, ?CLIENT_HELLO, Bin, true) -> decode_handshake(_Version, ?CLIENT_HELLO, Bin, false) -> decode_hello(Bin); -decode_handshake(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, - ?BYTE(SID_length), Session_ID:SID_length/binary, - ?UINT16(Cs_length), CipherSuites:Cs_length/binary, - ?BYTE(Cm_length), Comp_methods:Cm_length/binary, - Extensions/binary>>, _) -> +decode_handshake(_Version, ?CLIENT_HELLO, + <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, + ?BYTE(SID_length), Session_ID:SID_length/binary, + ?UINT16(Cs_length), CipherSuites:Cs_length/binary, + ?BYTE(Cm_length), Comp_methods:Cm_length/binary, + Extensions/binary>>, _) -> DecodedExtensions = ssl_handshake:decode_hello_extensions({client, Extensions}), @@ -268,53 +351,3 @@ decode_v2_hello(<<?BYTE(Major), ?BYTE(Minor), compression_methods = [?NULL], extensions = #hello_extensions{} }. - -enc_handshake(#hello_request{}, _Version) -> - {?HELLO_REQUEST, <<>>}; -enc_handshake(#client_hello{client_version = {Major, Minor}, - random = Random, - session_id = SessionID, - cipher_suites = CipherSuites, - compression_methods = CompMethods, - extensions = HelloExtensions}, _Version) -> - SIDLength = byte_size(SessionID), - BinCompMethods = list_to_binary(CompMethods), - CmLength = byte_size(BinCompMethods), - BinCipherSuites = list_to_binary(CipherSuites), - CsLength = byte_size(BinCipherSuites), - ExtensionsBin = ssl_handshake:encode_hello_extensions(HelloExtensions), - - {?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, - ?BYTE(SIDLength), SessionID/binary, - ?UINT16(CsLength), BinCipherSuites/binary, - ?BYTE(CmLength), BinCompMethods/binary, ExtensionsBin/binary>>}; - -enc_handshake(HandshakeMsg, Version) -> - ssl_handshake:encode_handshake(HandshakeMsg, Version). - - -handle_client_hello_extensions(Version, Type, Random, CipherSuites, - HelloExt, SslOpts, Session0, ConnectionStates0, Renegotiation, HashSign) -> - try ssl_handshake:handle_client_hello_extensions(tls_record, Random, CipherSuites, - HelloExt, Version, SslOpts, - Session0, ConnectionStates0, Renegotiation) of - #alert{} = Alert -> - Alert; - {Session, ConnectionStates, Protocol, ServerHelloExt} -> - {Version, {Type, Session}, ConnectionStates, Protocol, ServerHelloExt, HashSign} - catch throw:Alert -> - Alert - end. - - -handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, - Compression, HelloExt, SslOpt, ConnectionStates0, Renegotiation) -> - case ssl_handshake:handle_server_hello_extensions(tls_record, Random, CipherSuite, - Compression, HelloExt, Version, - SslOpt, ConnectionStates0, Renegotiation) of - #alert{} = Alert -> - Alert; - {ConnectionStates, ProtoExt, Protocol} -> - {Version, SessionId, ConnectionStates, ProtoExt, Protocol} - end. - diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl index 4ac6cdc6b5..ab179c1bf0 100644 --- a/lib/ssl/src/tls_record.erl +++ b/lib/ssl/src/tls_record.erl @@ -39,15 +39,15 @@ encode_change_cipher_spec/2, encode_data/3]). -export([encode_plain_text/4]). +%% Decoding +-export([decode_cipher_text/3]). + %% Protocol version handling -export([protocol_version/1, lowest_protocol_version/1, lowest_protocol_version/2, highest_protocol_version/1, highest_protocol_version/2, is_higher/2, supported_protocol_versions/0, is_acceptable_version/1, is_acceptable_version/2, hello_version/2]). -%% Decoding --export([decode_cipher_text/3]). - -export_type([tls_version/0, tls_atom_version/0]). -type tls_version() :: ssl_record:ssl_version(). @@ -56,13 +56,12 @@ -compile(inline). %%==================================================================== -%% Internal application API +%% Handling of incoming data %%==================================================================== %%-------------------------------------------------------------------- -spec init_connection_states(client | server, one_n_minus_one | zero_n | disabled) -> ssl_record:connection_states(). -%% % - % +%% %% Description: Creates a connection_states record with appropriate %% values for the initial SSL connection setup. %%-------------------------------------------------------------------- @@ -87,6 +86,10 @@ get_tls_records(Data, <<>>) -> get_tls_records(Data, Buffer) -> get_tls_records_aux(list_to_binary([Buffer, Data]), []). +%%==================================================================== +%% Encoding +%%==================================================================== + %%-------------------------------------------------------------------- -spec encode_handshake(iolist(), tls_version(), ssl_record:connection_states()) -> {iolist(), ssl_record:connection_states()}. @@ -141,6 +144,74 @@ encode_data(Frag, Version, Data = split_bin(Frag, ?MAX_PLAIN_TEXT_LENGTH, Version, BCA, BeastMitigation), encode_iolist(?APPLICATION_DATA, Data, Version, ConnectionStates). +%%==================================================================== +%% Decoding +%%==================================================================== + +%%-------------------------------------------------------------------- +-spec decode_cipher_text(#ssl_tls{}, ssl_record:connection_states(), boolean()) -> + {#ssl_tls{}, ssl_record:connection_states()}| #alert{}. +%% +%% Description: Decode cipher text +%%-------------------------------------------------------------------- +decode_cipher_text(#ssl_tls{type = Type, version = Version, + fragment = CipherFragment} = CipherText, + #{current_read := + #{compression_state := CompressionS0, + sequence_number := Seq, + cipher_state := CipherS0, + security_parameters := + #security_parameters{ + cipher_type = ?AEAD, + bulk_cipher_algorithm = + BulkCipherAlgo, + compression_algorithm = CompAlg} + } = ReadState0} = ConnnectionStates0, _) -> + AAD = calc_aad(Type, Version, ReadState0), + case ssl_cipher:decipher_aead(BulkCipherAlgo, CipherS0, Seq, AAD, CipherFragment, Version) of + {PlainFragment, CipherS1} -> + {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, + PlainFragment, CompressionS0), + ConnnectionStates = ConnnectionStates0#{ + current_read => ReadState0#{ + cipher_state => CipherS1, + sequence_number => Seq + 1, + compression_state => CompressionS1}}, + {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; + #alert{} = Alert -> + Alert + end; + +decode_cipher_text(#ssl_tls{type = Type, version = Version, + fragment = CipherFragment} = CipherText, + #{current_read := + #{compression_state := CompressionS0, + sequence_number := Seq, + security_parameters := + #security_parameters{compression_algorithm = CompAlg} + } = ReadState0} = ConnnectionStates0, PaddingCheck) -> + case ssl_record:decipher(Version, CipherFragment, ReadState0, PaddingCheck) of + {PlainFragment, Mac, ReadState1} -> + MacHash = ssl_cipher:calc_mac_hash(Type, Version, PlainFragment, ReadState1), + case ssl_record:is_correct_mac(Mac, MacHash) of + true -> + {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, + PlainFragment, CompressionS0), + ConnnectionStates = ConnnectionStates0#{ + current_read => ReadState1#{ + sequence_number => Seq + 1, + compression_state => CompressionS1}}, + {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; + false -> + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) + end; + #alert{} = Alert -> + Alert + end. + +%%==================================================================== +%% Protocol version handling +%%==================================================================== %%-------------------------------------------------------------------- -spec protocol_version(tls_atom_version() | tls_version()) -> @@ -278,11 +349,6 @@ supported_protocol_versions([_|_] = Vsns) -> end end. -%%-------------------------------------------------------------------- -%% -%% Description: ssl version 2 is not acceptable security risks are too big. -%% -%%-------------------------------------------------------------------- -spec is_acceptable_version(tls_version()) -> boolean(). is_acceptable_version({N,_}) when N >= ?LOWEST_MAJOR_SUPPORTED_VERSION -> @@ -302,6 +368,7 @@ hello_version(Version, _) when Version >= {3, 3} -> Version; hello_version(_, Versions) -> lowest_protocol_version(Versions). + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- @@ -376,37 +443,17 @@ get_tls_records_aux(Data, Acc) -> false -> ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE) end. - +%%-------------------------------------------------------------------- encode_plain_text(Type, Version, Data, #{current_write := Write0} = ConnectionStates) -> {CipherFragment, Write1} = do_encode_plain_text(Type, Version, Data, Write0), {CipherText, Write} = encode_tls_cipher_text(Type, Version, CipherFragment, Write1), {CipherText, ConnectionStates#{current_write => Write}}. -lowest_list_protocol_version(Ver, []) -> - Ver; -lowest_list_protocol_version(Ver1, [Ver2 | Rest]) -> - lowest_list_protocol_version(lowest_protocol_version(Ver1, Ver2), Rest). - -highest_list_protocol_version(Ver, []) -> - Ver; -highest_list_protocol_version(Ver1, [Ver2 | Rest]) -> - highest_list_protocol_version(highest_protocol_version(Ver1, Ver2), Rest). - encode_tls_cipher_text(Type, {MajVer, MinVer}, Fragment, #{sequence_number := Seq} = Write) -> Length = erlang:iolist_size(Fragment), {[<<?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer), ?UINT16(Length)>>, Fragment], Write#{sequence_number => Seq +1}}. -highest_protocol_version() -> - highest_protocol_version(supported_protocol_versions()). - -lowest_protocol_version() -> - lowest_protocol_version(supported_protocol_versions()). - -sufficient_tlsv1_2_crypto_support() -> - CryptoSupport = crypto:supports(), - proplists:get_bool(sha256, proplists:get_value(hashs, CryptoSupport)). - encode_iolist(Type, Data, Version, ConnectionStates0) -> {ConnectionStates, EncodedMsg} = lists:foldl(fun(Text, {CS0, Encoded}) -> @@ -415,6 +462,31 @@ encode_iolist(Type, Data, Version, ConnectionStates0) -> {CS1, [Enc | Encoded]} end, {ConnectionStates0, []}, Data), {lists:reverse(EncodedMsg), ConnectionStates}. +%%-------------------------------------------------------------------- +do_encode_plain_text(Type, Version, Data, #{compression_state := CompS0, + security_parameters := + #security_parameters{ + cipher_type = ?AEAD, + compression_algorithm = CompAlg} + } = WriteState0) -> + {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0), + WriteState1 = WriteState0#{compression_state => CompS1}, + AAD = calc_aad(Type, Version, WriteState1), + ssl_record:cipher_aead(Version, Comp, WriteState1, AAD); +do_encode_plain_text(Type, Version, Data, #{compression_state := CompS0, + security_parameters := + #security_parameters{compression_algorithm = CompAlg} + }= WriteState0) -> + {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0), + WriteState1 = WriteState0#{compression_state => CompS1}, + MacHash = ssl_cipher:calc_mac_hash(Type, Version, Comp, WriteState1), + ssl_record:cipher(Version, Comp, WriteState1, MacHash); +do_encode_plain_text(_,_,_,CS) -> + exit({cs, CS}). +%%-------------------------------------------------------------------- +calc_aad(Type, {MajVer, MinVer}, + #{sequence_number := SeqNo}) -> + <<?UINT64(SeqNo), ?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer)>>. %% 1/n-1 splitting countermeasure Rizzo/Duong-Beast, RC4 chiphers are %% not vulnerable to this attack. @@ -440,89 +512,25 @@ do_split_bin(Bin, ChunkSize, Acc) -> _ -> lists:reverse(Acc, [Bin]) end. - %%-------------------------------------------------------------------- --spec decode_cipher_text(#ssl_tls{}, ssl_record:connection_states(), boolean()) -> - {#ssl_tls{}, ssl_record:connection_states()}| #alert{}. -%% -%% Description: Decode cipher text -%%-------------------------------------------------------------------- -decode_cipher_text(#ssl_tls{type = Type, version = Version, - fragment = CipherFragment} = CipherText, - #{current_read := - #{compression_state := CompressionS0, - sequence_number := Seq, - cipher_state := CipherS0, - security_parameters := - #security_parameters{ - cipher_type = ?AEAD, - bulk_cipher_algorithm = - BulkCipherAlgo, - compression_algorithm = CompAlg} - } = ReadState0} = ConnnectionStates0, _) -> - AAD = calc_aad(Type, Version, ReadState0), - case ssl_cipher:decipher_aead(BulkCipherAlgo, CipherS0, Seq, AAD, CipherFragment, Version) of - {PlainFragment, CipherS1} -> - {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, - PlainFragment, CompressionS0), - ConnnectionStates = ConnnectionStates0#{ - current_read => ReadState0#{ - cipher_state => CipherS1, - sequence_number => Seq + 1, - compression_state => CompressionS1}}, - {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; - #alert{} = Alert -> - Alert - end; +lowest_list_protocol_version(Ver, []) -> + Ver; +lowest_list_protocol_version(Ver1, [Ver2 | Rest]) -> + lowest_list_protocol_version(lowest_protocol_version(Ver1, Ver2), Rest). -decode_cipher_text(#ssl_tls{type = Type, version = Version, - fragment = CipherFragment} = CipherText, - #{current_read := - #{compression_state := CompressionS0, - sequence_number := Seq, - security_parameters := - #security_parameters{compression_algorithm = CompAlg} - } = ReadState0} = ConnnectionStates0, PaddingCheck) -> - case ssl_record:decipher(Version, CipherFragment, ReadState0, PaddingCheck) of - {PlainFragment, Mac, ReadState1} -> - MacHash = ssl_cipher:calc_mac_hash(Type, Version, PlainFragment, ReadState1), - case ssl_record:is_correct_mac(Mac, MacHash) of - true -> - {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, - PlainFragment, CompressionS0), - ConnnectionStates = ConnnectionStates0#{ - current_read => ReadState1#{ - sequence_number => Seq + 1, - compression_state => CompressionS1}}, - {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; - false -> - ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) - end; - #alert{} = Alert -> - Alert - end. +highest_list_protocol_version(Ver, []) -> + Ver; +highest_list_protocol_version(Ver1, [Ver2 | Rest]) -> + highest_list_protocol_version(highest_protocol_version(Ver1, Ver2), Rest). + +highest_protocol_version() -> + highest_protocol_version(supported_protocol_versions()). + +lowest_protocol_version() -> + lowest_protocol_version(supported_protocol_versions()). + +sufficient_tlsv1_2_crypto_support() -> + CryptoSupport = crypto:supports(), + proplists:get_bool(sha256, proplists:get_value(hashs, CryptoSupport)). -do_encode_plain_text(Type, Version, Data, #{compression_state := CompS0, - security_parameters := - #security_parameters{ - cipher_type = ?AEAD, - compression_algorithm = CompAlg} - } = WriteState0) -> - {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0), - WriteState1 = WriteState0#{compression_state => CompS1}, - AAD = calc_aad(Type, Version, WriteState1), - ssl_record:cipher_aead(Version, Comp, WriteState1, AAD); -do_encode_plain_text(Type, Version, Data, #{compression_state := CompS0, - security_parameters := - #security_parameters{compression_algorithm = CompAlg} - }= WriteState0) -> - {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0), - WriteState1 = WriteState0#{compression_state => CompS1}, - MacHash = ssl_cipher:calc_mac_hash(Type, Version, Comp, WriteState1), - ssl_record:cipher(Version, Comp, WriteState1, MacHash); -do_encode_plain_text(_,_,_,CS) -> - exit({cs, CS}). -calc_aad(Type, {MajVer, MinVer}, - #{sequence_number := SeqNo}) -> - <<?UINT64(SeqNo), ?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer)>>. diff --git a/lib/ssl/src/tls_socket.erl b/lib/ssl/src/tls_socket.erl index e76d9c100a..453a908401 100644 --- a/lib/ssl/src/tls_socket.erl +++ b/lib/ssl/src/tls_socket.erl @@ -27,7 +27,7 @@ -export([send/3, listen/3, accept/3, socket/5, connect/4, upgrade/3, setopts/3, getopts/3, getstat/3, peername/2, sockname/2, port/2]). -export([split_options/1, get_socket_opts/3]). --export([emulated_options/0, internal_inet_values/0, default_inet_values/0, +-export([emulated_options/0, emulated_options/1, internal_inet_values/0, default_inet_values/0, init/1, start_link/3, terminate/2, inherit_tracker/3, emulated_socket_options/2, get_emulated_opts/1, set_emulated_opts/2, get_all_opts/1, handle_call/3, handle_cast/2, @@ -170,6 +170,9 @@ port(Transport, Socket) -> emulated_options() -> [mode, packet, active, header, packet_size]. +emulated_options(Opts) -> + emulated_options(Opts, internal_inet_values(), default_inet_values()). + internal_inet_values() -> [{packet_size,0}, {packet, 0}, {header, 0}, {active, false}, {mode,binary}]. @@ -328,3 +331,41 @@ emulated_socket_options(InetValues, #socket_options{ packet = proplists:get_value(packet, InetValues, Packet), packet_size = proplists:get_value(packet_size, InetValues, Size) }. + +emulated_options([{mode, Value} = Opt |Opts], Inet, Emulated) -> + validate_inet_option(mode, Value), + emulated_options(Opts, Inet, [Opt | proplists:delete(mode, Emulated)]); +emulated_options([{header, Value} = Opt | Opts], Inet, Emulated) -> + validate_inet_option(header, Value), + emulated_options(Opts, Inet, [Opt | proplists:delete(header, Emulated)]); +emulated_options([{active, Value} = Opt |Opts], Inet, Emulated) -> + validate_inet_option(active, Value), + emulated_options(Opts, Inet, [Opt | proplists:delete(active, Emulated)]); +emulated_options([{packet, Value} = Opt |Opts], Inet, Emulated) -> + validate_inet_option(packet, Value), + emulated_options(Opts, Inet, [Opt | proplists:delete(packet, Emulated)]); +emulated_options([{packet_size, Value} = Opt | Opts], Inet, Emulated) -> + validate_inet_option(packet_size, Value), + emulated_options(Opts, Inet, [Opt | proplists:delete(packet_size, Emulated)]); +emulated_options([Opt|Opts], Inet, Emulated) -> + emulated_options(Opts, [Opt|Inet], Emulated); +emulated_options([], Inet,Emulated) -> + {Inet, Emulated}. + +validate_inet_option(mode, Value) + when Value =/= list, Value =/= binary -> + throw({error, {options, {mode,Value}}}); +validate_inet_option(packet, Value) + when not (is_atom(Value) orelse is_integer(Value)) -> + throw({error, {options, {packet,Value}}}); +validate_inet_option(packet_size, Value) + when not is_integer(Value) -> + throw({error, {options, {packet_size,Value}}}); +validate_inet_option(header, Value) + when not is_integer(Value) -> + throw({error, {options, {header,Value}}}); +validate_inet_option(active, Value) + when Value =/= true, Value =/= false, Value =/= once -> + throw({error, {options, {active,Value}}}); +validate_inet_option(_, _) -> + ok. diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index c7e2f402af..9347b56f39 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -37,6 +37,8 @@ VSN=$(GS_VSN) MODULES = \ ssl_test_lib \ + ssl_bench_test_lib \ + ssl_dist_test_lib \ ssl_alpn_handshake_SUITE \ ssl_basic_SUITE \ ssl_bench_SUITE \ @@ -44,6 +46,8 @@ MODULES = \ ssl_certificate_verify_SUITE\ ssl_crl_SUITE\ ssl_dist_SUITE \ + ssl_dist_bench_SUITE \ + ssl_engine_SUITE\ ssl_handshake_SUITE \ ssl_npn_hello_SUITE \ ssl_npn_handshake_SUITE \ @@ -61,7 +65,8 @@ MODULES = \ ERL_FILES = $(MODULES:%=%.erl) -HRL_FILES = +HRL_FILES = \ + ssl_dist_test_lib.hrl HRL_FILES_SRC = \ ssl_api.hrl\ diff --git a/lib/ssl/test/ssl.spec b/lib/ssl/test/ssl.spec index 0ad94e22bc..17b66aef40 100644 --- a/lib/ssl/test/ssl.spec +++ b/lib/ssl/test/ssl.spec @@ -3,3 +3,6 @@ ssl_bench_SUITE, [setup_sequential, setup_concurrent, payload_simple, use_pem_cache, bypass_pem_cache], "Benchmarks run separately"}. +{skip_suites, "../ssl_test", + [ssl_dist_bench_SUITE], + "Benchmarks run separately"}. diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 9efde4752f..3b4ca40058 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -83,13 +83,14 @@ groups() -> ]. tls_versions_groups ()-> - [{group, renegotiate}, %% Should be in all_versions_groups not fixed for DTLS yet + [ {group, api_tls}, {group, tls_ciphers}, {group, error_handling_tests_tls}]. all_versions_groups ()-> [{group, api}, + {group, renegotiate}, {group, ciphers}, {group, ciphers_ec}, {group, error_handling_tests}]. diff --git a/lib/ssl/test/ssl_bench.spec b/lib/ssl/test/ssl_bench.spec index d2f75b4203..8b746c5ca9 100644 --- a/lib/ssl/test/ssl_bench.spec +++ b/lib/ssl/test/ssl_bench.spec @@ -1 +1 @@ -{suites,"../ssl_test",[ssl_bench_SUITE]}. +{suites,"../ssl_test",[ssl_bench_SUITE, ssl_dist_bench_SUITE]}. diff --git a/lib/ssl/test/ssl_bench_SUITE.erl b/lib/ssl/test/ssl_bench_SUITE.erl index ae2928b1c3..3fe6338d69 100644 --- a/lib/ssl/test/ssl_bench_SUITE.erl +++ b/lib/ssl/test/ssl_bench_SUITE.erl @@ -40,11 +40,11 @@ end_per_group(_GroupName, _Config) -> ok. init_per_suite(Config) -> - try - Server = setup(ssl, node()), - [{server_node, Server}|Config] - catch _:_ -> - {skipped, "Benchmark machines only"} + case node() of + nonode@nohost -> + {skipped, "Node not distributed"}; + _ -> + [{server_node, ssl_bench_test_lib:setup(perf_server)}|Config] end. end_per_suite(_Config) -> @@ -132,10 +132,10 @@ bypass_pem_cache(_Config) -> ssl() -> - test(ssl, ?COUNT, node()). + test(ssl, ?COUNT). -test(Type, Count, Host) -> - Server = setup(Type, Host), +test(Type, Count) -> + Server = ssl_bench_test_lib:setup(perf_server), (do_test(Type, setup_connection, Count * 20, 1, Server)), (do_test(Type, setup_connection, Count, 100, Server)), (do_test(Type, payload, Count*300, 10, Server)), @@ -294,47 +294,6 @@ msg() -> "asdlkjsafsdfoierwlejsdlkfjsdf">>. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -setup(_Type, nonode@nohost) -> - exit(dist_not_enabled); -setup(Type, _This) -> - Host = case os:getenv(?remote_host) of - false -> - {ok, This} = inet:gethostname(), - This; - RemHost -> - RemHost - end, - Node = list_to_atom("perf_server@" ++ Host), - SlaveArgs = case init:get_argument(pa) of - {ok, PaPaths} -> - lists:append([" -pa " ++ P || [P] <- PaPaths]); - _ -> [] - end, - %% io:format("Slave args: ~p~n",[SlaveArgs]), - Prog = - case os:find_executable("erl") of - false -> "erl"; - P -> P - end, - io:format("Prog = ~p~n", [Prog]), - - case net_adm:ping(Node) of - pong -> ok; - pang -> - {ok, Node} = slave:start(Host, perf_server, SlaveArgs, no_link, Prog) - end, - Path = code:get_path(), - true = rpc:call(Node, code, set_path, [Path]), - ok = rpc:call(Node, ?MODULE, setup_server, [Type, node()]), - io:format("Client (~p) using ~s~n",[node(), code:which(ssl)]), - (Node =:= node()) andalso restrict_schedulers(client), - Node. - -setup_server(_Type, ClientNode) -> - (ClientNode =:= node()) andalso restrict_schedulers(server), - io:format("Server (~p) using ~s~n",[node(), code:which(ssl)]), - ok. - ensure_all_started(App, Ack) -> case application:start(App) of @@ -358,13 +317,6 @@ setup_server_init(Type, Tc, Loop, PC) -> unlink(Pid), Res. -restrict_schedulers(Type) -> - %% We expect this to run on 8 core machine - Extra0 = 1, - Extra = if (Type =:= server) -> -Extra0; true -> Extra0 end, - Scheds = erlang:system_info(schedulers), - erlang:system_flag(schedulers_online, (Scheds div 2) + Extra). - tc(Fun, Mod, Line) -> case timer:tc(Fun) of {_,{'EXIT',Reason}} -> diff --git a/lib/ssl/test/ssl_bench_test_lib.erl b/lib/ssl/test/ssl_bench_test_lib.erl new file mode 100644 index 0000000000..e5cbb911bd --- /dev/null +++ b/lib/ssl/test/ssl_bench_test_lib.erl @@ -0,0 +1,75 @@ +%%%------------------------------------------------------------------- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(ssl_bench_test_lib). + +%% API +-export([setup/1]). + +%% Internal exports +-export([setup_server/1]). + +-define(remote_host, "NETMARKS_REMOTE_HOST"). + +setup(Name) -> + Host = case os:getenv(?remote_host) of + false -> + {ok, This} = inet:gethostname(), + This; + RemHost -> + RemHost + end, + Node = list_to_atom(atom_to_list(Name) ++ "@" ++ Host), + SlaveArgs = case init:get_argument(pa) of + {ok, PaPaths} -> + lists:append([" -pa " ++ P || [P] <- PaPaths]); + _ -> [] + end, + %% io:format("Slave args: ~p~n",[SlaveArgs]), + Prog = + case os:find_executable("erl") of + false -> "erl"; + P -> P + end, + io:format("Prog = ~p~n", [Prog]), + + case net_adm:ping(Node) of + pong -> ok; + pang -> + {ok, Node} = + slave:start(Host, Name, SlaveArgs, no_link, Prog) + end, + Path = code:get_path(), + true = rpc:call(Node, code, set_path, [Path]), + ok = rpc:call(Node, ?MODULE, setup_server, [node()]), + io:format("Client (~p) using ~s~n",[node(), code:which(ssl)]), + (Node =:= node()) andalso restrict_schedulers(client), + Node. + +setup_server(ClientNode) -> + (ClientNode =:= node()) andalso restrict_schedulers(server), + io:format("Server (~p) using ~s~n",[node(), code:which(ssl)]), + ok. + +restrict_schedulers(Type) -> + %% We expect this to run on 8 core machine + Extra0 = 1, + Extra = if (Type =:= server) -> -Extra0; true -> Extra0 end, + Scheds = erlang:system_info(schedulers), + erlang:system_flag(schedulers_online, (Scheds div 2) + Extra). diff --git a/lib/ssl/test/ssl_dist_SUITE.erl b/lib/ssl/test/ssl_dist_SUITE.erl index 8740e8c8f0..c822a52d1f 100644 --- a/lib/ssl/test/ssl_dist_SUITE.erl +++ b/lib/ssl/test/ssl_dist_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2016. All Rights Reserved. +%% Copyright Ericsson AB 2007-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -22,6 +22,7 @@ -include_lib("common_test/include/ct.hrl"). -include_lib("public_key/include/public_key.hrl"). +-include("ssl_dist_test_lib.hrl"). %% Note: This directive should only be used in test suites. -compile(export_all). @@ -30,12 +31,12 @@ -define(AWAIT_SSL_NODE_UP_TIMEOUT, 30000). --record(node_handle, - {connection_handler, - socket, - name, - nodename} - ). +-import(ssl_dist_test_lib, + [tstsrvr_format/2, send_to_tstcntrl/1, + apply_on_ssl_node/4, apply_on_ssl_node/2, + stop_ssl_node/1]). +start_ssl_node_name(Name, Args) -> + ssl_dist_test_lib:start_ssl_node(Name, Args). %%-------------------------------------------------------------------- %% Common Test interface functions ----------------------------------- @@ -140,11 +141,14 @@ basic_test(NH1, NH2, _) -> apply_on_ssl_node( NH1, fun () -> - tstsrvr_format("Hi from ~p!~n", [node()]), - send_to_tstcntrl({Ref, self()}), + tstsrvr_format( + "Hi from ~p!~n", [node()]), + send_to_tstcntrl( + {Ref, self()}), receive {From, ping} -> - tstsrvr_format("Received ping ~p!~n", [node()]), + tstsrvr_format( + "Received ping ~p!~n", [node()]), From ! {self(), pong} end end) @@ -154,7 +158,8 @@ basic_test(NH1, NH2, _) -> ok = apply_on_ssl_node( NH2, fun () -> - tstsrvr_format("Hi from ~p!~n", [node()]), + tstsrvr_format( + "Hi from ~p!~n", [node()]), SslPid ! {self(), ping}, receive {SslPid, pong} -> @@ -183,7 +188,8 @@ payload_test(NH1, NH2, _) -> apply_on_ssl_node( NH1, fun () -> - send_to_tstcntrl({Ref, self()}), + send_to_tstcntrl( + {Ref, self()}), receive {From, Msg} -> From ! {self(), Msg} @@ -616,12 +622,6 @@ gen_dist_test(Test, Config) -> %% ssl_node side api %% -tstsrvr_format(Fmt, ArgList) -> - send_to_tstsrvr({format, Fmt, ArgList}). - -send_to_tstcntrl(Message) -> - send_to_tstsrvr({message, Message}). - try_setting_priority(TestFun, Config) -> Prio = 1, case gen_udp:open(0, [{priority,Prio}]) of @@ -653,44 +653,6 @@ inet_ports() -> %% test_server side api %% -apply_on_ssl_node(Node, M, F, A) when is_atom(M), is_atom(F), is_list(A) -> - Ref = make_ref(), - send_to_ssl_node(Node, {apply, self(), Ref, M, F, A}), - receive - {Ref, Result} -> - Result - end. - -apply_on_ssl_node(Node, Fun) when is_function(Fun, 0) -> - Ref = make_ref(), - send_to_ssl_node(Node, {apply, self(), Ref, Fun}), - receive - {Ref, Result} -> - Result - end. - -stop_ssl_node(#node_handle{connection_handler = Handler, - socket = Socket, - name = Name}) -> - ?t:format("Trying to stop ssl node ~s.~n", [Name]), - Mon = erlang:monitor(process, Handler), - unlink(Handler), - case gen_tcp:send(Socket, term_to_binary(stop)) of - ok -> - receive - {'DOWN', Mon, process, Handler, Reason} -> - case Reason of - normal -> - ok; - _ -> - ct:pal("Down ~p ~n", [Reason]) - end - end; - Error -> - erlang:demonitor(Mon, [flush]), - ct:pal("Warning ~p ~n", [Error]) - end. - start_ssl_node(Config) -> start_ssl_node(Config, ""). @@ -698,29 +660,8 @@ start_ssl_node(Config, XArgs) -> Name = mk_node_name(Config), SSL = proplists:get_value(ssl_opts, Config), SSLDistOpts = setup_dist_opts(Config), - start_ssl_node_raw(Name, SSL ++ " " ++ SSLDistOpts ++ XArgs). - -start_ssl_node_raw(Name, Args) -> - {ok, LSock} = gen_tcp:listen(0, - [binary, {packet, 4}, {active, false}]), - {ok, ListenPort} = inet:port(LSock), - CmdLine = mk_node_cmdline(ListenPort, Name, Args), - ?t:format("Attempting to start ssl node ~ts: ~ts~n", [Name, CmdLine]), - case open_port({spawn, CmdLine}, []) of - Port when is_port(Port) -> - unlink(Port), - erlang:port_close(Port), - case await_ssl_node_up(Name, LSock) of - #node_handle{} = NodeHandle -> - ?t:format("Ssl node ~s started.~n", [Name]), - NodeName = list_to_atom(Name ++ "@" ++ host_name()), - NodeHandle#node_handle{nodename = NodeName}; - Error -> - exit({failed_to_start_node, Name, Error}) - end; - Error -> - exit({failed_to_start_node, Name, Error}) - end. + start_ssl_node_name( + Name, SSL ++ " " ++ SSLDistOpts ++ XArgs). cache_crls_on_ssl_nodes(PrivDir, CANames, NHs) -> [begin @@ -739,11 +680,6 @@ cache_crls_on_ssl_nodes(PrivDir, CANames, NHs) -> %% command line creation %% -host_name() -> - [$@ | Host] = lists:dropwhile(fun ($@) -> false; (_) -> true end, - atom_to_list(node())), - Host. - mk_node_name(Config) -> N = erlang:unique_integer([positive]), Case = proplists:get_value(testcase, Config), @@ -753,225 +689,6 @@ mk_node_name(Config) -> ++ "_" ++ integer_to_list(N). -mk_node_cmdline(ListenPort, Name, Args) -> - Static = "-detached -noinput", - Pa = filename:dirname(code:which(?MODULE)), - Prog = case catch init:get_argument(progname) of - {ok,[[P]]} -> P; - _ -> exit(no_progname_argument_found) - end, - NameSw = case net_kernel:longnames() of - false -> "-sname "; - _ -> "-name " - end, - {ok, Pwd} = file:get_cwd(), - "\"" ++ Prog ++ "\" " - ++ Static ++ " " - ++ NameSw ++ " " ++ Name ++ " " - ++ "-pa " ++ Pa ++ " " - ++ "-run application start crypto -run application start public_key " - ++ "-eval 'net_kernel:verbose(1)' " - ++ "-run " ++ atom_to_list(?MODULE) ++ " cnct2tstsrvr " - ++ host_name() ++ " " - ++ integer_to_list(ListenPort) ++ " " - ++ Args ++ " " - ++ "-env ERL_CRASH_DUMP " ++ Pwd ++ "/erl_crash_dump." ++ Name ++ " " - ++ "-kernel error_logger \"{file,\\\"" ++ Pwd ++ "/error_log." ++ Name ++ "\\\"}\" " - ++ "-setcookie " ++ atom_to_list(erlang:get_cookie()). - -%% -%% Connection handler test_server side -%% - -await_ssl_node_up(Name, LSock) -> - case gen_tcp:accept(LSock, ?AWAIT_SSL_NODE_UP_TIMEOUT) of - timeout -> - gen_tcp:close(LSock), - ?t:format("Timeout waiting for ssl node ~s to come up~n", - [Name]), - timeout; - {ok, Socket} -> - gen_tcp:close(LSock), - case gen_tcp:recv(Socket, 0) of - {ok, Bin} -> - check_ssl_node_up(Socket, Name, Bin); - {error, closed} -> - gen_tcp:close(Socket), - exit({lost_connection_with_ssl_node_before_up, Name}) - end; - {error, Error} -> - gen_tcp:close(LSock), - exit({accept_failed, Error}) - end. - -check_ssl_node_up(Socket, Name, Bin) -> - case catch binary_to_term(Bin) of - {'EXIT', _} -> - gen_tcp:close(Socket), - exit({bad_data_received_from_ssl_node, Name, Bin}); - {ssl_node_up, NodeName} -> - case list_to_atom(Name++"@"++host_name()) of - NodeName -> - Parent = self(), - Go = make_ref(), - %% Spawn connection handler on test server side - Pid = spawn_link( - fun () -> - receive Go -> ok end, - tstsrvr_con_loop(Name, Socket, Parent) - end), - ok = gen_tcp:controlling_process(Socket, Pid), - Pid ! Go, - #node_handle{connection_handler = Pid, - socket = Socket, - name = Name}; - _ -> - exit({unexpected_ssl_node_connected, NodeName}) - end; - Msg -> - exit({unexpected_msg_instead_of_ssl_node_up, Name, Msg}) - end. - -send_to_ssl_node(#node_handle{connection_handler = Hndlr}, Term) -> - Hndlr ! {relay_to_ssl_node, term_to_binary(Term)}, - ok. - -tstsrvr_con_loop(Name, Socket, Parent) -> - inet:setopts(Socket,[{active,once}]), - receive - {relay_to_ssl_node, Data} when is_binary(Data) -> - case gen_tcp:send(Socket, Data) of - ok -> - ok; - _Error -> - gen_tcp:close(Socket), - exit({failed_to_relay_data_to_ssl_node, Name, Data}) - end; - {tcp, Socket, Bin} -> - case catch binary_to_term(Bin) of - {'EXIT', _} -> - gen_tcp:close(Socket), - exit({bad_data_received_from_ssl_node, Name, Bin}); - {format, FmtStr, ArgList} -> - ?t:format(FmtStr, ArgList); - {message, Msg} -> - ?t:format("Got message ~p", [Msg]), - Parent ! Msg; - {apply_res, To, Ref, Res} -> - To ! {Ref, Res}; - bye -> - ?t:format("Ssl node ~s stopped.~n", [Name]), - gen_tcp:close(Socket), - exit(normal); - Unknown -> - exit({unexpected_message_from_ssl_node, Name, Unknown}) - end; - {tcp_closed, Socket} -> - gen_tcp:close(Socket), - exit({lost_connection_with_ssl_node, Name}) - end, - tstsrvr_con_loop(Name, Socket, Parent). - -%% -%% Connection handler ssl_node side -%% - -% cnct2tstsrvr() is called via command line arg -run ... -cnct2tstsrvr([Host, Port]) when is_list(Host), is_list(Port) -> - %% Spawn connection handler on ssl node side - ConnHandler - = spawn(fun () -> - case catch gen_tcp:connect(Host, - list_to_integer(Port), - [binary, - {packet, 4}, - {active, false}]) of - {ok, Socket} -> - notify_ssl_node_up(Socket), - ets:new(test_server_info, - [set, - public, - named_table, - {keypos, 1}]), - ets:insert(test_server_info, - {test_server_handler, self()}), - ssl_node_con_loop(Socket); - Error -> - halt("Failed to connect to test server " ++ - lists:flatten(io_lib:format("Host:~p ~n Port:~p~n Error:~p~n", - [Host, Port, Error]))) - end - end), - spawn(fun () -> - Mon = erlang:monitor(process, ConnHandler), - receive - {'DOWN', Mon, process, ConnHandler, Reason} -> - receive after 1000 -> ok end, - halt("test server connection handler terminated: " ++ - lists:flatten(io_lib:format("~p", [Reason]))) - end - end). - -notify_ssl_node_up(Socket) -> - case catch gen_tcp:send(Socket, - term_to_binary({ssl_node_up, node()})) of - ok -> ok; - _ -> halt("Failed to notify test server that I'm up") - end. - -send_to_tstsrvr(Term) -> - case catch ets:lookup_element(test_server_info, test_server_handler, 2) of - Hndlr when is_pid(Hndlr) -> - Hndlr ! {relay_to_test_server, term_to_binary(Term)}, ok; - _ -> - receive after 200 -> ok end, - send_to_tstsrvr(Term) - end. - -ssl_node_con_loop(Socket) -> - inet:setopts(Socket,[{active,once}]), - receive - {relay_to_test_server, Data} when is_binary(Data) -> - case gen_tcp:send(Socket, Data) of - ok -> - ok; - _Error -> - gen_tcp:close(Socket), - halt("Failed to relay data to test server") - end; - {tcp, Socket, Bin} -> - case catch binary_to_term(Bin) of - {'EXIT', _} -> - gen_tcp:close(Socket), - halt("test server sent me bad data"); - {apply, From, Ref, M, F, A} -> - spawn_link( - fun () -> - send_to_tstsrvr({apply_res, - From, - Ref, - (catch apply(M, F, A))}) - end); - {apply, From, Ref, Fun} -> - spawn_link(fun () -> - send_to_tstsrvr({apply_res, - From, - Ref, - (catch Fun())}) - end); - stop -> - gen_tcp:send(Socket, term_to_binary(bye)), - gen_tcp:close(Socket), - init:stop(), - receive after infinity -> ok end; - _Unknown -> - halt("test server sent me an unexpected message") - end; - {tcp_closed, Socket} -> - halt("Lost connection to test server") - end, - ssl_node_con_loop(Socket). - %% %% Setup ssl dist info %% diff --git a/lib/ssl/test/ssl_dist_bench_SUITE.erl b/lib/ssl/test/ssl_dist_bench_SUITE.erl new file mode 100644 index 0000000000..4d27564319 --- /dev/null +++ b/lib/ssl/test/ssl_dist_bench_SUITE.erl @@ -0,0 +1,481 @@ +%%%------------------------------------------------------------------- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(ssl_dist_bench_SUITE). + +-include_lib("common_test/include/ct_event.hrl"). +-include_lib("public_key/include/public_key.hrl"). + +%% CT meta +-export([suite/0, all/0, groups/0, + init_per_suite/1, end_per_suite/1, + init_per_group/2, end_per_group/2, + init_per_testcase/2, end_per_testcase/2]). + +%% Test cases +-export( + [setup/1, + roundtrip/1, + throughput_1024/1, + throughput_4096/1, + throughput_16384/1, + throughput_65536/1, + throughput_262144/1, + throughput_1048576/1]). + +%% Debug +-export([payload/1]). + +%%%------------------------------------------------------------------- + +suite() -> [{ct_hooks, [{ts_install_cth, [{nodenames, 2}]}]}]. + +all() -> [{group, ssl}, {group, plain}]. + +groups() -> + [{ssl, all_groups()}, + {plain, all_groups()}, + %% + {setup, [{repeat, 1}], [setup]}, + {roundtrip, [{repeat, 1}], [roundtrip]}, + {throughput, [{repeat, 1}], + [throughput_1024, + throughput_4096, + throughput_16384, + throughput_65536, + throughput_262144, + throughput_1048576]}]. + +all_groups() -> + [{group, setup}, + {group, roundtrip}, + {group, throughput}]. + +init_per_suite(Config) -> + Digest = sha1, + ECCurve = secp521r1, + TLSVersion = 'tlsv1.2', + TLSCipher = {ecdhe_ecdsa,aes_128_cbc,sha256,sha256}, + %% + Node = node(), + try + Node =/= nonode@nohost orelse + throw({skipped,"Node not distributed"}), + {supported, SSLVersions} = + lists:keyfind(supported, 1, ssl:versions()), + lists:member(TLSVersion, SSLVersions) orelse + throw( + {skipped, + "SSL does not support " ++ term_to_string(TLSVersion)}), + lists:member(ECCurve, ssl:eccs(TLSVersion)) orelse + throw( + {skipped, + "SSL does not support " ++ term_to_string(ECCurve)}), + lists:member(TLSCipher, ssl:cipher_suites()) orelse + throw( + {skipped, + "SSL does not support " ++ term_to_string(TLSCipher)}) + of + _ -> + PrivDir = proplists:get_value(priv_dir, Config), + %% + [_, HostA] = string:split(atom_to_list(Node), "@"), + NodeAName = ?MODULE_STRING ++ "_node_a", + NodeAString = NodeAName ++ "@" ++ HostA, + NodeAConfFile = filename:join(PrivDir, NodeAString ++ ".conf"), + NodeA = list_to_atom(NodeAString), + %% + ServerNode = ssl_bench_test_lib:setup(dist_server), + [_, HostB] = string:split(atom_to_list(ServerNode), "@"), + NodeBName = ?MODULE_STRING ++ "_node_b", + NodeBString = NodeBName ++ "@" ++ HostB, + NodeBConfFile = filename:join(PrivDir, NodeBString ++ ".conf"), + NodeB = list_to_atom(NodeBString), + %% + CertOptions = + [{digest, Digest}, + {key, {namedCurve, ECCurve}}], + RootCert = + public_key:pkix_test_root_cert( + ?MODULE_STRING ++ " ROOT CA", CertOptions), + SSLConf = + [{verify, verify_peer}, + {versions, [TLSVersion]}, + {ciphers, [TLSCipher]}], + %% + write_node_conf( + NodeAConfFile, NodeA, + [{fail_if_no_peer_cert, true} | SSLConf], SSLConf, + CertOptions, RootCert), + write_node_conf( + NodeBConfFile, NodeB, + [{fail_if_no_peer_cert, true} | SSLConf], SSLConf, + CertOptions, RootCert), + %% + [{node_a_name, NodeAName}, + {node_a, NodeA}, + {node_a_dist_args, + "-proto_dist inet_tls " + "-ssl_dist_optfile " ++ NodeAConfFile ++ " "}, + {node_b_name, NodeBName}, + {node_b, NodeB}, + {node_b_dist_args, + "-proto_dist inet_tls " + "-ssl_dist_optfile " ++ NodeBConfFile ++ " "}, + {server_node, ServerNode} + |Config] + catch + throw:Result -> + Result + end. + +end_per_suite(Config) -> + ServerNode = proplists:get_value(server_node, Config), + slave:stop(ServerNode). + +init_per_group(ssl, Config) -> + [{ssl_dist, true}, {ssl_dist_prefix, "SSL"}|Config]; +init_per_group(plain, Config) -> + [{ssl_dist, false}, {ssl_dist_prefix, "Plain"}|Config]; +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, _Config) -> + ok. + +init_per_testcase(_Func, Conf) -> + Conf. + +end_per_testcase(_Func, _Conf) -> + ok. + +-define(COUNT, 400). + +%%%------------------------------------------------------------------- +%%% CommonTest API helpers + +write_node_conf( + ConfFile, Node, ServerConf, ClientConf, CertOptions, RootCert) -> + Conf = + public_key:pkix_test_data( + #{root => RootCert, + peer => + [{extensions, + [#'Extension'{ + extnID = ?'id-ce-subjectAltName', + extnValue = [{dNSName, atom_to_list(Node)}], + critical = false}]} | CertOptions]}), + NodeConf = + [{server, ServerConf ++ Conf}, {client, ClientConf ++ Conf}], + {ok, Fd} = file:open(ConfFile, [write]), + ok = file:change_mode(ConfFile, 8#400), + io:format(Fd, "~p.~n", [NodeConf]), + ok = file:close(Fd). + + +%%%------------------------------------------------------------------- +%%% Test cases + +%%----------------------- +%% Connection setup speed + +setup(Config) -> + run_nodepair_test(fun setup/5, Config). + +setup(A, B, Prefix, HA, HB) -> + Rounds = 10, + [] = ssl_apply(HA, erlang, nodes, []), + [] = ssl_apply(HB, erlang, nodes, []), + {SetupTime, CycleTime} = + ssl_apply(HA, fun () -> setup_runner(A, B, Rounds) end), + [] = ssl_apply(HA, erlang, nodes, []), + [] = ssl_apply(HB, erlang, nodes, []), + SetupSpeed = round((Rounds*1000000*1000) / SetupTime), + CycleSpeed = round((Rounds*1000000*1000) / CycleTime), + _ = report(Prefix++" Setup", SetupSpeed, "setups/1000s"), + report(Prefix++" Setup Cycle", CycleSpeed, "cycles/1000s"). + +%% Runs on node A against rex in node B +setup_runner(A, B, Rounds) -> + StartTime = start_time(), + SetupTime = setup_loop(A, B, 0, Rounds), + {microseconds(SetupTime), microseconds(elapsed_time(StartTime))}. + +setup_loop(_A, _B, T, 0) -> + T; +setup_loop(A, B, T, N) -> + StartTime = start_time(), + [A] = rpc:block_call(B, erlang, nodes, []), + Time = elapsed_time(StartTime), + [B] = erlang:nodes(), + Mref = erlang:monitor(process, {rex,B}), + true = net_kernel:disconnect(B), + receive + {'DOWN',Mref,process,_,_} -> + [] = erlang:nodes(), + setup_loop(A, B, Time + T, N - 1) + end. + + +%%---------------- +%% Roundtrip speed + +roundtrip(Config) -> + run_nodepair_test(fun roundtrip/5, Config). + +roundtrip(A, B, Prefix, HA, HB) -> + Rounds = 40000, + [] = ssl_apply(HA, erlang, nodes, []), + [] = ssl_apply(HB, erlang, nodes, []), + Time = ssl_apply(HA, fun () -> roundtrip_runner(A, B, Rounds) end), + [B] = ssl_apply(HA, erlang, nodes, []), + [A] = ssl_apply(HB, erlang, nodes, []), + Speed = round((Rounds*1000000) / Time), + report(Prefix++" Roundtrip", Speed, "pings/s"). + +%% Runs on node A and spawns a server on node B +roundtrip_runner(A, B, Rounds) -> + ClientPid = self(), + [A] = rpc:call(B, erlang, nodes, []), + ServerPid = + erlang:spawn( + B, + fun () -> roundtrip_server(ClientPid, Rounds) end), + ServerMon = erlang:monitor(process, ServerPid), + microseconds( + roundtrip_client(ServerPid, ServerMon, start_time(), Rounds)). + +roundtrip_server(_Pid, 0) -> + ok; +roundtrip_server(Pid, N) -> + receive + N -> + Pid ! N, + roundtrip_server(Pid, N-1) + end. + +roundtrip_client(_Pid, Mon, StartTime, 0) -> + Time = elapsed_time(StartTime), + receive + {'DOWN', Mon, _, _, normal} -> + Time; + {'DOWN', Mon, _, _, Other} -> + exit(Other) + end; +roundtrip_client(Pid, Mon, StartTime, N) -> + Pid ! N, + receive + N -> + roundtrip_client(Pid, Mon, StartTime, N - 1) + end. + + +%%----------------- +%% Throughput speed + +throughput_1024(Config) -> + run_nodepair_test( + fun (A, B, Prefix, HA, HB) -> + throughput(A, B, Prefix, HA, HB, 100000, 1024) + end, Config). + +throughput_4096(Config) -> + run_nodepair_test( + fun (A, B, Prefix, HA, HB) -> + throughput(A, B, Prefix, HA, HB, 50000, 4096) + end, Config). + +throughput_16384(Config) -> + run_nodepair_test( + fun (A, B, Prefix, HA, HB) -> + throughput(A, B, Prefix, HA, HB, 10000, 16384) + end, Config). + +throughput_65536(Config) -> + run_nodepair_test( + fun (A, B, Prefix, HA, HB) -> + throughput(A, B, Prefix, HA, HB, 2000, 65536) + end, Config). + +throughput_262144(Config) -> + run_nodepair_test( + fun (A, B, Prefix, HA, HB) -> + throughput(A, B, Prefix, HA, HB, 500, 262144) + end, Config). + +throughput_1048576(Config) -> + run_nodepair_test( + fun (A, B, Prefix, HA, HB) -> + throughput(A, B, Prefix, HA, HB, 200, 1048576) + end, Config). + +throughput(A, B, Prefix, HA, HB, Packets, Size) -> + [] = ssl_apply(HA, erlang, nodes, []), + [] = ssl_apply(HB, erlang, nodes, []), + Time = + ssl_apply(HA, fun () -> throughput_runner(A, B, Packets, Size) end), + [B] = ssl_apply(HA, erlang, nodes, []), + [A] = ssl_apply(HB, erlang, nodes, []), + Speed = round((Packets*Size*1000000) / (1024*Time)), + report(Prefix++" Throughput_"++integer_to_list(Size), Speed, "kB/s"). + +%% Runs on node A and spawns a server on node B +throughput_runner(A, B, Rounds, Size) -> + Payload = payload(Size), + ClientPid = self(), + [A] = rpc:call(B, erlang, nodes, []), + ServerPid = + erlang:spawn( + B, + fun () -> throughput_server(ClientPid, Rounds) end), + ServerMon = erlang:monitor(process, ServerPid), + microseconds( + throughput_client( + ServerPid, ServerMon, Payload, start_time(), Rounds)). + +throughput_server(_Pid, 0) -> + ok; +throughput_server(Pid, N) -> + receive + [N|_] -> + throughput_server(Pid, N-1) + end. + +throughput_client(_Pid, Mon, _Payload, StartTime, 0) -> + receive + {'DOWN', Mon, _, _, normal} -> + elapsed_time(StartTime); + {'DOWN', Mon, _, _, Other} -> + exit(Other) + end; +throughput_client(Pid, Mon, Payload, StartTime, N) -> + Pid ! [N|Payload], + throughput_client(Pid, Mon, Payload, StartTime, N - 1). + +%%%------------------------------------------------------------------- +%%% Test cases helpers + +run_nodepair_test(TestFun, Config) -> + A = proplists:get_value(node_a, Config), + B = proplists:get_value(node_b, Config), + Prefix = proplists:get_value(ssl_dist_prefix, Config), + HA = start_ssl_node_a(Config), + HB = start_ssl_node_b(Config), + try TestFun(A, B, Prefix, HA, HB) + after + stop_ssl_node_a(HA), + stop_ssl_node_b(HB, Config), + ok + end. + +ssl_apply(Handle, M, F, Args) -> + case ssl_dist_test_lib:apply_on_ssl_node(Handle, M, F, Args) of + {'EXIT',Reason} -> + error(Reason); + Result -> + Result + end. + +ssl_apply(Handle, Fun) -> + case ssl_dist_test_lib:apply_on_ssl_node(Handle, Fun) of + {'EXIT',Reason} -> + error(Reason); + Result -> + Result + end. + +start_ssl_node_a(Config) -> + Name = proplists:get_value(node_a_name, Config), + Args = get_node_args(node_a_dist_args, Config), + ssl_dist_test_lib:start_ssl_node(Name, Args). + +start_ssl_node_b(Config) -> + Name = proplists:get_value(node_b_name, Config), + Args = get_node_args(node_b_dist_args, Config), + ServerNode = proplists:get_value(server_node, Config), + rpc:call( + ServerNode, ssl_dist_test_lib, start_ssl_node, [Name, Args]). + +stop_ssl_node_a(HA) -> + ssl_dist_test_lib:stop_ssl_node(HA). + +stop_ssl_node_b(HB, Config) -> + ServerNode = proplists:get_value(server_node, Config), + rpc:call(ServerNode, ssl_dist_test_lib, stop_ssl_node, [HB]). + +get_node_args(Tag, Config) -> + case proplists:get_value(ssl_dist, Config) of + true -> + proplists:get_value(Tag, Config); + false -> + "" + end. + + + +payload(Size) -> + iolist_to_binary( + [case Size bsr 8 of + 0 -> + []; + Blocks -> + payload(Blocks, create_binary(256)) + end | create_binary(Size band 255)]). +%% +payload(0, _) -> + []; +payload(Blocks, Block) -> + Half = payload(Blocks bsr 1, Block), + [Half, Half | + if + Blocks band 1 =:= 1 -> + Block; + true -> + [] + end]. + +create_binary(Size) -> + create_binary(Size, <<>>). +%% +create_binary(0, Bin) -> + Bin; +create_binary(Size, Bin) -> + NextSize = Size - 1, + create_binary(NextSize, <<Bin/binary, NextSize>>). + +start_time() -> + erlang:system_time(). + +elapsed_time(StartTime) -> + erlang:system_time() - StartTime. + +microseconds(Time) -> + erlang:convert_time_unit(Time, native, microsecond). + +report(Name, Value, Unit) -> + ct:pal("~s: ~w ~s", [Name, Value, Unit]), + ct_event:notify( + #event{ + name = benchmark_data, + data = [{value, Value}, {suite, "ssl_dist"}, {name, Name}]}), + {comment, term_to_string(Value) ++ " " ++ Unit}. + +term_to_string(Term) -> + unicode:characters_to_list( + io_lib:write(Term, [{encoding, unicode}])). diff --git a/lib/ssl/test/ssl_dist_test_lib.erl b/lib/ssl/test/ssl_dist_test_lib.erl new file mode 100644 index 0000000000..1b9c853fc4 --- /dev/null +++ b/lib/ssl/test/ssl_dist_test_lib.erl @@ -0,0 +1,343 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(ssl_dist_test_lib). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("public_key/include/public_key.hrl"). +-include("ssl_dist_test_lib.hrl"). + +-export([tstsrvr_format/2, send_to_tstcntrl/1]). +-export([apply_on_ssl_node/4, apply_on_ssl_node/2]). +-export([stop_ssl_node/1, start_ssl_node/2]). +%% +-export([cnct2tstsrvr/1]). + +-define(AWAIT_SSL_NODE_UP_TIMEOUT, 30000). + + + +%% ssl_node side api +%% + +tstsrvr_format(Fmt, ArgList) -> + send_to_tstsrvr({format, Fmt, ArgList}). + +send_to_tstcntrl(Message) -> + send_to_tstsrvr({message, Message}). + + +%% +%% test_server side api +%% + +apply_on_ssl_node( + #node_handle{connection_handler = Hndlr} = Node, + M, F, A) when is_atom(M), is_atom(F), is_list(A) -> + Ref = erlang:monitor(process, Hndlr), + apply_on_ssl_node(Node, Ref, {apply, self(), Ref, M, F, A}). + +apply_on_ssl_node( + #node_handle{connection_handler = Hndlr} = Node, + Fun) when is_function(Fun, 0) -> + Ref = erlang:monitor(process, Hndlr), + apply_on_ssl_node(Node, Ref, {apply, self(), Ref, Fun}). + +apply_on_ssl_node(Node, Ref, Msg) -> + send_to_ssl_node(Node, Msg), + receive + {'DOWN', Ref, process, Hndlr, Reason} -> + exit({handler_died, Hndlr, Reason}); + {Ref, Result} -> + Result + end. + +stop_ssl_node(#node_handle{connection_handler = Handler, + socket = Socket, + name = Name}) -> + ?t:format("Trying to stop ssl node ~s.~n", [Name]), + Mon = erlang:monitor(process, Handler), + unlink(Handler), + case gen_tcp:send(Socket, term_to_binary(stop)) of + ok -> + receive + {'DOWN', Mon, process, Handler, Reason} -> + case Reason of + normal -> + ok; + _ -> + ct:pal( + "stop_ssl_node/1 ~s Down ~p ~n", + [Name,Reason]) + end + end; + Error -> + erlang:demonitor(Mon, [flush]), + ct:pal("stop_ssl_node/1 ~s Warning ~p ~n", [Name,Error]) + end. + +start_ssl_node(Name, Args) -> + {ok, LSock} = gen_tcp:listen(0, + [binary, {packet, 4}, {active, false}]), + {ok, ListenPort} = inet:port(LSock), + CmdLine = mk_node_cmdline(ListenPort, Name, Args), + ?t:format("Attempting to start ssl node ~ts: ~ts~n", [Name, CmdLine]), + case open_port({spawn, CmdLine}, []) of + Port when is_port(Port) -> + unlink(Port), + erlang:port_close(Port), + case await_ssl_node_up(Name, LSock) of + #node_handle{} = NodeHandle -> + ?t:format("Ssl node ~s started.~n", [Name]), + NodeName = list_to_atom(Name ++ "@" ++ host_name()), + NodeHandle#node_handle{nodename = NodeName}; + Error -> + exit({failed_to_start_node, Name, Error}) + end; + Error -> + exit({failed_to_start_node, Name, Error}) + end. + +host_name() -> + [_, Host] = string:split(atom_to_list(node()), "@"), + %% [$@ | Host] = lists:dropwhile(fun ($@) -> false; (_) -> true end, + %% atom_to_list(node())), + Host. + +mk_node_cmdline(ListenPort, Name, Args) -> + Static = "-detached -noinput", + Pa = filename:dirname(code:which(?MODULE)), + Prog = case catch init:get_argument(progname) of + {ok,[[P]]} -> P; + _ -> exit(no_progname_argument_found) + end, + NameSw = case net_kernel:longnames() of + false -> "-sname "; + _ -> "-name " + end, + {ok, Pwd} = file:get_cwd(), + "\"" ++ Prog ++ "\" " + ++ Static ++ " " + ++ NameSw ++ " " ++ Name ++ " " + ++ "-pa " ++ Pa ++ " " + ++ "-run application start crypto -run application start public_key " + ++ "-eval 'net_kernel:verbose(1)' " + ++ "-run " ++ atom_to_list(?MODULE) ++ " cnct2tstsrvr " + ++ host_name() ++ " " + ++ integer_to_list(ListenPort) ++ " " + ++ Args ++ " " + ++ "-env ERL_CRASH_DUMP " ++ Pwd ++ "/erl_crash_dump." ++ Name ++ " " + ++ "-kernel error_logger \"{file,\\\"" ++ Pwd ++ "/error_log." ++ Name ++ "\\\"}\" " + ++ "-setcookie " ++ atom_to_list(erlang:get_cookie()). + +%% +%% Connection handler test_server side +%% + +await_ssl_node_up(Name, LSock) -> + case gen_tcp:accept(LSock, ?AWAIT_SSL_NODE_UP_TIMEOUT) of + {ok, Socket} -> + gen_tcp:close(LSock), + case gen_tcp:recv(Socket, 0) of + {ok, Bin} -> + check_ssl_node_up(Socket, Name, Bin); + {error, closed} -> + gen_tcp:close(Socket), + exit({lost_connection_with_ssl_node_before_up, Name}) + end; + {error, Error} -> + gen_tcp:close(LSock), + ?t:format("Accept failed for ssl node ~s: ~p~n", [Name,Error]), + exit({accept_failed, Error}) + end. + +check_ssl_node_up(Socket, Name, Bin) -> + case catch binary_to_term(Bin) of + {'EXIT', _} -> + gen_tcp:close(Socket), + exit({bad_data_received_from_ssl_node, Name, Bin}); + {ssl_node_up, NodeName} -> + case list_to_atom(Name++"@"++host_name()) of + NodeName -> + Parent = self(), + Go = make_ref(), + %% Spawn connection handler on test server side + Pid = spawn_link( + fun () -> + receive Go -> ok end, + process_flag(trap_exit, true), + tstsrvr_con_loop(Name, Socket, Parent) + end), + ok = gen_tcp:controlling_process(Socket, Pid), + Pid ! Go, + #node_handle{connection_handler = Pid, + socket = Socket, + name = Name}; + _ -> + exit({unexpected_ssl_node_connected, NodeName}) + end; + Msg -> + exit({unexpected_msg_instead_of_ssl_node_up, Name, Msg}) + end. + +send_to_ssl_node(#node_handle{connection_handler = Hndlr}, Term) -> + Hndlr ! {relay_to_ssl_node, term_to_binary(Term)}, + ok. + +tstsrvr_con_loop(Name, Socket, Parent) -> + ok = inet:setopts(Socket,[{active,once}]), + receive + {relay_to_ssl_node, Data} when is_binary(Data) -> + case gen_tcp:send(Socket, Data) of + ok -> + ok; + _Error -> + gen_tcp:close(Socket), + exit({failed_to_relay_data_to_ssl_node, Name, Data}) + end; + {tcp, Socket, Bin} -> + try binary_to_term(Bin) of + {format, FmtStr, ArgList} -> + ?t:format(FmtStr, ArgList); + {message, Msg} -> + ?t:format("Got message ~p", [Msg]), + Parent ! Msg; + {apply_res, To, Ref, Res} -> + To ! {Ref, Res}; + bye -> + {error, closed} = gen_tcp:recv(Socket, 0), + ?t:format("Ssl node ~s stopped.~n", [Name]), + gen_tcp:close(Socket), + exit(normal); + Unknown -> + exit({unexpected_message_from_ssl_node, Name, Unknown}) + catch + error : _ -> + gen_tcp:close(Socket), + exit({bad_data_received_from_ssl_node, Name, Bin}) + end; + {tcp_closed, Socket} -> + gen_tcp:close(Socket), + exit({lost_connection_with_ssl_node, Name}); + {'EXIT', Parent, Reason} -> + exit({'EXIT', parent, Reason}); + Unknown -> + exit({unknown, Unknown}) + end, + tstsrvr_con_loop(Name, Socket, Parent). + +%% +%% Connection handler ssl_node side +%% + +% cnct2tstsrvr() is called via command line arg -run ... +cnct2tstsrvr([Host, Port]) when is_list(Host), is_list(Port) -> + %% Spawn connection handler on ssl node side + ConnHandler + = spawn(fun () -> + case catch gen_tcp:connect(Host, + list_to_integer(Port), + [binary, + {packet, 4}, + {active, false}]) of + {ok, Socket} -> + notify_ssl_node_up(Socket), + ets:new(test_server_info, + [set, + public, + named_table, + {keypos, 1}]), + ets:insert(test_server_info, + {test_server_handler, self()}), + ssl_node_con_loop(Socket); + Error -> + halt("Failed to connect to test server " ++ + lists:flatten(io_lib:format("Host:~p ~n Port:~p~n Error:~p~n", + [Host, Port, Error]))) + end + end), + spawn(fun () -> + Mon = erlang:monitor(process, ConnHandler), + receive + {'DOWN', Mon, process, ConnHandler, Reason} -> + receive after 1000 -> ok end, + halt("test server connection handler terminated: " ++ + lists:flatten(io_lib:format("~p", [Reason]))) + end + end). + +notify_ssl_node_up(Socket) -> + case catch gen_tcp:send(Socket, + term_to_binary({ssl_node_up, node()})) of + ok -> ok; + _ -> halt("Failed to notify test server that I'm up") + end. + +send_to_tstsrvr(Term) -> + case catch ets:lookup_element(test_server_info, test_server_handler, 2) of + Hndlr when is_pid(Hndlr) -> + Hndlr ! {relay_to_test_server, term_to_binary(Term)}, ok; + _ -> + receive after 200 -> ok end, + send_to_tstsrvr(Term) + end. + +ssl_node_con_loop(Socket) -> + inet:setopts(Socket,[{active,once}]), + receive + {relay_to_test_server, Data} when is_binary(Data) -> + case gen_tcp:send(Socket, Data) of + ok -> + ok; + _Error -> + gen_tcp:close(Socket), + halt("Failed to relay data to test server") + end; + {tcp, Socket, Bin} -> + case catch binary_to_term(Bin) of + {'EXIT', _} -> + gen_tcp:close(Socket), + halt("test server sent me bad data"); + {apply, From, Ref, M, F, A} -> + spawn_link( + fun () -> + send_to_tstsrvr({apply_res, + From, + Ref, + (catch apply(M, F, A))}) + end); + {apply, From, Ref, Fun} -> + spawn_link(fun () -> + send_to_tstsrvr({apply_res, + From, + Ref, + (catch Fun())}) + end); + stop -> + gen_tcp:send(Socket, term_to_binary(bye)), + init:stop(), + receive after infinity -> ok end; + _Unknown -> + halt("test server sent me an unexpected message") + end; + {tcp_closed, Socket} -> + halt("Lost connection to test server") + end, + ssl_node_con_loop(Socket). diff --git a/lib/ssl/test/ssl_dist_test_lib.hrl b/lib/ssl/test/ssl_dist_test_lib.hrl new file mode 100644 index 0000000000..86b9b37026 --- /dev/null +++ b/lib/ssl/test/ssl_dist_test_lib.hrl @@ -0,0 +1,26 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-record(node_handle, + {connection_handler, + socket, + name, + nodename} + ). diff --git a/lib/ssl/test/ssl_engine_SUITE.erl b/lib/ssl/test/ssl_engine_SUITE.erl new file mode 100644 index 0000000000..bc221d35fd --- /dev/null +++ b/lib/ssl/test/ssl_engine_SUITE.erl @@ -0,0 +1,142 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% +-module(ssl_engine_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 ----------------------------------- +%%-------------------------------------------------------------------- +all() -> + [ + private_key + ]. + +init_per_suite(Config) -> + catch crypto:stop(), + try crypto:start() of + ok -> + ssl_test_lib:clean_start(), + case crypto:get_test_engine() of + {ok, EngineName} -> + try crypto:engine_load(<<"dynamic">>, + [{<<"SO_PATH">>, EngineName}, + <<"LOAD">>], + []) of + {ok, Engine} -> + [{engine, Engine} |Config]; + {error, Reason} -> + ct:pal("Reason ~p", [Reason]), + {skip, "No dynamic engine support"} + catch error:notsup -> + {skip, "No engine support in OpenSSL"} + end; + {error, notexist} -> + {skip, "Test engine not found"} + end + catch _:_ -> + {skip, "Crypto did not start"} + end. + +end_per_suite(Config) -> + Engine = proplists:get_value(engine, Config), + crypto:engine_unload(Engine), + ssl:stop(), + application:stop(crypto). + + +init_per_testcase(_TestCase, Config) -> + ssl:stop(), + ssl:start(), + ssl_test_lib:ct_log_supported_protocol_versions(Config), + ct:timetrap({seconds, 10}), + Config. + +end_per_testcase(_TestCase, Config) -> + Config. + +%%-------------------------------------------------------------------- +%% Test Cases -------------------------------------------------------- +%%-------------------------------------------------------------------- + +private_key(Config) when is_list(Config) -> + ClientFileBase = filename:join([proplists:get_value(priv_dir, Config), "client_engine"]), + ServerFileBase = filename:join([proplists:get_value(priv_dir, Config), "server_engine"]), + #{server_config := ServerConf, + client_config := ClientConf} = GenCertData = + public_key:pkix_test_data(#{server_chain => + #{root => [{key, ssl_test_lib:hardcode_rsa_key(1)}], + intermediates => [[{key, ssl_test_lib:hardcode_rsa_key(2)}]], + peer => [{key, ssl_test_lib:hardcode_rsa_key(3)} + ]}, + client_chain => + #{root => [{key, ssl_test_lib:hardcode_rsa_key(4)}], + intermediates => [[{key, ssl_test_lib:hardcode_rsa_key(5)}]], + peer => [{key, ssl_test_lib:hardcode_rsa_key(6)}]}}), + [{server_config, FileServerConf}, + {client_config, FileClientConf}] = + x509_test:gen_pem_config_files(GenCertData, ClientFileBase, ServerFileBase), + + Engine = proplists:get_value(engine, Config), + + ClientKey = engine_key(FileClientConf), + ServerKey = engine_key(FileServerConf), + + EngineClientConf = [{key, #{algorithm => rsa, + engine => Engine, + key_id => ClientKey}} | proplists:delete(key, ClientConf)], + + EngineServerConf = [{key, #{algorithm => rsa, + engine => Engine, + key_id => ServerKey}} | proplists:delete(key, ServerConf)], + %% Test with engine + test_tls_connection(EngineServerConf, EngineClientConf, Config), + %% Test that sofware fallback is available + test_tls_connection(ServerConf, [{reuse_sessions, false} |ClientConf], Config). + +engine_key(Conf) -> + FileStr = proplists:get_value(keyfile, Conf), + list_to_binary(FileStr). + + +test_tls_connection(ServerConf, ClientConf, Config) -> + {ClientNode, ServerNode, Hostname} = 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} + | ServerConf]}]), + Port = ssl_test_lib:inet_port(Server), + Client = 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} | ClientConf]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). diff --git a/lib/ssl/test/ssl_packet_SUITE.erl b/lib/ssl/test/ssl_packet_SUITE.erl index 408d62ce9c..3261244ace 100644 --- a/lib/ssl/test/ssl_packet_SUITE.erl +++ b/lib/ssl/test/ssl_packet_SUITE.erl @@ -63,8 +63,10 @@ groups() -> {'tlsv1.1', [], socket_packet_tests() ++ protocol_packet_tests()}, {'tlsv1', [], socket_packet_tests() ++ protocol_packet_tests()}, {'sslv3', [], socket_packet_tests() ++ protocol_packet_tests()}, - {'dtlsv1.2', [], protocol_packet_tests()}, - {'dtlsv1', [], protocol_packet_tests()} + %% We will not support any packet types if the transport is + %% not reliable. We might support it for DTLS over SCTP in the future + {'dtlsv1.2', [], [reject_packet_opt]}, + {'dtlsv1', [], [reject_packet_opt]} ]. socket_packet_tests() -> @@ -1924,6 +1926,25 @@ header_decode_two_bytes_one_sent_passive(Config) when is_list(Config) -> ssl_test_lib:close(Client). %%-------------------------------------------------------------------- +reject_packet_opt() -> + [{doc,"Test packet option is rejected for DTLS over udp"}]. + +reject_packet_opt(Config) when is_list(Config) -> + + ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + + {error,{options,{not_supported,{packet,4}}}} = + ssl:listen(9999, [{packet, 4} | ServerOpts]), + {error,{options,{not_supported,{packet_size,1}}}} = + ssl:listen(9999, [{packet_size, 1} | ServerOpts]), + {error,{options,{not_supported,{header,1}}}} = + ssl:listen(9999, [{header, 1} | ServerOpts]), + + client_reject_packet_opt(Config, {packet,4}), + client_reject_packet_opt(Config, {packet_size, 1}), + client_reject_packet_opt(Config, {header, 1}). + +%%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- @@ -2245,3 +2266,23 @@ add_tpkt_header(IOList) when is_list(IOList) -> Binary = list_to_binary(IOList), L = size(Binary) + 4, [3, 0, ((L) bsr 8) band 16#ff, (L) band 16#ff , Binary]. + + +client_reject_packet_opt(Config, PacketOpt) -> + ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, no_result_msg ,[]}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client_error([{node, ServerNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, no_result_msg, []}}, + {options, [PacketOpt | + ClientOpts]}]), + + ssl_test_lib:check_result(Client, {error, {options, {not_supported, PacketOpt}}}). diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 13265debb1..03c3ed9be3 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -1025,48 +1025,54 @@ string_regex_filter(_Str, _Search) -> false. anonymous_suites(Version) -> - Suites = [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:anonymous_suites(Version)], - ssl_cipher:filter_suites(Suites). + [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:anonymous_suites(Version))]. psk_suites(Version) -> - Suites = [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:psk_suites(Version)], - ssl_cipher:filter_suites(Suites). + [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:psk_suites(Version))]. psk_anon_suites(Version) -> - Suites = [Suite || Suite <- psk_suites(Version), is_psk_anon_suite(Suite)], - ssl_cipher:filter_suites(Suites). + [Suite || Suite <- psk_suites(Version), is_psk_anon_suite(Suite)]. srp_suites() -> - Suites = - [{srp_anon, '3des_ede_cbc', sha}, - {srp_rsa, '3des_ede_cbc', sha}, - {srp_anon, aes_128_cbc, sha}, - {srp_rsa, aes_128_cbc, sha}, - {srp_anon, aes_256_cbc, sha}, - {srp_rsa, aes_256_cbc, sha}], - ssl_cipher:filter_suites(Suites). - + [ssl_cipher:erl_suite_definition(Suite) || + Suite <- + ssl_cipher:filter_suites([tuple_to_map(S) || + S <- [{srp_anon,'3des_ede_cbc', sha}, + {srp_rsa, '3des_ede_cbc', sha}, + {srp_anon, aes_128_cbc, sha}, + {srp_rsa, aes_128_cbc, sha}, + {srp_anon, aes_256_cbc, sha}, + {srp_rsa, aes_256_cbc, sha}]])]. srp_anon_suites() -> - Suites = - [{srp_anon, '3des_ede_cbc', sha}, - {srp_anon, aes_128_cbc, sha}, - {srp_anon, aes_256_cbc, sha}], - ssl_cipher:filter_suites(Suites). - + [ssl_cipher:erl_suite_definition(Suite) || + Suite <- + ssl_cipher:filter_suites([tuple_to_map(S) || + S <-[{srp_anon, '3des_ede_cbc', sha}, + {srp_anon, aes_128_cbc, sha}, + {srp_anon, aes_256_cbc, sha}]])]. srp_dss_suites() -> - Suites = - [{srp_dss, '3des_ede_cbc', sha}, - {srp_dss, aes_128_cbc, sha}, - {srp_dss, aes_256_cbc, sha}], - ssl_cipher:filter_suites(Suites). - + [ssl_cipher:erl_suite_definition(Suite) || + Suite <- + ssl_cipher:filter_suites([tuple_to_map(S) || + S <- [{srp_dss, '3des_ede_cbc', sha}, + {srp_dss, aes_128_cbc, sha}, + {srp_dss, aes_256_cbc, sha}]])]. rc4_suites(Version) -> - Suites = [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:rc4_suites(Version)], - ssl_cipher:filter_suites(Suites). + [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:rc4_suites(Version))]. des_suites(Version) -> - Suites = ssl_cipher:des_suites(Version), - ssl_cipher:filter_suites(Suites). + [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:des_suites(Version))]. + +tuple_to_map({Kex, Cipher, Mac}) -> + #{key_exchange => Kex, + cipher => Cipher, + mac => Mac, + prf => default_prf}; +tuple_to_map({Kex, Cipher, Mac, Prf}) -> + #{key_exchange => Kex, + cipher => Cipher, + mac => Mac, + prf => Prf}. pem_to_der(File) -> {ok, PemBin} = file:read_file(File), @@ -1533,10 +1539,14 @@ is_psk_anon_suite({psk, _,_}) -> true; is_psk_anon_suite({dhe_psk,_,_}) -> true; +is_psk_anon_suite({ecdhe_psk,_,_}) -> + true; is_psk_anon_suite({psk, _,_,_}) -> true; is_psk_anon_suite({dhe_psk, _,_,_}) -> true; +is_psk_anon_suite({ecdhe_psk, _,_,_}) -> + true; is_psk_anon_suite(_) -> false. diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 2e1a0b94ea..9118e4b7e3 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -90,9 +90,9 @@ dtls_all_versions_tests() -> erlang_client_openssl_server_dsa_cert, erlang_server_openssl_client_dsa_cert, erlang_server_openssl_client_reuse_session, - %%erlang_client_openssl_server_renegotiate, - %%erlang_client_openssl_server_nowrap_seqnum, - %%erlang_server_openssl_client_nowrap_seqnum, + erlang_client_openssl_server_renegotiate, + erlang_client_openssl_server_nowrap_seqnum, + erlang_server_openssl_client_nowrap_seqnum, erlang_client_openssl_server_no_server_ca_cert, erlang_client_openssl_server_client_cert, erlang_server_openssl_client_client_cert, diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index cf6481d14c..2650399eea 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 8.2.2 +SSL_VSN = 8.2.3 diff --git a/lib/stdlib/doc/src/Makefile b/lib/stdlib/doc/src/Makefile index 26602764a6..af27efa6c1 100644 --- a/lib/stdlib/doc/src/Makefile +++ b/lib/stdlib/doc/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2016. All Rights Reserved. +# Copyright Ericsson AB 1997-2017. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -98,13 +98,15 @@ XML_REF3_FILES = \ sys.xml \ timer.xml \ unicode.xml \ + uri_string.xml \ win32reg.xml \ zip.xml XML_REF6_FILES = stdlib_app.xml -XML_PART_FILES = part.xml part_notes.xml part_notes_history.xml -XML_CHAPTER_FILES = io_protocol.xml unicode_usage.xml notes.xml notes_history.xml assert_hrl.xml +XML_PART_FILES = part.xml +XML_CHAPTER_FILES = introduction.xml io_protocol.xml unicode_usage.xml \ + notes.xml assert_hrl.xml BOOK_FILES = book.xml @@ -131,9 +133,9 @@ SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml) TOP_SPECS_FILE = specs.xml # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += +XML_FLAGS += SPECS_FLAGS = -I../../include -I../../../kernel/include @@ -150,7 +152,7 @@ html: $(HTML_REF_MAN_FILE) man: $(MAN3_FILES) $(MAN6_FILES) -debug opt: +debug opt: clean clean_docs: rm -rf $(HTMLDIR)/* @@ -158,7 +160,7 @@ clean clean_docs: rm -f $(MAN6DIR)/* rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f $(SPECDIR)/* - rm -f errs core *~ + rm -f errs core *~ $(SPECDIR)/specs_erl_id_trans.xml: escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \ @@ -166,7 +168,7 @@ $(SPECDIR)/specs_erl_id_trans.xml: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs diff --git a/lib/stdlib/doc/src/c.xml b/lib/stdlib/doc/src/c.xml index 7666699183..697e1715e7 100644 --- a/lib/stdlib/doc/src/c.xml +++ b/lib/stdlib/doc/src/c.xml @@ -94,6 +94,15 @@ </func> <func> + <name name="erlangrc" arity="1"/> + <fsummary>Load an erlang resource file.</fsummary> + <desc> + <p>Search <c>PathList</c> and load <c>.erlang</c> resource file if + found.</p> + </desc> + </func> + + <func> <name name="flush" arity="0"/> <fsummary>Flush any messages sent to the shell.</fsummary> <desc> diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml index 95af2b77a5..a0ec22c515 100644 --- a/lib/stdlib/doc/src/ets.xml +++ b/lib/stdlib/doc/src/ets.xml @@ -325,7 +325,7 @@ <p><c><anno>Acc0</anno></c> is returned if the table is empty. This function is similar to <seealso marker="lists#foldl/3"><c>lists:foldl/3</c></seealso>. - The table elements are traversed is unspecified order, except for + The table elements are traversed in an unspecified order, except for <c>ordered_set</c> tables, where they are traversed first to last.</p> <p>If <c><anno>Function</anno></c> inserts objects into the table, or another @@ -341,7 +341,7 @@ <p><c><anno>Acc0</anno></c> is returned if the table is empty. This function is similar to <seealso marker="lists#foldr/3"><c>lists:foldr/3</c></seealso>. - The table elements are traversed is unspecified order, except for + The table elements are traversed in an unspecified order, except for <c>ordered_set</c> tables, where they are traversed last to first.</p> <p>If <c><anno>Function</anno></c> inserts objects into the table, or another @@ -1961,7 +1961,7 @@ true</pre> The return value is a list of the new counter values from each update operation in the same order as in the operation list. If an empty list is specified, nothing is updated and an empty list is - returned. If the function fails, no updates is done.</p> + returned. If the function fails, no updates are done.</p> <p>The specified <c><anno>Key</anno></c> is used to identify the object by either <em>matching</em> the key of an object in a <c>set</c> table, or <em>compare equal</em> to the key of an object in an diff --git a/lib/stdlib/doc/src/fascicules.xml b/lib/stdlib/doc/src/fascicules.xml deleted file mode 100644 index 0ded9007e0..0000000000 --- a/lib/stdlib/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - STDLIB User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/stdlib/doc/src/filelib.xml b/lib/stdlib/doc/src/filelib.xml index 80c4acffdb..5e631aac21 100644 --- a/lib/stdlib/doc/src/filelib.xml +++ b/lib/stdlib/doc/src/filelib.xml @@ -45,6 +45,30 @@ <p>For more information about raw filenames, see the <seealso marker="kernel:file"><c>file</c></seealso> module.</p> + + <note> + <p> + Functionality in this module generally assumes valid input and + does not necessarily fail on input that does not use a valid + encoding, but may instead very likely produce invalid output. + </p> + <p> + File operations used to accept filenames containing + null characters (integer value zero). This caused + the name to be truncated and in some cases arguments + to primitive operations to be mixed up. Filenames + containing null characters inside the filename + are now <em>rejected</em> and will cause primitive + file operations to fail. + </p> + </note> + <warning><p> + Currently null characters at the end of the filename + will be accepted by primitive file operations. Such + filenames are however still documented as invalid. The + implementation will also change in the future and + reject such filenames. + </p></warning> </description> <datatypes> @@ -193,6 +217,11 @@ <p>Other characters represent themselves. Only filenames that have exactly the same character in the same position match. Matching is case-sensitive, for example, "a" does not match "A".</p> + <p>Directory separators must always be written as <c>/</c>, even on + Windows.</p> + <p>A character preceded by <c>\</c> loses its special meaning. Note + that <c>\</c> must be written as <c>\\</c> in a string literal. + For example, "\\?*" will match any filename starting with <c>?</c>.</p> <p>Notice that multiple "*" characters are allowed (as in Unix wildcards, but opposed to Windows/DOS wildcards).</p> <p><em>Examples:</em></p> diff --git a/lib/stdlib/doc/src/filename.xml b/lib/stdlib/doc/src/filename.xml index 14fd5ef787..d2608ad542 100644 --- a/lib/stdlib/doc/src/filename.xml +++ b/lib/stdlib/doc/src/filename.xml @@ -46,7 +46,10 @@ filename by removing redundant directory separators, use <seealso marker="#join/1"><c>join/1</c></seealso>.</p> - <p>The module supports raw filenames in the way that if a binary is + <p> + The module supports + <seealso marker="unicode_usage#notes-about-raw-filenames">raw + filenames</seealso> in the way that if a binary is present, or the filename cannot be interpreted according to the return value of <seealso marker="kernel:file#native_name_encoding/0"> <c>file:native_name_encoding/0</c></seealso>, a raw filename is also @@ -56,6 +59,30 @@ (the join operation is performed of course). For more information about raw filenames, see the <seealso marker="kernel:file"><c>file</c></seealso> module.</p> + + <note> + <p> + Functionality in this module generally assumes valid input and + does not necessarily fail on input that does not use a valid + encoding, but may instead very likely produce invalid output. + </p> + <p> + File operations used to accept filenames containing + null characters (integer value zero). This caused + the name to be truncated and in some cases arguments + to primitive operations to be mixed up. Filenames + containing null characters inside the filename + are now <em>rejected</em> and will cause primitive + file operations to fail. + </p> + </note> + <warning><p> + Currently null characters at the end of the filename + will be accepted by primitive file operations. Such + filenames are however still documented as invalid. The + implementation will also change in the future and + reject such filenames. + </p></warning> </description> <datatypes> <datatype> @@ -555,6 +582,7 @@ unsafe</pre> ["a:/","msdev","include"]</pre> </desc> </func> + </funcs> </erlref> diff --git a/lib/stdlib/doc/src/gen_server.xml b/lib/stdlib/doc/src/gen_server.xml index 7d137fc772..da74e793e6 100644 --- a/lib/stdlib/doc/src/gen_server.xml +++ b/lib/stdlib/doc/src/gen_server.xml @@ -60,6 +60,8 @@ gen_server:abcast -----> Module:handle_cast/2 - -----> Module:handle_info/2 +- -----> Module:handle_continue/2 + - -----> Module:terminate/2 - -----> Module:code_change/3</pre> @@ -88,6 +90,13 @@ gen_server:abcast -----> Module:handle_cast/2 implies at least two garbage collections (when hibernating and shortly after waking up) and is not something you want to do between each call to a busy server.</p> + + <p>If the <c>gen_server</c> process needs to perform an action + immediately after initialization or to break the execution of a + callback into multiple steps, it can return <c>{continue,Continue}</c> + in place of the time-out or hibernation value, which will immediately + invoke the <c>handle_continue/2</c> callback.</p> + </description> <funcs> @@ -610,12 +619,15 @@ gen_server:abcast -----> Module:handle_cast/2 <v>State = term()</v> <v>Result = {reply,Reply,NewState} | {reply,Reply,NewState,Timeout}</v> <v> | {reply,Reply,NewState,hibernate}</v> + <v> | {reply,Reply,NewState,{continue,Continue}}</v> <v> | {noreply,NewState} | {noreply,NewState,Timeout}</v> <v> | {noreply,NewState,hibernate}</v> + <v> | {noreply,NewState,{continue,Continue}}</v> <v> | {stop,Reason,Reply,NewState} | {stop,Reason,NewState}</v> <v> Reply = term()</v> <v> NewState = term()</v> <v> Timeout = int()>=0 | infinity</v> + <v> Continue = term()</v> <v> Reason = term()</v> </type> <desc> @@ -673,9 +685,11 @@ gen_server:abcast -----> Module:handle_cast/2 <v>State = term()</v> <v>Result = {noreply,NewState} | {noreply,NewState,Timeout}</v> <v> | {noreply,NewState,hibernate}</v> + <v> | {noreply,NewState,{continue,Continue}}</v> <v> | {stop,Reason,NewState}</v> <v> NewState = term()</v> <v> Timeout = int()>=0 | infinity</v> + <v> Continue = term()</v> <v> Reason = term()</v> </type> <desc> @@ -690,6 +704,41 @@ gen_server:abcast -----> Module:handle_cast/2 </func> <func> + <name>Module:handle_continue(Continue, State) -> Result</name> + <fsummary>Handle a continue instruction.</fsummary> + <type> + <v>Continue = term()</v> + <v>State = term()</v> + <v>Result = {noreply,NewState} | {noreply,NewState,Timeout}</v> + <v> | {noreply,NewState,hibernate}</v> + <v> | {noreply,NewState,{continue,Continue}}</v> + <v> | {stop,Reason,NewState}</v> + <v> NewState = term()</v> + <v> Timeout = int()>=0 | infinity</v> + <v> Continue = term()</v> + <v> Reason = normal | term()</v> + </type> + <desc> + <note> + <p>This callback is optional, so callback modules need to + export it only if they return <c>{continue,Continue}</c> + from another callback. If continue is used and the callback + is not implemented, the process will exit with <c>undef</c> + error.</p> + </note> + <p>This function is called by a <c>gen_server</c> process whenever + a previous callback returns <c>{continue, Continue}</c>. + <c>handle_continue/2</c> is invoked immediately after the previous + callback, which makes it useful for performing work after + initialization or for splitting the work in a callback in + multiple steps, updating the process state along the way.</p> + <p>For a description of the other arguments and possible return values, + see <seealso marker="#Module:handle_call/3"> + <c>Module:handle_call/3</c></seealso>.</p> + </desc> + </func> + + <func> <name>Module:handle_info(Info, State) -> Result</name> <fsummary>Handle an incoming message.</fsummary> <type> @@ -697,6 +746,7 @@ gen_server:abcast -----> Module:handle_cast/2 <v>State = term()</v> <v>Result = {noreply,NewState} | {noreply,NewState,Timeout}</v> <v> | {noreply,NewState,hibernate}</v> + <v> | {noreply,NewState,{continue,Continue}}</v> <v> | {stop,Reason,NewState}</v> <v> NewState = term()</v> <v> Timeout = int()>=0 | infinity</v> @@ -726,7 +776,7 @@ gen_server:abcast -----> Module:handle_cast/2 <type> <v>Args = term()</v> <v>Result = {ok,State} | {ok,State,Timeout} | {ok,State,hibernate}</v> - <v> | {stop,Reason} | ignore</v> + <v> | {ok,State,{continue,Continue}} | {stop,Reason} | ignore</v> <v> State = term()</v> <v> Timeout = int()>=0 | infinity</v> <v> Reason = term()</v> diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml index a7caa71dcb..4a824f073e 100644 --- a/lib/stdlib/doc/src/gen_statem.xml +++ b/lib/stdlib/doc/src/gen_statem.xml @@ -1329,7 +1329,7 @@ handle_event(_, _, State, Data) -> <c><anno>T</anno></c> is the time-out time. <c>{clean_timeout,<anno>T</anno>}</c> works like just <c>T</c> described in the note above - and uses a proxy process for <c>T < infinity</c>, + and uses a proxy process while <c>{dirty_timeout,<anno>T</anno>}</c> bypasses the proxy process which is more lightweight. </p> @@ -1339,8 +1339,12 @@ handle_event(_, _, State, Data) -> with <c>{dirty_timeout,<anno>T</anno>}</c> to avoid that the calling process dies when the call times out, you will have to be prepared to handle - a late reply. - So why not just let the calling process die? + a late reply. Note that there is an odd chance + to get a late reply even with + <c>{dirty_timeout,infinity}</c> or <c>infinity</c> + for example in the event of network problems. + So why not just let the calling process die + by not catching the exception? </p> </note> <p> @@ -1851,7 +1855,7 @@ handle_event(_, _, State, Data) -> </p> <note> <p> - Note that if the <c>gen_statem</c> is started trough + Note that if the <c>gen_statem</c> is started through <seealso marker="proc_lib"><c>proc_lib</c></seealso> and <seealso marker="#enter_loop/4"><c>enter_loop/4-6</c></seealso>, diff --git a/lib/stdlib/doc/src/maps.xml b/lib/stdlib/doc/src/maps.xml index 8c7270816b..987d92989d 100644 --- a/lib/stdlib/doc/src/maps.xml +++ b/lib/stdlib/doc/src/maps.xml @@ -33,16 +33,31 @@ <p>This module contains functions for maps processing.</p> </description> + <datatypes> + <datatype> + <name name="iterator"/> + <desc> + <p>An iterator representing the key value associations in a map.</p> + <p>Created using <seealso marker="#iterator-1"><c>maps:iterator/1</c></seealso>.</p> + <p>Consumed by <seealso marker="#next-1"><c>maps:next/1</c></seealso>, + <seealso marker="#filter-2"><c>maps:filter/2</c></seealso>, + <seealso marker="#fold-3"><c>maps:fold/3</c></seealso> and + <seealso marker="#map-2"><c>maps:map/2</c></seealso>.</p> + </desc> + </datatype> + </datatypes> + <funcs> <func> <name name="filter" arity="2"/> <fsummary>Select pairs that satisfy a predicate.</fsummary> <desc> - <p>Returns a map <c><anno>Map2</anno></c> for which predicate - <c><anno>Pred</anno></c> holds true in <c><anno>Map1</anno></c>.</p> + <p>Returns a map <c><anno>Map</anno></c> for which predicate + <c><anno>Pred</anno></c> holds true in <c><anno>MapOrIter</anno></c>.</p> <p>The call fails with a <c>{badmap,Map}</c> exception if - <c><anno>Map1</anno></c> is not a map, or with <c>badarg</c> if - <c><anno>Pred</anno></c> is not a function of arity 2.</p> + <c><anno>MapOrIter</anno></c> is not a map or valid iterator, + or with <c>badarg</c> if <c><anno>Pred</anno></c> is not a + function of arity 2.</p> <p><em>Example:</em></p> <code type="none"> > M = #{a => 2, b => 3, c=> 4, "a" => 1, "b" => 2, "c" => 4}, @@ -76,12 +91,16 @@ <fsummary></fsummary> <desc> <p>Calls <c>F(K, V, AccIn)</c> for every <c><anno>K</anno></c> to value - <c><anno>V</anno></c> association in <c><anno>Map</anno></c> in + <c><anno>V</anno></c> association in <c><anno>MapOrIter</anno></c> in any order. Function <c>fun F/3</c> must return a new accumulator, which is passed to the next successive call. This function returns the final value of the accumulator. The initial accumulator value <c><anno>Init</anno></c> is returned if the map is empty.</p> + <p>The call fails with a <c>{badmap,Map}</c> exception if + <c><anno>MapOrIter</anno></c> is not a map or valid iterator, + or with <c>badarg</c> if <c><anno>Fun</anno></c> is not a + function of arity 3.</p> <p><em>Example:</em></p> <code type="none"> > Fun = fun(K,V,AccIn) when is_list(K) -> AccIn + V end, @@ -169,6 +188,32 @@ false</code> </func> <func> + <name name="iterator" arity="1"/> + <fsummary>Create a map iterator.</fsummary> + <desc> + <p>Returns a map iterator <c><anno>Iterator</anno></c> that can + be used by <seealso marker="#next-1"><c>maps:next/1</c></seealso> + to traverse the key-value associations in a map. When iterating + over a map, the memory usage is guaranteed to be bounded no matter + the size of the map.</p> + <p>The call fails with a <c>{badmap,Map}</c> exception if + <c><anno>Map</anno></c> is not a map.</p> + <p><em>Example:</em></p> + <code type="none"> +> M = #{ a => 1, b => 2 }. +#{a => 1,b => 2} +> I = maps:iterator(M). +[{a,1},{b,2}] +> {K1, V1, I2} = maps:next(I). +{a,1,[{b,2}]} +> {K2, V2, I3} = maps:next(I2). +{b,2,[]} +> maps:next(I3). +none</code> + </desc> + </func> + + <func> <name name="keys" arity="1"/> <fsummary></fsummary> <desc> @@ -188,12 +233,16 @@ false</code> <name name="map" arity="2"/> <fsummary></fsummary> <desc> - <p>Produces a new map <c><anno>Map2</anno></c> by calling function + <p>Produces a new map <c><anno>Map</anno></c> by calling function <c>fun F(K, V1)</c> for every <c><anno>K</anno></c> to value - <c><anno>V1</anno></c> association in <c><anno>Map1</anno></c> in + <c><anno>V1</anno></c> association in <c><anno>MapOrIter</anno></c> in any order. Function <c>fun F/2</c> must return value <c><anno>V2</anno></c> to be associated with key <c><anno>K</anno></c> - for the new map <c><anno>Map2</anno></c>.</p> + for the new map <c><anno>Map</anno></c>.</p> + <p>The call fails with a <c>{badmap,Map}</c> exception if + <c><anno>MapOrIter</anno></c> is not a map or valid iterator, + or with <c>badarg</c> if <c><anno>Fun</anno></c> is not a + function of arity 2.</p> <p><em>Example:</em></p> <code type="none"> > Fun = fun(K,V1) when is_list(K) -> V1*2 end, @@ -234,6 +283,35 @@ false</code> </func> <func> + <name name="next" arity="1"/> + <fsummary>Get the next key and value from an iterator.</fsummary> + <desc> + <p>Returns the next key-value association in + <c><anno>Iterator</anno></c> and a new iterator for the + remaining associations in the iterator. + </p> + <p> + If there are no more associations in the iterator, + <c>none</c> is returned. + </p> + <p><em>Example:</em></p> + <code type="none"> +> Map = #{a => 1, b => 2, c => 3}. +#{a => 1,b => 2,c => 3} +> Iter = maps:iterator(Map). +[{a,1},{b,2},{c,3}] +> {_, _, Iter1} = maps:next(Iter). +{a,1,[{b,2},{c,3}]} +> {_, _, Iter2} = maps:next(Iter1). +{b,2,[{c,3}]} +> {_, _, Iter3} = maps:next(Iter2). +{c,3,[]} +> maps:next(Iter3). +none</code> + </desc> + </func> + + <func> <name name="put" arity="3"/> <fsummary></fsummary> <desc> diff --git a/lib/stdlib/doc/src/notes.xml b/lib/stdlib/doc/src/notes.xml index d396f1de8f..b61e5b9b9e 100644 --- a/lib/stdlib/doc/src/notes.xml +++ b/lib/stdlib/doc/src/notes.xml @@ -31,6 +31,49 @@ </header> <p>This document describes the changes made to the STDLIB application.</p> +<section><title>STDLIB 3.4.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Make <c>ets:i/1</c> exit cleaner when ^D is input + while browsing a table. Only the old Erlang shell is + affected (<c>erl(1)</c> flag <c>-oldshell</c>). </p> + <p> + Own Id: OTP-14663</p> + </item> + <item> + <p> + Fixed handling of windows UNC paths in module + <c>filename</c>.</p> + <p> + Own Id: OTP-14693</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Improve performance of the new string functionality when + handling ASCII characters.</p> + <p> + Own Id: OTP-14670</p> + </item> + <item> + <p> + Added a clarification to the documentation of + <c>unicode:characters_to_list/2</c>.</p> + <p> + Own Id: OTP-14798</p> + </item> + </list> + </section> + +</section> + <section><title>STDLIB 3.4.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/stdlib/doc/src/part_notes.xml b/lib/stdlib/doc/src/part_notes.xml deleted file mode 100644 index 461de749dd..0000000000 --- a/lib/stdlib/doc/src/part_notes.xml +++ /dev/null @@ -1,39 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2004</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>STDLIB Release Notes</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p>The Standard Erlang Libraries application, <em>STDLIB</em>, - contains modules for manipulating lists, strings and files etc.</p> - <p>For information about older versions, see - <url href="part_notes_history_frame.html">Release Notes History</url>.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/stdlib/doc/src/part_notes_history.xml b/lib/stdlib/doc/src/part_notes_history.xml deleted file mode 100644 index 8fd048a41e..0000000000 --- a/lib/stdlib/doc/src/part_notes_history.xml +++ /dev/null @@ -1,39 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part> - <header> - <copyright> - <year>2006</year> - <year>2016</year> - <holder>Ericsson AB, All Rights Reserved</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>STDLIB Release Notes History</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p>The Standard Erlang Libraries application, <em>STDLIB</em>, - contains modules for manipulating lists, strings and files etc.</p> - </description> - <include file="notes_history"></include> -</part> - diff --git a/lib/stdlib/doc/src/rand.xml b/lib/stdlib/doc/src/rand.xml index 89fb858823..21f680a0ee 100644 --- a/lib/stdlib/doc/src/rand.xml +++ b/lib/stdlib/doc/src/rand.xml @@ -133,8 +133,9 @@ variable <c>rand_seed</c> to remember the current state.</p> <p>If a process calls - <seealso marker="#uniform-0"><c>uniform/0</c></seealso> or - <seealso marker="#uniform-1"><c>uniform/1</c></seealso> without + <seealso marker="#uniform-0"><c>uniform/0</c></seealso>, + <seealso marker="#uniform-1"><c>uniform/1</c></seealso> or + <seealso marker="#uniform_real-0"><c>uniform_real/0</c></seealso> without setting a seed first, <seealso marker="#seed-1"><c>seed/1</c></seealso> is called automatically with the default algorithm and creates a non-constant seed.</p> @@ -168,10 +169,17 @@ R3 = rand:uniform(),</pre> S0 = rand:seed_s(exrop), {R4, S1} = rand:uniform_s(S0),</pre> + <p>Textbook basic form Box-Muller standard normal deviate</p> + + <pre> +R5 = rand:uniform_real(), +R6 = rand:uniform(), +SND0 = math:sqrt(-2 * math:log(R5)) * math:cos(math:pi() * R6)</pre> + <p>Create a standard normal deviate:</p> <pre> -{SND0, S2} = rand:normal_s(S1),</pre> +{SND1, S2} = rand:normal_s(S1),</pre> <p>Create a normal deviate with mean -3 and variance 0.5:</p> @@ -414,7 +422,8 @@ tests. We suggest to use a sign test to extract a random Boolean value.</pre> This function may return exactly <c>0.0</c> which can be fatal for certain applications. If that is undesired you can use <c>(1.0 - rand:uniform())</c> to get the - interval <c>0.0 < <anno>X</anno> =< 1.0</c>. + interval <c>0.0 < <anno>X</anno> =< 1.0</c>, or instead use + <seealso marker="#uniform_real-0"><c>uniform_real/0</c></seealso>. </p> <p> If neither endpoint is desired you can test and re-try @@ -432,6 +441,42 @@ end.</pre> </func> <func> + <name name="uniform_real" arity="0"/> + <fsummary>Return a random float.</fsummary> + <desc><marker id="uniform_real-0"/> + <p> + Returns a random float + uniformly distributed in the value range + <c>DBL_MIN =< <anno>X</anno> < 1.0</c> + and updates the state in the process dictionary. + </p> + <p> + Conceptually, a random real number <c>R</c> is generated + from the interval <c>0 =< R < 1</c> and then the + closest rounded down normalized number + in the IEEE 754 Double precision format + is returned. + </p> + <note> + <p> + The generated numbers from this function has got better + granularity for small numbers than the regular + <seealso marker="#uniform-0"><c>uniform/0</c></seealso> + because all bits in the mantissa are random. + This property, in combination with the fact that exactly zero + is never returned is useful for algoritms doing for example + <c>1.0 / <anno>X</anno></c> or <c>math:log(<anno>X</anno>)</c>. + </p> + </note> + <p> + See + <seealso marker="#uniform_real_s-1"><c>uniform_real_s/1</c></seealso> + for more explanation. + </p> + </desc> + </func> + + <func> <name name="uniform" arity="1"/> <fsummary>Return a random integer.</fsummary> <desc><marker id="uniform-1"/> @@ -460,7 +505,8 @@ end.</pre> This function may return exactly <c>0.0</c> which can be fatal for certain applications. If that is undesired you can use <c>(1.0 - rand:uniform(State))</c> to get the - interval <c>0.0 < <anno>X</anno> =< 1.0</c>. + interval <c>0.0 < <anno>X</anno> =< 1.0</c>, or instead use + <seealso marker="#uniform_real_s-1"><c>uniform_real_s/1</c></seealso>. </p> <p> If neither endpoint is desired you can test and re-try @@ -478,6 +524,68 @@ end.</pre> </func> <func> + <name name="uniform_real_s" arity="1"/> + <fsummary>Return a random float.</fsummary> + <desc> + <p> + Returns, for a specified state, a random float + uniformly distributed in the value range + <c>DBL_MIN =< <anno>X</anno> < 1.0</c> + and updates the state in the process dictionary. + </p> + <p> + Conceptually, a random real number <c>R</c> is generated + from the interval <c>0 =< R < 1</c> and then the + closest rounded down normalized number + in the IEEE 754 Double precision format + is returned. + </p> + <note> + <p> + The generated numbers from this function has got better + granularity for small numbers than the regular + <seealso marker="#uniform_s-1"><c>uniform_s/1</c></seealso> + because all bits in the mantissa are random. + This property, in combination with the fact that exactly zero + is never returned is useful for algoritms doing for example + <c>1.0 / <anno>X</anno></c> or <c>math:log(<anno>X</anno>)</c>. + </p> + </note> + <p> + The concept implicates that the probability to get + exactly zero is extremely low; so low that this function + is in fact guaranteed to never return zero. The smallest + number that it might return is <c>DBL_MIN</c>, which is + 2.0^(-1022). + </p> + <p> + The value range stated at the top of this function + description is technically correct, but + <c>0.0 =< <anno>X</anno> < 1.0</c> + is a better description of the generated numbers' + statistical distribution. Except that exactly 0.0 + is never returned, which is not possible to observe + statistically. + </p> + <p> + For example; for all sub ranges + <c>N*2.0^(-53) =< X < (N+1)*2.0^(-53)</c> + where + <c>0 =< integer(N) < 2.0^53</c> + the probability is the same. + Compare that with the form of the numbers generated by + <seealso marker="#uniform_s-1"><c>uniform_s/1</c></seealso>. + </p> + <p> + Having to generate extra random bits for + small numbers costs a little performance. + This function is about 20% slower than the regular + <seealso marker="#uniform_s-1"><c>uniform_s/1</c></seealso> + </p> + </desc> + </func> + + <func> <name name="uniform_s" arity="2"/> <fsummary>Return a random integer.</fsummary> <desc> diff --git a/lib/stdlib/doc/src/ref_man.xml b/lib/stdlib/doc/src/ref_man.xml index 878a3babc5..68bfddbc71 100644 --- a/lib/stdlib/doc/src/ref_man.xml +++ b/lib/stdlib/doc/src/ref_man.xml @@ -93,6 +93,7 @@ <xi:include href="sys.xml"/> <xi:include href="timer.xml"/> <xi:include href="unicode.xml"/> + <xi:include href="uri_string.xml"/> <xi:include href="win32reg.xml"/> <xi:include href="zip.xml"/> </application> diff --git a/lib/stdlib/doc/src/specs.xml b/lib/stdlib/doc/src/specs.xml index 45b207b13d..d559adf9b6 100644 --- a/lib/stdlib/doc/src/specs.xml +++ b/lib/stdlib/doc/src/specs.xml @@ -60,6 +60,7 @@ <xi:include href="../specs/specs_sys.xml"/> <xi:include href="../specs/specs_timer.xml"/> <xi:include href="../specs/specs_unicode.xml"/> + <xi:include href="../specs/specs_uri_string.xml"/> <xi:include href="../specs/specs_win32reg.xml"/> <xi:include href="../specs/specs_zip.xml"/> </specs> diff --git a/lib/stdlib/doc/src/string.xml b/lib/stdlib/doc/src/string.xml index 9d5edd9ecf..130fc74a28 100644 --- a/lib/stdlib/doc/src/string.xml +++ b/lib/stdlib/doc/src/string.xml @@ -109,10 +109,8 @@ <p>This module has been reworked in Erlang/OTP 20 to handle <seealso marker="unicode#type-chardata"> <c>unicode:chardata()</c></seealso> and operate on grapheme - clusters. The <seealso marker="#oldapi"> <c>old - functions</c></seealso> that only work on Latin-1 lists as input - are still available but should not be - used. They will be deprecated in Erlang/OTP 21. + clusters. The <c>old functions</c> that only work on Latin-1 lists as input + are kept for backwards compatibility reasons but should not be used. </p> </description> @@ -594,7 +592,7 @@ ÖÄÅ</pre> or <c>both</c>, indicates from which direction characters are to be removed. </p> - <p> Default <c><anno>Characters</anno></c> are the set of + <p> Default <c><anno>Characters</anno></c> is the set of nonbreakable whitespace codepoints, defined as Pattern_White_Space in <url href="http://unicode.org/reports/tr31/">Unicode Standard Annex #31</url>. @@ -631,393 +629,5 @@ ÖÄÅ</pre> </func> </funcs> - - <section> - <marker id="oldapi"/> - <title>Obsolete API functions</title> - <p>Here follows the function of the old API. - These functions only work on a list of Latin-1 characters. - </p> - <note><p> - The functions are kept for backward compatibility, but are - not recommended. - They will be deprecated in Erlang/OTP 21. - </p> - <p>Any undocumented functions in <c>string</c> are not to be used.</p> - </note> - </section> - - <funcs> - <func> - <name name="centre" arity="2"/> - <name name="centre" arity="3"/> - <fsummary>Center a string.</fsummary> - <desc> - <p>Returns a string, where <c><anno>String</anno></c> is centered in the - string and surrounded by blanks or <c><anno>Character</anno></c>. - The resulting string has length <c><anno>Number</anno></c>.</p> - <p>This function is <seealso marker="#oldapi">obsolete</seealso>. - Use - <seealso marker="#pad/3"><c>pad/3</c></seealso>. - </p> - </desc> - </func> - - <func> - <name name="chars" arity="2"/> - <name name="chars" arity="3"/> - <fsummary>Return a string consisting of numbers of characters.</fsummary> - <desc> - <p>Returns a string consisting of <c><anno>Number</anno></c> characters - <c><anno>Character</anno></c>. Optionally, the string can end with - string <c><anno>Tail</anno></c>.</p> - <p>This function is <seealso marker="#oldapi">obsolete</seealso>. - Use - <seealso marker="lists#duplicate/2"><c>lists:duplicate/2</c></seealso>.</p> - </desc> - </func> - - <func> - <name name="chr" arity="2"/> - <fsummary>Return the index of the first occurrence of - a character in a string.</fsummary> - <desc> - <p>Returns the index of the first occurrence of - <c><anno>Character</anno></c> in <c><anno>String</anno></c>. Returns - <c>0</c> if <c><anno>Character</anno></c> does not occur.</p> - <p>This function is <seealso marker="#oldapi">obsolete</seealso>. - Use - <seealso marker="#find/2"><c>find/2</c></seealso>.</p> - </desc> - </func> - - <func> - <name name="concat" arity="2"/> - <fsummary>Concatenate two strings.</fsummary> - <desc> - <p>Concatenates <c><anno>String1</anno></c> and - <c><anno>String2</anno></c> to form a new string - <c><anno>String3</anno></c>, which is returned.</p> - <p> - This function is <seealso marker="#oldapi">obsolete</seealso>. - Use <c>[<anno>String1</anno>, <anno>String2</anno>]</c> as - <c>Data</c> argument, and call - <seealso marker="unicode#characters_to_list/2"> - <c>unicode:characters_to_list/2</c></seealso> or - <seealso marker="unicode#characters_to_binary/2"> - <c>unicode:characters_to_binary/2</c></seealso> - to flatten the output. - </p> - </desc> - </func> - - <func> - <name name="copies" arity="2"/> - <fsummary>Copy a string.</fsummary> - <desc> - <p>Returns a string containing <c><anno>String</anno></c> repeated - <c><anno>Number</anno></c> times.</p> - <p>This function is <seealso marker="#oldapi">obsolete</seealso>. - Use - <seealso marker="lists#duplicate/2"><c>lists:duplicate/2</c></seealso>.</p> - </desc> - </func> - - <func> - <name name="cspan" arity="2"/> - <fsummary>Span characters at start of a string.</fsummary> - <desc> - <p>Returns the length of the maximum initial segment of - <c><anno>String</anno></c>, which consists entirely of characters - not from <c><anno>Chars</anno></c>.</p> - <p>This function is <seealso marker="#oldapi">obsolete</seealso>. - Use - <seealso marker="#take/3"><c>take/3</c></seealso>.</p> - <p><em>Example:</em></p> - <code type="none"> -> string:cspan("\t abcdef", " \t"). -0</code> - </desc> - </func> - - <func> - <name name="join" arity="2"/> - <fsummary>Join a list of strings with separator.</fsummary> - <desc> - <p>Returns a string with the elements of <c><anno>StringList</anno></c> - separated by the string in <c><anno>Separator</anno></c>.</p> - <p>This function is <seealso marker="#oldapi">obsolete</seealso>. - Use - <seealso marker="lists#join/2"><c>lists:join/2</c></seealso>.</p> - <p><em>Example:</em></p> - <code type="none"> -> join(["one", "two", "three"], ", "). -"one, two, three"</code> - </desc> - </func> - - <func> - <name name="left" arity="2"/> - <name name="left" arity="3"/> - <fsummary>Adjust left end of a string.</fsummary> - <desc> - <p>Returns <c><anno>String</anno></c> with the length adjusted in - accordance with <c><anno>Number</anno></c>. The left margin is - fixed. If <c>length(<anno>String</anno>)</c> < - <c><anno>Number</anno></c>, then <c><anno>String</anno></c> is padded - with blanks or <c><anno>Character</anno></c>s.</p> - <p>This function is <seealso marker="#oldapi">obsolete</seealso>. - Use - <seealso marker="#pad/2"><c>pad/2</c></seealso> or - <seealso marker="#pad/3"><c>pad/3</c></seealso>.</p> - <p><em>Example:</em></p> - <code type="none"> -> string:left("Hello",10,$.). -"Hello....."</code> - </desc> - </func> - - <func> - <name name="len" arity="1"/> - <fsummary>Return the length of a string.</fsummary> - <desc> - <p>Returns the number of characters in <c><anno>String</anno></c>.</p> - <p>This function is <seealso marker="#oldapi">obsolete</seealso>. - Use - <seealso marker="#length/1"><c>length/1</c></seealso>.</p> - </desc> - </func> - - <func> - <name name="rchr" arity="2"/> - <fsummary>Return the index of the last occurrence of - a character in a string.</fsummary> - <desc> - <p>Returns the index of the last occurrence of - <c><anno>Character</anno></c> in <c><anno>String</anno></c>. Returns - <c>0</c> if <c><anno>Character</anno></c> does not occur.</p> - <p>This function is <seealso marker="#oldapi">obsolete</seealso>. - Use - <seealso marker="#find/3"><c>find/3</c></seealso>.</p> - </desc> - </func> - - <func> - <name name="right" arity="2"/> - <name name="right" arity="3"/> - <fsummary>Adjust right end of a string.</fsummary> - <desc> - <p>Returns <c><anno>String</anno></c> with the length adjusted in - accordance with <c><anno>Number</anno></c>. The right margin is - fixed. If the length of <c>(<anno>String</anno>)</c> < - <c><anno>Number</anno></c>, then <c><anno>String</anno></c> is padded - with blanks or <c><anno>Character</anno></c>s.</p> - <p>This function is <seealso marker="#oldapi">obsolete</seealso>. - Use - <seealso marker="#pad/3"><c>pad/3</c></seealso>.</p> - <p><em>Example:</em></p> - <code type="none"> -> string:right("Hello", 10, $.). -".....Hello"</code> - </desc> - </func> - - <func> - <name name="rstr" arity="2"/> - <fsummary>Find the index of a substring.</fsummary> - <desc> - <p>Returns the position where the last occurrence of - <c><anno>SubString</anno></c> begins in <c><anno>String</anno></c>. - Returns <c>0</c> if <c><anno>SubString</anno></c> - does not exist in <c><anno>String</anno></c>.</p> - <p>This function is <seealso marker="#oldapi">obsolete</seealso>. - Use - <seealso marker="#find/3"><c>find/3</c></seealso>.</p> - <p><em>Example:</em></p> - <code type="none"> -> string:rstr(" Hello Hello World World ", "Hello World"). -8</code> - </desc> - </func> - - <func> - <name name="span" arity="2"/> - <fsummary>Span characters at start of a string.</fsummary> - <desc> - <p>Returns the length of the maximum initial segment of - <c><anno>String</anno></c>, which consists entirely of characters - from <c><anno>Chars</anno></c>.</p> - <p>This function is <seealso marker="#oldapi">obsolete</seealso>. - Use - <seealso marker="#take/2"><c>take/2</c></seealso>.</p> - <p><em>Example:</em></p> - <code type="none"> -> string:span("\t abcdef", " \t"). -5</code> - </desc> - </func> - - <func> - <name name="str" arity="2"/> - <fsummary>Find the index of a substring.</fsummary> - <desc> - <p>Returns the position where the first occurrence of - <c><anno>SubString</anno></c> begins in <c><anno>String</anno></c>. - Returns <c>0</c> if <c><anno>SubString</anno></c> - does not exist in <c><anno>String</anno></c>.</p> - <p>This function is <seealso marker="#oldapi">obsolete</seealso>. - Use - <seealso marker="#find/2"><c>find/2</c></seealso>.</p> - <p><em>Example:</em></p> - <code type="none"> -> string:str(" Hello Hello World World ", "Hello World"). -8</code> - </desc> - </func> - - <func> - <name name="strip" arity="1"/> - <name name="strip" arity="2"/> - <name name="strip" arity="3"/> - <fsummary>Strip leading or trailing characters.</fsummary> - <desc> - <p>Returns a string, where leading or trailing, or both, blanks or a - number of <c><anno>Character</anno></c> have been removed. - <c><anno>Direction</anno></c>, which can be <c>left</c>, <c>right</c>, - or <c>both</c>, indicates from which direction blanks are to be - removed. <c>strip/1</c> is equivalent to - <c>strip(String, both)</c>.</p> - <p>This function is <seealso marker="#oldapi">obsolete</seealso>. - Use - <seealso marker="#trim/3"><c>trim/3</c></seealso>.</p> - <p><em>Example:</em></p> - <code type="none"> -> string:strip("...Hello.....", both, $.). -"Hello"</code> - </desc> - </func> - - <func> - <name name="sub_string" arity="2"/> - <name name="sub_string" arity="3"/> - <fsummary>Extract a substring.</fsummary> - <desc> - <p>Returns a substring of <c><anno>String</anno></c>, starting at - position <c><anno>Start</anno></c> to the end of the string, or to - and including position <c><anno>Stop</anno></c>.</p> - <p>This function is <seealso marker="#oldapi">obsolete</seealso>. - Use - <seealso marker="#slice/3"><c>slice/3</c></seealso>.</p> - <p><em>Example:</em></p> - <code type="none"> -sub_string("Hello World", 4, 8). -"lo Wo"</code> - </desc> - </func> - - <func> - <name name="substr" arity="2"/> - <name name="substr" arity="3"/> - <fsummary>Return a substring of a string.</fsummary> - <desc> - <p>Returns a substring of <c><anno>String</anno></c>, starting at - position <c><anno>Start</anno></c>, and ending at the end of the - string or at length <c><anno>Length</anno></c>.</p> - <p>This function is <seealso marker="#oldapi">obsolete</seealso>. - Use - <seealso marker="#slice/3"><c>slice/3</c></seealso>.</p> - <p><em>Example:</em></p> - <code type="none"> -> substr("Hello World", 4, 5). -"lo Wo"</code> - </desc> - </func> - - <func> - <name name="sub_word" arity="2"/> - <name name="sub_word" arity="3"/> - <fsummary>Extract subword.</fsummary> - <desc> - <p>Returns the word in position <c><anno>Number</anno></c> of - <c><anno>String</anno></c>. Words are separated by blanks or - <c><anno>Character</anno></c>s.</p> - <p>This function is <seealso marker="#oldapi">obsolete</seealso>. - Use - <seealso marker="#nth_lexeme/3"><c>nth_lexeme/3</c></seealso>.</p> - <p><em>Example:</em></p> - <code type="none"> -> string:sub_word(" Hello old boy !",3,$o). -"ld b"</code> - </desc> - </func> - - <func> - <name name="to_lower" arity="1" clause_i="1"/> - <name name="to_lower" arity="1" clause_i="2"/> - <name name="to_upper" arity="1" clause_i="1"/> - <name name="to_upper" arity="1" clause_i="2"/> - <fsummary>Convert case of string (ISO/IEC 8859-1).</fsummary> - <type variable="String" name_i="1"/> - <type variable="Result" name_i="1"/> - <type variable="Char"/> - <type variable="CharResult"/> - <desc> - <p>The specified string or character is case-converted. Notice that - the supported character set is ISO/IEC 8859-1 (also called Latin 1); - all values outside this set are unchanged</p> - <p>This function is <seealso marker="#oldapi">obsolete</seealso> use - <seealso marker="#lowercase/1"><c>lowercase/1</c></seealso>, - <seealso marker="#uppercase/1"><c>uppercase/1</c></seealso>, - <seealso marker="#titlecase/1"><c>titlecase/1</c></seealso> or - <seealso marker="#casefold/1"><c>casefold/1</c></seealso>.</p> - </desc> - </func> - - <func> - <name name="tokens" arity="2"/> - <fsummary>Split string into tokens.</fsummary> - <desc> - <p>Returns a list of tokens in <c><anno>String</anno></c>, separated - by the characters in <c><anno>SeparatorList</anno></c>.</p> - <p><em>Example:</em></p> - <code type="none"> -> tokens("abc defxxghix jkl", "x "). -["abc", "def", "ghi", "jkl"]</code> - <p>Notice that, as shown in this example, two or more - adjacent separator characters in <c><anno>String</anno></c> - are treated as one. That is, there are no empty - strings in the resulting list of tokens.</p> - <p>This function is <seealso marker="#oldapi">obsolete</seealso>. - Use - <seealso marker="#lexemes/2"><c>lexemes/2</c></seealso>.</p> - </desc> - </func> - - <func> - <name name="words" arity="1"/> - <name name="words" arity="2"/> - <fsummary>Count blank separated words.</fsummary> - <desc> - <p>Returns the number of words in <c><anno>String</anno></c>, separated - by blanks or <c><anno>Character</anno></c>.</p> - <p>This function is <seealso marker="#oldapi">obsolete</seealso>. - Use - <seealso marker="#lexemes/2"><c>lexemes/2</c></seealso>.</p> - <p><em>Example:</em></p> - <code type="none"> -> words(" Hello old boy!", $o). -4</code> - </desc> - </func> - </funcs> - - <section> - <title>Notes</title> - <p>Some of the general string functions can seem to overlap each - other. The reason is that this string package is the - combination of two earlier packages and all functions of - both packages have been retained.</p> - </section> - </erlref> diff --git a/lib/stdlib/doc/src/unicode.xml b/lib/stdlib/doc/src/unicode.xml index e86f45431f..d822aca89c 100644 --- a/lib/stdlib/doc/src/unicode.xml +++ b/lib/stdlib/doc/src/unicode.xml @@ -239,8 +239,13 @@ <c><anno>InEncoding</anno></c>.</p> </item> </list> - <p>Only when <c><anno>InEncoding</anno></c> is one of the UTF - encodings, integers in the list are allowed to be > 255.</p> + <p> + Note that integers in the list always represent code points + regardless of <c><anno>InEncoding</anno></c> passed. If + <c><anno>InEncoding</anno> latin1</c> is passed, only code + points < 256 are allowed; otherwise, all valid unicode code + points are allowed. + </p> <p>If <c><anno>InEncoding</anno></c> is <c>latin1</c>, parameter <c><anno>Data</anno></c> corresponds to the <c>iodata()</c> type, but for <c>unicode</c>, parameter <c><anno>Data</anno></c> can diff --git a/lib/stdlib/doc/src/unicode_usage.xml b/lib/stdlib/doc/src/unicode_usage.xml index 26dc46719e..789e063c12 100644 --- a/lib/stdlib/doc/src/unicode_usage.xml +++ b/lib/stdlib/doc/src/unicode_usage.xml @@ -719,8 +719,8 @@ Eshell V5.10.1 (abort with ^G) </section> <section> - <title>Unicode Filenames</title> <marker id="unicode_file_names"/> + <title>Unicode Filenames</title> <p>Most modern operating systems support Unicode filenames in some way. There are many different ways to do this and Erlang by default treats the different approaches differently:</p> @@ -855,8 +855,12 @@ Eshell V5.10.1 (abort with ^G) </note> <section> - <title>Notes About Raw Filenames</title> <marker id="notes-about-raw-filenames"/> + <title>Notes About Raw Filenames</title> + <note><p> + Note that raw filenames <em>not</em> necessarily are encoded the + same way as on the OS level. + </p></note> <p>Raw filenames were introduced together with Unicode filename support in ERTS 5.8.2 (Erlang/OTP R14B01). The reason "raw filenames" were introduced in the system was diff --git a/lib/stdlib/doc/src/uri_string.xml b/lib/stdlib/doc/src/uri_string.xml new file mode 100644 index 0000000000..21f470e763 --- /dev/null +++ b/lib/stdlib/doc/src/uri_string.xml @@ -0,0 +1,326 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>2017</year><year>2017</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + </legalnotice> + + <title>uri_string</title> + <prepared>Péter Dimitrov</prepared> + <docno>1</docno> + <date>2017-10-24</date> + <rev>A</rev> + </header> + <module>uri_string</module> + <modulesummary>URI processing functions.</modulesummary> + <description> + <p>This module contains functions for parsing and handling URIs + (<url href="https://www.ietf.org/rfc/rfc3986.txt">RFC 3986</url>) and + form-urlencoded query strings (<url href="https://www.w3.org/TR/html5/forms.html">HTML5</url>). + </p> + <p>A URI is an identifier consisting of a sequence of characters matching the syntax + rule named <em>URI</em> in <url href="https://www.ietf.org/rfc/rfc3986.txt">RFC 3986</url>. + </p> + <p> The generic URI syntax consists of a hierarchical sequence of components referred + to as the scheme, authority, path, query, and fragment:</p> + <pre> + URI = scheme ":" hier-part [ "?" query ] [ "#" fragment ] + hier-part = "//" authority path-abempty + / path-absolute + / path-rootless + / path-empty + scheme = ALPHA *( ALPHA / DIGIT / "+" / "-" / "." ) + authority = [ userinfo "@" ] host [ ":" port ] + userinfo = *( unreserved / pct-encoded / sub-delims / ":" ) + + reserved = gen-delims / sub-delims + gen-delims = ":" / "/" / "?" / "#" / "[" / "]" / "@" + sub-delims = "!" / "$" / "&" / "'" / "(" / ")" + / "*" / "+" / "," / ";" / "=" + + unreserved = ALPHA / DIGIT / "-" / "." / "_" / "~" + </pre><br></br> + <p>The interpretation of a URI depends only on the characters used and not on how those + characters are represented in a network protocol.</p> + <p>The functions implemented by this module cover the following use cases:</p> + <list type="bulleted"> + <item>Parsing URIs into its components and returing a map<br></br> + <seealso marker="#parse/1"><c>parse/1</c></seealso> + </item> + <item>Recomposing a map of URI components into a URI string<br></br> + <seealso marker="#recompose/1"><c>recompose/1</c></seealso> + </item> + <item>Changing inbound binary and percent-encoding of URIs<br></br> + <seealso marker="#transcode/2"><c>transcode/2</c></seealso> + </item> + <item>Transforming URIs into a normalized form<br></br> + <seealso marker="#normalize/1"><c>normalize/1</c></seealso> + </item> + <item>Composing form-urlencoded query strings from a list of key-value pairs<br></br> + <seealso marker="#compose_query/1"><c>compose_query/1</c></seealso><br></br> + <seealso marker="#compose_query/2"><c>compose_query/2</c></seealso> + </item> + <item>Dissecting form-urlencoded query strings into a list of key-value pairs<br></br> + <seealso marker="#dissect_query/1"><c>dissect_query/1</c></seealso> + </item> + </list> + <p>There are four different encodings present during the handling of URIs:</p> + <list type="bulleted"> + <item>Inbound binary encoding in binaries</item> + <item>Inbound percent-encoding in lists and binaries</item> + <item>Outbound binary encoding in binaries</item> + <item>Outbound percent-encoding in lists and binaries</item> + </list> + <p>Functions with <c>uri_string()</c> argument accept lists, binaries and + mixed lists (lists with binary elements) as input type. All of the functions but + <c>transcode/2</c> expects input as lists of unicode codepoints, UTF-8 encoded binaries + and UTF-8 percent-encoded URI parts ("%C3%B6" corresponds to the unicode character "ö").</p> + <p>Unless otherwise specified the return value type and encoding are the same as the input + type and encoding. That is, binary input returns binary output, list input returns a list + output but mixed input returns list output.</p> + <p>In case of lists there is only percent-encoding. In binaries, however, both binary encoding + and percent-encoding shall be considered. <c>transcode/2</c> provides the means to convert + between the supported encodings, it takes a <c>uri_string()</c> and a list of options + specifying inbound and outbound encodings.</p> + <p><url href="https://www.ietf.org/rfc/rfc3986.txt">RFC 3986</url> does not mandate any specific + character encoding and it is usually defined by the protocol or surrounding text. This library + takes the same assumption, binary and percent-encoding are handled as one configuration unit, + they cannot be set to different values.</p> + </description> + + <datatypes> + <datatype> + <name name="error"/> + <desc> + <p>Error tuple indicating the type of error. Possible values of the second component:</p> + <list type="bulleted"> + <item><c>invalid_character</c></item> + <item><c>invalid_encoding</c></item> + <item><c>invalid_input</c></item> + <item><c>invalid_map</c></item> + <item><c>invalid_percent_encoding</c></item> + <item><c>invalid_scheme</c></item> + <item><c>invalid_uri</c></item> + <item><c>invalid_utf8</c></item> + <item><c>missing_value</c></item> + </list> + <p>The third component is a term providing additional information about the + cause of the error.</p> + </desc> + </datatype> + <datatype> + <name name="uri_map"/> + <desc> + <p>Map holding the main components of a URI.</p> + </desc> + </datatype> + <datatype> + <name name="uri_string"/> + <desc> + <p>List of unicode codepoints, a UTF-8 encoded binary, or a mix of the two, + representing an <url href="https://www.ietf.org/rfc/rfc3986.txt">RFC 3986</url> + compliant URI (<em>percent-encoded form</em>). + A URI is a sequence of characters from a very limited set: the letters of + the basic Latin alphabet, digits, and a few special characters.</p> + </desc> + </datatype> + </datatypes> + + <funcs> + + <func> + <name name="compose_query" arity="1"/> + <fsummary>Compose urlencoded query string.</fsummary> + <desc> + <p>Composes a form-urlencoded <c><anno>QueryString</anno></c> based on a + <c><anno>QueryList</anno></c>, a list of non-percent-encoded key-value pairs. + Form-urlencoding is defined in section + 4.10.22.6 of the <url href="https://www.w3.org/TR/html5/forms.html">HTML5</url> + specification. + </p> + <p>See also the opposite operation <seealso marker="#dissect_query/1"> + <c>dissect_query/1</c></seealso>. + </p> + <p><em>Example:</em></p> + <pre> +1> <input>uri_string:compose_query([{"foo bar","1"},{"city","örebro"}]).</input> +<![CDATA["foo+bar=1&city=%C3%B6rebro"]]> +2> <![CDATA[uri_string:compose_query([{<<"foo bar">>,<<"1">>}, +2> {<<"city">>,<<"örebro"/utf8>>}]).]]> +<![CDATA[<<"foo+bar=1&city=%C3%B6rebro">>]]> + </pre> + </desc> + </func> + + <func> + <name name="compose_query" arity="2"/> + <fsummary>Compose urlencoded query string.</fsummary> + <desc> + <p>Same as <c>compose_query/1</c> but with an additional + <c><anno>Options</anno></c> parameter, that controls the encoding ("charset") + used by the encoding algorithm. There are two supported encodings: <c>utf8</c> + (or <c>unicode</c>) and <c>latin1</c>. + </p> + <p>Each character in the entry's name and value that cannot be expressed using + the selected character encoding, is replaced by a string consisting of a U+0026 + AMPERSAND character (<![CDATA[&]]>), a "#" (U+0023) character, one or more ASCII + digits representing the Unicode code point of the character in base ten, and + finally a ";" (U+003B) character. + </p> + <p>Bytes that are out of the range 0x2A, 0x2D, 0x2E, 0x30 to 0x39, 0x41 to 0x5A, 0x5F, + 0x61 to 0x7A, are percent-encoded (U+0025 PERCENT SIGN character (%) followed by + uppercase ASCII hex digits representing the hexadecimal value of the byte). + </p> + <p>See also the opposite operation <seealso marker="#dissect_query/1"> + <c>dissect_query/1</c></seealso>. + </p> + <p><em>Example:</em></p> + <pre> +1> <input>uri_string:compose_query([{"foo bar","1"},{"city","örebro"}],</input> +1> [{encoding, latin1}]). +<![CDATA["foo+bar=1&city=%F6rebro" +2> uri_string:compose_query([{<<"foo bar">>,<<"1">>}, +2> {<<"city">>,<<"東京"/utf8>>}], [{encoding, latin1}]).]]> +<![CDATA[<<"foo+bar=1&city=%26%2326481%3B%26%2320140%3B">>]]> + </pre> + </desc> + </func> + + <func> + <name name="dissect_query" arity="1"/> + <fsummary>Dissect query string.</fsummary> + <desc> + <p>Dissects an urlencoded <c><anno>QueryString</anno></c> and returns a + <c><anno>QueryList</anno></c>, a list of non-percent-encoded key-value pairs. + Form-urlencoding is defined in section + 4.10.22.6 of the <url href="https://www.w3.org/TR/html5/forms.html">HTML5</url> + specification. + </p> + <p>It is not as strict for its input as the decoding algorithm defined by + <url href="https://www.w3.org/TR/html5/forms.html">HTML5</url> + and accepts all unicode characters.</p> + <p>See also the opposite operation <seealso marker="#compose_query/1"> + <c>compose_query/1</c></seealso>. + </p> + <p><em>Example:</em></p> + <pre> +1> <input><![CDATA[uri_string:dissect_query("foo+bar=1&city=%C3%B6rebro").]]></input> +[{"foo bar","1"},{"city","örebro"}] +2> <![CDATA[uri_string:dissect_query(<<"foo+bar=1&city=%26%2326481%3B%26%2320140%3B">>).]]> +<![CDATA[[{<<"foo bar">>,<<"1">>}, + {<<"city">>,<<230,157,177,228,186,172>>}] ]]> + </pre> + </desc> + </func> + + <func> + <name name="normalize" arity="1"/> + <fsummary>Syntax-based normalization.</fsummary> + <desc> + <p>Transforms <c><anno>URIString</anno></c> into a normalized form + using Syntax-Based Normalization as defined by + <url href="https://www.ietf.org/rfc/rfc3986.txt">RFC 3986</url>.</p> + <p>This function implements case normalization, percent-encoding + normalization, path segment normalization and scheme based normalization + for HTTP(S) with basic support for FTP, SSH, SFTP and TFTP.</p> + <p><em>Example:</em></p> + <pre> +1> <input>uri_string:normalize("/a/b/c/./../../g").</input> +"/a/g" +2> <![CDATA[uri_string:normalize(<<"mid/content=5/../6">>).]]> +<![CDATA[<<"mid/6">>]]> +3> uri_string:normalize("http://localhost:80"). +"https://localhost/" + </pre> + </desc> + </func> + + <func> + <name name="parse" arity="1"/> + <fsummary>Parse URI into a map.</fsummary> + <desc> + <p>Parses an <url href="https://www.ietf.org/rfc/rfc3986.txt">RFC 3986</url> + compliant <c>uri_string()</c> into a <c>uri_map()</c>, that holds the parsed + components of the <c>URI</c>. + If parsing fails, an error tuple is returned.</p> + <p>See also the opposite operation <seealso marker="#recompose/1"> + <c>recompose/1</c></seealso>.</p> + <p><em>Example:</em></p> + <pre> +1> <input>uri_string:parse("foo://[email protected]:8042/over/there?name=ferret#nose").</input> +#{fragment => "nose",host => "example.com", + path => "/over/there",port => 8042,query => "name=ferret", + scheme => foo,userinfo => "user"} +2> <![CDATA[uri_string:parse(<<"foo://[email protected]:8042/over/there?name=ferret">>).]]> +<![CDATA[#{host => <<"example.com">>,path => <<"/over/there">>, + port => 8042,query => <<"name=ferret">>,scheme => <<"foo">>, + userinfo => <<"user">>}]]> + </pre> + </desc> + </func> + + <func> + <name name="recompose" arity="1"/> + <fsummary>Recompose URI.</fsummary> + <desc> + <p>Creates an <url href="https://www.ietf.org/rfc/rfc3986.txt">RFC 3986</url> compliant + <c><anno>URIString</anno></c> (percent-encoded), based on the components of + <c><anno>URIMap</anno></c>. + If the <c><anno>URIMap</anno></c> is invalid, an error tuple is returned.</p> + <p>See also the opposite operation <seealso marker="#parse/1"> + <c>parse/1</c></seealso>.</p> + <p><em>Example:</em></p> + <pre> +1> <input>URIMap = #{fragment => "nose", host => "example.com", path => "/over/there",</input> +1> port => 8042, query => "name=ferret", scheme => "foo", userinfo => "user"}. +#{fragment => "top",host => "example.com", + path => "/over/there",port => 8042,query => "?name=ferret", + scheme => foo,userinfo => "user"} + +2> <input>uri_string:recompose(URIMap).</input> +"foo://example.com:8042/over/there?name=ferret#nose"</pre> + </desc> + </func> + + <func> + <name name="transcode" arity="2"/> + <fsummary>Transcode URI.</fsummary> + <desc> + <p>Transcodes an <url href="https://www.ietf.org/rfc/rfc3986.txt">RFC 3986</url> + compliant <c><anno>URIString</anno></c>, + where <c><anno>Options</anno></c> is a list of tagged tuples, specifying the inbound + (<c>in_encoding</c>) and outbound (<c>out_encoding</c>) encodings. <c>in_encoding</c> + and <c>out_encoding</c> specifies both binary encoding and percent-encoding for the + input and output data. Mixed encoding, where binary encoding is not the same as + percent-encoding, is not supported. + If an argument is invalid, an error tuple is returned.</p> + <p><em>Example:</em></p> + <pre> +1> <input><![CDATA[uri_string:transcode(<<"foo%00%00%00%F6bar"/utf32>>,]]></input> +1> [{in_encoding, utf32},{out_encoding, utf8}]). +<![CDATA[<<"foo%C3%B6bar"/utf8>>]]> +2> uri_string:transcode("foo%F6bar", [{in_encoding, latin1}, +2> {out_encoding, utf8}]). +"foo%C3%B6bar" + </pre> + </desc> + </func> + + </funcs> +</erlref> diff --git a/lib/stdlib/doc/src/user_guide.gif b/lib/stdlib/doc/src/user_guide.gif Binary files differdeleted file mode 100644 index e6275a803d..0000000000 --- a/lib/stdlib/doc/src/user_guide.gif +++ /dev/null diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile index bf836203ec..8b156929d7 100644 --- a/lib/stdlib/src/Makefile +++ b/lib/stdlib/src/Makefile @@ -121,6 +121,7 @@ MODULES= \ timer \ unicode \ unicode_util \ + uri_string \ win32reg \ zip diff --git a/lib/stdlib/src/base64.erl b/lib/stdlib/src/base64.erl index 5885745fb1..6ea4147abf 100644 --- a/lib/stdlib/src/base64.erl +++ b/lib/stdlib/src/base64.erl @@ -24,22 +24,11 @@ -export([encode/1, decode/1, mime_decode/1, encode_to_string/1, decode_to_string/1, mime_decode_to_string/1]). -%%------------------------------------------------------------------------- %% The following type is a subtype of string() for return values %% of (some) functions of this module. -%%------------------------------------------------------------------------- - -type ascii_string() :: [1..255]. -type ascii_binary() :: binary(). -%%------------------------------------------------------------------------- -%% encode_to_string(ASCII) -> Base64String -%% ASCII - string() | binary() -%% Base64String - string() -%% -%% Description: Encodes a plain ASCII string (or binary) into base64. -%%------------------------------------------------------------------------- - -spec encode_to_string(Data) -> Base64String when Data :: ascii_string() | ascii_binary(), Base64String :: ascii_string(). @@ -47,107 +36,89 @@ encode_to_string(Bin) when is_binary(Bin) -> encode_to_string(binary_to_list(Bin)); encode_to_string(List) when is_list(List) -> - encode_l(List). - -%%------------------------------------------------------------------------- -%% encode(ASCII) -> Base64 -%% ASCII - string() | binary() -%% Base64 - binary() -%% -%% Description: Encodes a plain ASCII string (or binary) into base64. -%%------------------------------------------------------------------------- + encode_list_to_string(List). -spec encode(Data) -> Base64 when Data :: ascii_string() | ascii_binary(), Base64 :: ascii_binary(). encode(Bin) when is_binary(Bin) -> - encode_binary(Bin); + encode_binary(Bin, <<>>); encode(List) when is_list(List) -> - list_to_binary(encode_l(List)). + encode_list(List, <<>>). --spec encode_l(ascii_string()) -> ascii_string(). - -encode_l([]) -> +encode_list_to_string([]) -> []; -encode_l([A]) -> - [b64e(A bsr 2), - b64e((A band 3) bsl 4), $=, $=]; -encode_l([A,B]) -> - [b64e(A bsr 2), - b64e(((A band 3) bsl 4) bor (B bsr 4)), - b64e((B band 15) bsl 2), $=]; -encode_l([A,B,C|Ls]) -> - BB = (A bsl 16) bor (B bsl 8) bor C, +encode_list_to_string([B1]) -> + [b64e(B1 bsr 2), + b64e((B1 band 3) bsl 4), $=, $=]; +encode_list_to_string([B1,B2]) -> + [b64e(B1 bsr 2), + b64e(((B1 band 3) bsl 4) bor (B2 bsr 4)), + b64e((B2 band 15) bsl 2), $=]; +encode_list_to_string([B1,B2,B3|Ls]) -> + BB = (B1 bsl 16) bor (B2 bsl 8) bor B3, [b64e(BB bsr 18), b64e((BB bsr 12) band 63), b64e((BB bsr 6) band 63), - b64e(BB band 63) | encode_l(Ls)]. - -encode_binary(Bin) -> - Split = 3*(byte_size(Bin) div 3), - <<Main0:Split/binary,Rest/binary>> = Bin, - Main = << <<(b64e(C)):8>> || <<C:6>> <= Main0 >>, - case Rest of - <<A:6,B:6,C:4>> -> - <<Main/binary,(b64e(A)):8,(b64e(B)):8,(b64e(C bsl 2)):8,$=:8>>; - <<A:6,B:2>> -> - <<Main/binary,(b64e(A)):8,(b64e(B bsl 4)):8,$=:8,$=:8>>; - <<>> -> - Main - end. + b64e(BB band 63) | encode_list_to_string(Ls)]. -%%------------------------------------------------------------------------- -%% mime_decode(Base64) -> ASCII -%% decode(Base64) -> ASCII -%% Base64 - string() | binary() -%% ASCII - binary() -%% -%% Description: Decodes an base64 encoded string to plain ASCII. -%% mime_decode strips away all characters not Base64 before converting, -%% whereas decode crashes if an illegal character is found -%%------------------------------------------------------------------------- +encode_binary(<<>>, A) -> + A; +encode_binary(<<B1:8>>, A) -> + <<A/bits,(b64e(B1 bsr 2)):8,(b64e((B1 band 3) bsl 4)):8,$=:8,$=:8>>; +encode_binary(<<B1:8, B2:8>>, A) -> + <<A/bits,(b64e(B1 bsr 2)):8, + (b64e(((B1 band 3) bsl 4) bor (B2 bsr 4))):8, + (b64e((B2 band 15) bsl 2)):8, $=:8>>; +encode_binary(<<B1:8, B2:8, B3:8, Ls/bits>>, A) -> + BB = (B1 bsl 16) bor (B2 bsl 8) bor B3, + encode_binary(Ls, + <<A/bits,(b64e(BB bsr 18)):8, + (b64e((BB bsr 12) band 63)):8, + (b64e((BB bsr 6) band 63)):8, + (b64e(BB band 63)):8>>). + +encode_list([], A) -> + A; +encode_list([B1], A) -> + <<A/bits,(b64e(B1 bsr 2)):8,(b64e((B1 band 3) bsl 4)):8,$=:8,$=:8>>; +encode_list([B1,B2], A) -> + <<A/bits,(b64e(B1 bsr 2)):8, + (b64e(((B1 band 3) bsl 4) bor (B2 bsr 4))):8, + (b64e((B2 band 15) bsl 2)):8, $=:8>>; +encode_list([B1,B2,B3|Ls], A) -> + BB = (B1 bsl 16) bor (B2 bsl 8) bor B3, + encode_list(Ls, + <<A/bits,(b64e(BB bsr 18)):8, + (b64e((BB bsr 12) band 63)):8, + (b64e((BB bsr 6) band 63)):8, + (b64e(BB band 63)):8>>). + +%% mime_decode strips away all characters not Base64 before +%% converting, whereas decode crashes if an illegal character is found -spec decode(Base64) -> Data when Base64 :: ascii_string() | ascii_binary(), Data :: ascii_binary(). decode(Bin) when is_binary(Bin) -> - decode_binary(<<>>, Bin); + decode_binary(Bin, <<>>); decode(List) when is_list(List) -> - list_to_binary(decode_l(List)). + decode_list(List, <<>>). -spec mime_decode(Base64) -> Data when Base64 :: ascii_string() | ascii_binary(), Data :: ascii_binary(). mime_decode(Bin) when is_binary(Bin) -> - mime_decode_binary(<<>>, Bin); + mime_decode_binary(Bin, <<>>); mime_decode(List) when is_list(List) -> - mime_decode(list_to_binary(List)). - --spec decode_l(ascii_string()) -> ascii_string(). - -decode_l(List) -> - L = strip_spaces(List, []), - decode(L, []). - --spec mime_decode_l(ascii_string()) -> ascii_string(). + mime_decode_list(List, <<>>). -mime_decode_l(List) -> - L = strip_illegal(List, [], 0), - decode(L, []). - -%%------------------------------------------------------------------------- -%% mime_decode_to_string(Base64) -> ASCII -%% decode_to_string(Base64) -> ASCII -%% Base64 - string() | binary() -%% ASCII - binary() -%% -%% Description: Decodes an base64 encoded string to plain ASCII. -%% mime_decode strips away all characters not Base64 before converting, -%% whereas decode crashes if an illegal character is found -%%------------------------------------------------------------------------- +%% mime_decode_to_string strips away all characters not Base64 before +%% converting, whereas decode_to_string crashes if an illegal +%% character is found -spec decode_to_string(Base64) -> DataString when Base64 :: ascii_string() | ascii_binary(), @@ -156,7 +127,7 @@ mime_decode_l(List) -> decode_to_string(Bin) when is_binary(Bin) -> decode_to_string(binary_to_list(Bin)); decode_to_string(List) when is_list(List) -> - decode_l(List). + decode_list_to_string(List). -spec mime_decode_to_string(Base64) -> DataString when Base64 :: ascii_string() | ascii_binary(), @@ -165,202 +136,326 @@ decode_to_string(List) when is_list(List) -> mime_decode_to_string(Bin) when is_binary(Bin) -> mime_decode_to_string(binary_to_list(Bin)); mime_decode_to_string(List) when is_list(List) -> - mime_decode_l(List). - -%% One-based decode map. --define(DECODE_MAP, - {bad,bad,bad,bad,bad,bad,bad,bad,ws,ws,bad,bad,ws,bad,bad, %1-15 - bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad, %16-31 - ws,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,62,bad,bad,bad,63, %32-47 - 52,53,54,55,56,57,58,59,60,61,bad,bad,bad,eq,bad,bad, %48-63 - bad,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14, - 15,16,17,18,19,20,21,22,23,24,25,bad,bad,bad,bad,bad, - bad,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40, - 41,42,43,44,45,46,47,48,49,50,51,bad,bad,bad,bad,bad, - bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad, - bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad, - bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad, - bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad, - bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad, - bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad, - bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad, - bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad}). - -decode_binary(Result0, <<C:8,T0/bits>>) -> - case element(C, ?DECODE_MAP) of - bad -> - erlang:error({badarg,C}); - ws -> - decode_binary(Result0, T0); - eq -> - case strip_ws(T0) of - <<$=:8,T/binary>> -> - <<>> = strip_ws(T), - Split = byte_size(Result0) - 1, - <<Result:Split/bytes,_:4>> = Result0, - Result; - T -> - <<>> = strip_ws(T), - Split = byte_size(Result0) - 1, - <<Result:Split/bytes,_:2>> = Result0, - Result - end; - Bits -> - decode_binary(<<Result0/bits,Bits:6>>, T0) - end; -decode_binary(Result, <<>>) -> - true = is_binary(Result), - Result. + mime_decode_list_to_string(List). %% Skipping pad character if not at end of string. Also liberal about %% excess padding and skipping of other illegal (non-base64 alphabet) %% characters. See section 3.3 of RFC4648 -mime_decode_binary(Result, <<0:8,T/bits>>) -> - mime_decode_binary(Result, T); -mime_decode_binary(Result0, <<C:8,T/bits>>) -> - case element(C, ?DECODE_MAP) of - Bits when is_integer(Bits) -> - mime_decode_binary(<<Result0/bits,Bits:6>>, T); +mime_decode_list([0 | Cs], A) -> + mime_decode_list(Cs, A); +mime_decode_list([C1 | Cs], A) -> + case b64d(C1) of + B1 when is_integer(B1) -> mime_decode_list(Cs, A, B1); + _ -> mime_decode_list(Cs, A) % eq is padding + end; +mime_decode_list([], A) -> + A. + +mime_decode_list([0 | Cs], A, B1) -> + mime_decode_list(Cs, A, B1); +mime_decode_list([C2 | Cs], A, B1) -> + case b64d(C2) of + B2 when is_integer(B2) -> + mime_decode_list(Cs, A, B1, B2); + _ -> mime_decode_list(Cs, A, B1) % eq is padding + end. + +mime_decode_list([0 | Cs], A, B1, B2) -> + mime_decode_list(Cs, A, B1, B2); +mime_decode_list([C3 | Cs], A, B1, B2) -> + case b64d(C3) of + B3 when is_integer(B3) -> + mime_decode_list(Cs, A, B1, B2, B3); + eq=B3 -> + mime_decode_list_after_eq(Cs, A, B1, B2, B3); + _ -> mime_decode_list(Cs, A, B1, B2) + end. + +mime_decode_list([0 | Cs], A, B1, B2, B3) -> + mime_decode_list(Cs, A, B1, B2, B3); +mime_decode_list([C4 | Cs], A, B1, B2, B3) -> + case b64d(C4) of + B4 when is_integer(B4) -> + mime_decode_list(Cs, <<A/bits,B1:6,B2:6,B3:6,B4:6>>); eq -> - mime_decode_binary_after_eq(Result0, T, false); - _ -> - mime_decode_binary(Result0, T) + mime_decode_list_after_eq(Cs, A, B1, B2, B3); + _ -> mime_decode_list(Cs, A, B1, B2, B3) + end. + +mime_decode_list_after_eq([0 | Cs], A, B1, B2, B3) -> + mime_decode_list_after_eq(Cs, A, B1, B2, B3); +mime_decode_list_after_eq([C | Cs], A, B1, B2, B3) -> + case b64d(C) of + B when is_integer(B) -> + %% More valid data, skip the eq as invalid + case B3 of + eq -> mime_decode_list(Cs, A, B1, B2, B); + _ -> mime_decode_list(Cs, <<A/bits,B1:6,B2:6,B3:6,B:6>>) + end; + _ -> mime_decode_list_after_eq(Cs, A, B1, B2, B3) end; -mime_decode_binary(Result, _) -> - true = is_binary(Result), - Result. - -mime_decode_binary_after_eq(Result, <<0:8,T/bits>>, Eq) -> - mime_decode_binary_after_eq(Result, T, Eq); -mime_decode_binary_after_eq(Result0, <<C:8,T/bits>>, Eq) -> - case element(C, ?DECODE_MAP) of - bad -> - mime_decode_binary_after_eq(Result0, T, Eq); - ws -> - mime_decode_binary_after_eq(Result0, T, Eq); +mime_decode_list_after_eq([], A, B1, B2, eq) -> + <<A/bits,B1:6,(B2 bsr 4):2>>; +mime_decode_list_after_eq([], A, B1, B2, B3) -> + <<A/bits,B1:6,B2:6,(B3 bsr 2):4>>. + +mime_decode_binary(<<0:8, Cs/bits>>, A) -> + mime_decode_binary(Cs, A); +mime_decode_binary(<<C1:8, Cs/bits>>, A) -> + case b64d(C1) of + B1 when is_integer(B1) -> mime_decode_binary(Cs, A, B1); + _ -> mime_decode_binary(Cs, A) % eq is padding + end; +mime_decode_binary(<<>>, A) -> + A. + +mime_decode_binary(<<0:8, Cs/bits>>, A, B1) -> + mime_decode_binary(Cs, A, B1); +mime_decode_binary(<<C2:8, Cs/bits>>, A, B1) -> + case b64d(C2) of + B2 when is_integer(B2) -> + mime_decode_binary(Cs, A, B1, B2); + _ -> mime_decode_binary(Cs, A, B1) % eq is padding + end. + +mime_decode_binary(<<0:8, Cs/bits>>, A, B1, B2) -> + mime_decode_binary(Cs, A, B1, B2); +mime_decode_binary(<<C3:8, Cs/bits>>, A, B1, B2) -> + case b64d(C3) of + B3 when is_integer(B3) -> + mime_decode_binary(Cs, A, B1, B2, B3); + eq=B3 -> + mime_decode_binary_after_eq(Cs, A, B1, B2, B3); + _ -> mime_decode_binary(Cs, A, B1, B2) + end. + +mime_decode_binary(<<0:8, Cs/bits>>, A, B1, B2, B3) -> + mime_decode_binary(Cs, A, B1, B2, B3); +mime_decode_binary(<<C4:8, Cs/bits>>, A, B1, B2, B3) -> + case b64d(C4) of + B4 when is_integer(B4) -> + mime_decode_binary(Cs, <<A/bits,B1:6,B2:6,B3:6,B4:6>>); eq -> - mime_decode_binary_after_eq(Result0, T, true); - Bits when is_integer(Bits) -> + mime_decode_binary_after_eq(Cs, A, B1, B2, B3); + _ -> mime_decode_binary(Cs, A, B1, B2, B3) + end. + +mime_decode_binary_after_eq(<<0:8, Cs/bits>>, A, B1, B2, B3) -> + mime_decode_binary_after_eq(Cs, A, B1, B2, B3); +mime_decode_binary_after_eq(<<C:8, Cs/bits>>, A, B1, B2, B3) -> + case b64d(C) of + B when is_integer(B) -> %% More valid data, skip the eq as invalid - mime_decode_binary(<<Result0/bits,Bits:6>>, T) + case B3 of + eq -> mime_decode_binary(Cs, A, B1, B2, B); + _ -> mime_decode_binary(Cs, <<A/bits,B1:6,B2:6,B3:6,B:6>>) + end; + _ -> mime_decode_binary_after_eq(Cs, A, B1, B2, B3) + end; +mime_decode_binary_after_eq(<<>>, A, B1, B2, eq) -> + <<A/bits,B1:6,(B2 bsr 4):2>>; +mime_decode_binary_after_eq(<<>>, A, B1, B2, B3) -> + <<A/bits,B1:6,B2:6,(B3 bsr 2):4>>. + +mime_decode_list_to_string([0 | Cs]) -> + mime_decode_list_to_string(Cs); +mime_decode_list_to_string([C1 | Cs]) -> + case b64d(C1) of + B1 when is_integer(B1) -> mime_decode_list_to_string(Cs, B1); + _ -> mime_decode_list_to_string(Cs) % eq is padding end; -mime_decode_binary_after_eq(Result0, <<>>, Eq) -> - %% No more valid data. - case bit_size(Result0) rem 8 of - 0 -> - %% '====' is not uncommon. - Result0; - 4 when Eq -> - %% enforce at least one more '=' only ignoring illegals and spacing - Split = byte_size(Result0) - 1, - <<Result:Split/bytes,_:4>> = Result0, - Result; - 2 -> - %% remove 2 bits - Split = byte_size(Result0) - 1, - <<Result:Split/bytes,_:2>> = Result0, - Result +mime_decode_list_to_string([]) -> + []. + +mime_decode_list_to_string([0 | Cs], B1) -> + mime_decode_list_to_string(Cs, B1); +mime_decode_list_to_string([C2 | Cs], B1) -> + case b64d(C2) of + B2 when is_integer(B2) -> + mime_decode_list_to_string(Cs, B1, B2); + _ -> mime_decode_list_to_string(Cs, B1) % eq is padding end. -decode([], A) -> A; -decode([$=,$=,C2,C1|Cs], A) -> - Bits2x6 = (b64d(C1) bsl 18) bor (b64d(C2) bsl 12), - Octet1 = Bits2x6 bsr 16, - decode(Cs, [Octet1|A]); -decode([$=,C3,C2,C1|Cs], A) -> - Bits3x6 = (b64d(C1) bsl 18) bor (b64d(C2) bsl 12) - bor (b64d(C3) bsl 6), - Octet1 = Bits3x6 bsr 16, - Octet2 = (Bits3x6 bsr 8) band 16#ff, - decode(Cs, [Octet1,Octet2|A]); -decode([C4,C3,C2,C1| Cs], A) -> - Bits4x6 = (b64d(C1) bsl 18) bor (b64d(C2) bsl 12) - bor (b64d(C3) bsl 6) bor b64d(C4), - Octet1 = Bits4x6 bsr 16, - Octet2 = (Bits4x6 bsr 8) band 16#ff, - Octet3 = Bits4x6 band 16#ff, - decode(Cs, [Octet1,Octet2,Octet3|A]). +mime_decode_list_to_string([0 | Cs], B1, B2) -> + mime_decode_list_to_string(Cs, B1, B2); +mime_decode_list_to_string([C3 | Cs], B1, B2) -> + case b64d(C3) of + B3 when is_integer(B3) -> + mime_decode_list_to_string(Cs, B1, B2, B3); + eq=B3 -> mime_decode_list_to_string_after_eq(Cs, B1, B2, B3); + _ -> mime_decode_list_to_string(Cs, B1, B2) + end. -%%%======================================================================== -%%% Internal functions -%%%======================================================================== +mime_decode_list_to_string([0 | Cs], B1, B2, B3) -> + mime_decode_list_to_string(Cs, B1, B2, B3); +mime_decode_list_to_string([C4 | Cs], B1, B2, B3) -> + case b64d(C4) of + B4 when is_integer(B4) -> + Bits4x6 = (B1 bsl 18) bor (B2 bsl 12) bor (B3 bsl 6) bor B4, + Octet1 = Bits4x6 bsr 16, + Octet2 = (Bits4x6 bsr 8) band 16#ff, + Octet3 = Bits4x6 band 16#ff, + [Octet1, Octet2, Octet3 | mime_decode_list_to_string(Cs)]; + eq -> + mime_decode_list_to_string_after_eq(Cs, B1, B2, B3); + _ -> mime_decode_list_to_string(Cs, B1, B2, B3) + end. -strip_spaces([], A) -> A; -strip_spaces([$\s|Cs], A) -> strip_spaces(Cs, A); -strip_spaces([$\t|Cs], A) -> strip_spaces(Cs, A); -strip_spaces([$\r|Cs], A) -> strip_spaces(Cs, A); -strip_spaces([$\n|Cs], A) -> strip_spaces(Cs, A); -strip_spaces([C|Cs], A) -> strip_spaces(Cs, [C | A]). - -strip_ws(<<$\t,T/binary>>) -> - strip_ws(T); -strip_ws(<<$\n,T/binary>>) -> - strip_ws(T); -strip_ws(<<$\r,T/binary>>) -> - strip_ws(T); -strip_ws(<<$\s,T/binary>>) -> - strip_ws(T); -strip_ws(T) -> T. +mime_decode_list_to_string_after_eq([0 | Cs], B1, B2, B3) -> + mime_decode_list_to_string_after_eq(Cs, B1, B2, B3); +mime_decode_list_to_string_after_eq([C | Cs], B1, B2, B3) -> + case b64d(C) of + B when is_integer(B) -> + %% More valid data, skip the eq as invalid + case B3 of + eq -> mime_decode_list_to_string(Cs, B1, B2, B); + _ -> + Bits4x6 = (B1 bsl 18) bor (B2 bsl 12) bor (B3 bsl 6) bor B, + Octet1 = Bits4x6 bsr 16, + Octet2 = (Bits4x6 bsr 8) band 16#ff, + Octet3 = Bits4x6 band 16#ff, + [Octet1, Octet2, Octet3 | mime_decode_list_to_string(Cs)] + end; + _ -> mime_decode_list_to_string_after_eq(Cs, B1, B2, B3) + end; +mime_decode_list_to_string_after_eq([], B1, B2, eq) -> + binary_to_list(<<B1:6,(B2 bsr 4):2>>); +mime_decode_list_to_string_after_eq([], B1, B2, B3) -> + binary_to_list(<<B1:6,B2:6,(B3 bsr 2):4>>). + +decode_list([C1 | Cs], A) -> + case b64d(C1) of + ws -> decode_list(Cs, A); + B1 -> decode_list(Cs, A, B1) + end; +decode_list([], A) -> + A. -%% Skipping pad character if not at end of string. Also liberal about -%% excess padding and skipping of other illegal (non-base64 alphabet) -%% characters. See section 3.3 of RFC4648 -strip_illegal([], A, _Cnt) -> +decode_list([C2 | Cs], A, B1) -> + case b64d(C2) of + ws -> decode_list(Cs, A, B1); + B2 -> decode_list(Cs, A, B1, B2) + end. + +decode_list([C3 | Cs], A, B1, B2) -> + case b64d(C3) of + ws -> decode_list(Cs, A, B1, B2); + B3 -> decode_list(Cs, A, B1, B2, B3) + end. + +decode_list([C4 | Cs], A, B1, B2, B3) -> + case b64d(C4) of + ws -> decode_list(Cs, A, B1, B2, B3); + eq when B3 =:= eq -> only_ws(Cs, <<A/bits,B1:6,(B2 bsr 4):2>>); + eq -> only_ws(Cs, <<A/bits,B1:6,B2:6,(B3 bsr 2):4>>); + B4 -> decode_list(Cs, <<A/bits,B1:6,B2:6,B3:6,B4:6>>) + end. + +decode_binary(<<C1:8, Cs/bits>>, A) -> + case b64d(C1) of + ws -> decode_binary(Cs, A); + B1 -> decode_binary(Cs, A, B1) + end; +decode_binary(<<>>, A) -> + A. + +decode_binary(<<C2:8, Cs/bits>>, A, B1) -> + case b64d(C2) of + ws -> decode_binary(Cs, A, B1); + B2 -> decode_binary(Cs, A, B1, B2) + end. + +decode_binary(<<C3:8, Cs/bits>>, A, B1, B2) -> + case b64d(C3) of + ws -> decode_binary(Cs, A, B1, B2); + B3 -> decode_binary(Cs, A, B1, B2, B3) + end. + +decode_binary(<<C4:8, Cs/bits>>, A, B1, B2, B3) -> + case b64d(C4) of + ws -> decode_binary(Cs, A, B1, B2, B3); + eq when B3 =:= eq -> only_ws_binary(Cs, <<A/bits,B1:6,(B2 bsr 4):2>>); + eq -> only_ws_binary(Cs, <<A/bits,B1:6,B2:6,(B3 bsr 2):4>>); + B4 -> decode_binary(Cs, <<A/bits,B1:6,B2:6,B3:6,B4:6>>) + end. + +only_ws_binary(<<>>, A) -> A; -strip_illegal([0|Cs], A, Cnt) -> - strip_illegal(Cs, A, Cnt); -strip_illegal([C|Cs], A, Cnt) -> - case element(C, ?DECODE_MAP) of - bad -> - strip_illegal(Cs, A, Cnt); - ws -> - strip_illegal(Cs, A, Cnt); - eq -> - case {tail_contains_more(Cs, false), Cnt rem 4} of - {{[], _}, 0} -> - A; %% Ignore extra = - {{[], true}, 2} -> - [$=|[$=|A]]; %% 'XX==' - {{[], _}, 3} -> - [$=|A]; %% 'XXX=' - {{[H|T], _}, _} -> - %% more data, skip equals - strip_illegal(T, [H|A], Cnt+1) - end; - _ -> - strip_illegal(Cs, [C|A], Cnt+1) +only_ws_binary(<<C:8, Cs/bits>>, A) -> + case b64d(C) of + ws -> only_ws_binary(Cs, A) end. -%% Search the tail for more valid data and remember if we saw -%% another equals along the way. -tail_contains_more([], Eq) -> - {[], Eq}; -tail_contains_more(<<>>, Eq) -> - {<<>>, Eq}; -tail_contains_more([C|T]=More, Eq) -> - case element(C, ?DECODE_MAP) of - bad -> - tail_contains_more(T, Eq); - ws -> - tail_contains_more(T, Eq); - eq -> - tail_contains_more(T, true); - _ -> - {More, Eq} +decode_list_to_string([C1 | Cs]) -> + case b64d(C1) of + ws -> decode_list_to_string(Cs); + B1 -> decode_list_to_string(Cs, B1) end; -tail_contains_more(<<C:8,T/bits>> =More, Eq) -> - case element(C, ?DECODE_MAP) of - bad -> - tail_contains_more(T, Eq); - ws -> - tail_contains_more(T, Eq); - eq -> - tail_contains_more(T, true); - _ -> - {More, Eq} +decode_list_to_string([]) -> + []. + +decode_list_to_string([C2 | Cs], B1) -> + case b64d(C2) of + ws -> decode_list_to_string(Cs, B1); + B2 -> decode_list_to_string(Cs, B1, B2) end. - + +decode_list_to_string([C3 | Cs], B1, B2) -> + case b64d(C3) of + ws -> decode_list_to_string(Cs, B1, B2); + B3 -> decode_list_to_string(Cs, B1, B2, B3) + end. + +decode_list_to_string([C4 | Cs], B1, B2, B3) -> + case b64d(C4) of + ws -> + decode_list_to_string(Cs, B1, B2, B3); + eq when B3 =:= eq -> + only_ws(Cs, binary_to_list(<<B1:6,(B2 bsr 4):2>>)); + eq -> + only_ws(Cs, binary_to_list(<<B1:6,B2:6,(B3 bsr 2):4>>)); + B4 -> + Bits4x6 = (B1 bsl 18) bor (B2 bsl 12) bor (B3 bsl 6) bor B4, + Octet1 = Bits4x6 bsr 16, + Octet2 = (Bits4x6 bsr 8) band 16#ff, + Octet3 = Bits4x6 band 16#ff, + [Octet1, Octet2, Octet3 | decode_list_to_string(Cs)] + end. + +only_ws([], A) -> + A; +only_ws([C | Cs], A) -> + case b64d(C) of + ws -> only_ws(Cs, A) + end. + +%%%======================================================================== +%%% Internal functions +%%%======================================================================== + %% accessors +-compile({inline, [{b64d, 1}]}). +%% One-based decode map. +b64d(X) -> + element(X, + {bad,bad,bad,bad,bad,bad,bad,bad,ws,ws,bad,bad,ws,bad,bad, %1-15 + bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad, %16-31 + ws,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,62,bad,bad,bad,63, %32-47 + 52,53,54,55,56,57,58,59,60,61,bad,bad,bad,eq,bad,bad, %48-63 + bad,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14, + 15,16,17,18,19,20,21,22,23,24,25,bad,bad,bad,bad,bad, + bad,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40, + 41,42,43,44,45,46,47,48,49,50,51,bad,bad,bad,bad,bad, + bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad, + bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad, + bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad, + bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad, + bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad, + bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad, + bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad, + bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad}). + +-compile({inline, [{b64e, 1}]}). b64e(X) -> element(X+1, {$A, $B, $C, $D, $E, $F, $G, $H, $I, $J, $K, $L, $M, $N, @@ -368,9 +463,3 @@ b64e(X) -> $a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l, $m, $n, $o, $p, $q, $r, $s, $t, $u, $v, $w, $x, $y, $z, $0, $1, $2, $3, $4, $5, $6, $7, $8, $9, $+, $/}). - - -b64d(X) -> - b64d_ok(element(X, ?DECODE_MAP)). - -b64d_ok(I) when is_integer(I) -> I. diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl index c04a201ce1..9a447af5b7 100644 --- a/lib/stdlib/src/c.erl +++ b/lib/stdlib/src/c.erl @@ -668,19 +668,23 @@ lm() -> [l(M) || M <- mm()]. %% erlangrc(Home) -%% Try to run a ".erlang" file, first in the current directory -%% else in home directory. +%% Try to run a ".erlang" file in home directory. + +-spec erlangrc() -> {ok, file:filename()} | {error, term()}. erlangrc() -> case init:get_argument(home) of {ok,[[Home]]} -> erlangrc([Home]); _ -> - f_p_e(["."], ".erlang") + {error, enoent} end. -erlangrc([Home]) -> - f_p_e([".",Home], ".erlang"). +-spec erlangrc(PathList) -> {ok, file:filename()} | {error, term()} + when PathList :: [Dir :: file:name()]. + +erlangrc([Home|_]=Paths) when is_list(Home) -> + f_p_e(Paths, ".erlang"). error(Fmt, Args) -> error_logger:error_msg(Fmt, Args). @@ -692,11 +696,11 @@ f_p_e(P, F) -> {error, E={Line, _Mod, _Term}} -> error("file:path_eval(~tp,~tp): error on line ~p: ~ts~n", [P, F, Line, file:format_error(E)]), - ok; + {error, E}; {error, E} -> error("file:path_eval(~tp,~tp): ~ts~n", [P, F, file:format_error(E)]), - ok; + {error, E}; Other -> Other end. diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index 31d0d499e3..00e6a10d8a 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -479,7 +479,7 @@ com_enc(_B, _Fun, _N, L, Ps) -> com_enc_end([L | Ps]). com_enc_end(Ps0) -> - Ps = lists:reverse([lists:reverse(string:to_lower(P)) || P <- Ps0]), + Ps = lists:reverse([lists:reverse(lowercase(P)) || P <- Ps0]), com_encoding(Ps). com_encoding(["latin","1"|_]) -> @@ -489,6 +489,9 @@ com_encoding(["utf","8"|_]) -> com_encoding(_) -> throw(no). % Don't try any further +lowercase(S) -> + unicode:characters_to_list(string:lowercase(S)). + normalize_typed_record_fields([]) -> {typed, []}; normalize_typed_record_fields(Fields) -> diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 9cd4727dc3..1930c462e8 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -144,6 +144,7 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> :: dict:dict(ta(), #typeinfo{}), exp_types=gb_sets:empty() %Exported types :: gb_sets:set(ta()), + in_try_head=false :: boolean(), %In a try head. catch_scope = none %Inside/outside try or catch :: catch_scope() }). @@ -312,6 +313,10 @@ format_error({unused_var, V}) -> io_lib:format("variable ~w is unused", [V]); format_error({variable_in_record_def,V}) -> io_lib:format("variable ~w in record definition", [V]); +format_error({stacktrace_guard,V}) -> + io_lib:format("stacktrace variable ~w must not be used in a guard", [V]); +format_error({stacktrace_bound,V}) -> + io_lib:format("stacktrace variable ~w must not be previously bound", [V]); %% --- binaries --- format_error({undefined_bittype,Type}) -> io_lib:format("bit type ~tw undefined", [Type]); @@ -3218,11 +3223,11 @@ is_module_dialyzer_option(Option) -> try_clauses(Scs, Ccs, In, Vt, St0) -> {Csvt0,St1} = icrt_clauses(Scs, Vt, St0), - St2 = St1#lint{catch_scope=try_catch}, + St2 = St1#lint{catch_scope=try_catch,in_try_head=true}, {Csvt1,St3} = icrt_clauses(Ccs, Vt, St2), Csvt = Csvt0 ++ Csvt1, UpdVt = icrt_export(Csvt, Vt, In, St3), - {UpdVt,St3}. + {UpdVt,St3#lint{in_try_head=false}}. %% icrt_clauses(Clauses, In, ImportVarTable, State) -> %% {UpdVt,State}. @@ -3239,12 +3244,29 @@ icrt_clauses(Cs, Vt, St) -> mapfoldl(fun (C, St0) -> icrt_clause(C, Vt, St0) end, St, Cs). icrt_clause({clause,_Line,H,G,B}, Vt0, #lint{catch_scope=Scope}=St0) -> - {Hvt,Binvt,St1} = head(H, Vt0, St0), - Vt1 = vtupdate(Hvt, Binvt), - {Gvt,St2} = guard(G, vtupdate(Vt1, Vt0), St1), - Vt2 = vtupdate(Gvt, Vt1), - {Bvt,St3} = exprs(B, vtupdate(Vt2, Vt0), St2), - {vtupdate(Bvt, Vt2),St3#lint{catch_scope=Scope}}. + Vt1 = taint_stack_var(Vt0, H, St0), + {Hvt,Binvt,St1} = head(H, Vt1, St0), + Vt2 = vtupdate(Hvt, Binvt), + Vt3 = taint_stack_var(Vt2, H, St0), + {Gvt,St2} = guard(G, vtupdate(Vt3, Vt0), St1#lint{in_try_head=false}), + Vt4 = vtupdate(Gvt, Vt2), + {Bvt,St3} = exprs(B, vtupdate(Vt4, Vt0), St2), + {vtupdate(Bvt, Vt4),St3#lint{catch_scope=Scope}}. + +taint_stack_var(Vt, Pat, #lint{in_try_head=true}) -> + [{tuple,_,[_,_,{var,_,Stk}]}] = Pat, + case Stk of + '_' -> + Vt; + _ -> + lists:map(fun({V,{bound,Used,Lines}}) when V =:= Stk -> + {V,{stacktrace,Used,Lines}}; + (B) -> + B + end, Vt) + end; +taint_stack_var(Vt, _Pat, #lint{in_try_head=false}) -> + Vt. icrt_export(Vts, Vt, {Tag,Attrs}, St) -> {_File,Loc} = loc(Attrs, St), @@ -3484,6 +3506,9 @@ pat_var(V, Line, Vt, Bvt, St) -> {[{V,{bound,used,Ls}}],[], %% As this is matching, exported vars are risky. add_warning(Line, {exported_var,V,From}, St)}; + {ok,{stacktrace,_Usage,Ls}} -> + {[{V,{bound,used,Ls}}],[], + add_error(Line, {stacktrace_bound,V}, St)}; error when St#lint.recdef_top -> {[],[{V,{bound,unused,[Line]}}], add_error(Line, {variable_in_record_def,V}, St)}; @@ -3541,6 +3566,9 @@ expr_var(V, Line, Vt, St) -> false -> {[{V,{{export,From},used,Ls}}],St} end; + {ok,{stacktrace,_Usage,Ls}} -> + {[{V,{bound,used,Ls}}], + add_error(Line, {stacktrace_guard,V}, St)}; error -> {[{V,{bound,used,[Line]}}], add_error(Line, {unbound_var,V}, St)} @@ -3910,10 +3938,9 @@ check_format_string(Fmt) -> extract_sequences(Fmt, []). extract_sequences(Fmt, Need0) -> - case string:chr(Fmt, $~) of - 0 -> {ok,lists:reverse(Need0)}; %That's it - Pos -> - Fmt1 = string:substr(Fmt, Pos+1), %Skip ~ + case string:find(Fmt, [$~]) of + nomatch -> {ok,lists:reverse(Need0)}; %That's it + [$~|Fmt1] -> case extract_sequence(1, Fmt1, Need0) of {ok,Need1,Rest} -> extract_sequences(Rest, Need1); Error -> Error diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 6e72d64acc..14ca24362e 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -29,6 +29,10 @@ clause_args clause_guard clause_body expr expr_100 expr_150 expr_160 expr_200 expr_300 expr_400 expr_500 expr_600 expr_700 expr_800 expr_max +pat_expr pat_expr_200 pat_expr_300 pat_expr_400 pat_expr_500 +pat_expr_600 pat_expr_700 pat_expr_800 +pat_expr_max map_pat_expr record_pat_expr +pat_argument_list pat_exprs list tail list_comprehension lc_expr lc_exprs binary_comprehension @@ -37,7 +41,7 @@ record_expr record_tuple record_field record_fields map_expr map_tuple map_field map_field_assoc map_field_exact map_fields map_key if_expr if_clause if_clauses case_expr cr_clause cr_clauses receive_expr fun_expr fun_clause fun_clauses atom_or_var integer_or_var -try_expr try_catch try_clause try_clauses +try_expr try_catch try_clause try_clauses try_opt_stacktrace function_call argument_list exprs guard atomic strings @@ -66,7 +70,7 @@ char integer float atom string var 'spec' 'callback' % helper dot. -Expect 2. +Expect 0. Rootsymbol form. @@ -210,7 +214,7 @@ function_clause -> atom clause_args clause_guard clause_body : {clause,?anno('$1'),element(3, '$1'),'$2','$3','$4'}. -clause_args -> argument_list : element(1, '$1'). +clause_args -> pat_argument_list : element(1, '$1'). clause_guard -> 'when' guard : '$2'. clause_guard -> '$empty' : []. @@ -275,6 +279,53 @@ expr_max -> receive_expr : '$1'. expr_max -> fun_expr : '$1'. expr_max -> try_expr : '$1'. +pat_expr -> pat_expr_200 '=' pat_expr : {match,?anno('$2'),'$1','$3'}. +pat_expr -> pat_expr_200 : '$1'. + +pat_expr_200 -> pat_expr_300 comp_op pat_expr_300 : + ?mkop2('$1', '$2', '$3'). +pat_expr_200 -> pat_expr_300 : '$1'. + +pat_expr_300 -> pat_expr_400 list_op pat_expr_300 : + ?mkop2('$1', '$2', '$3'). +pat_expr_300 -> pat_expr_400 : '$1'. + +pat_expr_400 -> pat_expr_400 add_op pat_expr_500 : + ?mkop2('$1', '$2', '$3'). +pat_expr_400 -> pat_expr_500 : '$1'. + +pat_expr_500 -> pat_expr_500 mult_op pat_expr_600 : + ?mkop2('$1', '$2', '$3'). +pat_expr_500 -> pat_expr_600 : '$1'. + +pat_expr_600 -> prefix_op pat_expr_700 : + ?mkop1('$1', '$2'). +pat_expr_600 -> map_pat_expr : '$1'. +pat_expr_600 -> pat_expr_700 : '$1'. + +pat_expr_700 -> record_pat_expr : '$1'. +pat_expr_700 -> pat_expr_800 : '$1'. + +pat_expr_800 -> pat_expr_max : '$1'. + +pat_expr_max -> var : '$1'. +pat_expr_max -> atomic : '$1'. +pat_expr_max -> list : '$1'. +pat_expr_max -> binary : '$1'. +pat_expr_max -> tuple : '$1'. +pat_expr_max -> '(' pat_expr ')' : '$2'. + +map_pat_expr -> '#' map_tuple : + {map, ?anno('$1'),'$2'}. +map_pat_expr -> pat_expr_max '#' map_tuple : + {map, ?anno('$2'),'$1','$3'}. +map_pat_expr -> map_pat_expr '#' map_tuple : + {map, ?anno('$2'),'$1','$3'}. + +record_pat_expr -> '#' atom '.' atom : + {record_index,?anno('$1'),element(3, '$2'),'$4'}. +record_pat_expr -> '#' atom record_tuple : + {record,?anno('$1'),element(3, '$2'),'$3'}. list -> '[' ']' : {nil,?anno('$1')}. list -> '[' expr tail : {cons,?anno('$1'),'$2','$3'}. @@ -397,6 +448,10 @@ case_expr -> 'case' expr 'of' cr_clauses 'end' : cr_clauses -> cr_clause : ['$1']. cr_clauses -> cr_clause ';' cr_clauses : ['$1' | '$3']. +%% FIXME: merl in syntax_tools depends on patterns in a 'case' being +%% full expressions. Therefore, we can't use pat_expr here. There +%% should be a better way. + cr_clause -> expr clause_guard clause_body : {clause,?anno('$1'),['$1'],'$2','$3'}. @@ -424,11 +479,11 @@ integer_or_var -> var : '$1'. fun_clauses -> fun_clause : ['$1']. fun_clauses -> fun_clause ';' fun_clauses : ['$1' | '$3']. -fun_clause -> argument_list clause_guard clause_body : +fun_clause -> pat_argument_list clause_guard clause_body : {Args,Anno} = '$1', {clause,Anno,'fun',Args,'$2','$3'}. -fun_clause -> var argument_list clause_guard clause_body : +fun_clause -> var pat_argument_list clause_guard clause_body : {clause,element(2, '$1'),element(3, '$1'),element(1, '$2'),'$3','$4'}. try_expr -> 'try' exprs 'of' cr_clauses try_catch : @@ -446,24 +501,31 @@ try_catch -> 'after' exprs 'end' : try_clauses -> try_clause : ['$1']. try_clauses -> try_clause ';' try_clauses : ['$1' | '$3']. -try_clause -> expr clause_guard clause_body : +try_clause -> pat_expr clause_guard clause_body : A = ?anno('$1'), {clause,A,[{tuple,A,[{atom,A,throw},'$1',{var,A,'_'}]}],'$2','$3'}. -try_clause -> atom ':' expr clause_guard clause_body : +try_clause -> atom ':' pat_expr try_opt_stacktrace clause_guard clause_body : A = ?anno('$1'), - {clause,A,[{tuple,A,['$1','$3',{var,A,'_'}]}],'$4','$5'}. -try_clause -> var ':' expr clause_guard clause_body : + {clause,A,[{tuple,A,['$1','$3',{var,A,'$4'}]}],'$5','$6'}. +try_clause -> var ':' pat_expr try_opt_stacktrace clause_guard clause_body : A = ?anno('$1'), - {clause,A,[{tuple,A,['$1','$3',{var,A,'_'}]}],'$4','$5'}. + {clause,A,[{tuple,A,['$1','$3',{var,A,'$4'}]}],'$5','$6'}. +try_opt_stacktrace -> ':' var : element(3, '$2'). +try_opt_stacktrace -> '$empty' : '_'. argument_list -> '(' ')' : {[],?anno('$1')}. argument_list -> '(' exprs ')' : {'$2',?anno('$1')}. +pat_argument_list -> '(' ')' : {[],?anno('$1')}. +pat_argument_list -> '(' pat_exprs ')' : {'$2',?anno('$1')}. exprs -> expr : ['$1']. exprs -> expr ',' exprs : ['$1' | '$3']. +pat_exprs -> pat_expr : ['$1']. +pat_exprs -> pat_expr ',' pat_exprs : ['$1' | '$3']. + guard -> exprs : ['$1']. guard -> exprs ';' guard : ['$1'|'$3']. diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index ee5e7a11bf..367dbefb82 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -237,13 +237,20 @@ lform({attribute,Line,Name,Arg}, Opts) -> lform({function,Line,Name,Arity,Clauses}, Opts) -> lfunction({function,Line,Name,Arity,Clauses}, Opts); %% These are specials to make it easier for the compiler. -lform({error,E}, _Opts) -> - leaf(format("~p\n", [{error,E}])); -lform({warning,W}, _Opts) -> - leaf(format("~p\n", [{warning,W}])); +lform({error,_}=E, Opts) -> + message(E, Opts); +lform({warning,_}=W, Opts) -> + message(W, Opts); lform({eof,_Line}, _Opts) -> $\n. +message(M, #options{encoding = Encoding}) -> + F = case Encoding of + latin1 -> "~p\n"; + unicode -> "~tp\n" + end, + leaf(format(F, [M])). + lattribute({attribute,_Line,type,Type}, Opts) -> [typeattr(type, Type, Opts),leaf(".\n")]; lattribute({attribute,_Line,opaque,Type}, Opts) -> @@ -598,8 +605,6 @@ lexpr({'fun',_,{clauses,Cs},Extra}, _Prec, Opts) -> lexpr({named_fun,_,Name,Cs,Extra}, _Prec, Opts) -> {force_nl,fun_info(Extra), {list,[{first,['fun', " "],fun_clauses(Cs, Opts, {named, Name})},'end']}}; -lexpr({'query',_,Lc}, _Prec, Opts) -> - {list,[{step,leaf("query"),lexpr(Lc, 0, Opts)},'end']}; lexpr({call,_,{remote,_,{atom,_,M},{atom,_,F}=N}=Name,Args}, Prec, Opts) -> case erl_internal:bif(M, F, length(Args)) of true -> @@ -904,7 +909,7 @@ maybe_paren(_P, _Prec, Expr) -> Expr. leaf(S) -> - {leaf,chars_size(S),S}. + {leaf,string:length(S),S}. %%% Do the formatting. Currently nothing fancy. Could probably have %%% done it in one single pass. @@ -964,7 +969,7 @@ f({seq,Before,After,Sep,LItems}, I0, ST, WT, PP) -> Sizes = BSizeL ++ SizeL, NSepChars = if is_list(Sep), Sep =/= [] -> - erlang:max(0, length(CharsL)-1); + erlang:max(0, length(CharsL)-1); % not string:length true -> 0 end, @@ -1120,7 +1125,7 @@ incr(I, Incr) -> I+Incr. indentation(E, I) when I < 0 -> - chars_size(E); + string:length(E); indentation(E, I0) -> I = io_lib_format:indentation(E, I0), case has_nl(E) of @@ -1157,19 +1162,19 @@ write_a_string(S, I, PP) -> write_a_string([], _N, _Len, _PP) -> []; write_a_string(S, N, Len, PP) -> - SS = string:sub_string(S, 1, N), + SS = string:slice(S, 0, N), Sl = write_string(SS, PP), - case (chars_size(Sl) > Len) and (N > ?MIN_SUBSTRING) of + case (string:length(Sl) > Len) and (N > ?MIN_SUBSTRING) of true -> write_a_string(S, N-1, Len, PP); false -> [flat_leaf(Sl) | - write_a_string(lists:nthtail(length(SS), S), Len, Len, PP)] + write_a_string(string:slice(S, string:length(SS)), Len, Len, PP)] end. flat_leaf(S) -> L = lists:flatten(S), - {leaf,length(L),L}. + {leaf,string:length(L),L}. write_value(V, PP) -> (PP#pp.value_fun)(V). @@ -1190,15 +1195,6 @@ write_char(C, PP) -> a0() -> erl_anno:new(0). -chars_size([C | Es]) when is_integer(C) -> - 1 + chars_size(Es); -chars_size([E | Es]) -> - chars_size(E) + chars_size(Es); -chars_size([]) -> - 0; -chars_size(B) when is_binary(B) -> - byte_size(B). - -define(N_SPACES, 30). spacetab() -> diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl index 47223b129c..4774c4bf19 100644 --- a/lib/stdlib/src/erl_scan.erl +++ b/lib/stdlib/src/erl_scan.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -752,7 +752,7 @@ scan_string(Cs, St, Line, Col, Toks, {Wcs,Str,Line0,Col0}) -> {char_error,Ncs,Error,Nline,Ncol,EndCol} -> scan_error(Error, Nline, Ncol, Nline, EndCol, Ncs); {error,Nline,Ncol,Nwcs,Ncs} -> - Estr = string:substr(Nwcs, 1, 16), % Expanded escape chars. + Estr = string:slice(Nwcs, 0, 16), % Expanded escape chars. scan_error({string,$\",Estr}, Line0, Col0, Nline, Ncol, Ncs); %" {Ncs,Nline,Ncol,Nstr,Nwcs} -> Anno = anno(Line0, Col0, St, Nstr), @@ -767,7 +767,7 @@ scan_qatom(Cs, St, Line, Col, Toks, {Wcs,Str,Line0,Col0}) -> {char_error,Ncs,Error,Nline,Ncol,EndCol} -> scan_error(Error, Nline, Ncol, Nline, EndCol, Ncs); {error,Nline,Ncol,Nwcs,Ncs} -> - Estr = string:substr(Nwcs, 1, 16), % Expanded escape chars. + Estr = string:slice(Nwcs, 0, 16), % Expanded escape chars. scan_error({string,$\',Estr}, Line0, Col0, Nline, Ncol, Ncs); %' {Ncs,Nline,Ncol,Nstr,Nwcs} -> case catch list_to_atom(Nwcs) of diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index 2b9d8ff65b..132f8efbbe 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -224,8 +224,8 @@ return_sections(S, Bin) -> normalize_section(Name, undefined) -> {Name, undefined}; normalize_section(shebang, "#!" ++ Chars) -> - Chopped = string:strip(Chars, right, $\n), - Stripped = string:strip(Chopped, both), + Chopped = string:trim(Chars, trailing, "$\n"), + Stripped = string:trim(Chopped, both), if Stripped =:= ?SHEBANG -> {shebang, default}; @@ -233,8 +233,8 @@ normalize_section(shebang, "#!" ++ Chars) -> {shebang, Stripped} end; normalize_section(comment, Chars) -> - Chopped = string:strip(Chars, right, $\n), - Stripped = string:strip(string:strip(Chopped, left, $%), both), + Chopped = string:trim(Chars, trailing, "$\n"), + Stripped = string:trim(string:trim(Chopped, leading, "$%"), both), if Stripped =:= ?COMMENT -> {comment, default}; @@ -242,8 +242,8 @@ normalize_section(comment, Chars) -> {comment, Stripped} end; normalize_section(emu_args, "%%!" ++ Chars) -> - Chopped = string:strip(Chars, right, $\n), - Stripped = string:strip(Chopped, both), + Chopped = string:trim(Chars, trailing, "$\n"), + Stripped = string:trim(Chopped, both), {emu_args, Stripped}; normalize_section(Name, Chars) -> {Name, Chars}. diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl index b5d3cd3c8d..b6548626f3 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -1700,6 +1700,8 @@ choice(Height, Width, P, Mode, Tab, Key, Turn, Opos) -> io:format("~ts\n", [ErrorString]), choice(Height, Width, P, Mode, Tab, Key, Turn, Opos) end; + eof -> + ok; _ -> choice(Height, Width, P, Mode, Tab, Key, Turn, Opos) end. @@ -1717,7 +1719,7 @@ get_line(P, Default) -> line_string(Binary) when is_binary(Binary) -> unicode:characters_to_list(Binary); line_string(Other) -> Other. -nonl(S) -> string:strip(S, right, $\n). +nonl(S) -> string:trim(S, trailing, "$\n"). print_number(Tab, Key, Num) -> Os = ets:lookup(Tab, Key), @@ -1746,7 +1748,7 @@ do_display_item(_Height, Width, I, Opos) -> L = to_string(I), L2 = if length(L) > Width - 8 -> - string:substr(L, 1, Width-13) ++ " ..."; + string:slice(L, 0, Width-13) ++ " ..."; true -> L end, diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl index d7c313f214..0f90b3fc33 100644 --- a/lib/stdlib/src/filelib.erl +++ b/lib/stdlib/src/filelib.erl @@ -365,11 +365,18 @@ do_list_dir(Dir, Mod) -> eval_list_dir(Dir, Mod). %%% Compiling a wildcard. + +%% Define characters used for escaping a \. +-define(ESCAPE_PREFIX, $@). +-define(ESCAPE_CHARACTER, [?ESCAPE_PREFIX,$e]). +-define(ESCAPED_ESCAPE_PREFIX, [?ESCAPE_PREFIX,?ESCAPE_PREFIX]). + %% Only for debugging. compile_wildcard(Pattern) when is_list(Pattern) -> {compiled_wildcard,?HANDLE_ERROR(compile_wildcard(Pattern, "."))}. -compile_wildcard(Pattern, Cwd0) -> +compile_wildcard(Pattern0, Cwd0) -> + Pattern = convert_escapes(Pattern0), [Root|Rest] = filename:split(Pattern), case filename:pathtype(Root) of relative -> @@ -409,7 +416,8 @@ compile_join({cwd,Cwd}, File0) -> compile_join({root,PrefixLen,Root}, File) -> {root,PrefixLen,filename:join(Root, File)}. -compile_part(Part) -> +compile_part(Part0) -> + Part = wrap_escapes(Part0), compile_part(Part, false, []). compile_part_to_sep(Part) -> @@ -445,6 +453,8 @@ compile_part([${|Rest], Upto, Result) -> error -> compile_part(Rest, Upto, [${|Result]) end; +compile_part([{escaped,X}|Rest], Upto, Result) -> + compile_part(Rest, Upto, [X|Result]); compile_part([X|Rest], Upto, Result) -> compile_part(Rest, Upto, [X|Result]); compile_part([], _Upto, Result) -> @@ -461,6 +471,8 @@ compile_charset1([Lower, $-, Upper|Rest], Ordset) when Lower =< Upper -> compile_charset1(Rest, compile_range(Lower, Upper, Ordset)); compile_charset1([$]|Rest], Ordset) -> {ok, {one_of, gb_sets:from_ordset(Ordset)}, Rest}; +compile_charset1([{escaped,X}|Rest], Ordset) -> + compile_charset1(Rest, ordsets:add_element(X, Ordset)); compile_charset1([X|Rest], Ordset) -> compile_charset1(Rest, ordsets:add_element(X, Ordset)); compile_charset1([], _Ordset) -> @@ -486,6 +498,32 @@ compile_alt(Pattern, Result) -> error end. +%% Convert backslashes to an illegal Unicode character to +%% protect in from filename:split/1. + +convert_escapes([?ESCAPE_PREFIX|T]) -> + ?ESCAPED_ESCAPE_PREFIX ++ convert_escapes(T); +convert_escapes([$\\|T]) -> + ?ESCAPE_CHARACTER ++ convert_escapes(T); +convert_escapes([H|T]) -> + [H|convert_escapes(T)]; +convert_escapes([]) -> + []. + +%% Wrap each escape in a tuple to remove the special meaning for +%% the character that follows. + +wrap_escapes(?ESCAPED_ESCAPE_PREFIX ++ T) -> + [?ESCAPE_PREFIX|wrap_escapes(T)]; +wrap_escapes(?ESCAPE_CHARACTER ++ [C|T]) -> + [{escaped,C}|wrap_escapes(T)]; +wrap_escapes(?ESCAPE_CHARACTER) -> + []; +wrap_escapes([H|T]) -> + [H|wrap_escapes(T)]; +wrap_escapes([]) -> + []. + badpattern(Reason) -> error({badpattern,Reason}). diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl index 9bf4290916..a322bd002d 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -34,6 +34,38 @@ %% we flatten the arguments immediately on function entry as that makes %% it easier to ensure that the code works. +%% +%% *** Requirements on Raw Filename Format *** +%% +%% These requirements are due to the 'filename' module +%% in stdlib. This since it is documented that it +%% should be able to operate on raw filenames as well +%% as ordinary filenames. +%% +%% A raw filename *must* be a byte sequence where: +%% 1. Codepoints 0-127 (7-bit ascii) *must* be encoded +%% as a byte with the corresponding value. That is, +%% the most significant bit in the byte encoding the +%% codepoint is never set. +%% 2. Codepoints greater than 127 *must* be encoded +%% with the most significant bit set in *every* byte +%% encoding it. +%% +%% Latin1 and UTF-8 meet these requirements while +%% UTF-16 and UTF-32 don't. +%% +%% On Windows filenames are natively stored as malformed +%% UTF-16LE (lonely surrogates may appear). A more correct +%% description than UTF-16 would be an array of 16-bit +%% words... In order to meet the requirements of the +%% raw file format we convert the malformed UTF-16LE to +%% malformed UTF-8 which meet the requirements. +%% +%% Note that these requirements are today only OTP +%% internal (erts-stdlib internal) requirements that +%% could be changed. +%% + -export([absname/1, absname/2, absname_join/2, basename/1, basename/2, dirname/1, extension/1, join/1, join/2, pathtype/1, @@ -41,6 +73,7 @@ safe_relative_path/1]). -export([find_src/1, find_src/2]). % deprecated -export([basedir/2, basedir/3]). +-export([validate/1]). %% Undocumented and unsupported exports. -export([append/2]). @@ -439,6 +472,10 @@ join(Name1, Name2) when is_atom(Name2) -> join1([UcLetter, $:|Rest], RelativeName, [], win32) when is_integer(UcLetter), UcLetter >= $A, UcLetter =< $Z -> join1(Rest, RelativeName, [$:, UcLetter+$a-$A], win32); +join1([$\\,$\\|Rest], RelativeName, [], win32) -> + join1([$/,$/|Rest], RelativeName, [], win32); +join1([$/,$/|Rest], RelativeName, [], win32) -> + join1(Rest, RelativeName, [$/,$/], win32); join1([$\\|Rest], RelativeName, Result, win32) -> join1([$/|Rest], RelativeName, Result, win32); join1([$/|Rest], RelativeName, [$., $/|Result], OsType) -> @@ -467,6 +504,10 @@ join1([Atom|Rest], RelativeName, Result, OsType) when is_atom(Atom) -> join1b(<<UcLetter, $:, Rest/binary>>, RelativeName, [], win32) when is_integer(UcLetter), UcLetter >= $A, UcLetter =< $Z -> join1b(Rest, RelativeName, [$:, UcLetter+$a-$A], win32); +join1b(<<$\\,$\\,Rest/binary>>, RelativeName, [], win32) -> + join1b(<<$/,$/,Rest/binary>>, RelativeName, [], win32); +join1b(<<$/,$/,Rest/binary>>, RelativeName, [], win32) -> + join1b(Rest, RelativeName, [$/,$/], win32); join1b(<<$\\,Rest/binary>>, RelativeName, Result, win32) -> join1b(<<$/,Rest/binary>>, RelativeName, Result, win32); join1b(<<$/,Rest/binary>>, RelativeName, [$., $/|Result], OsType) -> @@ -477,6 +518,8 @@ join1b(<<>>, <<>>, Result, OsType) -> list_to_binary(maybe_remove_dirsep(Result, OsType)); join1b(<<>>, RelativeName, [$:|Rest], win32) -> join1b(RelativeName, <<>>, [$:|Rest], win32); +join1b(<<>>, RelativeName, [$/,$/|Result], win32) -> + join1b(RelativeName, <<>>, [$/,$/|Result], win32); join1b(<<>>, RelativeName, [$/|Result], OsType) -> join1b(RelativeName, <<>>, [$/|Result], OsType); join1b(<<>>, RelativeName, [$., $/|Result], OsType) -> @@ -490,6 +533,8 @@ maybe_remove_dirsep([$/, $:, Letter], win32) -> [Letter, $:, $/]; maybe_remove_dirsep([$/], _) -> [$/]; +maybe_remove_dirsep([$/,$/], win32) -> + [$/,$/]; maybe_remove_dirsep([$/|Name], _) -> lists:reverse(Name); maybe_remove_dirsep(Name, _) -> @@ -679,6 +724,9 @@ win32_splitb(<<Letter0,$:,Rest/binary>>) when ?IS_DRIVELETTER(Letter0) -> Letter = fix_driveletter(Letter0), L = binary:split(Rest,[<<"/">>,<<"\\">>],[global]), [<<Letter,$:>> | [ X || X <- L, X =/= <<>> ]]; +win32_splitb(<<Slash,Slash,Rest/binary>>) when ((Slash =:= $\\) orelse (Slash =:= $/)) -> + L = binary:split(Rest,[<<"/">>,<<"\\">>],[global]), + [<<"//">> | [ X || X <- L, X =/= <<>> ]]; win32_splitb(<<Slash,Rest/binary>>) when ((Slash =:= $\\) orelse (Slash =:= $/)) -> L = binary:split(Rest,[<<"/">>,<<"\\">>],[global]), [<<$/>> | [ X || X <- L, X =/= <<>> ]]; @@ -690,6 +738,8 @@ win32_splitb(Name) -> unix_split(Name) -> split(Name, [], unix). +win32_split([Slash,Slash|Rest]) when ((Slash =:= $\\) orelse (Slash =:= $/)) -> + split(Rest, [[$/,$/]], win32); win32_split([$\\|Rest]) -> win32_split([$/|Rest]); win32_split([X, $\\|Rest]) when is_integer(X) -> @@ -1036,10 +1086,10 @@ basedir_linux(Type) -> user_log -> getenv("XDG_CACHE_HOME", ?basedir_linux_user_log, true); site_data -> Base = getenv("XDG_DATA_DIRS",?basedir_linux_site_data,false), - string:tokens(Base,":"); + string:lexemes(Base, ":"); site_config -> Base = getenv("XDG_CONFIG_DIRS",?basedir_linux_site_config,false), - string:tokens(Base,":") + string:lexemes(Base, ":") end. -define(basedir_darwin_user_data, "Library/Application Support"). @@ -1135,3 +1185,72 @@ basedir_os_type() -> {win32,_} -> windows; _ -> linux end. + +%% +%% validate/1 +%% + +-spec validate(FileName) -> boolean() when + FileName :: file:name_all(). + +validate(FileName) when is_binary(FileName) -> + %% Raw filename... + validate_bin(FileName); +validate(FileName) when is_list(FileName); + is_atom(FileName) -> + validate_list(FileName, + file:native_name_encoding(), + os:type()). + +validate_list(FileName, Enc, Os) -> + try + true = validate_list(FileName, Enc, Os, 0) > 0 + catch + _ : _ -> false + end. + +validate_list([], _Enc, _Os, Chars) -> + Chars; +validate_list(C, Enc, Os, Chars) when is_integer(C) -> + validate_char(C, Enc, Os), + Chars+1; +validate_list(A, Enc, Os, Chars) when is_atom(A) -> + validate_list(atom_to_list(A), Enc, Os, Chars); +validate_list([H|T], Enc, Os, Chars) -> + NewChars = validate_list(H, Enc, Os, Chars), + validate_list(T, Enc, Os, NewChars). + +%% C is always an integer... +% validate_char(C, _, _) when not is_integer(C) -> +% throw(invalid); +validate_char(C, _, _) when C < 1 -> + throw(invalid); %% No negative or null characters... +validate_char(C, latin1, _) when C > 255 -> + throw(invalid); +validate_char(C, utf8, _) when C >= 16#110000 -> + throw(invalid); +validate_char(C, utf8, {win32, _}) when C > 16#ffff -> + throw(invalid); %% invalid win wchar... +validate_char(_C, utf8, {win32, _}) -> + ok; %% Range below is accepted on windows... +validate_char(C, utf8, _) when 16#D800 =< C, C =< 16#DFFF -> + throw(invalid); %% invalid unicode range... +validate_char(_, _, _) -> + ok. + +validate_bin(Bin) -> + %% Raw filename. That is, we do not interpret + %% the encoding, but we still do not accept + %% null characters... + try + true = validate_bin(Bin, 0) > 0 + catch + _ : _ -> false + end. + +validate_bin(<<>>, Bs) -> + Bs; +validate_bin(<<0, _Rest/binary>>, _Bs) -> + throw(invalid); %% No null characters allowed... +validate_bin(<<_B, Rest/binary>>, Bs) -> + validate_bin(Rest, Bs+1). diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl index 33af0aed8f..4b1d448487 100644 --- a/lib/stdlib/src/gen.erl +++ b/lib/stdlib/src/gen.erl @@ -49,6 +49,7 @@ | {'logfile', string()}. -type option() :: {'timeout', timeout()} | {'debug', [debug_flag()]} + | {'hibernate_after', timeout()} | {'spawn_opt', [proc_lib:spawn_option()]}. -type options() :: [option()]. diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index 7daa7a9fe4..ac172325b5 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -116,23 +116,27 @@ %%%========================================================================= -callback init(Args :: term()) -> - {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate} | + {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate | {continue, term()}} | {stop, Reason :: term()} | ignore. -callback handle_call(Request :: term(), From :: {pid(), Tag :: term()}, State :: term()) -> {reply, Reply :: term(), NewState :: term()} | - {reply, Reply :: term(), NewState :: term(), timeout() | hibernate} | + {reply, Reply :: term(), NewState :: term(), timeout() | hibernate | {continue, term()}} | {noreply, NewState :: term()} | - {noreply, NewState :: term(), timeout() | hibernate} | + {noreply, NewState :: term(), timeout() | hibernate | {continue, term()}} | {stop, Reason :: term(), Reply :: term(), NewState :: term()} | {stop, Reason :: term(), NewState :: term()}. -callback handle_cast(Request :: term(), State :: term()) -> {noreply, NewState :: term()} | - {noreply, NewState :: term(), timeout() | hibernate} | + {noreply, NewState :: term(), timeout() | hibernate | {continue, term()}} | {stop, Reason :: term(), NewState :: term()}. -callback handle_info(Info :: timeout | term(), State :: term()) -> {noreply, NewState :: term()} | - {noreply, NewState :: term(), timeout() | hibernate} | + {noreply, NewState :: term(), timeout() | hibernate | {continue, term()}} | + {stop, Reason :: term(), NewState :: term()}. +-callback handle_continue(Info :: term(), State :: term()) -> + {noreply, NewState :: term()} | + {noreply, NewState :: term(), timeout() | hibernate | {continue, term()}} | {stop, Reason :: term(), NewState :: term()}. -callback terminate(Reason :: (normal | shutdown | {shutdown, term()} | term()), @@ -149,7 +153,7 @@ Status :: term(). -optional_callbacks( - [handle_info/2, terminate/2, code_change/3, format_status/2]). + [handle_info/2, handle_continue/2, terminate/2, code_change/3, format_status/2]). %%% ----------------------------------------------------------------- %%% Starts a generic server. @@ -309,7 +313,7 @@ enter_loop(Mod, Options, State, ServerName, Timeout) -> Name = gen:get_proc_name(ServerName), Parent = gen:get_parent(), Debug = gen:debug_options(Name, Options), - HibernateAfterTimeout = gen:hibernate_after(Options), + HibernateAfterTimeout = gen:hibernate_after(Options), loop(Parent, Name, State, Mod, Timeout, HibernateAfterTimeout, Debug). %%%======================================================================== @@ -374,6 +378,19 @@ init_it(Mod, Args) -> %%% --------------------------------------------------- %%% The MAIN loop. %%% --------------------------------------------------- + +loop(Parent, Name, State, Mod, {continue, Continue} = Msg, HibernateAfterTimeout, Debug) -> + Reply = try_dispatch(Mod, handle_continue, Continue, State), + case Debug of + [] -> + handle_common_reply(Reply, Parent, Name, undefined, Msg, Mod, + HibernateAfterTimeout, State); + _ -> + Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, Msg), + handle_common_reply(Reply, Parent, Name, undefined, Msg, Mod, + HibernateAfterTimeout, State, Debug1) + end; + loop(Parent, Name, State, Mod, hibernate, HibernateAfterTimeout, Debug) -> proc_lib:hibernate(?MODULE,wake_hib,[Parent, Name, State, Mod, HibernateAfterTimeout, Debug]); diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 1110d18af6..cd6312855d 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -296,7 +296,7 @@ (Reason :: term()). %% Format the callback module state in some sensible that is -%% often condensed way. For StatusOption =:= 'normal' the perferred +%% often condensed way. For StatusOption =:= 'normal' the preferred %% return term is [{data,[{"State",FormattedState}]}], and for %% StatusOption =:= 'terminate' it is just FormattedState. -callback format_status( @@ -510,8 +510,6 @@ call(ServerRef, Request, Timeout) -> parse_timeout(Timeout) -> case Timeout of - {clean_timeout,infinity} -> - {dirty_timeout,infinity}; {clean_timeout,_} -> Timeout; {dirty_timeout,_} -> diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index 9d447418f8..3c8430b820 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -963,7 +963,18 @@ limit_tail(Other, D) -> %% maps:from_list() creates a map with the same internal ordering of %% the selected associations as in Map. limit_map(Map, D) -> - maps:from_list(erts_internal:maps_to_list(Map, D)). + limit_map(maps:iterator(Map), D, []). + +limit_map(_I, 0, Acc) -> + maps:from_list(Acc); +limit_map(I, D, Acc) -> + case maps:next(I) of + {K, V, NextI} -> + limit_map(NextI, D-1, [{K,V} | Acc]); + none -> + maps:from_list(Acc) + end. + %% maps:from_list(limit_map_body(erts_internal:maps_to_list(Map, D), D)). %% limit_map_body(_, 0) -> [{'...', '...'}]; diff --git a/lib/stdlib/src/io_lib_format.erl b/lib/stdlib/src/io_lib_format.erl index 4b2d15c8b3..e345810ca0 100644 --- a/lib/stdlib/src/io_lib_format.erl +++ b/lib/stdlib/src/io_lib_format.erl @@ -380,7 +380,7 @@ float_e(_Fl, {Ds,E}, P) -> {Fs,false} -> [Fs|float_exp(E-1)] end. -%% float_man([Digit], Icount, Dcount) -> {[Chars],CarryFlag}. +%% float_man([Digit], Icount, Dcount) -> {[Char],CarryFlag}. %% Generate the characters in the mantissa from the digits with Icount %% characters before the '.' and Dcount decimals. Handle carry and let %% caller decide what to do at top. @@ -395,7 +395,7 @@ float_man([D|Ds], I, Dc) -> {Cs,false} -> {[D|Cs],false} end; float_man([], I, Dc) -> %Pad with 0's - {string:chars($0, I, [$.|string:chars($0, Dc)]),false}. + {lists:duplicate(I, $0) ++ [$.|lists:duplicate(Dc, $0)],false}. float_man([D|_], 0) when D >= $5 -> {[],true}; float_man([_|_], 0) -> {[],false}; @@ -405,7 +405,7 @@ float_man([D|Ds], Dc) -> {Cs,true} -> {[D+1|Cs],false}; {Cs,false} -> {[D|Cs],false} end; -float_man([], Dc) -> {string:chars($0, Dc),false}. %Pad with 0's +float_man([], Dc) -> {lists:duplicate(Dc, $0),false}. %Pad with 0's %% float_exp(Exponent) -> [Char]. %% Generate the exponent of a floating point number. Always include sign. @@ -429,7 +429,7 @@ fwrite_f(Fl, F, Adj, P, Pad) when P >= 1 -> float_f(Fl, Fd, P) when Fl < 0.0 -> [$-|float_f(-Fl, Fd, P)]; float_f(Fl, {Ds,E}, P) when E =< 0 -> - float_f(Fl, {string:chars($0, -E+1, Ds),1}, P); %Prepend enough 0's + float_f(Fl, {lists:duplicate(-E+1, $0)++Ds,1}, P); %Prepend enough 0's float_f(_Fl, {Ds,E}, P) -> case float_man(Ds, E, P) of {Fs,true} -> "1" ++ Fs; %Handle carry @@ -751,7 +751,7 @@ adjust(Data, Pad, right) -> [Pad|Data]. flat_trunc(List, N) when is_integer(N), N >= 0 -> string:slice(List, 0, N). -%% A deep version of string:chars/2,3 +%% A deep version of lists:duplicate/2 chars(_C, 0) -> []; diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl index 505613b80e..89e1931d2d 100644 --- a/lib/stdlib/src/io_lib_pretty.erl +++ b/lib/stdlib/src/io_lib_pretty.erl @@ -478,9 +478,19 @@ print_length(Term, _D, _RF, _Enc, _Str) -> print_length_map(_Map, 1, _RF, _Enc, _Str) -> {"#{...}", 6}; print_length_map(Map, D, RF, Enc, Str) when is_map(Map) -> - Pairs = print_length_map_pairs(erts_internal:maps_to_list(Map, D), D, RF, Enc, Str), + Pairs = print_length_map_pairs(limit_map(maps:iterator(Map), D, []), D, RF, Enc, Str), {{map, Pairs}, list_length(Pairs, 3)}. +limit_map(_I, 0, Acc) -> + Acc; +limit_map(I, D, Acc) -> + case maps:next(I) of + {K, V, NextI} -> + limit_map(NextI, D-1, [{K,V} | Acc]); + none -> + Acc + end. + print_length_map_pairs([], _D, _RF, _Enc, _Str) -> []; print_length_map_pairs(_Pairs, 1, _RF, _Enc, _Str) -> diff --git a/lib/stdlib/src/lib.erl b/lib/stdlib/src/lib.erl index c6eb0d7915..a7980cc294 100644 --- a/lib/stdlib/src/lib.erl +++ b/lib/stdlib/src/lib.erl @@ -646,7 +646,7 @@ pp_arguments(PF, As, I, Enc) -> Ll = length(L), A = list_to_atom(lists:duplicate(Ll, $a)), S0 = unicode:characters_to_list(PF([A | T], I+1), Enc), - brackets_to_parens([$[,L,string:sub_string(S0, 2+Ll)], Enc); + brackets_to_parens([$[,L,string:slice(S0, 1+Ll)], Enc); _ -> brackets_to_parens(PF(As, I+1), Enc) end. diff --git a/lib/stdlib/src/maps.erl b/lib/stdlib/src/maps.erl index 5dafdb282a..a13f340709 100644 --- a/lib/stdlib/src/maps.erl +++ b/lib/stdlib/src/maps.erl @@ -23,7 +23,8 @@ -export([get/3, filter/2,fold/3, map/2, size/1, update_with/3, update_with/4, - without/2, with/2]). + without/2, with/2, + iterator/1, next/1]). %% BIFs -export([get/2, find/2, from_list/1, @@ -31,6 +32,15 @@ new/0, put/3, remove/2, take/2, to_list/1, update/3, values/1]). +-opaque iterator() :: {term(), term(), iterator()} + | none | nonempty_improper_list(integer(),map()). + +-export_type([iterator/0]). + +-dialyzer({no_improper_lists, iterator/1}). + +-define(IS_ITERATOR(I), is_tuple(I) andalso tuple_size(I) == 3; I == none; is_integer(hd(I)) andalso is_map(tl(I))). + %% Shadowed by erl_bif_types: maps:get/2 -spec get(Key,Map) -> Value when Key :: term(), @@ -39,7 +49,6 @@ get(_,_) -> erlang:nif_error(undef). - -spec find(Key,Map) -> {ok, Value} | error when Key :: term(), Map :: map(), @@ -114,14 +123,20 @@ remove(_,_) -> erlang:nif_error(undef). take(_,_) -> erlang:nif_error(undef). -%% Shadowed by erl_bif_types: maps:to_list/1 -spec to_list(Map) -> [{Key,Value}] when Map :: map(), Key :: term(), Value :: term(). -to_list(_) -> erlang:nif_error(undef). +to_list(Map) when is_map(Map) -> + to_list_internal(erts_internal:map_next(0, Map, [])); +to_list(Map) -> + erlang:error({badmap,Map},[Map]). +to_list_internal([Iter, Map | Acc]) when is_integer(Iter) -> + to_list_internal(erts_internal:map_next(Iter, Map, Acc)); +to_list_internal(Acc) -> + Acc. %% Shadowed by erl_bif_types: maps:update/3 -spec update(Key,Value,Map1) -> Map2 when @@ -192,47 +207,80 @@ get(Key,Map,Default) -> erlang:error({badmap,Map},[Key,Map,Default]). --spec filter(Pred,Map1) -> Map2 when +-spec filter(Pred,MapOrIter) -> Map when Pred :: fun((Key, Value) -> boolean()), Key :: term(), Value :: term(), - Map1 :: map(), - Map2 :: map(). + MapOrIter :: map() | iterator(), + Map :: map(). filter(Pred,Map) when is_function(Pred,2), is_map(Map) -> - maps:from_list([{K,V}||{K,V}<-maps:to_list(Map),Pred(K,V)]); + maps:from_list(filter_1(Pred, iterator(Map))); +filter(Pred,Iterator) when is_function(Pred,2), ?IS_ITERATOR(Iterator) -> + maps:from_list(filter_1(Pred, Iterator)); filter(Pred,Map) -> erlang:error(error_type(Map),[Pred,Map]). - --spec fold(Fun,Init,Map) -> Acc when +filter_1(Pred, Iter) -> + case next(Iter) of + {K, V, NextIter} -> + case Pred(K,V) of + true -> + [{K,V} | filter_1(Pred, NextIter)]; + false -> + filter_1(Pred, NextIter) + end; + none -> + [] + end. + +-spec fold(Fun,Init,MapOrIter) -> Acc when Fun :: fun((K, V, AccIn) -> AccOut), Init :: term(), Acc :: term(), AccIn :: term(), AccOut :: term(), - Map :: map(), + MapOrIter :: map() | iterator(), K :: term(), V :: term(). fold(Fun,Init,Map) when is_function(Fun,3), is_map(Map) -> - lists:foldl(fun({K,V},A) -> Fun(K,V,A) end,Init,maps:to_list(Map)); + fold_1(Fun,Init,iterator(Map)); +fold(Fun,Init,Iterator) when is_function(Fun,3), ?IS_ITERATOR(Iterator) -> + fold_1(Fun,Init,Iterator); fold(Fun,Init,Map) -> erlang:error(error_type(Map),[Fun,Init,Map]). --spec map(Fun,Map1) -> Map2 when +fold_1(Fun, Acc, Iter) -> + case next(Iter) of + {K, V, NextIter} -> + fold_1(Fun, Fun(K,V,Acc), NextIter); + none -> + Acc + end. + +-spec map(Fun,MapOrIter) -> Map when Fun :: fun((K, V1) -> V2), - Map1 :: map(), - Map2 :: map(), + MapOrIter :: map() | iterator(), + Map :: map(), K :: term(), V1 :: term(), V2 :: term(). map(Fun,Map) when is_function(Fun, 2), is_map(Map) -> - maps:from_list([{K,Fun(K,V)}||{K,V}<-maps:to_list(Map)]); + maps:from_list(map_1(Fun, iterator(Map))); +map(Fun,Iterator) when is_function(Fun, 2), ?IS_ITERATOR(Iterator) -> + maps:from_list(map_1(Fun, Iterator)); map(Fun,Map) -> erlang:error(error_type(Map),[Fun,Map]). +map_1(Fun, Iter) -> + case next(Iter) of + {K, V, NextIter} -> + [{K, Fun(K, V)} | map_1(Fun, NextIter)]; + none -> + [] + end. -spec size(Map) -> non_neg_integer() when Map :: map(). @@ -242,6 +290,26 @@ size(Map) when is_map(Map) -> size(Val) -> erlang:error({badmap,Val},[Val]). +-spec iterator(Map) -> Iterator when + Map :: map(), + Iterator :: iterator(). + +iterator(M) when is_map(M) -> [0 | M]; +iterator(M) -> erlang:error({badmap, M}, [M]). + +-spec next(Iterator) -> {Key, Value, NextIterator} | 'none' when + Iterator :: iterator(), + Key :: term(), + Value :: term(), + NextIterator :: iterator(). +next({K, V, I}) -> + {K, V, I}; +next([Path | Map]) when is_integer(Path), is_map(Map) -> + erts_internal:map_next(Path, Map, iterator); +next(none) -> + none; +next(Iter) -> + erlang:error(badarg, [Iter]). -spec without(Ks,Map1) -> Map2 when Ks :: [K], @@ -250,11 +318,10 @@ size(Val) -> K :: term(). without(Ks,M) when is_list(Ks), is_map(M) -> - lists:foldl(fun(K, M1) -> ?MODULE:remove(K, M1) end, M, Ks); + lists:foldl(fun(K, M1) -> maps:remove(K, M1) end, M, Ks); without(Ks,M) -> erlang:error(error_type(M),[Ks,M]). - -spec with(Ks, Map1) -> Map2 when Ks :: [K], Map1 :: map(), @@ -263,17 +330,17 @@ without(Ks,M) -> with(Ks,Map1) when is_list(Ks), is_map(Map1) -> Fun = fun(K, List) -> - case ?MODULE:find(K, Map1) of - {ok, V} -> - [{K, V} | List]; - error -> - List - end - end, - ?MODULE:from_list(lists:foldl(Fun, [], Ks)); + case maps:find(K, Map1) of + {ok, V} -> + [{K, V} | List]; + error -> + List + end + end, + maps:from_list(lists:foldl(Fun, [], Ks)); with(Ks,M) -> erlang:error(error_type(M),[Ks,M]). -error_type(M) when is_map(M) -> badarg; +error_type(M) when is_map(M); ?IS_ITERATOR(M) -> badarg; error_type(V) -> {badmap, V}. diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 5b488cc677..122b476ddb 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -609,6 +609,52 @@ obsolete_1(filename, find_src, 2) -> obsolete_1(erlang, hash, 2) -> {removed, {erlang, phash2, 2}, "20.0"}; +%% Added in OTP-21 +obsolete_1(string, len, 1) -> + {deprecated, "deprecated; use string:length/3 instead"}; +obsolete_1(string, concat, 2) -> + {deprecated, "deprecated; use [Str1,Str2] instead"}; +obsolete_1(string, str, 2) -> + {deprecated, "deprecated; use string:find/2 instead"}; +obsolete_1(string, rstr, 2) -> + {deprecated, "deprecated; use string:find/3 instead"}; +obsolete_1(string, chr, 2) -> + {deprecated, "deprecated; use string:find/2 instead"}; +obsolete_1(string, rchr, 2) -> + {deprecated, "deprecated; use string:find/3 instead"}; +obsolete_1(string, span, 2) -> + {deprecated, "deprecated; use string:take/2 instead"}; +obsolete_1(string, cspan, 2) -> + {deprecated, "deprecated; use string:take/3 instead"}; +obsolete_1(string, substr, _) -> + {deprecated, "deprecated; use string:slice/3 instead"}; +obsolete_1(string, tokens, 2) -> + {deprecated, "deprecated; use string:lexemes/2 instead"}; +obsolete_1(string, chars, _) -> + {deprecated, "deprecated; use lists:duplicate/2 instead"}; +obsolete_1(string, copies, _) -> + {deprecated, "deprecated; use lists:duplicate/2 instead"}; +obsolete_1(string, words, _) -> + {deprecated, "deprecated; use string:lexemes/2 instead"}; +obsolete_1(string, strip, _) -> + {deprecated, "deprecated; use string:trim/3 instead"}; +obsolete_1(string, sub_word, _) -> + {deprecated, "deprecated; use string:nth_lexeme/3 instead"}; +obsolete_1(string, sub_string, _) -> + {deprecated, "deprecated; use string:slice/3 instead"}; +obsolete_1(string, left, _) -> + {deprecated, "deprecated; use string:pad/3 instead"}; +obsolete_1(string, right, _) -> + {deprecated, "deprecated; use string:pad/3 instead"}; +obsolete_1(string, centre, _) -> + {deprecated, "deprecated; use string:pad/3 instead"}; +obsolete_1(string, join, _) -> + {deprecated, "deprecated; use lists:join/2 instead"}; +obsolete_1(string, to_upper, _) -> + {deprecated, "deprecated; use string:uppercase/1 or string:titlecase/1 instead"}; +obsolete_1(string, to_lower, _) -> + {deprecated, "deprecated; use string:lowercase/1 or string:casefold/1 instead"}; + %% not obsolete obsolete_1(_, _, _) -> diff --git a/lib/stdlib/src/pool.erl b/lib/stdlib/src/pool.erl index 05950a1d7c..b12ff205b1 100644 --- a/lib/stdlib/src/pool.erl +++ b/lib/stdlib/src/pool.erl @@ -25,7 +25,7 @@ %% with the least load !!!! %% This function is callable from any node including the master %% That is part of the pool -%% nodes are scheduled on a per usgae basis and per load basis, +%% nodes are scheduled on a per usage basis and per load basis, %% Whenever we use a node, we put at the end of the queue, and whenever %% a node report a change in load, we insert it accordingly @@ -197,7 +197,7 @@ pure_insert({Load,Node},[{L,N}|Tail]) when Load < L -> pure_insert(L,[H|T]) -> [H|pure_insert(L,T)]. %% Really should not measure the contributions from -%% the back ground processes here .... which we do :-( +%% the background processes here .... which we do :-( %% We don't have to monitor the master, since we're slaves anyway statistic_collector() -> @@ -213,7 +213,7 @@ statistic_collector(I) -> stat_loop(M, 999999) end. -%% Do not tell the master about our load if it has not changed +%% Do not tell the master about our load if it has not changed stat_loop(M, Old) -> sleep(2000), diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl index 7a8a5e6d4a..362e98006e 100644 --- a/lib/stdlib/src/rand.erl +++ b/lib/stdlib/src/rand.erl @@ -21,8 +21,8 @@ %% Multiple PRNG module for Erlang/OTP %% Copyright (c) 2015-2016 Kenji Rikitake %% -%% exrop (xoroshiro116+) added and statistical distribution -%% improvements by the Erlang/OTP team 2017 +%% exrop (xoroshiro116+) added, statistical distribution +%% improvements and uniform_real added by the Erlang/OTP team 2017 %% ===================================================================== -module(rand). @@ -30,10 +30,14 @@ -export([seed_s/1, seed_s/2, seed/1, seed/2, export_seed/0, export_seed_s/1, uniform/0, uniform/1, uniform_s/1, uniform_s/2, + uniform_real/0, uniform_real_s/1, jump/0, jump/1, normal/0, normal/2, normal_s/1, normal_s/3 ]). +%% Debug +-export([make_float/3, float2str/1, bc64/1]). + -compile({inline, [exs64_next/1, exsplus_next/1, exs1024_next/1, exs1024_calc/2, exrop_next/1, exrop_next_s/2, @@ -60,6 +64,10 @@ %% N i evaluated 3 times (?BSL((Bits), (X), (N)) bor ((X) bsr ((Bits)-(N))))). +-define( + BC(V, N), + bc((V), ?BIT((N) - 1), N)). + %%-define(TWO_POW_MINUS53, (math:pow(2, -53))). -define(TWO_POW_MINUS53, 1.11022302462515657e-16). @@ -84,14 +92,21 @@ %% The 'bits' field indicates how many bits the integer %% returned from 'next' has got, i.e 'next' shall return %% an random integer in the range 0..(2^Bits - 1). -%% At least 53 bits is required for the floating point -%% producing fallbacks. This field is only used when -%% the 'uniform' or 'uniform_n' fields are not defined. +%% At least 55 bits is required for the floating point +%% producing fallbacks, but 56 bits would be more future proof. %% %% The fields 'next', 'uniform' and 'uniform_n' -%% implement the algorithm. If 'uniform' or 'uinform_n' +%% implement the algorithm. If 'uniform' or 'uniform_n' %% is not present there is a fallback using 'next' and either -%% 'bits' or the deprecated 'max'. +%% 'bits' or the deprecated 'max'. The 'next' function +%% must generate a word with at least 56 good random bits. +%% +%% The 'weak_low_bits' field indicate how many bits are of +%% lesser quality and they will not be used by the floating point +%% producing functions, nor by the range producing functions +%% when more bits are needed, to avoid weak bits in the middle +%% of the generated bits. The lowest bits from the range +%% functions still have the generator's quality. %% -type alg_handler() :: #{type := alg(), @@ -148,11 +163,7 @@ %% For ranges larger than the algorithm bit size uniform_range(Range, #{next:=Next, bits:=Bits} = Alg, R, V) -> - WeakLowBits = - case Alg of - #{weak_low_bits:=WLB} -> WLB; - #{} -> 0 - end, + WeakLowBits = maps:get(weak_low_bits, Alg, 0), %% Maybe waste the lowest bit(s) when shifting in new bits Shift = Bits - WeakLowBits, ShiftMask = bnot ?MASK(WeakLowBits), @@ -297,7 +308,7 @@ uniform_s({#{bits:=Bits, next:=Next} = Alg, R0}) -> {(V bsr (Bits - 53)) * ?TWO_POW_MINUS53, {Alg, R1}}; uniform_s({#{max:=Max, next:=Next} = Alg, R0}) -> {V, R1} = Next(R0), - %% Old broken algorithm with non-uniform density + %% Old algorithm with non-uniform density {V / (Max + 1), {Alg, R1}}. @@ -317,7 +328,7 @@ uniform_s(N, {#{bits:=Bits, next:=Next} = Alg, R0}) ?uniform_range(N, Alg, R1, V, MaxMinusN, I); uniform_s(N, {#{max:=Max, next:=Next} = Alg, R0}) when is_integer(N), 1 =< N -> - %% Old broken algorithm with skewed probability + %% Old algorithm with skewed probability %% and gap in ranges > Max {V, R1} = Next(R0), if @@ -328,6 +339,189 @@ uniform_s(N, {#{max:=Max, next:=Next} = Alg, R0}) {trunc(F * N) + 1, {Alg, R1}} end. +%% uniform_real/0: returns a random float X where 0.0 < X =< 1.0, +%% updating the state in the process dictionary. + +-spec uniform_real() -> X :: float(). +uniform_real() -> + {X, Seed} = uniform_real_s(seed_get()), + _ = seed_put(Seed), + X. + +%% uniform_real_s/1: given a state, uniform_s/1 +%% returns a random float X where 0.0 < X =< 1.0, +%% and a new state. +%% +%% This function does not use the same form of uniformity +%% as the uniform_s/1 function. +%% +%% Instead, this function does not generate numbers with equal +%% distance in the interval, but rather tries to keep all mantissa +%% bits random also for small numbers, meaning that the distance +%% between possible numbers decreases when the numbers +%% approaches 0.0, as does the possibility for a particular +%% number. Hence uniformity is preserved. +%% +%% To generate 56 bits at the time instead of 53 is actually +%% a speed optimization since the probability to have to +%% generate a second word decreases by 1/2 for every extra bit. +%% +%% This function generates normalized numbers, so the smallest number +%% that can be generated is 2^-1022 with the distance 2^-1074 +%% to the next to smallest number, compared to 2^-53 for uniform_s/1. +%% +%% This concept of uniformity should work better for applications +%% where you need to calculate 1.0/X or math:log(X) since those +%% operations benefits from larger precision approaching 0.0, +%% and that this function does not return 0.0 nor denormalized +%% numbers very close to 0.0. The log() operation in The Box-Muller +%% transformation for normal distribution is an example of this. +%% +%%-define(TWO_POW_MINUS55, (math:pow(2, -55))). +%%-define(TWO_POW_MINUS110, (math:pow(2, -110))). +%%-define(TWO_POW_MINUS55, 2.7755575615628914e-17). +%%-define(TWO_POW_MINUS110, 7.7037197775489436e-34). +%% +-spec uniform_real_s(State :: state()) -> {X :: float(), NewState :: state()}. +uniform_real_s({#{bits:=Bits, next:=Next} = Alg, R0}) -> + %% Generate a 56 bit number without using the weak low bits. + %% + %% Be sure to use only 53 bits when multiplying with + %% math:pow(2.0, -N) to avoid rounding which would make + %% "even" floats more probable than "odd". + %% + {V1, R1} = Next(R0), + M1 = V1 bsr (Bits - 56), + if + ?BIT(55) =< M1 -> + %% We have 56 bits - waste 3 + {(M1 bsr 3) * math:pow(2.0, -53), {Alg, R1}}; + ?BIT(54) =< M1 -> + %% We have 55 bits - waste 2 + {(M1 bsr 2) * math:pow(2.0, -54), {Alg, R1}}; + ?BIT(53) =< M1 -> + %% We have 54 bits - waste 1 + {(M1 bsr 1) * math:pow(2.0, -55), {Alg, R1}}; + ?BIT(52) =< M1 -> + %% We have 53 bits - use all + {M1 * math:pow(2.0, -56), {Alg, R1}}; + true -> + %% Need more bits + {V2, R2} = Next(R1), + uniform_real_s(Alg, Next, M1, -56, R2, V2, Bits) + end; +uniform_real_s({#{max:=_, next:=Next} = Alg, R0}) -> + %% Generate a 56 bit number. + %% Ignore the weak low bits for these old algorithms, + %% just produce something reasonable. + %% + %% Be sure to use only 53 bits when multiplying with + %% math:pow(2.0, -N) to avoid rounding which would make + %% "even" floats more probable than "odd". + %% + {V1, R1} = Next(R0), + M1 = ?MASK(56, V1), + if + ?BIT(55) =< M1 -> + %% We have 56 bits - waste 3 + {(M1 bsr 3) * math:pow(2.0, -53), {Alg, R1}}; + ?BIT(54) =< M1 -> + %% We have 55 bits - waste 2 + {(M1 bsr 2) * math:pow(2.0, -54), {Alg, R1}}; + ?BIT(53) =< M1 -> + %% We have 54 bits - waste 1 + {(M1 bsr 1) * math:pow(2.0, -55), {Alg, R1}}; + ?BIT(52) =< M1 -> + %% We have 53 bits - use all + {M1 * math:pow(2.0, -56), {Alg, R1}}; + true -> + %% Need more bits + {V2, R2} = Next(R1), + uniform_real_s(Alg, Next, M1, -56, R2, V2, 56) + end. + +uniform_real_s(Alg, _Next, M0, -1064, R1, V1, Bits) -> % 19*56 + %% This is a very theoretical bottom case. + %% The odds of getting here is about 2^-1008, + %% through a white box test case, or thanks to + %% a malfunctioning PRNG producing 18 56-bit zeros in a row. + %% + %% Fill up to 53 bits, we have at most 52 + B0 = (53 - ?BC(M0, 52)), % Missing bits + {(((M0 bsl B0) bor (V1 bsr (Bits - B0))) * math:pow(2.0, -1064 - B0)), + {Alg, R1}}; +uniform_real_s(Alg, Next, M0, BitNo, R1, V1, Bits) -> + if + %% Optimize the most probable. + %% Fill up to 53 bits. + ?BIT(51) =< M0 -> + %% We have 52 bits in M0 - need 1 + {(((M0 bsl 1) bor (V1 bsr (Bits - 1))) + * math:pow(2.0, BitNo - 1)), + {Alg, R1}}; + ?BIT(50) =< M0 -> + %% We have 51 bits in M0 - need 2 + {(((M0 bsl 2) bor (V1 bsr (Bits - 2))) + * math:pow(2.0, BitNo - 2)), + {Alg, R1}}; + ?BIT(49) =< M0 -> + %% We have 50 bits in M0 - need 3 + {(((M0 bsl 3) bor (V1 bsr (Bits - 3))) + * math:pow(2.0, BitNo - 3)), + {Alg, R1}}; + M0 == 0 -> + M1 = V1 bsr (Bits - 56), + if + ?BIT(55) =< M1 -> + %% We have 56 bits - waste 3 + {(M1 bsr 3) * math:pow(2.0, BitNo - 53), {Alg, R1}}; + ?BIT(54) =< M1 -> + %% We have 55 bits - waste 2 + {(M1 bsr 2) * math:pow(2.0, BitNo - 54), {Alg, R1}}; + ?BIT(53) =< M1 -> + %% We have 54 bits - waste 1 + {(M1 bsr 1) * math:pow(2.0, BitNo - 55), {Alg, R1}}; + ?BIT(52) =< M1 -> + %% We have 53 bits - use all + {M1 * math:pow(2.0, BitNo - 56), {Alg, R1}}; + BitNo =:= -1008 -> + %% Endgame + %% For the last round we can not have 14 zeros or more + %% at the top of M1 because then we will underflow, + %% so we need at least 43 bits + if + ?BIT(42) =< M1 -> + %% We have 43 bits - get the last bits + uniform_real_s(Alg, Next, M1, BitNo - 56, R1); + true -> + %% Would underflow 2^-1022 - start all over + %% + %% We could just crash here since the odds for + %% the PRNG being broken is much higher than + %% for a good PRNG generating this many zeros + %% in a row. Maybe we should write an error + %% report or call this a system limit...? + uniform_real_s({Alg, R1}) + end; + true -> + %% Need more bits + uniform_real_s(Alg, Next, M1, BitNo - 56, R1) + end; + true -> + %% Fill up to 53 bits + B0 = 53 - ?BC(M0, 49), % Number of bits we need to append + {(((M0 bsl B0) bor (V1 bsr (Bits - B0))) + * math:pow(2.0, BitNo - B0)), + {Alg, R1}} + end. +%% +uniform_real_s(#{bits:=Bits} = Alg, Next, M0, BitNo, R0) -> + {V1, R1} = Next(R0), + uniform_real_s(Alg, Next, M0, BitNo, R1, V1, Bits); +uniform_real_s(#{max:=_} = Alg, Next, M0, BitNo, R0) -> + {V1, R1} = Next(R0), + uniform_real_s(Alg, Next, M0, BitNo, R1, ?MASK(56, V1), 56). + %% jump/1: given a state, jump/1 %% returns a new state which is equivalent to that %% after a large number of call defined for each algorithm. @@ -1025,3 +1219,42 @@ normal_fi(Indx) -> 1.0214971439701471e-02,8.6165827693987316e-03,7.0508754713732268e-03, 5.5224032992509968e-03,4.0379725933630305e-03,2.6090727461021627e-03, 1.2602859304985975e-03}). + +%%%bitcount64(0) -> 0; +%%%bitcount64(V) -> 1 + bitcount(V, 64). +%%% +%%%-define( +%%% BITCOUNT(V, N), +%%% bitcount(V, N) -> +%%% if +%%% (1 bsl ((N) bsr 1)) =< (V) -> +%%% ((N) bsr 1) + bitcount((V) bsr ((N) bsr 1), ((N) bsr 1)); +%%% true -> +%%% bitcount((V), ((N) bsr 1)) +%%% end). +%%%?BITCOUNT(V, 64); +%%%?BITCOUNT(V, 32); +%%%?BITCOUNT(V, 16); +%%%?BITCOUNT(V, 8); +%%%?BITCOUNT(V, 4); +%%%?BITCOUNT(V, 2); +%%%bitcount(_, 1) -> 0. + +bc64(V) -> ?BC(V, 64). + +%% Linear from high bit - higher probability first gives faster execution +bc(V, B, N) when B =< V -> N; +bc(V, B, N) -> bc(V, B bsr 1, N - 1). + +make_float(S, E, M) -> + <<F/float>> = <<S:1, E:11, M:52>>, + F. + +float2str(N) -> + <<S:1, E:11, M:52>> = <<(float(N))/float>>, + lists:flatten( + io_lib:format( + "~c~c.~13.16.0bE~b", + [case S of 1 -> $-; 0 -> $+ end, + case E of 0 -> $0; _ -> $1 end, + M, E - 16#3ff])). diff --git a/lib/stdlib/src/slave.erl b/lib/stdlib/src/slave.erl index d7cf6386f5..b3f3206d67 100644 --- a/lib/stdlib/src/slave.erl +++ b/lib/stdlib/src/slave.erl @@ -320,7 +320,7 @@ mk_cmd(Host, Name, Args, Waiter, Prog0) -> %% emulator and flags as the test node. The return from lib:progname() %% could then typically be '/<full_path_to>/cerl -gcov'). quote_progname(Progname) -> - do_quote_progname(string:tokens(to_list(Progname)," ")). + do_quote_progname(string:lexemes(to_list(Progname)," ")). do_quote_progname([Prog]) -> "\""++Prog++"\""; diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index 3c449d3cb9..5fb48acfab 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -101,13 +101,14 @@ timer, unicode, unicode_util, + uri_string, win32reg, zip]}, {registered,[timer_server,rsh_starter,take_over_monitor,pool_master, dets]}, {applications, [kernel]}, {env, []}, - {runtime_dependencies, ["sasl-3.0","kernel-5.0","erts-9.0","crypto-3.3", + {runtime_dependencies, ["sasl-3.0","kernel-6.0","erts-10.0","crypto-3.3", "compiler-5.0"]} ]}. diff --git a/lib/stdlib/src/stdlib.appup.src b/lib/stdlib/src/stdlib.appup.src index 800c2c61f3..e4e3fb83e9 100644 --- a/lib/stdlib/src/stdlib.appup.src +++ b/lib/stdlib/src/stdlib.appup.src @@ -18,9 +18,7 @@ %% %CopyrightEnd% {"%VSN%", %% Up from - max one major revision back - [{<<"3\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* - {<<"3\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-20.* + [{<<"3\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-20.* %% Down to - max one major revision back - [{<<"3\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* - {<<"3\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-20.* + [{<<"3\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-20.* }. diff --git a/lib/stdlib/src/string.erl b/lib/stdlib/src/string.erl index 4972da297d..e01bb7d85e 100644 --- a/lib/stdlib/src/string.erl +++ b/lib/stdlib/src/string.erl @@ -74,19 +74,30 @@ -export([to_upper/1, to_lower/1]). %% -import(lists,[member/2]). - -compile({no_auto_import,[length/1]}). +-compile({inline, [btoken/2, rev/1, append/2, stack/2, search_compile/1]}). +-define(ASCII_LIST(CP1,CP2), CP1 < 256, CP2 < 256, CP1 =/= $\r). -export_type([grapheme_cluster/0]). -type grapheme_cluster() :: char() | [char()]. -type direction() :: 'leading' | 'trailing'. --dialyzer({no_improper_lists, stack/2}). +-dialyzer({no_improper_lists, [stack/2, length_b/3]}). %%% BIFs internal (not documented) should not to be used outside of this module %%% May be removed -export([list_to_float/1, list_to_integer/1]). +-deprecated([{len,1},{concat,2}, + {str,2},{chr,2},{rchr,2},{rstr,2}, + {span,2},{cspan,2},{substr,'_'},{tokens,2}, + {chars,'_'}, + {copies,2},{words,'_'},{strip,'_'}, + {sub_word,'_'},{left,'_'},{right,'_'}, + {sub_string,'_'},{centre,'_'},{join,2}, + {to_upper,1}, {to_lower,1} + ]). + %% Uses bifs: string:list_to_float/1 and string:list_to_integer/1 -spec list_to_float(String) -> {Float, Rest} | {'error', Reason} when String :: string(), @@ -117,8 +128,10 @@ is_empty(_) -> false. %% Count the number of grapheme clusters in chardata -spec length(String::unicode:chardata()) -> non_neg_integer(). +length(<<CP1/utf8, Bin/binary>>) -> + length_b(Bin, CP1, 0); length(CD) -> - length_1(unicode_util:gc(CD), 0). + length_1(CD, 0). %% Convert a string to a list of grapheme clusters -spec to_graphemes(String::unicode:chardata()) -> [grapheme_cluster()]. @@ -166,6 +179,8 @@ equal(A, B, true, Norm) -> %% Reverse grapheme clusters -spec reverse(String::unicode:chardata()) -> [grapheme_cluster()]. +reverse(<<CP1/utf8, Rest/binary>>) -> + reverse_b(Rest, CP1, []); reverse(CD) -> reverse_1(CD, []). @@ -176,7 +191,10 @@ reverse(CD) -> Start :: non_neg_integer(), Slice :: unicode:chardata(). slice(CD, N) when is_integer(N), N >= 0 -> - slice_l(CD, N, is_binary(CD)). + case slice_l0(CD, N) of + [] when is_binary(CD) -> <<>>; + Res -> Res + end. -spec slice(String, Start, Length) -> Slice when String::unicode:chardata(), @@ -185,9 +203,15 @@ slice(CD, N) when is_integer(N), N >= 0 -> Slice :: unicode:chardata(). slice(CD, N, Length) when is_integer(N), N >= 0, is_integer(Length), Length > 0 -> - slice_trail(slice_l(CD, N, is_binary(CD)), Length); + case slice_l0(CD, N) of + [] when is_binary(CD) -> <<>>; + L -> slice_trail(L, Length) + end; slice(CD, N, infinity) -> - slice_l(CD, N, is_binary(CD)); + case slice_l0(CD, N) of + [] when is_binary(CD) -> <<>>; + Res -> Res + end; slice(CD, _, 0) -> case is_binary(CD) of true -> <<>>; @@ -246,18 +270,22 @@ trim(Str, Dir) -> Dir :: direction() | 'both', Characters :: [grapheme_cluster()]. trim(Str, _, []) -> Str; +trim(Str, leading, [Sep]) when is_list(Str), Sep < 256 -> + trim_ls(Str, Sep); trim(Str, leading, Sep) when is_list(Sep) -> - trim_l(Str, search_pattern(Sep)); -trim(Str, trailing, Sep) when is_list(Sep) -> - trim_t(Str, 0, search_pattern(Sep)); -trim(Str, both, Sep0) when is_list(Sep0) -> - Sep = search_pattern(Sep0), - trim_t(trim_l(Str,Sep), 0, Sep). + trim_l(Str, Sep); +trim(Str, trailing, [Sep]) when is_list(Str), Sep < 256 -> + trim_ts(Str, Sep); +trim(Str, trailing, Seps0) when is_list(Seps0) -> + Seps = search_pattern(Seps0), + trim_t(Str, 0, Seps); +trim(Str, both, Sep) when is_list(Sep) -> + trim(trim(Str,leading,Sep), trailing, Sep). %% Delete trailing newlines or \r\n -spec chomp(String::unicode:chardata()) -> unicode:chardata(). chomp(Str) -> - trim_t(Str,0, {[[$\r,$\n],$\n], [$\r,$\n], [<<$\r>>,<<$\n>>]}). + trim(Str, trailing, [[$\r,$\n],$\n]). %% Split String into two parts where the leading part consists of Characters -spec take(String, Characters) -> {Leading, Trailing} when @@ -290,8 +318,7 @@ take(Str, [], Complement, Dir) -> {true, leading} -> {Str, Empty}; {true, trailing} -> {Empty, Str} end; -take(Str, Sep0, false, leading) -> - Sep = search_pattern(Sep0), +take(Str, Sep, false, leading) -> take_l(Str, Sep, []); take(Str, Sep0, true, leading) -> Sep = search_pattern(Sep0), @@ -451,6 +478,7 @@ replace(String, SearchPattern, Replacement, Where) -> SeparatorList::[grapheme_cluster()]) -> [unicode:chardata()]. lexemes([], _) -> []; +lexemes(Str, []) -> [Str]; lexemes(Str, Seps0) when is_list(Seps0) -> Seps = search_pattern(Seps0), lexemes_m(Str, Seps, []). @@ -484,13 +512,13 @@ find(String, SearchPattern, leading) -> find(String, SearchPattern, trailing) -> find_r(String, unicode:characters_to_list(SearchPattern), nomatch). -%% Fetch first codepoint and return rest in tail +%% Fetch first grapheme cluster and return rest in tail -spec next_grapheme(String::unicode:chardata()) -> maybe_improper_list(grapheme_cluster(),unicode:chardata()) | {error,unicode:chardata()}. next_grapheme(CD) -> unicode_util:gc(CD). -%% Fetch first grapheme cluster and return rest in tail +%% Fetch first codepoint and return rest in tail -spec next_codepoint(String::unicode:chardata()) -> maybe_improper_list(char(),unicode:chardata()) | {error,unicode:chardata()}. @@ -498,10 +526,23 @@ next_codepoint(CD) -> unicode_util:cp(CD). %% Internals -length_1([_|Rest], N) -> - length_1(unicode_util:gc(Rest), N+1); -length_1([], N) -> - N. +length_1([CP1|[CP2|_]=Cont], N) when ?ASCII_LIST(CP1,CP2) -> + length_1(Cont, N+1); +length_1(Str, N) -> + case unicode_util:gc(Str) of + [] -> N; + [_|Rest] -> length_1(Rest, N+1) + end. + +length_b(<<CP2/utf8, Rest/binary>>, CP1, N) + when ?ASCII_LIST(CP1,CP2) -> + length_b(Rest, CP2, N+1); +length_b(Bin0, CP1, N) -> + [_|Bin1] = unicode_util:gc([CP1|Bin0]), + case unicode_util:cp(Bin1) of + [] -> N+1; + [CP3|Bin] -> length_b(Bin, CP3, N+1) + end. equal_1([A|AR], [B|BR]) when is_integer(A), is_integer(B) -> A =:= B andalso equal_1(AR, BR); @@ -540,29 +581,66 @@ equal_norm_nocase(A0, B0, Norm) -> {L1,L2} when is_list(L1), is_list(L2) -> false end. +reverse_1([CP1|[CP2|_]=Cont], Acc) when ?ASCII_LIST(CP1,CP2) -> + reverse_1(Cont, [CP1|Acc]); reverse_1(CD, Acc) -> case unicode_util:gc(CD) of [GC|Rest] -> reverse_1(Rest, [GC|Acc]); [] -> Acc end. -slice_l(CD, N, Binary) when N > 0 -> +reverse_b(<<CP2/utf8, Rest/binary>>, CP1, Acc) + when ?ASCII_LIST(CP1,CP2) -> + reverse_b(Rest, CP2, [CP1|Acc]); +reverse_b(Bin0, CP1, Acc) -> + [GC|Bin1] = unicode_util:gc([CP1|Bin0]), + case unicode_util:cp(Bin1) of + [] -> [GC|Acc]; + [CP3|Bin] -> reverse_b(Bin, CP3, [GC|Acc]) + end. + +slice_l0(<<CP1/utf8, Bin/binary>>, N) when N > 0 -> + slice_lb(Bin, CP1, N); +slice_l0(L, N) -> + slice_l(L, N). + +slice_l([CP1|[CP2|_]=Cont], N) when ?ASCII_LIST(CP1,CP2),N > 0 -> + slice_l(Cont, N-1); +slice_l(CD, N) when N > 0 -> case unicode_util:gc(CD) of - [_|Cont] -> slice_l(Cont, N-1, Binary); - [] when Binary -> <<>>; + [_|Cont] -> slice_l(Cont, N-1); [] -> [] end; -slice_l(Cont, 0, Binary) -> - case is_empty(Cont) of - true when Binary -> <<>>; - _ -> Cont +slice_l(Cont, 0) -> + Cont. + +slice_lb(<<CP2/utf8, Bin/binary>>, CP1, N) when ?ASCII_LIST(CP1,CP2), N > 1 -> + slice_lb(Bin, CP2, N-1); +slice_lb(Bin, CP1, N) -> + [_|Rest] = unicode_util:gc([CP1|Bin]), + if N > 1 -> + case unicode_util:cp(Rest) of + [CP2|Cont] -> slice_lb(Cont, CP2, N-1); + [] -> <<>> + end; + N =:= 1 -> + Rest end. +slice_trail(Orig, N) when is_binary(Orig) -> + case Orig of + <<CP1/utf8, Bin/binary>> when N > 0 -> + Length = slice_bin(Bin, CP1, N), + Sz = byte_size(Orig) - Length, + <<Keep:Sz/binary, _/binary>> = Orig, + Keep; + _ -> <<>> + end; slice_trail(CD, N) when is_list(CD) -> - slice_list(CD, N); -slice_trail(CD, N) when is_binary(CD) -> - slice_bin(CD, N, CD). + slice_list(CD, N). +slice_list([CP1|[CP2|_]=Cont], N) when ?ASCII_LIST(CP1,CP2),N > 0 -> + [CP1|slice_list(Cont, N-1)]; slice_list(CD, N) when N > 0 -> case unicode_util:gc(CD) of [GC|Cont] -> append(GC, slice_list(Cont, N-1)); @@ -571,17 +649,16 @@ slice_list(CD, N) when N > 0 -> slice_list(_, 0) -> []. -slice_bin(CD, N, Orig) when N > 0 -> - case unicode_util:gc(CD) of - [_|Cont] -> slice_bin(Cont, N-1, Orig); - [] -> Orig +slice_bin(<<CP2/utf8, Bin/binary>>, CP1, N) when ?ASCII_LIST(CP1,CP2), N > 0 -> + slice_bin(Bin, CP2, N-1); +slice_bin(CD, CP1, N) when N > 0 -> + [_|Bin] = unicode_util:gc([CP1|CD]), + case unicode_util:cp(Bin) of + [CP2|Cont] -> slice_bin(Cont, CP2, N-1); + [] -> 0 end; -slice_bin([], 0, Orig) -> - Orig; -slice_bin(CD, 0, Orig) -> - Sz = byte_size(Orig) - byte_size(CD), - <<Keep:Sz/binary, _/binary>> = Orig, - Keep. +slice_bin(CD, CP1, 0) -> + byte_size(CD)+byte_size(<<CP1/utf8>>). uppercase_list(CPs0) -> case unicode_util:uppercase(CPs0) of @@ -631,16 +708,31 @@ casefold_bin(CPs0, Acc) -> [] -> Acc end. - +%% Fast path for ascii searching for one character in lists +trim_ls([CP1|[CP2|_]=Cont]=Str, Sep) + when ?ASCII_LIST(CP1,CP2) -> + case Sep of + CP1 -> trim_ls(Cont, Sep); + _ -> Str + end; +trim_ls(Str, Sep) -> + trim_l(Str, [Sep]). + +trim_l([CP1|[CP2|_]=Cont]=Str, Sep) + when ?ASCII_LIST(CP1,CP2) -> + case lists:member(CP1, Sep) of + true -> trim_l(Cont, Sep); + false -> Str + end; trim_l([Bin|Cont0], Sep) when is_binary(Bin) -> case bin_search_inv(Bin, Cont0, Sep) of {nomatch, Cont} -> trim_l(Cont, Sep); Keep -> Keep end; -trim_l(Str, {GCs, _, _}=Sep) when is_list(Str) -> +trim_l(Str, Sep) when is_list(Str) -> case unicode_util:gc(Str) of [C|Cs] -> - case lists:member(C, GCs) of + case lists:member(C, Sep) of true -> trim_l(Cs, Sep); false -> Str end; @@ -652,15 +744,51 @@ trim_l(Bin, Sep) when is_binary(Bin) -> [Keep] -> Keep end. -trim_t([Bin|Cont0], N, Sep) when is_binary(Bin) -> +%% Fast path for ascii searching for one character in lists +trim_ts([Sep|Cs1]=Str, Sep) -> + case Cs1 of + [] -> []; + [CP2|_] when ?ASCII_LIST(Sep,CP2) -> + Tail = trim_ts(Cs1, Sep), + case is_empty(Tail) of + true -> []; + false -> [Sep|Tail] + end; + _ -> + trim_t(Str, 0, search_pattern([Sep])) + end; +trim_ts([CP|Cont],Sep) when is_integer(CP) -> + [CP|trim_ts(Cont, Sep)]; +trim_ts(Str, Sep) -> + trim_t(Str, 0, search_pattern([Sep])). + +trim_t([CP1|Cont]=Cs0, _, {GCs,CPs,_}=Seps) when is_integer(CP1) -> + case lists:member(CP1, CPs) of + true -> + [GC|Cs1] = unicode_util:gc(Cs0), + case lists:member(GC, GCs) of + true -> + Tail = trim_t(Cs1, 0, Seps), + case is_empty(Tail) of + true -> []; + false -> append(GC,Tail) + end; + false -> + append(GC,trim_t(Cs1, 0, Seps)) + end; + false -> + [CP1|trim_t(Cont, 0, Seps)] + end; +trim_t([Bin|Cont0], N, {GCs,_,_}=Seps0) when is_binary(Bin) -> <<_:N/binary, Rest/binary>> = Bin, - case bin_search(Rest, Cont0, Sep) of + Seps = search_compile(Seps0), + case bin_search(Rest, Cont0, Seps) of {nomatch,_} -> - stack(Bin, trim_t(Cont0, 0, Sep)); + stack(Bin, trim_t(Cont0, 0, Seps)); [SepStart|Cont1] -> - case bin_search_inv(SepStart, Cont1, Sep) of + case bin_search_inv(SepStart, Cont1, GCs) of {nomatch, Cont} -> - Tail = trim_t(Cont, 0, Sep), + Tail = trim_t(Cont, 0, Seps), case is_empty(Tail) of true -> KeepSz = byte_size(Bin) - byte_size(SepStart), @@ -672,67 +800,69 @@ trim_t([Bin|Cont0], N, Sep) when is_binary(Bin) -> end; [NonSep|Cont] when is_binary(NonSep) -> KeepSz = byte_size(Bin) - byte_size(NonSep), - trim_t([Bin|Cont], KeepSz, Sep) + trim_t([Bin|Cont], KeepSz, Seps) end end; -trim_t(Str, 0, {GCs,CPs,_}=Sep) when is_list(Str) -> - case unicode_util:cp(Str) of - [CP|Cs] -> - case lists:member(CP, CPs) of +trim_t(Str, 0, {GCs,_,_}=Seps) when is_list(Str) -> + case unicode_util:gc(Str) of + [GC|Cs1] -> + case lists:member(GC, GCs) of true -> - [GC|Cs1] = unicode_util:gc(Str), - case lists:member(GC, GCs) of - true -> - Tail = trim_t(Cs1, 0, Sep), - case is_empty(Tail) of - true -> []; - false -> append(GC,Tail) - end; - false -> - append(GC,trim_t(Cs1, 0, Sep)) + Tail = trim_t(Cs1, 0, Seps), + case is_empty(Tail) of + true -> []; + false -> append(GC,Tail) end; false -> - append(CP,trim_t(Cs, 0, Sep)) + append(GC,trim_t(Cs1, 0, Seps)) end; [] -> [] end; -trim_t(Bin, N, Sep) when is_binary(Bin) -> +trim_t(Bin, N, {GCs,_,_}=Seps0) when is_binary(Bin) -> <<_:N/binary, Rest/binary>> = Bin, - case bin_search(Rest, Sep) of + Seps = search_compile(Seps0), + case bin_search(Rest, [], Seps) of {nomatch,_} -> Bin; [SepStart] -> - case bin_search_inv(SepStart, [], Sep) of + case bin_search_inv(SepStart, [], GCs) of {nomatch,_} -> KeepSz = byte_size(Bin) - byte_size(SepStart), <<Keep:KeepSz/binary, _/binary>> = Bin, Keep; [NonSep] -> KeepSz = byte_size(Bin) - byte_size(NonSep), - trim_t(Bin, KeepSz, Sep) + trim_t(Bin, KeepSz, Seps) end end. -take_l([Bin|Cont0], Sep, Acc) when is_binary(Bin) -> - case bin_search_inv(Bin, Cont0, Sep) of + +take_l([CP1|[CP2|_]=Cont]=Str, Seps, Acc) + when ?ASCII_LIST(CP1,CP2) -> + case lists:member(CP1, Seps) of + true -> take_l(Cont, Seps, [CP1|Acc]); + false -> {rev(Acc), Str} + end; +take_l([Bin|Cont0], Seps, Acc) when is_binary(Bin) -> + case bin_search_inv(Bin, Cont0, Seps) of {nomatch, Cont} -> Used = cp_prefix(Cont0, Cont), - take_l(Cont, Sep, [unicode:characters_to_binary([Bin|Used])|Acc]); + take_l(Cont, Seps, [unicode:characters_to_binary([Bin|Used])|Acc]); [Bin1|_]=After when is_binary(Bin1) -> First = byte_size(Bin) - byte_size(Bin1), <<Keep:First/binary, _/binary>> = Bin, {btoken(Keep,Acc), After} end; -take_l(Str, {GCs, _, _}=Sep, Acc) when is_list(Str) -> +take_l(Str, Seps, Acc) when is_list(Str) -> case unicode_util:gc(Str) of [C|Cs] -> - case lists:member(C, GCs) of - true -> take_l(Cs, Sep, append(rev(C),Acc)); + case lists:member(C, Seps) of + true -> take_l(Cs, Seps, append(rev(C),Acc)); false -> {rev(Acc), Str} end; [] -> {rev(Acc), []} end; -take_l(Bin, Sep, Acc) when is_binary(Bin) -> - case bin_search_inv(Bin, [], Sep) of +take_l(Bin, Seps, Acc) when is_binary(Bin) -> + case bin_search_inv(Bin, [], Seps) of {nomatch,_} -> {btoken(Bin, Acc), <<>>}; [After] -> @@ -741,27 +871,41 @@ take_l(Bin, Sep, Acc) when is_binary(Bin) -> {btoken(Keep, Acc), After} end. -take_lc([Bin|Cont0], Sep, Acc) when is_binary(Bin) -> - case bin_search(Bin, Cont0, Sep) of + +take_lc([CP1|Cont]=Str0, {GCs,CPs,_}=Seps, Acc) when is_integer(CP1) -> + case lists:member(CP1, CPs) of + true -> + [GC|Str] = unicode_util:gc(Str0), + case lists:member(GC, GCs) of + false -> take_lc(Str, Seps, append(rev(GC),Acc)); + true -> {rev(Acc), Str0} + end; + false -> + take_lc(Cont, Seps, append(CP1,Acc)) + end; +take_lc([Bin|Cont0], Seps0, Acc) when is_binary(Bin) -> + Seps = search_compile(Seps0), + case bin_search(Bin, Cont0, Seps) of {nomatch, Cont} -> Used = cp_prefix(Cont0, Cont), - take_lc(Cont, Sep, [unicode:characters_to_binary([Bin|Used])|Acc]); + take_lc(Cont, Seps, [unicode:characters_to_binary([Bin|Used])|Acc]); [Bin1|_]=After when is_binary(Bin1) -> First = byte_size(Bin) - byte_size(Bin1), <<Keep:First/binary, _/binary>> = Bin, {btoken(Keep,Acc), After} end; -take_lc(Str, {GCs, _, _}=Sep, Acc) when is_list(Str) -> +take_lc(Str, {GCs,_,_}=Seps, Acc) when is_list(Str) -> case unicode_util:gc(Str) of [C|Cs] -> case lists:member(C, GCs) of - false -> take_lc(Cs, Sep, append(rev(C),Acc)); + false -> take_lc(Cs, Seps, append(rev(C),Acc)); true -> {rev(Acc), Str} end; [] -> {rev(Acc), []} end; -take_lc(Bin, Sep, Acc) when is_binary(Bin) -> - case bin_search(Bin, [], Sep) of +take_lc(Bin, Seps0, Acc) when is_binary(Bin) -> + Seps = search_compile(Seps0), + case bin_search(Bin, [], Seps) of {nomatch,_} -> {btoken(Bin, Acc), <<>>}; [After] -> @@ -770,148 +914,192 @@ take_lc(Bin, Sep, Acc) when is_binary(Bin) -> {btoken(Keep, Acc), After} end. -take_t([Bin|Cont0], N, Sep) when is_binary(Bin) -> + +take_t([CP1|Cont]=Str0, _, {GCs,CPs,_}=Seps) when is_integer(CP1) -> + case lists:member(CP1, CPs) of + true -> + [GC|Str] = unicode_util:gc(Str0), + case lists:member(GC, GCs) of + true -> + {Head, Tail} = take_t(Str, 0, Seps), + case is_empty(Head) of + true -> {Head, append(GC,Tail)}; + false -> {append(GC,Head), Tail} + end; + false -> + {Head, Tail} = take_t(Str, 0, Seps), + {append(GC,Head), Tail} + end; + false -> + {Head, Tail} = take_t(Cont, 0, Seps), + {[CP1|Head], Tail} + end; +take_t([Bin|Cont0], N, {GCs,_,_}=Seps0) when is_binary(Bin) -> <<_:N/binary, Rest/binary>> = Bin, - case bin_search(Rest, Cont0, Sep) of + Seps = search_compile(Seps0), + case bin_search(Rest, Cont0, Seps) of {nomatch,Cont} -> Used = cp_prefix(Cont0, Cont), - {Head, Tail} = take_t(Cont, 0, Sep), + {Head, Tail} = take_t(Cont, 0, Seps), {stack(unicode:characters_to_binary([Bin|Used]), Head), Tail}; [SepStart|Cont1] -> - case bin_search_inv(SepStart, Cont1, Sep) of + case bin_search_inv(SepStart, Cont1, GCs) of {nomatch, Cont} -> - {Head, Tail} = take_t(Cont, 0, Sep), + {Head, Tail} = take_t(Cont, 0, Seps), Used = cp_prefix(Cont0, Cont), - case equal(Tail, Cont) of + case is_empty(Head) of true -> KeepSz = byte_size(Bin) - byte_size(SepStart), <<Keep:KeepSz/binary, End/binary>> = Bin, - {stack(Keep,Head), stack(stack(End,Used),Tail)}; + {Keep, stack(stack(End,Used),Tail)}; false -> {stack(unicode:characters_to_binary([Bin|Used]),Head), Tail} end; [NonSep|Cont] when is_binary(NonSep) -> KeepSz = byte_size(Bin) - byte_size(NonSep), - take_t([Bin|Cont], KeepSz, Sep) + take_t([Bin|Cont], KeepSz, Seps) end end; -take_t(Str, 0, {GCs,CPs,_}=Sep) when is_list(Str) -> - case unicode_util:cp(Str) of - [CP|Cs] -> - case lists:member(CP, CPs) of +take_t(Str, 0, {GCs,_,_}=Seps) when is_list(Str) -> + case unicode_util:gc(Str) of + [GC|Cs1] -> + case lists:member(GC, GCs) of true -> - [GC|Cs1] = unicode_util:gc(Str), - case lists:member(GC, GCs) of - true -> - {Head, Tail} = take_t(Cs1, 0, Sep), - case equal(Tail, Cs1) of - true -> {Head, append(GC,Tail)}; - false -> {append(GC,Head), Tail} - end; - false -> - {Head, Tail} = take_t(Cs, 0, Sep), - {append(CP,Head), Tail} + {Head, Tail} = take_t(Cs1, 0, Seps), + case is_empty(Head) of + true -> {Head, append(GC,Tail)}; + false -> {append(GC,Head), Tail} end; false -> - {Head, Tail} = take_t(Cs, 0, Sep), - {append(CP,Head), Tail} + {Head, Tail} = take_t(Cs1, 0, Seps), + {append(GC,Head), Tail} end; [] -> {[],[]} end; -take_t(Bin, N, Sep) when is_binary(Bin) -> +take_t(Bin, N, {GCs,_,_}=Seps0) when is_binary(Bin) -> <<_:N/binary, Rest/binary>> = Bin, - case bin_search(Rest, Sep) of + Seps = search_compile(Seps0), + case bin_search(Rest, [], Seps) of {nomatch,_} -> {Bin, <<>>}; [SepStart] -> - case bin_search_inv(SepStart, [], Sep) of + case bin_search_inv(SepStart, [], GCs) of {nomatch,_} -> KeepSz = byte_size(Bin) - byte_size(SepStart), <<Before:KeepSz/binary, End/binary>> = Bin, {Before, End}; [NonSep] -> KeepSz = byte_size(Bin) - byte_size(NonSep), - take_t(Bin, KeepSz, Sep) + take_t(Bin, KeepSz, Seps) end end. -take_tc([Bin|Cont0], N, Sep) when is_binary(Bin) -> +take_tc([CP1|[CP2|_]=Cont], _, {GCs,_,_}=Seps) when ?ASCII_LIST(CP1,CP2) -> + case lists:member(CP1, GCs) of + false -> + {Head, Tail} = take_tc(Cont, 0, Seps), + case is_empty(Head) of + true -> {Head, append(CP1,Tail)}; + false -> {append(CP1,Head), Tail} + end; + true -> + {Head, Tail} = take_tc(Cont, 0, Seps), + {append(CP1,Head), Tail} + end; +take_tc([Bin|Cont0], N, {GCs,_,_}=Seps0) when is_binary(Bin) -> <<_:N/binary, Rest/binary>> = Bin, - case bin_search_inv(Rest, Cont0, Sep) of + case bin_search_inv(Rest, Cont0, GCs) of {nomatch,Cont} -> Used = cp_prefix(Cont0, Cont), - {Head, Tail} = take_tc(Cont, 0, Sep), + {Head, Tail} = take_tc(Cont, 0, Seps0), {stack(unicode:characters_to_binary([Bin|Used]), Head), Tail}; [SepStart|Cont1] -> - case bin_search(SepStart, Cont1, Sep) of + Seps = search_compile(Seps0), + case bin_search(SepStart, Cont1, Seps) of {nomatch, Cont} -> - {Head, Tail} = take_tc(Cont, 0, Sep), + {Head, Tail} = take_tc(Cont, 0, Seps), Used = cp_prefix(Cont0, Cont), - case equal(Tail, Cont) of + case is_empty(Head) of true -> KeepSz = byte_size(Bin) - byte_size(SepStart), <<Keep:KeepSz/binary, End/binary>> = Bin, - {stack(Keep,Head), stack(stack(End,Used),Tail)}; + {Keep, stack(stack(End,Used),Tail)}; false -> {stack(unicode:characters_to_binary([Bin|Used]),Head), Tail} end; [NonSep|Cont] when is_binary(NonSep) -> KeepSz = byte_size(Bin) - byte_size(NonSep), - take_tc([Bin|Cont], KeepSz, Sep) + take_tc([Bin|Cont], KeepSz, Seps) end end; -take_tc(Str, 0, {GCs,CPs,_}=Sep) when is_list(Str) -> - case unicode_util:cp(Str) of - [CP|Cs] -> - case lists:member(CP, CPs) of - true -> - [GC|Cs1] = unicode_util:gc(Str), - case lists:member(GC, GCs) of - false -> - {Head, Tail} = take_tc(Cs1, 0, Sep), - case equal(Tail, Cs1) of - true -> {Head, append(GC,Tail)}; - false -> {append(GC,Head), Tail} - end; - true -> - {Head, Tail} = take_tc(Cs1, 0, Sep), - {append(GC,Head), Tail} - end; +take_tc(Str, 0, {GCs,_,_}=Seps) when is_list(Str) -> + case unicode_util:gc(Str) of + [GC|Cs1] -> + case lists:member(GC, GCs) of false -> - {Head, Tail} = take_tc(Cs, 0, Sep), - case equal(Tail, Cs) of - true -> {Head, append(CP,Tail)}; - false -> {append(CP,Head), Tail} - end + {Head, Tail} = take_tc(Cs1, 0, Seps), + case is_empty(Head) of + true -> {Head, append(GC,Tail)}; + false -> {append(GC,Head), Tail} + end; + true -> + {Head, Tail} = take_tc(Cs1, 0, Seps), + {append(GC,Head), Tail} end; [] -> {[],[]} end; -take_tc(Bin, N, Sep) when is_binary(Bin) -> +take_tc(Bin, N, {GCs,_,_}=Seps0) when is_binary(Bin) -> <<_:N/binary, Rest/binary>> = Bin, - case bin_search_inv(Rest, [], Sep) of + case bin_search_inv(Rest, [], GCs) of {nomatch,_} -> {Bin, <<>>}; [SepStart] -> - case bin_search(SepStart, [], Sep) of + Seps = search_compile(Seps0), + case bin_search(SepStart, [], Seps) of {nomatch,_} -> KeepSz = byte_size(Bin) - byte_size(SepStart), <<Before:KeepSz/binary, End/binary>> = Bin, {Before, End}; [NonSep] -> KeepSz = byte_size(Bin) - byte_size(NonSep), - take_tc(Bin, KeepSz, Sep) + take_tc(Bin, KeepSz, Seps) end end. -prefix_1(Cs, []) -> Cs; -prefix_1(Cs, [_]=Pre) -> - prefix_2(unicode_util:gc(Cs), Pre); -prefix_1(Cs, Pre) -> - prefix_2(unicode_util:cp(Cs), Pre). - -prefix_2([C|Cs], [C|Pre]) -> - prefix_1(Cs, Pre); -prefix_2(_, _) -> - nomatch. +prefix_1(Cs0, [GC]) -> + case unicode_util:gc(Cs0) of + [GC|Cs] -> Cs; + _ -> nomatch + end; +prefix_1([CP|Cs], [Pre|PreR]) when is_integer(CP) -> + case CP =:= Pre of + true -> prefix_1(Cs,PreR); + false -> nomatch + end; +prefix_1(<<CP/utf8, Cs/binary>>, [Pre|PreR]) -> + case CP =:= Pre of + true -> prefix_1(Cs,PreR); + false -> nomatch + end; +prefix_1(Cs0, [Pre|PreR]) -> + case unicode_util:cp(Cs0) of + [Pre|Cs] -> prefix_1(Cs,PreR); + _ -> nomatch + end. +split_1([CP1|Cs]=Cs0, [C|_]=Needle, _, Where, Curr, Acc) when is_integer(CP1) -> + case CP1=:=C of + true -> + case prefix_1(Cs0, Needle) of + nomatch -> split_1(Cs, Needle, 0, Where, append(C,Curr), Acc); + Rest when Where =:= leading -> + [rev(Curr), Rest]; + Rest when Where =:= trailing -> + split_1(Cs, Needle, 0, Where, [C|Curr], [rev(Curr), Rest]); + Rest when Where =:= all -> + split_1(Rest, Needle, 0, Where, [], [rev(Curr)|Acc]) + end; + false -> + split_1(Cs, Needle, 0, Where, append(CP1,Curr), Acc) + end; split_1([Bin|Cont0], Needle, Start, Where, Curr0, Acc) when is_binary(Bin) -> case bin_search_str(Bin, Start, Cont0, Needle) of @@ -971,32 +1159,50 @@ split_1(Bin, [_C|_]=Needle, Start, Where, Curr0, Acc) -> end end. -lexemes_m([Bin|Cont0], Seps, Ts) when is_binary(Bin) -> - case bin_search_inv(Bin, Cont0, Seps) of +lexemes_m([CP|_]=Cs0, {GCs,CPs,_}=Seps, Ts) when is_integer(CP) -> + case lists:member(CP, CPs) of + true -> + [GC|Cs2] = unicode_util:gc(Cs0), + case lists:member(GC, GCs) of + true -> + lexemes_m(Cs2, Seps, Ts); + false -> + {Lexeme,Rest} = lexeme_pick(Cs0, Seps, []), + lexemes_m(Rest, Seps, [Lexeme|Ts]) + end; + false -> + {Lexeme,Rest} = lexeme_pick(Cs0, Seps, []), + lexemes_m(Rest, Seps, [Lexeme|Ts]) + end; +lexemes_m([Bin|Cont0], {GCs,_,_}=Seps0, Ts) when is_binary(Bin) -> + case bin_search_inv(Bin, Cont0, GCs) of {nomatch,Cont} -> - lexemes_m(Cont, Seps, Ts); + lexemes_m(Cont, Seps0, Ts); Cs -> + Seps = search_compile(Seps0), {Lexeme,Rest} = lexeme_pick(Cs, Seps, []), lexemes_m(Rest, Seps, [Lexeme|Ts]) end; -lexemes_m(Cs0, {GCs, _, _}=Seps, Ts) when is_list(Cs0) -> +lexemes_m(Cs0, {GCs, _, _}=Seps0, Ts) when is_list(Cs0) -> case unicode_util:gc(Cs0) of [C|Cs] -> case lists:member(C, GCs) of true -> - lexemes_m(Cs, Seps, Ts); + lexemes_m(Cs, Seps0, Ts); false -> + Seps = search_compile(Seps0), {Lexeme,Rest} = lexeme_pick(Cs0, Seps, []), lexemes_m(Rest, Seps, [Lexeme|Ts]) end; [] -> lists:reverse(Ts) end; -lexemes_m(Bin, Seps, Ts) when is_binary(Bin) -> - case bin_search_inv(Bin, [], Seps) of +lexemes_m(Bin, {GCs,_,_}=Seps0, Ts) when is_binary(Bin) -> + case bin_search_inv(Bin, [], GCs) of {nomatch,_} -> lists:reverse(Ts); [Cs] -> + Seps = search_compile(Seps0), {Lexeme,Rest} = lexeme_pick(Cs, Seps, []), lexemes_m(Rest, Seps, add_non_empty(Lexeme,Ts)) end. @@ -1027,7 +1233,7 @@ lexeme_pick(Cs0, {GCs, CPs, _} = Seps, Tkn) when is_list(Cs0) -> true -> [GC|Cs2] = unicode_util:gc(Cs0), case lists:member(GC, GCs) of - true -> {rev(Tkn), Cs0}; + true -> {rev(Tkn), Cs2}; false -> lexeme_pick(Cs2, Seps, append(rev(GC),Tkn)) end; false -> @@ -1037,7 +1243,7 @@ lexeme_pick(Cs0, {GCs, CPs, _} = Seps, Tkn) when is_list(Cs0) -> {rev(Tkn), []} end; lexeme_pick(Bin, Seps, Tkn) when is_binary(Bin) -> - case bin_search(Bin, Seps) of + case bin_search(Bin, [], Seps) of {nomatch,_} -> {btoken(Bin,Tkn), []}; [Left] -> @@ -1046,35 +1252,38 @@ lexeme_pick(Bin, Seps, Tkn) when is_binary(Bin) -> {btoken(Lexeme, Tkn), Left} end. -nth_lexeme_m([Bin|Cont0], Seps, N) when is_binary(Bin) -> - case bin_search_inv(Bin, Cont0, Seps) of +nth_lexeme_m([Bin|Cont0], {GCs,_,_}=Seps0, N) when is_binary(Bin) -> + case bin_search_inv(Bin, Cont0, GCs) of {nomatch,Cont} -> - nth_lexeme_m(Cont, Seps, N); + nth_lexeme_m(Cont, Seps0, N); Cs when N > 1 -> - Rest = lexeme_skip(Cs, Seps), - nth_lexeme_m(Rest, Seps, N-1); + Rest = lexeme_skip(Cs, Seps0), + nth_lexeme_m(Rest, Seps0, N-1); Cs -> + Seps = search_compile(Seps0), {Lexeme,_} = lexeme_pick(Cs, Seps, []), Lexeme end; -nth_lexeme_m(Cs0, {GCs, _, _}=Seps, N) when is_list(Cs0) -> +nth_lexeme_m(Cs0, {GCs, _, _}=Seps0, N) when is_list(Cs0) -> case unicode_util:gc(Cs0) of [C|Cs] -> case lists:member(C, GCs) of true -> - nth_lexeme_m(Cs, Seps, N); + nth_lexeme_m(Cs, Seps0, N); false when N > 1 -> - Cs1 = lexeme_skip(Cs, Seps), - nth_lexeme_m(Cs1, Seps, N-1); + Cs1 = lexeme_skip(Cs, Seps0), + nth_lexeme_m(Cs1, Seps0, N-1); false -> + Seps = search_compile(Seps0), {Lexeme,_} = lexeme_pick(Cs0, Seps, []), Lexeme end; [] -> [] end; -nth_lexeme_m(Bin, Seps, N) when is_binary(Bin) -> - case bin_search_inv(Bin, [], Seps) of +nth_lexeme_m(Bin, {GCs,_,_}=Seps0, N) when is_binary(Bin) -> + Seps = search_compile(Seps0), + case bin_search_inv(Bin, [], GCs) of [Cs] when N > 1 -> Cs1 = lexeme_skip(Cs, Seps), nth_lexeme_m(Cs1, Seps, N-1); @@ -1090,16 +1299,17 @@ lexeme_skip([CP|Cs1]=Cs0, {GCs,CPs,_}=Seps) when is_integer(CP) -> true -> [GC|Cs2] = unicode_util:gc(Cs0), case lists:member(GC, GCs) of - true -> Cs0; + true -> Cs2; false -> lexeme_skip(Cs2, Seps) end; false -> lexeme_skip(Cs1, Seps) end; -lexeme_skip([Bin|Cont0], Seps) when is_binary(Bin) -> +lexeme_skip([Bin|Cont0], Seps0) when is_binary(Bin) -> + Seps = search_compile(Seps0), case bin_search(Bin, Cont0, Seps) of {nomatch,_} -> lexeme_skip(Cont0, Seps); - Cs -> Cs + Cs -> tl(unicode_util:gc(Cs)) end; lexeme_skip(Cs0, {GCs, CPs, _} = Seps) when is_list(Cs0) -> case unicode_util:cp(Cs0) of @@ -1108,7 +1318,7 @@ lexeme_skip(Cs0, {GCs, CPs, _} = Seps) when is_list(Cs0) -> true -> [GC|Cs2] = unicode_util:gc(Cs0), case lists:member(GC, GCs) of - true -> Cs0; + true -> Cs2; false -> lexeme_skip(Cs2, Seps) end; false -> @@ -1117,12 +1327,23 @@ lexeme_skip(Cs0, {GCs, CPs, _} = Seps) when is_list(Cs0) -> [] -> [] end; -lexeme_skip(Bin, Seps) when is_binary(Bin) -> - case bin_search(Bin, Seps) of +lexeme_skip(Bin, Seps0) when is_binary(Bin) -> + Seps = search_compile(Seps0), + case bin_search(Bin, [], Seps) of {nomatch,_} -> <<>>; - [Left] -> Left + [Left] -> tl(unicode_util:gc(Left)) end. +find_l([C1|Cs]=Cs0, [C|_]=Needle) when is_integer(C1) -> + case C1 of + C -> + case prefix_1(Cs0, Needle) of + nomatch -> find_l(Cs, Needle); + _ -> Cs0 + end; + _ -> + find_l(Cs, Needle) + end; find_l([Bin|Cont0], Needle) when is_binary(Bin) -> case bin_search_str(Bin, 0, Cont0, Needle) of {nomatch, _, Cont} -> @@ -1147,6 +1368,16 @@ find_l(Bin, Needle) -> {_Before, [Cs], _After} -> Cs end. +find_r([Cp|Cs]=Cs0, [C|_]=Needle, Res) when is_integer(Cp) -> + case Cp of + C -> + case prefix_1(Cs0, Needle) of + nomatch -> find_r(Cs, Needle, Res); + _ -> find_r(Cs, Needle, Cs0) + end; + _ -> + find_r(Cs, Needle, Res) + end; find_r([Bin|Cont0], Needle, Res) when is_binary(Bin) -> case bin_search_str(Bin, 0, Cont0, Needle) of {nomatch,_,Cont} -> @@ -1217,11 +1448,6 @@ cp_prefix_1(Orig, Until, Cont) -> %% Binary special -bin_search(Bin, Seps) -> - bin_search(Bin, [], Seps). - -bin_search(_Bin, Cont, {[],_,_}) -> - {nomatch, Cont}; bin_search(Bin, Cont, {Seps,_,BP}) -> bin_search_loop(Bin, 0, BP, Cont, Seps). @@ -1229,10 +1455,14 @@ bin_search(Bin, Cont, {Seps,_,BP}) -> %% i.e. å in nfd form $a "COMBINING RING ABOVE" %% and PREPEND characters like "ARABIC NUMBER SIGN" 1536 <<216,128>> %% combined with other characters are currently ignored. +search_pattern({_,_,_}=P) -> P; search_pattern(Seps) -> CPs = search_cp(Seps), - Bin = bin_pattern(CPs), - {Seps, CPs, Bin}. + {Seps, CPs, undefined}. + +search_compile({Sep, CPs, undefined}) -> + {Sep, CPs, binary:compile_pattern(bin_pattern(CPs))}; +search_compile({_,_,_}=Compiled) -> Compiled. search_cp([CP|Seps]) when is_integer(CP) -> [CP|search_cp(Seps)]; @@ -1253,9 +1483,21 @@ bin_search_loop(Bin0, Start, BinSeps, Cont, Seps) -> case binary:match(Bin, BinSeps) of nomatch -> {nomatch,Cont}; + {Where, _CL} when Cont =:= [] -> + <<_:Where/binary, Cont1/binary>> = Bin, + [GC|Cont2] = unicode_util:gc(Cont1), + case lists:member(GC, Seps) of + false when Cont2 =:= [] -> + {nomatch, []}; + false -> + Next = byte_size(Bin0) - byte_size(Cont2), + bin_search_loop(Bin0, Next, BinSeps, Cont, Seps); + true -> + [Cont1] + end; {Where, _CL} -> <<_:Where/binary, Cont0/binary>> = Bin, - Cont1 = stack(Cont0, Cont), + Cont1 = [Cont0|Cont], [GC|Cont2] = unicode_util:gc(Cont1), case lists:member(GC, Seps) of false -> @@ -1263,55 +1505,108 @@ bin_search_loop(Bin0, Start, BinSeps, Cont, Seps) -> [BinR|Cont] when is_binary(BinR) -> Next = byte_size(Bin0) - byte_size(BinR), bin_search_loop(Bin0, Next, BinSeps, Cont, Seps); - BinR when is_binary(BinR), Cont =:= [] -> - Next = byte_size(Bin0) - byte_size(BinR), - bin_search_loop(Bin0, Next, BinSeps, Cont, Seps); _ -> {nomatch, Cont2} end; - true when is_list(Cont1) -> - Cont1; true -> - [Cont1] + Cont1 end end. -bin_search_inv(Bin, Cont, {[], _, _}) -> - [Bin|Cont]; -bin_search_inv(Bin, Cont, {[Sep], _, _}) -> - bin_search_inv_1([Bin|Cont], Sep); -bin_search_inv(Bin, Cont, {Seps, _, _}) -> - bin_search_inv_n([Bin|Cont], Seps). - -bin_search_inv_1([<<>>|CPs], _) -> - {nomatch, CPs}; -bin_search_inv_1(CPs = [Bin0|Cont], Sep) when is_binary(Bin0) -> - case unicode_util:gc(CPs) of - [Sep|Bin] when is_binary(Bin), Cont =:= [] -> - bin_search_inv_1([Bin], Sep); - [Sep|[Bin|Cont]=Cs] when is_binary(Bin) -> - bin_search_inv_1(Cs, Sep); - [Sep|Cs] -> - {nomatch, Cs}; - _ -> CPs - end. +bin_search_inv(<<>>, Cont, _) -> + {nomatch, Cont}; +bin_search_inv(Bin, Cont, [Sep]) -> + bin_search_inv_1(Bin, Cont, Sep); +bin_search_inv(Bin, Cont, Seps) -> + bin_search_inv_n(Bin, Cont, Seps). + +bin_search_inv_1(<<CP1/utf8, BinRest/binary>>=Bin0, Cont, Sep) -> + case BinRest of + <<CP2/utf8, _/binary>> when ?ASCII_LIST(CP1, CP2) -> + case CP1 of + Sep -> bin_search_inv_1(BinRest, Cont, Sep); + _ -> [Bin0|Cont] + end; + _ when Cont =:= [] -> + case unicode_util:gc(Bin0) of + [Sep|Bin] -> bin_search_inv_1(Bin, Cont, Sep); + _ -> [Bin0|Cont] + end; + _ -> + case unicode_util:gc([Bin0|Cont]) of + [Sep|[Bin|Cont]] when is_binary(Bin) -> + bin_search_inv_1(Bin, Cont, Sep); + [Sep|Cs] -> + {nomatch, Cs}; + _ -> [Bin0|Cont] + end + end; +bin_search_inv_1(<<>>, Cont, _Sep) -> + {nomatch, Cont}; +bin_search_inv_1([], Cont, _Sep) -> + {nomatch, Cont}. -bin_search_inv_n([<<>>|CPs], _) -> - {nomatch, CPs}; -bin_search_inv_n([Bin0|Cont]=CPs, Seps) when is_binary(Bin0) -> - [C|Cs0] = unicode_util:gc(CPs), - case {lists:member(C, Seps), Cs0} of - {true, Cs} when is_binary(Cs), Cont =:= [] -> - bin_search_inv_n([Cs], Seps); - {true, [Bin|Cont]=Cs} when is_binary(Bin) -> - bin_search_inv_n(Cs, Seps); - {true, Cs} -> {nomatch, Cs}; - {false, _} -> CPs - end. +bin_search_inv_n(<<CP1/utf8, BinRest/binary>>=Bin0, Cont, Seps) -> + case BinRest of + <<CP2/utf8, _/binary>> when ?ASCII_LIST(CP1, CP2) -> + case lists:member(CP1,Seps) of + true -> bin_search_inv_n(BinRest, Cont, Seps); + false -> [Bin0|Cont] + end; + _ when Cont =:= [] -> + [GC|Bin] = unicode_util:gc(Bin0), + case lists:member(GC, Seps) of + true -> bin_search_inv_n(Bin, Cont, Seps); + false -> [Bin0|Cont] + end; + _ -> + [GC|Cs0] = unicode_util:gc([Bin0|Cont]), + case lists:member(GC, Seps) of + false -> [Bin0|Cont]; + true -> + case Cs0 of + [Bin|Cont] when is_binary(Bin) -> + bin_search_inv_n(Bin, Cont, Seps); + _ -> + {nomatch, Cs0} + end + end + end; +bin_search_inv_n(<<>>, Cont, _Sep) -> + {nomatch, Cont}; +bin_search_inv_n([], Cont, _Sep) -> + {nomatch, Cont}. + +bin_search_str(Bin0, Start, [], SearchCPs) -> + Compiled = binary:compile_pattern(unicode:characters_to_binary(SearchCPs)), + bin_search_str_1(Bin0, Start, Compiled, SearchCPs); bin_search_str(Bin0, Start, Cont, [CP|_]=SearchCPs) -> + First = binary:compile_pattern(<<CP/utf8>>), + bin_search_str_2(Bin0, Start, Cont, First, SearchCPs). + +bin_search_str_1(Bin0, Start, First, SearchCPs) -> + <<_:Start/binary, Bin/binary>> = Bin0, + case binary:match(Bin, First) of + nomatch -> {nomatch, byte_size(Bin0), []}; + {Where0, _} -> + Where = Start+Where0, + <<Keep:Where/binary, Cs0/binary>> = Bin0, + case prefix_1(Cs0, SearchCPs) of + nomatch -> + <<_/utf8, Cs/binary>> = Cs0, + KeepSz = byte_size(Bin0) - byte_size(Cs), + bin_search_str_1(Bin0, KeepSz, First, SearchCPs); + [] -> + {Keep, [Cs0], <<>>}; + Rest -> + {Keep, [Cs0], Rest} + end + end. + +bin_search_str_2(Bin0, Start, Cont, First, SearchCPs) -> <<_:Start/binary, Bin/binary>> = Bin0, - case binary:match(Bin, <<CP/utf8>>) of + case binary:match(Bin, First) of nomatch -> {nomatch, byte_size(Bin0), Cont}; {Where0, _} -> Where = Start+Where0, @@ -1320,7 +1615,7 @@ bin_search_str(Bin0, Start, Cont, [CP|_]=SearchCPs) -> case prefix_1(stack(Cs0,Cont), SearchCPs) of nomatch when is_binary(Cs) -> KeepSz = byte_size(Bin0) - byte_size(Cs), - bin_search_str(Bin0, KeepSz, Cont, SearchCPs); + bin_search_str_2(Bin0, KeepSz, Cont, First, SearchCPs); nomatch -> {nomatch, Where, stack([GC|Cs],Cont)}; [] -> diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 7920e55930..e56415650f 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -31,7 +31,6 @@ %% Internal exports -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3, format_status/2]). --export([try_again_restart/2]). %% For release_handler only -export([get_callback_module/1]). @@ -79,6 +78,7 @@ | {RestartStrategy :: strategy(), Intensity :: non_neg_integer(), Period :: pos_integer()}. +-type children() :: {Ids :: [child_id()], Db :: #{child_id() => child_rec()}}. %%-------------------------------------------------------------------------- %% Defaults @@ -96,7 +96,7 @@ pid = undefined :: child() | {restarting, pid() | undefined} | [pid()], - name :: child_id(), + id :: child_id(), mfargs :: mfargs(), restart_type :: restart(), shutdown :: shutdown(), @@ -104,16 +104,11 @@ modules = [] :: modules()}). -type child_rec() :: #child{}. --define(DICTS, dict). --define(DICT, dict:dict). --define(SETS, sets). --define(SET, sets:set). - -record(state, {name, strategy :: strategy() | 'undefined', - children = [] :: [child_rec()], - dynamics :: {'dict', ?DICT(pid(), list())} - | {'set', ?SET(pid())} + children = {[],#{}} :: children(), % Ids in start order + dynamics :: {'maps', #{pid() => list()}} + | {'sets', sets:set(pid())} | 'undefined', intensity :: non_neg_integer() | 'undefined', period :: pos_integer() | 'undefined', @@ -124,6 +119,9 @@ -type state() :: #state{}. -define(is_simple(State), State#state.strategy =:= simple_one_for_one). +-define(is_temporary(_Child_), _Child_#child.restart_type=:=temporary). +-define(is_transient(_Child_), _Child_#child.restart_type=:=transient). +-define(is_permanent(_Child_), _Child_#child.restart_type=:=permanent). -callback init(Args :: term()) -> {ok, {SupFlags :: sup_flags(), [ChildSpec :: child_spec()]}} @@ -179,16 +177,16 @@ start_child(Supervisor, ChildSpec) -> | {'error', Error}, Error :: 'running' | 'restarting' | 'not_found' | 'simple_one_for_one' | term(). -restart_child(Supervisor, Name) -> - call(Supervisor, {restart_child, Name}). +restart_child(Supervisor, Id) -> + call(Supervisor, {restart_child, Id}). -spec delete_child(SupRef, Id) -> Result when SupRef :: sup_ref(), Id :: child_id(), Result :: 'ok' | {'error', Error}, Error :: 'running' | 'restarting' | 'not_found' | 'simple_one_for_one'. -delete_child(Supervisor, Name) -> - call(Supervisor, {delete_child, Name}). +delete_child(Supervisor, Id) -> + call(Supervisor, {delete_child, Id}). %%----------------------------------------------------------------- %% Func: terminate_child/2 @@ -202,16 +200,16 @@ delete_child(Supervisor, Name) -> Id :: pid() | child_id(), Result :: 'ok' | {'error', Error}, Error :: 'not_found' | 'simple_one_for_one'. -terminate_child(Supervisor, Name) -> - call(Supervisor, {terminate_child, Name}). +terminate_child(Supervisor, Id) -> + call(Supervisor, {terminate_child, Id}). -spec get_childspec(SupRef, Id) -> Result when SupRef :: sup_ref(), Id :: pid() | child_id(), Result :: {'ok', child_spec()} | {'error', Error}, Error :: 'not_found'. -get_childspec(Supervisor, Name) -> - call(Supervisor, {get_childspec, Name}). +get_childspec(Supervisor, Id) -> + call(Supervisor, {get_childspec, Id}). -spec which_children(SupRef) -> [{Id,Child,Type,Modules}] when SupRef :: sup_ref(), @@ -246,17 +244,6 @@ check_childspecs(ChildSpecs) when is_list(ChildSpecs) -> check_childspecs(X) -> {error, {badarg, X}}. %%%----------------------------------------------------------------- -%%% Called by restart/2 --spec try_again_restart(SupRef, Child) -> ok when - SupRef :: sup_ref(), - Child :: child_id() | pid(). -try_again_restart(Supervisor, Child) -> - cast(Supervisor, {try_again_restart, Child}). - -cast(Supervisor, Req) -> - gen_server:cast(Supervisor, Req). - -%%%----------------------------------------------------------------- %%% Called by release_handler during upgrade -spec get_callback_module(Pid) -> Module when Pid :: pid(), @@ -325,7 +312,7 @@ init_children(State, StartSpec) -> init_dynamic(State, [StartSpec]) -> case check_startspec([StartSpec]) of {ok, Children} -> - {ok, State#state{children = Children}}; + {ok, dyn_init(State#state{children = Children})}; Error -> {stop, {start_spec, Error}} end; @@ -334,35 +321,34 @@ init_dynamic(_State, StartSpec) -> %%----------------------------------------------------------------- %% Func: start_children/2 -%% Args: Children = [child_rec()] in start order +%% Args: Children = children() % Ids in start order %% SupName = {local, atom()} | {global, atom()} | {pid(), Mod} -%% Purpose: Start all children. The new list contains #child's +%% Purpose: Start all children. The new map contains #child's %% with pids. %% Returns: {ok, NChildren} | {error, NChildren, Reason} -%% NChildren = [child_rec()] in termination order (reversed -%% start order) +%% NChildren = children() % Ids in termination order +%% (reversed start order) %%----------------------------------------------------------------- -start_children(Children, SupName) -> start_children(Children, [], SupName). - -start_children([Child|Chs], NChildren, SupName) -> - case do_start_child(SupName, Child) of - {ok, undefined} when Child#child.restart_type =:= temporary -> - start_children(Chs, NChildren, SupName); - {ok, Pid} -> - start_children(Chs, [Child#child{pid = Pid}|NChildren], SupName); - {ok, Pid, _Extra} -> - start_children(Chs, [Child#child{pid = Pid}|NChildren], SupName); - {error, Reason} -> - report_error(start_error, Reason, Child, SupName), - {error, lists:reverse(Chs) ++ [Child | NChildren], - {failed_to_start_child,Child#child.name,Reason}} - end; -start_children([], NChildren, _SupName) -> - {ok, NChildren}. +start_children(Children, SupName) -> + Start = + fun(Id,Child) -> + case do_start_child(SupName, Child) of + {ok, undefined} when ?is_temporary(Child) -> + remove; + {ok, Pid} -> + {update,Child#child{pid = Pid}}; + {ok, Pid, _Extra} -> + {update,Child#child{pid = Pid}}; + {error, Reason} -> + report_error(start_error, Reason, Child, SupName), + {abort,{failed_to_start_child,Id,Reason}} + end + end, + children_map(Start,Children). do_start_child(SupName, Child) -> #child{mfargs = {M, F, Args}} = Child, - case catch apply(M, F, Args) of + case do_start_child_i(M, F, Args) of {ok, Pid} when is_pid(Pid) -> NChild = Child#child{pid = Pid}, report_progress(NChild, SupName), @@ -371,10 +357,8 @@ do_start_child(SupName, Child) -> NChild = Child#child{pid = Pid}, report_progress(NChild, SupName), {ok, Pid, Extra}; - ignore -> - {ok, undefined}; - {error, What} -> {error, What}; - What -> {error, What} + Other -> + Other end. do_start_child_i(M, F, A) -> @@ -400,17 +384,17 @@ do_start_child_i(M, F, A) -> -spec handle_call(call(), term(), state()) -> {'reply', term(), state()}. handle_call({start_child, EArgs}, _From, State) when ?is_simple(State) -> - Child = hd(State#state.children), + Child = get_dynamic_child(State), #child{mfargs = {M, F, A}} = Child, Args = A ++ EArgs, case do_start_child_i(M, F, Args) of {ok, undefined} -> {reply, {ok, undefined}, State}; {ok, Pid} -> - NState = save_dynamic_child(Child#child.restart_type, Pid, Args, State), + NState = dyn_store(Pid, Args, State), {reply, {ok, Pid}, NState}; {ok, Pid, Extra} -> - NState = save_dynamic_child(Child#child.restart_type, Pid, Args, State), + NState = dyn_store(Pid, Args, State), {reply, {ok, Pid, Extra}, NState}; What -> {reply, What, State} @@ -426,121 +410,94 @@ handle_call({start_child, ChildSpec}, _From, State) -> end; %% terminate_child for simple_one_for_one can only be done with pid -handle_call({terminate_child, Name}, _From, State) when not is_pid(Name), - ?is_simple(State) -> +handle_call({terminate_child, Id}, _From, State) when not is_pid(Id), + ?is_simple(State) -> {reply, {error, simple_one_for_one}, State}; -handle_call({terminate_child, Name}, _From, State) -> - case get_child(Name, State, ?is_simple(State)) of - {value, Child} -> - case do_terminate(Child, State#state.name) of - #child{restart_type=RT} when RT=:=temporary; ?is_simple(State) -> - {reply, ok, state_del_child(Child, State)}; - NChild -> - {reply, ok, replace_child(NChild, State)} - end; - false -> +handle_call({terminate_child, Id}, _From, State) -> + case find_child(Id, State) of + {ok, Child} -> + do_terminate(Child, State#state.name), + {reply, ok, del_child(Child, State)}; + error -> {reply, {error, not_found}, State} end; %% restart_child request is invalid for simple_one_for_one supervisors -handle_call({restart_child, _Name}, _From, State) when ?is_simple(State) -> +handle_call({restart_child, _Id}, _From, State) when ?is_simple(State) -> {reply, {error, simple_one_for_one}, State}; -handle_call({restart_child, Name}, _From, State) -> - case get_child(Name, State) of - {value, Child} when Child#child.pid =:= undefined -> +handle_call({restart_child, Id}, _From, State) -> + case find_child(Id, State) of + {ok, Child} when Child#child.pid =:= undefined -> case do_start_child(State#state.name, Child) of {ok, Pid} -> - NState = replace_child(Child#child{pid = Pid}, State), + NState = set_pid(Pid, Id, State), {reply, {ok, Pid}, NState}; {ok, Pid, Extra} -> - NState = replace_child(Child#child{pid = Pid}, State), + NState = set_pid(Pid, Id, State), {reply, {ok, Pid, Extra}, NState}; Error -> {reply, Error, State} end; - {value, #child{pid=?restarting(_)}} -> + {ok, #child{pid=?restarting(_)}} -> {reply, {error, restarting}, State}; - {value, _} -> + {ok, _} -> {reply, {error, running}, State}; _ -> {reply, {error, not_found}, State} end; %% delete_child request is invalid for simple_one_for_one supervisors -handle_call({delete_child, _Name}, _From, State) when ?is_simple(State) -> +handle_call({delete_child, _Id}, _From, State) when ?is_simple(State) -> {reply, {error, simple_one_for_one}, State}; -handle_call({delete_child, Name}, _From, State) -> - case get_child(Name, State) of - {value, Child} when Child#child.pid =:= undefined -> - NState = remove_child(Child, State), +handle_call({delete_child, Id}, _From, State) -> + case find_child(Id, State) of + {ok, Child} when Child#child.pid =:= undefined -> + NState = remove_child(Id, State), {reply, ok, NState}; - {value, #child{pid=?restarting(_)}} -> + {ok, #child{pid=?restarting(_)}} -> {reply, {error, restarting}, State}; - {value, _} -> + {ok, _} -> {reply, {error, running}, State}; _ -> {reply, {error, not_found}, State} end; -handle_call({get_childspec, Name}, _From, State) -> - case get_child(Name, State, ?is_simple(State)) of - {value, Child} -> +handle_call({get_childspec, Id}, _From, State) -> + case find_child(Id, State) of + {ok, Child} -> {reply, {ok, child_to_spec(Child)}, State}; - false -> + error -> {reply, {error, not_found}, State} end; -handle_call(which_children, _From, #state{children = [#child{restart_type = temporary, - child_type = CT, - modules = Mods}]} = - State) when ?is_simple(State) -> - Reply = lists:map(fun(Pid) -> {undefined, Pid, CT, Mods} end, - ?SETS:to_list(dynamics_db(temporary, State#state.dynamics))), - {reply, Reply, State}; - -handle_call(which_children, _From, #state{children = [#child{restart_type = RType, - child_type = CT, - modules = Mods}]} = - State) when ?is_simple(State) -> - Reply = lists:map(fun({?restarting(_),_}) -> {undefined,restarting,CT,Mods}; - ({Pid, _}) -> {undefined, Pid, CT, Mods} end, - ?DICTS:to_list(dynamics_db(RType, State#state.dynamics))), +handle_call(which_children, _From, State) when ?is_simple(State) -> + #child{child_type = CT,modules = Mods} = get_dynamic_child(State), + Reply = dyn_map(fun(?restarting(_)) -> {undefined, restarting, CT, Mods}; + (Pid) -> {undefined, Pid, CT, Mods} + end, State), {reply, Reply, State}; handle_call(which_children, _From, State) -> Resp = - lists:map(fun(#child{pid = ?restarting(_), name = Name, - child_type = ChildType, modules = Mods}) -> - {Name, restarting, ChildType, Mods}; - (#child{pid = Pid, name = Name, - child_type = ChildType, modules = Mods}) -> - {Name, Pid, ChildType, Mods} - end, - State#state.children), + children_to_list( + fun(Id,#child{pid = ?restarting(_), + child_type = ChildType, modules = Mods}) -> + {Id, restarting, ChildType, Mods}; + (Id,#child{pid = Pid, + child_type = ChildType, modules = Mods}) -> + {Id, Pid, ChildType, Mods} + end, + State#state.children), {reply, Resp, State}; - -handle_call(count_children, _From, #state{children = [#child{restart_type = temporary, - child_type = CT}]} = State) - when ?is_simple(State) -> - Sz = ?SETS:size(dynamics_db(temporary, State#state.dynamics)), - Reply = case CT of - supervisor -> [{specs, 1}, {active, Sz}, - {supervisors, Sz}, {workers, 0}]; - worker -> [{specs, 1}, {active, Sz}, - {supervisors, 0}, {workers, Sz}] - end, - {reply, Reply, State}; - -handle_call(count_children, _From, #state{dynamic_restarts = Restarts, - children = [#child{restart_type = RType, - child_type = CT}]} = State) +handle_call(count_children, _From, #state{dynamic_restarts = Restarts} = State) when ?is_simple(State) -> - Sz = ?DICTS:size(dynamics_db(RType, State#state.dynamics)), - Active = Sz - Restarts, + #child{child_type = CT} = get_dynamic_child(State), + Sz = dyn_size(State), + Active = Sz - Restarts, % Restarts is always 0 for temporary children Reply = case CT of supervisor -> [{specs, 1}, {active, Active}, {supervisors, Sz}, {workers, 0}]; @@ -552,16 +509,15 @@ handle_call(count_children, _From, #state{dynamic_restarts = Restarts, handle_call(count_children, _From, State) -> %% Specs and children are together on the children list... {Specs, Active, Supers, Workers} = - lists:foldl(fun(Child, Counts) -> - count_child(Child, Counts) - end, {0,0,0,0}, State#state.children), + children_fold(fun(_Id, Child, Counts) -> + count_child(Child, Counts) + end, {0,0,0,0}, State#state.children), %% Reformat counts to a property list. Reply = [{specs, Specs}, {active, Active}, {supervisors, Supers}, {workers, Workers}], {reply, Reply, State}. - count_child(#child{pid = Pid, child_type = worker}, {Specs, Active, Supers, Workers}) -> case is_pid(Pid) andalso is_process_alive(Pid) of @@ -575,34 +531,15 @@ count_child(#child{pid = Pid, child_type = supervisor}, false -> {Specs+1, Active, Supers+1, Workers} end. - %%% If a restart attempt failed, this message is cast %%% from restart/2 in order to give gen_server the chance to %%% check it's inbox before trying again. --spec handle_cast({try_again_restart, child_id() | pid()}, state()) -> +-spec handle_cast({try_again_restart, child_id() | {'restarting',pid()}}, state()) -> {'noreply', state()} | {stop, shutdown, state()}. -handle_cast({try_again_restart,Pid}, #state{children=[Child]}=State) - when ?is_simple(State) -> - RT = Child#child.restart_type, - RPid = restarting(Pid), - case dynamic_child_args(RPid, RT, State#state.dynamics) of - {ok, Args} -> - {M, F, _} = Child#child.mfargs, - NChild = Child#child{pid = RPid, mfargs = {M, F, Args}}, - case restart(NChild,State) of - {ok, State1} -> - {noreply, State1}; - {shutdown, State1} -> - {stop, shutdown, State1} - end; - error -> - {noreply, State} - end; - -handle_cast({try_again_restart,Name}, State) -> - case lists:keyfind(Name,#child.name,State#state.children) of - Child = #child{pid=?restarting(_)} -> +handle_cast({try_again_restart,TryAgainId}, State) -> + case find_child_and_args(TryAgainId, State) of + {ok, Child = #child{pid=?restarting(_)}} -> case restart(Child,State) of {ok, State1} -> {noreply, State1}; @@ -637,10 +574,8 @@ handle_info(Msg, State) -> %% -spec terminate(term(), state()) -> 'ok'. -terminate(_Reason, #state{children=[Child]} = State) when ?is_simple(State) -> - terminate_dynamic_children(Child, dynamics_db(Child#child.restart_type, - State#state.dynamics), - State#state.name); +terminate(_Reason, State) when ?is_simple(State) -> + terminate_dynamic_children(State); terminate(_Reason, State) -> terminate_children(State#state.children, State#state.name). @@ -675,8 +610,8 @@ code_change(_, State, _) -> update_childspec(State, StartSpec) when ?is_simple(State) -> case check_startspec(StartSpec) of - {ok, [Child]} -> - {ok, State#state{children = [Child]}}; + {ok, {[_],_}=Children} -> + {ok, State#state{children = Children}}; Error -> {error, Error} end; @@ -690,39 +625,36 @@ update_childspec(State, StartSpec) -> {error, Error} end. -update_childspec1([Child|OldC], Children, KeepOld) -> - case update_chsp(Child, Children) of - {ok,NewChildren} -> - update_childspec1(OldC, NewChildren, KeepOld); +update_childspec1({[Id|OldIds], OldDb}, {Ids,Db}, KeepOld) -> + case update_chsp(maps:get(Id,OldDb), Db) of + {ok,NewDb} -> + update_childspec1({OldIds,OldDb}, {Ids,NewDb}, KeepOld); false -> - update_childspec1(OldC, Children, [Child|KeepOld]) + update_childspec1({OldIds,OldDb}, {Ids,Db}, [Id|KeepOld]) end; -update_childspec1([], Children, KeepOld) -> +update_childspec1({[],OldDb}, {Ids,Db}, KeepOld) -> + KeepOldDb = maps:with(KeepOld,OldDb), %% Return them in (kept) reverse start order. - lists:reverse(Children ++ KeepOld). - -update_chsp(OldCh, Children) -> - case lists:map(fun(Ch) when OldCh#child.name =:= Ch#child.name -> - Ch#child{pid = OldCh#child.pid}; - (Ch) -> - Ch - end, - Children) of - Children -> - false; % OldCh not found in new spec. - NewC -> - {ok, NewC} + {lists:reverse(Ids ++ KeepOld),maps:merge(KeepOldDb,Db)}. + +update_chsp(#child{id=Id}=OldChild, NewDb) -> + case maps:find(Id, NewDb) of + {ok,Child} -> + {ok,NewDb#{Id => Child#child{pid = OldChild#child.pid}}}; + error -> % Id not found in new spec. + false end. + %%% --------------------------------------------------- %%% Start a new child. %%% --------------------------------------------------- handle_start_child(Child, State) -> - case get_child(Child#child.name, State) of - false -> + case find_child(Child#child.id, State) of + error -> case do_start_child(State#state.name, Child) of - {ok, undefined} when Child#child.restart_type =:= temporary -> + {ok, undefined} when ?is_temporary(Child) -> {{ok, undefined}, State}; {ok, Pid} -> {{ok, Pid}, save_child(Child#child{pid = Pid}, State)}; @@ -731,9 +663,9 @@ handle_start_child(Child, State) -> {error, What} -> {{error, {What, Child}}, State} end; - {value, OldChild} when is_pid(OldChild#child.pid) -> + {ok, OldChild} when is_pid(OldChild#child.pid) -> {{error, {already_started, OldChild#child.pid}}, State}; - {value, _OldChild} -> + {ok, _OldChild} -> {{error, already_present}, State} end. @@ -742,63 +674,45 @@ handle_start_child(Child, State) -> %%% Returns: {ok, state()} | {shutdown, state()} %%% --------------------------------------------------- -restart_child(Pid, Reason, #state{children = [Child]} = State) when ?is_simple(State) -> - RestartType = Child#child.restart_type, - case dynamic_child_args(Pid, RestartType, State#state.dynamics) of - {ok, Args} -> - {M, F, _} = Child#child.mfargs, - NChild = Child#child{pid = Pid, mfargs = {M, F, Args}}, - do_restart(RestartType, Reason, NChild, State); - error -> - {ok, State} - end; - restart_child(Pid, Reason, State) -> - Children = State#state.children, - case lists:keyfind(Pid, #child.pid, Children) of - #child{restart_type = RestartType} = Child -> - do_restart(RestartType, Reason, Child, State); - false -> + case find_child_and_args(Pid, State) of + {ok, Child} -> + do_restart(Reason, Child, State); + error -> {ok, State} end. -do_restart(permanent, Reason, Child, State) -> +do_restart(Reason, Child, State) when ?is_permanent(Child) -> report_error(child_terminated, Reason, Child, State#state.name), restart(Child, State); -do_restart(_, normal, Child, State) -> - NState = state_del_child(Child, State), +do_restart(normal, Child, State) -> + NState = del_child(Child, State), {ok, NState}; -do_restart(_, shutdown, Child, State) -> - NState = state_del_child(Child, State), +do_restart(shutdown, Child, State) -> + NState = del_child(Child, State), {ok, NState}; -do_restart(_, {shutdown, _Term}, Child, State) -> - NState = state_del_child(Child, State), +do_restart({shutdown, _Term}, Child, State) -> + NState = del_child(Child, State), {ok, NState}; -do_restart(transient, Reason, Child, State) -> +do_restart(Reason, Child, State) when ?is_transient(Child) -> report_error(child_terminated, Reason, Child, State#state.name), restart(Child, State); -do_restart(temporary, Reason, Child, State) -> +do_restart(Reason, Child, State) when ?is_temporary(Child) -> report_error(child_terminated, Reason, Child, State#state.name), - NState = state_del_child(Child, State), + NState = del_child(Child, State), {ok, NState}. restart(Child, State) -> case add_restart(State) of {ok, NState} -> case restart(NState#state.strategy, Child, NState) of - {try_again,NState2} -> + {{try_again, TryAgainId}, NState2} -> %% Leaving control back to gen_server before %% trying again. This way other incoming requsts %% for the supervisor can be handled - e.g. a %% shutdown request for the supervisor or the %% child. - Id = if ?is_simple(State) -> Child#child.pid; - true -> Child#child.name - end, - ok = try_again_restart(self(), Id), - {ok,NState2}; - {try_again, NState2, #child{name=ChName}} -> - ok = try_again_restart(self(), ChName), + try_again_restart(TryAgainId), {ok,NState2}; Other -> Other @@ -806,124 +720,111 @@ restart(Child, State) -> {terminate, NState} -> report_error(shutdown, reached_max_restart_intensity, Child, State#state.name), - {shutdown, remove_child(Child, NState)} + {shutdown, del_child(Child, NState)} end. restart(simple_one_for_one, Child, State0) -> #child{pid = OldPid, mfargs = {M, F, A}} = Child, - State = case OldPid of + State1 = case OldPid of ?restarting(_) -> NRes = State0#state.dynamic_restarts - 1, State0#state{dynamic_restarts = NRes}; _ -> State0 end, - Dynamics = ?DICTS:erase(OldPid, dynamics_db(Child#child.restart_type, - State#state.dynamics)), + State2 = dyn_erase(OldPid, State1), case do_start_child_i(M, F, A) of {ok, Pid} -> - DynamicsDb = {dict, ?DICTS:store(Pid, A, Dynamics)}, - NState = State#state{dynamics = DynamicsDb}, + NState = dyn_store(Pid, A, State2), {ok, NState}; {ok, Pid, _Extra} -> - DynamicsDb = {dict, ?DICTS:store(Pid, A, Dynamics)}, - NState = State#state{dynamics = DynamicsDb}, + NState = dyn_store(Pid, A, State2), {ok, NState}; {error, Error} -> - NRestarts = State#state.dynamic_restarts + 1, - DynamicsDb = {dict, ?DICTS:store(restarting(OldPid), A, Dynamics)}, - NState = State#state{dynamic_restarts = NRestarts, - dynamics = DynamicsDb}, - report_error(start_error, Error, Child, State#state.name), - {try_again, NState} + ROldPid = restarting(OldPid), + NRestarts = State2#state.dynamic_restarts + 1, + State3 = State2#state{dynamic_restarts = NRestarts}, + NState = dyn_store(ROldPid, A, State3), + report_error(start_error, Error, Child, NState#state.name), + {{try_again, ROldPid}, NState} end; -restart(one_for_one, Child, State) -> +restart(one_for_one, #child{id=Id} = Child, State) -> OldPid = Child#child.pid, case do_start_child(State#state.name, Child) of {ok, Pid} -> - NState = replace_child(Child#child{pid = Pid}, State), + NState = set_pid(Pid, Id, State), {ok, NState}; {ok, Pid, _Extra} -> - NState = replace_child(Child#child{pid = Pid}, State), + NState = set_pid(Pid, Id, State), {ok, NState}; {error, Reason} -> - NState = replace_child(Child#child{pid = restarting(OldPid)}, State), + NState = set_pid(restarting(OldPid), Id, State), report_error(start_error, Reason, Child, State#state.name), - {try_again, NState} - end; -restart(rest_for_one, Child, State) -> - {ChAfter, ChBefore} = split_child(Child#child.pid, State#state.children), - ChAfter2 = terminate_children(ChAfter, State#state.name), - case start_children(ChAfter2, State#state.name) of - {ok, ChAfter3} -> - {ok, State#state{children = ChAfter3 ++ ChBefore}}; - {error, ChAfter3, {failed_to_start_child, ChName, _Reason}} - when ChName =:= Child#child.name -> - NChild = Child#child{pid=restarting(Child#child.pid)}, - NState = State#state{children = ChAfter3 ++ ChBefore}, - {try_again, replace_child(NChild,NState)}; - {error, ChAfter3, {failed_to_start_child, ChName, _Reason}} -> - NChild = lists:keyfind(ChName, #child.name, ChAfter3), - NChild2 = NChild#child{pid=?restarting(undefined)}, - NState = State#state{children = ChAfter3 ++ ChBefore}, - {try_again, replace_child(NChild2,NState), NChild2} + {{try_again,Id}, NState} end; -restart(one_for_all, Child, State) -> - Children1 = del_child(Child#child.pid, State#state.children), - Children2 = terminate_children(Children1, State#state.name), - case start_children(Children2, State#state.name) of - {ok, NChs} -> - {ok, State#state{children = NChs}}; - {error, NChs, {failed_to_start_child, ChName, _Reason}} - when ChName =:= Child#child.name -> - NChild = Child#child{pid=restarting(Child#child.pid)}, - NState = State#state{children = NChs}, - {try_again, replace_child(NChild,NState)}; - {error, NChs, {failed_to_start_child, ChName, _Reason}} -> - NChild = lists:keyfind(ChName, #child.name, NChs), - NChild2 = NChild#child{pid=?restarting(undefined)}, - NState = State#state{children = NChs}, - {try_again, replace_child(NChild2,NState), NChild2} +restart(rest_for_one, #child{id=Id} = Child, #state{name=SupName} = State) -> + {ChAfter, ChBefore} = split_child(Id, State#state.children), + {Return, ChAfter2} = restart_multiple_children(Child, ChAfter, SupName), + {Return, State#state{children = append(ChAfter2,ChBefore)}}; +restart(one_for_all, Child, #state{name=SupName} = State) -> + Children1 = del_child(Child#child.id, State#state.children), + {Return, NChildren} = restart_multiple_children(Child, Children1, SupName), + {Return, State#state{children = NChildren}}. + +restart_multiple_children(Child, Children, SupName) -> + Children1 = terminate_children(Children, SupName), + case start_children(Children1, SupName) of + {ok, NChildren} -> + {ok, NChildren}; + {error, NChildren, {failed_to_start_child, FailedId, _Reason}} -> + NewPid = if FailedId =:= Child#child.id -> + restarting(Child#child.pid); + true -> + ?restarting(undefined) + end, + {{try_again, FailedId}, set_pid(NewPid,FailedId,NChildren)} end. restarting(Pid) when is_pid(Pid) -> ?restarting(Pid); restarting(RPid) -> RPid. +-spec try_again_restart(child_id() | {'restarting',pid()}) -> 'ok'. +try_again_restart(TryAgainId) -> + gen_server:cast(self(), {try_again_restart, TryAgainId}). + %%----------------------------------------------------------------- %% Func: terminate_children/2 -%% Args: Children = [child_rec()] in termination order +%% Args: Children = children() % Ids in termination order %% SupName = {local, atom()} | {global, atom()} | {pid(),Mod} -%% Returns: NChildren = [child_rec()] in -%% startup order (reversed termination order) +%% Returns: NChildren = children() % Ids in startup order +%% % (reversed termination order) %%----------------------------------------------------------------- terminate_children(Children, SupName) -> - terminate_children(Children, SupName, []). - -%% Temporary children should not be restarted and thus should -%% be skipped when building the list of terminated children, although -%% we do want them to be shut down as many functions from this module -%% use this function to just clear everything. -terminate_children([Child = #child{restart_type=temporary} | Children], SupName, Res) -> - _ = do_terminate(Child, SupName), - terminate_children(Children, SupName, Res); -terminate_children([Child | Children], SupName, Res) -> - NChild = do_terminate(Child, SupName), - terminate_children(Children, SupName, [NChild | Res]); -terminate_children([], _SupName, Res) -> - Res. + Terminate = + fun(_Id,Child) when ?is_temporary(Child) -> + %% Temporary children should not be restarted and thus should + %% be skipped when building the list of terminated children. + do_terminate(Child, SupName), + remove; + (_Id,Child) -> + do_terminate(Child, SupName), + {update,Child#child{pid=undefined}} + end, + {ok,NChildren} = children_map(Terminate, Children), + NChildren. do_terminate(Child, SupName) when is_pid(Child#child.pid) -> case shutdown(Child#child.pid, Child#child.shutdown) of ok -> ok; - {error, normal} when Child#child.restart_type =/= permanent -> + {error, normal} when not (?is_permanent(Child)) -> ok; {error, OtherReason} -> report_error(shutdown_error, OtherReason, Child, SupName) end, - Child#child{pid = undefined}; -do_terminate(Child, _SupName) -> - Child#child{pid = undefined}. + ok; +do_terminate(_Child, _SupName) -> + ok. %%----------------------------------------------------------------- %% Shutdowns a child. We must check the EXIT value @@ -996,66 +897,50 @@ monitor_child(Pid) -> ok end. - %%----------------------------------------------------------------- -%% Func: terminate_dynamic_children/3 -%% Args: Child = child_rec() -%% Dynamics = ?DICT() | ?SET() -%% SupName = {local, atom()} | {global, atom()} | {pid(),Mod} +%% Func: terminate_dynamic_children/1 +%% Args: State %% Returns: ok %% -%% %% Shutdown all dynamic children. This happens when the supervisor is %% stopped. Because the supervisor can have millions of dynamic children, we -%% can have an significative overhead here. +%% can have a significative overhead here. %%----------------------------------------------------------------- -terminate_dynamic_children(Child, Dynamics, SupName) -> - {Pids, EStack0} = monitor_dynamic_children(Child, Dynamics), - Sz = ?SETS:size(Pids), +terminate_dynamic_children(State) -> + Child = get_dynamic_child(State), + {Pids, EStack0} = monitor_dynamic_children(Child,State), + Sz = sets:size(Pids), EStack = case Child#child.shutdown of brutal_kill -> - ?SETS:fold(fun(P, _) -> exit(P, kill) end, ok, Pids), + sets:fold(fun(P, _) -> exit(P, kill) end, ok, Pids), wait_dynamic_children(Child, Pids, Sz, undefined, EStack0); infinity -> - ?SETS:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids), + sets:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids), wait_dynamic_children(Child, Pids, Sz, undefined, EStack0); Time -> - ?SETS:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids), + sets:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids), TRef = erlang:start_timer(Time, self(), kill), wait_dynamic_children(Child, Pids, Sz, TRef, EStack0) end, %% Unroll stacked errors and report them - ?DICTS:fold(fun(Reason, Ls, _) -> - report_error(shutdown_error, Reason, - Child#child{pid=Ls}, SupName) - end, ok, EStack). - - -monitor_dynamic_children(#child{restart_type=temporary}, Dynamics) -> - ?SETS:fold(fun(P, {Pids, EStack}) -> - case monitor_child(P) of - ok -> - {?SETS:add_element(P, Pids), EStack}; - {error, normal} -> - {Pids, EStack}; - {error, Reason} -> - {Pids, ?DICTS:append(Reason, P, EStack)} - end - end, {?SETS:new(), ?DICTS:new()}, Dynamics); -monitor_dynamic_children(#child{restart_type=RType}, Dynamics) -> - ?DICTS:fold(fun(P, _, {Pids, EStack}) when is_pid(P) -> - case monitor_child(P) of - ok -> - {?SETS:add_element(P, Pids), EStack}; - {error, normal} when RType =/= permanent -> - {Pids, EStack}; - {error, Reason} -> - {Pids, ?DICTS:append(Reason, P, EStack)} - end; - (?restarting(_), _, {Pids, EStack}) -> - {Pids, EStack} - end, {?SETS:new(), ?DICTS:new()}, Dynamics). - + dict:fold(fun(Reason, Ls, _) -> + report_error(shutdown_error, Reason, + Child#child{pid=Ls}, State#state.name) + end, ok, EStack). + +monitor_dynamic_children(Child,State) -> + dyn_fold(fun(P,{Pids, EStack}) when is_pid(P) -> + case monitor_child(P) of + ok -> + {sets:add_element(P, Pids), EStack}; + {error, normal} when not (?is_permanent(Child)) -> + {Pids, EStack}; + {error, Reason} -> + {Pids, dict:append(Reason, P, EStack)} + end; + (?restarting(_), {Pids, EStack}) -> + {Pids, EStack} + end, {sets:new(), dict:new()}, State). wait_dynamic_children(_Child, _Pids, 0, undefined, EStack) -> EStack; @@ -1073,39 +958,38 @@ wait_dynamic_children(#child{shutdown=brutal_kill} = Child, Pids, Sz, TRef, EStack) -> receive {'DOWN', _MRef, process, Pid, killed} -> - wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + wait_dynamic_children(Child, sets:del_element(Pid, Pids), Sz-1, TRef, EStack); {'DOWN', _MRef, process, Pid, Reason} -> - wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, - TRef, ?DICTS:append(Reason, Pid, EStack)) + wait_dynamic_children(Child, sets:del_element(Pid, Pids), Sz-1, + TRef, dict:append(Reason, Pid, EStack)) end; -wait_dynamic_children(#child{restart_type=RType} = Child, Pids, Sz, - TRef, EStack) -> +wait_dynamic_children(Child, Pids, Sz, TRef, EStack) -> receive {'DOWN', _MRef, process, Pid, shutdown} -> - wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + wait_dynamic_children(Child, sets:del_element(Pid, Pids), Sz-1, TRef, EStack); {'DOWN', _MRef, process, Pid, {shutdown, _}} -> - wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + wait_dynamic_children(Child, sets:del_element(Pid, Pids), Sz-1, TRef, EStack); - {'DOWN', _MRef, process, Pid, normal} when RType =/= permanent -> - wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + {'DOWN', _MRef, process, Pid, normal} when not (?is_permanent(Child)) -> + wait_dynamic_children(Child, sets:del_element(Pid, Pids), Sz-1, TRef, EStack); {'DOWN', _MRef, process, Pid, Reason} -> - wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, - TRef, ?DICTS:append(Reason, Pid, EStack)); + wait_dynamic_children(Child, sets:del_element(Pid, Pids), Sz-1, + TRef, dict:append(Reason, Pid, EStack)); {timeout, TRef, kill} -> - ?SETS:fold(fun(P, _) -> exit(P, kill) end, ok, Pids), + sets:fold(fun(P, _) -> exit(P, kill) end, ok, Pids), wait_dynamic_children(Child, Pids, Sz, undefined, EStack) end. %%----------------------------------------------------------------- -%% Child/State manipulating functions. +%% Access #state.children %%----------------------------------------------------------------- %% Note we do not want to save the parameter list for temporary processes as @@ -1113,114 +997,184 @@ wait_dynamic_children(#child{restart_type=RType} = Child, Pids, Sz, %% Especially for dynamic children to simple_one_for_one supervisors %% it could become very costly as it is not uncommon to spawn %% very many such processes. -save_child(#child{restart_type = temporary, - mfargs = {M, F, _}} = Child, #state{children = Children} = State) -> - State#state{children = [Child#child{mfargs = {M, F, undefined}} |Children]}; -save_child(Child, #state{children = Children} = State) -> - State#state{children = [Child |Children]}. - -save_dynamic_child(temporary, Pid, _, #state{dynamics = Dynamics} = State) -> - DynamicsDb = dynamics_db(temporary, Dynamics), - State#state{dynamics = {set, ?SETS:add_element(Pid, DynamicsDb)}}; -save_dynamic_child(RestartType, Pid, Args, #state{dynamics = Dynamics} = State) -> - DynamicsDb = dynamics_db(RestartType, Dynamics), - State#state{dynamics = {dict, ?DICTS:store(Pid, Args, DynamicsDb)}}. - -dynamics_db(temporary, undefined) -> - ?SETS:new(); -dynamics_db(_, undefined) -> - ?DICTS:new(); -dynamics_db(_, {_Tag, DynamicsDb}) -> - DynamicsDb. - -dynamic_child_args(_Pid, temporary, _DynamicsDb) -> - {ok, undefined}; -dynamic_child_args(Pid, _RT, {dict, DynamicsDb}) -> - ?DICTS:find(Pid, DynamicsDb); -dynamic_child_args(_Pid, _RT, undefined) -> - error. - -state_del_child(#child{pid = Pid, restart_type = temporary}, State) when ?is_simple(State) -> - NDynamics = ?SETS:del_element(Pid, dynamics_db(temporary, State#state.dynamics)), - State#state{dynamics = {set, NDynamics}}; -state_del_child(#child{pid = Pid, restart_type = RType}, State) when ?is_simple(State) -> - NDynamics = ?DICTS:erase(Pid, dynamics_db(RType, State#state.dynamics)), - State#state{dynamics = {dict, NDynamics}}; -state_del_child(Child, State) -> - NChildren = del_child(Child#child.name, State#state.children), - State#state{children = NChildren}. - -del_child(Name, [Ch|Chs]) when Ch#child.name =:= Name, Ch#child.restart_type =:= temporary -> - Chs; -del_child(Name, [Ch|Chs]) when Ch#child.name =:= Name -> - [Ch#child{pid = undefined} | Chs]; -del_child(Pid, [Ch|Chs]) when Ch#child.pid =:= Pid, Ch#child.restart_type =:= temporary -> - Chs; -del_child(Pid, [Ch|Chs]) when Ch#child.pid =:= Pid -> - [Ch#child{pid = undefined} | Chs]; -del_child(Name, [Ch|Chs]) -> - [Ch|del_child(Name, Chs)]; -del_child(_, []) -> - []. +-spec save_child(child_rec(), state()) -> state(). +save_child(#child{mfargs = {M, F, _}} = Child, State) when ?is_temporary(Child) -> + do_save_child(Child#child{mfargs = {M, F, undefined}}, State); +save_child(Child, State) -> + do_save_child(Child, State). + +-spec do_save_child(child_rec(), state()) -> state(). +do_save_child(#child{id = Id} = Child, #state{children = {Ids,Db}} = State) -> + State#state{children = {[Id|Ids],Db#{Id => Child}}}. + +-spec del_child(child_rec(), state()) -> state(); + (child_id(), children()) -> children(). +del_child(#child{pid = Pid}, State) when ?is_simple(State) -> + dyn_erase(Pid,State); +del_child(Child, State) when is_record(Child,child), is_record(State,state) -> + NChildren = del_child(Child#child.id, State#state.children), + State#state{children = NChildren}; +del_child(Id, {Ids,Db}) -> + case maps:get(Id, Db) of + Child when Child#child.restart_type =:= temporary -> + {lists:delete(Id, Ids), maps:remove(Id, Db)}; + Child -> + {Ids, Db#{Id=>Child#child{pid=undefined}}} + end. -%% Chs = [S4, S3, Ch, S1, S0] -%% Ret: {[S4, S3, Ch], [S1, S0]} -split_child(Name, Chs) -> - split_child(Name, Chs, []). - -split_child(Name, [Ch|Chs], After) when Ch#child.name =:= Name -> - {lists:reverse([Ch#child{pid = undefined} | After]), Chs}; -split_child(Pid, [Ch|Chs], After) when Ch#child.pid =:= Pid -> - {lists:reverse([Ch#child{pid = undefined} | After]), Chs}; -split_child(Name, [Ch|Chs], After) -> - split_child(Name, Chs, [Ch | After]); -split_child(_, [], After) -> - {lists:reverse(After), []}. - -get_child(Name, State) -> - get_child(Name, State, false). - -get_child(Pid, State, AllowPid) when AllowPid, is_pid(Pid) -> - get_dynamic_child(Pid, State); -get_child(Name, State, _) -> - lists:keysearch(Name, #child.name, State#state.children). - -get_dynamic_child(Pid, #state{children=[Child], dynamics=Dynamics}) -> - case is_dynamic_pid(Pid, Dynamics) of - true -> - {value, Child#child{pid=Pid}}; - false -> - RPid = restarting(Pid), - case is_dynamic_pid(RPid, Dynamics) of - true -> - {value, Child#child{pid=RPid}}; - false -> +%% In: {[S4, S3, Ch, S1, S0],Db} +%% Ret: {{[S4, S3, Ch],Db1}, {[S1, S0],Db2}} +%% Db1 and Db2 contain the keys in the lists they are associated with. +-spec split_child(child_id(), children()) -> {children(), children()}. +split_child(Id, {Ids,Db}) -> + {IdsAfter,IdsBefore} = split_ids(Id, Ids, []), + DbBefore = maps:with(IdsBefore,Db), + #{Id:=Ch} = DbAfter = maps:with(IdsAfter,Db), + {{IdsAfter,DbAfter#{Id=>Ch#child{pid=undefined}}},{IdsBefore,DbBefore}}. + +split_ids(Id, [Id|Ids], After) -> + {lists:reverse([Id|After]), Ids}; +split_ids(Id, [Other|Ids], After) -> + split_ids(Id, Ids, [Other | After]). + +%% Find the child record for a given Pid (dynamic child) or Id +%% (non-dynamic child). This is called from the API functions. +-spec find_child(pid() | child_id(), state()) -> {ok,child_rec()} | error. +find_child(Pid, State) when is_pid(Pid), ?is_simple(State) -> + case find_dynamic_child(Pid, State) of + error -> + case find_dynamic_child(restarting(Pid), State) of + error -> case erlang:is_process_alive(Pid) of - true -> false; - false -> {value, Child} - end - end + true -> error; + false -> {ok, get_dynamic_child(State)} + end; + Other -> + Other + end; + Other -> + Other + end; +find_child(Id, #state{children = {_Ids,Db}}) -> + maps:find(Id, Db). + +%% Get the child record - either by child id or by pid. If +%% simple_one_for_one, then insert the pid and args into the returned +%% child record. This is called when trying to restart the child. +-spec find_child_and_args(IdOrPid, state()) -> {ok, child_rec()} | error when + IdOrPid :: pid() | {restarting,pid()} | child_id(). +find_child_and_args(Pid, State) when ?is_simple(State) -> + case find_dynamic_child(Pid, State) of + {ok,#child{mfargs={M,F,_}} = Child} -> + {ok, Args} = dyn_args(Pid, State), + {ok, Child#child{mfargs = {M, F, Args}}}; + error -> + error + end; +find_child_and_args(Pid, State) when is_pid(Pid) -> + find_child_by_pid(Pid, State); +find_child_and_args(Id, #state{children={_Ids,Db}}) -> + maps:find(Id, Db). + +%% Given the pid, find the child record for a dynamic child, and +%% include the pid in the returned record. +-spec find_dynamic_child(IdOrPid, state()) -> {ok, child_rec()} | error when + IdOrPid :: pid() | {restarting,pid()} | child_id(). +find_dynamic_child(Pid, State) -> + case dyn_exists(Pid, State) of + true -> + Child = get_dynamic_child(State), + {ok, Child#child{pid=Pid}}; + false -> + error end. -is_dynamic_pid(Pid, {dict, Dynamics}) -> - ?DICTS:is_key(Pid, Dynamics); -is_dynamic_pid(Pid, {set, Dynamics}) -> - ?SETS:is_element(Pid, Dynamics); -is_dynamic_pid(_Pid, undefined) -> - false. - -replace_child(Child, State) -> - Chs = do_replace_child(Child, State#state.children), - State#state{children = Chs}. - -do_replace_child(Child, [Ch|Chs]) when Ch#child.name =:= Child#child.name -> - [Child | Chs]; -do_replace_child(Child, [Ch|Chs]) -> - [Ch|do_replace_child(Child, Chs)]. +%% Given the pid, find the child record for a non-dyanamic child. +-spec find_child_by_pid(IdOrPid, state()) -> {ok,child_rec()} | error when + IdOrPid :: pid() | {restarting,pid()}. +find_child_by_pid(Pid,#state{children={_Ids,Db}}) -> + Fun = fun(_Id,#child{pid=P}=Ch,_) when P =:= Pid -> + throw(Ch); + (_,_,error) -> + error + end, + try maps:fold(Fun,error,Db) + catch throw:Child -> {ok,Child} + end. -remove_child(Child, State) -> - Chs = lists:keydelete(Child#child.name, #child.name, State#state.children), - State#state{children = Chs}. +%% Get the child record from a simple_one_for_one supervisor - no pid +%% It is assumed that the child can always be found +-spec get_dynamic_child(state()) -> child_rec(). +get_dynamic_child(#state{children={[Id],Db}}) -> + #{Id := Child} = Db, + Child. + +%% Update pid in the given child record and store it in the process state +-spec set_pid(term(), child_id(), state()) -> state(); + (term(), child_id(), children()) -> children(). +set_pid(Pid, Id, #state{children=Children} = State) -> + State#state{children = set_pid(Pid, Id, Children)}; +set_pid(Pid, Id, {Ids, Db}) -> + NewDb = maps:update_with(Id, fun(Child) -> Child#child{pid=Pid} end, Db), + {Ids,NewDb}. + +%% Remove the Id and the child record from the process state +-spec remove_child(child_id(), state()) -> state(). +remove_child(Id, #state{children={Ids,Db}} = State) -> + NewIds = lists:delete(Id,Ids), + NewDb = maps:remove(Id,Db), + State#state{children = {NewIds,NewDb}}. + +%% In the order of Ids, traverse the children and update each child +%% according to the return value of the Fun. +%% On error, abort and return the merge of the old and the updated map. +%% NOTE: The returned list of Ids is reverted compared to the input. +-spec children_map(Fun, children()) -> {ok, children()} | + {error,children(),Reason} when + Fun :: fun((child_id(),child_rec()) -> {update,child_rec()} | + remove | + {abort, Reason}), + Reason :: term(). +children_map(Fun,{Ids,Db}) -> + children_map(Fun, Ids, Db, []). + +children_map(Fun,[Id|Ids],Db,Acc) -> + case Fun(Id,maps:get(Id,Db)) of + {update,Child} -> + children_map(Fun,Ids,Db#{Id => Child},[Id|Acc]); + remove -> + children_map(Fun,Ids,maps:remove(Id,Db),Acc); + {abort,Reason} -> + {error,{lists:reverse(Ids)++[Id|Acc],Db},Reason} + end; +children_map(_Fun,[],Db,Acc) -> + {ok,{Acc,Db}}. + +%% In the order of Ids, map over all children and return the list +-spec children_to_list(Fun, children()) -> List when + Fun :: fun((child_id(), child_rec()) -> Elem), + List :: list(Elem), + Elem :: term(). +children_to_list(Fun,{Ids,Db}) -> + children_to_list(Fun, Ids, Db, []). +children_to_list(Fun,[Id|Ids],Db,Acc) -> + children_to_list(Fun,Ids,Db,[Fun(Id,maps:get(Id,Db))|Acc]); +children_to_list(_Fun,[],_Db,Acc) -> + lists:reverse(Acc). + +%% The order is not important - so ignore Ids +-spec children_fold(Fun, Acc0, children()) -> Acc1 when + Fun :: fun((child_id(), child_rec(), AccIn) -> AccOut), + Acc0 :: term(), + Acc1 :: term(), + AccIn :: term(), + AccOut :: term(). +children_fold(Fun,Init,{_Ids,Db}) -> + maps:fold(Fun, Init, Db). + +-spec append(children(), children()) -> children(). +append({Ids1,Db1},{Ids2,Db2}) -> + {Ids1++Ids2,maps:merge(Db1,Db2)}. %%----------------------------------------------------------------- %% Func: init_state/4 @@ -1290,27 +1244,27 @@ supname(N, _) -> N. %%% Returns: {ok, [child_rec()]} | Error %%% ------------------------------------------------------ -check_startspec(Children) -> check_startspec(Children, []). +check_startspec(Children) -> check_startspec(Children, [], #{}). -check_startspec([ChildSpec|T], Res) -> +check_startspec([ChildSpec|T], Ids, Db) -> case check_childspec(ChildSpec) of - {ok, Child} -> - case lists:keymember(Child#child.name, #child.name, Res) of + {ok, #child{id=Id}=Child} -> + case maps:is_key(Id, Db) of %% The error message duplicate_child_name is kept for %% backwards compatibility, although %% duplicate_child_id would be more correct. - true -> {duplicate_child_name, Child#child.name}; - false -> check_startspec(T, [Child | Res]) + true -> {duplicate_child_name, Id}; + false -> check_startspec(T, [Id | Ids], Db#{Id=>Child}) end; Error -> Error end; -check_startspec([], Res) -> - {ok, lists:reverse(Res)}. +check_startspec([], Ids, Db) -> + {ok, {lists:reverse(Ids),Db}}. check_childspec(ChildSpec) when is_map(ChildSpec) -> catch do_check_childspec(maps:merge(?default_child_spec,ChildSpec)); -check_childspec({Name, Func, RestartType, Shutdown, ChildType, Mods}) -> - check_childspec(#{id => Name, +check_childspec({Id, Func, RestartType, Shutdown, ChildType, Mods}) -> + check_childspec(#{id => Id, start => Func, restart => RestartType, shutdown => Shutdown, @@ -1320,15 +1274,15 @@ check_childspec(X) -> {invalid_child_spec, X}. do_check_childspec(#{restart := RestartType, type := ChildType} = ChildSpec)-> - Name = case ChildSpec of - #{id := N} -> N; + Id = case ChildSpec of + #{id := I} -> I; _ -> throw(missing_id) end, Func = case ChildSpec of #{start := F} -> F; _ -> throw(missing_start) end, - validName(Name), + validId(Id), validFunc(Func), validRestartType(RestartType), validChildType(ChildType), @@ -1343,14 +1297,14 @@ do_check_childspec(#{restart := RestartType, _ -> {M,_,_} = Func, [M] end, validMods(Mods), - {ok, #child{name = Name, mfargs = Func, restart_type = RestartType, + {ok, #child{id = Id, mfargs = Func, restart_type = RestartType, shutdown = Shutdown, child_type = ChildType, modules = Mods}}. validChildType(supervisor) -> true; validChildType(worker) -> true; validChildType(What) -> throw({invalid_child_type, What}). -validName(_Name) -> true. +validId(_Id) -> true. validFunc({M, F, A}) when is_atom(M), is_atom(F), @@ -1379,13 +1333,13 @@ validMods(Mods) when is_list(Mods) -> Mods); validMods(Mods) -> throw({invalid_modules, Mods}). -child_to_spec(#child{name = Name, +child_to_spec(#child{id = Id, mfargs = Func, restart_type = RestartType, shutdown = Shutdown, child_type = ChildType, modules = Mods}) -> - #{id => Name, + #{id => Id, start => Func, restart => RestartType, shutdown => Shutdown, @@ -1439,17 +1393,16 @@ report_error(Error, Reason, Child, SupName) -> {offender, extract_child(Child)}], error_logger:error_report(supervisor_report, ErrorMsg). - extract_child(Child) when is_list(Child#child.pid) -> [{nb_children, length(Child#child.pid)}, - {id, Child#child.name}, + {id, Child#child.id}, {mfargs, Child#child.mfargs}, {restart_type, Child#child.restart_type}, {shutdown, Child#child.shutdown}, {child_type, Child#child.child_type}]; extract_child(Child) -> [{pid, Child#child.pid}, - {id, Child#child.name}, + {id, Child#child.id}, {mfargs, Child#child.mfargs}, {restart_type, Child#child.restart_type}, {shutdown, Child#child.shutdown}, @@ -1465,3 +1418,46 @@ format_status(terminate, [_PDict, State]) -> format_status(_, [_PDict, State]) -> [{data, [{"State", State}]}, {supervisor, [{"Callback", State#state.module}]}]. + +%%%----------------------------------------------------------------- +%%% Dynamics database access +dyn_size(#state{dynamics = {Mod,Db}}) -> + Mod:size(Db). + +dyn_erase(Pid,#state{dynamics={sets,Db}}=State) -> + State#state{dynamics={sets,sets:del_element(Pid,Db)}}; +dyn_erase(Pid,#state{dynamics={maps,Db}}=State) -> + State#state{dynamics={maps,maps:remove(Pid,Db)}}. + +dyn_store(Pid,_,#state{dynamics={sets,Db}}=State) -> + State#state{dynamics={sets,sets:add_element(Pid,Db)}}; +dyn_store(Pid,Args,#state{dynamics={maps,Db}}=State) -> + State#state{dynamics={maps,Db#{Pid => Args}}}. + +dyn_fold(Fun,Init,#state{dynamics={sets,Db}}) -> + sets:fold(Fun,Init,Db); +dyn_fold(Fun,Init,#state{dynamics={maps,Db}}) -> + maps:fold(fun(Pid,_,Acc) -> Fun(Pid,Acc) end, Init, Db). + +dyn_map(Fun, #state{dynamics={sets,Db}}) -> + lists:map(Fun, sets:to_list(Db)); +dyn_map(Fun, #state{dynamics={maps,Db}}) -> + lists:map(Fun, maps:keys(Db)). + +dyn_exists(Pid, #state{dynamics={sets, Db}}) -> + sets:is_element(Pid, Db); +dyn_exists(Pid, #state{dynamics={maps, Db}}) -> + maps:is_key(Pid, Db). + +dyn_args(_Pid, #state{dynamics={sets, _Db}}) -> + {ok,undefined}; +dyn_args(Pid, #state{dynamics={maps, Db}}) -> + maps:find(Pid, Db). + +dyn_init(State) -> + dyn_init(get_dynamic_child(State),State). + +dyn_init(Child,State) when ?is_temporary(Child) -> + State#state{dynamics={sets,sets:new()}}; +dyn_init(_Child,State) -> + State#state{dynamics={maps,maps:new()}}. diff --git a/lib/stdlib/src/uri_string.erl b/lib/stdlib/src/uri_string.erl new file mode 100644 index 0000000000..a84679c595 --- /dev/null +++ b/lib/stdlib/src/uri_string.erl @@ -0,0 +1,2069 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +%% +%% [RFC 3986, Chapter 2.2. Reserved Characters] +%% +%% reserved = gen-delims / sub-delims +%% +%% gen-delims = ":" / "/" / "?" / "#" / "[" / "]" / "@" +%% +%% sub-delims = "!" / "$" / "&" / "'" / "(" / ")" +%% / "*" / "+" / "," / ";" / "=" +%% +%% +%% [RFC 3986, Chapter 2.3. Unreserved Characters] +%% +%% unreserved = ALPHA / DIGIT / "-" / "." / "_" / "~" +%% +%% +%% [RFC 3986, Chapter 3. Syntax Components] +%% +%% The generic URI syntax consists of a hierarchical sequence of +%% components referred to as the scheme, authority, path, query, and +%% fragment. +%% +%% URI = scheme ":" hier-part [ "?" query ] [ "#" fragment ] +%% +%% hier-part = "//" authority path-abempty +%% / path-absolute +%% / path-rootless +%% / path-empty +%% +%% The scheme and path components are required, though the path may be +%% empty (no characters). When authority is present, the path must +%% either be empty or begin with a slash ("/") character. When +%% authority is not present, the path cannot begin with two slash +%% characters ("//"). These restrictions result in five different ABNF +%% rules for a path (Section 3.3), only one of which will match any +%% given URI reference. +%% +%% The following are two example URIs and their component parts: +%% +%% foo://example.com:8042/over/there?name=ferret#nose +%% \_/ \______________/\_________/ \_________/ \__/ +%% | | | | | +%% scheme authority path query fragment +%% | _____________________|__ +%% / \ / \ +%% urn:example:animal:ferret:nose +%% +%% +%% [RFC 3986, Chapter 3.1. Scheme] +%% +%% Each URI begins with a scheme name that refers to a specification for +%% assigning identifiers within that scheme. +%% +%% scheme = ALPHA *( ALPHA / DIGIT / "+" / "-" / "." ) +%% +%% +%% [RFC 3986, Chapter 3.2. Authority] +%% +%% Many URI schemes include a hierarchical element for a naming +%% authority so that governance of the name space defined by the +%% remainder of the URI is delegated to that authority (which may, in +%% turn, delegate it further). +%% +%% authority = [ userinfo "@" ] host [ ":" port ] +%% +%% +%% [RFC 3986, Chapter 3.2.1. User Information] +%% +%% The userinfo subcomponent may consist of a user name and, optionally, +%% scheme-specific information about how to gain authorization to access +%% the resource. The user information, if present, is followed by a +%% commercial at-sign ("@") that delimits it from the host. +%% +%% userinfo = *( unreserved / pct-encoded / sub-delims / ":" ) +%% +%% +%% [RFC 3986, Chapter 3.2.2. Host] +%% +%% The host subcomponent of authority is identified by an IP literal +%% encapsulated within square brackets, an IPv4 address in dotted- +%% decimal form, or a registered name. +%% +%% host = IP-literal / IPv4address / reg-name +%% +%% IP-literal = "[" ( IPv6address / IPvFuture ) "]" +%% +%% IPvFuture = "v" 1*HEXDIG "." 1*( unreserved / sub-delims / ":" ) +%% +%% IPv6address = 6( h16 ":" ) ls32 +%% / "::" 5( h16 ":" ) ls32 +%% / [ h16 ] "::" 4( h16 ":" ) ls32 +%% / [ *1( h16 ":" ) h16 ] "::" 3( h16 ":" ) ls32 +%% / [ *2( h16 ":" ) h16 ] "::" 2( h16 ":" ) ls32 +%% / [ *3( h16 ":" ) h16 ] "::" h16 ":" ls32 +%% / [ *4( h16 ":" ) h16 ] "::" ls32 +%% / [ *5( h16 ":" ) h16 ] "::" h16 +%% / [ *6( h16 ":" ) h16 ] "::" +%% +%% ls32 = ( h16 ":" h16 ) / IPv4address +%% ; least-significant 32 bits of address +%% +%% h16 = 1*4HEXDIG +%% ; 16 bits of address represented in hexadecimal +%% +%% IPv4address = dec-octet "." dec-octet "." dec-octet "." dec-octet +%% +%% dec-octet = DIGIT ; 0-9 +%% / %x31-39 DIGIT ; 10-99 +%% / "1" 2DIGIT ; 100-199 +%% / "2" %x30-34 DIGIT ; 200-249 +%% / "25" %x30-35 ; 250-255 +%% +%% reg-name = *( unreserved / pct-encoded / sub-delims ) +%% +%% +%% [RFC 3986, Chapter 3.2.2. Port] +%% +%% The port subcomponent of authority is designated by an optional port +%% number in decimal following the host and delimited from it by a +%% single colon (":") character. +%% +%% port = *DIGIT +%% +%% +%% [RFC 3986, Chapter 3.3. Path] +%% +%% The path component contains data, usually organized in hierarchical +%% form, that, along with data in the non-hierarchical query component +%% (Section 3.4), serves to identify a resource within the scope of the +%% URI's scheme and naming authority (if any). The path is terminated +%% by the first question mark ("?") or number sign ("#") character, or +%% by the end of the URI. +%% +%% path = path-abempty ; begins with "/" or is empty +%% / path-absolute ; begins with "/" but not "//" +%% / path-noscheme ; begins with a non-colon segment +%% / path-rootless ; begins with a segment +%% / path-empty ; zero characters +%% +%% path-abempty = *( "/" segment ) +%% path-absolute = "/" [ segment-nz *( "/" segment ) ] +%% path-noscheme = segment-nz-nc *( "/" segment ) +%% path-rootless = segment-nz *( "/" segment ) +%% path-empty = 0<pchar> +%% segment = *pchar +%% segment-nz = 1*pchar +%% segment-nz-nc = 1*( unreserved / pct-encoded / sub-delims / "@" ) +%% ; non-zero-length segment without any colon ":" +%% +%% pchar = unreserved / pct-encoded / sub-delims / ":" / "@" +%% +%% +%% [RFC 3986, Chapter 3.4. Query] +%% +%% The query component contains non-hierarchical data that, along with +%% data in the path component (Section 3.3), serves to identify a +%% resource within the scope of the URI's scheme and naming authority +%% (if any). The query component is indicated by the first question +%% mark ("?") character and terminated by a number sign ("#") character +%% or by the end of the URI. +%% +%% query = *( pchar / "/" / "?" ) +%% +%% +%% [RFC 3986, Chapter 3.5. Fragment] +%% +%% The fragment identifier component of a URI allows indirect +%% identification of a secondary resource by reference to a primary +%% resource and additional identifying information. +%% +%% fragment = *( pchar / "/" / "?" ) +%% +%% +%% [RFC 3986, Chapter 4.1. URI Reference] +%% +%% URI-reference is used to denote the most common usage of a resource +%% identifier. +%% +%% URI-reference = URI / relative-ref +%% +%% +%% [RFC 3986, Chapter 4.2. Relative Reference] +%% +%% A relative reference takes advantage of the hierarchical syntax +%% (Section 1.2.3) to express a URI reference relative to the name space +%% of another hierarchical URI. +%% +%% relative-ref = relative-part [ "?" query ] [ "#" fragment ] +%% +%% relative-part = "//" authority path-abempty +%% / path-absolute +%% / path-noscheme +%% / path-empty +%% +%% +%% [RFC 3986, Chapter 4.3. Absolute URI] +%% +%% Some protocol elements allow only the absolute form of a URI without +%% a fragment identifier. For example, defining a base URI for later +%% use by relative references calls for an absolute-URI syntax rule that +%% does not allow a fragment. +%% +%% absolute-URI = scheme ":" hier-part [ "?" query ] +%% +-module(uri_string). + +%%------------------------------------------------------------------------- +%% External API +%%------------------------------------------------------------------------- +-export([compose_query/1, compose_query/2, + dissect_query/1, normalize/1, parse/1, + recompose/1, transcode/2]). +-export_type([error/0, uri_map/0, uri_string/0]). + + +%%------------------------------------------------------------------------- +%% Internal API +%%------------------------------------------------------------------------- +-export([is_host/1, is_path/1]). % suppress warnings + + +%%------------------------------------------------------------------------- +%% Macros +%%------------------------------------------------------------------------- +-define(CHAR(Char), <<Char/utf8>>). +-define(STRING_EMPTY, <<>>). +-define(STRING(MatchStr), <<MatchStr/binary>>). +-define(STRING_REST(MatchStr, Rest), <<MatchStr/utf8, Rest/binary>>). + +-define(DEC2HEX(X), + if ((X) >= 0) andalso ((X) =< 9) -> (X) + $0; + ((X) >= 10) andalso ((X) =< 15) -> (X) + $A - 10 + end). + +-define(HEX2DEC(X), + if ((X) >= $0) andalso ((X) =< $9) -> (X) - $0; + ((X) >= $A) andalso ((X) =< $F) -> (X) - $A + 10; + ((X) >= $a) andalso ((X) =< $f) -> (X) - $a + 10 + end). + + +%%%========================================================================= +%%% API +%%%========================================================================= + +%%------------------------------------------------------------------------- +%% URI compliant with RFC 3986 +%% ASCII %x21 - %x7A ("!" - "z") except +%% %x34 " double quote +%% %x60 < less than +%% %x62 > greater than +%% %x92 \ backslash +%% %x94 ^ caret / circumflex +%% %x96 ` grave / accent +%%------------------------------------------------------------------------- +-type uri_string() :: iodata(). +-type error() :: {error, atom(), term()}. + + +%%------------------------------------------------------------------------- +%% RFC 3986, Chapter 3. Syntax Components +%%------------------------------------------------------------------------- +-type uri_map() :: + #{fragment => unicode:chardata(), + host => unicode:chardata(), + path => unicode:chardata(), + port => non_neg_integer() | undefined, + query => unicode:chardata(), + scheme => unicode:chardata(), + userinfo => unicode:chardata()} | #{}. + + +%%------------------------------------------------------------------------- +%% Normalize URIs +%%------------------------------------------------------------------------- +-spec normalize(URIString) -> NormalizedURI when + URIString :: uri_string(), + NormalizedURI :: uri_string(). +normalize(URIString) -> + %% Percent-encoding normalization and case normalization for + %% percent-encoded triplets are achieved by running parse and + %% recompose on the input URI string. + recompose( + normalize_path_segment( + normalize_scheme_based( + normalize_case( + parse(URIString))))). + + +%%------------------------------------------------------------------------- +%% Parse URIs +%%------------------------------------------------------------------------- +-spec parse(URIString) -> URIMap when + URIString :: uri_string(), + URIMap :: uri_map() + | error(). +parse(URIString) when is_binary(URIString) -> + try parse_uri_reference(URIString, #{}) + catch + throw:{error, Atom, RestData} -> {error, Atom, RestData} + end; +parse(URIString) when is_list(URIString) -> + try + Binary = unicode:characters_to_binary(URIString), + Map = parse_uri_reference(Binary, #{}), + convert_mapfields_to_list(Map) + catch + throw:{error, Atom, RestData} -> {error, Atom, RestData} + end. + + +%%------------------------------------------------------------------------- +%% Recompose URIs +%%------------------------------------------------------------------------- +-spec recompose(URIMap) -> URIString when + URIMap :: uri_map(), + URIString :: uri_string() + | error(). +recompose(Map) -> + case is_valid_map(Map) of + false -> + {error, invalid_map, Map}; + true -> + try + T0 = update_scheme(Map, empty), + T1 = update_userinfo(Map, T0), + T2 = update_host(Map, T1), + T3 = update_port(Map, T2), + T4 = update_path(Map, T3), + T5 = update_query(Map, T4), + update_fragment(Map, T5) + catch + throw:{error, Atom, RestData} -> {error, Atom, RestData} + end + end. + + +%%------------------------------------------------------------------------- +%% Transcode URIs +%%------------------------------------------------------------------------- +-spec transcode(URIString, Options) -> Result when + URIString :: uri_string(), + Options :: [{in_encoding, unicode:encoding()}|{out_encoding, unicode:encoding()}], + Result :: uri_string() + | error(). +transcode(URIString, Options) when is_binary(URIString) -> + try + InEnc = proplists:get_value(in_encoding, Options, utf8), + OutEnc = proplists:get_value(out_encoding, Options, utf8), + List = convert_to_list(URIString, InEnc), + Output = transcode(List, [], InEnc, OutEnc), + convert_to_binary(Output, utf8, OutEnc) + catch + throw:{error, Atom, RestData} -> {error, Atom, RestData} + end; +transcode(URIString, Options) when is_list(URIString) -> + InEnc = proplists:get_value(in_encoding, Options, utf8), + OutEnc = proplists:get_value(out_encoding, Options, utf8), + Flattened = flatten_list(URIString, InEnc), + try transcode(Flattened, [], InEnc, OutEnc) + catch + throw:{error, Atom, RestData} -> {error, Atom, RestData} + end. + + +%%------------------------------------------------------------------------- +%% Functions for working with the query part of a URI as a list +%% of key/value pairs. +%% HTML5 - 4.10.22.6 URL-encoded form data +%%------------------------------------------------------------------------- + +%%------------------------------------------------------------------------- +%% Compose urlencoded query string from a list of unescaped key/value pairs. +%% (application/x-www-form-urlencoded encoding algorithm) +%%------------------------------------------------------------------------- +-spec compose_query(QueryList) -> QueryString when + QueryList :: [{uri_string(), uri_string()}], + QueryString :: uri_string() + | error(). +compose_query(List) -> + compose_query(List, [{encoding, utf8}]). + + +-spec compose_query(QueryList, Options) -> QueryString when + QueryList :: [{uri_string(), uri_string()}], + Options :: [{encoding, atom()}], + QueryString :: uri_string() + | error(). +compose_query([],_Options) -> + []; +compose_query(List, Options) -> + try compose_query(List, Options, false, <<>>) + catch + throw:{error, Atom, RestData} -> {error, Atom, RestData} + end. +%% +compose_query([{Key,Value}|Rest], Options, IsList, Acc) -> + Separator = get_separator(Rest), + K = form_urlencode(Key, Options), + V = form_urlencode(Value, Options), + IsListNew = IsList orelse is_list(Key) orelse is_list(Value), + compose_query(Rest, Options, IsListNew, <<Acc/binary,K/binary,"=",V/binary,Separator/binary>>); +compose_query([], _Options, IsList, Acc) -> + case IsList of + true -> convert_to_list(Acc, utf8); + false -> Acc + end. + + +%%------------------------------------------------------------------------- +%% Dissect a query string into a list of unescaped key/value pairs. +%% (application/x-www-form-urlencoded decoding algorithm) +%%------------------------------------------------------------------------- +-spec dissect_query(QueryString) -> QueryList when + QueryString :: uri_string(), + QueryList :: [{uri_string(), uri_string()}] + | error(). +dissect_query(<<>>) -> + []; +dissect_query([]) -> + []; +dissect_query(QueryString) when is_list(QueryString) -> + try + B = convert_to_binary(QueryString, utf8, utf8), + dissect_query_key(B, true, [], <<>>, <<>>) + catch + throw:{error, Atom, RestData} -> {error, Atom, RestData} + end; +dissect_query(QueryString) -> + try dissect_query_key(QueryString, false, [], <<>>, <<>>) + catch + throw:{error, Atom, RestData} -> {error, Atom, RestData} + end. + + +%%%======================================================================== +%%% Internal functions +%%%======================================================================== + +%%------------------------------------------------------------------------- +%% Converts Map fields to lists +%%------------------------------------------------------------------------- +convert_mapfields_to_list(Map) -> + Fun = fun (_, V) when is_binary(V) -> unicode:characters_to_list(V); + (_, V) -> V end, + maps:map(Fun, Map). + + +%%------------------------------------------------------------------------- +%% [RFC 3986, Chapter 4.1. URI Reference] +%% +%% URI-reference is used to denote the most common usage of a resource +%% identifier. +%% +%% URI-reference = URI / relative-ref +%%------------------------------------------------------------------------- +-spec parse_uri_reference(binary(), uri_map()) -> uri_map(). +parse_uri_reference(<<>>, _) -> #{path => <<>>}; +parse_uri_reference(URIString, URI) -> + try parse_scheme_start(URIString, URI) + catch + throw:{_,_,_} -> + parse_relative_part(URIString, URI) + end. + + +%%------------------------------------------------------------------------- +%% [RFC 3986, Chapter 4.2. Relative Reference] +%% +%% A relative reference takes advantage of the hierarchical syntax +%% (Section 1.2.3) to express a URI reference relative to the name space +%% of another hierarchical URI. +%% +%% relative-ref = relative-part [ "?" query ] [ "#" fragment ] +%% +%% relative-part = "//" authority path-abempty +%% / path-absolute +%% / path-noscheme +%% / path-empty +%%------------------------------------------------------------------------- +-spec parse_relative_part(binary(), uri_map()) -> uri_map(). +parse_relative_part(?STRING_REST("//", Rest), URI) -> + %% Parse userinfo - "//" is NOT part of authority + try parse_userinfo(Rest, URI) of + {T, URI1} -> + Userinfo = calculate_parsed_userinfo(Rest, T), + URI2 = maybe_add_path(URI1), + URI2#{userinfo => decode_userinfo(Userinfo)} + catch + throw:{_,_,_} -> + {T, URI1} = parse_host(Rest, URI), + Host = calculate_parsed_host_port(Rest, T), + URI2 = maybe_add_path(URI1), + URI2#{host => decode_host(remove_brackets(Host))} + end; +parse_relative_part(?STRING_REST($/, Rest), URI) -> + {T, URI1} = parse_segment(Rest, URI), % path-absolute + Path = calculate_parsed_part(Rest, T), + URI1#{path => decode_path(?STRING_REST($/, Path))}; +parse_relative_part(?STRING_REST($?, Rest), URI) -> + {T, URI1} = parse_query(Rest, URI), % path-empty ?query + Query = calculate_parsed_query_fragment(Rest, T), + URI2 = maybe_add_path(URI1), + URI2#{query => decode_query(Query)}; +parse_relative_part(?STRING_REST($#, Rest), URI) -> + {T, URI1} = parse_fragment(Rest, URI), % path-empty + Fragment = calculate_parsed_query_fragment(Rest, T), + URI2 = maybe_add_path(URI1), + URI2#{fragment => decode_fragment(Fragment)}; +parse_relative_part(?STRING_REST(Char, Rest), URI) -> + case is_segment_nz_nc(Char) of + true -> + {T, URI1} = parse_segment_nz_nc(Rest, URI), % path-noscheme + Path = calculate_parsed_part(Rest, T), + URI1#{path => decode_path(?STRING_REST(Char, Path))}; + false -> throw({error,invalid_uri,[Char]}) + end. + + +%%------------------------------------------------------------------------- +%% [RFC 3986, Chapter 3.3. Path] +%% +%% The path component contains data, usually organized in hierarchical +%% form, that, along with data in the non-hierarchical query component +%% (Section 3.4), serves to identify a resource within the scope of the +%% URI's scheme and naming authority (if any). The path is terminated +%% by the first question mark ("?") or number sign ("#") character, or +%% by the end of the URI. +%% +%% path = path-abempty ; begins with "/" or is empty +%% / path-absolute ; begins with "/" but not "//" +%% / path-noscheme ; begins with a non-colon segment +%% / path-rootless ; begins with a segment +%% / path-empty ; zero characters +%% +%% path-abempty = *( "/" segment ) +%% path-absolute = "/" [ segment-nz *( "/" segment ) ] +%% path-noscheme = segment-nz-nc *( "/" segment ) +%% path-rootless = segment-nz *( "/" segment ) +%% path-empty = 0<pchar> +%% segment = *pchar +%% segment-nz = 1*pchar +%% segment-nz-nc = 1*( unreserved / pct-encoded / sub-delims / "@" ) +%% ; non-zero-length segment without any colon ":" +%% +%% pchar = unreserved / pct-encoded / sub-delims / ":" / "@" +%%------------------------------------------------------------------------- + +%%------------------------------------------------------------------------- +%% path-abempty +%%------------------------------------------------------------------------- +-spec parse_segment(binary(), uri_map()) -> {binary(), uri_map()}. +parse_segment(?STRING_REST($/, Rest), URI) -> + parse_segment(Rest, URI); % segment +parse_segment(?STRING_REST($?, Rest), URI) -> + {T, URI1} = parse_query(Rest, URI), % ?query + Query = calculate_parsed_query_fragment(Rest, T), + {Rest, URI1#{query => decode_query(Query)}}; +parse_segment(?STRING_REST($#, Rest), URI) -> + {T, URI1} = parse_fragment(Rest, URI), + Fragment = calculate_parsed_query_fragment(Rest, T), + {Rest, URI1#{fragment => decode_fragment(Fragment)}}; +parse_segment(?STRING_REST(Char, Rest), URI) -> + case is_pchar(Char) of + true -> parse_segment(Rest, URI); + false -> throw({error,invalid_uri,[Char]}) + end; +parse_segment(?STRING_EMPTY, URI) -> + {?STRING_EMPTY, URI}. + + +%%------------------------------------------------------------------------- +%% path-noscheme +%%------------------------------------------------------------------------- +-spec parse_segment_nz_nc(binary(), uri_map()) -> {binary(), uri_map()}. +parse_segment_nz_nc(?STRING_REST($/, Rest), URI) -> + parse_segment(Rest, URI); % segment +parse_segment_nz_nc(?STRING_REST($?, Rest), URI) -> + {T, URI1} = parse_query(Rest, URI), % ?query + Query = calculate_parsed_query_fragment(Rest, T), + {Rest, URI1#{query => decode_query(Query)}}; +parse_segment_nz_nc(?STRING_REST($#, Rest), URI) -> + {T, URI1} = parse_fragment(Rest, URI), + Fragment = calculate_parsed_query_fragment(Rest, T), + {Rest, URI1#{fragment => decode_fragment(Fragment)}}; +parse_segment_nz_nc(?STRING_REST(Char, Rest), URI) -> + case is_segment_nz_nc(Char) of + true -> parse_segment_nz_nc(Rest, URI); + false -> throw({error,invalid_uri,[Char]}) + end; +parse_segment_nz_nc(?STRING_EMPTY, URI) -> + {?STRING_EMPTY, URI}. + + +%% Check if char is pchar. +-spec is_pchar(char()) -> boolean(). +is_pchar($%) -> true; % pct-encoded +is_pchar($:) -> true; +is_pchar($@) -> true; +is_pchar(Char) -> is_unreserved(Char) orelse is_sub_delim(Char). + +%% Check if char is segment_nz_nc. +-spec is_segment_nz_nc(char()) -> boolean(). +is_segment_nz_nc($%) -> true; % pct-encoded +is_segment_nz_nc($@) -> true; +is_segment_nz_nc(Char) -> is_unreserved(Char) orelse is_sub_delim(Char). + + +%%------------------------------------------------------------------------- +%% [RFC 3986, Chapter 3.1. Scheme] +%% +%% Each URI begins with a scheme name that refers to a specification for +%% assigning identifiers within that scheme. +%% +%% scheme = ALPHA *( ALPHA / DIGIT / "+" / "-" / "." ) +%%------------------------------------------------------------------------- +-spec parse_scheme_start(binary(), uri_map()) -> uri_map(). +parse_scheme_start(?STRING_REST(Char, Rest), URI) -> + case is_alpha(Char) of + true -> {T, URI1} = parse_scheme(Rest, URI), + Scheme = calculate_parsed_scheme(Rest, T), + URI2 = maybe_add_path(URI1), + URI2#{scheme => ?STRING_REST(Char, Scheme)}; + false -> throw({error,invalid_uri,[Char]}) + end. + +%% Add path component if it missing after parsing the URI. +%% According to the URI specification there is always a +%% path component in every URI-reference and it can be +%% empty. +maybe_add_path(Map) -> + case maps:is_key(path, Map) of + false -> + Map#{path => <<>>}; + _Else -> + Map + end. + + + +-spec parse_scheme(binary(), uri_map()) -> {binary(), uri_map()}. +parse_scheme(?STRING_REST($:, Rest), URI) -> + {_, URI1} = parse_hier(Rest, URI), + {Rest, URI1}; +parse_scheme(?STRING_REST(Char, Rest), URI) -> + case is_scheme(Char) of + true -> parse_scheme(Rest, URI); + false -> throw({error,invalid_uri,[Char]}) + end; +parse_scheme(?STRING_EMPTY, _URI) -> + throw({error,invalid_uri,<<>>}). + + +%% Check if char is allowed in scheme +-spec is_scheme(char()) -> boolean(). +is_scheme($+) -> true; +is_scheme($-) -> true; +is_scheme($.) -> true; +is_scheme(Char) -> is_alpha(Char) orelse is_digit(Char). + + +%%------------------------------------------------------------------------- +%% hier-part = "//" authority path-abempty +%% / path-absolute +%% / path-rootless +%% / path-empty +%%------------------------------------------------------------------------- +-spec parse_hier(binary(), uri_map()) -> {binary(), uri_map()}. +parse_hier(?STRING_REST("//", Rest), URI) -> + % Parse userinfo - "//" is NOT part of authority + try parse_userinfo(Rest, URI) of + {T, URI1} -> + Userinfo = calculate_parsed_userinfo(Rest, T), + {Rest, URI1#{userinfo => decode_userinfo(Userinfo)}} + catch + throw:{_,_,_} -> + {T, URI1} = parse_host(Rest, URI), + Host = calculate_parsed_host_port(Rest, T), + {Rest, URI1#{host => decode_host(remove_brackets(Host))}} + end; +parse_hier(?STRING_REST($/, Rest), URI) -> + {T, URI1} = parse_segment(Rest, URI), % path-absolute + Path = calculate_parsed_part(Rest, T), + {Rest, URI1#{path => decode_path(?STRING_REST($/, Path))}}; +parse_hier(?STRING_REST($?, Rest), URI) -> + {T, URI1} = parse_query(Rest, URI), % path-empty ?query + Query = calculate_parsed_query_fragment(Rest, T), + {Rest, URI1#{query => decode_query(Query)}}; +parse_hier(?STRING_REST($#, Rest), URI) -> + {T, URI1} = parse_fragment(Rest, URI), % path-empty + Fragment = calculate_parsed_query_fragment(Rest, T), + {Rest, URI1#{fragment => decode_fragment(Fragment)}}; +parse_hier(?STRING_REST(Char, Rest), URI) -> % path-rootless + case is_pchar(Char) of + true -> % segment_nz + {T, URI1} = parse_segment(Rest, URI), + Path = calculate_parsed_part(Rest, T), + {Rest, URI1#{path => decode_path(?STRING_REST(Char, Path))}}; + false -> throw({error,invalid_uri,[Char]}) + end; +parse_hier(?STRING_EMPTY, URI) -> + {<<>>, URI}. + + +%%------------------------------------------------------------------------- +%% [RFC 3986, Chapter 3.2. Authority] +%% +%% Many URI schemes include a hierarchical element for a naming +%% authority so that governance of the name space defined by the +%% remainder of the URI is delegated to that authority (which may, in +%% turn, delegate it further). +%% +%% The authority component is preceded by a double slash ("//") and is +%% terminated by the next slash ("/"), question mark ("?"), or number +%% sign ("#") character, or by the end of the URI. +%% +%% authority = [ userinfo "@" ] host [ ":" port ] +%% +%% +%% [RFC 3986, Chapter 3.2.1. User Information] +%% +%% The userinfo subcomponent may consist of a user name and, optionally, +%% scheme-specific information about how to gain authorization to access +%% the resource. The user information, if present, is followed by a +%% commercial at-sign ("@") that delimits it from the host. +%% +%% userinfo = *( unreserved / pct-encoded / sub-delims / ":" ) +%%------------------------------------------------------------------------- +-spec parse_userinfo(binary(), uri_map()) -> {binary(), uri_map()}. +parse_userinfo(?CHAR($@), URI) -> + {?STRING_EMPTY, URI#{host => <<>>}}; +parse_userinfo(?STRING_REST($@, Rest), URI) -> + {T, URI1} = parse_host(Rest, URI), + Host = calculate_parsed_host_port(Rest, T), + {Rest, URI1#{host => decode_host(remove_brackets(Host))}}; +parse_userinfo(?STRING_REST(Char, Rest), URI) -> + case is_userinfo(Char) of + true -> parse_userinfo(Rest, URI); + false -> throw({error,invalid_uri,[Char]}) + end; +parse_userinfo(?STRING_EMPTY, _URI) -> + %% URI cannot end in userinfo state + throw({error,invalid_uri,<<>>}). + + +%% Check if char is allowed in userinfo +-spec is_userinfo(char()) -> boolean(). +is_userinfo($%) -> true; % pct-encoded +is_userinfo($:) -> true; +is_userinfo(Char) -> is_unreserved(Char) orelse is_sub_delim(Char). + + +%%------------------------------------------------------------------------- +%% [RFC 3986, Chapter 3.2.2. Host] +%% +%% The host subcomponent of authority is identified by an IP literal +%% encapsulated within square brackets, an IPv4 address in dotted- +%% decimal form, or a registered name. +%% +%% host = IP-literal / IPv4address / reg-name +%% +%% IP-literal = "[" ( IPv6address / IPvFuture ) "]" +%% +%% IPvFuture = "v" 1*HEXDIG "." 1*( unreserved / sub-delims / ":" ) +%% +%% IPv6address = 6( h16 ":" ) ls32 +%% / "::" 5( h16 ":" ) ls32 +%% / [ h16 ] "::" 4( h16 ":" ) ls32 +%% / [ *1( h16 ":" ) h16 ] "::" 3( h16 ":" ) ls32 +%% / [ *2( h16 ":" ) h16 ] "::" 2( h16 ":" ) ls32 +%% / [ *3( h16 ":" ) h16 ] "::" h16 ":" ls32 +%% / [ *4( h16 ":" ) h16 ] "::" ls32 +%% / [ *5( h16 ":" ) h16 ] "::" h16 +%% / [ *6( h16 ":" ) h16 ] "::" +%% +%% ls32 = ( h16 ":" h16 ) / IPv4address +%% ; least-significant 32 bits of address +%% +%% h16 = 1*4HEXDIG +%% ; 16 bits of address represented in hexadecimal +%% +%% IPv4address = dec-octet "." dec-octet "." dec-octet "." dec-octet +%% +%% dec-octet = DIGIT ; 0-9 +%% / %x31-39 DIGIT ; 10-99 +%% / "1" 2DIGIT ; 100-199 +%% / "2" %x30-34 DIGIT ; 200-249 +%% / "25" %x30-35 ; 250-255 +%% +%% reg-name = *( unreserved / pct-encoded / sub-delims ) +%%------------------------------------------------------------------------- +-spec parse_host(binary(), uri_map()) -> {binary(), uri_map()}. +parse_host(?STRING_REST($:, Rest), URI) -> + {T, URI1} = parse_port(Rest, URI), + H = calculate_parsed_host_port(Rest, T), + Port = get_port(H), + {Rest, URI1#{port => Port}}; +parse_host(?STRING_REST($/, Rest), URI) -> + {T, URI1} = parse_segment(Rest, URI), % path-abempty + Path = calculate_parsed_part(Rest, T), + {Rest, URI1#{path => decode_path(?STRING_REST($/, Path))}}; +parse_host(?STRING_REST($?, Rest), URI) -> + {T, URI1} = parse_query(Rest, URI), % path-empty ?query + Query = calculate_parsed_query_fragment(Rest, T), + {Rest, URI1#{query => decode_query(Query)}}; +parse_host(?STRING_REST($[, Rest), URI) -> + parse_ipv6_bin(Rest, [], URI); +parse_host(?STRING_REST($#, Rest), URI) -> + {T, URI1} = parse_fragment(Rest, URI), % path-empty + Fragment = calculate_parsed_query_fragment(Rest, T), + {Rest, URI1#{fragment => decode_fragment(Fragment)}}; +parse_host(?STRING_REST(Char, Rest), URI) -> + case is_digit(Char) of + true -> parse_ipv4_bin(Rest, [Char], URI); + false -> parse_reg_name(?STRING_REST(Char, Rest), URI) + end; +parse_host(?STRING_EMPTY, URI) -> + {?STRING_EMPTY, URI}. + + +-spec parse_reg_name(binary(), uri_map()) -> {binary(), uri_map()}. +parse_reg_name(?STRING_REST($:, Rest), URI) -> + {T, URI1} = parse_port(Rest, URI), + H = calculate_parsed_host_port(Rest, T), + Port = get_port(H), + {Rest, URI1#{port => Port}}; +parse_reg_name(?STRING_REST($/, Rest), URI) -> + {T, URI1} = parse_segment(Rest, URI), % path-abempty + Path = calculate_parsed_part(Rest, T), + {Rest, URI1#{path => decode_path(?STRING_REST($/, Path))}}; +parse_reg_name(?STRING_REST($?, Rest), URI) -> + {T, URI1} = parse_query(Rest, URI), % path-empty ?query + Query = calculate_parsed_query_fragment(Rest, T), + {Rest, URI1#{query => decode_query(Query)}}; +parse_reg_name(?STRING_REST($#, Rest), URI) -> + {T, URI1} = parse_fragment(Rest, URI), % path-empty + Fragment = calculate_parsed_query_fragment(Rest, T), + {Rest, URI1#{fragment => decode_fragment(Fragment)}}; +parse_reg_name(?STRING_REST(Char, Rest), URI) -> + case is_reg_name(Char) of + true -> parse_reg_name(Rest, URI); + false -> throw({error,invalid_uri,[Char]}) + end; +parse_reg_name(?STRING_EMPTY, URI) -> + {?STRING_EMPTY, URI}. + +%% Check if char is allowed in reg-name +-spec is_reg_name(char()) -> boolean(). +is_reg_name($%) -> true; +is_reg_name(Char) -> is_unreserved(Char) orelse is_sub_delim(Char). + + +-spec parse_ipv4_bin(binary(), list(), uri_map()) -> {binary(), uri_map()}. +parse_ipv4_bin(?STRING_REST($:, Rest), Acc, URI) -> + _ = validate_ipv4_address(lists:reverse(Acc)), + {T, URI1} = parse_port(Rest, URI), + H = calculate_parsed_host_port(Rest, T), + Port = get_port(H), + {Rest, URI1#{port => Port}}; +parse_ipv4_bin(?STRING_REST($/, Rest), Acc, URI) -> + _ = validate_ipv4_address(lists:reverse(Acc)), + {T, URI1} = parse_segment(Rest, URI), % path-abempty + Path = calculate_parsed_part(Rest, T), + {Rest, URI1#{path => decode_path(?STRING_REST($/, Path))}}; +parse_ipv4_bin(?STRING_REST($?, Rest), Acc, URI) -> + _ = validate_ipv4_address(lists:reverse(Acc)), + {T, URI1} = parse_query(Rest, URI), % path-empty ?query + Query = calculate_parsed_query_fragment(Rest, T), + {Rest, URI1#{query => decode_query(Query)}}; +parse_ipv4_bin(?STRING_REST($#, Rest), Acc, URI) -> + _ = validate_ipv4_address(lists:reverse(Acc)), + {T, URI1} = parse_fragment(Rest, URI), % path-empty + Fragment = calculate_parsed_query_fragment(Rest, T), + {Rest, URI1#{fragment => decode_fragment(Fragment)}}; +parse_ipv4_bin(?STRING_REST(Char, Rest), Acc, URI) -> + case is_ipv4(Char) of + true -> parse_ipv4_bin(Rest, [Char|Acc], URI); + false -> throw({error,invalid_uri,[Char]}) + end; +parse_ipv4_bin(?STRING_EMPTY, Acc, URI) -> + _ = validate_ipv4_address(lists:reverse(Acc)), + {?STRING_EMPTY, URI}. + + +%% Check if char is allowed in IPv4 addresses +-spec is_ipv4(char()) -> boolean(). +is_ipv4($.) -> true; +is_ipv4(Char) -> is_digit(Char). + +-spec validate_ipv4_address(list()) -> list(). +validate_ipv4_address(Addr) -> + case inet:parse_ipv4strict_address(Addr) of + {ok, _} -> Addr; + {error, _} -> throw({error,invalid_uri,Addr}) + end. + + +-spec parse_ipv6_bin(binary(), list(), uri_map()) -> {binary(), uri_map()}. +parse_ipv6_bin(?STRING_REST($], Rest), Acc, URI) -> + _ = validate_ipv6_address(lists:reverse(Acc)), + parse_ipv6_bin_end(Rest, URI); +parse_ipv6_bin(?STRING_REST(Char, Rest), Acc, URI) -> + case is_ipv6(Char) of + true -> parse_ipv6_bin(Rest, [Char|Acc], URI); + false -> throw({error,invalid_uri,[Char]}) + end; +parse_ipv6_bin(?STRING_EMPTY, _Acc, _URI) -> + throw({error,invalid_uri,<<>>}). + +%% Check if char is allowed in IPv6 addresses +-spec is_ipv6(char()) -> boolean(). +is_ipv6($:) -> true; +is_ipv6($.) -> true; +is_ipv6(Char) -> is_hex_digit(Char). + + +-spec parse_ipv6_bin_end(binary(), uri_map()) -> {binary(), uri_map()}. +parse_ipv6_bin_end(?STRING_REST($:, Rest), URI) -> + {T, URI1} = parse_port(Rest, URI), + H = calculate_parsed_host_port(Rest, T), + Port = get_port(H), + {Rest, URI1#{port => Port}}; +parse_ipv6_bin_end(?STRING_REST($/, Rest), URI) -> + {T, URI1} = parse_segment(Rest, URI), % path-abempty + Path = calculate_parsed_part(Rest, T), + {Rest, URI1#{path => decode_path(?STRING_REST($/, Path))}}; +parse_ipv6_bin_end(?STRING_REST($?, Rest), URI) -> + {T, URI1} = parse_query(Rest, URI), % path-empty ?query + Query = calculate_parsed_query_fragment(Rest, T), + {Rest, URI1#{query => decode_query(Query)}}; +parse_ipv6_bin_end(?STRING_REST($#, Rest), URI) -> + {T, URI1} = parse_fragment(Rest, URI), % path-empty + Fragment = calculate_parsed_query_fragment(Rest, T), + {Rest, URI1#{fragment => decode_fragment(Fragment)}}; +parse_ipv6_bin_end(?STRING_REST(Char, Rest), URI) -> + case is_ipv6(Char) of + true -> parse_ipv6_bin_end(Rest, URI); + false -> throw({error,invalid_uri,[Char]}) + end; +parse_ipv6_bin_end(?STRING_EMPTY, URI) -> + {?STRING_EMPTY, URI}. + +-spec validate_ipv6_address(list()) -> list(). +validate_ipv6_address(Addr) -> + case inet:parse_ipv6strict_address(Addr) of + {ok, _} -> Addr; + {error, _} -> throw({error,invalid_uri,Addr}) + end. + + +%%------------------------------------------------------------------------- +%% [RFC 3986, Chapter 3.2.2. Port] +%% +%% The port subcomponent of authority is designated by an optional port +%% number in decimal following the host and delimited from it by a +%% single colon (":") character. +%% +%% port = *DIGIT +%%------------------------------------------------------------------------- +-spec parse_port(binary(), uri_map()) -> {binary(), uri_map()}. +parse_port(?STRING_REST($/, Rest), URI) -> + {T, URI1} = parse_segment(Rest, URI), % path-abempty + Path = calculate_parsed_part(Rest, T), + {Rest, URI1#{path => decode_path(?STRING_REST($/, Path))}}; +parse_port(?STRING_REST($?, Rest), URI) -> + {T, URI1} = parse_query(Rest, URI), % path-empty ?query + Query = calculate_parsed_query_fragment(Rest, T), + {Rest, URI1#{query => decode_query(Query)}}; +parse_port(?STRING_REST($#, Rest), URI) -> + {T, URI1} = parse_fragment(Rest, URI), % path-empty + Fragment = calculate_parsed_query_fragment(Rest, T), + {Rest, URI1#{fragment => decode_fragment(Fragment)}}; +parse_port(?STRING_REST(Char, Rest), URI) -> + case is_digit(Char) of + true -> parse_port(Rest, URI); + false -> throw({error,invalid_uri,[Char]}) + end; +parse_port(?STRING_EMPTY, URI) -> + {?STRING_EMPTY, URI}. + + +%%------------------------------------------------------------------------- +%% [RFC 3986, Chapter 3.4. Query] +%% +%% The query component contains non-hierarchical data that, along with +%% data in the path component (Section 3.3), serves to identify a +%% resource within the scope of the URI's scheme and naming authority +%% (if any). The query component is indicated by the first question +%% mark ("?") character and terminated by a number sign ("#") character +%% or by the end of the URI. +%% +%% query = *( pchar / "/" / "?" ) +%%------------------------------------------------------------------------- +-spec parse_query(binary(), uri_map()) -> {binary(), uri_map()}. +parse_query(?STRING_REST($#, Rest), URI) -> + {T, URI1} = parse_fragment(Rest, URI), + Fragment = calculate_parsed_query_fragment(Rest, T), + {Rest, URI1#{fragment => decode_fragment(Fragment)}}; +parse_query(?STRING_REST(Char, Rest), URI) -> + case is_query(Char) of + true -> parse_query(Rest, URI); + false -> throw({error,invalid_uri,[Char]}) + end; +parse_query(?STRING_EMPTY, URI) -> + {?STRING_EMPTY, URI}. + + +%% Check if char is allowed in query +-spec is_query(char()) -> boolean(). +is_query($/) -> true; +is_query($?) -> true; +is_query(Char) -> is_pchar(Char). + + +%%------------------------------------------------------------------------- +%% [RFC 3986, Chapter 3.5. Fragment] +%% +%% The fragment identifier component of a URI allows indirect +%% identification of a secondary resource by reference to a primary +%% resource and additional identifying information. +%% +%% fragment = *( pchar / "/" / "?" ) +%%------------------------------------------------------------------------- +-spec parse_fragment(binary(), uri_map()) -> {binary(), uri_map()}. +parse_fragment(?STRING_REST(Char, Rest), URI) -> + case is_fragment(Char) of + true -> parse_fragment(Rest, URI); + false -> throw({error,invalid_uri,[Char]}) + end; +parse_fragment(?STRING_EMPTY, URI) -> + {?STRING_EMPTY, URI}. + + +%% Check if char is allowed in fragment +-spec is_fragment(char()) -> boolean(). +is_fragment($/) -> true; +is_fragment($?) -> true; +is_fragment(Char) -> is_pchar(Char). + + +%%------------------------------------------------------------------------- +%% [RFC 3986, Chapter 2.2. Reserved Characters] +%% +%% reserved = gen-delims / sub-delims +%% +%% gen-delims = ":" / "/" / "?" / "#" / "[" / "]" / "@" +%% +%% sub-delims = "!" / "$" / "&" / "'" / "(" / ")" +%% / "*" / "+" / "," / ";" / "=" +%% +%%------------------------------------------------------------------------- + +%% Check if char is sub-delim. +-spec is_sub_delim(char()) -> boolean(). +is_sub_delim($!) -> true; +is_sub_delim($$) -> true; +is_sub_delim($&) -> true; +is_sub_delim($') -> true; +is_sub_delim($() -> true; +is_sub_delim($)) -> true; + +is_sub_delim($*) -> true; +is_sub_delim($+) -> true; +is_sub_delim($,) -> true; +is_sub_delim($;) -> true; +is_sub_delim($=) -> true; +is_sub_delim(_) -> false. + + +%%------------------------------------------------------------------------- +%% [RFC 3986, Chapter 2.3. Unreserved Characters] +%% +%% unreserved = ALPHA / DIGIT / "-" / "." / "_" / "~" +%% +%%------------------------------------------------------------------------- +-spec is_unreserved(char()) -> boolean(). +is_unreserved($-) -> true; +is_unreserved($.) -> true; +is_unreserved($_) -> true; +is_unreserved($~) -> true; +is_unreserved(Char) -> is_alpha(Char) orelse is_digit(Char). + +-spec is_alpha(char()) -> boolean(). +is_alpha(C) + when $A =< C, C =< $Z; + $a =< C, C =< $z -> true; +is_alpha(_) -> false. + +-spec is_digit(char()) -> boolean(). +is_digit(C) + when $0 =< C, C =< $9 -> true; +is_digit(_) -> false. + +-spec is_hex_digit(char()) -> boolean(). +is_hex_digit(C) + when $0 =< C, C =< $9;$a =< C, C =< $f;$A =< C, C =< $F -> true; +is_hex_digit(_) -> false. + + +%% Remove enclosing brackets from binary +-spec remove_brackets(binary()) -> binary(). +remove_brackets(<<$[/utf8, Rest/binary>>) -> + {H,T} = split_binary(Rest, byte_size(Rest) - 1), + case T =:= <<$]/utf8>> of + true -> H; + false -> Rest + end; +remove_brackets(Addr) -> Addr. + + +%%------------------------------------------------------------------------- +%% Helper functions for calculating the parsed binary. +%%------------------------------------------------------------------------- +-spec calculate_parsed_scheme(binary(), binary()) -> binary(). +calculate_parsed_scheme(Input, <<>>) -> + strip_last_char(Input, [$:]); +calculate_parsed_scheme(Input, Unparsed) -> + get_parsed_binary(Input, Unparsed). + + +-spec calculate_parsed_part(binary(), binary()) -> binary(). +calculate_parsed_part(Input, <<>>) -> + strip_last_char(Input, [$?,$#]); +calculate_parsed_part(Input, Unparsed) -> + get_parsed_binary(Input, Unparsed). + + +-spec calculate_parsed_userinfo(binary(), binary()) -> binary(). +calculate_parsed_userinfo(Input, <<>>) -> + strip_last_char(Input, [$?,$#,$@]); +calculate_parsed_userinfo(Input, Unparsed) -> + get_parsed_binary(Input, Unparsed). + + +-spec calculate_parsed_host_port(binary(), binary()) -> binary(). +calculate_parsed_host_port(Input, <<>>) -> + strip_last_char(Input, [$:,$?,$#,$/]); +calculate_parsed_host_port(Input, Unparsed) -> + get_parsed_binary(Input, Unparsed). + + +calculate_parsed_query_fragment(Input, <<>>) -> + strip_last_char(Input, [$#]); +calculate_parsed_query_fragment(Input, Unparsed) -> + get_parsed_binary(Input, Unparsed). + + +get_port(<<>>) -> + undefined; +get_port(B) -> + try binary_to_integer(B) + catch + error:badarg -> + throw({error, invalid_uri, B}) + end. + + +%% Strip last char if it is in list +%% +%% This function is optimized for speed: parse/1 is about 10% faster than +%% with an alternative implementation based on lists and sets. +strip_last_char(<<>>, _) -> <<>>; +strip_last_char(Input, [C0]) -> + case binary:last(Input) of + C0 -> + init_binary(Input); + _Else -> + Input + end; +strip_last_char(Input, [C0,C1]) -> + case binary:last(Input) of + C0 -> + init_binary(Input); + C1 -> + init_binary(Input); + _Else -> + Input + end; +strip_last_char(Input, [C0,C1,C2]) -> + case binary:last(Input) of + C0 -> + init_binary(Input); + C1 -> + init_binary(Input); + C2 -> + init_binary(Input); + _Else -> + Input + end; +strip_last_char(Input, [C0,C1,C2,C3]) -> + case binary:last(Input) of + C0 -> + init_binary(Input); + C1 -> + init_binary(Input); + C2 -> + init_binary(Input); + C3 -> + init_binary(Input); + _Else -> + Input + end. + + +%% Get parsed binary +get_parsed_binary(Input, Unparsed) -> + {First, _} = split_binary(Input, byte_size(Input) - byte_size_exl_head(Unparsed)), + First. + + +%% Return all bytes of the binary except the last one. The binary must be non-empty. +init_binary(B) -> + {Init, _} = + split_binary(B, byte_size(B) - 1), + Init. + + +%% Returns the size of a binary exluding the first element. +%% Used in calls to split_binary(). +-spec byte_size_exl_head(binary()) -> number(). +byte_size_exl_head(<<>>) -> 0; +byte_size_exl_head(Binary) -> byte_size(Binary) + 1. + + +%%------------------------------------------------------------------------- +%% [RFC 3986, Chapter 2.1. Percent-Encoding] +%% +%% A percent-encoding mechanism is used to represent a data octet in a +%% component when that octet's corresponding character is outside the +%% allowed set or is being used as a delimiter of, or within, the +%% component. A percent-encoded octet is encoded as a character +%% triplet, consisting of the percent character "%" followed by the two +%% hexadecimal digits representing that octet's numeric value. For +%% example, "%20" is the percent-encoding for the binary octet +%% "00100000" (ABNF: %x20), which in US-ASCII corresponds to the space +%% character (SP). Section 2.4 describes when percent-encoding and +%% decoding is applied. +%% +%% pct-encoded = "%" HEXDIG HEXDIG +%%------------------------------------------------------------------------- +-spec decode_userinfo(binary()) -> binary(). +decode_userinfo(Cs) -> + check_utf8(decode(Cs, fun is_userinfo/1, <<>>)). + +-spec decode_host(binary()) -> binary(). +decode_host(Cs) -> + check_utf8(decode(Cs, fun is_host/1, <<>>)). + +-spec decode_path(binary()) -> binary(). +decode_path(Cs) -> + check_utf8(decode(Cs, fun is_path/1, <<>>)). + +-spec decode_query(binary()) -> binary(). +decode_query(Cs) -> + check_utf8(decode(Cs, fun is_query/1, <<>>)). + +-spec decode_fragment(binary()) -> binary(). +decode_fragment(Cs) -> + check_utf8(decode(Cs, fun is_fragment/1, <<>>)). + + +%% Returns Cs if it is utf8 encoded. +check_utf8(Cs) -> + case unicode:characters_to_list(Cs) of + {incomplete,_,_} -> + throw({error,invalid_utf8,Cs}); + {error,_,_} -> + throw({error,invalid_utf8,Cs}); + _ -> Cs + end. + +%%------------------------------------------------------------------------- +%% Percent-encode +%%------------------------------------------------------------------------- + +%% Only validates as scheme cannot have percent-encoded characters +-spec encode_scheme(list()|binary()) -> list() | binary(). +encode_scheme([]) -> + throw({error,invalid_scheme,""}); +encode_scheme(<<>>) -> + throw({error,invalid_scheme,<<>>}); +encode_scheme(Scheme) -> + case validate_scheme(Scheme) of + true -> Scheme; + false -> throw({error,invalid_scheme,Scheme}) + end. + +-spec encode_userinfo(list()|binary()) -> list() | binary(). +encode_userinfo(Cs) -> + encode(Cs, fun is_userinfo/1). + +-spec encode_host(list()|binary()) -> list() | binary(). +encode_host(Cs) -> + case classify_host(Cs) of + regname -> Cs; + ipv4 -> Cs; + ipv6 -> bracket_ipv6(Cs); + other -> encode(Cs, fun is_reg_name/1) + end. + +-spec encode_path(list()|binary()) -> list() | binary(). +encode_path(Cs) -> + encode(Cs, fun is_path/1). + +-spec encode_query(list()|binary()) -> list() | binary(). +encode_query(Cs) -> + encode(Cs, fun is_query/1). + +-spec encode_fragment(list()|binary()) -> list() | binary(). +encode_fragment(Cs) -> + encode(Cs, fun is_fragment/1). + +%%------------------------------------------------------------------------- +%% Helper funtions for percent-decode +%%------------------------------------------------------------------------- +decode(<<$%,C0,C1,Cs/binary>>, Fun, Acc) -> + case is_hex_digit(C0) andalso is_hex_digit(C1) of + true -> + B = ?HEX2DEC(C0)*16+?HEX2DEC(C1), + decode(Cs, Fun, <<Acc/binary, B>>); + false -> throw({error,invalid_percent_encoding,<<$%,C0,C1>>}) + end; +decode(<<C,Cs/binary>>, Fun, Acc) -> + case Fun(C) of + true -> decode(Cs, Fun, <<Acc/binary, C>>); + false -> throw({error,invalid_percent_encoding,<<C,Cs/binary>>}) + end; +decode(<<>>, _Fun, Acc) -> + Acc. + +%% Check if char is allowed in host +-spec is_host(char()) -> boolean(). +is_host($:) -> true; +is_host(Char) -> is_unreserved(Char) orelse is_sub_delim(Char). + +%% Check if char is allowed in path +-spec is_path(char()) -> boolean(). +is_path($/) -> true; +is_path(Char) -> is_pchar(Char). + + +%%------------------------------------------------------------------------- +%% Helper functions for percent-encode +%%------------------------------------------------------------------------- +-spec encode(list()|binary(), fun()) -> list() | binary(). +encode(Component, Fun) when is_list(Component) -> + B = unicode:characters_to_binary(Component), + unicode:characters_to_list(encode(B, Fun, <<>>)); +encode(Component, Fun) when is_binary(Component) -> + encode(Component, Fun, <<>>). +%% +encode(<<Char/utf8, Rest/binary>>, Fun, Acc) -> + C = encode_codepoint_binary(Char, Fun), + encode(Rest, Fun, <<Acc/binary,C/binary>>); +encode(<<Char, Rest/binary>>, _Fun, _Acc) -> + throw({error,invalid_input,<<Char,Rest/binary>>}); +encode(<<>>, _Fun, Acc) -> + Acc. + + +-spec encode_codepoint_binary(integer(), fun()) -> binary(). +encode_codepoint_binary(C, Fun) -> + case Fun(C) of + false -> percent_encode_binary(C); + true -> <<C>> + end. + + +-spec percent_encode_binary(integer()) -> binary(). +percent_encode_binary(Code) -> + percent_encode_binary(<<Code/utf8>>, <<>>). + + +percent_encode_binary(<<A:4,B:4,Rest/binary>>, Acc) -> + percent_encode_binary(Rest, <<Acc/binary,$%,(?DEC2HEX(A)),(?DEC2HEX(B))>>); +percent_encode_binary(<<>>, Acc) -> + Acc. + + +%%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- +validate_scheme([]) -> true; +validate_scheme([H|T]) -> + case is_scheme(H) of + true -> validate_scheme(T); + false -> false + end; +validate_scheme(<<>>) -> true; +validate_scheme(<<H, Rest/binary>>) -> + case is_scheme(H) of + true -> validate_scheme(Rest); + false -> false + end. + + +%%------------------------------------------------------------------------- +%% Classifies hostname into the following categories: +%% regname, ipv4 - address does not contain reserved characters to be +%% percent-encoded +%% ipv6 - address does not contain reserved characters but it shall be +%% encolsed in brackets +%% other - address shall be percent-encoded +%%------------------------------------------------------------------------- +classify_host([]) -> other; +classify_host(Addr) when is_binary(Addr) -> + A = unicode:characters_to_list(Addr), + classify_host_ipv6(A); +classify_host(Addr) -> + classify_host_ipv6(Addr). + +classify_host_ipv6(Addr) -> + case is_ipv6_address(Addr) of + true -> ipv6; + false -> classify_host_ipv4(Addr) + end. + +classify_host_ipv4(Addr) -> + case is_ipv4_address(Addr) of + true -> ipv4; + false -> classify_host_regname(Addr) + end. + +classify_host_regname([]) -> regname; +classify_host_regname([H|T]) -> + case is_reg_name(H) of + true -> classify_host_regname(T); + false -> other + end. + +is_ipv4_address(Addr) -> + case inet:parse_ipv4strict_address(Addr) of + {ok, _} -> true; + {error, _} -> false + end. + +is_ipv6_address(Addr) -> + case inet:parse_ipv6strict_address(Addr) of + {ok, _} -> true; + {error, _} -> false + end. + +bracket_ipv6(Addr) when is_binary(Addr) -> + concat(<<$[,Addr/binary>>,<<$]>>); +bracket_ipv6(Addr) when is_list(Addr) -> + [$[|Addr] ++ "]". + + +%%------------------------------------------------------------------------- +%% Helper funtions for recompose +%%------------------------------------------------------------------------- + +%%------------------------------------------------------------------------- +%% Checks if input Map has valid combination of fields that can be +%% recomposed into a URI. +%% +%% The implementation is based on a decision tree that fulfills the +%% following rules: +%% - 'path' shall always be present in the input map +%% URI = scheme ":" hier-part [ "?" query ] [ "#" fragment ] +%% hier-part = "//" authority path-abempty +%% / path-absolute +%% / path-rootless +%% / path-empty +%% - 'host' shall be present in the input map when 'path' starts with +%% two slashes ("//") +%% path = path-abempty ; begins with "/" or is empty +%% / path-absolute ; begins with "/" but not "//" +%% / path-noscheme ; begins with a non-colon segment +%% / path-rootless ; begins with a segment +%% / path-empty ; zero characters +%% path-abempty = *( "/" segment ) +%% segment = *pchar +%% - 'host' shall be present if userinfo or port is present in input map +%% authority = [ userinfo "@" ] host [ ":" port ] +%% - All fields shall be valid (scheme, userinfo, host, port, path, query +%% or fragment). +%%------------------------------------------------------------------------- +is_valid_map(#{path := Path} = Map) -> + ((starts_with_two_slash(Path) andalso is_valid_map_host(Map)) + orelse + (maps:is_key(userinfo, Map) andalso is_valid_map_host(Map)) + orelse + (maps:is_key(port, Map) andalso is_valid_map_host(Map)) + orelse + all_fields_valid(Map)); +is_valid_map(#{}) -> + false. + + +is_valid_map_host(Map) -> + maps:is_key(host, Map) andalso all_fields_valid(Map). + + +all_fields_valid(Map) -> + Fun = fun(scheme, _, Acc) -> Acc; + (userinfo, _, Acc) -> Acc; + (host, _, Acc) -> Acc; + (port, _, Acc) -> Acc; + (path, _, Acc) -> Acc; + (query, _, Acc) -> Acc; + (fragment, _, Acc) -> Acc; + (_, _, _) -> false + end, + maps:fold(Fun, true, Map). + + +starts_with_two_slash([$/,$/|_]) -> + true; +starts_with_two_slash(?STRING_REST("//", _)) -> + true; +starts_with_two_slash(_) -> false. + + +update_scheme(#{scheme := Scheme}, _) -> + add_colon_postfix(encode_scheme(Scheme)); +update_scheme(#{}, _) -> + empty. + + +update_userinfo(#{userinfo := Userinfo}, empty) -> + add_auth_prefix(encode_userinfo(Userinfo)); +update_userinfo(#{userinfo := Userinfo}, URI) -> + concat(URI,add_auth_prefix(encode_userinfo(Userinfo))); +update_userinfo(#{}, empty) -> + empty; +update_userinfo(#{}, URI) -> + URI. + + +update_host(#{host := Host}, empty) -> + add_auth_prefix(encode_host(Host)); +update_host(#{host := Host} = Map, URI) -> + concat(URI,add_host_prefix(Map, encode_host(Host))); +update_host(#{}, empty) -> + empty; +update_host(#{}, URI) -> + URI. + + +%% URI cannot be empty for ports. E.g. ":8080" is not a valid URI +update_port(#{port := undefined}, URI) -> + concat(URI, <<":">>); +update_port(#{port := Port}, URI) -> + concat(URI,add_colon(encode_port(Port))); +update_port(#{}, URI) -> + URI. + + +update_path(#{path := Path}, empty) -> + encode_path(Path); +update_path(#{path := Path}, URI) -> + concat(URI,encode_path(Path)); +update_path(#{}, empty) -> + empty; +update_path(#{}, URI) -> + URI. + + +update_query(#{query := Query}, empty) -> + encode_query(Query); +update_query(#{query := Query}, URI) -> + concat(URI,add_question_mark(encode_query(Query))); +update_query(#{}, empty) -> + empty; +update_query(#{}, URI) -> + URI. + + +update_fragment(#{fragment := Fragment}, empty) -> + add_hashmark(encode_fragment(Fragment)); +update_fragment(#{fragment := Fragment}, URI) -> + concat(URI,add_hashmark(encode_fragment(Fragment))); +update_fragment(#{}, empty) -> + ""; +update_fragment(#{}, URI) -> + URI. + +%%------------------------------------------------------------------------- +%% Concatenates its arguments that can be lists and binaries. +%% The result is a list if at least one of its argument is a list and +%% binary otherwise. +%%------------------------------------------------------------------------- +concat(A, B) when is_binary(A), is_binary(B) -> + <<A/binary, B/binary>>; +concat(A, B) when is_binary(A), is_list(B) -> + unicode:characters_to_list(A) ++ B; +concat(A, B) when is_list(A) -> + A ++ maybe_to_list(B). + +add_hashmark(Comp) when is_binary(Comp) -> + <<$#, Comp/binary>>; +add_hashmark(Comp) when is_list(Comp) -> + [$#|Comp]. + +add_question_mark(Comp) when is_binary(Comp) -> + <<$?, Comp/binary>>; +add_question_mark(Comp) when is_list(Comp) -> + [$?|Comp]. + +add_colon(Comp) when is_binary(Comp) -> + <<$:, Comp/binary>>. + +add_colon_postfix(Comp) when is_binary(Comp) -> + <<Comp/binary,$:>>; +add_colon_postfix(Comp) when is_list(Comp) -> + Comp ++ ":". + +add_auth_prefix(Comp) when is_binary(Comp) -> + <<"//", Comp/binary>>; +add_auth_prefix(Comp) when is_list(Comp) -> + [$/,$/|Comp]. + +add_host_prefix(#{userinfo := _}, Host) when is_binary(Host) -> + <<$@,Host/binary>>; +add_host_prefix(#{}, Host) when is_binary(Host) -> + <<"//",Host/binary>>; +add_host_prefix(#{userinfo := _}, Host) when is_list(Host) -> + [$@|Host]; +add_host_prefix(#{}, Host) when is_list(Host) -> + [$/,$/|Host]. + +maybe_to_list(Comp) when is_binary(Comp) -> unicode:characters_to_list(Comp); +maybe_to_list(Comp) -> Comp. + +encode_port(Port) -> + integer_to_binary(Port). + +%%------------------------------------------------------------------------- +%% Helper functions for transcode +%%------------------------------------------------------------------------- + +%%------------------------------------------------------------------------- +%% uri_string:transcode(<<"x%00%00%00%F6"/utf32>>). +%% 1. Convert (transcode/2) input to list form (list of unicode codepoints) +%% "x%00%00%00%F6" +%% 2. Accumulate characters until percent-encoded segment (transcode/4). +%% Acc = "x" +%% 3. Convert percent-encoded triplets to binary form (transcode_pct/4) +%% <<0,0,0,246>> +%% 4. Transcode in-encoded binary to out-encoding (utf32 -> utf8): +%% <<195,182>> +%% 5. Percent-encode out-encoded binary: +%% <<"%C3%B6"/utf8>> = <<37,67,51,37,66,54>> +%% 6. Convert binary to list form, reverse it and append the accumulator +%% "6B%3C%" + "x" +%% 7. Reverse Acc and return it +%%------------------------------------------------------------------------- +transcode([$%,_C0,_C1|_Rest] = L, Acc, InEnc, OutEnc) -> + transcode_pct(L, Acc, <<>>, InEnc, OutEnc); +transcode([_C|_Rest] = L, Acc, InEnc, OutEnc) -> + transcode(L, Acc, [], InEnc, OutEnc). +%% +transcode([$%,_C0,_C1|_Rest] = L, Acc, List, InEncoding, OutEncoding) -> + transcode_pct(L, List ++ Acc, <<>>, InEncoding, OutEncoding); +transcode([C|Rest], Acc, List, InEncoding, OutEncoding) -> + transcode(Rest, Acc, [C|List], InEncoding, OutEncoding); +transcode([], Acc, List, _InEncoding, _OutEncoding) -> + lists:reverse(List ++ Acc). + + +%% Transcode percent-encoded segment +transcode_pct([$%,C0,C1|Rest] = L, Acc, B, InEncoding, OutEncoding) -> + case is_hex_digit(C0) andalso is_hex_digit(C1) of + true -> + Int = ?HEX2DEC(C0)*16+?HEX2DEC(C1), + transcode_pct(Rest, Acc, <<B/binary, Int>>, InEncoding, OutEncoding); + false -> throw({error, invalid_percent_encoding,L}) + end; +transcode_pct([_C|_Rest] = L, Acc, B, InEncoding, OutEncoding) -> + OutBinary = convert_to_binary(B, InEncoding, OutEncoding), + PctEncUtf8 = percent_encode_segment(OutBinary), + Out = lists:reverse(convert_to_list(PctEncUtf8, utf8)), + transcode(L, Out ++ Acc, [], InEncoding, OutEncoding); +transcode_pct([], Acc, B, InEncoding, OutEncoding) -> + OutBinary = convert_to_binary(B, InEncoding, OutEncoding), + PctEncUtf8 = percent_encode_segment(OutBinary), + Out = convert_to_list(PctEncUtf8, utf8), + lists:reverse(Acc) ++ Out. + + +%% Convert to binary +convert_to_binary(Binary, InEncoding, OutEncoding) -> + case unicode:characters_to_binary(Binary, InEncoding, OutEncoding) of + {error, _List, RestData} -> + throw({error, invalid_input, RestData}); + {incomplete, _List, RestData} -> + throw({error, invalid_input, RestData}); + Result -> + Result + end. + + +%% Convert to list +convert_to_list(Binary, InEncoding) -> + case unicode:characters_to_list(Binary, InEncoding) of + {error, _List, RestData} -> + throw({error, invalid_input, RestData}); + {incomplete, _List, RestData} -> + throw({error, invalid_input, RestData}); + Result -> + Result + end. + + +%% Flatten input list +flatten_list([], _) -> + []; +flatten_list(L, InEnc) -> + flatten_list(L, InEnc, []). +%% +flatten_list([H|T], InEnc, Acc) when is_binary(H) -> + L = convert_to_list(H, InEnc), + flatten_list(T, InEnc, lists:reverse(L) ++ Acc); +flatten_list([H|T], InEnc, Acc) when is_list(H) -> + flatten_list(H ++ T, InEnc, Acc); +flatten_list([H|T], InEnc, Acc) -> + flatten_list(T, InEnc, [H|Acc]); +flatten_list([], _InEnc, Acc) -> + lists:reverse(Acc); +flatten_list(Arg, _, _) -> + throw({error, invalid_input, Arg}). + + +percent_encode_segment(Segment) -> + percent_encode_binary(Segment, <<>>). + + +%%------------------------------------------------------------------------- +%% Helper functions for compose_query +%%------------------------------------------------------------------------- + +%% Returns separator to be used between key-value pairs +get_separator(L) when length(L) =:= 0 -> + <<>>; +get_separator(_L) -> + <<"&">>. + + +%% HTML5 - 4.10.22.6 URL-encoded form data - encoding +form_urlencode(Cs, [{encoding, latin1}]) when is_list(Cs) -> + B = convert_to_binary(Cs, utf8, utf8), + html5_byte_encode(base10_encode(B)); +form_urlencode(Cs, [{encoding, latin1}]) when is_binary(Cs) -> + html5_byte_encode(base10_encode(Cs)); +form_urlencode(Cs, [{encoding, Encoding}]) + when is_list(Cs), Encoding =:= utf8; Encoding =:= unicode -> + B = convert_to_binary(Cs, utf8, Encoding), + html5_byte_encode(B); +form_urlencode(Cs, [{encoding, Encoding}]) + when is_binary(Cs), Encoding =:= utf8; Encoding =:= unicode -> + html5_byte_encode(Cs); +form_urlencode(Cs, [{encoding, Encoding}]) when is_list(Cs); is_binary(Cs) -> + throw({error,invalid_encoding, Encoding}); +form_urlencode(Cs, _) -> + throw({error,invalid_input, Cs}). + + +%% For each character in the entry's name and value that cannot be expressed using +%% the selected character encoding, replace the character by a string consisting of +%% a U+0026 AMPERSAND character (&), a "#" (U+0023) character, one or more ASCII +%% digits representing the Unicode code point of the character in base ten, and +%% finally a ";" (U+003B) character. +base10_encode(Cs) -> + base10_encode(Cs, <<>>). +%% +base10_encode(<<>>, Acc) -> + Acc; +base10_encode(<<H/utf8,T/binary>>, Acc) when H > 255 -> + Base10 = convert_to_binary(integer_to_list(H,10), utf8, utf8), + base10_encode(T, <<Acc/binary,"&#",Base10/binary,$;>>); +base10_encode(<<H/utf8,T/binary>>, Acc) -> + base10_encode(T, <<Acc/binary,H>>). + + +html5_byte_encode(B) -> + html5_byte_encode(B, <<>>). +%% +html5_byte_encode(<<>>, Acc) -> + Acc; +html5_byte_encode(<<$ ,T/binary>>, Acc) -> + html5_byte_encode(T, <<Acc/binary,$+>>); +html5_byte_encode(<<H,T/binary>>, Acc) -> + case is_url_char(H) of + true -> + html5_byte_encode(T, <<Acc/binary,H>>); + false -> + <<A:4,B:4>> = <<H>>, + html5_byte_encode(T, <<Acc/binary,$%,(?DEC2HEX(A)),(?DEC2HEX(B))>>) + end; +html5_byte_encode(H, _Acc) -> + throw({error,invalid_input, H}). + + +%% Return true if input char can appear in form-urlencoded string +%% Allowed chararacters: +%% 0x2A, 0x2D, 0x2E, 0x30 to 0x39, 0x41 to 0x5A, +%% 0x5F, 0x61 to 0x7A +is_url_char(C) + when C =:= 16#2A; C =:= 16#2D; + C =:= 16#2E; C =:= 16#5F; + 16#30 =< C, C =< 16#39; + 16#41 =< C, C =< 16#5A; + 16#61 =< C, C =< 16#7A -> true; +is_url_char(_) -> false. + + +%%------------------------------------------------------------------------- +%% Helper functions for dissect_query +%%------------------------------------------------------------------------- +dissect_query_key(<<$=,T/binary>>, IsList, Acc, Key, Value) -> + dissect_query_value(T, IsList, Acc, Key, Value); +dissect_query_key(<<"&#",T/binary>>, IsList, Acc, Key, Value) -> + dissect_query_key(T, IsList, Acc, <<Key/binary,"&#">>, Value); +dissect_query_key(<<$&,_T/binary>>, _IsList, _Acc, _Key, _Value) -> + throw({error, missing_value, "&"}); +dissect_query_key(<<H,T/binary>>, IsList, Acc, Key, Value) -> + dissect_query_key(T, IsList, Acc, <<Key/binary,H>>, Value); +dissect_query_key(B, _, _, _, _) -> + throw({error, missing_value, B}). + + +dissect_query_value(<<$&,T/binary>>, IsList, Acc, Key, Value) -> + K = form_urldecode(IsList, Key), + V = form_urldecode(IsList, Value), + dissect_query_key(T, IsList, [{K,V}|Acc], <<>>, <<>>); +dissect_query_value(<<H,T/binary>>, IsList, Acc, Key, Value) -> + dissect_query_value(T, IsList, Acc, Key, <<Value/binary,H>>); +dissect_query_value(<<>>, IsList, Acc, Key, Value) -> + K = form_urldecode(IsList, Key), + V = form_urldecode(IsList, Value), + lists:reverse([{K,V}|Acc]). + + +%% Form-urldecode input based on RFC 1866 [8.2.1] +form_urldecode(true, B) -> + Result = base10_decode(form_urldecode(B, <<>>)), + convert_to_list(Result, utf8); +form_urldecode(false, B) -> + base10_decode(form_urldecode(B, <<>>)); +form_urldecode(<<>>, Acc) -> + Acc; +form_urldecode(<<$+,T/binary>>, Acc) -> + form_urldecode(T, <<Acc/binary,$ >>); +form_urldecode(<<$%,C0,C1,T/binary>>, Acc) -> + case is_hex_digit(C0) andalso is_hex_digit(C1) of + true -> + V = ?HEX2DEC(C0)*16+?HEX2DEC(C1), + form_urldecode(T, <<Acc/binary, V>>); + false -> + L = convert_to_list(<<$%,C0,C1,T/binary>>, utf8), + throw({error, invalid_percent_encoding, L}) + end; +form_urldecode(<<H/utf8,T/binary>>, Acc) -> + form_urldecode(T, <<Acc/binary,H/utf8>>); +form_urldecode(<<H,_/binary>>, _Acc) -> + throw({error, invalid_character, [H]}). + +base10_decode(Cs) -> + base10_decode(Cs, <<>>). +% +base10_decode(<<>>, Acc) -> + Acc; +base10_decode(<<"&#",T/binary>>, Acc) -> + base10_decode_unicode(T, Acc); +base10_decode(<<H/utf8,T/binary>>, Acc) -> + base10_decode(T,<<Acc/binary,H/utf8>>); +base10_decode(<<H,_/binary>>, _) -> + throw({error, invalid_input, [H]}). + + +base10_decode_unicode(B, Acc) -> + base10_decode_unicode(B, 0, Acc). +%% +base10_decode_unicode(<<H/utf8,T/binary>>, Codepoint, Acc) when $0 =< H, H =< $9 -> + Res = Codepoint * 10 + (H - $0), + base10_decode_unicode(T, Res, Acc); +base10_decode_unicode(<<$;,T/binary>>, Codepoint, Acc) -> + base10_decode(T, <<Acc/binary,Codepoint/utf8>>); +base10_decode_unicode(<<H,_/binary>>, _, _) -> + throw({error, invalid_input, [H]}). + + +%%------------------------------------------------------------------------- +%% Helper functions for normalize +%%------------------------------------------------------------------------- + +%% 6.2.2.1. Case Normalization +normalize_case(#{scheme := Scheme, host := Host} = Map) -> + Map#{scheme => to_lower(Scheme), + host => to_lower(Host)}; +normalize_case(#{host := Host} = Map) -> + Map#{host => to_lower(Host)}; +normalize_case(#{scheme := Scheme} = Map) -> + Map#{scheme => to_lower(Scheme)}; +normalize_case(#{} = Map) -> + Map. + + +to_lower(Cs) when is_list(Cs) -> + B = convert_to_binary(Cs, utf8, utf8), + convert_to_list(to_lower(B), utf8); +to_lower(Cs) when is_binary(Cs) -> + to_lower(Cs, <<>>). +%% +to_lower(<<C,Cs/binary>>, Acc) when $A =< C, C =< $Z -> + to_lower(Cs, <<Acc/binary,(C + 32)>>); +to_lower(<<C,Cs/binary>>, Acc) -> + to_lower(Cs, <<Acc/binary,C>>); +to_lower(<<>>, Acc) -> + Acc. + + +%% 6.2.2.3. Path Segment Normalization +%% 5.2.4. Remove Dot Segments +normalize_path_segment(Map) -> + Path = maps:get(path, Map, undefined), + Map#{path => remove_dot_segments(Path)}. + + +remove_dot_segments(Path) when is_binary(Path) -> + remove_dot_segments(Path, <<>>); +remove_dot_segments(Path) when is_list(Path) -> + B = convert_to_binary(Path, utf8, utf8), + B1 = remove_dot_segments(B, <<>>), + convert_to_list(B1, utf8). +%% +remove_dot_segments(<<>>, Output) -> + Output; +remove_dot_segments(<<"../",T/binary>>, Output) -> + remove_dot_segments(T, Output); +remove_dot_segments(<<"./",T/binary>>, Output) -> + remove_dot_segments(T, Output); +remove_dot_segments(<<"/./",T/binary>>, Output) -> + remove_dot_segments(<<$/,T/binary>>, Output); +remove_dot_segments(<<"/.">>, Output) -> + remove_dot_segments(<<$/>>, Output); +remove_dot_segments(<<"/../",T/binary>>, Output) -> + Out1 = remove_last_segment(Output), + remove_dot_segments(<<$/,T/binary>>, Out1); +remove_dot_segments(<<"/..">>, Output) -> + Out1 = remove_last_segment(Output), + remove_dot_segments(<<$/>>, Out1); +remove_dot_segments(<<$.>>, Output) -> + remove_dot_segments(<<>>, Output); +remove_dot_segments(<<"..">>, Output) -> + remove_dot_segments(<<>>, Output); +remove_dot_segments(Input, Output) -> + {First, Rest} = first_path_segment(Input), + remove_dot_segments(Rest, <<Output/binary,First/binary>>). + + +first_path_segment(Input) -> + F = first_path_segment(Input, <<>>), + split_binary(Input, byte_size(F)). +%% +first_path_segment(<<$/,T/binary>>, Acc) -> + first_path_segment_end(<<T/binary>>, <<Acc/binary,$/>>); +first_path_segment(<<C,T/binary>>, Acc) -> + first_path_segment_end(<<T/binary>>, <<Acc/binary,C>>). + + +first_path_segment_end(<<>>, Acc) -> + Acc; +first_path_segment_end(<<$/,_/binary>>, Acc) -> + Acc; +first_path_segment_end(<<C,T/binary>>, Acc) -> + first_path_segment_end(<<T/binary>>, <<Acc/binary,C>>). + + +remove_last_segment(<<>>) -> + <<>>; +remove_last_segment(B) -> + {Init, Last} = split_binary(B, byte_size(B) - 1), + case Last of + <<$/>> -> + Init; + _Char -> + remove_last_segment(Init) + end. + + +%% RFC 3986, 6.2.3. Scheme-Based Normalization +normalize_scheme_based(Map) -> + Scheme = maps:get(scheme, Map, undefined), + Port = maps:get(port, Map, undefined), + Path= maps:get(path, Map, undefined), + normalize_scheme_based(Map, Scheme, Port, Path). +%% +normalize_scheme_based(Map, Scheme, Port, Path) + when Scheme =:= "http"; Scheme =:= <<"http">> -> + normalize_http(Map, Port, Path); +normalize_scheme_based(Map, Scheme, Port, Path) + when Scheme =:= "https"; Scheme =:= <<"https">> -> + normalize_https(Map, Port, Path); +normalize_scheme_based(Map, Scheme, Port, _Path) + when Scheme =:= "ftp"; Scheme =:= <<"ftp">> -> + normalize_ftp(Map, Port); +normalize_scheme_based(Map, Scheme, Port, _Path) + when Scheme =:= "ssh"; Scheme =:= <<"ssh">> -> + normalize_ssh_sftp(Map, Port); +normalize_scheme_based(Map, Scheme, Port, _Path) + when Scheme =:= "sftp"; Scheme =:= <<"sftp">> -> + normalize_ssh_sftp(Map, Port); +normalize_scheme_based(Map, Scheme, Port, _Path) + when Scheme =:= "tftp"; Scheme =:= <<"tftp">> -> + normalize_tftp(Map, Port); +normalize_scheme_based(Map, _, _, _) -> + Map. + + +normalize_http(Map, Port, Path) -> + M1 = normalize_port(Map, Port, 80), + normalize_http_path(M1, Path). + + +normalize_https(Map, Port, Path) -> + M1 = normalize_port(Map, Port, 443), + normalize_http_path(M1, Path). + + +normalize_ftp(Map, Port) -> + normalize_port(Map, Port, 21). + + +normalize_ssh_sftp(Map, Port) -> + normalize_port(Map, Port, 22). + + +normalize_tftp(Map, Port) -> + normalize_port(Map, Port, 69). + + +normalize_port(Map, Port, Default) -> + case Port of + Default -> + maps:remove(port, Map); + _Else -> + Map + end. + + +normalize_http_path(Map, Path) -> + case Path of + "" -> + Map#{path => "/"}; + <<>> -> + Map#{path => <<"/">>}; + _Else -> + Map + end. diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile index 7b79dcf04d..8490770f3d 100644 --- a/lib/stdlib/test/Makefile +++ b/lib/stdlib/test/Makefile @@ -69,6 +69,7 @@ MODULES= \ sets_test_lib \ sofs_SUITE \ stdlib_SUITE \ + stdlib_bench_SUITE \ string_SUITE \ supervisor_1 \ supervisor_2 \ @@ -86,6 +87,7 @@ MODULES= \ timer_simple_SUITE \ unicode_SUITE \ unicode_util_SUITE \ + uri_string_SUITE \ win32reg_SUITE \ y2k_SUITE \ select_SUITE \ @@ -146,7 +148,7 @@ release_spec: opt release_tests_spec: make_emakefile $(INSTALL_DIR) "$(RELSYSDIR)" - $(INSTALL_DATA) stdlib.spec $(EMAKEFILE) \ + $(INSTALL_DATA) stdlib.spec stdlib_bench.spec $(EMAKEFILE) \ $(ERL_FILES) $(COVERFILE) "$(RELSYSDIR)" chmod -R u+w "$(RELSYSDIR)" @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) diff --git a/lib/stdlib/test/base64_SUITE.erl b/lib/stdlib/test/base64_SUITE.erl index 48b3f5f959..1fc4c3fc0e 100644 --- a/lib/stdlib/test/base64_SUITE.erl +++ b/lib/stdlib/test/base64_SUITE.erl @@ -97,10 +97,9 @@ base64_otp_5635(Config) when is_list(Config) -> <<"===">> = base64:decode(base64:encode("===")), ok. %%------------------------------------------------------------------------- -%% OTP-6279: Guard needed so that function fails in a correct -%% way for faulty input, i.e. function_clause. +%% OTP-6279: Make sure illegal characters are rejected when decoding. base64_otp_6279(Config) when is_list(Config) -> - {'EXIT',{function_clause, _}} = (catch base64:decode("dGVzda==a")), + {'EXIT',_} = (catch base64:decode("dGVzda==a")), ok. %%------------------------------------------------------------------------- %% Encode and decode big binaries. @@ -115,48 +114,61 @@ big(Config) when is_list(Config) -> %%------------------------------------------------------------------------- %% Make sure illegal characters are rejected when decoding. illegal(Config) when is_list(Config) -> - {'EXIT',{function_clause, _}} = (catch base64:decode("()")), + %% A few samples with different error reasons. Nothing can be + %% assumed about the reason for the crash. + {'EXIT',_} = (catch base64:decode("()")), + {'EXIT',_} = (catch base64:decode(<<19:8,20:8,21:8,22:8>>)), + {'EXIT',_} = (catch base64:decode([19,20,21,22])), + {'EXIT',_} = (catch base64:decode_to_string(<<19:8,20:8,21:8,22:8>>)), + {'EXIT',_} = (catch base64:decode_to_string([19,20,21,22])), ok. %%------------------------------------------------------------------------- %% mime_decode and mime_decode_to_string have different implementations -%% so test both with the same input separately. Both functions have -%% the same implementation for binary/string arguments. +%% so test both with the same input separately. %% %% Test base64:mime_decode/1. mime_decode(Config) when is_list(Config) -> + MimeDecode = fun(In) -> + Out = base64:mime_decode(In), + Out = base64:mime_decode(binary_to_list(In)) + end, %% Test correct padding - <<"one">> = base64:mime_decode(<<"b25l">>), - <<"on">> = base64:mime_decode(<<"b24=">>), - <<"o">> = base64:mime_decode(<<"bw==">>), + <<"one">> = MimeDecode(<<"b25l">>), + <<"on">> = MimeDecode(<<"b24=">>), + <<"o">> = MimeDecode(<<"bw==">>), %% Test 1 extra padding - <<"one">> = base64:mime_decode(<<"b25l= =">>), - <<"on">> = base64:mime_decode(<<"b24== =">>), - <<"o">> = base64:mime_decode(<<"bw=== =">>), + <<"one">> = MimeDecode(<<"b25l= =">>), + <<"on">> = MimeDecode(<<"b24== =">>), + <<"o">> = MimeDecode(<<"bw=== =">>), %% Test 2 extra padding - <<"one">> = base64:mime_decode(<<"b25l===">>), - <<"on">> = base64:mime_decode(<<"b24====">>), - <<"o">> = base64:mime_decode(<<"bw=====">>), + <<"one">> = MimeDecode(<<"b25l===">>), + <<"on">> = MimeDecode(<<"b24====">>), + <<"o">> = MimeDecode(<<"bw=====">>), %% Test misc embedded padding - <<"one">> = base64:mime_decode(<<"b2=5l===">>), - <<"on">> = base64:mime_decode(<<"b=24====">>), - <<"o">> = base64:mime_decode(<<"b=w=====">>), + <<"one">> = MimeDecode(<<"b2=5l===">>), + <<"on">> = MimeDecode(<<"b=24====">>), + <<"o">> = MimeDecode(<<"b=w=====">>), %% Test misc white space and illegals with embedded padding - <<"one">> = base64:mime_decode(<<" b~2=\r\n5()l===">>), - <<"on">> = base64:mime_decode(<<"\tb =2\"¤4=¤= ==">>), - <<"o">> = base64:mime_decode(<<"\nb=w=====">>), + <<"one">> = MimeDecode(<<" b~2=\r\n5()l===">>), + <<"on">> = MimeDecode(<<"\tb =2\"¤4=¤= ==">>), + <<"o">> = MimeDecode(<<"\nb=w=====">>), %% Two pads <<"Aladdin:open sesame">> = - base64:mime_decode("QWxhZGRpbjpvc()GVuIHNlc2FtZQ=="), + MimeDecode(<<"QWxhZGRpbjpvc()GVuIHNlc2FtZQ==">>), %% One pad to ignore, followed by more text - <<"Hello World!!">> = base64:mime_decode(<<"SGVsb)(G8gV29ybGQ=h IQ= =">>), + <<"Hello World!!">> = MimeDecode(<<"SGVsb)(G8gV29ybGQ=h IQ= =">>), %% No pad <<"Aladdin:open sesam">> = - base64:mime_decode("QWxhZGRpbjpvcG¤\")(VuIHNlc2Ft"), + MimeDecode(<<"QWxhZGRpbjpvcG¤\")(VuIHNlc2Ft">>), %% Encoded base 64 strings may be divided by non base 64 chars. %% In this cases whitespaces. <<"0123456789!@#0^&*();:<>,. []{}">> = - base64:mime_decode( + MimeDecode( <<"MDEy MzQ1Njc4 \tOSFAIzBeJ \nio)(oKTs6 PD4sLi \r\nBbXXt9">>), + %% Zeroes + <<"012">> = MimeDecode(<<"\000M\000D\000E\000y=\000">>), + <<"o">> = MimeDecode(<<"bw==\000">>), + <<"o">> = MimeDecode(<<"bw=\000=">>), ok. %%------------------------------------------------------------------------- @@ -165,39 +177,48 @@ mime_decode(Config) when is_list(Config) -> %% Test base64:mime_decode_to_string/1. mime_decode_to_string(Config) when is_list(Config) -> + MimeDecodeToString = + fun(In) -> + Out = base64:mime_decode_to_string(In), + Out = base64:mime_decode_to_string(binary_to_list(In)) + end, %% Test correct padding - "one" = base64:mime_decode_to_string(<<"b25l">>), - "on" = base64:mime_decode_to_string(<<"b24=">>), - "o" = base64:mime_decode_to_string(<<"bw==">>), + "one" = MimeDecodeToString(<<"b25l">>), + "on" = MimeDecodeToString(<<"b24=">>), + "o" = MimeDecodeToString(<<"bw==">>), %% Test 1 extra padding - "one" = base64:mime_decode_to_string(<<"b25l= =">>), - "on" = base64:mime_decode_to_string(<<"b24== =">>), - "o" = base64:mime_decode_to_string(<<"bw=== =">>), + "one" = MimeDecodeToString(<<"b25l= =">>), + "on" = MimeDecodeToString(<<"b24== =">>), + "o" = MimeDecodeToString(<<"bw=== =">>), %% Test 2 extra padding - "one" = base64:mime_decode_to_string(<<"b25l===">>), - "on" = base64:mime_decode_to_string(<<"b24====">>), - "o" = base64:mime_decode_to_string(<<"bw=====">>), + "one" = MimeDecodeToString(<<"b25l===">>), + "on" = MimeDecodeToString(<<"b24====">>), + "o" = MimeDecodeToString(<<"bw=====">>), %% Test misc embedded padding - "one" = base64:mime_decode_to_string(<<"b2=5l===">>), - "on" = base64:mime_decode_to_string(<<"b=24====">>), - "o" = base64:mime_decode_to_string(<<"b=w=====">>), + "one" = MimeDecodeToString(<<"b2=5l===">>), + "on" = MimeDecodeToString(<<"b=24====">>), + "o" = MimeDecodeToString(<<"b=w=====">>), %% Test misc white space and illegals with embedded padding - "one" = base64:mime_decode_to_string(<<" b~2=\r\n5()l===">>), - "on" = base64:mime_decode_to_string(<<"\tb =2\"¤4=¤= ==">>), - "o" = base64:mime_decode_to_string(<<"\nb=w=====">>), + "one" = MimeDecodeToString(<<" b~2=\r\n5()l===">>), + "on" = MimeDecodeToString(<<"\tb =2\"¤4=¤= ==">>), + "o" = MimeDecodeToString(<<"\nb=w=====">>), %% Two pads "Aladdin:open sesame" = - base64:mime_decode_to_string("QWxhZGRpbjpvc()GVuIHNlc2FtZQ=="), + MimeDecodeToString(<<"QWxhZGRpbjpvc()GVuIHNlc2FtZQ==">>), %% One pad to ignore, followed by more text - "Hello World!!" = base64:mime_decode_to_string(<<"SGVsb)(G8gV29ybGQ=h IQ= =">>), + "Hello World!!" = MimeDecodeToString(<<"SGVsb)(G8gV29ybGQ=h IQ= =">>), %% No pad "Aladdin:open sesam" = - base64:mime_decode_to_string("QWxhZGRpbjpvcG¤\")(VuIHNlc2Ft"), + MimeDecodeToString(<<"QWxhZGRpbjpvcG¤\")(VuIHNlc2Ft">>), %% Encoded base 64 strings may be divided by non base 64 chars. %% In this cases whitespaces. "0123456789!@#0^&*();:<>,. []{}" = - base64:mime_decode_to_string( + MimeDecodeToString( <<"MDEy MzQ1Njc4 \tOSFAIzBeJ \nio)(oKTs6 PD4sLi \r\nBbXXt9">>), + %% Zeroes + "012" = MimeDecodeToString(<<"\000M\000D\000E\000y=\000">>), + "o" = MimeDecodeToString(<<"bw==\000">>), + "o" = MimeDecodeToString(<<"bw=\000=">>), ok. %%------------------------------------------------------------------------- diff --git a/lib/stdlib/test/erl_internal_SUITE.erl b/lib/stdlib/test/erl_internal_SUITE.erl index 789a9d4363..7d9df1f989 100644 --- a/lib/stdlib/test/erl_internal_SUITE.erl +++ b/lib/stdlib/test/erl_internal_SUITE.erl @@ -80,7 +80,7 @@ callbacks(application) -> callbacks(gen_server) -> [{init,1}, {handle_call,3}, {handle_cast,2}, {handle_info,2}, {terminate,2}, {code_change,3}, - {format_status,2}]; + {format_status,2}, {handle_continue, 2}]; callbacks(gen_fsm) -> [{init,1}, {handle_event,3}, {handle_sync_event,4}, {handle_info,3}, {terminate,3}, {code_change,4}, @@ -101,7 +101,7 @@ callbacks(supervisor) -> optional_callbacks(application) -> []; optional_callbacks(gen_server) -> - [{handle_info, 2}, {terminate, 2}, {code_change, 3}, {format_status, 2}]; + [{handle_info, 2}, {handle_continue, 2}, {terminate, 2}, {code_change, 3}, {format_status, 2}]; optional_callbacks(gen_fsm) -> [{handle_info, 3}, {terminate, 3}, {code_change, 4}, {format_status, 2}]; optional_callbacks(gen_event) -> diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index b76bece07f..5efffc6a5c 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -66,7 +66,8 @@ otp_11851/1,otp_11879/1,otp_13230/1, record_errors/1, otp_11879_cont/1, non_latin1_module/1, otp_14323/1, - get_stacktrace/1, otp_14285/1, otp_14378/1]). + get_stacktrace/1, stacktrace_syntax/1, + otp_14285/1, otp_14378/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -87,7 +88,7 @@ all() -> maps, maps_type, maps_parallel_match, otp_11851, otp_11879, otp_13230, record_errors, otp_11879_cont, non_latin1_module, otp_14323, - get_stacktrace, otp_14285, otp_14378]. + get_stacktrace, stacktrace_syntax, otp_14285, otp_14378]. groups() -> [{unused_vars_warn, [], @@ -4129,6 +4130,40 @@ get_stacktrace(Config) -> run(Config, Ts), ok. +stacktrace_syntax(Config) -> + Ts = [{guard, + <<"t1() -> + try error(foo) + catch _:_:Stk when is_number(Stk) -> ok + end. + ">>, + [], + {errors,[{3,erl_lint,{stacktrace_guard,'Stk'}}],[]}}, + {bound, + <<"t1() -> + Stk = [], + try error(foo) + catch _:_:Stk -> ok + end. + ">>, + [], + {errors,[{4,erl_lint,{stacktrace_bound,'Stk'}}],[]}}, + {guard_and_bound, + <<"t1() -> + Stk = [], + try error(foo) + catch _:_:Stk when is_integer(Stk) -> ok + end. + ">>, + [], + {errors,[{4,erl_lint,{stacktrace_bound,'Stk'}}, + {4,erl_lint,{stacktrace_guard,'Stk'}}],[]}} + ], + + run(Config, Ts), + ok. + + %% Unicode atoms. otp_14285(Config) -> %% A small sample of all the errors and warnings in module erl_lint. diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 05451a83fb..07c8b60cbd 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -1682,7 +1682,7 @@ do_random_test() -> ets:delete(Set), verify_etsmem(EtsMem). -%% Ttest various variants of update_element. +%% Test various variants of update_element. update_element(Config) when is_list(Config) -> EtsMem = etsmem(), repeat_for_opts(fun update_element_opts/1), @@ -2283,13 +2283,8 @@ write_concurrency(Config) when is_list(Config) -> NoHashMem = ets:info(No7,memory), NoHashMem = ets:info(No8,memory), - case erlang:system_info(smp_support) of - true -> - true = YesMem > NoHashMem, - true = YesMem > NoTreeMem; - false -> - true = YesMem =:= NoHashMem - end, + true = YesMem > NoHashMem, + true = YesMem > NoTreeMem, {'EXIT',{badarg,_}} = (catch ets_new(foo,[public,{write_concurrency,foo}])), {'EXIT',{badarg,_}} = (catch ets_new(foo,[public,{write_concurrency}])), @@ -5912,16 +5907,11 @@ add_lists([E1|T1], [E2|T2], Acc) -> run_smp_workers(InitF,ExecF,FiniF,Laps) -> run_smp_workers(InitF,ExecF,FiniF,Laps, 0). run_smp_workers(InitF,ExecF,FiniF,Laps, Exclude) -> - case erlang:system_info(smp_support) of - true -> - case erlang:system_info(schedulers_online) of - N when N > Exclude -> - run_workers_do(InitF,ExecF,FiniF,Laps, N - Exclude); - _ -> - {skipped, "Too few schedulers online"} - end; - false -> - {skipped,"No smp support"} + case erlang:system_info(schedulers_online) of + N when N > Exclude -> + run_workers_do(InitF,ExecF,FiniF,Laps, N - Exclude); + _ -> + {skipped, "Too few schedulers online"} end. run_sched_workers(InitF,ExecF,FiniF,Laps) -> @@ -6231,11 +6221,9 @@ spawn_monitor_with_pid(Pid, Fun, N) -> only_if_smp(Func) -> only_if_smp(2, Func). only_if_smp(Schedulers, Func) -> - case {erlang:system_info(smp_support), - erlang:system_info(schedulers_online)} of - {false,_} -> {skip,"No smp support"}; - {true,N} when N < Schedulers -> {skip,"Too few schedulers online"}; - {true,_} -> Func() + case erlang:system_info(schedulers_online) of + N when N < Schedulers -> {skip,"Too few schedulers online"}; + _ -> Func() end. %% Copy-paste from emulator/test/binary_SUITE.erl @@ -6381,7 +6369,7 @@ very_big_num(0, Result) -> Result. make_port() -> - open_port({spawn, "efile"}, [eof]). + hd(erlang:ports()). make_pid() -> spawn_link(fun sleeper/0). diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl index c94821bc75..930cea347f 100644 --- a/lib/stdlib/test/filelib_SUITE.erl +++ b/lib/stdlib/test/filelib_SUITE.erl @@ -33,6 +33,8 @@ -include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). +-define(PRIM_FILE, prim_file). + init_per_testcase(_Case, Config) -> Config. @@ -120,7 +122,7 @@ wcc(Wc, Error) -> do_wildcard_1(Dir, Wcf0) -> do_wildcard_2(Dir, Wcf0), Wcf = fun(Wc0) -> - Wc = filename:join(Dir, Wc0), + Wc = Dir ++ "/" ++ Wc0, L = Wcf0(Wc), [subtract_dir(N, Dir) || N <- L] end, @@ -268,8 +270,37 @@ do_wildcard_9(Dir, Wcf) -> %% Cleanup. del(Files), [ok = file:del_dir(D) || D <- lists:reverse(Dirs)], - ok. + do_wildcard_10(Dir, Wcf). + +%% ERL-451/OTP-14577: Escape characters using \\. +do_wildcard_10(Dir, Wcf) -> + All0 = ["{abc}","abc","def","---","z--","@a,b","@c"], + All = case os:type() of + {unix,_} -> + %% '?' is allowed in file names on Unix, but + %% not on Windows. + ["?q"|All0]; + _ -> + All0 + end, + Files = mkfiles(lists:reverse(All), Dir), + ["{abc}"] = Wcf("\\{a*"), + ["{abc}"] = Wcf("\\{abc}"), + ["abc","def","z--"] = Wcf("[a-z]*"), + ["---","abc","z--"] = Wcf("[a\\-z]*"), + ["@a,b","@c"] = Wcf("@{a\\,b,c}"), + ["@c"] = Wcf("@{a,b,c}"), + + case os:type() of + {unix,_} -> + ["?q"] = Wcf("\\?q"); + _ -> + [] = Wcf("\\?q") + end, + + del(Files), + ok. fold_files(Config) when is_list(Config) -> Dir = filename:join(proplists:get_value(priv_dir, Config), "fold_files"), @@ -417,10 +448,10 @@ wildcard_symlink(Config) when is_list(Config) -> erl_prim_loader)), ["sub","symlink"] = basenames(Dir, filelib:wildcard(filename:join(Dir, "*"), - prim_file)), + ?PRIM_FILE)), ["symlink"] = basenames(Dir, filelib:wildcard(filename:join(Dir, "symlink"), - prim_file)), + ?PRIM_FILE)), ok = file:delete(AFile), %% The symlink should still be visible even when its target %% has been deleted. @@ -436,10 +467,10 @@ wildcard_symlink(Config) when is_list(Config) -> erl_prim_loader)), ["sub","symlink"] = basenames(Dir, filelib:wildcard(filename:join(Dir, "*"), - prim_file)), + ?PRIM_FILE)), ["symlink"] = basenames(Dir, filelib:wildcard(filename:join(Dir, "symlink"), - prim_file)), + ?PRIM_FILE)), ok end. @@ -468,17 +499,17 @@ is_file_symlink(Config) -> ok -> true = filelib:is_dir(DirAlias), true = filelib:is_dir(DirAlias, erl_prim_loader), - true = filelib:is_dir(DirAlias, prim_file), + true = filelib:is_dir(DirAlias, ?PRIM_FILE), true = filelib:is_file(DirAlias), true = filelib:is_file(DirAlias, erl_prim_loader), - true = filelib:is_file(DirAlias, prim_file), + true = filelib:is_file(DirAlias, ?PRIM_FILE), ok = file:make_symlink(AFile,FileAlias), true = filelib:is_file(FileAlias), true = filelib:is_file(FileAlias, erl_prim_loader), - true = filelib:is_file(FileAlias, prim_file), + true = filelib:is_file(FileAlias, ?PRIM_FILE), true = filelib:is_regular(FileAlias), true = filelib:is_regular(FileAlias, erl_prim_loader), - true = filelib:is_regular(FileAlias, prim_file), + true = filelib:is_regular(FileAlias, ?PRIM_FILE), ok end. @@ -499,11 +530,11 @@ file_props_symlink(Config) -> {_,_} = LastMod = filelib:last_modified(AFile), LastMod = filelib:last_modified(Alias), LastMod = filelib:last_modified(Alias, erl_prim_loader), - LastMod = filelib:last_modified(Alias, prim_file), + LastMod = filelib:last_modified(Alias, ?PRIM_FILE), FileSize = filelib:file_size(AFile), FileSize = filelib:file_size(Alias), FileSize = filelib:file_size(Alias, erl_prim_loader), - FileSize = filelib:file_size(Alias, prim_file) + FileSize = filelib:file_size(Alias, ?PRIM_FILE) end. find_source(Config) when is_list(Config) -> diff --git a/lib/stdlib/test/filename_SUITE.erl b/lib/stdlib/test/filename_SUITE.erl index fc77593bb8..f284eb1ed6 100644 --- a/lib/stdlib/test/filename_SUITE.erl +++ b/lib/stdlib/test/filename_SUITE.erl @@ -107,6 +107,17 @@ absname(Config) when is_list(Config) -> [Drive|":/erlang/src"] = filename:absname([Drive|":erlang/src"]), "a:/erlang" = filename:absname("a:erlang"), + "//foo" = filename:absname("//foo"), + "//foo/bar" = filename:absname("//foo/bar"), + "//foo/\bar" = filename:absname("//foo/\bar"), + "//foo/bar/baz" = filename:absname("//foo/bar\\baz"), + "//foo/bar/baz" = filename:absname("//foo\\bar/baz"), + "//foo" = filename:absname("\\\\foo"), + "//foo/bar" = filename:absname("\\\\foo/bar"), + "//foo/\bar" = filename:absname("\\\\foo/\bar"), + "//foo/bar/baz" = filename:absname("\\\\foo/bar\\baz"), + "//foo/bar/baz" = filename:absname("\\\\foo\\bar/baz"), + file:set_cwd(Cwd), ok; {unix, _} -> @@ -167,6 +178,23 @@ absname_2(Config) when is_list(Config) -> [Drive|":/"]), "a:/erlang" = filename:absname("a:erlang", [Drive|":/"]), + "//foo" = filename:absname("foo","//"), + "//foo/bar" = filename:absname("foo/bar", "//"), + "//foo/bar" = filename:absname("bar", "//foo"), + "//bar" = filename:absname("/bar", "//foo"), + "//foo/bar/baz" = filename:absname("bar/baz", "//foo"), + "//bar/baz" = filename:absname("//bar/baz", "//foo"), + "//\bar" = filename:absname("/\bar", "//foo"), + "//foo" = filename:absname("foo","\\\\"), + "//foo/bar" = filename:absname("foo/bar", "\\\\"), + "//foo/bar" = filename:absname("bar", "\\\\foo"), + "//bar" = filename:absname("/bar", "\\\\foo"), + "//foo/bar/baz" = filename:absname("bar/baz", "\\\\foo"), + "//bar/baz" = filename:absname("\\\\bar/baz", "\\\\foo"), + "//\bar" = filename:absname("/\bar", "\\\\foo"), + "//bar/baz" = filename:absname("\\\\bar/baz", "//foo"), + "//bar/baz" = filename:absname("//bar/baz", "\\\\foo"), + ok; _ -> "/usr/foo" = filename:absname(foo, "/usr"), @@ -244,6 +272,18 @@ dirname(Config) when is_list(Config) -> "A:usr" = filename:dirname("A:usr/foo.erl"), "/usr" = filename:dirname("\\usr\\foo.erl"), "/" = filename:dirname("\\usr"), + "//foo/bar" = filename:dirname("//foo/bar/baz.erl"), + "//foo/\bar" = filename:dirname("//foo/\bar/baz.erl"), + "//foo/bar" = filename:dirname("//foo\\bar/baz.erl"), + "//foo/bar" = filename:dirname("\\\\foo/bar/baz.erl"), + "//foo/\bar" = filename:dirname("\\\\foo/\bar/baz.erl"), + "//foo/bar" = filename:dirname("\\\\foo\\bar/baz.erl"), + "//foo" = filename:dirname("//foo/baz.erl"), + "//foo" = filename:dirname("//foo/\baz.erl"), + "//foo" = filename:dirname("//foo\\baz.erl"), + "//foo" = filename:dirname("\\\\foo/baz.erl"), + "//foo" = filename:dirname("\\\\foo/\baz.erl"), + "//foo" = filename:dirname("\\\\foo\\baz.erl"), "A:" = filename:dirname("A:"); _ -> true end, @@ -289,7 +329,6 @@ join(Config) when is_list(Config) -> %% join/1 and join/2 (OTP-12158) by using help function %% filename_join/2. "/" = filename:join(["/"]), - "/" = filename:join(["//"]), "usr/foo.erl" = filename_join("usr","foo.erl"), "/src/foo.erl" = filename_join(usr, "/src/foo.erl"), "/src/foo.erl" = filename_join("/src/",'foo.erl'), @@ -301,7 +340,6 @@ join(Config) when is_list(Config) -> "a/b/c/d/e/f/g" = filename_join("a//b/c/", "d//e/f/g"), "a/b/c/d/e/f/g" = filename_join("a//b/c", "d//e/f/g"), "/d/e/f/g" = filename_join("a//b/c", "/d//e/f/g"), - "/d/e/f/g" = filename:join("a//b/c", "//d//e/f/g"), "foo/bar" = filename_join([$f,$o,$o,$/,[]], "bar"), @@ -332,6 +370,7 @@ join(Config) when is_list(Config) -> case os:type() of {win32, _} -> + "//" = filename:join(["//"]), "d:/" = filename:join(["D:/"]), "d:/" = filename:join(["D:\\"]), "d:/abc" = filename_join("D:/", "abc"), @@ -345,8 +384,35 @@ join(Config) when is_list(Config) -> "c:/usr/foo.erl" = filename:join(["A:","C:/usr","foo.erl"]), "c:usr/foo.erl" = filename:join(["A:","C:usr","foo.erl"]), "d:/foo" = filename:join([$D, $:, $/, []], "foo"), + "//" = filename:join("\\\\", ""), + "//foo" = filename:join("\\\\", "foo"), + "//foo/bar" = filename:join("\\\\", "foo\\\\bar"), + "//foo/bar/baz" = filename:join("\\\\foo", "bar\\\\baz"), + "//foo/bar/baz" = filename:join("\\\\foo", "bar\\baz"), + "//foo/bar/baz" = filename:join("\\\\foo\\bar", baz), + "//foo/\bar/baz" = filename:join("\\\\foo/\bar", baz), + "//foo/bar/baz" = filename:join("\\\\foo/bar", baz), + "//bar/baz" = filename:join("\\\\foo", "\\\\bar\\baz"), + "//bar/baz" = filename:join("\\\\foo", "//bar\\baz"), + "//bar/baz" = filename:join("\\\\foo", "//bar/baz"), + "//bar/baz" = filename:join("\\\\foo", "\\\\bar/baz"), + "//d/e/f/g" = filename:join("a//b/c", "//d//e/f/g"), + "//" = filename:join("//", ""), + "//foo" = filename:join("//", "foo"), + "//foo/bar" = filename:join("//", "foo\\\\bar"), + "//foo/bar/baz" = filename:join("//foo", "bar\\\\baz"), + "//foo/bar/baz" = filename:join("//foo", "bar\\baz"), + "//foo/bar/baz" = filename:join("//foo\\bar", baz), + "//foo/\bar/baz" = filename:join("//foo/\bar", baz), + "//foo/bar/baz" = filename:join("//foo/bar", baz), + "//bar/baz" = filename:join("//foo", "\\\\bar\\baz"), + "//bar/baz" = filename:join("//foo", "//bar\\baz"), + "//bar/baz" = filename:join("//foo", "//bar/baz"), + "//bar/baz" = filename:join("//foo", "\\\\bar/baz"), ok; _ -> + "/" = filename:join(["//"]), + "/d/e/f/g" = filename:join("a//b/c", "//d//e/f/g"), ok end. @@ -402,6 +468,16 @@ split(Config) when is_list(Config) -> filename:split("a:\\msdev\\include"), ["a:","msdev","include"] = filename:split("a:msdev\\include"), + ["//","foo"] = + filename:split("\\\\foo"), + ["//","foo"] = + filename:split("//foo"), + ["//","foo","bar"] = + filename:split("\\\\foo\\\\bar"), + ["//","foo","baz"] = + filename:split("\\\\foo\\baz"), + ["//","foo","baz"] = + filename:split("//foo\\baz"), ok; _ -> ok @@ -630,7 +706,6 @@ extension_bin(Config) when is_list(Config) -> join_bin(Config) when is_list(Config) -> <<"/">> = filename:join([<<"/">>]), - <<"/">> = filename:join([<<"//">>]), <<"usr/foo.erl">> = filename:join(<<"usr">>,<<"foo.erl">>), <<"/src/foo.erl">> = filename:join(usr, <<"/src/foo.erl">>), <<"/src/foo.erl">> = filename:join([<<"/src/">>,'foo.erl']), @@ -642,7 +717,6 @@ join_bin(Config) when is_list(Config) -> <<"a/b/c/d/e/f/g">> = filename:join([<<"a//b/c/">>, <<"d//e/f/g">>]), <<"a/b/c/d/e/f/g">> = filename:join([<<"a//b/c">>, <<"d//e/f/g">>]), <<"/d/e/f/g">> = filename:join([<<"a//b/c">>, <<"/d//e/f/g">>]), - <<"/d/e/f/g">> = filename:join([<<"a//b/c">>, <<"//d//e/f/g">>]), <<"foo/bar">> = filename:join([$f,$o,$o,$/,[]], <<"bar">>), @@ -695,6 +769,7 @@ join_bin(Config) when is_list(Config) -> case os:type() of {win32, _} -> + <<"//">> = filename:join([<<"//">>]), <<"d:/">> = filename:join([<<"D:/">>]), <<"d:/">> = filename:join([<<"D:\\">>]), <<"d:/abc">> = filename:join([<<"D:/">>, <<"abc">>]), @@ -708,8 +783,35 @@ join_bin(Config) when is_list(Config) -> <<"c:/usr/foo.erl">> = filename:join([<<"A:">>,<<"C:/usr">>,<<"foo.erl">>]), <<"c:usr/foo.erl">> = filename:join([<<"A:">>,<<"C:usr">>,<<"foo.erl">>]), <<"d:/foo">> = filename:join([$D, $:, $/, []], <<"foo">>), + <<"//">> = filename:join(<<"\\\\">>, <<"">>), + <<"//foo">> = filename:join(<<"\\\\">>, <<"foo">>), + <<"//foo/bar">> = filename:join(<<"\\\\">>, <<"foo\\\\bar">>), + <<"//foo/bar/baz">> = filename:join(<<"\\\\foo">>, <<"bar\\\\baz">>), + <<"//bar/baz">> = filename:join(<<"\\\\foo">>, <<"\\\\bar\\baz">>), + <<"//foo/bar/baz">> = filename:join(<<"\\\\foo\\bar">>, baz), + <<"//foo/\bar/baz">> = filename:join(<<"\\\\foo/\bar">>, baz), + <<"//foo/bar/baz">> = filename:join(<<"\\\\foo/bar">>, baz), + <<"//bar/baz">> = filename:join(<<"\\\\foo">>, <<"\\\\bar\\baz">>), + <<"//bar/baz">> = filename:join(<<"\\\\foo">>, <<"//bar\\baz">>), + <<"//bar/baz">> = filename:join(<<"\\\\foo">>, <<"//bar/baz">>), + <<"//bar/baz">> = filename:join(<<"\\\\foo">>, <<"\\\\bar/baz">>), + <<"//d/e/f/g">> = filename:join([<<"a//b/c">>, <<"//d//e/f/g">>]), + <<"//">> = filename:join(<<"//">>, <<"">>), + <<"//foo">> = filename:join(<<"//">>, <<"foo">>), + <<"//foo/bar">> = filename:join(<<"//">>, <<"foo\\\\bar">>), + <<"//foo/bar/baz">> = filename:join(<<"//foo">>, <<"bar\\\\baz">>), + <<"//bar/baz">> = filename:join(<<"//foo">>, <<"\\\\bar\\baz">>), + <<"//foo/bar/baz">> = filename:join(<<"//foo\\bar">>, baz), + <<"//foo/\bar/baz">> = filename:join(<<"//foo/\bar">>, baz), + <<"//foo/bar/baz">> = filename:join(<<"//foo/bar">>, baz), + <<"//bar/baz">> = filename:join(<<"//foo">>, <<"\\\\bar\\baz">>), + <<"//bar/baz">> = filename:join(<<"//foo">>, <<"//bar\\baz">>), + <<"//bar/baz">> = filename:join(<<"//foo">>, <<"//bar/baz">>), + <<"//bar/baz">> = filename:join(<<"//foo">>, <<"\\\\bar/baz">>), ok; _ -> + <<"/">> = filename:join([<<"//">>]), + <<"/d/e/f/g">> = filename:join([<<"a//b/c">>, <<"//d//e/f/g">>]), ok end. @@ -756,6 +858,16 @@ split_bin(Config) when is_list(Config) -> filename:split(<<"a:\\msdev\\include">>), [<<"a:">>,<<"msdev">>,<<"include">>] = filename:split(<<"a:msdev\\include">>), + [<<"//">>,<<"foo">>] = + filename:split(<<"\\\\foo">>), + [<<"//">>,<<"foo">>] = + filename:split(<<"//foo">>), + [<<"//">>,<<"foo">>,<<"bar">>] = + filename:split(<<"\\\\foo\\\\bar">>), + [<<"//">>,<<"foo">>,<<"baz">>] = + filename:split(<<"\\\\foo\\baz">>), + [<<"//">>,<<"foo">>,<<"baz">>] = + filename:split(<<"//foo\\baz">>), ok; _ -> ok diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl index 2e9dc4d4fb..2bc220fef2 100644 --- a/lib/stdlib/test/gen_server_SUITE.erl +++ b/lib/stdlib/test/gen_server_SUITE.erl @@ -27,7 +27,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). -export([start/1, crash/1, call/1, cast/1, cast_fast/1, - info/1, abcast/1, multicall/1, multicall_down/1, + continue/1, info/1, abcast/1, multicall/1, multicall_down/1, call_remote1/1, call_remote2/1, call_remote3/1, call_remote_n1/1, call_remote_n2/1, call_remote_n3/1, spec_init/1, spec_init_local_registered_parent/1, @@ -37,7 +37,8 @@ get_state/1, replace_state/1, call_with_huge_message_queue/1, undef_handle_call/1, undef_handle_cast/1, undef_handle_info/1, undef_init/1, undef_code_change/1, undef_terminate1/1, - undef_terminate2/1, undef_in_terminate/1, undef_in_handle_info/1 + undef_terminate2/1, undef_in_terminate/1, undef_in_handle_info/1, + undef_handle_continue/1 ]). -export([stop1/1, stop2/1, stop3/1, stop4/1, stop5/1, stop6/1, stop7/1, @@ -52,7 +53,7 @@ %% The gen_server behaviour --export([init/1, handle_call/3, handle_cast/2, +-export([init/1, handle_call/3, handle_cast/2, handle_continue/2, handle_info/2, code_change/3, terminate/2, format_status/2]). suite() -> @@ -61,7 +62,7 @@ suite() -> all() -> [start, {group,stop}, crash, call, cast, cast_fast, info, abcast, - multicall, multicall_down, call_remote1, call_remote2, + continue, multicall, multicall_down, call_remote1, call_remote2, call_remote3, call_remote_n1, call_remote_n2, call_remote_n3, spec_init, spec_init_local_registered_parent, @@ -76,7 +77,7 @@ groups() -> [{stop, [], [stop1, stop2, stop3, stop4, stop5, stop6, stop7, stop8, stop9, stop10]}, {undef_callbacks, [], - [undef_handle_call, undef_handle_cast, undef_handle_info, + [undef_handle_call, undef_handle_cast, undef_handle_info, undef_handle_continue, undef_init, undef_code_change, undef_terminate1, undef_terminate2]}]. @@ -458,6 +459,47 @@ call(Config) when is_list(Config) -> ok. %% -------------------------------------- +%% Test handle_continue. +%% -------------------------------------- + +continue(Config) when is_list(Config) -> + {ok, Pid} = gen_server:start_link(gen_server_SUITE, {continue, self()}, []), + [{Pid, continue}, {Pid, after_continue}] = read_replies(Pid), + + gen_server:call(Pid, {continue_reply, self()}), + [{Pid, continue}, {Pid, after_continue}] = read_replies(Pid), + + gen_server:call(Pid, {continue_noreply, self()}), + [{Pid, continue}, {Pid, after_continue}] = read_replies(Pid), + + gen_server:cast(Pid, {continue_noreply, self()}), + [{Pid, continue}, {Pid, after_continue}] = read_replies(Pid), + + Pid ! {continue_noreply, self()}, + [{Pid, continue}, {Pid, after_continue}] = read_replies(Pid), + + Pid ! {continue_continue, self()}, + [{Pid, before_continue}, {Pid, continue}, {Pid, after_continue}] = read_replies(Pid), + + Ref = monitor(process, Pid), + Pid ! continue_stop, + verify_down_reason(Ref, Pid, normal). + +read_replies(Pid) -> + receive + {Pid, ack} -> read_replies() + after + 1000 -> ct:fail({continue, ack}) + end. + +read_replies() -> + receive + Msg -> [Msg | read_replies()] + after + 0 -> [] + end. + +%% -------------------------------------- %% Test call to nonexisting processes on remote nodes %% -------------------------------------- @@ -1346,7 +1388,7 @@ echo_loop() -> %% Test the default implementation of terminate if the callback module %% does not export it undef_terminate1(Config) when is_list(Config) -> - {ok, Server} = gen_server:start(oc_server, [], []), + {ok, Server} = oc_server:start(), MRef = monitor(process, Server), ok = gen_server:stop(Server), ok = verify_down_reason(MRef, Server, normal). @@ -1354,7 +1396,7 @@ undef_terminate1(Config) when is_list(Config) -> %% Test the default implementation of terminate if the callback module %% does not export it undef_terminate2(Config) when is_list(Config) -> - {ok, Server} = gen_server:start(oc_server, [], []), + {ok, Server} = oc_server:start(), MRef = monitor(process, Server), ok = gen_server:stop(Server, {error, test}, infinity), ok = verify_down_reason(MRef, Server, {error, test}). @@ -1377,7 +1419,7 @@ undef_init(_Config) -> %% The upgrade should fail if code_change is expected in the callback module %% but not exported, but the server should continue with the old code undef_code_change(Config) when is_list(Config) -> - {ok, Server} = gen_server:start(oc_server, [], []), + {ok, Server} = oc_server:start(), {error, {'EXIT', {undef, [{oc_server, code_change, [_, _, _], _}|_]}}} = fake_upgrade(Server, ?MODULE), true = is_process_alive(Server). @@ -1385,7 +1427,7 @@ undef_code_change(Config) when is_list(Config) -> %% The server should crash if the handle_call callback is %% not exported in the callback module undef_handle_call(_Config) -> - {ok, Server} = gen_server:start(oc_server, [], []), + {ok, Server} = oc_server:start(), try gen_server:call(Server, call_msg), ct:fail(should_crash) @@ -1397,17 +1439,25 @@ undef_handle_call(_Config) -> %% The server should crash if the handle_cast callback is %% not exported in the callback module undef_handle_cast(_Config) -> - {ok, Server} = gen_server:start(oc_server, [], []), + {ok, Server} = oc_server:start(), MRef = monitor(process, Server), gen_server:cast(Server, cast_msg), verify_undef_down(MRef, Server, oc_server, handle_cast), ok. +%% The server should crash if the handle_continue callback is +%% not exported in the callback module +undef_handle_continue(_Config) -> + {ok, Server} = oc_server:start(continue), + MRef = monitor(process, Server), + verify_undef_down(MRef, Server, oc_server, handle_continue), + ok. + %% The server should log but not crash if the handle_info callback is %% calling an undefined function undef_handle_info(Config) when is_list(Config) -> error_logger_forwarder:register(), - {ok, Server} = gen_server:start(oc_server, [], []), + {ok, Server} = oc_server:start(), Server ! hej, wait_until_processed(Server, hej, 10), true = is_process_alive(Server), @@ -1570,8 +1620,11 @@ init(hibernate) -> init(sleep) -> ct:sleep(1000), {ok, []}; +init({continue, Pid}) -> + self() ! {after_continue, Pid}, + {ok, [], {continue, {message, Pid}}}; init({state,State}) -> - {ok, State}. + {ok,State}. handle_call(started_p, _From, State) -> io:format("FROZ"), @@ -1604,6 +1657,12 @@ handle_call(shutdown_reason, _From, _State) -> handle_call({call_undef_fun, Mod, Fun}, _From, State) -> Mod:Fun(), {reply, ok, State}; +handle_call({continue_reply, Pid}, _From, State) -> + self() ! {after_continue, Pid}, + {reply, ok, State, {continue, {message, Pid}}}; +handle_call({continue_noreply, Pid}, From, State) -> + self() ! {after_continue, Pid}, + {noreply, State, {continue, {message, Pid, From}}}; handle_call(stop_shutdown_reason, _From, State) -> {stop,{shutdown,stop_reason},State}. @@ -1620,6 +1679,9 @@ handle_cast(hibernate_later, _State) -> handle_cast({call_undef_fun, Mod, Fun}, State) -> Mod:Fun(), {noreply, State}; +handle_cast({continue_noreply, Pid}, State) -> + self() ! {after_continue, Pid}, + {noreply, State, {continue, {message, Pid}}}; handle_cast({From, stop}, State) -> io:format("BAZ"), {stop, {From,stopped}, State}. @@ -1657,9 +1719,34 @@ handle_info(continue, From) -> {noreply, []}; handle_info({From, stop}, State) -> {stop, {From,stopped_info}, State}; +handle_info({after_continue, Pid}, State) -> + Pid ! {self(), after_continue}, + Pid ! {self(), ack}, + {noreply, State}; +handle_info({continue_noreply, Pid}, State) -> + self() ! {after_continue, Pid}, + {noreply, State, {continue, {message, Pid}}}; +handle_info({continue_continue, Pid}, State) -> + {noreply, State, {continue, {continue, Pid}}}; +handle_info(continue_stop, State) -> + {noreply, State, {continue, stop}}; handle_info(_Info, State) -> {noreply, State}. +handle_continue({continue, Pid}, State) -> + Pid ! {self(), before_continue}, + self() ! {after_continue, Pid}, + {noreply, State, {continue, {message, Pid}}}; +handle_continue(stop, State) -> + {stop, normal, State}; +handle_continue({message, Pid}, State) -> + Pid ! {self(), continue}, + {noreply, State}; +handle_continue({message, Pid, From}, State) -> + Pid ! {self(), continue}, + gen_server:reply(From, ok), + {noreply, State}. + code_change(_OldVsn, {new, {undef_in_code_change, {Mod, Fun}}} = State, _Extra) -> diff --git a/lib/stdlib/test/gen_server_SUITE_data/oc_server.erl b/lib/stdlib/test/gen_server_SUITE_data/oc_server.erl index 4ba37987f3..7b92a49bf6 100644 --- a/lib/stdlib/test/gen_server_SUITE_data/oc_server.erl +++ b/lib/stdlib/test/gen_server_SUITE_data/oc_server.erl @@ -22,7 +22,7 @@ -behaviour(gen_server). %% API --export([start/0]). +-export([start/0, start/1]). %% gen_server callbacks -export([init/1]). @@ -30,8 +30,12 @@ -record(state, {}). start() -> - gen_server:start({local, ?MODULE}, ?MODULE, [], []). + gen_server:start(?MODULE, ok, []). -init([]) -> - {ok, #state{}}. +start(continue) -> + gen_server:start(?MODULE, continue, []). +init(ok) -> + {ok, #state{}}; +init(continue) -> + {ok, #state{}, {continue, continue}}. diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl index e2c73371cd..13929bdbb6 100644 --- a/lib/stdlib/test/io_SUITE.erl +++ b/lib/stdlib/test/io_SUITE.erl @@ -2138,8 +2138,8 @@ otp_14175(_Config) -> "#{}" = p(#{}, 1), "#{...}" = p(#{a => 1}, 1), "#{#{} => a}" = p(#{#{} => a}, 2), - "#{a => 1,...}" = p(#{a => 1, b => 2}, 2), - "#{a => 1,b => 2}" = p(#{a => 1, b => 2}, -1), + mt("#{a => 1,...}", p(#{a => 1, b => 2}, 2)), + mt("#{a => 1,b => 2}", p(#{a => 1, b => 2}, -1)), M = #{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2, kccccccccccccccccccc => v3,kddddddddddddddddddd => v4, diff --git a/lib/stdlib/test/maps_SUITE.erl b/lib/stdlib/test/maps_SUITE.erl index 42e669a799..a75751b31d 100644 --- a/lib/stdlib/test/maps_SUITE.erl +++ b/lib/stdlib/test/maps_SUITE.erl @@ -30,6 +30,7 @@ -export([t_update_with_3/1, t_update_with_4/1, t_get_3/1, t_filter_2/1, t_fold_3/1,t_map_2/1,t_size_1/1, + t_iterator_1/1, t_with_2/1,t_without_2/1]). %%-define(badmap(V,F,Args), {'EXIT', {{badmap,V}, [{maps,F,Args,_}|_]}}). @@ -47,6 +48,7 @@ all() -> [t_update_with_3,t_update_with_4, t_get_3,t_filter_2, t_fold_3,t_map_2,t_size_1, + t_iterator_1, t_with_2,t_without_2]. t_update_with_3(Config) when is_list(Config) -> @@ -127,6 +129,8 @@ t_filter_2(Config) when is_list(Config) -> Pred2 = fun(K,V) -> is_list(K) andalso (V rem 2) =:= 0 end, #{a := 2,c := 4} = maps:filter(Pred1,M), #{"b" := 2,"c" := 4} = maps:filter(Pred2,M), + #{a := 2,c := 4} = maps:filter(Pred1,maps:iterator(M)), + #{"b" := 2,"c" := 4} = maps:filter(Pred2,maps:iterator(M)), %% error case ?badmap(a,filter,[_,a]) = (catch maps:filter(fun(_,_) -> ok end,id(a))), ?badarg(filter,[<<>>,#{}]) = (catch maps:filter(id(<<>>),#{})), @@ -139,6 +143,8 @@ t_fold_3(Config) when is_list(Config) -> Tot0 = lists:sum(Vs), Tot1 = maps:fold(fun({k,_},V,A) -> A + V end, 0, M0), true = Tot0 =:= Tot1, + Tot2 = maps:fold(fun({k,_},V,A) -> A + V end, 0, maps:iterator(M0)), + true = Tot0 =:= Tot2, %% error case ?badmap(a,fold,[_,0,a]) = (catch maps:fold(fun(_,_,_) -> ok end,0,id(a))), @@ -151,12 +157,48 @@ t_map_2(Config) when is_list(Config) -> #{ {k,1} := 1, {k,200} := 200} = M0, M1 = maps:map(fun({k,_},V) -> V + 42 end, M0), #{ {k,1} := 43, {k,200} := 242} = M1, + M2 = maps:map(fun({k,_},V) -> V + 42 end, maps:iterator(M0)), + #{ {k,1} := 43, {k,200} := 242} = M2, %% error case ?badmap(a,map,[_,a]) = (catch maps:map(fun(_,_) -> ok end, id(a))), ?badarg(map,[<<>>,#{}]) = (catch maps:map(id(<<>>),#{})), ok. +t_iterator_1(Config) when is_list(Config) -> + + %% Small map test + M0 = #{ a => 1, b => 2 }, + I0 = maps:iterator(M0), + {K1,V1,I1} = maps:next(I0), + {K2,V2,I2} = maps:next(I1), + none = maps:next(I2), + + KVList = lists:sort([{K1,V1},{K2,V2}]), + KVList = lists:sort(maps:to_list(M0)), + + %% Large map test + + Vs2 = lists:seq(1,200), + M2 = maps:from_list([{{k,I},I}||I<-Vs2]), + KVList2 = lists:sort(iter_kv(maps:iterator(M2))), + KVList2 = lists:sort(maps:to_list(M2)), + + %% Larger map test + + Vs3 = lists:seq(1,10000), + M3 = maps:from_list([{{k,I},I}||I<-Vs3]), + KVList3 = lists:sort(iter_kv(maps:iterator(M3))), + KVList3 = lists:sort(maps:to_list(M3)), + ok. + +iter_kv(I) -> + case maps:next(I) of + none -> + []; + {K,V,NI} -> + [{K,V} | iter_kv(NI)] + end. t_size_1(Config) when is_list(Config) -> 0 = maps:size(#{}), diff --git a/lib/stdlib/test/property_test/README b/lib/stdlib/test/property_test/README new file mode 100644 index 0000000000..57602bf719 --- /dev/null +++ b/lib/stdlib/test/property_test/README @@ -0,0 +1,12 @@ + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% %%% +%%% WARNING %%% +%%% %%% +%%% This is experimental code which may be changed or removed %%% +%%% anytime without any warning. %%% +%%% %%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +The test in this directory are written assuming that the user has a QuickCheck license. They are to be run manually. Some may be possible to be run with other tools, e.g. PropEr. + diff --git a/lib/stdlib/test/property_test/uri_string_recompose.erl b/lib/stdlib/test/property_test/uri_string_recompose.erl new file mode 100644 index 0000000000..e51a671172 --- /dev/null +++ b/lib/stdlib/test/property_test/uri_string_recompose.erl @@ -0,0 +1,361 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(uri_string_recompose). + +-compile(export_all). + +-proptest(eqc). +-proptest([triq,proper]). + +-ifndef(EQC). +-ifndef(PROPER). +-ifndef(TRIQ). +-define(EQC,true). +-endif. +-endif. +-endif. + +-ifdef(EQC). +-include_lib("eqc/include/eqc.hrl"). +-define(MOD_eqc,eqc). + +-else. +-ifdef(PROPER). +-include_lib("proper/include/proper.hrl"). +-define(MOD_eqc,proper). + +-else. +-ifdef(TRIQ). +-define(MOD_eqc,triq). +-include_lib("triq/include/triq.hrl"). + +-endif. +-endif. +-endif. + + +-define(STRING_REST(MatchStr, Rest), <<MatchStr/utf8, Rest/binary>>). + +-define(SCHEME, {scheme, scheme()}). +-define(USER, {userinfo, unicode()}). +-define(HOST, {host, host_map()}). +-define(PORT, {port, port()}). +-define(PATH_ABE, {path, path_abempty_map()}). +-define(PATH_ABS, {path, path_absolute_map()}). +-define(PATH_NOS, {path, path_noscheme_map()}). +-define(PATH_ROO, {path, path_rootless_map()}). +-define(PATH_EMP, {path, path_empty_map()}). +-define(QUERY, {query, query_map()}). +-define(FRAGMENT, {fragment, fragment_map()}). + + +%%%======================================================================== +%%% Properties +%%%======================================================================== + +prop_recompose() -> + ?FORALL(Map, map(), + Map =:= uri_string:parse(uri_string:recompose(Map)) + ). + +%% Stats +prop_map_key_length_collect() -> + ?FORALL(List, map(), + collect(length(maps:keys(List)), true)). + +prop_map_collect() -> + ?FORALL(List, map(), + collect(lists:sort(maps:keys(List)), true)). + +prop_scheme_collect() -> + ?FORALL(List, scheme(), + collect(length(List), true)). + + +%%%======================================================================== +%%% Generators +%%%======================================================================== + +map() -> + ?LET(Gen, comp_proplist(), proplist_to_map(Gen)). + +comp_proplist() -> + frequency([ + {2, [?SCHEME,?PATH_ABS]}, + {2, [?SCHEME,?PATH_ROO]}, + {2, [?SCHEME,?PATH_EMP]}, + {2, [?SCHEME,?HOST,?PATH_ABE]}, + {2, [?SCHEME,?USER,?HOST,?PATH_ABE]}, + {2, [?SCHEME,?HOST,?PORT,?PATH_ABE]}, + {2, [?SCHEME,?USER,?HOST,?PORT,?PATH_ABE]}, + + {2, [?PATH_ABS]}, + {2, [?PATH_NOS]}, + {2, [?PATH_EMP]}, + {2, [?HOST,?PATH_ABE]}, + {2, [?USER,?HOST,?PATH_ABE]}, + {2, [?HOST,?PORT,?PATH_ABE]}, + {2, [?USER,?HOST,?PORT,?PATH_ABE]}, + + + {2, [?SCHEME,?PATH_ABS,?QUERY]}, + {2, [?SCHEME,?PATH_ROO,?QUERY]}, + {2, [?SCHEME,?PATH_EMP,?QUERY]}, + {2, [?SCHEME,?HOST,?PATH_ABE,?QUERY]}, + {2, [?SCHEME,?USER,?HOST,?PATH_ABE,?QUERY]}, + {2, [?SCHEME,?HOST,?PORT,?PATH_ABE,?QUERY]}, + {2, [?SCHEME,?USER,?HOST,?PORT,?PATH_ABE,?QUERY]}, + + {2, [?PATH_ABS,?QUERY]}, + {2, [?PATH_NOS,?QUERY]}, + {2, [?PATH_EMP,?QUERY]}, + {2, [?HOST,?PATH_ABE,?QUERY]}, + {2, [?USER,?HOST,?PATH_ABE,?QUERY]}, + {2, [?HOST,?PORT,?PATH_ABE,?QUERY]}, + {2, [?USER,?HOST,?PORT,?PATH_ABE,?QUERY]}, + + + {2, [?SCHEME,?PATH_ABS,?FRAGMENT]}, + {2, [?SCHEME,?PATH_ROO,?FRAGMENT]}, + {2, [?SCHEME,?PATH_EMP,?FRAGMENT]}, + {2, [?SCHEME,?HOST,?PATH_ABE,?FRAGMENT]}, + {2, [?SCHEME,?USER,?HOST,?PATH_ABE,?FRAGMENT]}, + {2, [?SCHEME,?HOST,?PORT,?PATH_ABE,?FRAGMENT]}, + {2, [?SCHEME,?USER,?HOST,?PORT,?PATH_ABE,?FRAGMENT]}, + + {2, [?PATH_ABS,?FRAGMENT]}, + {2, [?PATH_NOS,?FRAGMENT]}, + {2, [?PATH_EMP,?FRAGMENT]}, + {2, [?HOST,?PATH_ABE,?FRAGMENT]}, + {2, [?USER,?HOST,?PATH_ABE,?FRAGMENT]}, + {2, [?HOST,?PORT,?PATH_ABE,?FRAGMENT]}, + {2, [?USER,?HOST,?PORT,?PATH_ABE,?FRAGMENT]}, + + + {2, [?SCHEME,?PATH_ABS,?QUERY,?FRAGMENT]}, + {2, [?SCHEME,?PATH_ROO,?QUERY,?FRAGMENT]}, + {2, [?SCHEME,?PATH_EMP,?QUERY,?FRAGMENT]}, + {2, [?SCHEME,?HOST,?PATH_ABE,?QUERY,?FRAGMENT]}, + {2, [?SCHEME,?USER,?HOST,?PATH_ABE,?QUERY,?FRAGMENT]}, + {2, [?SCHEME,?HOST,?PORT,?PATH_ABE,?QUERY,?FRAGMENT]}, + {2, [?SCHEME,?USER,?HOST,?PORT,?PATH_ABE,?QUERY,?FRAGMENT]}, + + {2, [?PATH_ABS,?QUERY,?FRAGMENT]}, + {2, [?PATH_NOS,?QUERY,?FRAGMENT]}, + {2, [?PATH_EMP,?QUERY,?FRAGMENT]}, + {2, [?HOST,?PATH_ABE,?QUERY,?FRAGMENT]}, + {2, [?USER,?HOST,?PATH_ABE,?QUERY,?FRAGMENT]}, + {2, [?HOST,?PORT,?PATH_ABE,?QUERY,?FRAGMENT]}, + {2, [?USER,?HOST,?PORT,?PATH_ABE,?QUERY,?FRAGMENT]} + ]). + + +%%------------------------------------------------------------------------- +%% Path +%%------------------------------------------------------------------------- +path_abempty_map() -> + frequency([{90, path_abe_map()}, + {10, path_empty_map()}]). + +path_abe_map() -> + ?SIZED(Length, path_abe_map(Length, [])). +%% +path_abe_map(0, Segments) -> + ?LET(Gen, Segments, lists:append(Gen)); +path_abe_map(N, Segments) -> + path_abe_map(N-1, [slash(),segment()|Segments]). + + +path_absolute_map() -> + ?SIZED(Length, path_absolute_map(Length, [])). +%% +path_absolute_map(0, Segments) -> + ?LET(Gen, [slash(),segment_nz()|Segments], lists:append(Gen)); +path_absolute_map(N, Segments) -> + path_absolute_map(N-1, [slash(),segment()|Segments]). + + +path_noscheme_map() -> + ?SIZED(Length, path_noscheme_map(Length, [])). +%% +path_noscheme_map(0, Segments) -> + ?LET(Gen, [segment_nz_nc()|Segments], lists:append(Gen)); +path_noscheme_map(N, Segments) -> + path_noscheme_map(N-1, [slash(),segment()|Segments]). + +path_rootless_map() -> + ?SIZED(Length, path_rootless_map(Length, [])). +%% +path_rootless_map(0, Segments) -> + ?LET(Gen, [segment_nz()|Segments], lists:append(Gen)); +path_rootless_map(N, Segments) -> + path_rootless_map(N-1, [slash(),segment()|Segments]). + + +segment_nz() -> + non_empty(segment()). + +segment_nz_nc() -> + non_empty(list(frequency([{30, unreserved()}, + {10, sub_delims()}, + {10, unicode_char()}, + {5, oneof([$@])} + ]))). + + +segment() -> + list(frequency([{30, unreserved()}, + {10, sub_delims()}, + {10, unicode_char()}, + {5, oneof([$:, $@])} + ])). + +slash() -> + "/". + +path_empty_map() -> + "". + + +%%------------------------------------------------------------------------- +%% Path +%%------------------------------------------------------------------------- +host_map() -> + frequency([{30, reg_name()}, + {30, ip_address()} + ]). + + +reg_name() -> + list(frequency([{30, alpha()}, + {10, sub_delims()}, + {10, unicode_char()} + ])). + +ip_address() -> + oneof(["127.0.0.1", "::127.0.0.1", + "2001:0db8:0000:0000:0000:0000:1428:07ab", + "2001:0db8:0000:0000:0000::1428:07ab", + "2001:0db8:0:0:0:0:1428:07ab", + "2001:0db8:0::0:1428:07ab"]). + +%% Generating only reg-names +host_uri() -> + non_empty(list(frequency([{30, unreserved()}, + {10, sub_delims()}, + {10, pct_encoded()} + ]))). + +%%------------------------------------------------------------------------- +%% Port, Query, Fragment +%%------------------------------------------------------------------------- +port() -> + frequency([{10, undefined}, + {10, range(1,65535)} + ]). + +query_map() -> + unicode(). + + +query_uri() -> + [$?| non_empty(list(frequency([{20, pchar()}, + {5, oneof([$/, $?])} % punctuation + ])))]. + +fragment_map() -> + unicode(). + +fragment_uri() -> + [$?| non_empty(list(frequency([{20, pchar()}, + {5, oneof([$/, $?])} % punctuation + ])))]. + + +%%------------------------------------------------------------------------- +%% Scheme +%%------------------------------------------------------------------------- +scheme() -> + ?SIZED(Length, scheme_start(Length, [])). +%% +scheme_start(0, L) -> + ?LET(Gen, L, lists:reverse(Gen)); +scheme_start(N, L) -> + scheme(N-1,[alpha()|L]). + +scheme(0, L) -> + ?LET(Gen, L, lists:reverse(Gen)); +scheme(N, L) -> + scheme(N-1, [scheme_char()|L]). + + +%%------------------------------------------------------------------------- +%% Misc +%%------------------------------------------------------------------------- +unicode() -> + list(frequency([{20, alpha()}, % alpha + {10, digit()}, % digit + {10, unicode_char()} % unicode + ])). + +scheme_char() -> + frequency([{20, alpha()}, % alpha + {20, digit()}, % digit + {5, oneof([$+, $-, $.])} % punctuation + ]). + +sub_delims() -> + oneof([$!, $$, $&, $', $(, $), + $*, $+, $,,$;, $=]). + +pchar() -> + frequency([{20, unreserved()}, + {5, pct_encoded()}, + {5, sub_delims()}, + {1, oneof([$:, $@])} % punctuation + ]). + +unreserved() -> + frequency([{20, alpha()}, + {5, digit()}, + {1, oneof([$-, $., $_, $~])} % punctuation + ]). + +unicode_char() -> + range(913, 1023). + +alpha() -> + frequency([{20, range($a, $z)}, % letters + {20, range($A, $Z)}]). % letters + +digit() -> + range($0, $9). % numbers + +pct_encoded() -> + oneof(["%C3%A4", "%C3%A5", "%C3%B6"]). + + +%%%======================================================================== +%%% Helpers +%%%======================================================================== +proplist_to_map(L) -> + lists:foldl(fun({K,V},M) -> M#{K => V}; + (_,M) -> M + end, #{}, L). diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl index 5e9e03e410..8f8a0f6e73 100644 --- a/lib/stdlib/test/qlc_SUITE.erl +++ b/lib/stdlib/test/qlc_SUITE.erl @@ -1695,28 +1695,7 @@ sort(Config) when is_list(Config) -> [true || I <- lists:seq(1, 50000), not ets:insert(E, {I, I})], H = qlc:q([{X,Y} || X <- [a,b], Y <- qlc:sort(ets:table(E))]), 100000 = length(qlc:e(H)), - ets:delete(E)">>, - - begin - TmpDir = ?privdir, - [<<"TE = process_flag(trap_exit, true), - E = ets:new(foo, []), - [true || I <- lists:seq(1, 50000), not ets:insert(E, {I, I})], - Ports = erlang:ports(), - H = qlc:q([{X,Y} || X <- [a,b], - begin - [P] = erlang:ports() -- Ports, - exit(P, port_exit), - true - end, - Y <- qlc:sort(ets:table(E), - [{tmpdir,\"">>, - TmpDir, <<"\"}])]), - {error, qlc, {file_error, _, _}} = (catch qlc:e(H)), - receive {'EXIT', _, port_exit} -> ok end, - ets:delete(E), - process_flag(trap_exit, TE)">>] - end + ets:delete(E)">> ], run(Config, Ts), @@ -7871,7 +7850,7 @@ run_test(Config, Extra, {cres, Body, Opts, ExpectedCompileReturn}) -> {module, _} = code:load_abs(AbsFile, Mod), Ms0 = erlang:process_info(self(),messages), - Before = {{get(), lists:sort(ets:all()), Ms0}, pps()}, + Before = {{lget(), lists:sort(ets:all()), Ms0}, pps()}, %% Prepare the check that the qlc module does not call qlc_pt. _ = [unload_pt() || {file, Name} <- [code:is_loaded(qlc_pt)], @@ -7903,7 +7882,7 @@ run_test(Config, Extra, Body) -> wait_for_expected(R, {Strict0,PPS0}=Before, SourceFile, Wait) -> Ms = erlang:process_info(self(),messages), - After = {_,PPS1} = {{get(), lists:sort(ets:all()), Ms}, pps()}, + After = {_,PPS1} = {{lget(), lists:sort(ets:all()), Ms}, pps()}, case {R, After} of {ok, Before} -> ok; @@ -7931,6 +7910,18 @@ wait_for_expected(R, {Strict0,PPS0}=Before, SourceFile, Wait) -> expected({ok,Before}, {R,After}, SourceFile) end. +%% The qlc modules uses the process dictionary for storing names of files. +lget() -> + lists:sort([T || {K, _} = T <- get(), is_qlc_key(K)]). + +%% Copied from the qlc module. +-define(LCACHE_FILE(Ref), {Ref, '$_qlc_cache_tmpfiles_'}). +-define(MERGE_JOIN_FILE, '$_qlc_merge_join_tmpfiles_'). + +is_qlc_key(?LCACHE_FILE(_)) -> true; +is_qlc_key(?MERGE_JOIN_FILE) -> true; +is_qlc_key(_) -> false. + unload_pt() -> erlang:garbage_collect(), % get rid of references to qlc_pt... _ = code:purge(qlc_pt), diff --git a/lib/stdlib/test/rand_SUITE.erl b/lib/stdlib/test/rand_SUITE.erl index 432293b656..ef4f9faad9 100644 --- a/lib/stdlib/test/rand_SUITE.erl +++ b/lib/stdlib/test/rand_SUITE.erl @@ -29,11 +29,14 @@ basic_stats_uniform_1/1, basic_stats_uniform_2/1, basic_stats_standard_normal/1, basic_stats_normal/1, + uniform_real_conv/1, plugin/1, measure/1, reference_jump_state/1, reference_jump_procdict/1]). -export([test/0, gen/1]). +-export([uniform_real_gen/1, uniform_gen/2]). + -include_lib("common_test/include/ct.hrl"). -define(LOOP, 1000000). @@ -46,7 +49,7 @@ all() -> [seed, interval_int, interval_float, api_eq, reference, - {group, basic_stats}, + {group, basic_stats}, uniform_real_conv, plugin, measure, {group, reference_jump} ]. @@ -80,7 +83,7 @@ test() -> end, Tests). algs() -> - [exs64, exsplus, exsp, exrop, exs1024, exs1024s]. + [exrop, exsp, exs1024s, exs64, exsplus, exs1024]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -101,7 +104,7 @@ seed_1(Alg) -> _ = rand:uniform(), S00 = get(rand_seed), erase(), - _ = rand:uniform(), + _ = rand:uniform_real(), false = S00 =:= get(rand_seed), %% hopefully %% Choosing algo and seed @@ -228,11 +231,13 @@ interval_float(Config) when is_list(Config) -> interval_float_1(0) -> ok; interval_float_1(N) -> X = rand:uniform(), + Y = rand:uniform_real(), if - 0.0 =< X, X < 1.0 -> + 0.0 =< X, X < 1.0, 0.0 < Y, Y < 1.0 -> ok; true -> - io:format("X=~p 0=<~p<1.0~n", [X,X]), + io:format("X=~p 0.0=<~p<1.0~n", [X,X]), + io:format("Y=~p 0.0<~p<1.0~n", [Y,Y]), exit({X, rand:export_seed()}) end, interval_float_1(N-1). @@ -334,7 +339,13 @@ basic_stats_normal(Config) when is_list(Config) -> IntendedMeanVariancePairs). basic_uniform_1(N, S0, Sum, A0) when N > 0 -> - {X,S} = rand:uniform_s(S0), + {X,S} = + case N band 1 of + 0 -> + rand:uniform_s(S0); + 1 -> + rand:uniform_real_s(S0) + end, I = trunc(X*100), A = array:set(I, 1+array:get(I,A0), A0), basic_uniform_1(N-1, S, Sum+X, A); @@ -400,6 +411,137 @@ normal_s(Mean, Variance, State0) -> rand:normal_s(Mean, Variance, State0). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% White box test of the conversion to float + +uniform_real_conv(Config) when is_list(Config) -> + [begin +%% ct:pal("~13.16.0bx~3.16.0b: ~p~n", [M,E,Gen]), + uniform_real_conv_check(M, E, Gen) + end || {M, E, Gen} <- uniform_real_conv_data()], + uniform_real_scan(0), + uniform_real_scan(3). + +uniform_real_conv_data() -> + [{16#fffffffffffff, -1, [16#3ffffffffffffff]}, + {16#fffffffffffff, -1, [16#3ffffffffffffe0]}, + {16#ffffffffffffe, -1, [16#3ffffffffffffdf]}, + %% + {16#0000000000000, -1, [16#200000000000000]}, + {16#fffffffffffff, -2, [16#1ffffffffffffff]}, + {16#fffffffffffff, -2, [16#1fffffffffffff0]}, + {16#ffffffffffffe, -2, [16#1ffffffffffffef]}, + %% + {16#0000000000000, -2, [16#100000000000000]}, + {16#fffffffffffff, -3, [16#0ffffffffffffff]}, + {16#fffffffffffff, -3, [16#0fffffffffffff8]}, + {16#ffffffffffffe, -3, [16#0fffffffffffff7]}, + %% + {16#0000000000000, -3, [16#080000000000000]}, + {16#fffffffffffff, -4, [16#07fffffffffffff]}, + {16#fffffffffffff, -4, [16#07ffffffffffffc]}, + {16#ffffffffffffe, -4, [16#07ffffffffffffb]}, + %% + {16#0000000000000, -4, [16#040000000000000]}, + {16#fffffffffffff, -5, [16#03fffffffffffff,16#3ffffffffffffff]}, + {16#fffffffffffff, -5, [16#03ffffffffffffe,16#200000000000000]}, + {16#ffffffffffffe, -5, [16#03fffffffffffff,16#1ffffffffffffff]}, + {16#ffffffffffffe, -5, [16#03fffffffffffff,16#100000000000000]}, + %% + {16#0000000000001, -56, [16#000000000000007,16#00000000000007f]}, + {16#0000000000001, -56, [16#000000000000004,16#000000000000040]}, + {16#0000000000000, -57, [16#000000000000003,16#20000000000001f]}, + {16#0000000000000, -57, [16#000000000000000,16#200000000000000]}, + {16#fffffffffffff, -58, [16#000000000000003,16#1ffffffffffffff]}, + {16#fffffffffffff, -58, [16#000000000000000,16#1fffffffffffff0]}, + {16#ffffffffffffe, -58, [16#000000000000000,16#1ffffffffffffef]}, + {16#ffffffffffffe, -58, [16#000000000000000,16#1ffffffffffffe0]}, + %% + {16#0000000000000, -58, [16#000000000000000,16#10000000000000f]}, + {16#0000000000000, -58, [16#000000000000000,16#100000000000000]}, + {2#11001100000000000000000000000000000000000011000000011, % 53 bits + -1022, + [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, % 18 zeros + 2#1100110000000000000000000000000000000000001 bsl 2, % 43 bits + 2#1000000011 bsl (56-10+2)]}, % 10 bits + {0, -1, % 0.5 after retry + [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, % 18 zeros + 2#111111111111111111111111111111111111111111 bsl 2, % 42 bits - retry + 16#200000000000003]}]. % 0.5 + +-define(UNIFORM_REAL_SCAN_PATTERN, (16#19000000000009)). % 53 bits +-define(UNIFORM_REAL_SCAN_NUMBER, (1021)). + +uniform_real_scan_template(K) -> + <<0:?UNIFORM_REAL_SCAN_NUMBER, + ?UNIFORM_REAL_SCAN_PATTERN:53,K:2,0:1>>. + +uniform_real_scan(K) -> + Templ = uniform_real_scan_template(K), + N = ?UNIFORM_REAL_SCAN_NUMBER, + uniform_real_scan(Templ, N, K). + +uniform_real_scan(Templ, N, K) when 0 =< N -> + <<_:N/bits,T/bits>> = Templ, + Data = uniform_real_scan_data(T, K), + uniform_real_conv_check( + ?UNIFORM_REAL_SCAN_PATTERN, N - 1 - ?UNIFORM_REAL_SCAN_NUMBER, Data), + uniform_real_scan(Templ, N - 1, K); +uniform_real_scan(_, _, _) -> + ok. + +uniform_real_scan_data(Templ, K) -> + case Templ of + <<X:56, T/bits>> -> + B = rand:bc64(X), + [(X bsl 2) bor K | + if + 53 =< B -> + []; + true -> + uniform_real_scan_data(T, K) + end]; + _ -> + <<X:56, _/bits>> = <<Templ/bits, 0:56>>, + [(X bsl 2) bor K] + end. + +uniform_real_conv_check(M, E, Gen) -> + <<F/float>> = <<0:1, (E + 16#3ff):11, M:52>>, + try uniform_real_gen(Gen) of + F -> F; + FF -> + ct:pal( + "~s =/= ~s: ~s~n", + [rand:float2str(FF), rand:float2str(F), + [["16#",integer_to_list(G,16),$\s]||G<-Gen]]), + ct:fail({neq, FF, F}) + catch + Error:Reason -> + ct:pal( + "~w:~p ~s: ~s~n", + [Error, Reason, rand:float2str(F), + [["16#",integer_to_list(G,16),$\s]||G<-Gen]]), + ct:fail({Error, Reason, F, erlang:get_stacktrace()}) + end. + + +uniform_real_gen(Gen) -> + State = rand_state(Gen), + {F, {#{type := rand_SUITE_list},[]}} = rand:uniform_real_s(State), + F. + +uniform_gen(Range, Gen) -> + State = rand_state(Gen), + {N, {#{type := rand_SUITE_list},[]}} = rand:uniform_s(Range, State), + N. + +%% Loaded dice for white box tests +rand_state(Gen) -> + {#{type => rand_SUITE_list, bits => 58, weak_low_bits => 1, + next => fun ([H|T]) -> {H, T} end}, + Gen}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Test that the user can write algorithms. plugin(Config) when is_list(Config) -> @@ -459,213 +601,289 @@ measure(Config) -> {skip,{will_not_run_in_scaled_time,Scale}} end. +-define(CHECK_UNIFORM_RANGE(Gen, Range, X, St), + case (Gen) of + {(X), (St)} when is_integer(X), 1 =< (X), (X) =< (Range) -> + St + end). +-define(CHECK_UNIFORM(Gen, X, St), + case (Gen) of + {(X), (St)} when is_float(X), 0.0 =< (X), (X) < 1.0 -> + St + end). +-define(CHECK_UNIFORM_NZ(Gen, X, St), + case (Gen) of + {(X), (St)} when is_float(X), 0.0 < (X), (X) =< 1.0 -> + St + end). +-define(CHECK_NORMAL(Gen, X, St), + case (Gen) of + {(X), (St)} when is_float(X) -> + St + end). + do_measure(_Config) -> - Algos = + Algs = + algs() ++ try crypto:strong_rand_bytes(1) of - <<_>> -> [crypto64, crypto] + <<_>> -> [crypto64, crypto_cache, crypto] catch error:low_entropy -> []; error:undef -> [] - end ++ algs(), + end, %% - ct:pal("RNG uniform integer performance~n",[]), - TMark1 = + ct:pal("~nRNG uniform integer range 10000 performance~n",[]), + _ = measure_1( - random, fun (_) -> 10000 end, - undefined, - fun (Range, State) -> - {int, random:uniform_s(Range, State)} - end), + fun (State, Range, Mod) -> + measure_loop( + fun (St0) -> + ?CHECK_UNIFORM_RANGE( + Mod:uniform_s(Range, St0), Range, + X, St1) + end, + State) + end, + Algs), + %% + ct:pal("~nRNG uniform integer 32 bit performance~n",[]), _ = - [measure_1( - Algo, - fun (_) -> 10000 end, - TMark1, - fun (Range, State) -> - {int, rand:uniform_s(Range, State)} - end) || Algo <- Algos], + measure_1( + fun (_) -> 1 bsl 32 end, + fun (State, Range, Mod) -> + measure_loop( + fun (St0) -> + ?CHECK_UNIFORM_RANGE( + Mod:uniform_s(Range, St0), Range, + X, St1) + end, + State) + end, + Algs), %% ct:pal("~nRNG uniform integer half range performance~n",[]), - HalfRangeFun = fun (State) -> half_range(State) end, - TMark2 = - measure_1( - random, - HalfRangeFun, - undefined, - fun (Range, State) -> - {int, random:uniform_s(Range, State)} - end), _ = - [measure_1( - Algo, - HalfRangeFun, - TMark2, - fun (Range, State) -> - {int, rand:uniform_s(Range, State)} - end) || Algo <- Algos], - %% - ct:pal("~nRNG uniform integer half range + 1 performance~n",[]), - HalfRangePlus1Fun = fun (State) -> half_range(State) + 1 end, - TMark3 = measure_1( - random, - HalfRangePlus1Fun, - undefined, - fun (Range, State) -> - {int, random:uniform_s(Range, State)} - end), + fun (State) -> half_range(State) end, + fun (State, Range, Mod) -> + measure_loop( + fun (St0) -> + ?CHECK_UNIFORM_RANGE( + Mod:uniform_s(Range, St0), Range, + X, St1) + end, + State) + end, + Algs), + %% + ct:pal("~nRNG uniform integer half range + 1 performance~n",[]), _ = - [measure_1( - Algo, - HalfRangePlus1Fun, - TMark3, - fun (Range, State) -> - {int, rand:uniform_s(Range, State)} - end) || Algo <- Algos], + measure_1( + fun (State) -> half_range(State) + 1 end, + fun (State, Range, Mod) -> + measure_loop( + fun (St0) -> + ?CHECK_UNIFORM_RANGE( + Mod:uniform_s(Range, St0), Range, + X, St1) + end, + State) + end, + Algs), %% ct:pal("~nRNG uniform integer full range - 1 performance~n",[]), - FullRangeMinus1Fun = fun (State) -> (half_range(State) bsl 1) - 1 end, - TMark4 = - measure_1( - random, - FullRangeMinus1Fun, - undefined, - fun (Range, State) -> - {int, random:uniform_s(Range, State)} - end), _ = - [measure_1( - Algo, - FullRangeMinus1Fun, - TMark4, - fun (Range, State) -> - {int, rand:uniform_s(Range, State)} - end) || Algo <- Algos], + measure_1( + fun (State) -> (half_range(State) bsl 1) - 1 end, + fun (State, Range, Mod) -> + measure_loop( + fun (St0) -> + ?CHECK_UNIFORM_RANGE( + Mod:uniform_s(Range, St0), Range, + X, St1) + end, + State) + end, + Algs), %% ct:pal("~nRNG uniform integer full range performance~n",[]), - FullRangeFun = fun (State) -> half_range(State) bsl 1 end, - TMark5 = - measure_1( - random, - FullRangeFun, - undefined, - fun (Range, State) -> - {int, random:uniform_s(Range, State)} - end), _ = - [measure_1( - Algo, - FullRangeFun, - TMark5, - fun (Range, State) -> - {int, rand:uniform_s(Range, State)} - end) || Algo <- Algos], + measure_1( + fun (State) -> half_range(State) bsl 1 end, + fun (State, Range, Mod) -> + measure_loop( + fun (St0) -> + ?CHECK_UNIFORM_RANGE( + Mod:uniform_s(Range, St0), Range, + X, St1) + end, + State) + end, + Algs), %% ct:pal("~nRNG uniform integer full range + 1 performance~n",[]), - FullRangePlus1Fun = fun (State) -> (half_range(State) bsl 1) + 1 end, - TMark6 = - measure_1( - random, - FullRangePlus1Fun, - undefined, - fun (Range, State) -> - {int, random:uniform_s(Range, State)} - end), _ = - [measure_1( - Algo, - FullRangePlus1Fun, - TMark6, - fun (Range, State) -> - {int, rand:uniform_s(Range, State)} - end) || Algo <- Algos], + measure_1( + fun (State) -> (half_range(State) bsl 1) + 1 end, + fun (State, Range, Mod) -> + measure_loop( + fun (St0) -> + ?CHECK_UNIFORM_RANGE( + Mod:uniform_s(Range, St0), Range, + X, St1) + end, + State) + end, + Algs), %% ct:pal("~nRNG uniform integer double range performance~n",[]), - DoubleRangeFun = fun (State) -> half_range(State) bsl 2 end, - TMark7 = - measure_1( - random, - DoubleRangeFun, - undefined, - fun (Range, State) -> - {int, random:uniform_s(Range, State)} - end), _ = - [measure_1( - Algo, - DoubleRangeFun, - TMark7, - fun (Range, State) -> - {int, rand:uniform_s(Range, State)} - end) || Algo <- Algos], + measure_1( + fun (State) -> + half_range(State) bsl 2 + end, + fun (State, Range, Mod) -> + measure_loop( + fun (St0) -> + ?CHECK_UNIFORM_RANGE( + Mod:uniform_s(Range, St0), Range, + X, St1) + end, + State) + end, + Algs), %% ct:pal("~nRNG uniform integer double range + 1 performance~n",[]), - DoubleRangePlus1Fun = fun (State) -> (half_range(State) bsl 2) + 1 end, - TMark8 = + _ = measure_1( - random, - DoubleRangePlus1Fun, - undefined, - fun (Range, State) -> - {int, random:uniform_s(Range, State)} - end), + fun (State) -> + (half_range(State) bsl 2) + 1 + end, + fun (State, Range, Mod) -> + measure_loop( + fun (St0) -> + ?CHECK_UNIFORM_RANGE( + Mod:uniform_s(Range, St0), Range, + X, St1) + end, + State) + end, + Algs), + %% + ct:pal("~nRNG uniform integer 64 bit performance~n",[]), _ = - [measure_1( - Algo, - DoubleRangePlus1Fun, - TMark8, - fun (Range, State) -> - {int, rand:uniform_s(Range, State)} - end) || Algo <- Algos], + measure_1( + fun (_) -> 1 bsl 64 end, + fun (State, Range, Mod) -> + measure_loop( + fun (St0) -> + ?CHECK_UNIFORM_RANGE( + Mod:uniform_s(Range, St0), Range, + X, St1) + end, + State) + end, + Algs), %% ct:pal("~nRNG uniform float performance~n",[]), - TMark9 = + _ = measure_1( - random, fun (_) -> 0 end, - undefined, - fun (_, State) -> - {uniform, random:uniform_s(State)} - end), + fun (State, _, Mod) -> + measure_loop( + fun (St0) -> + ?CHECK_UNIFORM(Mod:uniform_s(St0), X, St) + end, + State) + end, + Algs), + %% + ct:pal("~nRNG uniform_real float performance~n",[]), _ = - [measure_1( - Algo, - fun (_) -> 0 end, - TMark9, - fun (_, State) -> - {uniform, rand:uniform_s(State)} - end) || Algo <- Algos], + measure_1( + fun (_) -> 0 end, + fun (State, _, Mod) -> + measure_loop( + fun (St0) -> + ?CHECK_UNIFORM(Mod:uniform_real_s(St0), X, St) + end, + State) + end, + Algs), %% ct:pal("~nRNG normal float performance~n",[]), - io:format("~.12w: not implemented (too few bits)~n", [random]), - _ = [measure_1( - Algo, - fun (_) -> 0 end, - TMark9, - fun (_, State) -> - {normal, rand:normal_s(State)} - end) || Algo <- Algos], + [TMarkNormalFloat|_] = + measure_1( + fun (_) -> 0 end, + fun (State, _, Mod) -> + measure_loop( + fun (St0) -> + ?CHECK_NORMAL(Mod:normal_s(St0), X, St1) + end, + State) + end, + Algs), + %% Just for fun try an implementation of the Box-Muller + %% transformation for creating normal distribution floats + %% to compare with our Ziggurat implementation. + %% Generates two numbers per call that we add so they + %% will not be optimized away. Hence the benchmark time + %% is twice what it should be. + TwoPi = 2 * math:pi(), + _ = + measure_1( + fun (_) -> 0 end, + fun (State, _, Mod) -> + measure_loop( + fun (State0) -> + {U1, State1} = Mod:uniform_real_s(State0), + {U2, State2} = Mod:uniform_s(State1), + R = math:sqrt(-2.0 * math:log(U1)), + T = TwoPi * U2, + Z0 = R * math:cos(T), + Z1 = R * math:sin(T), + ?CHECK_NORMAL({Z0 + Z1, State2}, X, State3) + end, + State) + end, + exrop, TMarkNormalFloat), + ok. + +-define(LOOP_MEASURE, (?LOOP div 5)). + +measure_loop(Fun, State) -> + measure_loop(Fun, State, ?LOOP_MEASURE). +%% +measure_loop(Fun, State, N) when 0 < N -> + measure_loop(Fun, Fun(State), N-1); +measure_loop(_, _, _) -> ok. -measure_1(Algo, RangeFun, TMark, Gen) -> +measure_1(RangeFun, Fun, Algs) -> + TMark = measure_1(RangeFun, Fun, hd(Algs), undefined), + [TMark] ++ + [measure_1(RangeFun, Fun, Alg, TMark) || Alg <- tl(Algs)]. + +measure_1(RangeFun, Fun, Alg, TMark) -> Parent = self(), - Seed = - case Algo of + {Mod, State} = + case Alg of crypto64 -> - crypto64_seed(); + {rand, crypto64_seed()}; + crypto_cache -> + {rand, crypto:rand_seed_alg(crypto_cache)}; crypto -> - crypto:rand_seed_s(); + {rand, crypto:rand_seed_s()}; random -> - random:seed(os:timestamp()), get(random_seed); + {random, random:seed(os:timestamp()), get(random_seed)}; _ -> - rand:seed_s(Algo) + {rand, rand:seed_s(Alg)} end, - Range = RangeFun(Seed), + Range = RangeFun(State), Pid = spawn_link( fun() -> - Fun = fun() -> measure_2(?LOOP, Range, Seed, Gen) end, - {Time, ok} = timer:tc(Fun), + {Time, ok} = timer:tc(fun () -> Fun(State, Range, Mod) end), Percent = case TMark of undefined -> 100; @@ -673,7 +891,8 @@ measure_1(Algo, RangeFun, TMark, Gen) -> end, io:format( "~.12w: ~p ns ~p% [16#~.16b]~n", - [Algo, (Time * 1000 + 500) div ?LOOP, Percent, Range]), + [Alg, (Time * 1000 + 500) div ?LOOP_MEASURE, + Percent, Range]), Parent ! {self(), Time}, normal end), @@ -681,21 +900,6 @@ measure_1(Algo, RangeFun, TMark, Gen) -> {Pid, Msg} -> Msg end. -measure_2(N, Range, State0, Fun) when N > 0 -> - case Fun(Range, State0) of - {int, {Random, State}} - when is_integer(Random), Random >= 1, Random =< Range -> - measure_2(N-1, Range, State, Fun); - {uniform, {Random, State}} - when is_float(Random), 0.0 =< Random, Random < 1.0 -> - measure_2(N-1, Range, State, Fun); - {normal, {Random, State}} when is_float(Random) -> - measure_2(N-1, Range, State, Fun); - Res -> - exit({error, Res, State0}) - end; -measure_2(0, _, _, _) -> ok. - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% The jump sequence tests has two parts %% for those with the functional API (jump/1) diff --git a/lib/stdlib/test/stdlib.spec b/lib/stdlib/test/stdlib.spec index 3768e494b2..91712b8963 100644 --- a/lib/stdlib/test/stdlib.spec +++ b/lib/stdlib/test/stdlib.spec @@ -1 +1,2 @@ {suites,"../stdlib_test",all}. +{skip_suites,"../stdlib_test",stdlib_bench_SUITE, "bench only"}. diff --git a/lib/stdlib/test/stdlib_bench.spec b/lib/stdlib/test/stdlib_bench.spec new file mode 100644 index 0000000000..a5d1e1db80 --- /dev/null +++ b/lib/stdlib/test/stdlib_bench.spec @@ -0,0 +1,7 @@ +%% Needed to compile ,unicode_util_SUITE and string_SUITE... +{cases,"../stdlib_test",unicode_util_SUITE, []}. +{cases,"../stdlib_test",string_SUITE, []}. +{skip_suites,"../stdlib_test",unicode_util_SUITE, "bench only"}. +{skip_suites,"../stdlib_test",string_SUITE, "bench only"}. + +{suites,"../stdlib_test",[stdlib_bench_SUITE]}. diff --git a/lib/stdlib/test/stdlib_bench_SUITE.erl b/lib/stdlib/test/stdlib_bench_SUITE.erl new file mode 100644 index 0000000000..2a9981bb9e --- /dev/null +++ b/lib/stdlib/test/stdlib_bench_SUITE.erl @@ -0,0 +1,208 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% +-module(stdlib_bench_SUITE). +-compile([export_all, nowarn_export_all]). +-include_lib("common_test/include/ct_event.hrl"). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +suite() -> [{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]}]. + + +all() -> + [{group,unicode}, {group,base64}]. + +groups() -> + [{unicode,[{repeat,5}], + [norm_nfc_list, norm_nfc_deep_l, norm_nfc_binary, + string_lexemes_list, string_lexemes_binary + ]}, + {base64,[{repeat,5}], + [decode_binary, decode_binary_to_string, + decode_list, decode_list_to_string, + encode_binary, encode_binary_to_string, + encode_list, encode_list_to_string, + mime_binary_decode, mime_binary_decode_to_string, + mime_list_decode, mime_list_decode_to_string]}]. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +init_per_suite(Config) -> + Config. + +end_per_suite(Config) -> + Config. + +init_per_testcase(_Func, Conf) -> + Conf. + +end_per_testcase(_Func, _Conf) -> + ok. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-define(REPEAT_NORM, 5). + +norm_nfc_list(Config) -> + Bin = norm_data(Config), + {_N, Mean, _Stddev, Res} = unicode_util_SUITE:time_count(nfc, list, Bin, ?REPEAT_NORM), + report(1000.0*Res / Mean). + +norm_nfc_deep_l(Config) -> + Bin = norm_data(Config), + {_N, Mean, _Stddev, Res} = unicode_util_SUITE:time_count(nfc, deep_l, Bin, ?REPEAT_NORM), + report(1000.0*Res / Mean). + +norm_nfc_binary(Config) -> + Bin = norm_data(Config), + {_N, Mean, _Stddev, Res} = unicode_util_SUITE:time_count(nfc, binary, Bin, ?REPEAT_NORM), + report(1000.0*Res / Mean). + + +string_lexemes_list(Config) -> + %% Use nth_lexeme instead of lexemes to avoid building a result of + %% large lists which causes large differences between test runs, gc? + Bin = norm_data(Config), + Fun = fun(Str) -> string:nth_lexeme(Str, 200000, [$;,$\n,$\r]), 200000 end, + {_N, Mean, _Stddev, Res} = string_SUITE:time_func(Fun, list, Bin, 15), + report(1000.0*Res / Mean). + +string_lexemes_binary(Config) -> + %% Use nth_lexeme instead of lexemes to avoid building a result of + %% large lists which causes large differences between test runs, gc? + Bin = norm_data(Config), + Fun = fun(Str) -> string:nth_lexeme(Str, 200000, [$;,$\n,$\r]), 200000 end, + {_N, Mean, _Stddev, Res} = string_SUITE:time_func(Fun, binary, Bin, ?REPEAT_NORM), + report(1000.0*Res / Mean). + +%%% +report(Tps) -> + ct_event:notify(#event{name = benchmark_data, + data = [{suite,"stdlib_unicode"},{value,round(Tps)}]}), + Tps. + +norm_data(Config) -> + DataDir0 = proplists:get_value(data_dir, Config), + DataDir = filename:join(lists:droplast(filename:split(DataDir0))), + File = filename:join([DataDir,"unicode_util_SUITE_data","NormalizationTest.txt"]), + {ok, Bin} = file:read_file(File), + Bin. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +decode_binary(_Config) -> + test(decode, encoded_binary()). + +decode_binary_to_string(_Config) -> + test(decode_to_string, encoded_binary()). + +decode_list(_Config) -> + test(decode, encoded_list()). + +decode_list_to_string(_Config) -> + test(decode_to_string, encoded_list()). + +encode_binary(_Config) -> + test(encode, binary()). + +encode_binary_to_string(_Config) -> + test(encode_to_string, binary()). + +encode_list(_Config) -> + test(encode, list()). + +encode_list_to_string(_Config) -> + test(encode_to_string, list()). + +mime_binary_decode(_Config) -> + test(mime_decode, encoded_binary()). + +mime_binary_decode_to_string(_Config) -> + test(mime_decode_to_string, encoded_binary()). + +mime_list_decode(_Config) -> + test(mime_decode, encoded_list()). + +mime_list_decode_to_string(_Config) -> + test(mime_decode_to_string, encoded_list()). + +-define(SIZE, 10000). +-define(N, 1000). + +encoded_binary() -> + list_to_binary(encoded_list()). + +encoded_list() -> + L = random_byte_list(round(?SIZE*0.75)), + base64:encode_to_string(L). + +binary() -> + list_to_binary(list()). + +list() -> + random_byte_list(?SIZE). + +test(Func, Data) -> + F = fun() -> loop(?N, Func, Data) end, + {Time, ok} = timer:tc(fun() -> lspawn(F) end), + report_base64(Time). + +loop(0, _F, _D) -> garbage_collect(), ok; +loop(N, F, D) -> + _ = base64:F(D), + loop(N - 1, F, D). + +lspawn(Fun) -> + {Pid, Ref} = spawn_monitor(fun() -> exit(Fun()) end), + receive + {'DOWN', Ref, process, Pid, Rep} -> Rep + end. + +report_base64(Time) -> + Tps = round((?N*1000000)/Time), + ct_event:notify(#event{name = benchmark_data, + data = [{suite, "stdlib_base64"}, + {value, Tps}]}), + Tps. + +%% Copied from base64_SUITE.erl. + +random_byte_list(N) -> + random_byte_list(N, []). + +random_byte_list(0, Acc) -> + Acc; +random_byte_list(N, Acc) -> + random_byte_list(N-1, [rand:uniform(255)|Acc]). + +make_big_binary(N) -> + list_to_binary(mbb(N, [])). + +mbb(N, Acc) when N > 256 -> + B = list_to_binary(lists:seq(0, 255)), + mbb(N - 256, [B | Acc]); +mbb(N, Acc) -> + B = list_to_binary(lists:seq(0, N-1)), + lists:reverse(Acc, B). diff --git a/lib/stdlib/test/string_SUITE.erl b/lib/stdlib/test/string_SUITE.erl index 90f980c0e5..d02a6eac0a 100644 --- a/lib/stdlib/test/string_SUITE.erl +++ b/lib/stdlib/test/string_SUITE.erl @@ -47,7 +47,8 @@ -export([to_upper_to_lower/1]). %% Run tests when debugging them --export([debug/0]). +-export([debug/0, time_func/4]). +-compile([nowarn_deprecated_function]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -92,14 +93,11 @@ end_per_testcase(_Case, _Config) -> ok. debug() -> - Config = [{data_dir, ?MODULE_STRING++"_data"}], + Config = [{data_dir, "./" ++ ?MODULE_STRING++"_data"}], [io:format("~p:~p~n",[Test,?MODULE:Test(Config)]) || {_,Tests} <- groups(), Test <- Tests]. -define(TEST(B,C,D), test(?LINE,?FUNCTION_NAME,B,C,D, true)). --define(TEST_EQ(B,C,D), - test(?LINE,?FUNCTION_NAME,B,C,D, true), - test(?LINE,?FUNCTION_NAME,hd(C),[B|tl(C),D, true)). -define(TEST_NN(B,C,D), test(?LINE,?FUNCTION_NAME,B,C,D, false), @@ -294,6 +292,7 @@ trim(_) -> ?TEST(["..h", ".e", <<"j..">>], [both, ". "], "h.ej"), ?TEST(["..h", <<".ejsa"/utf8>>, "n.."], [both, ". "], "h.ejsan"), %% Test that it behaves with graphemes (i.e. nfd tests are the hard part) + ?TEST([1013,101,778,101,101], [trailing, [101]], [1013,101,778]), ?TEST("aaåaa", [both, "a"], "å"), ?TEST(["aaa",778,"äöoo"], [both, "ao"], "åäö"), ?TEST([<<"aaa">>,778,"äöoo"], [both, "ao"], "åäö"), @@ -353,6 +352,7 @@ take(_) -> ?TEST([<<>>,<<"..">>, " h.ej", <<" ..">>], [Chars, true, leading], {".. ", "h.ej .."}), ?TEST(["..h", <<".ejsa"/utf8>>, "n.."], [Chars, true, leading], {"..", "h.ejsan.."}), %% Test that it behaves with graphemes (i.e. nfd tests are the hard part) + ?TEST([101,778], [[[101, 779]], true], {[101,778], []}), ?TEST(["aaee",778,"äöoo"], [[[$e,778]], true, leading], {"aae", [$e,778|"äöoo"]}), ?TEST([<<"aae">>,778,"äöoo"], [[[$e,778]],true,leading], {"aa", [$e,778|"äöoo"]}), ?TEST([<<"e">>,778,"åäöe", <<778/utf8>>], [[[$e,778]], true, leading], {[], [$e,778]++"åäöe"++[778]}), @@ -713,29 +713,123 @@ nth_lexeme(_) -> meas(Config) -> + Parent = self(), + Exec = fun() -> + DataDir0 = proplists:get_value(data_dir, Config), + DataDir = filename:join(lists:droplast(filename:split(DataDir0))), + case proplists:get_value(profile, Config, false) of + false -> + do_measure(DataDir); + eprof -> + eprof:profile(fun() -> do_measure(DataDir) end, [set_on_spawn]), + eprof:stop_profiling(), + eprof:analyze(), + eprof:stop() + end, + Parent ! {test_done, self()}, + normal + end, + ct:timetrap({minutes,2}), case ct:get_timetrap_info() of {_,{_,Scale}} when Scale > 1 -> {skip,{will_not_run_in_debug,Scale}}; - _ -> % No scaling - DataDir = proplists:get_value(data_dir, Config), - TestDir = filename:dirname(string:trim(DataDir, trailing, "/")), - do_measure(TestDir) + _ -> % No scaling, run at most 1.5 min + Tester = spawn(Exec), + receive {test_done, Tester} -> ok + after 90000 -> + io:format("Timelimit reached stopping~n",[]), + exit(Tester, die) + end, + ok end. -do_measure(TestDir) -> - File = filename:join(TestDir, ?MODULE_STRING ++ ".erl"), +do_measure(DataDir) -> + File = filename:join([DataDir,"unicode_util_SUITE_data","NormalizationTest.txt"]), io:format("File ~s ",[File]), {ok, Bin} = file:read_file(File), io:format("~p~n",[byte_size(Bin)]), Do = fun(Name, Func, Mode) -> - {N, Mean, Stddev, _} = time_func(Func, Mode, Bin), - io:format("~10w ~6w ~6.2fms ±~4.2fms #~.2w gc included~n", + {N, Mean, Stddev, _} = time_func(Func, Mode, Bin, 20), + io:format("~15w ~6w ~6.2fms ±~5.2fms #~.2w gc included~n", [Name, Mode, Mean/1000, Stddev/1000, N]) end, + Do2 = fun(Name, Func, Mode) -> + {N, Mean, Stddev, _} = time_func(Func, binary, <<>>, 20), + io:format("~15w ~6w ~6.2fms ±~5.2fms #~.2w gc included~n", + [Name, Mode, Mean/1000, Stddev/1000, N]) + end, io:format("----------------------~n"), - Do(tokens, fun(Str) -> string:tokens(Str, [$\n,$\r]) end, list), + + Do(old_tokens, fun(Str) -> string:tokens(Str, [$\n,$\r]) end, list), Tokens = {lexemes, fun(Str) -> string:lexemes(Str, [$\n,$\r]) end}, [Do(Name,Fun,Mode) || {Name,Fun} <- [Tokens], Mode <- [list, binary]], + + S0 = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxy.....", + S0B = <<"xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxy.....">>, + Do2(old_strip_l, repeat(fun() -> string:strip(S0, left, $x) end), list), + Do2(trim_l, repeat(fun() -> string:trim(S0, leading, [$x]) end), list), + Do2(trim_l, repeat(fun() -> string:trim(S0B, leading, [$x]) end), binary), + Do2(old_strip_r, repeat(fun() -> string:strip(S0, right, $.) end), list), + Do2(trim_t, repeat(fun() -> string:trim(S0, trailing, [$.]) end), list), + Do2(trim_t, repeat(fun() -> string:trim(S0B, trailing, [$.]) end), binary), + + Do2(old_chr_sub, repeat(fun() -> string:sub_string(S0, string:chr(S0, $.)) end), list), + Do2(old_str_sub, repeat(fun() -> string:sub_string(S0, string:str(S0, [$.])) end), list), + Do2(find, repeat(fun() -> string:find(S0, [$.]) end), list), + Do2(find, repeat(fun() -> string:find(S0B, [$.]) end), binary), + Do2(old_str_sub2, repeat(fun() -> N = string:str(S0, "xy.."), + {string:sub_string(S0,1,N), string:sub_string(S0,N+4)} end), list), + Do2(split, repeat(fun() -> string:split(S0, "xy..") end), list), + Do2(split, repeat(fun() -> string:split(S0B, "xy..") end), binary), + + Do2(old_rstr_sub, repeat(fun() -> string:sub_string(S0, string:rstr(S0, [$y])) end), list), + Do2(find_t, repeat(fun() -> string:find(S0, [$y], trailing) end), list), + Do2(find_t, repeat(fun() -> string:find(S0B, [$y], trailing) end), binary), + Do2(old_rstr_sub2, repeat(fun() -> N = string:rstr(S0, "y.."), + {string:sub_string(S0,1,N), string:sub_string(S0,N+3)} end), list), + Do2(split_t, repeat(fun() -> string:split(S0, "y..", trailing) end), list), + Do2(split_t, repeat(fun() -> string:split(S0B, "y..", trailing) end), binary), + + Do2(old_span, repeat(fun() -> N=string:span(S0, [$x, $y]), + {string:sub_string(S0,1,N),string:sub_string(S0,N+1)} + end), list), + Do2(take, repeat(fun() -> string:take(S0, [$x, $y]) end), list), + Do2(take, repeat(fun() -> string:take(S0B, [$x, $y]) end), binary), + + Do2(old_cspan, repeat(fun() -> N=string:cspan(S0, [$.,$y]), + {string:sub_string(S0,1,N),string:sub_string(S0,N+1)} + end), list), + Do2(take_c, repeat(fun() -> string:take(S0, [$.,$y], true) end), list), + Do2(take_c, repeat(fun() -> string:take(S0B, [$.,$y], true) end), binary), + + Do2(old_substr, repeat(fun() -> string:substr(S0, 21, 15) end), list), + Do2(slice, repeat(fun() -> string:slice(S0, 20, 15) end), list), + Do2(slice, repeat(fun() -> string:slice(S0B, 20, 15) end), binary), + + io:format("--~n",[]), + NthTokens = {nth_lexemes, fun(Str) -> string:nth_lexeme(Str, 18000, [$\n,$\r]) end}, + [Do(Name,Fun,Mode) || {Name,Fun} <- [NthTokens], Mode <- [list, binary]], + Do2(take_t, repeat(fun() -> string:take(S0, [$.,$y], false, trailing) end), list), + Do2(take_t, repeat(fun() -> string:take(S0B, [$.,$y], false, trailing) end), binary), + Do2(take_tc, repeat(fun() -> string:take(S0, [$x], true, trailing) end), list), + Do2(take_tc, repeat(fun() -> string:take(S0B, [$x], true, trailing) end), binary), + + Length = {length, fun(Str) -> string:length(Str) end}, + [Do(Name,Fun,Mode) || {Name,Fun} <- [Length], Mode <- [list, binary]], + + Reverse = {reverse, fun(Str) -> string:reverse(Str) end}, + [Do(Name,Fun,Mode) || {Name,Fun} <- [Reverse], Mode <- [list, binary]], + + ok. + +repeat(F) -> + fun(_) -> repeat_1(F,20000) end. + +repeat_1(F, N) when N > 0 -> + F(), + repeat_1(F, N-1); +repeat_1(_, _) -> + erlang:garbage_collect(), ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -865,8 +959,6 @@ check_types_1({list, _},{list, undefined}) -> ok; check_types_1({list, _},{list, codepoints}) -> ok; -check_types_1({list, _},{list, {list, codepoints}}) -> - ok; check_types_1({list, {list, _}},{list, {list, codepoints}}) -> ok; check_types_1(mixed,_) -> @@ -938,19 +1030,19 @@ needs_check(_) -> true. %%%% Timer stuff -time_func(Fun, Mode, Bin) -> +time_func(Fun, Mode, Bin, Repeat) -> timer:sleep(100), %% Let emulator catch up and clean things before test runs Self = self(), Pid = spawn_link(fun() -> Str = mode(Mode, Bin), - Self ! {self(),time_func(0,0,0, Fun, Str, undefined)} + Self ! {self(),time_func(0,0,0, Fun, Str, undefined, Repeat)} end), receive {Pid,Msg} -> Msg end. -time_func(N,Sum,SumSq, Fun, Str, _) when N < 50 -> +time_func(N,Sum,SumSq, Fun, Str, _, Repeat) when N < Repeat -> {Time, Res} = timer:tc(fun() -> Fun(Str) end), - time_func(N+1,Sum+Time,SumSq+Time*Time, Fun, Str, Res); -time_func(N,Sum,SumSq, _, _, Res) -> + time_func(N+1,Sum+Time,SumSq+Time*Time, Fun, Str, Res, Repeat); +time_func(N,Sum,SumSq, _, _, Res, _) -> Mean = round(Sum / N), Stdev = round(math:sqrt((SumSq - (Sum*Sum/N))/(N - 1))), {N, Mean, Stdev, Res}. diff --git a/lib/stdlib/test/supervisor_1.erl b/lib/stdlib/test/supervisor_1.erl index 419026749b..c3ccacc587 100644 --- a/lib/stdlib/test/supervisor_1.erl +++ b/lib/stdlib/test/supervisor_1.erl @@ -42,6 +42,8 @@ start_child(error) -> set -> gen_server:start_link(?MODULE, error, []) end; +start_child({return, Term}) -> + Term; start_child(Extra) -> {ok, Pid} = gen_server:start_link(?MODULE, normal, []), diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl index cd2c6b0cbb..761df8eb40 100644 --- a/lib/stdlib/test/supervisor_SUITE.erl +++ b/lib/stdlib/test/supervisor_SUITE.erl @@ -39,6 +39,9 @@ sup_start_ignore_temporary_child_start_child_simple/1, sup_start_ignore_permanent_child_start_child_simple/1, sup_start_error_return/1, sup_start_fail/1, + sup_start_child_returns_error/1, + sup_start_restart_child_returns_error/1, + sup_start_child_returns_error_simple/1, sup_start_map/1, sup_start_map_simple/1, sup_start_map_faulty_specs/1, sup_stop_infinity/1, sup_stop_timeout/1, sup_stop_brutal_kill/1, @@ -65,14 +68,16 @@ simple_one_for_one_extra/1, simple_one_for_one_shutdown/1]). %% Misc tests --export([child_unlink/1, tree/1, count_children/1, +-export([child_unlink/1, tree/1, count_children/1, count_children_supervisor/1, count_restarting_children/1, get_callback_module/1, do_not_save_start_parameters_for_temporary_children/1, do_not_save_child_specs_for_temporary_children/1, simple_one_for_one_scale_many_temporary_children/1, simple_global_supervisor/1, hanging_restart_loop/1, + hanging_restart_loop_rest_for_one/1, hanging_restart_loop_simple/1, code_change/1, code_change_map/1, - code_change_simple/1, code_change_simple_map/1]). + code_change_simple/1, code_change_simple_map/1, + order_of_children/1, scale_start_stop_many_children/1]). %%------------------------------------------------------------------------- @@ -91,12 +96,15 @@ all() -> {group, normal_termination}, {group, shutdown_termination}, {group, abnormal_termination}, child_unlink, tree, - count_children, count_restarting_children, get_callback_module, + count_children, count_children_supervisor, count_restarting_children, + get_callback_module, do_not_save_start_parameters_for_temporary_children, do_not_save_child_specs_for_temporary_children, simple_one_for_one_scale_many_temporary_children, temporary_bystander, - simple_global_supervisor, hanging_restart_loop, hanging_restart_loop_simple, - code_change, code_change_map, code_change_simple, code_change_simple_map]. + simple_global_supervisor, hanging_restart_loop, + hanging_restart_loop_rest_for_one, hanging_restart_loop_simple, + code_change, code_change_map, code_change_simple, code_change_simple_map, + order_of_children, scale_start_stop_many_children]. groups() -> [{sup_start, [], @@ -105,7 +113,10 @@ groups() -> sup_start_ignore_temporary_child_start_child, sup_start_ignore_temporary_child_start_child_simple, sup_start_ignore_permanent_child_start_child_simple, - sup_start_error_return, sup_start_fail]}, + sup_start_error_return, sup_start_fail, + sup_start_child_returns_error, sup_start_restart_child_returns_error, + sup_start_child_returns_error_simple + ]}, {sup_start_map, [], [sup_start_map, sup_start_map_simple, sup_start_map_faulty_specs]}, {sup_stop, [], @@ -147,6 +158,15 @@ init_per_testcase(_Case, Config) -> Config. end_per_testcase(_Case, _Config) -> + %% Clean up to avoid unnecessary error reports in the shell + case whereis(sup_test) of + SupPid when is_pid(SupPid) -> + unlink(SupPid), + exit(SupPid,shutdown), + ok; + _ -> + error + end, ok. start_link(InitResult) -> @@ -274,6 +294,7 @@ sup_start_ignore_permanent_child_start_child_simple(Config) %% Regression test: check that the supervisor terminates without error. exit(Pid, shutdown), check_exit_reason(Pid, shutdown). + %%------------------------------------------------------------------------- %% Tests what happens if init-callback returns a invalid value. sup_start_error_return(Config) when is_list(Config) -> @@ -289,6 +310,53 @@ sup_start_fail(Config) when is_list(Config) -> check_exit_reason(Term). %%------------------------------------------------------------------------- +%% Test what happens when the start function for a child returns +%% {error,Reason} or some other term(). +sup_start_restart_child_returns_error(_Config) -> + process_flag(trap_exit, true), + Child = {child1, {supervisor_1, start_child, [error]}, + permanent, 1000, worker, []}, + {ok, _Pid} = start_link({ok, {{one_for_one, 2, 3600}, [Child]}}), + + ok = supervisor:terminate_child(sup_test, child1), + {error,{function_clause,_}} = supervisor:restart_child(sup_test,child1), + + [{child1,undefined,worker,[]}] = supervisor:which_children(sup_test), + ok. + +%%------------------------------------------------------------------------- +%% Test what happens when the start function for a child returns +%% {error,Reason} or some other term(). +sup_start_child_returns_error(_Config) -> + process_flag(trap_exit, true), + Child1 = {child1, {supervisor_1, start_child, [{return,{error,reason}}]}, + permanent, 1000, worker, []}, + Child2 = {child2, {supervisor_1, start_child, [{return,error_reason}]}, + permanent, 1000, worker, []}, + {ok, _Pid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), + + {error,{reason,_}} = supervisor:start_child(sup_test,Child1), + {error,{error_reason,_}} = supervisor:start_child(sup_test,Child2), + + [] = supervisor:which_children(sup_test), + ok. + +%%------------------------------------------------------------------------- +%% Test what happens when the start function for a child returns +%% {error,Reason} - simple_one_for_one +sup_start_child_returns_error_simple(_Config) -> + process_flag(trap_exit, true), + Child = {child1, {supervisor_1, start_child, []}, + permanent, 1000, worker, []}, + {ok, _Pid} = start_link({ok, {{simple_one_for_one, 2, 3600}, [Child]}}), + + {error,reason} = supervisor:start_child(sup_test,[{return,{error,reason}}]), + {error,error_reason} = supervisor:start_child(sup_test,[{return,error_reason}]), + + [] = supervisor:which_children(sup_test), + ok. + +%%------------------------------------------------------------------------- %% Tests that the supervisor process starts correctly with map %% startspec, and that the full childspec can be read. sup_start_map(Config) when is_list(Config) -> @@ -468,7 +536,16 @@ extra_return(Config) when is_list(Config) -> [{child1, CPid3, worker, []}] = supervisor:which_children(sup_test), [1,1,0,1] = get_child_counts(sup_test), - ok. + %% Check that it can be automatically restarted + terminate(CPid3, abnormal), + [{child1, CPid4, worker, []}] = supervisor:which_children(sup_test), + [1,1,0,1] = get_child_counts(sup_test), + if (not is_pid(CPid4)) orelse CPid4=:=CPid3 -> + ct:fail({not_restarted,CPid3,CPid4}); + true -> + ok + end. + %%------------------------------------------------------------------------- %% Test API functions start_child/2, terminate_child/2, delete_child/2 %% restart_child/2, which_children/1, count_children/1. Only correct @@ -1140,7 +1217,7 @@ simple_one_for_one(Config) when is_list(Config) -> [{Id4, Pid4, _, _}|_] = supervisor:which_children(sup_test), terminate(SupPid, Pid4, Id4, abnormal), - check_exit([SupPid]). + check_exit_reason(SupPid,shutdown). %%------------------------------------------------------------------------- @@ -1378,6 +1455,11 @@ tree(Config) when is_list(Config) -> [?MODULE, {ok, {{one_for_one, 4, 3600}, []}}]}, permanent, infinity, supervisor, []}, + ChildSup3 = {supchild3, + {supervisor, start_link, + [?MODULE, {ok, {{one_for_one, 4, 3600}, []}}]}, + transient, infinity, + supervisor, []}, %% Top supervisor {ok, SupPid} = start_link({ok, {{one_for_all, 4, 3600}, []}}), @@ -1385,7 +1467,9 @@ tree(Config) when is_list(Config) -> %% Child supervisors {ok, Sup1} = supervisor:start_child(SupPid, ChildSup1), {ok, Sup2} = supervisor:start_child(SupPid, ChildSup2), - [2,2,2,0] = get_child_counts(SupPid), + {ok, _Sup3} = supervisor:start_child(SupPid, ChildSup3), + ok = supervisor:terminate_child(SupPid, supchild3), + [3,2,3,0] = get_child_counts(SupPid), %% Workers [{_, CPid2, _, _},{_, CPid1, _, _}] = @@ -1417,16 +1501,21 @@ tree(Config) when is_list(Config) -> timer:sleep(1000), - [{supchild2, NewSup2, _, _},{supchild1, NewSup1, _, _}] = + [{supchild3, NewSup3, _, _}, + {supchild2, NewSup2, _, _}, + {supchild1, NewSup1, _, _}] = supervisor:which_children(SupPid), - [2,2,2,0] = get_child_counts(SupPid), + [3,3,3,0] = get_child_counts(SupPid), [{child2, _, _, _},{child1, _, _, _}] = supervisor:which_children(NewSup1), [2,2,0,2] = get_child_counts(NewSup1), [] = supervisor:which_children(NewSup2), - [0,0,0,0] = get_child_counts(NewSup2). + [0,0,0,0] = get_child_counts(NewSup2), + + [] = supervisor:which_children(NewSup3), + [0,0,0,0] = get_child_counts(NewSup3). %%------------------------------------------------------------------------- %% Test count_children @@ -1459,6 +1548,36 @@ count_children(Config) when is_list(Config) -> [1,0,0,0] = get_child_counts(sup_test). %%------------------------------------------------------------------------- +%% Test count_children for simple_one_for_one, when children are supervisors +count_children_supervisor(Config) when is_list(Config) -> + process_flag(trap_exit, true), + Child = {child, {supervisor_1, start_child, []}, temporary, infinity, + supervisor, []}, + {ok, SupPid} = start_link({ok, {{simple_one_for_one, 2, 3600}, [Child]}}), + [supervisor:start_child(sup_test, []) || _Ignore <- lists:seq(1,1000)], + + Children = supervisor:which_children(sup_test), + ChildCount = get_child_counts(sup_test), + + [supervisor:start_child(sup_test, []) || _Ignore2 <- lists:seq(1,1000)], + + ChildCount2 = get_child_counts(sup_test), + Children2 = supervisor:which_children(sup_test), + + ChildCount3 = get_child_counts(sup_test), + Children3 = supervisor:which_children(sup_test), + + 1000 = length(Children), + [1,1000,1000,0] = ChildCount, + 2000 = length(Children2), + [1,2000,2000,0] = ChildCount2, + Children3 = Children2, + ChildCount3 = ChildCount2, + + [terminate(SupPid, Pid, child, kill) || {undefined, Pid, supervisor, _Modules} <- Children3], + [1,0,0,0] = get_child_counts(sup_test). + +%%------------------------------------------------------------------------- %% Test count_children when some children are restarting count_restarting_children(Config) when is_list(Config) -> process_flag(trap_exit, true), @@ -1577,11 +1696,11 @@ dont_save_start_parameters_for_temporary_children(simple_one_for_one = Type) -> start_children(Sup2, [LargeList], 100), start_children(Sup3, [LargeList], 100), - [{memory,Mem1}] = process_info(Sup1, [memory]), - [{memory,Mem2}] = process_info(Sup2, [memory]), - [{memory,Mem3}] = process_info(Sup3, [memory]), + Size1 = erts_debug:flat_size(sys:get_status(Sup1)), + Size2 = erts_debug:flat_size(sys:get_status(Sup2)), + Size3 = erts_debug:flat_size(sys:get_status(Sup3)), - true = (Mem3 < Mem1) and (Mem3 < Mem2), + true = (Size3 < Size1) and (Size3 < Size2), terminate(Sup1, shutdown), terminate(Sup2, shutdown), @@ -1605,11 +1724,11 @@ dont_save_start_parameters_for_temporary_children(Type) -> start_children(Sup2, Transient, 100), start_children(Sup3, Temporary, 100), - [{memory,Mem1}] = process_info(Sup1, [memory]), - [{memory,Mem2}] = process_info(Sup2, [memory]), - [{memory,Mem3}] = process_info(Sup3, [memory]), + Size1 = erts_debug:flat_size(sys:get_status(Sup1)), + Size2 = erts_debug:flat_size(sys:get_status(Sup2)), + Size3 = erts_debug:flat_size(sys:get_status(Sup3)), - true = (Mem3 < Mem1) and (Mem3 < Mem2), + true = (Size3 < Size1) and (Size3 < Size2), terminate(Sup1, shutdown), terminate(Sup2, shutdown), @@ -1847,6 +1966,61 @@ hanging_restart_loop(Config) when is_list(Config) -> undefined = whereis(sup_test), ok. +hanging_restart_loop_rest_for_one(Config) when is_list(Config) -> + process_flag(trap_exit, true), + {ok, Pid} = start_link({ok, {{rest_for_one, 8, 10}, []}}), + Child1 = {child1, {supervisor_1, start_child, []}, + permanent, brutal_kill, worker, []}, + Child2 = {child2, {supervisor_deadlock, start_child, []}, + permanent, brutal_kill, worker, []}, + Child3 = {child3, {supervisor_1, start_child, []}, + permanent, brutal_kill, worker, []}, + + %% Ets table with state read by supervisor_deadlock.erl + ets:new(supervisor_deadlock,[set,named_table,public]), + ets:insert(supervisor_deadlock,{fail_start,false}), + + {ok, CPid1} = supervisor:start_child(sup_test, Child1), + {ok, CPid2} = supervisor:start_child(sup_test, Child2), + link(CPid2), + {ok, _CPid3} = supervisor:start_child(sup_test, Child3), + + ets:insert(supervisor_deadlock,{fail_start,true}), + supervisor_deadlock:restart_child(), + timer:sleep(2000), % allow restart to happen before proceeding + + {error, already_present} = supervisor:start_child(sup_test, Child2), + {error, restarting} = supervisor:restart_child(sup_test, child2), + {error, restarting} = supervisor:delete_child(sup_test, child2), + [{child3,undefined,worker,[]}, + {child2,restarting,worker,[]}, + {child1,CPid1,worker,[]}] = supervisor:which_children(sup_test), + [3,1,0,3] = get_child_counts(sup_test), + + ok = supervisor:terminate_child(sup_test, child2), + check_exit_reason(CPid2, error), + [{child3,undefined,worker,[]}, + {child2,undefined,worker,[]}, + {child1,CPid1,worker,[]}] = supervisor:which_children(sup_test), + + ets:insert(supervisor_deadlock,{fail_start,false}), + {ok, CPid22} = supervisor:restart_child(sup_test, child2), + link(CPid22), + + ets:insert(supervisor_deadlock,{fail_start,true}), + supervisor_deadlock:restart_child(), + timer:sleep(2000), % allow restart to happen before proceeding + + %% Terminating supervisor. + %% OTP-9549 fixes so this does not give a timetrap timeout - + %% i.e. that supervisor does not hang in restart loop. + terminate(Pid,shutdown), + + %% Check that child died with reason from 'restart' request above + check_exit_reason(CPid22, error), + undefined = whereis(sup_test), + ok. + %%------------------------------------------------------------------------- %% Test that child and supervisor can be shutdown while hanging in %% restart loop, simple_one_for_one. @@ -2022,11 +2196,11 @@ code_change_simple(_Config) -> SimpleChild2 = {child2,{supervisor_1, start_child, []}, permanent, brutal_kill, worker, []}, - {error, {error, {ok,[_,_]}}} = + {error, {error, {ok,{[_,_],_}}}} = fake_upgrade(SimplePid,{ok,{SimpleFlags,[SimpleChild1,SimpleChild2]}}), %% Attempt to remove child - {error, {error, {ok,[]}}} = fake_upgrade(SimplePid,{ok,{SimpleFlags,[]}}), + {error, {error, {ok,{[],_}}}} = fake_upgrade(SimplePid,{ok,{SimpleFlags,[]}}), terminate(SimplePid,shutdown), ok. @@ -2047,11 +2221,11 @@ code_change_simple_map(_Config) -> %% Attempt to add child SimpleChild2 = #{id=>child2, start=>{supervisor_1, start_child, []}}, - {error, {error, {ok, [_,_]}}} = + {error, {error, {ok, {[_,_],_}}}} = fake_upgrade(SimplePid,{ok,{SimpleFlags,[SimpleChild1,SimpleChild2]}}), %% Attempt to remove child - {error, {error, {ok, []}}} = + {error, {error, {ok, {[],_}}}} = fake_upgrade(SimplePid,{ok,{SimpleFlags,[]}}), terminate(SimplePid,shutdown), @@ -2075,6 +2249,148 @@ fake_upgrade(Pid,NewInitReturn) -> ok = sys:resume(Pid), R. +%% Test that children are started in the order they are given, and +%% terminated in the opposite order +order_of_children(_Config) -> + process_flag(trap_exit, true), + %% Use child ids that are not alphabetically storted + Id1 = ch7, + Id2 = ch3, + Id3 = ch10, + Id4 = ch2, + Id5 = ch5, + Children = + [{Id, {supervisor_1, start_child, []}, permanent, 1000, worker, []} || + Id <- [Id1,Id2,Id3,Id4,Id5]], + + {ok, SupPid} = start_link({ok, {{rest_for_one, 2, 3600}, Children}}), + + + %% Check start order (pids are growing) + Which1 = supervisor:which_children(sup_test), + IsPid = fun({_,P,_,_}) when is_pid(P) -> true; (_) -> false end, + true = lists:all(IsPid,Which1), + SortedOnPid1 = lists:keysort(2,Which1), + [{Id1,Pid1,_,_}, + {Id2,Pid2,_,_}, + {Id3,Pid3,_,_}, + {Id4,Pid4,_,_}, + {Id5,Pid5,_,_}] = SortedOnPid1, + + TPid = self(), + TraceHandler = fun({trace,P,exit,_},{Last,Ps}) when P=:=Last -> + TPid ! {exited,lists:reverse([P|Ps])}, + {Last,Ps}; + ({trace,P,exit,_},{Last,Ps}) -> + {Last,[P|Ps]}; + (_T,Acc) -> + Acc + end, + + %% Terminate Pid3 and check that Pid4 and Pid5 are terminated in + %% expected order. + Expected1 = [Pid5,Pid4], + {ok,_} = dbg:tracer(process,{TraceHandler,{Pid4,[]}}), + [{ok,[_]} = dbg:p(P,procs) || P <- Expected1], + terminate(Pid3, abnormal), + receive {exited,ExitedPids1} -> + dbg:stop_clear(), + case ExitedPids1 of + Expected1 -> ok; + _ -> ct:fail({faulty_termination_order, + {expected,Expected1}, + {got,ExitedPids1}}) + end + after 3000 -> + dbg:stop_clear(), + ct:fail({shutdown_fail,timeout}) + end, + + %% Then check that Id3-5 are started again in correct order + Which2 = supervisor:which_children(sup_test), + true = lists:all(IsPid,Which2), + SortedOnPid2 = lists:keysort(2,Which2), + [{Id1,Pid1,_,_}, + {Id2,Pid2,_,_}, + {Id3,Pid32,_,_}, + {Id4,Pid42,_,_}, + {Id5,Pid52,_,_}] = SortedOnPid2, + + %% Terminate supervisor and check that all children are terminated + %% in opposite start order + Expected2 = [Pid52,Pid42,Pid32,Pid2,Pid1], + {ok,_} = dbg:tracer(process,{TraceHandler,{Pid1,[]}}), + [{ok,[_]} = dbg:p(P,procs) || P <- Expected2], + exit(SupPid,shutdown), + receive {exited,ExitedPids2} -> + dbg:stop_clear(), + case ExitedPids2 of + Expected2 -> ok; + _ -> ct:fail({faulty_termination_order, + {expected,Expected2}, + {got,ExitedPids2}}) + end + after 3000 -> + dbg:stop_clear(), + ct:fail({shutdown_fail,timeout}) + end, + ok. + +%% Test that a non-simple supervisor scales well for starting and +%% stopping many children. +scale_start_stop_many_children(_Config) -> + process_flag(trap_exit, true), + {ok, _Pid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), + N1 = 1000, + N2 = 100000, + Ids1 = lists:seq(1,N1), + Ids2 = lists:seq(1,N2), + Children1 = [{Id,{supervisor_1,start_child,[]},permanent,1000,worker,[]} || + Id <- Ids1], + Children2 = [{Id,{supervisor_1,start_child,[]},permanent,1000,worker,[]} || + Id <- Ids2], + + {StartT1,_} = + timer:tc(fun() -> + [supervisor:start_child(sup_test,C) || C <- Children1] + end), + {StopT1,_} = + timer:tc(fun() -> + [supervisor:terminate_child(sup_test,I) || I <- Ids1] + end), + ct:log("~w children, start time: ~w ms, stop time: ~w ms", + [N1, StartT1 div 1000, StopT1 div 1000]), + + {StartT2,_} = + timer:tc(fun() -> + [supervisor:start_child(sup_test,C) || C <- Children2] + end), + {StopT2,_} = + timer:tc(fun() -> + [supervisor:terminate_child(sup_test,I) || I <- Ids2] + end), + ct:log("~w children, start time: ~w ms, stop time: ~w ms", + [N2, StartT2 div 1000, StopT2 div 1000]), + + %% Scaling should be more or less linear, but allowing a bit more + %% to avoid false alarms + ScaleLimit = (N2 div N1) * 10, + StartScale = StartT2 div StartT1, + StopScale = StopT2 div StopT1, + + ct:log("Scale limit: ~w~nStart scale: ~w~nStop scale: ~w", + [ScaleLimit, StartScale, StopScale]), + + if StartScale > ScaleLimit -> + ct:fail({bad_start_scale,StartScale}); + StopScale > ScaleLimit -> + ct:fail({bad_stop_scale,StopScale}); + true -> + ok + end, + + ok. + %%------------------------------------------------------------------------- terminate(Pid, Reason) when Reason =/= supervisor -> terminate(dummy, Pid, dummy, Reason). diff --git a/lib/stdlib/test/supervisor_deadlock.erl b/lib/stdlib/test/supervisor_deadlock.erl index 8d3d1c6f30..f51aecccb2 100644 --- a/lib/stdlib/test/supervisor_deadlock.erl +++ b/lib/stdlib/test/supervisor_deadlock.erl @@ -1,5 +1,5 @@ -module(supervisor_deadlock). --compile(export_all). +-compile([export_all,nowarn_export_all]). %%%----------------------------------------------------------------- diff --git a/lib/stdlib/test/unicode_util_SUITE.erl b/lib/stdlib/test/unicode_util_SUITE.erl index 03c24c7027..632d9ae6e6 100644 --- a/lib/stdlib/test/unicode_util_SUITE.erl +++ b/lib/stdlib/test/unicode_util_SUITE.erl @@ -29,7 +29,9 @@ get/1, count/1]). --export([debug/0, id/1, bin_split/1, uc_loaded_size/0]). +-export([debug/0, id/1, bin_split/1, uc_loaded_size/0, + time_count/4 %% Used by stdlib_bench_SUITE + ]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -310,12 +312,23 @@ get(_) -> add_get_tests. count(Config) -> + Parent = self(), + Exec = fun() -> + do_measure(Config), + Parent ! {test_done, self()} + end, ct:timetrap({minutes,5}), case ct:get_timetrap_info() of - {_,{_,Scale}} -> + {_,{_,Scale}} when Scale > 1 -> {skip,{measurments_skipped_debug,Scale}}; - _ -> % No scaling - do_measure(Config) + _ -> % No scaling, run at most 2 min + Tester = spawn(Exec), + receive {test_done, Tester} -> ok + after 120000 -> + io:format("Timelimit reached stopping~n",[]), + exit(Tester, die) + end, + ok end. do_measure(Config) -> @@ -323,7 +336,7 @@ do_measure(Config) -> File = DataDir ++ "/NormalizationTest.txt", {ok, Bin} = file:read_file(File), Do = fun(Func, Mode) -> - {N, Mean, Stddev, Res} = time_count(Func, Mode, Bin), + {N, Mean, Stddev, Res} = time_count(Func, Mode, Bin, 10), io:format("~4w ~6w ~.10w ~.6wms ±~.2wms #~.2w~n", [Func, Mode, Res, Mean div 1000, Stddev div 1000, N]) end, @@ -345,19 +358,19 @@ uc_loaded_size([_|Rest]) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -time_count(Fun, Mode, Bin) -> +time_count(Fun, Mode, Bin, Repeat) -> timer:sleep(100), %% Let emulator catch up and clean things before test runs Self = self(), Pid = spawn_link(fun() -> Str = mode(Mode, Bin), - Self ! {self(),do_count(0,0,0, Fun, Str, undefined)} + Self ! {self(),do_count(0,0,0, Fun, Str, undefined, Repeat)} end), receive {Pid,Msg} -> Msg end. -do_count(N,Sum,SumSq, Fun, Str, _) when N < 10 -> +do_count(N,Sum,SumSq, Fun, Str, _, Repeat) when N < Repeat -> {Time, Res} = do_count(Fun, Str), - do_count(N+1,Sum+Time,SumSq+Time*Time, Fun, Str, Res); -do_count(N,Sum,SumSq, _, _, Res) -> + do_count(N+1,Sum+Time,SumSq+Time*Time, Fun, Str, Res, Repeat); +do_count(N,Sum,SumSq, _, _, Res, _) -> Mean = round(Sum / N), Stdev = round(math:sqrt((SumSq - (Sum*Sum/N))/(N - 1))), {N, Mean, Stdev, Res}. diff --git a/lib/stdlib/test/unicode_util_SUITE_data/GraphemeBreakTest.txt b/lib/stdlib/test/unicode_util_SUITE_data/GraphemeBreakTest.txt index 4bb4b1369b..d7d8f90de0 100644 --- a/lib/stdlib/test/unicode_util_SUITE_data/GraphemeBreakTest.txt +++ b/lib/stdlib/test/unicode_util_SUITE_data/GraphemeBreakTest.txt @@ -1,23 +1,24 @@ -# GraphemeBreakTest-9.0.0.txt -# Date: 2016-06-02, 18:28:17 GMT -# © 2016 Unicode®, Inc. +# GraphemeBreakTest-10.0.0.txt +# Date: 2017-04-14, 05:40:29 GMT +# © 2017 Unicode®, Inc. # Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries. # For terms of use, see http://www.unicode.org/terms_of_use.html # # Unicode Character Database # For documentation, see http://www.unicode.org/reports/tr44/ # -# Default Grapheme Break Test +# Default Grapheme_Cluster_Break Test # # Format: -# <string> (# <comment>)? -# <string> contains hex Unicode code points, with -# ÷ wherever there is a break opportunity, and +# <string> (# <comment>)? +# <string> contains hex Unicode code points, with +# ÷ wherever there is a break opportunity, and # × wherever there is not. # <comment> the format can change, but currently it shows: # - the sample character name # - (x) the Grapheme_Cluster_Break property value for the sample character -# - [x] the rule that determines whether there is a break or not +# - [x] the rule that determines whether there is a break or not, +# as listed in the Rules section of GraphemeBreakTest.html # # These samples may be extended or changed in the future. # @@ -53,8 +54,8 @@ ÷ 0020 × 0308 ÷ 1F3FB ÷ # ÷ [0.2] SPACE (Other) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3] ÷ 0020 × 200D ÷ # ÷ [0.2] SPACE (Other) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] ÷ 0020 × 0308 × 200D ÷ # ÷ [0.2] SPACE (Other) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] -÷ 0020 ÷ 2764 ÷ # ÷ [0.2] SPACE (Other) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] -÷ 0020 × 0308 ÷ 2764 ÷ # ÷ [0.2] SPACE (Other) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] +÷ 0020 ÷ 2640 ÷ # ÷ [0.2] SPACE (Other) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] +÷ 0020 × 0308 ÷ 2640 ÷ # ÷ [0.2] SPACE (Other) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] ÷ 0020 ÷ 1F466 ÷ # ÷ [0.2] SPACE (Other) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 0020 × 0308 ÷ 1F466 ÷ # ÷ [0.2] SPACE (Other) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 0020 ÷ 0378 ÷ # ÷ [0.2] SPACE (Other) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] @@ -93,8 +94,8 @@ ÷ 000D ÷ 0308 ÷ 1F3FB ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3] ÷ 000D ÷ 200D ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] ÷ 000D ÷ 0308 × 200D ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] -÷ 000D ÷ 2764 ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] -÷ 000D ÷ 0308 ÷ 2764 ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] +÷ 000D ÷ 2640 ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] +÷ 000D ÷ 0308 ÷ 2640 ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] ÷ 000D ÷ 1F466 ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] BOY (EBG) ÷ [0.3] ÷ 000D ÷ 0308 ÷ 1F466 ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 000D ÷ 0378 ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] <reserved-0378> (Other) ÷ [0.3] @@ -133,8 +134,8 @@ ÷ 000A ÷ 0308 ÷ 1F3FB ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3] ÷ 000A ÷ 200D ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] ÷ 000A ÷ 0308 × 200D ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] -÷ 000A ÷ 2764 ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] -÷ 000A ÷ 0308 ÷ 2764 ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] +÷ 000A ÷ 2640 ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] +÷ 000A ÷ 0308 ÷ 2640 ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] ÷ 000A ÷ 1F466 ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] BOY (EBG) ÷ [0.3] ÷ 000A ÷ 0308 ÷ 1F466 ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 000A ÷ 0378 ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] <reserved-0378> (Other) ÷ [0.3] @@ -173,8 +174,8 @@ ÷ 0001 ÷ 0308 ÷ 1F3FB ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3] ÷ 0001 ÷ 200D ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] ÷ 0001 ÷ 0308 × 200D ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] -÷ 0001 ÷ 2764 ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] -÷ 0001 ÷ 0308 ÷ 2764 ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] +÷ 0001 ÷ 2640 ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] +÷ 0001 ÷ 0308 ÷ 2640 ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] ÷ 0001 ÷ 1F466 ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] BOY (EBG) ÷ [0.3] ÷ 0001 ÷ 0308 ÷ 1F466 ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 0001 ÷ 0378 ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] <reserved-0378> (Other) ÷ [0.3] @@ -213,8 +214,8 @@ ÷ 0300 × 0308 ÷ 1F3FB ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3] ÷ 0300 × 200D ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] ÷ 0300 × 0308 × 200D ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] -÷ 0300 ÷ 2764 ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] -÷ 0300 × 0308 ÷ 2764 ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] +÷ 0300 ÷ 2640 ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] +÷ 0300 × 0308 ÷ 2640 ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] ÷ 0300 ÷ 1F466 ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 0300 × 0308 ÷ 1F466 ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 0300 ÷ 0378 ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] @@ -253,8 +254,8 @@ ÷ 0600 × 0308 ÷ 1F3FB ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3] ÷ 0600 × 200D ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] ÷ 0600 × 0308 × 200D ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] -÷ 0600 × 2764 ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) × [9.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] -÷ 0600 × 0308 ÷ 2764 ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] +÷ 0600 × 2640 ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) × [9.2] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] +÷ 0600 × 0308 ÷ 2640 ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] ÷ 0600 × 1F466 ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) × [9.2] BOY (EBG) ÷ [0.3] ÷ 0600 × 0308 ÷ 1F466 ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 0600 × 0378 ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) × [9.2] <reserved-0378> (Other) ÷ [0.3] @@ -293,8 +294,8 @@ ÷ 0903 × 0308 ÷ 1F3FB ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3] ÷ 0903 × 200D ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] ÷ 0903 × 0308 × 200D ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] -÷ 0903 ÷ 2764 ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] -÷ 0903 × 0308 ÷ 2764 ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] +÷ 0903 ÷ 2640 ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] +÷ 0903 × 0308 ÷ 2640 ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] ÷ 0903 ÷ 1F466 ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 0903 × 0308 ÷ 1F466 ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 0903 ÷ 0378 ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] @@ -333,8 +334,8 @@ ÷ 1100 × 0308 ÷ 1F3FB ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3] ÷ 1100 × 200D ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] ÷ 1100 × 0308 × 200D ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] -÷ 1100 ÷ 2764 ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] -÷ 1100 × 0308 ÷ 2764 ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] +÷ 1100 ÷ 2640 ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] +÷ 1100 × 0308 ÷ 2640 ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] ÷ 1100 ÷ 1F466 ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 1100 × 0308 ÷ 1F466 ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 1100 ÷ 0378 ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] @@ -373,8 +374,8 @@ ÷ 1160 × 0308 ÷ 1F3FB ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3] ÷ 1160 × 200D ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] ÷ 1160 × 0308 × 200D ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] -÷ 1160 ÷ 2764 ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] -÷ 1160 × 0308 ÷ 2764 ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] +÷ 1160 ÷ 2640 ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] +÷ 1160 × 0308 ÷ 2640 ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] ÷ 1160 ÷ 1F466 ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 1160 × 0308 ÷ 1F466 ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 1160 ÷ 0378 ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] @@ -413,8 +414,8 @@ ÷ 11A8 × 0308 ÷ 1F3FB ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3] ÷ 11A8 × 200D ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] ÷ 11A8 × 0308 × 200D ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] -÷ 11A8 ÷ 2764 ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] -÷ 11A8 × 0308 ÷ 2764 ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] +÷ 11A8 ÷ 2640 ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] +÷ 11A8 × 0308 ÷ 2640 ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] ÷ 11A8 ÷ 1F466 ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 11A8 × 0308 ÷ 1F466 ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 11A8 ÷ 0378 ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] @@ -453,8 +454,8 @@ ÷ AC00 × 0308 ÷ 1F3FB ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3] ÷ AC00 × 200D ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] ÷ AC00 × 0308 × 200D ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] -÷ AC00 ÷ 2764 ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] -÷ AC00 × 0308 ÷ 2764 ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] +÷ AC00 ÷ 2640 ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] +÷ AC00 × 0308 ÷ 2640 ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] ÷ AC00 ÷ 1F466 ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ AC00 × 0308 ÷ 1F466 ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ AC00 ÷ 0378 ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] @@ -493,8 +494,8 @@ ÷ AC01 × 0308 ÷ 1F3FB ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3] ÷ AC01 × 200D ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] ÷ AC01 × 0308 × 200D ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] -÷ AC01 ÷ 2764 ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] -÷ AC01 × 0308 ÷ 2764 ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] +÷ AC01 ÷ 2640 ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] +÷ AC01 × 0308 ÷ 2640 ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] ÷ AC01 ÷ 1F466 ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ AC01 × 0308 ÷ 1F466 ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ AC01 ÷ 0378 ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] @@ -533,8 +534,8 @@ ÷ 1F1E6 × 0308 ÷ 1F3FB ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3] ÷ 1F1E6 × 200D ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] ÷ 1F1E6 × 0308 × 200D ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] -÷ 1F1E6 ÷ 2764 ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] -÷ 1F1E6 × 0308 ÷ 2764 ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] +÷ 1F1E6 ÷ 2640 ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] +÷ 1F1E6 × 0308 ÷ 2640 ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] ÷ 1F1E6 ÷ 1F466 ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 1F1E6 × 0308 ÷ 1F466 ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 1F1E6 ÷ 0378 ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] @@ -573,8 +574,8 @@ ÷ 261D × 0308 × 1F3FB ÷ # ÷ [0.2] WHITE UP POINTING INDEX (E_Base) × [9.0] COMBINING DIAERESIS (Extend) × [10.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3] ÷ 261D × 200D ÷ # ÷ [0.2] WHITE UP POINTING INDEX (E_Base) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] ÷ 261D × 0308 × 200D ÷ # ÷ [0.2] WHITE UP POINTING INDEX (E_Base) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] -÷ 261D ÷ 2764 ÷ # ÷ [0.2] WHITE UP POINTING INDEX (E_Base) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] -÷ 261D × 0308 ÷ 2764 ÷ # ÷ [0.2] WHITE UP POINTING INDEX (E_Base) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] +÷ 261D ÷ 2640 ÷ # ÷ [0.2] WHITE UP POINTING INDEX (E_Base) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] +÷ 261D × 0308 ÷ 2640 ÷ # ÷ [0.2] WHITE UP POINTING INDEX (E_Base) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] ÷ 261D ÷ 1F466 ÷ # ÷ [0.2] WHITE UP POINTING INDEX (E_Base) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 261D × 0308 ÷ 1F466 ÷ # ÷ [0.2] WHITE UP POINTING INDEX (E_Base) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 261D ÷ 0378 ÷ # ÷ [0.2] WHITE UP POINTING INDEX (E_Base) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] @@ -613,8 +614,8 @@ ÷ 1F3FB × 0308 ÷ 1F3FB ÷ # ÷ [0.2] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3] ÷ 1F3FB × 200D ÷ # ÷ [0.2] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] ÷ 1F3FB × 0308 × 200D ÷ # ÷ [0.2] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] -÷ 1F3FB ÷ 2764 ÷ # ÷ [0.2] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] -÷ 1F3FB × 0308 ÷ 2764 ÷ # ÷ [0.2] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] +÷ 1F3FB ÷ 2640 ÷ # ÷ [0.2] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] +÷ 1F3FB × 0308 ÷ 2640 ÷ # ÷ [0.2] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] ÷ 1F3FB ÷ 1F466 ÷ # ÷ [0.2] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 1F3FB × 0308 ÷ 1F466 ÷ # ÷ [0.2] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 1F3FB ÷ 0378 ÷ # ÷ [0.2] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] @@ -653,54 +654,54 @@ ÷ 200D × 0308 ÷ 1F3FB ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3] ÷ 200D × 200D ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] ÷ 200D × 0308 × 200D ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] -÷ 200D × 2764 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [11.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] -÷ 200D × 0308 ÷ 2764 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] +÷ 200D × 2640 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [11.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] +÷ 200D × 0308 ÷ 2640 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] ÷ 200D × 1F466 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [11.0] BOY (EBG) ÷ [0.3] ÷ 200D × 0308 ÷ 1F466 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 200D ÷ 0378 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] ÷ 200D × 0308 ÷ 0378 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] ÷ 200D ÷ D800 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] ÷ 200D × 0308 ÷ D800 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [9.0] COMBINING DIAERESIS (Extend) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] -÷ 2764 ÷ 0020 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [999.0] SPACE (Other) ÷ [0.3] -÷ 2764 × 0308 ÷ 0020 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] SPACE (Other) ÷ [0.3] -÷ 2764 ÷ 000D ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [5.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3] -÷ 2764 × 0308 ÷ 000D ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [5.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3] -÷ 2764 ÷ 000A ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [5.0] <LINE FEED (LF)> (LF) ÷ [0.3] -÷ 2764 × 0308 ÷ 000A ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [5.0] <LINE FEED (LF)> (LF) ÷ [0.3] -÷ 2764 ÷ 0001 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [5.0] <START OF HEADING> (Control) ÷ [0.3] -÷ 2764 × 0308 ÷ 0001 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [5.0] <START OF HEADING> (Control) ÷ [0.3] -÷ 2764 × 0300 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING GRAVE ACCENT (Extend) ÷ [0.3] -÷ 2764 × 0308 × 0300 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] COMBINING GRAVE ACCENT (Extend) ÷ [0.3] -÷ 2764 ÷ 0600 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [999.0] ARABIC NUMBER SIGN (Prepend) ÷ [0.3] -÷ 2764 × 0308 ÷ 0600 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] ARABIC NUMBER SIGN (Prepend) ÷ [0.3] -÷ 2764 × 0903 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.1] DEVANAGARI SIGN VISARGA (SpacingMark) ÷ [0.3] -÷ 2764 × 0308 × 0903 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) × [9.1] DEVANAGARI SIGN VISARGA (SpacingMark) ÷ [0.3] -÷ 2764 ÷ 1100 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [999.0] HANGUL CHOSEONG KIYEOK (L) ÷ [0.3] -÷ 2764 × 0308 ÷ 1100 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HANGUL CHOSEONG KIYEOK (L) ÷ [0.3] -÷ 2764 ÷ 1160 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [999.0] HANGUL JUNGSEONG FILLER (V) ÷ [0.3] -÷ 2764 × 0308 ÷ 1160 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HANGUL JUNGSEONG FILLER (V) ÷ [0.3] -÷ 2764 ÷ 11A8 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [999.0] HANGUL JONGSEONG KIYEOK (T) ÷ [0.3] -÷ 2764 × 0308 ÷ 11A8 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HANGUL JONGSEONG KIYEOK (T) ÷ [0.3] -÷ 2764 ÷ AC00 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [999.0] HANGUL SYLLABLE GA (LV) ÷ [0.3] -÷ 2764 × 0308 ÷ AC00 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HANGUL SYLLABLE GA (LV) ÷ [0.3] -÷ 2764 ÷ AC01 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [999.0] HANGUL SYLLABLE GAG (LVT) ÷ [0.3] -÷ 2764 × 0308 ÷ AC01 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HANGUL SYLLABLE GAG (LVT) ÷ [0.3] -÷ 2764 ÷ 1F1E6 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [999.0] REGIONAL INDICATOR SYMBOL LETTER A (RI) ÷ [0.3] -÷ 2764 × 0308 ÷ 1F1E6 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] REGIONAL INDICATOR SYMBOL LETTER A (RI) ÷ [0.3] -÷ 2764 ÷ 261D ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [999.0] WHITE UP POINTING INDEX (E_Base) ÷ [0.3] -÷ 2764 × 0308 ÷ 261D ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] WHITE UP POINTING INDEX (E_Base) ÷ [0.3] -÷ 2764 ÷ 1F3FB ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3] -÷ 2764 × 0308 ÷ 1F3FB ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3] -÷ 2764 × 200D ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] -÷ 2764 × 0308 × 200D ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] -÷ 2764 ÷ 2764 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] -÷ 2764 × 0308 ÷ 2764 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] -÷ 2764 ÷ 1F466 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [999.0] BOY (EBG) ÷ [0.3] -÷ 2764 × 0308 ÷ 1F466 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3] -÷ 2764 ÷ 0378 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] -÷ 2764 × 0308 ÷ 0378 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] -÷ 2764 ÷ D800 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] -÷ 2764 × 0308 ÷ D800 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] +÷ 2640 ÷ 0020 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [999.0] SPACE (Other) ÷ [0.3] +÷ 2640 × 0308 ÷ 0020 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] SPACE (Other) ÷ [0.3] +÷ 2640 ÷ 000D ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [5.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3] +÷ 2640 × 0308 ÷ 000D ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [5.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3] +÷ 2640 ÷ 000A ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [5.0] <LINE FEED (LF)> (LF) ÷ [0.3] +÷ 2640 × 0308 ÷ 000A ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [5.0] <LINE FEED (LF)> (LF) ÷ [0.3] +÷ 2640 ÷ 0001 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [5.0] <START OF HEADING> (Control) ÷ [0.3] +÷ 2640 × 0308 ÷ 0001 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [5.0] <START OF HEADING> (Control) ÷ [0.3] +÷ 2640 × 0300 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING GRAVE ACCENT (Extend) ÷ [0.3] +÷ 2640 × 0308 × 0300 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] COMBINING GRAVE ACCENT (Extend) ÷ [0.3] +÷ 2640 ÷ 0600 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [999.0] ARABIC NUMBER SIGN (Prepend) ÷ [0.3] +÷ 2640 × 0308 ÷ 0600 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] ARABIC NUMBER SIGN (Prepend) ÷ [0.3] +÷ 2640 × 0903 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.1] DEVANAGARI SIGN VISARGA (SpacingMark) ÷ [0.3] +÷ 2640 × 0308 × 0903 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) × [9.1] DEVANAGARI SIGN VISARGA (SpacingMark) ÷ [0.3] +÷ 2640 ÷ 1100 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [999.0] HANGUL CHOSEONG KIYEOK (L) ÷ [0.3] +÷ 2640 × 0308 ÷ 1100 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HANGUL CHOSEONG KIYEOK (L) ÷ [0.3] +÷ 2640 ÷ 1160 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [999.0] HANGUL JUNGSEONG FILLER (V) ÷ [0.3] +÷ 2640 × 0308 ÷ 1160 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HANGUL JUNGSEONG FILLER (V) ÷ [0.3] +÷ 2640 ÷ 11A8 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [999.0] HANGUL JONGSEONG KIYEOK (T) ÷ [0.3] +÷ 2640 × 0308 ÷ 11A8 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HANGUL JONGSEONG KIYEOK (T) ÷ [0.3] +÷ 2640 ÷ AC00 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [999.0] HANGUL SYLLABLE GA (LV) ÷ [0.3] +÷ 2640 × 0308 ÷ AC00 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HANGUL SYLLABLE GA (LV) ÷ [0.3] +÷ 2640 ÷ AC01 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [999.0] HANGUL SYLLABLE GAG (LVT) ÷ [0.3] +÷ 2640 × 0308 ÷ AC01 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HANGUL SYLLABLE GAG (LVT) ÷ [0.3] +÷ 2640 ÷ 1F1E6 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [999.0] REGIONAL INDICATOR SYMBOL LETTER A (RI) ÷ [0.3] +÷ 2640 × 0308 ÷ 1F1E6 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] REGIONAL INDICATOR SYMBOL LETTER A (RI) ÷ [0.3] +÷ 2640 ÷ 261D ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [999.0] WHITE UP POINTING INDEX (E_Base) ÷ [0.3] +÷ 2640 × 0308 ÷ 261D ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] WHITE UP POINTING INDEX (E_Base) ÷ [0.3] +÷ 2640 ÷ 1F3FB ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3] +÷ 2640 × 0308 ÷ 1F3FB ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3] +÷ 2640 × 200D ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] +÷ 2640 × 0308 × 200D ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] +÷ 2640 ÷ 2640 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] +÷ 2640 × 0308 ÷ 2640 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] +÷ 2640 ÷ 1F466 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [999.0] BOY (EBG) ÷ [0.3] +÷ 2640 × 0308 ÷ 1F466 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3] +÷ 2640 ÷ 0378 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] +÷ 2640 × 0308 ÷ 0378 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] +÷ 2640 ÷ D800 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] +÷ 2640 × 0308 ÷ D800 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] ÷ 1F466 ÷ 0020 ÷ # ÷ [0.2] BOY (EBG) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ 1F466 × 0308 ÷ 0020 ÷ # ÷ [0.2] BOY (EBG) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ 1F466 ÷ 000D ÷ # ÷ [0.2] BOY (EBG) ÷ [5.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3] @@ -733,8 +734,8 @@ ÷ 1F466 × 0308 × 1F3FB ÷ # ÷ [0.2] BOY (EBG) × [9.0] COMBINING DIAERESIS (Extend) × [10.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3] ÷ 1F466 × 200D ÷ # ÷ [0.2] BOY (EBG) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] ÷ 1F466 × 0308 × 200D ÷ # ÷ [0.2] BOY (EBG) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] -÷ 1F466 ÷ 2764 ÷ # ÷ [0.2] BOY (EBG) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] -÷ 1F466 × 0308 ÷ 2764 ÷ # ÷ [0.2] BOY (EBG) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] +÷ 1F466 ÷ 2640 ÷ # ÷ [0.2] BOY (EBG) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] +÷ 1F466 × 0308 ÷ 2640 ÷ # ÷ [0.2] BOY (EBG) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] ÷ 1F466 ÷ 1F466 ÷ # ÷ [0.2] BOY (EBG) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 1F466 × 0308 ÷ 1F466 ÷ # ÷ [0.2] BOY (EBG) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 1F466 ÷ 0378 ÷ # ÷ [0.2] BOY (EBG) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] @@ -773,8 +774,8 @@ ÷ 0378 × 0308 ÷ 1F3FB ÷ # ÷ [0.2] <reserved-0378> (Other) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3] ÷ 0378 × 200D ÷ # ÷ [0.2] <reserved-0378> (Other) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] ÷ 0378 × 0308 × 200D ÷ # ÷ [0.2] <reserved-0378> (Other) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] -÷ 0378 ÷ 2764 ÷ # ÷ [0.2] <reserved-0378> (Other) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] -÷ 0378 × 0308 ÷ 2764 ÷ # ÷ [0.2] <reserved-0378> (Other) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] +÷ 0378 ÷ 2640 ÷ # ÷ [0.2] <reserved-0378> (Other) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] +÷ 0378 × 0308 ÷ 2640 ÷ # ÷ [0.2] <reserved-0378> (Other) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] ÷ 0378 ÷ 1F466 ÷ # ÷ [0.2] <reserved-0378> (Other) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 0378 × 0308 ÷ 1F466 ÷ # ÷ [0.2] <reserved-0378> (Other) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ 0378 ÷ 0378 ÷ # ÷ [0.2] <reserved-0378> (Other) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] @@ -813,8 +814,8 @@ ÷ D800 ÷ 0308 ÷ 1F3FB ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3] ÷ D800 ÷ 200D ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] ÷ D800 ÷ 0308 × 200D ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3] -÷ D800 ÷ 2764 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] -÷ D800 ÷ 0308 ÷ 2764 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] +÷ D800 ÷ 2640 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] +÷ D800 ÷ 0308 ÷ 2640 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] ÷ D800 ÷ 1F466 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] BOY (EBG) ÷ [0.3] ÷ D800 ÷ 0308 ÷ 1F466 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3] ÷ D800 ÷ 0378 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] <reserved-0378> (Other) ÷ [0.3] @@ -840,7 +841,7 @@ ÷ 261D × 1F3FB ÷ 261D ÷ # ÷ [0.2] WHITE UP POINTING INDEX (E_Base) × [10.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [999.0] WHITE UP POINTING INDEX (E_Base) ÷ [0.3] ÷ 1F466 × 1F3FB ÷ # ÷ [0.2] BOY (EBG) × [10.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3] ÷ 200D × 1F466 × 1F3FB ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [11.0] BOY (EBG) × [10.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3] -÷ 200D × 2764 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [11.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3] +÷ 200D × 2640 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [11.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3] ÷ 200D × 1F466 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [11.0] BOY (EBG) ÷ [0.3] ÷ 1F466 ÷ 1F466 ÷ # ÷ [0.2] BOY (EBG) ÷ [999.0] BOY (EBG) ÷ [0.3] # diff --git a/lib/stdlib/test/unicode_util_SUITE_data/LineBreakTest.txt b/lib/stdlib/test/unicode_util_SUITE_data/LineBreakTest.txt index 05efcf5a44..6715446aba 100644 --- a/lib/stdlib/test/unicode_util_SUITE_data/LineBreakTest.txt +++ b/lib/stdlib/test/unicode_util_SUITE_data/LineBreakTest.txt @@ -1,25 +1,28 @@ -# LineBreakTest-9.0.0.txt -# Date: 2016-06-18, 00:42:06 GMT -# © 2016 Unicode®, Inc. +# LineBreakTest-10.0.0.txt +# Date: 2017-04-14, 05:40:30 GMT +# © 2017 Unicode®, Inc. # Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries. # For terms of use, see http://www.unicode.org/terms_of_use.html # # Unicode Character Database # For documentation, see http://www.unicode.org/reports/tr44/ # -# Default Line Break Test +# Default Line_Break Test # # Format: -# <string> (# <comment>)? -# <string> contains hex Unicode code points, with -# ÷ wherever there is a break opportunity, and +# <string> (# <comment>)? +# <string> contains hex Unicode code points, with +# ÷ wherever there is a break opportunity, and # × wherever there is not. # <comment> the format can change, but currently it shows: # - the sample character name # - (x) the Line_Break property value for the sample character -# - [x] the rule that determines whether there is a break or not -# Note: The Line Break tests use tailoring of numbers described in Example 7 of Section 8.2 Examples of Customization. -# They also differ from the results produced by a pair table implementation in sequences like: ZW SP CL. +# - [x] the rule that determines whether there is a break or not, +# as listed in the Rules section of LineBreakTest.html +# +# Note: +# The Line_Break tests use tailoring of numbers described in +# Example 7 of Section 8.2, "Examples of Customization" of UAX #14. # # These samples may be extended or changed in the future. # diff --git a/lib/stdlib/test/unicode_util_SUITE_data/NormalizationTest.txt b/lib/stdlib/test/unicode_util_SUITE_data/NormalizationTest.txt index e133fa8a78..71f2371c5e 100644 --- a/lib/stdlib/test/unicode_util_SUITE_data/NormalizationTest.txt +++ b/lib/stdlib/test/unicode_util_SUITE_data/NormalizationTest.txt @@ -1,6 +1,6 @@ -# NormalizationTest-9.0.0.txt -# Date: 2016-04-04, 11:41:55 GMT -# © 2016 Unicode®, Inc. +# NormalizationTest-10.0.0.txt +# Date: 2017-03-08, 08:41:55 GMT +# © 2017 Unicode®, Inc. # Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries. # For terms of use, see http://www.unicode.org/terms_of_use.html # @@ -17653,6 +17653,10 @@ FFEE;FFEE;FFEE;25CB;25CB; # (￮; ￮; ￮; ○; ○; ) HALFWIDTH WHITE CIRCLE 0061 0CBC 3099 093C 0334 0062;0061 0334 0CBC 093C 3099 0062;0061 0334 0CBC 093C 3099 0062;0061 0334 0CBC 093C 3099 0062;0061 0334 0CBC 093C 3099 0062; # (a◌಼◌゙◌़◌̴b; a◌̴◌಼◌़◌゙b; a◌̴◌಼◌़◌゙b; a◌̴◌಼◌़◌゙b; a◌̴◌಼◌़◌゙b; ) LATIN SMALL LETTER A, KANNADA SIGN NUKTA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, DEVANAGARI SIGN NUKTA, COMBINING TILDE OVERLAY, LATIN SMALL LETTER B 0061 05B0 094D 3099 0CCD 0062;0061 3099 094D 0CCD 05B0 0062;0061 3099 094D 0CCD 05B0 0062;0061 3099 094D 0CCD 05B0 0062;0061 3099 094D 0CCD 05B0 0062; # (a◌ְ◌्◌゙◌್b; a◌゙◌्◌್◌ְb; a◌゙◌्◌್◌ְb; a◌゙◌्◌್◌ְb; a◌゙◌्◌್◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, KANNADA SIGN VIRAMA, LATIN SMALL LETTER B 0061 0CCD 05B0 094D 3099 0062;0061 3099 0CCD 094D 05B0 0062;0061 3099 0CCD 094D 05B0 0062;0061 3099 0CCD 094D 05B0 0062;0061 3099 0CCD 094D 05B0 0062; # (a◌್◌ְ◌्◌゙b; a◌゙◌್◌्◌ְb; a◌゙◌್◌्◌ְb; a◌゙◌್◌्◌ְb; a◌゙◌್◌्◌ְb; ) LATIN SMALL LETTER A, KANNADA SIGN VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B +0061 05B0 094D 3099 0D3B 0062;0061 3099 094D 0D3B 05B0 0062;0061 3099 094D 0D3B 05B0 0062;0061 3099 094D 0D3B 05B0 0062;0061 3099 094D 0D3B 05B0 0062; # (a◌ְ◌्◌゙◌഻b; a◌゙◌्◌഻◌ְb; a◌゙◌्◌഻◌ְb; a◌゙◌्◌഻◌ְb; a◌゙◌्◌഻◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, MALAYALAM SIGN VERTICAL BAR VIRAMA, LATIN SMALL LETTER B +0061 0D3B 05B0 094D 3099 0062;0061 3099 0D3B 094D 05B0 0062;0061 3099 0D3B 094D 05B0 0062;0061 3099 0D3B 094D 05B0 0062;0061 3099 0D3B 094D 05B0 0062; # (a◌഻◌ְ◌्◌゙b; a◌゙◌഻◌्◌ְb; a◌゙◌഻◌्◌ְb; a◌゙◌഻◌्◌ְb; a◌゙◌഻◌्◌ְb; ) LATIN SMALL LETTER A, MALAYALAM SIGN VERTICAL BAR VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B +0061 05B0 094D 3099 0D3C 0062;0061 3099 094D 0D3C 05B0 0062;0061 3099 094D 0D3C 05B0 0062;0061 3099 094D 0D3C 05B0 0062;0061 3099 094D 0D3C 05B0 0062; # (a◌ְ◌्◌゙◌഼b; a◌゙◌्◌഼◌ְb; a◌゙◌्◌഼◌ְb; a◌゙◌्◌഼◌ְb; a◌゙◌्◌഼◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, MALAYALAM SIGN CIRCULAR VIRAMA, LATIN SMALL LETTER B +0061 0D3C 05B0 094D 3099 0062;0061 3099 0D3C 094D 05B0 0062;0061 3099 0D3C 094D 05B0 0062;0061 3099 0D3C 094D 05B0 0062;0061 3099 0D3C 094D 05B0 0062; # (a◌഼◌ְ◌्◌゙b; a◌゙◌഼◌्◌ְb; a◌゙◌഼◌्◌ְb; a◌゙◌഼◌्◌ְb; a◌゙◌഼◌्◌ְb; ) LATIN SMALL LETTER A, MALAYALAM SIGN CIRCULAR VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B 0061 05B0 094D 3099 0D4D 0062;0061 3099 094D 0D4D 05B0 0062;0061 3099 094D 0D4D 05B0 0062;0061 3099 094D 0D4D 05B0 0062;0061 3099 094D 0D4D 05B0 0062; # (a◌ְ◌्◌゙◌്b; a◌゙◌्◌്◌ְb; a◌゙◌्◌്◌ְb; a◌゙◌्◌്◌ְb; a◌゙◌्◌്◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, MALAYALAM SIGN VIRAMA, LATIN SMALL LETTER B 0061 0D4D 05B0 094D 3099 0062;0061 3099 0D4D 094D 05B0 0062;0061 3099 0D4D 094D 05B0 0062;0061 3099 0D4D 094D 05B0 0062;0061 3099 0D4D 094D 05B0 0062; # (a◌്◌ְ◌्◌゙b; a◌゙◌്◌्◌ְb; a◌゙◌്◌्◌ְb; a◌゙◌്◌्◌ְb; a◌゙◌്◌्◌ְb; ) LATIN SMALL LETTER A, MALAYALAM SIGN VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B 0061 05B0 094D 3099 0DCA 0062;0061 3099 094D 0DCA 05B0 0062;0061 3099 094D 0DCA 05B0 0062;0061 3099 094D 0DCA 05B0 0062;0061 3099 094D 0DCA 05B0 0062; # (a◌ְ◌्◌゙◌්b; a◌゙◌्◌්◌ְb; a◌゙◌्◌්◌ְb; a◌゙◌्◌්◌ְb; a◌゙◌्◌්◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, SINHALA SIGN AL-LAKUNA, LATIN SMALL LETTER B @@ -17999,6 +18003,14 @@ FFEE;FFEE;FFEE;25CB;25CB; # (￮; ￮; ￮; ○; ○; ) HALFWIDTH WHITE CIRCLE 0061 1DF4 0315 0300 05AE 0062;0061 05AE 1DF4 0300 0315 0062;0061 05AE 1DF4 0300 0315 0062;0061 05AE 1DF4 0300 0315 0062;0061 05AE 1DF4 0300 0315 0062; # (a◌ᷴ◌̕◌̀◌֮b; a◌֮◌ᷴ◌̀◌̕b; a◌֮◌ᷴ◌̀◌̕b; a◌֮◌ᷴ◌̀◌̕b; a◌֮◌ᷴ◌̀◌̕b; ) LATIN SMALL LETTER A, COMBINING LATIN SMALL LETTER U WITH DIAERESIS, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B 0061 0315 0300 05AE 1DF5 0062;00E0 05AE 1DF5 0315 0062;0061 05AE 0300 1DF5 0315 0062;00E0 05AE 1DF5 0315 0062;0061 05AE 0300 1DF5 0315 0062; # (a◌̕◌̀◌֮◌᷵b; à◌֮◌᷵◌̕b; a◌֮◌̀◌᷵◌̕b; à◌֮◌᷵◌̕b; a◌֮◌̀◌᷵◌̕b; ) LATIN SMALL LETTER A, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, COMBINING UP TACK ABOVE, LATIN SMALL LETTER B 0061 1DF5 0315 0300 05AE 0062;0061 05AE 1DF5 0300 0315 0062;0061 05AE 1DF5 0300 0315 0062;0061 05AE 1DF5 0300 0315 0062;0061 05AE 1DF5 0300 0315 0062; # (a◌᷵◌̕◌̀◌֮b; a◌֮◌᷵◌̀◌̕b; a◌֮◌᷵◌̀◌̕b; a◌֮◌᷵◌̀◌̕b; a◌֮◌᷵◌̀◌̕b; ) LATIN SMALL LETTER A, COMBINING UP TACK ABOVE, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B +0061 035C 0315 0300 1DF6 0062;00E0 0315 1DF6 035C 0062;0061 0300 0315 1DF6 035C 0062;00E0 0315 1DF6 035C 0062;0061 0300 0315 1DF6 035C 0062; # (a◌͜◌̕◌̀◌᷶b; à◌̕◌᷶◌͜b; a◌̀◌̕◌᷶◌͜b; à◌̕◌᷶◌͜b; a◌̀◌̕◌᷶◌͜b; ) LATIN SMALL LETTER A, COMBINING DOUBLE BREVE BELOW, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, COMBINING KAVYKA ABOVE RIGHT, LATIN SMALL LETTER B +0061 1DF6 035C 0315 0300 0062;00E0 1DF6 0315 035C 0062;0061 0300 1DF6 0315 035C 0062;00E0 1DF6 0315 035C 0062;0061 0300 1DF6 0315 035C 0062; # (a◌᷶◌͜◌̕◌̀b; à◌᷶◌̕◌͜b; a◌̀◌᷶◌̕◌͜b; à◌᷶◌̕◌͜b; a◌̀◌᷶◌̕◌͜b; ) LATIN SMALL LETTER A, COMBINING KAVYKA ABOVE RIGHT, COMBINING DOUBLE BREVE BELOW, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, LATIN SMALL LETTER B +0061 0300 05AE 1D16D 1DF7 0062;00E0 1D16D 05AE 1DF7 0062;0061 1D16D 05AE 1DF7 0300 0062;00E0 1D16D 05AE 1DF7 0062;0061 1D16D 05AE 1DF7 0300 0062; # (a◌̀◌𝅭֮◌᷷b; à𝅭◌֮◌᷷b; a𝅭◌֮◌᷷◌̀b; à𝅭◌֮◌᷷b; a𝅭◌֮◌᷷◌̀b; ) LATIN SMALL LETTER A, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, MUSICAL SYMBOL COMBINING AUGMENTATION DOT, COMBINING KAVYKA ABOVE LEFT, LATIN SMALL LETTER B +0061 1DF7 0300 05AE 1D16D 0062;00E0 1D16D 1DF7 05AE 0062;0061 1D16D 1DF7 05AE 0300 0062;00E0 1D16D 1DF7 05AE 0062;0061 1D16D 1DF7 05AE 0300 0062; # (a◌᷷◌̀◌𝅭֮b; à𝅭◌᷷◌֮b; a𝅭◌᷷◌֮◌̀b; à𝅭◌᷷◌֮b; a𝅭◌᷷◌֮◌̀b; ) LATIN SMALL LETTER A, COMBINING KAVYKA ABOVE LEFT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, MUSICAL SYMBOL COMBINING AUGMENTATION DOT, LATIN SMALL LETTER B +0061 0300 05AE 1D16D 1DF8 0062;00E0 1D16D 05AE 1DF8 0062;0061 1D16D 05AE 1DF8 0300 0062;00E0 1D16D 05AE 1DF8 0062;0061 1D16D 05AE 1DF8 0300 0062; # (a◌̀◌𝅭֮◌᷸b; à𝅭◌֮◌᷸b; a𝅭◌֮◌᷸◌̀b; à𝅭◌֮◌᷸b; a𝅭◌֮◌᷸◌̀b; ) LATIN SMALL LETTER A, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, MUSICAL SYMBOL COMBINING AUGMENTATION DOT, COMBINING DOT ABOVE LEFT, LATIN SMALL LETTER B +0061 1DF8 0300 05AE 1D16D 0062;00E0 1D16D 1DF8 05AE 0062;0061 1D16D 1DF8 05AE 0300 0062;00E0 1D16D 1DF8 05AE 0062;0061 1D16D 1DF8 05AE 0300 0062; # (a◌᷸◌̀◌𝅭֮b; à𝅭◌᷸◌֮b; a𝅭◌᷸◌֮◌̀b; à𝅭◌᷸◌֮b; a𝅭◌᷸◌֮◌̀b; ) LATIN SMALL LETTER A, COMBINING DOT ABOVE LEFT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, MUSICAL SYMBOL COMBINING AUGMENTATION DOT, LATIN SMALL LETTER B +0061 059A 0316 302A 1DF9 0062;0061 302A 0316 1DF9 059A 0062;0061 302A 0316 1DF9 059A 0062;0061 302A 0316 1DF9 059A 0062;0061 302A 0316 1DF9 059A 0062; # (a◌֚◌̖◌〪◌᷹b; a◌〪◌̖◌᷹◌֚b; a◌〪◌̖◌᷹◌֚b; a◌〪◌̖◌᷹◌֚b; a◌〪◌̖◌᷹◌֚b; ) LATIN SMALL LETTER A, HEBREW ACCENT YETIV, COMBINING GRAVE ACCENT BELOW, IDEOGRAPHIC LEVEL TONE MARK, COMBINING WIDE INVERTED BRIDGE BELOW, LATIN SMALL LETTER B +0061 1DF9 059A 0316 302A 0062;0061 302A 1DF9 0316 059A 0062;0061 302A 1DF9 0316 059A 0062;0061 302A 1DF9 0316 059A 0062;0061 302A 1DF9 0316 059A 0062; # (a◌᷹◌֚◌̖◌〪b; a◌〪◌᷹◌̖◌֚b; a◌〪◌᷹◌̖◌֚b; a◌〪◌᷹◌̖◌֚b; a◌〪◌᷹◌̖◌֚b; ) LATIN SMALL LETTER A, COMBINING WIDE INVERTED BRIDGE BELOW, HEBREW ACCENT YETIV, COMBINING GRAVE ACCENT BELOW, IDEOGRAPHIC LEVEL TONE MARK, LATIN SMALL LETTER B 0061 0315 0300 05AE 1DFB 0062;00E0 05AE 1DFB 0315 0062;0061 05AE 0300 1DFB 0315 0062;00E0 05AE 1DFB 0315 0062;0061 05AE 0300 1DFB 0315 0062; # (a◌̕◌̀◌֮◌᷻b; à◌֮◌᷻◌̕b; a◌֮◌̀◌᷻◌̕b; à◌֮◌᷻◌̕b; a◌֮◌̀◌᷻◌̕b; ) LATIN SMALL LETTER A, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, COMBINING DELETION MARK, LATIN SMALL LETTER B 0061 1DFB 0315 0300 05AE 0062;0061 05AE 1DFB 0300 0315 0062;0061 05AE 1DFB 0300 0315 0062;0061 05AE 1DFB 0300 0315 0062;0061 05AE 1DFB 0300 0315 0062; # (a◌᷻◌̕◌̀◌֮b; a◌֮◌᷻◌̀◌̕b; a◌֮◌᷻◌̀◌̕b; a◌֮◌᷻◌̀◌̕b; a◌֮◌᷻◌̀◌̕b; ) LATIN SMALL LETTER A, COMBINING DELETION MARK, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B 0061 035D 035C 0315 1DFC 0062;0061 0315 035C 1DFC 035D 0062;0061 0315 035C 1DFC 035D 0062;0061 0315 035C 1DFC 035D 0062;0061 0315 035C 1DFC 035D 0062; # (a◌͝◌͜◌̕◌᷼b; a◌̕◌͜◌᷼◌͝b; a◌̕◌͜◌᷼◌͝b; a◌̕◌͜◌᷼◌͝b; a◌̕◌͜◌᷼◌͝b; ) LATIN SMALL LETTER A, COMBINING DOUBLE BREVE, COMBINING DOUBLE BREVE BELOW, COMBINING COMMA ABOVE RIGHT, COMBINING DOUBLE INVERTED BREVE BELOW, LATIN SMALL LETTER B @@ -18397,8 +18409,20 @@ FFEE;FFEE;FFEE;25CB;25CB; # (￮; ￮; ￮; ○; ○; ) HALFWIDTH WHITE CIRCLE 0061 116B7 3099 093C 0334 0062;0061 0334 116B7 093C 3099 0062;0061 0334 116B7 093C 3099 0062;0061 0334 116B7 093C 3099 0062;0061 0334 116B7 093C 3099 0062; # (a◌𑚷◌゙◌़◌̴b; a◌̴◌𑚷◌़◌゙b; a◌̴◌𑚷◌़◌゙b; a◌̴◌𑚷◌़◌゙b; a◌̴◌𑚷◌़◌゙b; ) LATIN SMALL LETTER A, TAKRI SIGN NUKTA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, DEVANAGARI SIGN NUKTA, COMBINING TILDE OVERLAY, LATIN SMALL LETTER B 0061 05B0 094D 3099 1172B 0062;0061 3099 094D 1172B 05B0 0062;0061 3099 094D 1172B 05B0 0062;0061 3099 094D 1172B 05B0 0062;0061 3099 094D 1172B 05B0 0062; # (a◌ְ◌्◌゙◌𑜫b; a◌゙◌्◌𑜫◌ְb; a◌゙◌्◌𑜫◌ְb; a◌゙◌्◌𑜫◌ְb; a◌゙◌्◌𑜫◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, AHOM SIGN KILLER, LATIN SMALL LETTER B 0061 1172B 05B0 094D 3099 0062;0061 3099 1172B 094D 05B0 0062;0061 3099 1172B 094D 05B0 0062;0061 3099 1172B 094D 05B0 0062;0061 3099 1172B 094D 05B0 0062; # (a◌𑜫◌ְ◌्◌゙b; a◌゙◌𑜫◌्◌ְb; a◌゙◌𑜫◌्◌ְb; a◌゙◌𑜫◌्◌ְb; a◌゙◌𑜫◌्◌ְb; ) LATIN SMALL LETTER A, AHOM SIGN KILLER, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B +0061 05B0 094D 3099 11A34 0062;0061 3099 094D 11A34 05B0 0062;0061 3099 094D 11A34 05B0 0062;0061 3099 094D 11A34 05B0 0062;0061 3099 094D 11A34 05B0 0062; # (a◌ְ◌्◌゙◌𑨴b; a◌゙◌्◌𑨴◌ְb; a◌゙◌्◌𑨴◌ְb; a◌゙◌्◌𑨴◌ְb; a◌゙◌्◌𑨴◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, ZANABAZAR SQUARE SIGN VIRAMA, LATIN SMALL LETTER B +0061 11A34 05B0 094D 3099 0062;0061 3099 11A34 094D 05B0 0062;0061 3099 11A34 094D 05B0 0062;0061 3099 11A34 094D 05B0 0062;0061 3099 11A34 094D 05B0 0062; # (a◌𑨴◌ְ◌्◌゙b; a◌゙◌𑨴◌्◌ְb; a◌゙◌𑨴◌्◌ְb; a◌゙◌𑨴◌्◌ְb; a◌゙◌𑨴◌्◌ְb; ) LATIN SMALL LETTER A, ZANABAZAR SQUARE SIGN VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B +0061 05B0 094D 3099 11A47 0062;0061 3099 094D 11A47 05B0 0062;0061 3099 094D 11A47 05B0 0062;0061 3099 094D 11A47 05B0 0062;0061 3099 094D 11A47 05B0 0062; # (a◌ְ◌्◌゙◌𑩇b; a◌゙◌्◌𑩇◌ְb; a◌゙◌्◌𑩇◌ְb; a◌゙◌्◌𑩇◌ְb; a◌゙◌्◌𑩇◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, ZANABAZAR SQUARE SUBJOINER, LATIN SMALL LETTER B +0061 11A47 05B0 094D 3099 0062;0061 3099 11A47 094D 05B0 0062;0061 3099 11A47 094D 05B0 0062;0061 3099 11A47 094D 05B0 0062;0061 3099 11A47 094D 05B0 0062; # (a◌𑩇◌ְ◌्◌゙b; a◌゙◌𑩇◌्◌ְb; a◌゙◌𑩇◌्◌ְb; a◌゙◌𑩇◌्◌ְb; a◌゙◌𑩇◌्◌ְb; ) LATIN SMALL LETTER A, ZANABAZAR SQUARE SUBJOINER, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B +0061 05B0 094D 3099 11A99 0062;0061 3099 094D 11A99 05B0 0062;0061 3099 094D 11A99 05B0 0062;0061 3099 094D 11A99 05B0 0062;0061 3099 094D 11A99 05B0 0062; # (a◌ְ◌्◌゙◌𑪙b; a◌゙◌्◌𑪙◌ְb; a◌゙◌्◌𑪙◌ְb; a◌゙◌्◌𑪙◌ְb; a◌゙◌्◌𑪙◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, SOYOMBO SUBJOINER, LATIN SMALL LETTER B +0061 11A99 05B0 094D 3099 0062;0061 3099 11A99 094D 05B0 0062;0061 3099 11A99 094D 05B0 0062;0061 3099 11A99 094D 05B0 0062;0061 3099 11A99 094D 05B0 0062; # (a◌𑪙◌ְ◌्◌゙b; a◌゙◌𑪙◌्◌ְb; a◌゙◌𑪙◌्◌ְb; a◌゙◌𑪙◌्◌ְb; a◌゙◌𑪙◌्◌ְb; ) LATIN SMALL LETTER A, SOYOMBO SUBJOINER, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B 0061 05B0 094D 3099 11C3F 0062;0061 3099 094D 11C3F 05B0 0062;0061 3099 094D 11C3F 05B0 0062;0061 3099 094D 11C3F 05B0 0062;0061 3099 094D 11C3F 05B0 0062; # (a◌ְ◌्◌゙◌𑰿b; a◌゙◌्◌𑰿◌ְb; a◌゙◌्◌𑰿◌ְb; a◌゙◌्◌𑰿◌ְb; a◌゙◌्◌𑰿◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, BHAIKSUKI SIGN VIRAMA, LATIN SMALL LETTER B 0061 11C3F 05B0 094D 3099 0062;0061 3099 11C3F 094D 05B0 0062;0061 3099 11C3F 094D 05B0 0062;0061 3099 11C3F 094D 05B0 0062;0061 3099 11C3F 094D 05B0 0062; # (a◌𑰿◌ְ◌्◌゙b; a◌゙◌𑰿◌्◌ְb; a◌゙◌𑰿◌्◌ְb; a◌゙◌𑰿◌्◌ְb; a◌゙◌𑰿◌्◌ְb; ) LATIN SMALL LETTER A, BHAIKSUKI SIGN VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B +0061 3099 093C 0334 11D42 0062;0061 0334 093C 11D42 3099 0062;0061 0334 093C 11D42 3099 0062;0061 0334 093C 11D42 3099 0062;0061 0334 093C 11D42 3099 0062; # (a◌゙◌़◌̴◌𑵂b; a◌̴◌़◌𑵂◌゙b; a◌̴◌़◌𑵂◌゙b; a◌̴◌़◌𑵂◌゙b; a◌̴◌़◌𑵂◌゙b; ) LATIN SMALL LETTER A, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, DEVANAGARI SIGN NUKTA, COMBINING TILDE OVERLAY, MASARAM GONDI SIGN NUKTA, LATIN SMALL LETTER B +0061 11D42 3099 093C 0334 0062;0061 0334 11D42 093C 3099 0062;0061 0334 11D42 093C 3099 0062;0061 0334 11D42 093C 3099 0062;0061 0334 11D42 093C 3099 0062; # (a◌𑵂◌゙◌़◌̴b; a◌̴◌𑵂◌़◌゙b; a◌̴◌𑵂◌़◌゙b; a◌̴◌𑵂◌़◌゙b; a◌̴◌𑵂◌़◌゙b; ) LATIN SMALL LETTER A, MASARAM GONDI SIGN NUKTA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, DEVANAGARI SIGN NUKTA, COMBINING TILDE OVERLAY, LATIN SMALL LETTER B +0061 05B0 094D 3099 11D44 0062;0061 3099 094D 11D44 05B0 0062;0061 3099 094D 11D44 05B0 0062;0061 3099 094D 11D44 05B0 0062;0061 3099 094D 11D44 05B0 0062; # (a◌ְ◌्◌゙◌𑵄b; a◌゙◌्◌𑵄◌ְb; a◌゙◌्◌𑵄◌ְb; a◌゙◌्◌𑵄◌ְb; a◌゙◌्◌𑵄◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, MASARAM GONDI SIGN HALANTA, LATIN SMALL LETTER B +0061 11D44 05B0 094D 3099 0062;0061 3099 11D44 094D 05B0 0062;0061 3099 11D44 094D 05B0 0062;0061 3099 11D44 094D 05B0 0062;0061 3099 11D44 094D 05B0 0062; # (a◌𑵄◌ְ◌्◌゙b; a◌゙◌𑵄◌्◌ְb; a◌゙◌𑵄◌्◌ְb; a◌゙◌𑵄◌्◌ְb; a◌゙◌𑵄◌्◌ְb; ) LATIN SMALL LETTER A, MASARAM GONDI SIGN HALANTA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B +0061 05B0 094D 3099 11D45 0062;0061 3099 094D 11D45 05B0 0062;0061 3099 094D 11D45 05B0 0062;0061 3099 094D 11D45 05B0 0062;0061 3099 094D 11D45 05B0 0062; # (a◌ְ◌्◌゙◌𑵅b; a◌゙◌्◌𑵅◌ְb; a◌゙◌्◌𑵅◌ְb; a◌゙◌्◌𑵅◌ְb; a◌゙◌्◌𑵅◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, MASARAM GONDI VIRAMA, LATIN SMALL LETTER B +0061 11D45 05B0 094D 3099 0062;0061 3099 11D45 094D 05B0 0062;0061 3099 11D45 094D 05B0 0062;0061 3099 11D45 094D 05B0 0062;0061 3099 11D45 094D 05B0 0062; # (a◌𑵅◌ְ◌्◌゙b; a◌゙◌𑵅◌्◌ְb; a◌゙◌𑵅◌्◌ְb; a◌゙◌𑵅◌्◌ְb; a◌゙◌𑵅◌्◌ְb; ) LATIN SMALL LETTER A, MASARAM GONDI VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B 0061 093C 0334 16AF0 0062;0061 0334 16AF0 093C 0062;0061 0334 16AF0 093C 0062;0061 0334 16AF0 093C 0062;0061 0334 16AF0 093C 0062; # (a◌़◌̴◌𖫰b; a◌̴◌𖫰◌़b; a◌̴◌𖫰◌़b; a◌̴◌𖫰◌़b; a◌̴◌𖫰◌़b; ) LATIN SMALL LETTER A, DEVANAGARI SIGN NUKTA, COMBINING TILDE OVERLAY, BASSA VAH COMBINING HIGH TONE, LATIN SMALL LETTER B 0061 16AF0 093C 0334 0062;0061 16AF0 0334 093C 0062;0061 16AF0 0334 093C 0062;0061 16AF0 0334 093C 0062;0061 16AF0 0334 093C 0062; # (a◌𖫰◌़◌̴b; a◌𖫰◌̴◌़b; a◌𖫰◌̴◌़b; a◌𖫰◌̴◌़b; a◌𖫰◌̴◌़b; ) LATIN SMALL LETTER A, BASSA VAH COMBINING HIGH TONE, DEVANAGARI SIGN NUKTA, COMBINING TILDE OVERLAY, LATIN SMALL LETTER B 0061 093C 0334 16AF1 0062;0061 0334 16AF1 093C 0062;0061 0334 16AF1 093C 0062;0061 0334 16AF1 093C 0062;0061 0334 16AF1 093C 0062; # (a◌़◌̴◌𖫱b; a◌̴◌𖫱◌़b; a◌̴◌𖫱◌़b; a◌̴◌𖫱◌़b; a◌̴◌𖫱◌़b; ) LATIN SMALL LETTER A, DEVANAGARI SIGN NUKTA, COMBINING TILDE OVERLAY, BASSA VAH COMBINING LOW TONE, LATIN SMALL LETTER B diff --git a/lib/stdlib/test/uri_string_SUITE.erl b/lib/stdlib/test/uri_string_SUITE.erl new file mode 100644 index 0000000000..fef356355c --- /dev/null +++ b/lib/stdlib/test/uri_string_SUITE.erl @@ -0,0 +1,926 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(uri_string_SUITE). + +-include_lib("common_test/include/ct.hrl"). + +-export([all/0, suite/0,groups/0, + normalize/1, + parse_binary_fragment/1, parse_binary_host/1, parse_binary_host_ipv4/1, + parse_binary_host_ipv6/1, + parse_binary_path/1, parse_binary_pct_encoded_fragment/1, parse_binary_pct_encoded_query/1, + parse_binary_pct_encoded_userinfo/1, parse_binary_port/1, + parse_binary_query/1, parse_binary_scheme/1, parse_binary_userinfo/1, + parse_fragment/1, parse_host/1, parse_host_ipv4/1, parse_host_ipv6/1, + parse_path/1, parse_pct_encoded_fragment/1, parse_pct_encoded_query/1, + parse_pct_encoded_userinfo/1, parse_port/1, + parse_query/1, parse_scheme/1, parse_userinfo/1, + parse_list/1, parse_binary/1, parse_mixed/1, parse_relative/1, + parse_special/1, parse_special2/1, parse_negative/1, + recompose_fragment/1, recompose_parse_fragment/1, + recompose_query/1, recompose_parse_query/1, + recompose_path/1, recompose_parse_path/1, + recompose_autogen/1, parse_recompose_autogen/1, + transcode_basic/1, transcode_options/1, transcode_mixed/1, transcode_negative/1, + compose_query/1, compose_query_latin1/1, compose_query_negative/1, + dissect_query/1, dissect_query_negative/1, + interop_query_latin1/1, interop_query_utf8/1 + ]). + + +-define(SCHEME, "foo"). +-define(USERINFO, "åsa"). +-define(USERINFO_ENC, "%C3%A5sa"). +-define(HOST, "älvsjö"). +-define(HOST_ENC, "%C3%A4lvsj%C3%B6"). +-define(IPV6, "::127.0.0.1"). +-define(IPV6_ENC, "[::127.0.0.1]"). +-define(PORT, 8042). +-define(PORT_ENC, ":8042"). +-define(PATH, "/där"). +-define(PATH_ENC, "/d%C3%A4r"). +-define(QUERY, "name=örn"). +-define(QUERY_ENC, "?name=%C3%B6rn"). +-define(FRAGMENT, "näsa"). +-define(FRAGMENT_ENC, "#n%C3%A4sa"). + + +suite() -> + [{timetrap,{minutes,1}}]. + +all() -> + [ + normalize, + parse_binary_scheme, + parse_binary_userinfo, + parse_binary_pct_encoded_userinfo, + parse_binary_host, + parse_binary_host_ipv4, + parse_binary_host_ipv6, + parse_binary_port, + parse_binary_path, + parse_binary_query, + parse_binary_pct_encoded_query, + parse_binary_fragment, + parse_binary_pct_encoded_fragment, + parse_scheme, + parse_userinfo, + parse_pct_encoded_userinfo, + parse_host, + parse_host_ipv4, + parse_host_ipv6, + parse_port, + parse_path, + parse_query, + parse_pct_encoded_query, + parse_fragment, + parse_pct_encoded_fragment, + parse_list, + parse_binary, + parse_mixed, + parse_relative, + parse_special, + parse_special2, + parse_negative, + recompose_fragment, + recompose_parse_fragment, + recompose_query, + recompose_parse_query, + recompose_path, + recompose_parse_path, + recompose_autogen, + parse_recompose_autogen, + transcode_basic, + transcode_options, + transcode_mixed, + transcode_negative, + compose_query, + compose_query_latin1, + compose_query_negative, + dissect_query, + dissect_query_negative, + interop_query_latin1, + interop_query_utf8 + ]. + +groups() -> + []. + + +%%------------------------------------------------------------------------- +%% Helper functions +%%------------------------------------------------------------------------- +uri_combinations() -> + [[Sch,Usr,Hst,Prt,Pat,Qry,Frg] || + Sch <- [fun update_scheme/1, fun update_scheme_binary/1, none], + Usr <- [fun update_userinfo/1, fun update_userinfo_binary/1, none], + Hst <- [fun update_host/1, fun update_host_binary/1, + fun update_ipv6/1, fun update_ipv6_binary/1, none], + Prt <- [fun update_port/1, none], + Pat <- [fun update_path/1, fun update_path_binary/1], + Qry <- [fun update_query/1,fun update_query_binary/1, none], + Frg <- [fun update_fragment/1, fun update_fragment_binary/1, none], + not (Usr =:= none andalso Hst =:= none andalso Prt =/= none), + not (Usr =/= none andalso Hst =:= none andalso Prt =:= none), + not (Usr =/= none andalso Hst =:= none andalso Prt =/= none)]. + + +generate_test_vector(Comb) -> + Fun = fun (F, {Map, URI}) when is_function(F) -> F({Map, URI}); + (_, Map) -> Map + end, + lists:foldl(Fun, {#{}, empty}, Comb). + +generate_test_vectors(L) -> + lists:map(fun generate_test_vector/1, L). + +update_fragment({In, empty}) -> + {In#{fragment => ?FRAGMENT}, ?FRAGMENT_ENC}; +update_fragment({In, Out}) when is_list(Out) -> + {In#{fragment => ?FRAGMENT}, Out ++ ?FRAGMENT_ENC}; +update_fragment({In, Out}) when is_binary(Out) -> + {In#{fragment => ?FRAGMENT}, binary_to_list(Out) ++ ?FRAGMENT_ENC}. + +update_fragment_binary({In, empty}) -> + {In#{fragment => <<?FRAGMENT/utf8>>}, <<?FRAGMENT_ENC>>}; +update_fragment_binary({In, Out}) when is_list(Out) -> + {In#{fragment => <<?FRAGMENT/utf8>>}, Out ++ ?FRAGMENT_ENC}; +update_fragment_binary({In, Out}) when is_binary(Out) -> + {In#{fragment => <<?FRAGMENT/utf8>>}, <<Out/binary,?FRAGMENT_ENC>>}. + + +update_query({In, empty}) -> + {In#{query => ?QUERY}, ?QUERY_ENC}; +update_query({In, Out}) when is_list(Out) -> + {In#{query => ?QUERY}, Out ++ ?QUERY_ENC}; +update_query({In, Out}) when is_binary(Out) -> + {In#{query => ?QUERY}, binary_to_list(Out) ++ ?QUERY_ENC}. + +update_query_binary({In, empty}) -> + {In#{query => <<?QUERY/utf8>>}, <<?QUERY_ENC>>}; +update_query_binary({In, Out}) when is_list(Out) -> + {In#{query => <<?QUERY/utf8>>}, Out ++ ?QUERY_ENC}; +update_query_binary({In, Out}) when is_binary(Out) -> + {In#{query => <<?QUERY/utf8>>}, <<Out/binary,?QUERY_ENC>>}. + +update_path({In, empty}) -> + {In#{path => ?PATH}, ?PATH_ENC}; +update_path({In, Out}) when is_list(Out) -> + {In#{path => ?PATH}, Out ++ ?PATH_ENC}; +update_path({In, Out}) when is_binary(Out) -> + {In#{path => ?PATH}, binary_to_list(Out) ++ ?PATH_ENC}. + +update_path_binary({In, empty}) -> + {In#{path => <<?PATH/utf8>>}, <<?PATH_ENC>>}; +update_path_binary({In, Out}) when is_list(Out) -> + {In#{path => <<?PATH/utf8>>}, Out ++ ?PATH_ENC}; +update_path_binary({In, Out}) when is_binary(Out) -> + {In#{path => <<?PATH/utf8>>}, <<Out/binary,?PATH_ENC>>}. + +update_port({In, Out}) when is_list(Out) -> + {In#{port => ?PORT}, Out ++ ?PORT_ENC}; +update_port({In, Out}) when is_binary(Out) -> + {In#{port => ?PORT}, <<Out/binary,?PORT_ENC>>}. + +update_host({In, empty}) -> + {In#{host => ?HOST}, "//" ++ ?HOST_ENC}; +update_host({In, Out}) when is_list(Out) -> + case maps:is_key(userinfo, In) of + true -> {In#{host => ?HOST}, Out ++ [$@|?HOST_ENC]}; + false -> {In#{host => ?HOST}, Out ++ [$/,$/|?HOST_ENC]} + end; +update_host({In, Out}) when is_binary(Out) -> + case maps:is_key(userinfo, In) of + true -> {In#{host => ?HOST}, binary_to_list(Out) ++ [$@|?HOST_ENC]}; + false -> {In#{host => ?HOST}, binary_to_list(Out) ++ [$/,$/|?HOST_ENC]} + end. + +update_host_binary({In, empty}) -> + {In#{host => <<?HOST/utf8>>}, <<"//",?HOST_ENC>>}; +update_host_binary({In, Out}) when is_list(Out) -> + case maps:is_key(userinfo, In) of + true -> {In#{host => <<?HOST/utf8>>}, Out ++ [$@|?HOST_ENC]}; + false -> {In#{host => <<?HOST/utf8>>}, Out ++ [$/,$/|?HOST_ENC]} + end; +update_host_binary({In, Out}) when is_binary(Out) -> + case maps:is_key(userinfo, In) of + true -> {In#{host => <<?HOST/utf8>>}, <<Out/binary,$@,?HOST_ENC>>}; + false-> {In#{host => <<?HOST/utf8>>}, <<Out/binary,"//",?HOST_ENC>>} + end. + +update_ipv6({In, empty}) -> + {In#{host => ?IPV6}, "//" ++ ?IPV6_ENC}; +update_ipv6({In, Out}) when is_list(Out) -> + case maps:is_key(userinfo, In) of + true -> {In#{host => ?IPV6}, Out ++ [$@|?IPV6_ENC]}; + false -> {In#{host => ?IPV6}, Out ++ [$/,$/|?IPV6_ENC]} + end; +update_ipv6({In, Out}) when is_binary(Out) -> + case maps:is_key(userinfo, In) of + true -> {In#{host => ?IPV6}, binary_to_list(Out) ++ [$@|?IPV6_ENC]}; + false -> {In#{host => ?IPV6}, binary_to_list(Out) ++ [$/,$/|?IPV6_ENC]} + end. + +update_ipv6_binary({In, empty}) -> + {In#{host => <<?IPV6/utf8>>}, <<"//",?IPV6_ENC>>}; +update_ipv6_binary({In, Out}) when is_list(Out) -> + case maps:is_key(userinfo, In) of + true -> {In#{host => <<?IPV6/utf8>>}, Out ++ [$@|?IPV6_ENC]}; + false -> {In#{host => <<?IPV6/utf8>>}, Out ++ [$/,$/|?IPV6_ENC]} + end; +update_ipv6_binary({In, Out}) when is_binary(Out) -> + case maps:is_key(userinfo, In) of + true -> {In#{host => <<?IPV6/utf8>>}, <<Out/binary,$@,?IPV6_ENC>>}; + false-> {In#{host => <<?IPV6/utf8>>}, <<Out/binary,"//",?IPV6_ENC>>} + end. + +update_userinfo({In, empty}) -> + {In#{userinfo => ?USERINFO}, "//" ++ ?USERINFO_ENC}; +update_userinfo({In, Out}) when is_list(Out) -> + {In#{userinfo => ?USERINFO}, Out ++ "//" ++ ?USERINFO_ENC}; +update_userinfo({In, Out}) when is_binary(Out) -> + {In#{userinfo => ?USERINFO}, binary_to_list(Out) ++ "//" ++ ?USERINFO_ENC}. + +update_userinfo_binary({In, empty}) -> + {In#{userinfo => <<?USERINFO/utf8>>}, <<"//",?USERINFO_ENC>>}; +update_userinfo_binary({In, Out}) when is_list(Out) -> + {In#{userinfo => <<?USERINFO/utf8>>}, Out ++ "//" ++ ?USERINFO_ENC}; +update_userinfo_binary({In, Out}) when is_binary(Out) -> + {In#{userinfo => <<?USERINFO/utf8>>}, <<Out/binary,"//",?USERINFO_ENC>>}. + +update_scheme({In, empty}) -> + {In#{scheme => ?SCHEME}, ?SCHEME ++ ":"}. + +update_scheme_binary({In, empty}) -> + {In#{scheme => <<?SCHEME/utf8>>}, <<?SCHEME,$:>>}. + + +%% Test recompose on a generated test vector +run_test_recompose({#{}, empty}) -> + try "" = uri_string:recompose(#{}) of + _ -> ok + catch + _:_ -> error({test_failed, #{}, ""}) + end; +run_test_recompose({Map, URI}) -> + try URI = uri_string:recompose(Map) of + URI -> ok + catch + _:_ -> error({test_failed, Map, URI}) + end. + +%% Test parse - recompose on a generated test vector +run_test_parse_recompose({#{}, empty}) -> + try "" = uri_string:recompose(uri_string:parse("")) of + _ -> ok + catch + _:_ -> error({test_failed, #{}, ""}) + end; +run_test_parse_recompose({Map, URI}) -> + try URI = uri_string:recompose(uri_string:parse(URI)) of + URI -> ok + catch + _:_ -> error({test_failed, Map, URI}) + end. + + +%%------------------------------------------------------------------------- +%% Parse tests +%%------------------------------------------------------------------------- + +parse_binary_scheme(_Config) -> + #{} = uri_string:parse(<<>>), + #{path := <<"foo">>} = uri_string:parse(<<"foo">>), + #{scheme := <<"foo">>} = uri_string:parse(<<"foo:">>), + #{scheme := <<"foo">>, path := <<"bar:nisse">>} = uri_string:parse(<<"foo:bar:nisse">>), + #{scheme := <<"foo">>, host := <<"">>} = uri_string:parse(<<"foo://">>), + #{scheme := <<"foo">>, host := <<"">>, path := <<"/">>} = uri_string:parse(<<"foo:///">>), + #{scheme := <<"foo">>, host := <<"">>, path := <<"//">>} = uri_string:parse(<<"foo:////">>), + + #{path := <<"/">>} = uri_string:parse(<<"/">>), + #{host := <<>>} = uri_string:parse(<<"//">>), + #{host := <<>>, path := <<"/">>} = uri_string:parse(<<"///">>). + +parse_binary_userinfo(_Config) -> + #{scheme := <<"user">>, path := <<"password@localhost">>} = + uri_string:parse(<<"user:password@localhost">>), + #{path := <<"user@">>} = uri_string:parse(<<"user@">>), + #{path := <<"/user@">>} = uri_string:parse(<<"/user@">>), + #{path := <<"user@localhost">>} = uri_string:parse(<<"user@localhost">>), + #{userinfo := <<"user">>, host := <<"localhost">>} = uri_string:parse(<<"//user@localhost">>), + #{userinfo := <<"user:password">>, host := <<"localhost">>} = + uri_string:parse(<<"//user:password@localhost">>), + #{scheme := <<"foo">>, path := <<"/user@">>} = + uri_string:parse(<<"foo:/user@">>), + #{scheme := <<"foo">>, userinfo := <<"user">>, host := <<"localhost">>} = + uri_string:parse(<<"foo://user@localhost">>), + #{scheme := <<"foo">>, userinfo := <<"user:password">>, host := <<"localhost">>} = + uri_string:parse(<<"foo://user:password@localhost">>). + +parse_binary_pct_encoded_userinfo(_Config) -> + #{scheme := <<"user">>, path := <<"合@気道"/utf8>>} = + uri_string:parse(<<"user:%E5%90%88@%E6%B0%97%E9%81%93">>), + #{path := <<"合気道@"/utf8>>} = uri_string:parse(<<"%E5%90%88%E6%B0%97%E9%81%93@">>), + #{path := <<"/合気道@"/utf8>>} = uri_string:parse(<<"/%E5%90%88%E6%B0%97%E9%81%93@">>), + #{path := <<"合@気道"/utf8>>} = uri_string:parse(<<"%E5%90%88@%E6%B0%97%E9%81%93">>), + #{userinfo := <<"合"/utf8>>, host := <<"気道"/utf8>>} = + uri_string:parse(<<"//%E5%90%88@%E6%B0%97%E9%81%93">>), + #{userinfo := <<"合:気"/utf8>>, host := <<"道"/utf8>>} = + uri_string:parse(<<"//%E5%90%88:%E6%B0%97@%E9%81%93">>), + #{scheme := <<"foo">>, path := <<"/合気道@"/utf8>>} = + uri_string:parse(<<"foo:/%E5%90%88%E6%B0%97%E9%81%93@">>), + #{scheme := <<"foo">>, userinfo := <<"合"/utf8>>, host := <<"気道"/utf8>>} = + uri_string:parse(<<"foo://%E5%90%88@%E6%B0%97%E9%81%93">>), + #{scheme := <<"foo">>, userinfo := <<"合:気"/utf8>>, host := <<"道"/utf8>>} = + uri_string:parse(<<"foo://%E5%90%88:%E6%B0%97@%E9%81%93">>), + {error,invalid_uri,"@"} = uri_string:parse(<<"//%E5%90%88@%E6%B0%97%E9%81%93@">>), + {error,invalid_uri,":"} = uri_string:parse(<<"foo://%E5%90%88@%E6%B0%97%E9%81%93@">>). + +parse_binary_host(_Config) -> + #{host := <<"hostname">>} = uri_string:parse(<<"//hostname">>), + #{host := <<"hostname">>,scheme := <<"foo">>} = uri_string:parse(<<"foo://hostname">>), + #{host := <<"hostname">>,scheme := <<"foo">>, userinfo := <<"user">>} = + uri_string:parse(<<"foo://user@hostname">>). + +parse_binary_host_ipv4(_Config) -> + #{host := <<"127.0.0.1">>} = uri_string:parse(<<"//127.0.0.1">>), + #{host := <<"127.0.0.1">>, path := <<"/over/there">>} = + uri_string:parse(<<"//127.0.0.1/over/there">>), + #{host := <<"127.0.0.1">>, query := <<"name=ferret">>} = + uri_string:parse(<<"//127.0.0.1?name=ferret">>), + #{host := <<"127.0.0.1">>, fragment := <<"nose">>} = uri_string:parse(<<"//127.0.0.1#nose">>), + {error,invalid_uri,"x"} = uri_string:parse(<<"//127.0.0.x">>), + {error,invalid_uri,"1227.0.0.1"} = uri_string:parse(<<"//1227.0.0.1">>). + +parse_binary_host_ipv6(_Config) -> + #{host := <<"::127.0.0.1">>} = uri_string:parse(<<"//[::127.0.0.1]">>), + #{host := <<"2001:0db8:0000:0000:0000:0000:1428:07ab">>} = + uri_string:parse(<<"//[2001:0db8:0000:0000:0000:0000:1428:07ab]">>), + #{host := <<"::127.0.0.1">>, path := <<"/over/there">>} = + uri_string:parse(<<"//[::127.0.0.1]/over/there">>), + #{host := <<"::127.0.0.1">>, query := <<"name=ferret">>} = + uri_string:parse(<<"//[::127.0.0.1]?name=ferret">>), + #{host := <<"::127.0.0.1">>, fragment := <<"nose">>} = + uri_string:parse(<<"//[::127.0.0.1]#nose">>), + {error,invalid_uri,"x"} = uri_string:parse(<<"//[::127.0.0.x]">>), + {error,invalid_uri,"::1227.0.0.1"} = uri_string:parse(<<"//[::1227.0.0.1]">>), + {error,invalid_uri,"G"} = uri_string:parse(<<"//[2001:0db8:0000:0000:0000:0000:1428:G7ab]">>). + +parse_binary_port(_Config) -> + #{path:= <<"/:8042">>} = + uri_string:parse(<<"/:8042">>), + #{host:= <<>>, port := 8042} = + uri_string:parse(<<"//:8042">>), + #{host := <<"example.com">>, port:= 8042} = + uri_string:parse(<<"//example.com:8042">>), + #{scheme := <<"foo">>, path := <<"/:8042">>} = + uri_string:parse(<<"foo:/:8042">>), + #{scheme := <<"foo">>, host := <<>>, port := 8042} = + uri_string:parse(<<"foo://:8042">>), + #{scheme := <<"foo">>, host := <<"example.com">>, port := 8042} = + uri_string:parse(<<"foo://example.com:8042">>), + {error,invalid_uri,":"} = uri_string:parse(":600"), + {error,invalid_uri,"x"} = uri_string:parse("//:8042x"). + +parse_binary_path(_Config) -> + #{path := <<"over/there">>} = uri_string:parse(<<"over/there">>), + #{path := <<"/over/there">>} = uri_string:parse(<<"/over/there">>), + #{scheme := <<"foo">>, path := <<"/over/there">>} = + uri_string:parse(<<"foo:/over/there">>), + #{scheme := <<"foo">>, host := <<"example.com">>, path := <<"/over/there">>} = + uri_string:parse(<<"foo://example.com/over/there">>), + #{scheme := <<"foo">>, host := <<"example.com">>, path := <<"/over/there">>, port := 8042} = + uri_string:parse(<<"foo://example.com:8042/over/there">>). + +parse_binary_query(_Config) -> + #{scheme := <<"foo">>, query := <<"name=ferret">>} = + uri_string:parse(<<"foo:?name=ferret">>), + #{scheme := <<"foo">>, path:= <<"over/there">>, query := <<"name=ferret">>} = + uri_string:parse(<<"foo:over/there?name=ferret">>), + #{scheme := <<"foo">>, path:= <<"/over/there">>, query := <<"name=ferret">>} = + uri_string:parse(<<"foo:/over/there?name=ferret">>), + #{scheme := <<"foo">>, host := <<"example.com">>, query := <<"name=ferret">>} = + uri_string:parse(<<"foo://example.com?name=ferret">>), + #{scheme := <<"foo">>, host := <<"example.com">>, path := <<"/">>, query := <<"name=ferret">>} = + uri_string:parse(<<"foo://example.com/?name=ferret">>), + + #{path := <<>>, query := <<"name=ferret">>} = + uri_string:parse(<<"?name=ferret">>), + #{path := <<"over/there">>, query := <<"name=ferret">>} = + uri_string:parse(<<"over/there?name=ferret">>), + #{path := <<"/">>, query := <<"name=ferret">>} = + uri_string:parse(<<"/?name=ferret">>), + #{path := <<"/over/there">>, query := <<"name=ferret">>} = + uri_string:parse(<<"/over/there?name=ferret">>), + #{host := <<"example.com">>, query := <<"name=ferret">>} = + uri_string:parse(<<"//example.com?name=ferret">>), + #{host := <<"example.com">>, path := <<"/">>, query := <<"name=ferret">>} = + uri_string:parse(<<"//example.com/?name=ferret">>). + +parse_binary_pct_encoded_query(_Config) -> + #{scheme := <<"foo">>, host := <<"example.com">>, path := <<"/">>, + query := <<"name=合気道"/utf8>>} = + uri_string:parse(<<"foo://example.com/?name=%E5%90%88%E6%B0%97%E9%81%93">>), + #{host := <<"example.com">>, path := <<"/">>, query := <<"name=合気道"/utf8>>} = + uri_string:parse(<<"//example.com/?name=%E5%90%88%E6%B0%97%E9%81%93">>). + +parse_binary_fragment(_Config) -> + #{scheme := <<"foo">>, fragment := <<"nose">>} = + uri_string:parse(<<"foo:#nose">>), + #{scheme := <<"foo">>, path:= <<"over/there">>, fragment := <<"nose">>} = + uri_string:parse(<<"foo:over/there#nose">>), + #{scheme := <<"foo">>, path:= <<"/over/there">>, fragment := <<"nose">>} = + uri_string:parse(<<"foo:/over/there#nose">>), + #{scheme := <<"foo">>, host := <<"example.com">>, fragment := <<"nose">>} = + uri_string:parse(<<"foo://example.com#nose">>), + #{scheme := <<"foo">>, host := <<"example.com">>, path := <<"/">>, fragment := <<"nose">>} = + uri_string:parse(<<"foo://example.com/#nose">>), + #{scheme := <<"foo">>, host := <<"example.com">>, fragment := <<"nose">>} = + uri_string:parse(<<"foo://example.com#nose">>), + + #{fragment := <<"nose">>} = + uri_string:parse(<<"#nose">>), + #{path := <<"over/there">>, fragment := <<"nose">>} = + uri_string:parse(<<"over/there#nose">>), + #{path := <<"/">>, fragment := <<"nose">>} = + uri_string:parse(<<"/#nose">>), + #{path := <<"/over/there">>, fragment := <<"nose">>} = + uri_string:parse(<<"/over/there#nose">>), + #{host := <<"example.com">>, fragment := <<"nose">>} = + uri_string:parse(<<"//example.com#nose">>), + #{host := <<"example.com">>, path := <<"/">>, fragment := <<"nose">>} = + uri_string:parse(<<"//example.com/#nose">>). + +parse_binary_pct_encoded_fragment(_Config) -> + #{scheme := <<"foo">>, host := <<"example.com">>, fragment := <<"合気道"/utf8>>} = + uri_string:parse(<<"foo://example.com#%E5%90%88%E6%B0%97%E9%81%93">>), + #{host := <<"example.com">>, path := <<"/">>, fragment := <<"合気道"/utf8>>} = + uri_string:parse(<<"//example.com/#%E5%90%88%E6%B0%97%E9%81%93">>). + +parse_scheme(_Config) -> + #{} = uri_string:parse(""), + #{path := "foo"} = uri_string:parse("foo"), + #{scheme := "foo"} = uri_string:parse("foo:"), + #{scheme := "foo", path := "bar:nisse"} = uri_string:parse("foo:bar:nisse"), + #{scheme := "foo", host := ""} = uri_string:parse("foo://"), + #{scheme := "foo", host := "", path := "/"} = uri_string:parse("foo:///"), + #{scheme := "foo", host := "", path := "//"} = uri_string:parse("foo:////"), + + #{path := "/"} = uri_string:parse("/"), + #{host := ""} = uri_string:parse("//"), + #{host := "", path := "/"} = uri_string:parse("///"). + +parse_userinfo(_Config) -> + #{scheme := "user", path := "password@localhost"} = uri_string:parse("user:password@localhost"), + #{path := "user@"} = uri_string:parse("user@"), + #{path := "/user@"} = uri_string:parse("/user@"), + #{path := "user@localhost"} = uri_string:parse("user@localhost"), + #{userinfo := "user", host := "localhost"} = uri_string:parse("//user@localhost"), + #{userinfo := "user:password", host := "localhost"} = + uri_string:parse("//user:password@localhost"), + #{scheme := "foo", path := "/user@"} = + uri_string:parse("foo:/user@"), + #{scheme := "foo", userinfo := "user", host := "localhost"} = + uri_string:parse("foo://user@localhost"), + #{scheme := "foo", userinfo := "user:password", host := "localhost"} = + uri_string:parse("foo://user:password@localhost"). + +parse_pct_encoded_userinfo(_Config) -> + #{scheme := "user", path := "合@気道"} = + uri_string:parse("user:%E5%90%88@%E6%B0%97%E9%81%93"), + #{path := "合気道@"} = uri_string:parse("%E5%90%88%E6%B0%97%E9%81%93@"), + #{path := "/合気道@"} = uri_string:parse("/%E5%90%88%E6%B0%97%E9%81%93@"), + #{path := "合@気道"} = uri_string:parse("%E5%90%88@%E6%B0%97%E9%81%93"), + #{userinfo := "合", host := "気道"} = + uri_string:parse("//%E5%90%88@%E6%B0%97%E9%81%93"), + #{userinfo := "合:気", host := "道"} = + uri_string:parse("//%E5%90%88:%E6%B0%97@%E9%81%93"), + #{scheme := "foo", path := "/合気道@"} = + uri_string:parse("foo:/%E5%90%88%E6%B0%97%E9%81%93@"), + #{scheme := "foo", userinfo := "合", host := "気道"} = + uri_string:parse("foo://%E5%90%88@%E6%B0%97%E9%81%93"), + #{scheme := "foo", userinfo := "合:気", host := "道"} = + uri_string:parse("foo://%E5%90%88:%E6%B0%97@%E9%81%93"), + {error,invalid_uri,"@"} = uri_string:parse("//%E5%90%88@%E6%B0%97%E9%81%93@"), + {error,invalid_uri,":"} = uri_string:parse("foo://%E5%90%88@%E6%B0%97%E9%81%93@"). + + +parse_host(_Config) -> + #{host := "hostname"} = uri_string:parse("//hostname"), + #{host := "hostname",scheme := "foo"} = uri_string:parse("foo://hostname"), + #{host := "hostname",scheme := "foo", userinfo := "user"} = + uri_string:parse("foo://user@hostname"). + +parse_host_ipv4(_Config) -> + #{host := "127.0.0.1"} = uri_string:parse("//127.0.0.1"), + #{host := "2001:0db8:0000:0000:0000:0000:1428:07ab"} = + uri_string:parse("//[2001:0db8:0000:0000:0000:0000:1428:07ab]"), + #{host := "127.0.0.1", path := "/over/there"} = uri_string:parse("//127.0.0.1/over/there"), + #{host := "127.0.0.1", query := "name=ferret"} = uri_string:parse("//127.0.0.1?name=ferret"), + #{host := "127.0.0.1", fragment := "nose"} = uri_string:parse("//127.0.0.1#nose"), + {error,invalid_uri,"x"} = uri_string:parse("//127.0.0.x"), + {error,invalid_uri,"1227.0.0.1"} = uri_string:parse("//1227.0.0.1"). + +parse_host_ipv6(_Config) -> + #{host := "::127.0.0.1"} = uri_string:parse("//[::127.0.0.1]"), + #{host := "::127.0.0.1", path := "/over/there"} = uri_string:parse("//[::127.0.0.1]/over/there"), + #{host := "::127.0.0.1", query := "name=ferret"} = + uri_string:parse("//[::127.0.0.1]?name=ferret"), + #{host := "::127.0.0.1", fragment := "nose"} = uri_string:parse("//[::127.0.0.1]#nose"), + {error,invalid_uri,"x"} = uri_string:parse("//[::127.0.0.x]"), + {error,invalid_uri,"::1227.0.0.1"} = uri_string:parse("//[::1227.0.0.1]"), + {error,invalid_uri,"G"} = uri_string:parse("//[2001:0db8:0000:0000:0000:0000:1428:G7ab]"). + +parse_port(_Config) -> + #{path:= "/:8042"} = + uri_string:parse("/:8042"), + #{host:= "", port := 8042} = + uri_string:parse("//:8042"), + #{host := "example.com", port:= 8042} = + uri_string:parse("//example.com:8042"), + #{scheme := "foo", path := "/:8042"} = + uri_string:parse("foo:/:8042"), + #{scheme := "foo", host := "", port := 8042} = + uri_string:parse("foo://:8042"), + #{scheme := "foo", host := "example.com", port := 8042} = + uri_string:parse("foo://example.com:8042"). + +parse_path(_Config) -> + #{path := "over/there"} = uri_string:parse("over/there"), + #{path := "/over/there"} = uri_string:parse("/over/there"), + #{scheme := "foo", path := "/over/there"} = + uri_string:parse("foo:/over/there"), + #{scheme := "foo", host := "example.com", path := "/over/there"} = + uri_string:parse("foo://example.com/over/there"), + #{scheme := "foo", host := "example.com", path := "/over/there", port := 8042} = + uri_string:parse("foo://example.com:8042/over/there"). + +parse_query(_Config) -> + #{scheme := "foo", query := "name=ferret"} = + uri_string:parse("foo:?name=ferret"), + #{scheme := "foo", path:= "over/there", query := "name=ferret"} = + uri_string:parse("foo:over/there?name=ferret"), + #{scheme := "foo", path:= "/over/there", query := "name=ferret"} = + uri_string:parse("foo:/over/there?name=ferret"), + #{scheme := "foo", host := "example.com", query := "name=ferret"} = + uri_string:parse("foo://example.com?name=ferret"), + #{scheme := "foo", host := "example.com", path := "/", query := "name=ferret"} = + uri_string:parse("foo://example.com/?name=ferret"), + + #{path := "", query := "name=ferret"} = + uri_string:parse("?name=ferret"), + #{path := "over/there", query := "name=ferret"} = + uri_string:parse("over/there?name=ferret"), + #{path := "/", query := "name=ferret"} = + uri_string:parse("/?name=ferret"), + #{path := "/over/there", query := "name=ferret"} = + uri_string:parse("/over/there?name=ferret"), + #{host := "example.com", query := "name=ferret"} = + uri_string:parse("//example.com?name=ferret"), + #{host := "example.com", path := "/", query := "name=ferret"} = + uri_string:parse("//example.com/?name=ferret"). + +parse_pct_encoded_query(_Config) -> + #{scheme := "foo", host := "example.com", path := "/", + query := "name=合気道"} = + uri_string:parse("foo://example.com/?name=%E5%90%88%E6%B0%97%E9%81%93"), + #{host := "example.com", path := "/", query := "name=合気道"} = + uri_string:parse("//example.com/?name=%E5%90%88%E6%B0%97%E9%81%93"). + +parse_fragment(_Config) -> + #{scheme := "foo", fragment := "nose"} = + uri_string:parse("foo:#nose"), + #{scheme := "foo", path:= "over/there", fragment := "nose"} = + uri_string:parse("foo:over/there#nose"), + #{scheme := "foo", path:= "/over/there", fragment := "nose"} = + uri_string:parse("foo:/over/there#nose"), + #{scheme := "foo", host := "example.com", fragment := "nose"} = + uri_string:parse("foo://example.com#nose"), + #{scheme := "foo", host := "example.com", path := "/", fragment := "nose"} = + uri_string:parse("foo://example.com/#nose"), + #{scheme := "foo", host := "example.com", fragment := "nose"} = + uri_string:parse("foo://example.com#nose"), + + #{fragment := "nose"} = + uri_string:parse("#nose"), + #{path := "over/there", fragment := "nose"} = + uri_string:parse("over/there#nose"), + #{path := "/", fragment := "nose"} = + uri_string:parse("/#nose"), + #{path := "/over/there", fragment := "nose"} = + uri_string:parse("/over/there#nose"), + #{host := "example.com", fragment := "nose"} = + uri_string:parse("//example.com#nose"), + #{host := "example.com", path := "/", fragment := "nose"} = + uri_string:parse("//example.com/#nose"). + +parse_pct_encoded_fragment(_Config) -> + #{scheme := "foo", host := "example.com", fragment := "合気道"} = + uri_string:parse("foo://example.com#%E5%90%88%E6%B0%97%E9%81%93"), + #{host := "example.com", path := "/", fragment := "合気道"} = + uri_string:parse("//example.com/#%E5%90%88%E6%B0%97%E9%81%93"). + +parse_list(_Config) -> + #{scheme := "foo", path := "bar:nisse"} = uri_string:parse("foo:bar:nisse"), + #{scheme := "foo", host := "example.com", port := 8042, + path := "/over/there", query := "name=ferret", fragment := "nose"} = + uri_string:parse("foo://example.com:8042/over/there?name=ferret#nose"), + #{scheme := "foo", userinfo := "admin:admin", host := "example.com", port := 8042, + path := "/over/there", query := "name=ferret", fragment := "nose"} = + uri_string:parse("foo://admin:[email protected]:8042/over/there?name=ferret#nose"). + +parse_binary(_Config) -> + #{scheme := <<"foo">>, path := <<"bar:nisse">>} = uri_string:parse(<<"foo:bar:nisse">>), + #{scheme := <<"foo">>, host := <<"example.com">>, port := 8042, + path := <<"/over/there">>, query := <<"name=ferret">>, fragment := <<"nose">>} = + uri_string:parse(<<"foo://example.com:8042/over/there?name=ferret#nose">>), + #{scheme := <<"foo">>, userinfo := <<"admin:admin">>, host := <<"example.com">>, port := 8042, + path := <<"/over/there">>, query := <<"name=ferret">>, fragment := <<"nose">>} = + uri_string:parse(<<"foo://admin:[email protected]:8042/over/there?name=ferret#nose">>). + + +parse_mixed(_Config) -> + #{scheme := "foo", path := "bar"} = + uri_string:parse(lists:append("fo",<<"o:bar">>)), + #{scheme := "foo", path := "bar"} = + uri_string:parse(lists:append("foo:b",<<"ar">>)), + #{scheme := "foo", path := "bar:bar"} = + uri_string:parse([[102],[111,111],<<":bar">>,58,98,97,114]). + +parse_relative(_Config) -> + #{path := "/path"} = + uri_string:parse(lists:append("/pa",<<"th">>)), + #{path := "foo"} = + uri_string:parse(lists:append("fo",<<"o">>)). + +parse_special(_Config) -> + #{host := [],query := []} = uri_string:parse("//?"), + #{fragment := [],host := []} = uri_string:parse("//#"), + #{host := [],query := [],scheme := "foo"} = uri_string:parse("foo://?"), + #{fragment := [],host := [],scheme := "foo"} = uri_string:parse("foo://#"), + #{host := <<>>, path := <<"/">>} = uri_string:parse(<<"///">>), + #{host := <<"hostname">>} = uri_string:parse(<<"//hostname">>), + #{host := <<>>, path := <<"/hostname">>} = uri_string:parse(<<"///hostname">>), + #{host := [],path := "/",query := []} = uri_string:parse("///?"), + #{fragment := [],host := [],path := "/"} = uri_string:parse("///#"), + #{host := "foo",query := []} = uri_string:parse("//foo?"), + #{fragment := [],host := "foo"} = uri_string:parse("//foo#"), + #{host := "foo",path := "/"} = uri_string:parse("//foo/"), + #{host := "foo",query := [],scheme := "http"} = uri_string:parse("http://foo?"), + #{fragment := [],host := "foo",scheme := "http"} = uri_string:parse("http://foo#"), + #{host := "foo",path := "/",scheme := "http"} = uri_string:parse("http://foo/"), + #{fragment := [],host := "host",port := 80,scheme := "http"} = uri_string:parse("http://host:80#"), + #{host := "host",port := 80,query := [],scheme := "http"} = uri_string:parse("http://host:80?"), + #{path := [],query := []} = uri_string:parse("?"), + #{path := [],query := "?"} = uri_string:parse("??"), + #{path := [],query := "??"} = uri_string:parse("???"). + +parse_special2(_Config) -> + #{host := [],path := "/",port := 1,scheme := "a"} = uri_string:parse("a://:1/"), + #{path := "/a/",scheme := "a"} = uri_string:parse("a:/a/"), + #{host := [],path := [],userinfo := []} = uri_string:parse("//@"), + #{host := [],path := [],scheme := "foo",userinfo := []} = uri_string:parse("foo://@"), + #{host := [],path := "/",userinfo := []} = uri_string:parse("//@/"), + #{host := [],path := "/",scheme := "foo",userinfo := []} = uri_string:parse("foo://@/"), + #{host := "localhost",path := "/",port := undefined} = uri_string:parse("//localhost:/"), + #{host := [],path := [],port := undefined} = uri_string:parse("//:"). + +parse_negative(_Config) -> + {error,invalid_uri,"å"} = uri_string:parse("å"), + {error,invalid_uri,"å"} = uri_string:parse("aå:/foo"), + {error,invalid_uri,":"} = uri_string:parse("foo://usär@host"), + {error,invalid_uri,"ö"} = uri_string:parse("//host/path?foö=bar"), + {error,invalid_uri,"ö"} = uri_string:parse("//host/path#foö"), + {error,invalid_uri,"127.256.0.1"} = uri_string:parse("//127.256.0.1"), + {error,invalid_uri,":::127.0.0.1"} = uri_string:parse("//[:::127.0.0.1]"), + {error,invalid_utf8,<<0,0,0,246>>} = uri_string:parse("//%00%00%00%F6"), + {error,invalid_uri,"A"} = uri_string:parse("//localhost:A8"). + + +%%------------------------------------------------------------------------- +%% Recompose tests +%%------------------------------------------------------------------------- +recompose_fragment(_Config) -> + <<?FRAGMENT_ENC>> = uri_string:recompose(#{fragment => <<?FRAGMENT/utf8>>, path => <<>>}), + ?FRAGMENT_ENC = uri_string:recompose(#{fragment => ?FRAGMENT, path => ""}). + +recompose_parse_fragment(_Config) -> + <<?FRAGMENT_ENC>> = uri_string:recompose(uri_string:parse(<<?FRAGMENT_ENC>>)), + ?FRAGMENT_ENC = uri_string:recompose(uri_string:parse(?FRAGMENT_ENC)). + +recompose_query(_Config) -> + <<?QUERY_ENC>> = + uri_string:recompose(#{query => <<?QUERY/utf8>>, path => <<>>}), + <<?QUERY_ENC?FRAGMENT_ENC>> = + uri_string:recompose(#{query => <<?QUERY/utf8>>, + fragment => <<?FRAGMENT/utf8>>, + path => <<>>}), + "?name=%C3%B6rn" = + uri_string:recompose(#{query => "name=örn", path => ""}), + "?name=%C3%B6rn#n%C3%A4sa" = + uri_string:recompose(#{query => "name=örn", + fragment => "näsa", + path => ""}). + +recompose_parse_query(_Config) -> + <<"?name=%C3%B6rn">> = uri_string:recompose(uri_string:parse(<<"?name=%C3%B6rn">>)), + <<"?name=%C3%B6rn#n%C3%A4sa">> = + uri_string:recompose(uri_string:parse(<<"?name=%C3%B6rn#n%C3%A4sa">>)), + "?name=%C3%B6rn" = uri_string:recompose(uri_string:parse("?name=%C3%B6rn")), + "?name=%C3%B6rn#n%C3%A4sa" = uri_string:recompose(uri_string:parse("?name=%C3%B6rn#n%C3%A4sa")). + +recompose_path(_Config) -> + <<"/d%C3%A4r">> = + uri_string:recompose(#{path => <<"/där"/utf8>>}), + <<"/d%C3%A4r#n%C3%A4sa">> = + uri_string:recompose(#{path => <<"/där"/utf8>>, + fragment => <<"näsa"/utf8>>}), + <<"/d%C3%A4r?name=%C3%B6rn">> = + uri_string:recompose(#{path => <<"/där"/utf8>>, + query => <<"name=örn"/utf8>>}), + <<"/d%C3%A4r?name=%C3%B6rn#n%C3%A4sa">> = + uri_string:recompose(#{path => <<"/där"/utf8>>, + query => <<"name=örn"/utf8>>, + fragment => <<"näsa"/utf8>>}), + + + "/d%C3%A4r" = + uri_string:recompose(#{path => "/där"}), + "/d%C3%A4r#n%C3%A4sa" = + uri_string:recompose(#{path => "/där", + fragment => "näsa"}), + "/d%C3%A4r?name=%C3%B6rn" = + uri_string:recompose(#{path => "/där", + query => "name=örn"}), + "/d%C3%A4r?name=%C3%B6rn#n%C3%A4sa" = + uri_string:recompose(#{path => "/där", + query => "name=örn", + fragment => "näsa"}). + + +recompose_parse_path(_Config) -> + <<"/d%C3%A4r">> = + uri_string:recompose(uri_string:parse(<<"/d%C3%A4r">>)), + <<"/d%C3%A4r#n%C3%A4sa">> = + uri_string:recompose(uri_string:parse(<<"/d%C3%A4r#n%C3%A4sa">>)), + <<"/d%C3%A4r?name=%C3%B6rn">> = + uri_string:recompose(uri_string:parse(<<"/d%C3%A4r?name=%C3%B6rn">>)), + + "/d%C3%A4r" = + uri_string:recompose(uri_string:parse("/d%C3%A4r")), + "/d%C3%A4r#n%C3%A4sa" = + uri_string:recompose(uri_string:parse("/d%C3%A4r#n%C3%A4sa")), + "/d%C3%A4r?name=%C3%B6rn" = + uri_string:recompose(uri_string:parse("/d%C3%A4r?name=%C3%B6rn")). + + +recompose_autogen(_Config) -> + Tests = generate_test_vectors(uri_combinations()), + lists:map(fun run_test_recompose/1, Tests). + +parse_recompose_autogen(_Config) -> + Tests = generate_test_vectors(uri_combinations()), + lists:map(fun run_test_parse_recompose/1, Tests). + +transcode_basic(_Config) -> + <<"foo%C3%B6bar"/utf8>> = + uri_string:transcode(<<"foo%00%00%00%F6bar"/utf32>>, [{in_encoding, utf32},{out_encoding, utf8}]), + "foo%C3%B6bar" = + uri_string:transcode("foo%00%00%00%F6bar", [{in_encoding, utf32},{out_encoding, utf8}]), + <<"foo%00%00%00%F6bar"/utf32>> = + uri_string:transcode(<<"foo%C3%B6bar"/utf8>>, [{in_encoding, utf8},{out_encoding, utf32}]), + "foo%00%00%00%F6bar" = + uri_string:transcode("foo%C3%B6bar", [{in_encoding, utf8},{out_encoding, utf32}]), + "foo%C3%B6bar" = + uri_string:transcode("foo%F6bar", [{in_encoding, latin1},{out_encoding, utf8}]). + +transcode_options(_Config) -> + <<"foo%C3%B6bar"/utf8>> = + uri_string:transcode(<<"foo%C3%B6bar"/utf8>>, []), + <<"foo%C3%B6bar"/utf8>> = + uri_string:transcode(<<"foo%00%00%00%F6bar"/utf32>>, [{in_encoding, utf32}]), + <<"foo%00%00%00%F6bar"/utf32>> = + uri_string:transcode(<<"foo%C3%B6bar"/utf8>>, [{out_encoding, utf32}]). + +transcode_mixed(_Config) -> + "foo%00%00%00%F6bar" = + uri_string:transcode(["foo",<<"%C3%B6"/utf8>>,<<"ba"/utf8>>,"r"], [{out_encoding, utf32}]), + "foo%00%00%00%F6bar" = + uri_string:transcode(["foo",<<"%C3%"/utf8>>,<<"B6ba"/utf8>>,"r"], [{out_encoding, utf32}]), + "foo%C3%B6bar" = + uri_string:transcode(["foo%00", <<"%00%0"/utf32>>,<<"0%F"/utf32>>,"6bar"], [{in_encoding, utf32},{out_encoding, utf8}]). + +transcode_negative(_Config) -> + {error,invalid_percent_encoding,"%BXbar"} = + uri_string:transcode(<<"foo%C3%BXbar"/utf8>>, [{in_encoding, utf8},{out_encoding, utf32}]), + {error,invalid_input,<<"ö">>} = + uri_string:transcode("foo%F6bar", [{in_encoding, utf8},{out_encoding, utf8}]). + +compose_query(_Config) -> + [] = uri_string:compose_query([]), + "foo=1&bar=2" = uri_string:compose_query([{<<"foo">>,"1"}, {"bar", "2"}]), + "foo=1&b%C3%A4r=2" = uri_string:compose_query([{"foo","1"}, {"bär", "2"}],[{encoding,utf8}]), + "foo=1&b%C3%A4r=2" = uri_string:compose_query([{"foo","1"}, {"bär", "2"}],[{encoding,unicode}]), + "foo=1&b%E4r=2" = uri_string:compose_query([{"foo","1"}, {"bär", "2"}],[{encoding,latin1}]), + "foo+bar=1&%E5%90%88=2" = uri_string:compose_query([{"foo bar","1"}, {"合", "2"}]), + "foo+bar=1&%26%2321512%3B=2" = + uri_string:compose_query([{"foo bar","1"}, {"合", "2"}],[{encoding,latin1}]), + "foo+bar=1&%C3%B6=2" = uri_string:compose_query([{<<"foo bar">>,<<"1">>}, {"ö", <<"2">>}]), + <<"foo+bar=1&%C3%B6=2">> = + uri_string:compose_query([{<<"foo bar">>,<<"1">>}, {<<"ö"/utf8>>, <<"2">>}]). + +compose_query_latin1(_Config) -> + Q = uri_string:compose_query([{"合foö bar","1"}, {"合", "合"}],[{encoding,latin1}]), + Q1 = uri_string:transcode(Q, [{in_encoding, latin1}]), + [{"合foö bar","1"}, {"合", "合"}] = uri_string:dissect_query(Q1), + Q2 = uri_string:compose_query([{<<"合foö bar"/utf8>>,<<"1">>}, {<<"合"/utf8>>, <<"合"/utf8>>}], + [{encoding,latin1}]), + Q3 = uri_string:transcode(Q2, [{in_encoding, latin1}]), + [{<<"合foö bar"/utf8>>,<<"1">>}, {<<"合"/utf8>>, <<"合"/utf8>>}] = + uri_string:dissect_query(Q3). + +compose_query_negative(_Config) -> + {error,invalid_input,4} = uri_string:compose_query([{"",4}]), + {error,invalid_input,5} = uri_string:compose_query([{5,""}]), + {error,invalid_encoding,utf16} = + uri_string:compose_query([{"foo bar","1"}, {<<"ö">>, "2"}],[{encoding,utf16}]). + +dissect_query(_Config) -> + [] = uri_string:dissect_query(""), + [{"foo","1"}, {"amp;bar", "2"}] = uri_string:dissect_query("foo=1&bar=2"), + [{"foo","1"}, {"bar", "2"}] = uri_string:dissect_query("foo=1&bar=2"), + [{"foo","1;bar=2"}] = uri_string:dissect_query("foo=1;bar=2"), + [{"foo","1"}, {"bar", "222"}] = uri_string:dissect_query([<<"foo=1&bar=2">>,"22"]), + [{"foo","ö"}, {"bar", "2"}] = uri_string:dissect_query("foo=%C3%B6&bar=2"), + [{<<"foo">>,<<"ö"/utf8>>}, {<<"bar">>, <<"2">>}] = + uri_string:dissect_query(<<"foo=%C3%B6&bar=2">>), + [{"foo bar","1"},{"ö","2"}] = + uri_string:dissect_query([<<"foo+bar=1&">>,<<"%C3%B6=2">>]), + [{"foo bar","1"},{[21512],"2"}] = + uri_string:dissect_query("foo+bar=1&%26%2321512%3B=2"), + [{<<"foo bar">>,<<"1">>},{<<"合"/utf8>>,<<"2">>}] = + uri_string:dissect_query(<<"foo+bar=1&%26%2321512%3B=2">>), + [{"föo bar","1"},{"ö","2"}] = + uri_string:dissect_query("föo+bar=1&%C3%B6=2"), + [{<<"föo bar"/utf8>>,<<"1">>},{<<"ö"/utf8>>,<<"2">>}] = + uri_string:dissect_query(<<"föo+bar=1&%C3%B6=2"/utf8>>). + +dissect_query_negative(_Config) -> + {error,missing_value,"&"} = + uri_string:dissect_query("foo1&bar=2"), + {error,invalid_percent_encoding,"%XX%B6"} = uri_string:dissect_query("foo=%XX%B6&bar=2"), + {error,invalid_input,[153]} = + uri_string:dissect_query("foo=%99%B6&bar=2"), + {error,invalid_character,"ö"} = uri_string:dissect_query(<<"föo+bar=1&%C3%B6=2">>), + {error,invalid_input,<<"ö">>} = + uri_string:dissect_query([<<"foo+bar=1&">>,<<"%C3%B6=2ö">>]). + +normalize(_Config) -> + "/a/g" = uri_string:normalize("/a/b/c/./../../g"), + <<"mid/6">> = uri_string:normalize(<<"mid/content=5/../6">>), + "http://localhost-%C3%B6rebro/a/g" = + uri_string:normalize("http://localhos%74-%c3%b6rebro:80/a/b/c/./../../g"), + <<"http://localhost-%C3%B6rebro/a/g">> = + uri_string:normalize(<<"http://localhos%74-%c3%b6rebro:80/a/b/c/./../../g">>), + <<"https://localhost/">> = + uri_string:normalize(<<"https://localhost:443">>), + <<"https://localhost:445/">> = + uri_string:normalize(<<"https://localhost:445">>), + <<"ftp://localhost">> = + uri_string:normalize(<<"ftp://localhost:21">>), + <<"ssh://localhost">> = + uri_string:normalize(<<"ssh://localhost:22">>), + <<"sftp://localhost">> = + uri_string:normalize(<<"sftp://localhost:22">>), + <<"tftp://localhost">> = + uri_string:normalize(<<"tftp://localhost:69">>). + +interop_query_utf8(_Config) -> + Q = uri_string:compose_query([{"foo bar","1"}, {"合", "2"}]), + Uri = uri_string:recompose(#{path => "/", query => Q}), + #{query := Q1} = uri_string:parse(Uri), + [{"foo bar","1"}, {"合", "2"}] = uri_string:dissect_query(Q1). + +interop_query_latin1(_Config) -> + Q = uri_string:compose_query([{"foo bar","1"}, {"合", "2"}], [{encoding,latin1}]), + Uri = uri_string:recompose(#{path => "/", query => Q}), + Uri1 = uri_string:transcode(Uri, [{in_encoding, latin1}]), + #{query := Q1} = uri_string:parse(Uri1), + [{"foo bar","1"}, {"合", "2"}] = uri_string:dissect_query(Q1). diff --git a/lib/stdlib/test/uri_string_property_test_SUITE.erl b/lib/stdlib/test/uri_string_property_test_SUITE.erl new file mode 100644 index 0000000000..ae2c61c7aa --- /dev/null +++ b/lib/stdlib/test/uri_string_property_test_SUITE.erl @@ -0,0 +1,39 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(uri_string_property_test_SUITE). + +-include_lib("common_test/include/ct.hrl"). +-compile(export_all). + +all() -> [recompose]. + +init_per_suite(Config) -> + ct_property_test:init_per_suite(Config). + +end_per_suite(Config) -> + Config. + +%%%======================================================================== +%%% Test suites +%%%======================================================================== +recompose(Config) -> + ct_property_test:quickcheck( + uri_string_recompose:prop_recompose(), + Config). diff --git a/lib/stdlib/uc_spec/CaseFolding.txt b/lib/stdlib/uc_spec/CaseFolding.txt index 372ee68bd8..efdf18e441 100644 --- a/lib/stdlib/uc_spec/CaseFolding.txt +++ b/lib/stdlib/uc_spec/CaseFolding.txt @@ -1,6 +1,6 @@ -# CaseFolding-9.0.0.txt -# Date: 2016-03-02, 18:54:54 GMT -# © 2016 Unicode®, Inc. +# CaseFolding-10.0.0.txt +# Date: 2017-04-14, 05:40:18 GMT +# © 2017 Unicode®, Inc. # Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries. # For terms of use, see http://www.unicode.org/terms_of_use.html # @@ -24,7 +24,7 @@ # # NOTE: case folding does not preserve normalization formats! # -# For information on case folding, including how to have case folding +# For information on case folding, including how to have case folding # preserve normalization formats, see Section 3.13 Default Case Algorithms in # The Unicode Standard. # diff --git a/lib/stdlib/uc_spec/CompositionExclusions.txt b/lib/stdlib/uc_spec/CompositionExclusions.txt index 1999ed1328..ff42508686 100644 --- a/lib/stdlib/uc_spec/CompositionExclusions.txt +++ b/lib/stdlib/uc_spec/CompositionExclusions.txt @@ -1,6 +1,6 @@ -# CompositionExclusions-9.0.0.txt -# Date: 2016-01-21, 22:00:00 GMT [KW, LI] -# © 2016 Unicode®, Inc. +# CompositionExclusions-10.0.0.txt +# Date: 2017-02-15, 00:00:00 GMT [KW, LI] +# © 2017 Unicode®, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html # # Unicode Character Database diff --git a/lib/stdlib/uc_spec/GraphemeBreakProperty.txt b/lib/stdlib/uc_spec/GraphemeBreakProperty.txt index c5e94a3762..32bb12e47e 100644 --- a/lib/stdlib/uc_spec/GraphemeBreakProperty.txt +++ b/lib/stdlib/uc_spec/GraphemeBreakProperty.txt @@ -1,6 +1,6 @@ -# GraphemeBreakProperty-9.0.0.txt -# Date: 2016-06-03, 22:23:55 GMT -# © 2016 Unicode®, Inc. +# GraphemeBreakProperty-10.0.0.txt +# Date: 2017-03-12, 07:03:41 GMT +# © 2017 Unicode®, Inc. # Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries. # For terms of use, see http://www.unicode.org/terms_of_use.html # @@ -25,8 +25,11 @@ 0D4E ; Prepend # Lo MALAYALAM LETTER DOT REPH 110BD ; Prepend # Cf KAITHI NUMBER SIGN 111C2..111C3 ; Prepend # Lo [2] SHARADA SIGN JIHVAMULIYA..SHARADA SIGN UPADHMANIYA +11A3A ; Prepend # Lo ZANABAZAR SQUARE CLUSTER-INITIAL LETTER RA +11A86..11A89 ; Prepend # Lo [4] SOYOMBO CLUSTER-INITIAL LETTER RA..SOYOMBO CLUSTER-INITIAL LETTER SA +11D46 ; Prepend # Lo MASARAM GONDI REPHA -# Total code points: 13 +# Total code points: 19 # ================================================ @@ -126,6 +129,7 @@ E01F0..E0FFF ; Control # Cn [3600] <reserved-E01F0>..<reserved-E0FFF> 0AC7..0AC8 ; Extend # Mn [2] GUJARATI VOWEL SIGN E..GUJARATI VOWEL SIGN AI 0ACD ; Extend # Mn GUJARATI SIGN VIRAMA 0AE2..0AE3 ; Extend # Mn [2] GUJARATI VOWEL SIGN VOCALIC L..GUJARATI VOWEL SIGN VOCALIC LL +0AFA..0AFF ; Extend # Mn [6] GUJARATI SIGN SUKUN..GUJARATI SIGN TWO-CIRCLE NUKTA ABOVE 0B01 ; Extend # Mn ORIYA SIGN CANDRABINDU 0B3C ; Extend # Mn ORIYA SIGN NUKTA 0B3E ; Extend # Mc ORIYA VOWEL SIGN AA @@ -154,7 +158,8 @@ E01F0..E0FFF ; Control # Cn [3600] <reserved-E01F0>..<reserved-E0FFF> 0CCC..0CCD ; Extend # Mn [2] KANNADA VOWEL SIGN AU..KANNADA SIGN VIRAMA 0CD5..0CD6 ; Extend # Mc [2] KANNADA LENGTH MARK..KANNADA AI LENGTH MARK 0CE2..0CE3 ; Extend # Mn [2] KANNADA VOWEL SIGN VOCALIC L..KANNADA VOWEL SIGN VOCALIC LL -0D01 ; Extend # Mn MALAYALAM SIGN CANDRABINDU +0D00..0D01 ; Extend # Mn [2] MALAYALAM SIGN COMBINING ANUSVARA ABOVE..MALAYALAM SIGN CANDRABINDU +0D3B..0D3C ; Extend # Mn [2] MALAYALAM SIGN VERTICAL BAR VIRAMA..MALAYALAM SIGN CIRCULAR VIRAMA 0D3E ; Extend # Mc MALAYALAM VOWEL SIGN AA 0D41..0D44 ; Extend # Mn [4] MALAYALAM VOWEL SIGN U..MALAYALAM VOWEL SIGN VOCALIC RR 0D4D ; Extend # Mn MALAYALAM SIGN VIRAMA @@ -243,7 +248,7 @@ E01F0..E0FFF ; Control # Cn [3600] <reserved-E01F0>..<reserved-E0FFF> 1CED ; Extend # Mn VEDIC SIGN TIRYAK 1CF4 ; Extend # Mn VEDIC TONE CANDRA ABOVE 1CF8..1CF9 ; Extend # Mn [2] VEDIC TONE RING ABOVE..VEDIC TONE DOUBLE RING ABOVE -1DC0..1DF5 ; Extend # Mn [54] COMBINING DOTTED GRAVE ACCENT..COMBINING UP TACK ABOVE +1DC0..1DF9 ; Extend # Mn [58] COMBINING DOTTED GRAVE ACCENT..COMBINING WIDE INVERTED BRIDGE BELOW 1DFB..1DFF ; Extend # Mn [5] COMBINING DELETION MARK..COMBINING RIGHT ARROWHEAD AND DOWN ARROWHEAD BELOW 200C ; Extend # Cf ZERO WIDTH NON-JOINER 20D0..20DC ; Extend # Mn [13] COMBINING LEFT HARPOON ABOVE..COMBINING FOUR DOTS ABOVE @@ -353,6 +358,15 @@ FF9E..FF9F ; Extend # Lm [2] HALFWIDTH KATAKANA VOICED SOUND MARK..HALFWIDT 1171D..1171F ; Extend # Mn [3] AHOM CONSONANT SIGN MEDIAL LA..AHOM CONSONANT SIGN MEDIAL LIGATING RA 11722..11725 ; Extend # Mn [4] AHOM VOWEL SIGN I..AHOM VOWEL SIGN UU 11727..1172B ; Extend # Mn [5] AHOM VOWEL SIGN AW..AHOM SIGN KILLER +11A01..11A06 ; Extend # Mn [6] ZANABAZAR SQUARE VOWEL SIGN I..ZANABAZAR SQUARE VOWEL SIGN O +11A09..11A0A ; Extend # Mn [2] ZANABAZAR SQUARE VOWEL SIGN REVERSED I..ZANABAZAR SQUARE VOWEL LENGTH MARK +11A33..11A38 ; Extend # Mn [6] ZANABAZAR SQUARE FINAL CONSONANT MARK..ZANABAZAR SQUARE SIGN ANUSVARA +11A3B..11A3E ; Extend # Mn [4] ZANABAZAR SQUARE CLUSTER-FINAL LETTER YA..ZANABAZAR SQUARE CLUSTER-FINAL LETTER VA +11A47 ; Extend # Mn ZANABAZAR SQUARE SUBJOINER +11A51..11A56 ; Extend # Mn [6] SOYOMBO VOWEL SIGN I..SOYOMBO VOWEL SIGN OE +11A59..11A5B ; Extend # Mn [3] SOYOMBO VOWEL SIGN VOCALIC R..SOYOMBO VOWEL LENGTH MARK +11A8A..11A96 ; Extend # Mn [13] SOYOMBO FINAL CONSONANT SIGN G..SOYOMBO SIGN ANUSVARA +11A98..11A99 ; Extend # Mn [2] SOYOMBO GEMINATION MARK..SOYOMBO SUBJOINER 11C30..11C36 ; Extend # Mn [7] BHAIKSUKI VOWEL SIGN I..BHAIKSUKI VOWEL SIGN VOCALIC L 11C38..11C3D ; Extend # Mn [6] BHAIKSUKI VOWEL SIGN E..BHAIKSUKI SIGN ANUSVARA 11C3F ; Extend # Mn BHAIKSUKI SIGN VIRAMA @@ -360,6 +374,11 @@ FF9E..FF9F ; Extend # Lm [2] HALFWIDTH KATAKANA VOICED SOUND MARK..HALFWIDT 11CAA..11CB0 ; Extend # Mn [7] MARCHEN SUBJOINED LETTER RA..MARCHEN VOWEL SIGN AA 11CB2..11CB3 ; Extend # Mn [2] MARCHEN VOWEL SIGN U..MARCHEN VOWEL SIGN E 11CB5..11CB6 ; Extend # Mn [2] MARCHEN SIGN ANUSVARA..MARCHEN SIGN CANDRABINDU +11D31..11D36 ; Extend # Mn [6] MASARAM GONDI VOWEL SIGN AA..MASARAM GONDI VOWEL SIGN VOCALIC R +11D3A ; Extend # Mn MASARAM GONDI VOWEL SIGN E +11D3C..11D3D ; Extend # Mn [2] MASARAM GONDI VOWEL SIGN AI..MASARAM GONDI VOWEL SIGN O +11D3F..11D45 ; Extend # Mn [7] MASARAM GONDI VOWEL SIGN AU..MASARAM GONDI VIRAMA +11D47 ; Extend # Mn MASARAM GONDI RA-KARA 16AF0..16AF4 ; Extend # Mn [5] BASSA VAH COMBINING HIGH TONE..BASSA VAH COMBINING HIGH-LOW TONE 16B30..16B36 ; Extend # Mn [7] PAHAWH HMONG MARK CIM TUB..PAHAWH HMONG MARK CIM TAUM 16F8F..16F92 ; Extend # Mn [4] MIAO TONE RIGHT..MIAO TONE BELOW @@ -387,7 +406,7 @@ FF9E..FF9F ; Extend # Lm [2] HALFWIDTH KATAKANA VOICED SOUND MARK..HALFWIDT E0020..E007F ; Extend # Cf [96] TAG SPACE..CANCEL TAG E0100..E01EF ; Extend # Mn [240] VARIATION SELECTOR-17..VARIATION SELECTOR-256 -# Total code points: 1828 +# Total code points: 1901 # ================================================ @@ -472,6 +491,7 @@ E0100..E01EF ; Extend # Mn [240] VARIATION SELECTOR-17..VARIATION SELECTOR-256 1C34..1C35 ; SpacingMark # Mc [2] LEPCHA CONSONANT SIGN NYIN-DO..LEPCHA CONSONANT SIGN KANG 1CE1 ; SpacingMark # Mc VEDIC TONE ATHARVAVEDIC INDEPENDENT SVARITA 1CF2..1CF3 ; SpacingMark # Mc [2] VEDIC SIGN ARDHAVISARGA..VEDIC SIGN ROTATED ARDHAVISARGA +1CF7 ; SpacingMark # Mc VEDIC SIGN ATIKRAMA A823..A824 ; SpacingMark # Mc [2] SYLOTI NAGRI VOWEL SIGN A..SYLOTI NAGRI VOWEL SIGN I A827 ; SpacingMark # Mc SYLOTI NAGRI VOWEL SIGN OO A880..A881 ; SpacingMark # Mc [2] SAURASHTRA SIGN ANUSVARA..SAURASHTRA SIGN VISARGA @@ -529,6 +549,10 @@ ABEC ; SpacingMark # Mc MEETEI MAYEK LUM IYEK 116B6 ; SpacingMark # Mc TAKRI SIGN VIRAMA 11720..11721 ; SpacingMark # Mc [2] AHOM VOWEL SIGN A..AHOM VOWEL SIGN AA 11726 ; SpacingMark # Mc AHOM VOWEL SIGN E +11A07..11A08 ; SpacingMark # Mc [2] ZANABAZAR SQUARE VOWEL SIGN AI..ZANABAZAR SQUARE VOWEL SIGN AU +11A39 ; SpacingMark # Mc ZANABAZAR SQUARE SIGN VISARGA +11A57..11A58 ; SpacingMark # Mc [2] SOYOMBO VOWEL SIGN AI..SOYOMBO VOWEL SIGN AU +11A97 ; SpacingMark # Mc SOYOMBO SIGN VISARGA 11C2F ; SpacingMark # Mc BHAIKSUKI VOWEL SIGN AA 11C3E ; SpacingMark # Mc BHAIKSUKI SIGN VISARGA 11CA9 ; SpacingMark # Mc MARCHEN SUBJOINED LETTER YA @@ -538,7 +562,7 @@ ABEC ; SpacingMark # Mc MEETEI MAYEK LUM IYEK 1D166 ; SpacingMark # Mc MUSICAL SYMBOL COMBINING SPRECHGESANG STEM 1D16D ; SpacingMark # Mc MUSICAL SYMBOL COMBINING AUGMENTATION DOT -# Total code points: 341 +# Total code points: 348 # ================================================ @@ -1375,8 +1399,9 @@ D789..D7A3 ; LVT # Lo [27] HANGUL SYLLABLE HIG..HANGUL SYLLABLE HIH 26F9 ; E_Base # So PERSON WITH BALL 270A..270D ; E_Base # So [4] RAISED FIST..WRITING HAND 1F385 ; E_Base # So FATHER CHRISTMAS -1F3C3..1F3C4 ; E_Base # So [2] RUNNER..SURFER -1F3CA..1F3CB ; E_Base # So [2] SWIMMER..WEIGHT LIFTER +1F3C2..1F3C4 ; E_Base # So [3] SNOWBOARDER..SURFER +1F3C7 ; E_Base # So HORSE RACING +1F3CA..1F3CC ; E_Base # So [3] SWIMMER..GOLFER 1F442..1F443 ; E_Base # So [2] EAR..NOSE 1F446..1F450 ; E_Base # So [11] WHITE UP POINTING BACKHAND INDEX..OPEN HANDS SIGN 1F46E ; E_Base # So POLICE OFFICER @@ -1385,7 +1410,7 @@ D789..D7A3 ; LVT # Lo [27] HANGUL SYLLABLE HIG..HANGUL SYLLABLE HIH 1F481..1F483 ; E_Base # So [3] INFORMATION DESK PERSON..DANCER 1F485..1F487 ; E_Base # So [3] NAIL POLISH..HAIRCUT 1F4AA ; E_Base # So FLEXED BICEPS -1F575 ; E_Base # So SLEUTH OR SPY +1F574..1F575 ; E_Base # So [2] MAN IN BUSINESS SUIT LEVITATING..SLEUTH OR SPY 1F57A ; E_Base # So MAN DANCING 1F590 ; E_Base # So RAISED HAND WITH FINGERS SPLAYED 1F595..1F596 ; E_Base # So [2] REVERSED HAND WITH MIDDLE FINGER EXTENDED..RAISED HAND WITH PART BETWEEN MIDDLE AND RING FINGERS @@ -1394,13 +1419,15 @@ D789..D7A3 ; LVT # Lo [27] HANGUL SYLLABLE HIG..HANGUL SYLLABLE HIH 1F6A3 ; E_Base # So ROWBOAT 1F6B4..1F6B6 ; E_Base # So [3] BICYCLIST..PEDESTRIAN 1F6C0 ; E_Base # So BATH -1F918..1F91E ; E_Base # So [7] SIGN OF THE HORNS..HAND WITH INDEX AND MIDDLE FINGERS CROSSED +1F6CC ; E_Base # So SLEEPING ACCOMMODATION +1F918..1F91C ; E_Base # So [5] SIGN OF THE HORNS..RIGHT-FACING FIST +1F91E..1F91F ; E_Base # So [2] HAND WITH INDEX AND MIDDLE FINGERS CROSSED..I LOVE YOU HAND SIGN 1F926 ; E_Base # So FACE PALM -1F930 ; E_Base # So PREGNANT WOMAN -1F933..1F939 ; E_Base # So [7] SELFIE..JUGGLING -1F93C..1F93E ; E_Base # So [3] WRESTLERS..HANDBALL +1F930..1F939 ; E_Base # So [10] PREGNANT WOMAN..JUGGLING +1F93D..1F93E ; E_Base # So [2] WATER POLO..HANDBALL +1F9D1..1F9DD ; E_Base # So [13] ADULT..ELF -# Total code points: 79 +# Total code points: 98 # ================================================ @@ -1416,11 +1443,28 @@ D789..D7A3 ; LVT # Lo [27] HANGUL SYLLABLE HIG..HANGUL SYLLABLE HIH # ================================================ +2640 ; Glue_After_Zwj # So FEMALE SIGN +2642 ; Glue_After_Zwj # So MALE SIGN +2695..2696 ; Glue_After_Zwj # So [2] STAFF OF AESCULAPIUS..SCALES +2708 ; Glue_After_Zwj # So AIRPLANE 2764 ; Glue_After_Zwj # So HEAVY BLACK HEART +1F308 ; Glue_After_Zwj # So RAINBOW +1F33E ; Glue_After_Zwj # So EAR OF RICE +1F373 ; Glue_After_Zwj # So COOKING +1F393 ; Glue_After_Zwj # So GRADUATION CAP +1F3A4 ; Glue_After_Zwj # So MICROPHONE +1F3A8 ; Glue_After_Zwj # So ARTIST PALETTE +1F3EB ; Glue_After_Zwj # So SCHOOL +1F3ED ; Glue_After_Zwj # So FACTORY 1F48B ; Glue_After_Zwj # So KISS MARK +1F4BB..1F4BC ; Glue_After_Zwj # So [2] PERSONAL COMPUTER..BRIEFCASE +1F527 ; Glue_After_Zwj # So WRENCH +1F52C ; Glue_After_Zwj # So MICROSCOPE 1F5E8 ; Glue_After_Zwj # So LEFT SPEECH BUBBLE +1F680 ; Glue_After_Zwj # So ROCKET +1F692 ; Glue_After_Zwj # So FIRE ENGINE -# Total code points: 3 +# Total code points: 22 # ================================================ diff --git a/lib/stdlib/uc_spec/PropList.txt b/lib/stdlib/uc_spec/PropList.txt index a8c0da7135..9a2d0e4b1c 100644 --- a/lib/stdlib/uc_spec/PropList.txt +++ b/lib/stdlib/uc_spec/PropList.txt @@ -1,6 +1,6 @@ -# PropList-9.0.0.txt -# Date: 2016-06-01, 10:34:30 GMT -# © 2016 Unicode®, Inc. +# PropList-10.0.0.txt +# Date: 2017-03-10, 08:25:30 GMT +# © 2017 Unicode®, Inc. # Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries. # For terms of use, see http://www.unicode.org/terms_of_use.html # @@ -199,6 +199,9 @@ FF64 ; Terminal_Punctuation # Po HALFWIDTH IDEOGRAPHIC COMMA 115C9..115D7 ; Terminal_Punctuation # Po [15] SIDDHAM END OF TEXT MARK..SIDDHAM SECTION MARK WITH CIRCLES AND FOUR ENCLOSURES 11641..11642 ; Terminal_Punctuation # Po [2] MODI DANDA..MODI DOUBLE DANDA 1173C..1173E ; Terminal_Punctuation # Po [3] AHOM SIGN SMALL SECTION..AHOM SIGN RULAI +11A42..11A43 ; Terminal_Punctuation # Po [2] ZANABAZAR SQUARE MARK SHAD..ZANABAZAR SQUARE MARK DOUBLE SHAD +11A9B..11A9C ; Terminal_Punctuation # Po [2] SOYOMBO MARK SHAD..SOYOMBO MARK DOUBLE SHAD +11AA1..11AA2 ; Terminal_Punctuation # Po [2] SOYOMBO TERMINAL MARK-1..SOYOMBO TERMINAL MARK-2 11C41..11C43 ; Terminal_Punctuation # Po [3] BHAIKSUKI DANDA..BHAIKSUKI WORD SEPARATOR 11C71 ; Terminal_Punctuation # Po MARCHEN MARK SHAD 12470..12474 ; Terminal_Punctuation # Po [5] CUNEIFORM PUNCTUATION SIGN OLD ASSYRIAN WORD DIVIDER..CUNEIFORM PUNCTUATION SIGN DIAGONAL QUADCOLON @@ -209,7 +212,7 @@ FF64 ; Terminal_Punctuation # Po HALFWIDTH IDEOGRAPHIC COMMA 1BC9F ; Terminal_Punctuation # Po DUPLOYAN PUNCTUATION CHINOOK FULL STOP 1DA87..1DA8A ; Terminal_Punctuation # Po [4] SIGNWRITING COMMA..SIGNWRITING COLON -# Total code points: 246 +# Total code points: 252 # ================================================ @@ -471,6 +474,7 @@ FF41..FF46 ; Hex_Digit # L& [6] FULLWIDTH LATIN SMALL LETTER A..FULLWIDTH L 0AC9 ; Other_Alphabetic # Mc GUJARATI VOWEL SIGN CANDRA O 0ACB..0ACC ; Other_Alphabetic # Mc [2] GUJARATI VOWEL SIGN O..GUJARATI VOWEL SIGN AU 0AE2..0AE3 ; Other_Alphabetic # Mn [2] GUJARATI VOWEL SIGN VOCALIC L..GUJARATI VOWEL SIGN VOCALIC LL +0AFA..0AFC ; Other_Alphabetic # Mn [3] GUJARATI SIGN SUKUN..GUJARATI SIGN MADDAH 0B01 ; Other_Alphabetic # Mn ORIYA SIGN CANDRABINDU 0B02..0B03 ; Other_Alphabetic # Mc [2] ORIYA SIGN ANUSVARA..ORIYA SIGN VISARGA 0B3E ; Other_Alphabetic # Mc ORIYA VOWEL SIGN AA @@ -508,7 +512,7 @@ FF41..FF46 ; Hex_Digit # L& [6] FULLWIDTH LATIN SMALL LETTER A..FULLWIDTH L 0CCC ; Other_Alphabetic # Mn KANNADA VOWEL SIGN AU 0CD5..0CD6 ; Other_Alphabetic # Mc [2] KANNADA LENGTH MARK..KANNADA AI LENGTH MARK 0CE2..0CE3 ; Other_Alphabetic # Mn [2] KANNADA VOWEL SIGN VOCALIC L..KANNADA VOWEL SIGN VOCALIC LL -0D01 ; Other_Alphabetic # Mn MALAYALAM SIGN CANDRABINDU +0D00..0D01 ; Other_Alphabetic # Mn [2] MALAYALAM SIGN COMBINING ANUSVARA ABOVE..MALAYALAM SIGN CANDRABINDU 0D02..0D03 ; Other_Alphabetic # Mc [2] MALAYALAM SIGN ANUSVARA..MALAYALAM SIGN VISARGA 0D3E..0D40 ; Other_Alphabetic # Mc [3] MALAYALAM VOWEL SIGN AA..MALAYALAM VOWEL SIGN II 0D41..0D44 ; Other_Alphabetic # Mn [4] MALAYALAM VOWEL SIGN U..MALAYALAM VOWEL SIGN VOCALIC RR @@ -726,6 +730,17 @@ FB1E ; Other_Alphabetic # Mn HEBREW POINT JUDEO-SPANISH VARIKA 11722..11725 ; Other_Alphabetic # Mn [4] AHOM VOWEL SIGN I..AHOM VOWEL SIGN UU 11726 ; Other_Alphabetic # Mc AHOM VOWEL SIGN E 11727..1172A ; Other_Alphabetic # Mn [4] AHOM VOWEL SIGN AW..AHOM VOWEL SIGN AM +11A01..11A06 ; Other_Alphabetic # Mn [6] ZANABAZAR SQUARE VOWEL SIGN I..ZANABAZAR SQUARE VOWEL SIGN O +11A07..11A08 ; Other_Alphabetic # Mc [2] ZANABAZAR SQUARE VOWEL SIGN AI..ZANABAZAR SQUARE VOWEL SIGN AU +11A09..11A0A ; Other_Alphabetic # Mn [2] ZANABAZAR SQUARE VOWEL SIGN REVERSED I..ZANABAZAR SQUARE VOWEL LENGTH MARK +11A35..11A38 ; Other_Alphabetic # Mn [4] ZANABAZAR SQUARE SIGN CANDRABINDU..ZANABAZAR SQUARE SIGN ANUSVARA +11A39 ; Other_Alphabetic # Mc ZANABAZAR SQUARE SIGN VISARGA +11A3B..11A3E ; Other_Alphabetic # Mn [4] ZANABAZAR SQUARE CLUSTER-FINAL LETTER YA..ZANABAZAR SQUARE CLUSTER-FINAL LETTER VA +11A51..11A56 ; Other_Alphabetic # Mn [6] SOYOMBO VOWEL SIGN I..SOYOMBO VOWEL SIGN OE +11A57..11A58 ; Other_Alphabetic # Mc [2] SOYOMBO VOWEL SIGN AI..SOYOMBO VOWEL SIGN AU +11A59..11A5B ; Other_Alphabetic # Mn [3] SOYOMBO VOWEL SIGN VOCALIC R..SOYOMBO VOWEL LENGTH MARK +11A8A..11A96 ; Other_Alphabetic # Mn [13] SOYOMBO FINAL CONSONANT SIGN G..SOYOMBO SIGN ANUSVARA +11A97 ; Other_Alphabetic # Mc SOYOMBO SIGN VISARGA 11C2F ; Other_Alphabetic # Mc BHAIKSUKI VOWEL SIGN AA 11C30..11C36 ; Other_Alphabetic # Mn [7] BHAIKSUKI VOWEL SIGN I..BHAIKSUKI VOWEL SIGN VOCALIC L 11C38..11C3D ; Other_Alphabetic # Mn [6] BHAIKSUKI VOWEL SIGN E..BHAIKSUKI SIGN ANUSVARA @@ -737,6 +752,12 @@ FB1E ; Other_Alphabetic # Mn HEBREW POINT JUDEO-SPANISH VARIKA 11CB2..11CB3 ; Other_Alphabetic # Mn [2] MARCHEN VOWEL SIGN U..MARCHEN VOWEL SIGN E 11CB4 ; Other_Alphabetic # Mc MARCHEN VOWEL SIGN O 11CB5..11CB6 ; Other_Alphabetic # Mn [2] MARCHEN SIGN ANUSVARA..MARCHEN SIGN CANDRABINDU +11D31..11D36 ; Other_Alphabetic # Mn [6] MASARAM GONDI VOWEL SIGN AA..MASARAM GONDI VOWEL SIGN VOCALIC R +11D3A ; Other_Alphabetic # Mn MASARAM GONDI VOWEL SIGN E +11D3C..11D3D ; Other_Alphabetic # Mn [2] MASARAM GONDI VOWEL SIGN AI..MASARAM GONDI VOWEL SIGN O +11D3F..11D41 ; Other_Alphabetic # Mn [3] MASARAM GONDI VOWEL SIGN AU..MASARAM GONDI SIGN VISARGA +11D43 ; Other_Alphabetic # Mn MASARAM GONDI SIGN CANDRA +11D47 ; Other_Alphabetic # Mn MASARAM GONDI RA-KARA 16B30..16B36 ; Other_Alphabetic # Mn [7] PAHAWH HMONG MARK CIM TUB..PAHAWH HMONG MARK CIM TAUM 16F51..16F7E ; Other_Alphabetic # Mc [46] MIAO SIGN ASPIRATION..MIAO VOWEL SIGN NG 1BC9E ; Other_Alphabetic # Mn DUPLOYAN DOUBLE MARK @@ -750,7 +771,7 @@ FB1E ; Other_Alphabetic # Mn HEBREW POINT JUDEO-SPANISH VARIKA 1F150..1F169 ; Other_Alphabetic # So [26] NEGATIVE CIRCLED LATIN CAPITAL LETTER A..NEGATIVE CIRCLED LATIN CAPITAL LETTER Z 1F170..1F189 ; Other_Alphabetic # So [26] NEGATIVE SQUARED LATIN CAPITAL LETTER A..NEGATIVE SQUARED LATIN CAPITAL LETTER Z -# Total code points: 1238 +# Total code points: 1300 # ================================================ @@ -759,18 +780,20 @@ FB1E ; Other_Alphabetic # Mn HEBREW POINT JUDEO-SPANISH VARIKA 3021..3029 ; Ideographic # Nl [9] HANGZHOU NUMERAL ONE..HANGZHOU NUMERAL NINE 3038..303A ; Ideographic # Nl [3] HANGZHOU NUMERAL TEN..HANGZHOU NUMERAL THIRTY 3400..4DB5 ; Ideographic # Lo [6582] CJK UNIFIED IDEOGRAPH-3400..CJK UNIFIED IDEOGRAPH-4DB5 -4E00..9FD5 ; Ideographic # Lo [20950] CJK UNIFIED IDEOGRAPH-4E00..CJK UNIFIED IDEOGRAPH-9FD5 +4E00..9FEA ; Ideographic # Lo [20971] CJK UNIFIED IDEOGRAPH-4E00..CJK UNIFIED IDEOGRAPH-9FEA F900..FA6D ; Ideographic # Lo [366] CJK COMPATIBILITY IDEOGRAPH-F900..CJK COMPATIBILITY IDEOGRAPH-FA6D FA70..FAD9 ; Ideographic # Lo [106] CJK COMPATIBILITY IDEOGRAPH-FA70..CJK COMPATIBILITY IDEOGRAPH-FAD9 17000..187EC ; Ideographic # Lo [6125] TANGUT IDEOGRAPH-17000..TANGUT IDEOGRAPH-187EC 18800..18AF2 ; Ideographic # Lo [755] TANGUT COMPONENT-001..TANGUT COMPONENT-755 +1B170..1B2FB ; Ideographic # Lo [396] NUSHU CHARACTER-1B170..NUSHU CHARACTER-1B2FB 20000..2A6D6 ; Ideographic # Lo [42711] CJK UNIFIED IDEOGRAPH-20000..CJK UNIFIED IDEOGRAPH-2A6D6 2A700..2B734 ; Ideographic # Lo [4149] CJK UNIFIED IDEOGRAPH-2A700..CJK UNIFIED IDEOGRAPH-2B734 2B740..2B81D ; Ideographic # Lo [222] CJK UNIFIED IDEOGRAPH-2B740..CJK UNIFIED IDEOGRAPH-2B81D 2B820..2CEA1 ; Ideographic # Lo [5762] CJK UNIFIED IDEOGRAPH-2B820..CJK UNIFIED IDEOGRAPH-2CEA1 +2CEB0..2EBE0 ; Ideographic # Lo [7473] CJK UNIFIED IDEOGRAPH-2CEB0..CJK UNIFIED IDEOGRAPH-2EBE0 2F800..2FA1D ; Ideographic # Lo [542] CJK COMPATIBILITY IDEOGRAPH-2F800..CJK COMPATIBILITY IDEOGRAPH-2FA1D -# Total code points: 88284 +# Total code points: 96174 # ================================================ @@ -826,12 +849,14 @@ FA70..FAD9 ; Ideographic # Lo [106] CJK COMPATIBILITY IDEOGRAPH-FA70..CJK COM 0A4D ; Diacritic # Mn GURMUKHI SIGN VIRAMA 0ABC ; Diacritic # Mn GUJARATI SIGN NUKTA 0ACD ; Diacritic # Mn GUJARATI SIGN VIRAMA +0AFD..0AFF ; Diacritic # Mn [3] GUJARATI SIGN THREE-DOT NUKTA ABOVE..GUJARATI SIGN TWO-CIRCLE NUKTA ABOVE 0B3C ; Diacritic # Mn ORIYA SIGN NUKTA 0B4D ; Diacritic # Mn ORIYA SIGN VIRAMA 0BCD ; Diacritic # Mn TAMIL SIGN VIRAMA 0C4D ; Diacritic # Mn TELUGU SIGN VIRAMA 0CBC ; Diacritic # Mn KANNADA SIGN NUKTA 0CCD ; Diacritic # Mn KANNADA SIGN VIRAMA +0D3B..0D3C ; Diacritic # Mn [2] MALAYALAM SIGN VERTICAL BAR VIRAMA..MALAYALAM SIGN CIRCULAR VIRAMA 0D4D ; Diacritic # Mn MALAYALAM SIGN VIRAMA 0DCA ; Diacritic # Mn SINHALA SIGN AL-LAKUNA 0E47..0E4C ; Diacritic # Mn [6] THAI CHARACTER MAITAIKHU..THAI CHARACTER THANTHAKHAT @@ -871,10 +896,11 @@ FA70..FAD9 ; Ideographic # Lo [106] CJK COMPATIBILITY IDEOGRAPH-FA70..CJK COM 1CE2..1CE8 ; Diacritic # Mn [7] VEDIC SIGN VISARGA SVARITA..VEDIC SIGN VISARGA ANUDATTA WITH TAIL 1CED ; Diacritic # Mn VEDIC SIGN TIRYAK 1CF4 ; Diacritic # Mn VEDIC TONE CANDRA ABOVE +1CF7 ; Diacritic # Mc VEDIC SIGN ATIKRAMA 1CF8..1CF9 ; Diacritic # Mn [2] VEDIC TONE RING ABOVE..VEDIC TONE DOUBLE RING ABOVE 1D2C..1D6A ; Diacritic # Lm [63] MODIFIER LETTER CAPITAL A..GREEK SUBSCRIPT SMALL LETTER CHI 1DC4..1DCF ; Diacritic # Mn [12] COMBINING MACRON-ACUTE..COMBINING ZIGZAG BELOW -1DF5 ; Diacritic # Mn COMBINING UP TACK ABOVE +1DF5..1DF9 ; Diacritic # Mn [5] COMBINING UP TACK ABOVE..COMBINING WIDE INVERTED BRIDGE BELOW 1DFD..1DFF ; Diacritic # Mn [3] COMBINING ALMOST EQUAL TO BELOW..COMBINING RIGHT ARROWHEAD AND DOWN ARROWHEAD BELOW 1FBD ; Diacritic # Sk GREEK KORONIS 1FBF..1FC1 ; Diacritic # Sk [3] GREEK PSILI..GREEK DIALYTIKA AND PERISPOMENI @@ -947,7 +973,12 @@ FFE3 ; Diacritic # Sk FULLWIDTH MACRON 116B6 ; Diacritic # Mc TAKRI SIGN VIRAMA 116B7 ; Diacritic # Mn TAKRI SIGN NUKTA 1172B ; Diacritic # Mn AHOM SIGN KILLER +11A34 ; Diacritic # Mn ZANABAZAR SQUARE SIGN VIRAMA +11A47 ; Diacritic # Mn ZANABAZAR SQUARE SUBJOINER +11A99 ; Diacritic # Mn SOYOMBO SUBJOINER 11C3F ; Diacritic # Mn BHAIKSUKI SIGN VIRAMA +11D42 ; Diacritic # Mn MASARAM GONDI SIGN NUKTA +11D44..11D45 ; Diacritic # Mn [2] MASARAM GONDI SIGN HALANTA..MASARAM GONDI VIRAMA 16AF0..16AF4 ; Diacritic # Mn [5] BASSA VAH COMBINING HIGH TONE..BASSA VAH COMBINING HIGH-LOW TONE 16F8F..16F92 ; Diacritic # Mn [4] MIAO TONE RIGHT..MIAO TONE BELOW 16F93..16F9F ; Diacritic # Lm [13] MIAO LETTER TONE-2..MIAO LETTER REFORMED TONE-8 @@ -960,7 +991,7 @@ FFE3 ; Diacritic # Sk FULLWIDTH MACRON 1E944..1E946 ; Diacritic # Mn [3] ADLAM ALIF LENGTHENER..ADLAM GEMINATION MARK 1E948..1E94A ; Diacritic # Mn [3] ADLAM CONSONANT MODIFIER..ADLAM NUKTA -# Total code points: 782 +# Total code points: 798 # ================================================ @@ -989,11 +1020,12 @@ AAF3..AAF4 ; Extender # Lm [2] MEETEI MAYEK SYLLABLE REPETITION MARK..MEETE FF70 ; Extender # Lm HALFWIDTH KATAKANA-HIRAGANA PROLONGED SOUND MARK 1135D ; Extender # Lo GRANTHA SIGN PLUTA 115C6..115C8 ; Extender # Po [3] SIDDHAM REPETITION MARK-1..SIDDHAM REPETITION MARK-3 +11A98 ; Extender # Mn SOYOMBO GEMINATION MARK 16B42..16B43 ; Extender # Lm [2] PAHAWH HMONG SIGN VOS NRUA..PAHAWH HMONG SIGN IB YAM -16FE0 ; Extender # Lm TANGUT ITERATION MARK +16FE0..16FE1 ; Extender # Lm [2] TANGUT ITERATION MARK..NUSHU ITERATION MARK 1E944..1E946 ; Extender # Mn [3] ADLAM ALIF LENGTHENER..ADLAM GEMINATION MARK -# Total code points: 42 +# Total code points: 44 # ================================================ @@ -1105,7 +1137,7 @@ E0020..E007F ; Other_Grapheme_Extend # Cf [96] TAG SPACE..CANCEL TAG # ================================================ 3400..4DB5 ; Unified_Ideograph # Lo [6582] CJK UNIFIED IDEOGRAPH-3400..CJK UNIFIED IDEOGRAPH-4DB5 -4E00..9FD5 ; Unified_Ideograph # Lo [20950] CJK UNIFIED IDEOGRAPH-4E00..CJK UNIFIED IDEOGRAPH-9FD5 +4E00..9FEA ; Unified_Ideograph # Lo [20971] CJK UNIFIED IDEOGRAPH-4E00..CJK UNIFIED IDEOGRAPH-9FEA FA0E..FA0F ; Unified_Ideograph # Lo [2] CJK COMPATIBILITY IDEOGRAPH-FA0E..CJK COMPATIBILITY IDEOGRAPH-FA0F FA11 ; Unified_Ideograph # Lo CJK COMPATIBILITY IDEOGRAPH-FA11 FA13..FA14 ; Unified_Ideograph # Lo [2] CJK COMPATIBILITY IDEOGRAPH-FA13..CJK COMPATIBILITY IDEOGRAPH-FA14 @@ -1117,8 +1149,9 @@ FA27..FA29 ; Unified_Ideograph # Lo [3] CJK COMPATIBILITY IDEOGRAPH-FA27..C 2A700..2B734 ; Unified_Ideograph # Lo [4149] CJK UNIFIED IDEOGRAPH-2A700..CJK UNIFIED IDEOGRAPH-2B734 2B740..2B81D ; Unified_Ideograph # Lo [222] CJK UNIFIED IDEOGRAPH-2B740..CJK UNIFIED IDEOGRAPH-2B81D 2B820..2CEA1 ; Unified_Ideograph # Lo [5762] CJK UNIFIED IDEOGRAPH-2B820..CJK UNIFIED IDEOGRAPH-2CEA1 +2CEB0..2EBE0 ; Unified_Ideograph # Lo [7473] CJK UNIFIED IDEOGRAPH-2CEB0..CJK UNIFIED IDEOGRAPH-2EBE0 -# Total code points: 80388 +# Total code points: 87882 # ================================================ @@ -1277,6 +1310,8 @@ FF61 ; Sentence_Terminal # Po HALFWIDTH IDEOGRAPHIC FULL STOP 115C9..115D7 ; Sentence_Terminal # Po [15] SIDDHAM END OF TEXT MARK..SIDDHAM SECTION MARK WITH CIRCLES AND FOUR ENCLOSURES 11641..11642 ; Sentence_Terminal # Po [2] MODI DANDA..MODI DOUBLE DANDA 1173C..1173E ; Sentence_Terminal # Po [3] AHOM SIGN SMALL SECTION..AHOM SIGN RULAI +11A42..11A43 ; Sentence_Terminal # Po [2] ZANABAZAR SQUARE MARK SHAD..ZANABAZAR SQUARE MARK DOUBLE SHAD +11A9B..11A9C ; Sentence_Terminal # Po [2] SOYOMBO MARK SHAD..SOYOMBO MARK DOUBLE SHAD 11C41..11C42 ; Sentence_Terminal # Po [2] BHAIKSUKI DANDA..BHAIKSUKI DOUBLE DANDA 16A6E..16A6F ; Sentence_Terminal # Po [2] MRO DANDA..MRO DOUBLE DANDA 16AF5 ; Sentence_Terminal # Po BASSA VAH FULL STOP @@ -1285,7 +1320,7 @@ FF61 ; Sentence_Terminal # Po HALFWIDTH IDEOGRAPHIC FULL STOP 1BC9F ; Sentence_Terminal # Po DUPLOYAN PUNCTUATION CHINOOK FULL STOP 1DA88 ; Sentence_Terminal # Po SIGNWRITING FULL STOP -# Total code points: 124 +# Total code points: 128 # ================================================ @@ -1402,9 +1437,7 @@ E0100..E01EF ; Variation_Selector # Mn [240] VARIATION SELECTOR-17..VARIATION S 239B..23B3 ; Pattern_Syntax # Sm [25] LEFT PARENTHESIS UPPER HOOK..SUMMATION BOTTOM 23B4..23DB ; Pattern_Syntax # So [40] TOP SQUARE BRACKET..FUSE 23DC..23E1 ; Pattern_Syntax # Sm [6] TOP PARENTHESIS..BOTTOM TORTOISE SHELL BRACKET -23E2..23FE ; Pattern_Syntax # So [29] WHITE TRAPEZIUM..POWER SLEEP SYMBOL -23FF ; Pattern_Syntax # Cn <reserved-23FF> -2400..2426 ; Pattern_Syntax # So [39] SYMBOL FOR NULL..SYMBOL FOR SUBSTITUTE FORM TWO +23E2..2426 ; Pattern_Syntax # So [69] WHITE TRAPEZIUM..SYMBOL FOR SUBSTITUTE FORM TWO 2427..243F ; Pattern_Syntax # Cn [25] <reserved-2427>..<reserved-243F> 2440..244A ; Pattern_Syntax # So [11] OCR HOOK..OCR DOUBLE BACKSLASH 244B..245F ; Pattern_Syntax # Cn [21] <reserved-244B>..<reserved-245F> @@ -1492,8 +1525,8 @@ E0100..E01EF ; Variation_Selector # Mn [240] VARIATION SELECTOR-17..VARIATION S 2BBA..2BBC ; Pattern_Syntax # Cn [3] <reserved-2BBA>..<reserved-2BBC> 2BBD..2BC8 ; Pattern_Syntax # So [12] BALLOT BOX WITH LIGHT X..BLACK MEDIUM RIGHT-POINTING TRIANGLE CENTRED 2BC9 ; Pattern_Syntax # Cn <reserved-2BC9> -2BCA..2BD1 ; Pattern_Syntax # So [8] TOP HALF BLACK CIRCLE..UNCERTAINTY SIGN -2BD2..2BEB ; Pattern_Syntax # Cn [26] <reserved-2BD2>..<reserved-2BEB> +2BCA..2BD2 ; Pattern_Syntax # So [9] TOP HALF BLACK CIRCLE..GROUP MARK +2BD3..2BEB ; Pattern_Syntax # Cn [25] <reserved-2BD3>..<reserved-2BEB> 2BEC..2BEF ; Pattern_Syntax # So [4] LEFTWARDS TWO-HEADED ARROW WITH TRIANGLE ARROWHEADS..DOWNWARDS TWO-HEADED ARROW WITH TRIANGLE ARROWHEADS 2BF0..2BFF ; Pattern_Syntax # Cn [16] <reserved-2BF0>..<reserved-2BFF> 2E00..2E01 ; Pattern_Syntax # Po [2] RIGHT ANGLE SUBSTITUTION MARKER..RIGHT ANGLE DOTTED SUBSTITUTION MARKER @@ -1533,8 +1566,8 @@ E0100..E01EF ; Variation_Selector # Mn [240] VARIATION SELECTOR-17..VARIATION S 2E40 ; Pattern_Syntax # Pd DOUBLE HYPHEN 2E41 ; Pattern_Syntax # Po REVERSED COMMA 2E42 ; Pattern_Syntax # Ps DOUBLE LOW-REVERSED-9 QUOTATION MARK -2E43..2E44 ; Pattern_Syntax # Po [2] DASH WITH LEFT UPTURN..DOUBLE SUSPENSION MARK -2E45..2E7F ; Pattern_Syntax # Cn [59] <reserved-2E45>..<reserved-2E7F> +2E43..2E49 ; Pattern_Syntax # Po [7] DASH WITH LEFT UPTURN..DOUBLE STACKED COMMA +2E4A..2E7F ; Pattern_Syntax # Cn [54] <reserved-2E4A>..<reserved-2E7F> 3001..3003 ; Pattern_Syntax # Po [3] IDEOGRAPHIC COMMA..DITTO MARK 3008 ; Pattern_Syntax # Ps LEFT ANGLE BRACKET 3009 ; Pattern_Syntax # Pe RIGHT ANGLE BRACKET @@ -1576,4 +1609,10 @@ FE45..FE46 ; Pattern_Syntax # Po [2] SESAME DOT..WHITE SESAME DOT # Total code points: 10 +# ================================================ + +1F1E6..1F1FF ; Regional_Indicator # So [26] REGIONAL INDICATOR SYMBOL LETTER A..REGIONAL INDICATOR SYMBOL LETTER Z + +# Total code points: 26 + # EOF diff --git a/lib/stdlib/uc_spec/SpecialCasing.txt b/lib/stdlib/uc_spec/SpecialCasing.txt index b23fa7f768..b9ba0d81c1 100644 --- a/lib/stdlib/uc_spec/SpecialCasing.txt +++ b/lib/stdlib/uc_spec/SpecialCasing.txt @@ -1,6 +1,6 @@ -# SpecialCasing-9.0.0.txt -# Date: 2016-03-02, 18:55:13 GMT -# © 2016 Unicode®, Inc. +# SpecialCasing-10.0.0.txt +# Date: 2017-04-14, 05:40:43 GMT +# © 2017 Unicode®, Inc. # Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries. # For terms of use, see http://www.unicode.org/terms_of_use.html # @@ -197,7 +197,7 @@ FB17; FB17; 0544 056D; 0544 053D; # ARMENIAN SMALL LIGATURE MEN XEH # ================================================================================ # Conditional Mappings -# The remainder of this file provides conditional casing data used to produce +# The remainder of this file provides conditional casing data used to produce # full case mappings. # ================================================================================ # Language-Insensitive Mappings diff --git a/lib/stdlib/uc_spec/UnicodeData.txt b/lib/stdlib/uc_spec/UnicodeData.txt index a756976461..d89c64f526 100644 --- a/lib/stdlib/uc_spec/UnicodeData.txt +++ b/lib/stdlib/uc_spec/UnicodeData.txt @@ -2072,6 +2072,17 @@ 085A;MANDAIC VOCALIZATION MARK;Mn;220;NSM;;;;;N;;;;; 085B;MANDAIC GEMINATION MARK;Mn;220;NSM;;;;;N;;;;; 085E;MANDAIC PUNCTUATION;Po;0;R;;;;;N;;;;; +0860;SYRIAC LETTER MALAYALAM NGA;Lo;0;AL;;;;;N;;;;; +0861;SYRIAC LETTER MALAYALAM JA;Lo;0;AL;;;;;N;;;;; +0862;SYRIAC LETTER MALAYALAM NYA;Lo;0;AL;;;;;N;;;;; +0863;SYRIAC LETTER MALAYALAM TTA;Lo;0;AL;;;;;N;;;;; +0864;SYRIAC LETTER MALAYALAM NNA;Lo;0;AL;;;;;N;;;;; +0865;SYRIAC LETTER MALAYALAM NNNA;Lo;0;AL;;;;;N;;;;; +0866;SYRIAC LETTER MALAYALAM BHA;Lo;0;AL;;;;;N;;;;; +0867;SYRIAC LETTER MALAYALAM RA;Lo;0;AL;;;;;N;;;;; +0868;SYRIAC LETTER MALAYALAM LLA;Lo;0;AL;;;;;N;;;;; +0869;SYRIAC LETTER MALAYALAM LLLA;Lo;0;AL;;;;;N;;;;; +086A;SYRIAC LETTER MALAYALAM SSA;Lo;0;AL;;;;;N;;;;; 08A0;ARABIC LETTER BEH WITH SMALL V BELOW;Lo;0;AL;;;;;N;;;;; 08A1;ARABIC LETTER BEH WITH HAMZA ABOVE;Lo;0;AL;;;;;N;;;;; 08A2;ARABIC LETTER JEEM WITH TWO DOTS ABOVE;Lo;0;AL;;;;;N;;;;; @@ -2366,6 +2377,8 @@ 09F9;BENGALI CURRENCY DENOMINATOR SIXTEEN;No;0;L;;;;16;N;;;;; 09FA;BENGALI ISSHAR;So;0;L;;;;;N;;;;; 09FB;BENGALI GANDA MARK;Sc;0;ET;;;;;N;;;;; +09FC;BENGALI LETTER VEDIC ANUSVARA;Lo;0;L;;;;;N;;;;; +09FD;BENGALI ABBREVIATION SIGN;Po;0;L;;;;;N;;;;; 0A01;GURMUKHI SIGN ADAK BINDI;Mn;0;NSM;;;;;N;;;;; 0A02;GURMUKHI SIGN BINDI;Mn;0;NSM;;;;;N;;;;; 0A03;GURMUKHI SIGN VISARGA;Mc;0;L;;;;;N;;;;; @@ -2530,6 +2543,12 @@ 0AF0;GUJARATI ABBREVIATION SIGN;Po;0;L;;;;;N;;;;; 0AF1;GUJARATI RUPEE SIGN;Sc;0;ET;;;;;N;;;;; 0AF9;GUJARATI LETTER ZHA;Lo;0;L;;;;;N;;;;; +0AFA;GUJARATI SIGN SUKUN;Mn;0;NSM;;;;;N;;;;; +0AFB;GUJARATI SIGN SHADDA;Mn;0;NSM;;;;;N;;;;; +0AFC;GUJARATI SIGN MADDAH;Mn;0;NSM;;;;;N;;;;; +0AFD;GUJARATI SIGN THREE-DOT NUKTA ABOVE;Mn;0;NSM;;;;;N;;;;; +0AFE;GUJARATI SIGN CIRCLE NUKTA ABOVE;Mn;0;NSM;;;;;N;;;;; +0AFF;GUJARATI SIGN TWO-CIRCLE NUKTA ABOVE;Mn;0;NSM;;;;;N;;;;; 0B01;ORIYA SIGN CANDRABINDU;Mn;0;NSM;;;;;N;;;;; 0B02;ORIYA SIGN ANUSVARA;Mc;0;L;;;;;N;;;;; 0B03;ORIYA SIGN VISARGA;Mc;0;L;;;;;N;;;;; @@ -2876,6 +2895,7 @@ 0CEF;KANNADA DIGIT NINE;Nd;0;L;;9;9;9;N;;;;; 0CF1;KANNADA SIGN JIHVAMULIYA;Lo;0;L;;;;;N;;;;; 0CF2;KANNADA SIGN UPADHMANIYA;Lo;0;L;;;;;N;;;;; +0D00;MALAYALAM SIGN COMBINING ANUSVARA ABOVE;Mn;0;NSM;;;;;N;;;;; 0D01;MALAYALAM SIGN CANDRABINDU;Mn;0;NSM;;;;;N;;;;; 0D02;MALAYALAM SIGN ANUSVARA;Mc;0;L;;;;;N;;;;; 0D03;MALAYALAM SIGN VISARGA;Mc;0;L;;;;;N;;;;; @@ -2931,6 +2951,8 @@ 0D38;MALAYALAM LETTER SA;Lo;0;L;;;;;N;;;;; 0D39;MALAYALAM LETTER HA;Lo;0;L;;;;;N;;;;; 0D3A;MALAYALAM LETTER TTTA;Lo;0;L;;;;;N;;;;; +0D3B;MALAYALAM SIGN VERTICAL BAR VIRAMA;Mn;9;NSM;;;;;N;;;;; +0D3C;MALAYALAM SIGN CIRCULAR VIRAMA;Mn;9;NSM;;;;;N;;;;; 0D3D;MALAYALAM SIGN AVAGRAHA;Lo;0;L;;;;;N;;;;; 0D3E;MALAYALAM VOWEL SIGN AA;Mc;0;L;;;;;N;;;;; 0D3F;MALAYALAM VOWEL SIGN I;Mc;0;L;;;;;N;;;;; @@ -6413,6 +6435,7 @@ 1CF4;VEDIC TONE CANDRA ABOVE;Mn;230;NSM;;;;;N;;;;; 1CF5;VEDIC SIGN JIHVAMULIYA;Lo;0;L;;;;;N;;;;; 1CF6;VEDIC SIGN UPADHMANIYA;Lo;0;L;;;;;N;;;;; +1CF7;VEDIC SIGN ATIKRAMA;Mc;0;L;;;;;N;;;;; 1CF8;VEDIC TONE RING ABOVE;Mn;230;NSM;;;;;N;;;;; 1CF9;VEDIC TONE DOUBLE RING ABOVE;Mn;230;NSM;;;;;N;;;;; 1D00;LATIN LETTER SMALL CAPITAL A;Ll;0;L;;;;;N;;;;; @@ -6661,6 +6684,10 @@ 1DF3;COMBINING LATIN SMALL LETTER O WITH DIAERESIS;Mn;230;NSM;;;;;N;;;;; 1DF4;COMBINING LATIN SMALL LETTER U WITH DIAERESIS;Mn;230;NSM;;;;;N;;;;; 1DF5;COMBINING UP TACK ABOVE;Mn;230;NSM;;;;;N;;;;; +1DF6;COMBINING KAVYKA ABOVE RIGHT;Mn;232;NSM;;;;;N;;;;; +1DF7;COMBINING KAVYKA ABOVE LEFT;Mn;228;NSM;;;;;N;;;;; +1DF8;COMBINING DOT ABOVE LEFT;Mn;228;NSM;;;;;N;;;;; +1DF9;COMBINING WIDE INVERTED BRIDGE BELOW;Mn;220;NSM;;;;;N;;;;; 1DFB;COMBINING DELETION MARK;Mn;230;NSM;;;;;N;;;;; 1DFC;COMBINING DOUBLE INVERTED BREVE BELOW;Mn;233;NSM;;;;;N;;;;; 1DFD;COMBINING ALMOST EQUAL TO BELOW;Mn;220;NSM;;;;;N;;;;; @@ -7339,6 +7366,7 @@ 20BC;MANAT SIGN;Sc;0;ET;;;;;N;;;;; 20BD;RUBLE SIGN;Sc;0;ET;;;;;N;;;;; 20BE;LARI SIGN;Sc;0;ET;;;;;N;;;;; +20BF;BITCOIN SIGN;Sc;0;ET;;;;;N;;;;; 20D0;COMBINING LEFT HARPOON ABOVE;Mn;230;NSM;;;;;N;NON-SPACING LEFT HARPOON ABOVE;;;; 20D1;COMBINING RIGHT HARPOON ABOVE;Mn;230;NSM;;;;;N;NON-SPACING RIGHT HARPOON ABOVE;;;; 20D2;COMBINING LONG VERTICAL LINE OVERLAY;Mn;1;NSM;;;;;N;NON-SPACING LONG VERTICAL BAR OVERLAY;;;; @@ -8135,6 +8163,7 @@ 23FC;POWER ON-OFF SYMBOL;So;0;ON;;;;;N;;;;; 23FD;POWER ON SYMBOL;So;0;ON;;;;;N;;;;; 23FE;POWER SLEEP SYMBOL;So;0;ON;;;;;N;;;;; +23FF;OBSERVER EYE SYMBOL;So;0;ON;;;;;N;;;;; 2400;SYMBOL FOR NULL;So;0;ON;;;;;N;GRAPHIC FOR NULL;;;; 2401;SYMBOL FOR START OF HEADING;So;0;ON;;;;;N;GRAPHIC FOR START OF HEADING;;;; 2402;SYMBOL FOR START OF TEXT;So;0;ON;;;;;N;GRAPHIC FOR START OF TEXT;;;; @@ -10083,6 +10112,7 @@ 2BCF;ROTATED WHITE FOUR POINTED CUSP;So;0;ON;;;;;N;;;;; 2BD0;SQUARE POSITION INDICATOR;So;0;ON;;;;;N;;;;; 2BD1;UNCERTAINTY SIGN;So;0;ON;;;;;N;;;;; +2BD2;GROUP MARK;So;0;ON;;;;;N;;;;; 2BEC;LEFTWARDS TWO-HEADED ARROW WITH TRIANGLE ARROWHEADS;So;0;ON;;;;;N;;;;; 2BED;UPWARDS TWO-HEADED ARROW WITH TRIANGLE ARROWHEADS;So;0;ON;;;;;N;;;;; 2BEE;RIGHTWARDS TWO-HEADED ARROW WITH TRIANGLE ARROWHEADS;So;0;ON;;;;;N;;;;; @@ -10615,6 +10645,11 @@ 2E42;DOUBLE LOW-REVERSED-9 QUOTATION MARK;Ps;0;ON;;;;;N;;;;; 2E43;DASH WITH LEFT UPTURN;Po;0;ON;;;;;N;;;;; 2E44;DOUBLE SUSPENSION MARK;Po;0;ON;;;;;N;;;;; +2E45;INVERTED LOW KAVYKA;Po;0;ON;;;;;N;;;;; +2E46;INVERTED LOW KAVYKA WITH KAVYKA ABOVE;Po;0;ON;;;;;N;;;;; +2E47;LOW KAVYKA;Po;0;ON;;;;;N;;;;; +2E48;LOW KAVYKA WITH DOT;Po;0;ON;;;;;N;;;;; +2E49;DOUBLE STACKED COMMA;Po;0;ON;;;;;N;;;;; 2E80;CJK RADICAL REPEAT;So;0;ON;;;;;N;;;;; 2E81;CJK RADICAL CLIFF;So;0;ON;;;;;N;;;;; 2E82;CJK RADICAL SECOND ONE;So;0;ON;;;;;N;;;;; @@ -11250,6 +11285,7 @@ 312B;BOPOMOFO LETTER NG;Lo;0;L;;;;;N;;;;; 312C;BOPOMOFO LETTER GN;Lo;0;L;;;;;N;;;;; 312D;BOPOMOFO LETTER IH;Lo;0;L;;;;;N;;;;; +312E;BOPOMOFO LETTER O WITH DOT ABOVE;Lo;0;L;;;;;N;;;;; 3131;HANGUL LETTER KIYEOK;Lo;0;L;<compat> 1100;;;;N;HANGUL LETTER GIYEOG;;;; 3132;HANGUL LETTER SSANGKIYEOK;Lo;0;L;<compat> 1101;;;;N;HANGUL LETTER SSANG GIYEOG;;;; 3133;HANGUL LETTER KIYEOK-SIOS;Lo;0;L;<compat> 11AA;;;;N;HANGUL LETTER GIYEOG SIOS;;;; @@ -12016,7 +12052,7 @@ 4DFE;HEXAGRAM FOR AFTER COMPLETION;So;0;ON;;;;;N;;;;; 4DFF;HEXAGRAM FOR BEFORE COMPLETION;So;0;ON;;;;;N;;;;; 4E00;<CJK Ideograph, First>;Lo;0;L;;;;;N;;;;; -9FD5;<CJK Ideograph, Last>;Lo;0;L;;;;;N;;;;; +9FEA;<CJK Ideograph, Last>;Lo;0;L;;;;;N;;;;; A000;YI SYLLABLE IT;Lo;0;L;;;;;N;;;;; A001;YI SYLLABLE IX;Lo;0;L;;;;;N;;;;; A002;YI SYLLABLE I;Lo;0;L;;;;;N;;;;; @@ -17093,6 +17129,9 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 10321;OLD ITALIC NUMERAL FIVE;No;0;L;;;;5;N;;;;; 10322;OLD ITALIC NUMERAL TEN;No;0;L;;;;10;N;;;;; 10323;OLD ITALIC NUMERAL FIFTY;No;0;L;;;;50;N;;;;; +1032D;OLD ITALIC LETTER YE;Lo;0;L;;;;;N;;;;; +1032E;OLD ITALIC LETTER NORTHERN TSE;Lo;0;L;;;;;N;;;;; +1032F;OLD ITALIC LETTER SOUTHERN TSE;Lo;0;L;;;;;N;;;;; 10330;GOTHIC LETTER AHSA;Lo;0;L;;;;;N;;;;; 10331;GOTHIC LETTER BAIRKAN;Lo;0;L;;;;;N;;;;; 10332;GOTHIC LETTER GIBA;Lo;0;L;;;;;N;;;;; @@ -20068,6 +20107,158 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 118F1;WARANG CITI NUMBER EIGHTY;No;0;L;;;;80;N;;;;; 118F2;WARANG CITI NUMBER NINETY;No;0;L;;;;90;N;;;;; 118FF;WARANG CITI OM;Lo;0;L;;;;;N;;;;; +11A00;ZANABAZAR SQUARE LETTER A;Lo;0;L;;;;;N;;;;; +11A01;ZANABAZAR SQUARE VOWEL SIGN I;Mn;0;NSM;;;;;N;;;;; +11A02;ZANABAZAR SQUARE VOWEL SIGN UE;Mn;0;NSM;;;;;N;;;;; +11A03;ZANABAZAR SQUARE VOWEL SIGN U;Mn;0;NSM;;;;;N;;;;; +11A04;ZANABAZAR SQUARE VOWEL SIGN E;Mn;0;NSM;;;;;N;;;;; +11A05;ZANABAZAR SQUARE VOWEL SIGN OE;Mn;0;NSM;;;;;N;;;;; +11A06;ZANABAZAR SQUARE VOWEL SIGN O;Mn;0;NSM;;;;;N;;;;; +11A07;ZANABAZAR SQUARE VOWEL SIGN AI;Mc;0;L;;;;;N;;;;; +11A08;ZANABAZAR SQUARE VOWEL SIGN AU;Mc;0;L;;;;;N;;;;; +11A09;ZANABAZAR SQUARE VOWEL SIGN REVERSED I;Mn;0;NSM;;;;;N;;;;; +11A0A;ZANABAZAR SQUARE VOWEL LENGTH MARK;Mn;0;NSM;;;;;N;;;;; +11A0B;ZANABAZAR SQUARE LETTER KA;Lo;0;L;;;;;N;;;;; +11A0C;ZANABAZAR SQUARE LETTER KHA;Lo;0;L;;;;;N;;;;; +11A0D;ZANABAZAR SQUARE LETTER GA;Lo;0;L;;;;;N;;;;; +11A0E;ZANABAZAR SQUARE LETTER GHA;Lo;0;L;;;;;N;;;;; +11A0F;ZANABAZAR SQUARE LETTER NGA;Lo;0;L;;;;;N;;;;; +11A10;ZANABAZAR SQUARE LETTER CA;Lo;0;L;;;;;N;;;;; +11A11;ZANABAZAR SQUARE LETTER CHA;Lo;0;L;;;;;N;;;;; +11A12;ZANABAZAR SQUARE LETTER JA;Lo;0;L;;;;;N;;;;; +11A13;ZANABAZAR SQUARE LETTER NYA;Lo;0;L;;;;;N;;;;; +11A14;ZANABAZAR SQUARE LETTER TTA;Lo;0;L;;;;;N;;;;; +11A15;ZANABAZAR SQUARE LETTER TTHA;Lo;0;L;;;;;N;;;;; +11A16;ZANABAZAR SQUARE LETTER DDA;Lo;0;L;;;;;N;;;;; +11A17;ZANABAZAR SQUARE LETTER DDHA;Lo;0;L;;;;;N;;;;; +11A18;ZANABAZAR SQUARE LETTER NNA;Lo;0;L;;;;;N;;;;; +11A19;ZANABAZAR SQUARE LETTER TA;Lo;0;L;;;;;N;;;;; +11A1A;ZANABAZAR SQUARE LETTER THA;Lo;0;L;;;;;N;;;;; +11A1B;ZANABAZAR SQUARE LETTER DA;Lo;0;L;;;;;N;;;;; +11A1C;ZANABAZAR SQUARE LETTER DHA;Lo;0;L;;;;;N;;;;; +11A1D;ZANABAZAR SQUARE LETTER NA;Lo;0;L;;;;;N;;;;; +11A1E;ZANABAZAR SQUARE LETTER PA;Lo;0;L;;;;;N;;;;; +11A1F;ZANABAZAR SQUARE LETTER PHA;Lo;0;L;;;;;N;;;;; +11A20;ZANABAZAR SQUARE LETTER BA;Lo;0;L;;;;;N;;;;; +11A21;ZANABAZAR SQUARE LETTER BHA;Lo;0;L;;;;;N;;;;; +11A22;ZANABAZAR SQUARE LETTER MA;Lo;0;L;;;;;N;;;;; +11A23;ZANABAZAR SQUARE LETTER TSA;Lo;0;L;;;;;N;;;;; +11A24;ZANABAZAR SQUARE LETTER TSHA;Lo;0;L;;;;;N;;;;; +11A25;ZANABAZAR SQUARE LETTER DZA;Lo;0;L;;;;;N;;;;; +11A26;ZANABAZAR SQUARE LETTER DZHA;Lo;0;L;;;;;N;;;;; +11A27;ZANABAZAR SQUARE LETTER ZHA;Lo;0;L;;;;;N;;;;; +11A28;ZANABAZAR SQUARE LETTER ZA;Lo;0;L;;;;;N;;;;; +11A29;ZANABAZAR SQUARE LETTER -A;Lo;0;L;;;;;N;;;;; +11A2A;ZANABAZAR SQUARE LETTER YA;Lo;0;L;;;;;N;;;;; +11A2B;ZANABAZAR SQUARE LETTER RA;Lo;0;L;;;;;N;;;;; +11A2C;ZANABAZAR SQUARE LETTER LA;Lo;0;L;;;;;N;;;;; +11A2D;ZANABAZAR SQUARE LETTER VA;Lo;0;L;;;;;N;;;;; +11A2E;ZANABAZAR SQUARE LETTER SHA;Lo;0;L;;;;;N;;;;; +11A2F;ZANABAZAR SQUARE LETTER SSA;Lo;0;L;;;;;N;;;;; +11A30;ZANABAZAR SQUARE LETTER SA;Lo;0;L;;;;;N;;;;; +11A31;ZANABAZAR SQUARE LETTER HA;Lo;0;L;;;;;N;;;;; +11A32;ZANABAZAR SQUARE LETTER KSSA;Lo;0;L;;;;;N;;;;; +11A33;ZANABAZAR SQUARE FINAL CONSONANT MARK;Mn;0;NSM;;;;;N;;;;; +11A34;ZANABAZAR SQUARE SIGN VIRAMA;Mn;9;NSM;;;;;N;;;;; +11A35;ZANABAZAR SQUARE SIGN CANDRABINDU;Mn;0;NSM;;;;;N;;;;; +11A36;ZANABAZAR SQUARE SIGN CANDRABINDU WITH ORNAMENT;Mn;0;NSM;;;;;N;;;;; +11A37;ZANABAZAR SQUARE SIGN CANDRA WITH ORNAMENT;Mn;0;NSM;;;;;N;;;;; +11A38;ZANABAZAR SQUARE SIGN ANUSVARA;Mn;0;NSM;;;;;N;;;;; +11A39;ZANABAZAR SQUARE SIGN VISARGA;Mc;0;L;;;;;N;;;;; +11A3A;ZANABAZAR SQUARE CLUSTER-INITIAL LETTER RA;Lo;0;L;;;;;N;;;;; +11A3B;ZANABAZAR SQUARE CLUSTER-FINAL LETTER YA;Mn;0;NSM;;;;;N;;;;; +11A3C;ZANABAZAR SQUARE CLUSTER-FINAL LETTER RA;Mn;0;NSM;;;;;N;;;;; +11A3D;ZANABAZAR SQUARE CLUSTER-FINAL LETTER LA;Mn;0;NSM;;;;;N;;;;; +11A3E;ZANABAZAR SQUARE CLUSTER-FINAL LETTER VA;Mn;0;NSM;;;;;N;;;;; +11A3F;ZANABAZAR SQUARE INITIAL HEAD MARK;Po;0;L;;;;;N;;;;; +11A40;ZANABAZAR SQUARE CLOSING HEAD MARK;Po;0;L;;;;;N;;;;; +11A41;ZANABAZAR SQUARE MARK TSHEG;Po;0;L;;;;;N;;;;; +11A42;ZANABAZAR SQUARE MARK SHAD;Po;0;L;;;;;N;;;;; +11A43;ZANABAZAR SQUARE MARK DOUBLE SHAD;Po;0;L;;;;;N;;;;; +11A44;ZANABAZAR SQUARE MARK LONG TSHEG;Po;0;L;;;;;N;;;;; +11A45;ZANABAZAR SQUARE INITIAL DOUBLE-LINED HEAD MARK;Po;0;L;;;;;N;;;;; +11A46;ZANABAZAR SQUARE CLOSING DOUBLE-LINED HEAD MARK;Po;0;L;;;;;N;;;;; +11A47;ZANABAZAR SQUARE SUBJOINER;Mn;9;NSM;;;;;N;;;;; +11A50;SOYOMBO LETTER A;Lo;0;L;;;;;N;;;;; +11A51;SOYOMBO VOWEL SIGN I;Mn;0;NSM;;;;;N;;;;; +11A52;SOYOMBO VOWEL SIGN UE;Mn;0;NSM;;;;;N;;;;; +11A53;SOYOMBO VOWEL SIGN U;Mn;0;NSM;;;;;N;;;;; +11A54;SOYOMBO VOWEL SIGN E;Mn;0;NSM;;;;;N;;;;; +11A55;SOYOMBO VOWEL SIGN O;Mn;0;NSM;;;;;N;;;;; +11A56;SOYOMBO VOWEL SIGN OE;Mn;0;NSM;;;;;N;;;;; +11A57;SOYOMBO VOWEL SIGN AI;Mc;0;L;;;;;N;;;;; +11A58;SOYOMBO VOWEL SIGN AU;Mc;0;L;;;;;N;;;;; +11A59;SOYOMBO VOWEL SIGN VOCALIC R;Mn;0;NSM;;;;;N;;;;; +11A5A;SOYOMBO VOWEL SIGN VOCALIC L;Mn;0;NSM;;;;;N;;;;; +11A5B;SOYOMBO VOWEL LENGTH MARK;Mn;0;NSM;;;;;N;;;;; +11A5C;SOYOMBO LETTER KA;Lo;0;L;;;;;N;;;;; +11A5D;SOYOMBO LETTER KHA;Lo;0;L;;;;;N;;;;; +11A5E;SOYOMBO LETTER GA;Lo;0;L;;;;;N;;;;; +11A5F;SOYOMBO LETTER GHA;Lo;0;L;;;;;N;;;;; +11A60;SOYOMBO LETTER NGA;Lo;0;L;;;;;N;;;;; +11A61;SOYOMBO LETTER CA;Lo;0;L;;;;;N;;;;; +11A62;SOYOMBO LETTER CHA;Lo;0;L;;;;;N;;;;; +11A63;SOYOMBO LETTER JA;Lo;0;L;;;;;N;;;;; +11A64;SOYOMBO LETTER JHA;Lo;0;L;;;;;N;;;;; +11A65;SOYOMBO LETTER NYA;Lo;0;L;;;;;N;;;;; +11A66;SOYOMBO LETTER TTA;Lo;0;L;;;;;N;;;;; +11A67;SOYOMBO LETTER TTHA;Lo;0;L;;;;;N;;;;; +11A68;SOYOMBO LETTER DDA;Lo;0;L;;;;;N;;;;; +11A69;SOYOMBO LETTER DDHA;Lo;0;L;;;;;N;;;;; +11A6A;SOYOMBO LETTER NNA;Lo;0;L;;;;;N;;;;; +11A6B;SOYOMBO LETTER TA;Lo;0;L;;;;;N;;;;; +11A6C;SOYOMBO LETTER THA;Lo;0;L;;;;;N;;;;; +11A6D;SOYOMBO LETTER DA;Lo;0;L;;;;;N;;;;; +11A6E;SOYOMBO LETTER DHA;Lo;0;L;;;;;N;;;;; +11A6F;SOYOMBO LETTER NA;Lo;0;L;;;;;N;;;;; +11A70;SOYOMBO LETTER PA;Lo;0;L;;;;;N;;;;; +11A71;SOYOMBO LETTER PHA;Lo;0;L;;;;;N;;;;; +11A72;SOYOMBO LETTER BA;Lo;0;L;;;;;N;;;;; +11A73;SOYOMBO LETTER BHA;Lo;0;L;;;;;N;;;;; +11A74;SOYOMBO LETTER MA;Lo;0;L;;;;;N;;;;; +11A75;SOYOMBO LETTER TSA;Lo;0;L;;;;;N;;;;; +11A76;SOYOMBO LETTER TSHA;Lo;0;L;;;;;N;;;;; +11A77;SOYOMBO LETTER DZA;Lo;0;L;;;;;N;;;;; +11A78;SOYOMBO LETTER ZHA;Lo;0;L;;;;;N;;;;; +11A79;SOYOMBO LETTER ZA;Lo;0;L;;;;;N;;;;; +11A7A;SOYOMBO LETTER -A;Lo;0;L;;;;;N;;;;; +11A7B;SOYOMBO LETTER YA;Lo;0;L;;;;;N;;;;; +11A7C;SOYOMBO LETTER RA;Lo;0;L;;;;;N;;;;; +11A7D;SOYOMBO LETTER LA;Lo;0;L;;;;;N;;;;; +11A7E;SOYOMBO LETTER VA;Lo;0;L;;;;;N;;;;; +11A7F;SOYOMBO LETTER SHA;Lo;0;L;;;;;N;;;;; +11A80;SOYOMBO LETTER SSA;Lo;0;L;;;;;N;;;;; +11A81;SOYOMBO LETTER SA;Lo;0;L;;;;;N;;;;; +11A82;SOYOMBO LETTER HA;Lo;0;L;;;;;N;;;;; +11A83;SOYOMBO LETTER KSSA;Lo;0;L;;;;;N;;;;; +11A86;SOYOMBO CLUSTER-INITIAL LETTER RA;Lo;0;L;;;;;N;;;;; +11A87;SOYOMBO CLUSTER-INITIAL LETTER LA;Lo;0;L;;;;;N;;;;; +11A88;SOYOMBO CLUSTER-INITIAL LETTER SHA;Lo;0;L;;;;;N;;;;; +11A89;SOYOMBO CLUSTER-INITIAL LETTER SA;Lo;0;L;;;;;N;;;;; +11A8A;SOYOMBO FINAL CONSONANT SIGN G;Mn;0;NSM;;;;;N;;;;; +11A8B;SOYOMBO FINAL CONSONANT SIGN K;Mn;0;NSM;;;;;N;;;;; +11A8C;SOYOMBO FINAL CONSONANT SIGN NG;Mn;0;NSM;;;;;N;;;;; +11A8D;SOYOMBO FINAL CONSONANT SIGN D;Mn;0;NSM;;;;;N;;;;; +11A8E;SOYOMBO FINAL CONSONANT SIGN N;Mn;0;NSM;;;;;N;;;;; +11A8F;SOYOMBO FINAL CONSONANT SIGN B;Mn;0;NSM;;;;;N;;;;; +11A90;SOYOMBO FINAL CONSONANT SIGN M;Mn;0;NSM;;;;;N;;;;; +11A91;SOYOMBO FINAL CONSONANT SIGN R;Mn;0;NSM;;;;;N;;;;; +11A92;SOYOMBO FINAL CONSONANT SIGN L;Mn;0;NSM;;;;;N;;;;; +11A93;SOYOMBO FINAL CONSONANT SIGN SH;Mn;0;NSM;;;;;N;;;;; +11A94;SOYOMBO FINAL CONSONANT SIGN S;Mn;0;NSM;;;;;N;;;;; +11A95;SOYOMBO FINAL CONSONANT SIGN -A;Mn;0;NSM;;;;;N;;;;; +11A96;SOYOMBO SIGN ANUSVARA;Mn;0;NSM;;;;;N;;;;; +11A97;SOYOMBO SIGN VISARGA;Mc;0;L;;;;;N;;;;; +11A98;SOYOMBO GEMINATION MARK;Mn;0;NSM;;;;;N;;;;; +11A99;SOYOMBO SUBJOINER;Mn;9;NSM;;;;;N;;;;; +11A9A;SOYOMBO MARK TSHEG;Po;0;L;;;;;N;;;;; +11A9B;SOYOMBO MARK SHAD;Po;0;L;;;;;N;;;;; +11A9C;SOYOMBO MARK DOUBLE SHAD;Po;0;L;;;;;N;;;;; +11A9E;SOYOMBO HEAD MARK WITH MOON AND SUN AND TRIPLE FLAME;Po;0;L;;;;;N;;;;; +11A9F;SOYOMBO HEAD MARK WITH MOON AND SUN AND FLAME;Po;0;L;;;;;N;;;;; +11AA0;SOYOMBO HEAD MARK WITH MOON AND SUN;Po;0;L;;;;;N;;;;; +11AA1;SOYOMBO TERMINAL MARK-1;Po;0;L;;;;;N;;;;; +11AA2;SOYOMBO TERMINAL MARK-2;Po;0;L;;;;;N;;;;; 11AC0;PAU CIN HAU LETTER PA;Lo;0;L;;;;;N;;;;; 11AC1;PAU CIN HAU LETTER KA;Lo;0;L;;;;;N;;;;; 11AC2;PAU CIN HAU LETTER LA;Lo;0;L;;;;;N;;;;; @@ -20290,6 +20481,81 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 11CB4;MARCHEN VOWEL SIGN O;Mc;0;L;;;;;N;;;;; 11CB5;MARCHEN SIGN ANUSVARA;Mn;0;NSM;;;;;N;;;;; 11CB6;MARCHEN SIGN CANDRABINDU;Mn;0;NSM;;;;;N;;;;; +11D00;MASARAM GONDI LETTER A;Lo;0;L;;;;;N;;;;; +11D01;MASARAM GONDI LETTER AA;Lo;0;L;;;;;N;;;;; +11D02;MASARAM GONDI LETTER I;Lo;0;L;;;;;N;;;;; +11D03;MASARAM GONDI LETTER II;Lo;0;L;;;;;N;;;;; +11D04;MASARAM GONDI LETTER U;Lo;0;L;;;;;N;;;;; +11D05;MASARAM GONDI LETTER UU;Lo;0;L;;;;;N;;;;; +11D06;MASARAM GONDI LETTER E;Lo;0;L;;;;;N;;;;; +11D08;MASARAM GONDI LETTER AI;Lo;0;L;;;;;N;;;;; +11D09;MASARAM GONDI LETTER O;Lo;0;L;;;;;N;;;;; +11D0B;MASARAM GONDI LETTER AU;Lo;0;L;;;;;N;;;;; +11D0C;MASARAM GONDI LETTER KA;Lo;0;L;;;;;N;;;;; +11D0D;MASARAM GONDI LETTER KHA;Lo;0;L;;;;;N;;;;; +11D0E;MASARAM GONDI LETTER GA;Lo;0;L;;;;;N;;;;; +11D0F;MASARAM GONDI LETTER GHA;Lo;0;L;;;;;N;;;;; +11D10;MASARAM GONDI LETTER NGA;Lo;0;L;;;;;N;;;;; +11D11;MASARAM GONDI LETTER CA;Lo;0;L;;;;;N;;;;; +11D12;MASARAM GONDI LETTER CHA;Lo;0;L;;;;;N;;;;; +11D13;MASARAM GONDI LETTER JA;Lo;0;L;;;;;N;;;;; +11D14;MASARAM GONDI LETTER JHA;Lo;0;L;;;;;N;;;;; +11D15;MASARAM GONDI LETTER NYA;Lo;0;L;;;;;N;;;;; +11D16;MASARAM GONDI LETTER TTA;Lo;0;L;;;;;N;;;;; +11D17;MASARAM GONDI LETTER TTHA;Lo;0;L;;;;;N;;;;; +11D18;MASARAM GONDI LETTER DDA;Lo;0;L;;;;;N;;;;; +11D19;MASARAM GONDI LETTER DDHA;Lo;0;L;;;;;N;;;;; +11D1A;MASARAM GONDI LETTER NNA;Lo;0;L;;;;;N;;;;; +11D1B;MASARAM GONDI LETTER TA;Lo;0;L;;;;;N;;;;; +11D1C;MASARAM GONDI LETTER THA;Lo;0;L;;;;;N;;;;; +11D1D;MASARAM GONDI LETTER DA;Lo;0;L;;;;;N;;;;; +11D1E;MASARAM GONDI LETTER DHA;Lo;0;L;;;;;N;;;;; +11D1F;MASARAM GONDI LETTER NA;Lo;0;L;;;;;N;;;;; +11D20;MASARAM GONDI LETTER PA;Lo;0;L;;;;;N;;;;; +11D21;MASARAM GONDI LETTER PHA;Lo;0;L;;;;;N;;;;; +11D22;MASARAM GONDI LETTER BA;Lo;0;L;;;;;N;;;;; +11D23;MASARAM GONDI LETTER BHA;Lo;0;L;;;;;N;;;;; +11D24;MASARAM GONDI LETTER MA;Lo;0;L;;;;;N;;;;; +11D25;MASARAM GONDI LETTER YA;Lo;0;L;;;;;N;;;;; +11D26;MASARAM GONDI LETTER RA;Lo;0;L;;;;;N;;;;; +11D27;MASARAM GONDI LETTER LA;Lo;0;L;;;;;N;;;;; +11D28;MASARAM GONDI LETTER VA;Lo;0;L;;;;;N;;;;; +11D29;MASARAM GONDI LETTER SHA;Lo;0;L;;;;;N;;;;; +11D2A;MASARAM GONDI LETTER SSA;Lo;0;L;;;;;N;;;;; +11D2B;MASARAM GONDI LETTER SA;Lo;0;L;;;;;N;;;;; +11D2C;MASARAM GONDI LETTER HA;Lo;0;L;;;;;N;;;;; +11D2D;MASARAM GONDI LETTER LLA;Lo;0;L;;;;;N;;;;; +11D2E;MASARAM GONDI LETTER KSSA;Lo;0;L;;;;;N;;;;; +11D2F;MASARAM GONDI LETTER JNYA;Lo;0;L;;;;;N;;;;; +11D30;MASARAM GONDI LETTER TRA;Lo;0;L;;;;;N;;;;; +11D31;MASARAM GONDI VOWEL SIGN AA;Mn;0;NSM;;;;;N;;;;; +11D32;MASARAM GONDI VOWEL SIGN I;Mn;0;NSM;;;;;N;;;;; +11D33;MASARAM GONDI VOWEL SIGN II;Mn;0;NSM;;;;;N;;;;; +11D34;MASARAM GONDI VOWEL SIGN U;Mn;0;NSM;;;;;N;;;;; +11D35;MASARAM GONDI VOWEL SIGN UU;Mn;0;NSM;;;;;N;;;;; +11D36;MASARAM GONDI VOWEL SIGN VOCALIC R;Mn;0;NSM;;;;;N;;;;; +11D3A;MASARAM GONDI VOWEL SIGN E;Mn;0;NSM;;;;;N;;;;; +11D3C;MASARAM GONDI VOWEL SIGN AI;Mn;0;NSM;;;;;N;;;;; +11D3D;MASARAM GONDI VOWEL SIGN O;Mn;0;NSM;;;;;N;;;;; +11D3F;MASARAM GONDI VOWEL SIGN AU;Mn;0;NSM;;;;;N;;;;; +11D40;MASARAM GONDI SIGN ANUSVARA;Mn;0;NSM;;;;;N;;;;; +11D41;MASARAM GONDI SIGN VISARGA;Mn;0;NSM;;;;;N;;;;; +11D42;MASARAM GONDI SIGN NUKTA;Mn;7;NSM;;;;;N;;;;; +11D43;MASARAM GONDI SIGN CANDRA;Mn;0;NSM;;;;;N;;;;; +11D44;MASARAM GONDI SIGN HALANTA;Mn;9;NSM;;;;;N;;;;; +11D45;MASARAM GONDI VIRAMA;Mn;9;NSM;;;;;N;;;;; +11D46;MASARAM GONDI REPHA;Lo;0;L;;;;;N;;;;; +11D47;MASARAM GONDI RA-KARA;Mn;0;NSM;;;;;N;;;;; +11D50;MASARAM GONDI DIGIT ZERO;Nd;0;L;;0;0;0;N;;;;; +11D51;MASARAM GONDI DIGIT ONE;Nd;0;L;;1;1;1;N;;;;; +11D52;MASARAM GONDI DIGIT TWO;Nd;0;L;;2;2;2;N;;;;; +11D53;MASARAM GONDI DIGIT THREE;Nd;0;L;;3;3;3;N;;;;; +11D54;MASARAM GONDI DIGIT FOUR;Nd;0;L;;4;4;4;N;;;;; +11D55;MASARAM GONDI DIGIT FIVE;Nd;0;L;;5;5;5;N;;;;; +11D56;MASARAM GONDI DIGIT SIX;Nd;0;L;;6;6;6;N;;;;; +11D57;MASARAM GONDI DIGIT SEVEN;Nd;0;L;;7;7;7;N;;;;; +11D58;MASARAM GONDI DIGIT EIGHT;Nd;0;L;;8;8;8;N;;;;; +11D59;MASARAM GONDI DIGIT NINE;Nd;0;L;;9;9;9;N;;;;; 12000;CUNEIFORM SIGN A;Lo;0;L;;;;;N;;;;; 12001;CUNEIFORM SIGN A TIMES A;Lo;0;L;;;;;N;;;;; 12002;CUNEIFORM SIGN A TIMES BAD;Lo;0;L;;;;;N;;;;; @@ -24087,6 +24353,7 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 16F9E;MIAO LETTER REFORMED TONE-6;Lm;0;L;;;;;N;;;;; 16F9F;MIAO LETTER REFORMED TONE-8;Lm;0;L;;;;;N;;;;; 16FE0;TANGUT ITERATION MARK;Lm;0;L;;;;;N;;;;; +16FE1;NUSHU ITERATION MARK;Lm;0;L;;;;;N;;;;; 17000;<Tangut Ideograph, First>;Lo;0;L;;;;;N;;;;; 187EC;<Tangut Ideograph, Last>;Lo;0;L;;;;;N;;;;; 18800;TANGUT COMPONENT-001;Lo;0;L;;;;;N;;;;; @@ -24846,6 +25113,687 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 18AF2;TANGUT COMPONENT-755;Lo;0;L;;;;;N;;;;; 1B000;KATAKANA LETTER ARCHAIC E;Lo;0;L;;;;;N;;;;; 1B001;HIRAGANA LETTER ARCHAIC YE;Lo;0;L;;;;;N;;;;; +1B002;HENTAIGANA LETTER A-1;Lo;0;L;;;;;N;;;;; +1B003;HENTAIGANA LETTER A-2;Lo;0;L;;;;;N;;;;; +1B004;HENTAIGANA LETTER A-3;Lo;0;L;;;;;N;;;;; +1B005;HENTAIGANA LETTER A-WO;Lo;0;L;;;;;N;;;;; +1B006;HENTAIGANA LETTER I-1;Lo;0;L;;;;;N;;;;; +1B007;HENTAIGANA LETTER I-2;Lo;0;L;;;;;N;;;;; +1B008;HENTAIGANA LETTER I-3;Lo;0;L;;;;;N;;;;; +1B009;HENTAIGANA LETTER I-4;Lo;0;L;;;;;N;;;;; +1B00A;HENTAIGANA LETTER U-1;Lo;0;L;;;;;N;;;;; +1B00B;HENTAIGANA LETTER U-2;Lo;0;L;;;;;N;;;;; +1B00C;HENTAIGANA LETTER U-3;Lo;0;L;;;;;N;;;;; +1B00D;HENTAIGANA LETTER U-4;Lo;0;L;;;;;N;;;;; +1B00E;HENTAIGANA LETTER U-5;Lo;0;L;;;;;N;;;;; +1B00F;HENTAIGANA LETTER E-2;Lo;0;L;;;;;N;;;;; +1B010;HENTAIGANA LETTER E-3;Lo;0;L;;;;;N;;;;; +1B011;HENTAIGANA LETTER E-4;Lo;0;L;;;;;N;;;;; +1B012;HENTAIGANA LETTER E-5;Lo;0;L;;;;;N;;;;; +1B013;HENTAIGANA LETTER E-6;Lo;0;L;;;;;N;;;;; +1B014;HENTAIGANA LETTER O-1;Lo;0;L;;;;;N;;;;; +1B015;HENTAIGANA LETTER O-2;Lo;0;L;;;;;N;;;;; +1B016;HENTAIGANA LETTER O-3;Lo;0;L;;;;;N;;;;; +1B017;HENTAIGANA LETTER KA-1;Lo;0;L;;;;;N;;;;; +1B018;HENTAIGANA LETTER KA-2;Lo;0;L;;;;;N;;;;; +1B019;HENTAIGANA LETTER KA-3;Lo;0;L;;;;;N;;;;; +1B01A;HENTAIGANA LETTER KA-4;Lo;0;L;;;;;N;;;;; +1B01B;HENTAIGANA LETTER KA-5;Lo;0;L;;;;;N;;;;; +1B01C;HENTAIGANA LETTER KA-6;Lo;0;L;;;;;N;;;;; +1B01D;HENTAIGANA LETTER KA-7;Lo;0;L;;;;;N;;;;; +1B01E;HENTAIGANA LETTER KA-8;Lo;0;L;;;;;N;;;;; +1B01F;HENTAIGANA LETTER KA-9;Lo;0;L;;;;;N;;;;; +1B020;HENTAIGANA LETTER KA-10;Lo;0;L;;;;;N;;;;; +1B021;HENTAIGANA LETTER KA-11;Lo;0;L;;;;;N;;;;; +1B022;HENTAIGANA LETTER KA-KE;Lo;0;L;;;;;N;;;;; +1B023;HENTAIGANA LETTER KI-1;Lo;0;L;;;;;N;;;;; +1B024;HENTAIGANA LETTER KI-2;Lo;0;L;;;;;N;;;;; +1B025;HENTAIGANA LETTER KI-3;Lo;0;L;;;;;N;;;;; +1B026;HENTAIGANA LETTER KI-4;Lo;0;L;;;;;N;;;;; +1B027;HENTAIGANA LETTER KI-5;Lo;0;L;;;;;N;;;;; +1B028;HENTAIGANA LETTER KI-6;Lo;0;L;;;;;N;;;;; +1B029;HENTAIGANA LETTER KI-7;Lo;0;L;;;;;N;;;;; +1B02A;HENTAIGANA LETTER KI-8;Lo;0;L;;;;;N;;;;; +1B02B;HENTAIGANA LETTER KU-1;Lo;0;L;;;;;N;;;;; +1B02C;HENTAIGANA LETTER KU-2;Lo;0;L;;;;;N;;;;; +1B02D;HENTAIGANA LETTER KU-3;Lo;0;L;;;;;N;;;;; +1B02E;HENTAIGANA LETTER KU-4;Lo;0;L;;;;;N;;;;; +1B02F;HENTAIGANA LETTER KU-5;Lo;0;L;;;;;N;;;;; +1B030;HENTAIGANA LETTER KU-6;Lo;0;L;;;;;N;;;;; +1B031;HENTAIGANA LETTER KU-7;Lo;0;L;;;;;N;;;;; +1B032;HENTAIGANA LETTER KE-1;Lo;0;L;;;;;N;;;;; +1B033;HENTAIGANA LETTER KE-2;Lo;0;L;;;;;N;;;;; +1B034;HENTAIGANA LETTER KE-3;Lo;0;L;;;;;N;;;;; +1B035;HENTAIGANA LETTER KE-4;Lo;0;L;;;;;N;;;;; +1B036;HENTAIGANA LETTER KE-5;Lo;0;L;;;;;N;;;;; +1B037;HENTAIGANA LETTER KE-6;Lo;0;L;;;;;N;;;;; +1B038;HENTAIGANA LETTER KO-1;Lo;0;L;;;;;N;;;;; +1B039;HENTAIGANA LETTER KO-2;Lo;0;L;;;;;N;;;;; +1B03A;HENTAIGANA LETTER KO-3;Lo;0;L;;;;;N;;;;; +1B03B;HENTAIGANA LETTER KO-KI;Lo;0;L;;;;;N;;;;; +1B03C;HENTAIGANA LETTER SA-1;Lo;0;L;;;;;N;;;;; +1B03D;HENTAIGANA LETTER SA-2;Lo;0;L;;;;;N;;;;; +1B03E;HENTAIGANA LETTER SA-3;Lo;0;L;;;;;N;;;;; +1B03F;HENTAIGANA LETTER SA-4;Lo;0;L;;;;;N;;;;; +1B040;HENTAIGANA LETTER SA-5;Lo;0;L;;;;;N;;;;; +1B041;HENTAIGANA LETTER SA-6;Lo;0;L;;;;;N;;;;; +1B042;HENTAIGANA LETTER SA-7;Lo;0;L;;;;;N;;;;; +1B043;HENTAIGANA LETTER SA-8;Lo;0;L;;;;;N;;;;; +1B044;HENTAIGANA LETTER SI-1;Lo;0;L;;;;;N;;;;; +1B045;HENTAIGANA LETTER SI-2;Lo;0;L;;;;;N;;;;; +1B046;HENTAIGANA LETTER SI-3;Lo;0;L;;;;;N;;;;; +1B047;HENTAIGANA LETTER SI-4;Lo;0;L;;;;;N;;;;; +1B048;HENTAIGANA LETTER SI-5;Lo;0;L;;;;;N;;;;; +1B049;HENTAIGANA LETTER SI-6;Lo;0;L;;;;;N;;;;; +1B04A;HENTAIGANA LETTER SU-1;Lo;0;L;;;;;N;;;;; +1B04B;HENTAIGANA LETTER SU-2;Lo;0;L;;;;;N;;;;; +1B04C;HENTAIGANA LETTER SU-3;Lo;0;L;;;;;N;;;;; +1B04D;HENTAIGANA LETTER SU-4;Lo;0;L;;;;;N;;;;; +1B04E;HENTAIGANA LETTER SU-5;Lo;0;L;;;;;N;;;;; +1B04F;HENTAIGANA LETTER SU-6;Lo;0;L;;;;;N;;;;; +1B050;HENTAIGANA LETTER SU-7;Lo;0;L;;;;;N;;;;; +1B051;HENTAIGANA LETTER SU-8;Lo;0;L;;;;;N;;;;; +1B052;HENTAIGANA LETTER SE-1;Lo;0;L;;;;;N;;;;; +1B053;HENTAIGANA LETTER SE-2;Lo;0;L;;;;;N;;;;; +1B054;HENTAIGANA LETTER SE-3;Lo;0;L;;;;;N;;;;; +1B055;HENTAIGANA LETTER SE-4;Lo;0;L;;;;;N;;;;; +1B056;HENTAIGANA LETTER SE-5;Lo;0;L;;;;;N;;;;; +1B057;HENTAIGANA LETTER SO-1;Lo;0;L;;;;;N;;;;; +1B058;HENTAIGANA LETTER SO-2;Lo;0;L;;;;;N;;;;; +1B059;HENTAIGANA LETTER SO-3;Lo;0;L;;;;;N;;;;; +1B05A;HENTAIGANA LETTER SO-4;Lo;0;L;;;;;N;;;;; +1B05B;HENTAIGANA LETTER SO-5;Lo;0;L;;;;;N;;;;; +1B05C;HENTAIGANA LETTER SO-6;Lo;0;L;;;;;N;;;;; +1B05D;HENTAIGANA LETTER SO-7;Lo;0;L;;;;;N;;;;; +1B05E;HENTAIGANA LETTER TA-1;Lo;0;L;;;;;N;;;;; +1B05F;HENTAIGANA LETTER TA-2;Lo;0;L;;;;;N;;;;; +1B060;HENTAIGANA LETTER TA-3;Lo;0;L;;;;;N;;;;; +1B061;HENTAIGANA LETTER TA-4;Lo;0;L;;;;;N;;;;; +1B062;HENTAIGANA LETTER TI-1;Lo;0;L;;;;;N;;;;; +1B063;HENTAIGANA LETTER TI-2;Lo;0;L;;;;;N;;;;; +1B064;HENTAIGANA LETTER TI-3;Lo;0;L;;;;;N;;;;; +1B065;HENTAIGANA LETTER TI-4;Lo;0;L;;;;;N;;;;; +1B066;HENTAIGANA LETTER TI-5;Lo;0;L;;;;;N;;;;; +1B067;HENTAIGANA LETTER TI-6;Lo;0;L;;;;;N;;;;; +1B068;HENTAIGANA LETTER TI-7;Lo;0;L;;;;;N;;;;; +1B069;HENTAIGANA LETTER TU-1;Lo;0;L;;;;;N;;;;; +1B06A;HENTAIGANA LETTER TU-2;Lo;0;L;;;;;N;;;;; +1B06B;HENTAIGANA LETTER TU-3;Lo;0;L;;;;;N;;;;; +1B06C;HENTAIGANA LETTER TU-4;Lo;0;L;;;;;N;;;;; +1B06D;HENTAIGANA LETTER TU-TO;Lo;0;L;;;;;N;;;;; +1B06E;HENTAIGANA LETTER TE-1;Lo;0;L;;;;;N;;;;; +1B06F;HENTAIGANA LETTER TE-2;Lo;0;L;;;;;N;;;;; +1B070;HENTAIGANA LETTER TE-3;Lo;0;L;;;;;N;;;;; +1B071;HENTAIGANA LETTER TE-4;Lo;0;L;;;;;N;;;;; +1B072;HENTAIGANA LETTER TE-5;Lo;0;L;;;;;N;;;;; +1B073;HENTAIGANA LETTER TE-6;Lo;0;L;;;;;N;;;;; +1B074;HENTAIGANA LETTER TE-7;Lo;0;L;;;;;N;;;;; +1B075;HENTAIGANA LETTER TE-8;Lo;0;L;;;;;N;;;;; +1B076;HENTAIGANA LETTER TE-9;Lo;0;L;;;;;N;;;;; +1B077;HENTAIGANA LETTER TO-1;Lo;0;L;;;;;N;;;;; +1B078;HENTAIGANA LETTER TO-2;Lo;0;L;;;;;N;;;;; +1B079;HENTAIGANA LETTER TO-3;Lo;0;L;;;;;N;;;;; +1B07A;HENTAIGANA LETTER TO-4;Lo;0;L;;;;;N;;;;; +1B07B;HENTAIGANA LETTER TO-5;Lo;0;L;;;;;N;;;;; +1B07C;HENTAIGANA LETTER TO-6;Lo;0;L;;;;;N;;;;; +1B07D;HENTAIGANA LETTER TO-RA;Lo;0;L;;;;;N;;;;; +1B07E;HENTAIGANA LETTER NA-1;Lo;0;L;;;;;N;;;;; +1B07F;HENTAIGANA LETTER NA-2;Lo;0;L;;;;;N;;;;; +1B080;HENTAIGANA LETTER NA-3;Lo;0;L;;;;;N;;;;; +1B081;HENTAIGANA LETTER NA-4;Lo;0;L;;;;;N;;;;; +1B082;HENTAIGANA LETTER NA-5;Lo;0;L;;;;;N;;;;; +1B083;HENTAIGANA LETTER NA-6;Lo;0;L;;;;;N;;;;; +1B084;HENTAIGANA LETTER NA-7;Lo;0;L;;;;;N;;;;; +1B085;HENTAIGANA LETTER NA-8;Lo;0;L;;;;;N;;;;; +1B086;HENTAIGANA LETTER NA-9;Lo;0;L;;;;;N;;;;; +1B087;HENTAIGANA LETTER NI-1;Lo;0;L;;;;;N;;;;; +1B088;HENTAIGANA LETTER NI-2;Lo;0;L;;;;;N;;;;; +1B089;HENTAIGANA LETTER NI-3;Lo;0;L;;;;;N;;;;; +1B08A;HENTAIGANA LETTER NI-4;Lo;0;L;;;;;N;;;;; +1B08B;HENTAIGANA LETTER NI-5;Lo;0;L;;;;;N;;;;; +1B08C;HENTAIGANA LETTER NI-6;Lo;0;L;;;;;N;;;;; +1B08D;HENTAIGANA LETTER NI-7;Lo;0;L;;;;;N;;;;; +1B08E;HENTAIGANA LETTER NI-TE;Lo;0;L;;;;;N;;;;; +1B08F;HENTAIGANA LETTER NU-1;Lo;0;L;;;;;N;;;;; +1B090;HENTAIGANA LETTER NU-2;Lo;0;L;;;;;N;;;;; +1B091;HENTAIGANA LETTER NU-3;Lo;0;L;;;;;N;;;;; +1B092;HENTAIGANA LETTER NE-1;Lo;0;L;;;;;N;;;;; +1B093;HENTAIGANA LETTER NE-2;Lo;0;L;;;;;N;;;;; +1B094;HENTAIGANA LETTER NE-3;Lo;0;L;;;;;N;;;;; +1B095;HENTAIGANA LETTER NE-4;Lo;0;L;;;;;N;;;;; +1B096;HENTAIGANA LETTER NE-5;Lo;0;L;;;;;N;;;;; +1B097;HENTAIGANA LETTER NE-6;Lo;0;L;;;;;N;;;;; +1B098;HENTAIGANA LETTER NE-KO;Lo;0;L;;;;;N;;;;; +1B099;HENTAIGANA LETTER NO-1;Lo;0;L;;;;;N;;;;; +1B09A;HENTAIGANA LETTER NO-2;Lo;0;L;;;;;N;;;;; +1B09B;HENTAIGANA LETTER NO-3;Lo;0;L;;;;;N;;;;; +1B09C;HENTAIGANA LETTER NO-4;Lo;0;L;;;;;N;;;;; +1B09D;HENTAIGANA LETTER NO-5;Lo;0;L;;;;;N;;;;; +1B09E;HENTAIGANA LETTER HA-1;Lo;0;L;;;;;N;;;;; +1B09F;HENTAIGANA LETTER HA-2;Lo;0;L;;;;;N;;;;; +1B0A0;HENTAIGANA LETTER HA-3;Lo;0;L;;;;;N;;;;; +1B0A1;HENTAIGANA LETTER HA-4;Lo;0;L;;;;;N;;;;; +1B0A2;HENTAIGANA LETTER HA-5;Lo;0;L;;;;;N;;;;; +1B0A3;HENTAIGANA LETTER HA-6;Lo;0;L;;;;;N;;;;; +1B0A4;HENTAIGANA LETTER HA-7;Lo;0;L;;;;;N;;;;; +1B0A5;HENTAIGANA LETTER HA-8;Lo;0;L;;;;;N;;;;; +1B0A6;HENTAIGANA LETTER HA-9;Lo;0;L;;;;;N;;;;; +1B0A7;HENTAIGANA LETTER HA-10;Lo;0;L;;;;;N;;;;; +1B0A8;HENTAIGANA LETTER HA-11;Lo;0;L;;;;;N;;;;; +1B0A9;HENTAIGANA LETTER HI-1;Lo;0;L;;;;;N;;;;; +1B0AA;HENTAIGANA LETTER HI-2;Lo;0;L;;;;;N;;;;; +1B0AB;HENTAIGANA LETTER HI-3;Lo;0;L;;;;;N;;;;; +1B0AC;HENTAIGANA LETTER HI-4;Lo;0;L;;;;;N;;;;; +1B0AD;HENTAIGANA LETTER HI-5;Lo;0;L;;;;;N;;;;; +1B0AE;HENTAIGANA LETTER HI-6;Lo;0;L;;;;;N;;;;; +1B0AF;HENTAIGANA LETTER HI-7;Lo;0;L;;;;;N;;;;; +1B0B0;HENTAIGANA LETTER HU-1;Lo;0;L;;;;;N;;;;; +1B0B1;HENTAIGANA LETTER HU-2;Lo;0;L;;;;;N;;;;; +1B0B2;HENTAIGANA LETTER HU-3;Lo;0;L;;;;;N;;;;; +1B0B3;HENTAIGANA LETTER HE-1;Lo;0;L;;;;;N;;;;; +1B0B4;HENTAIGANA LETTER HE-2;Lo;0;L;;;;;N;;;;; +1B0B5;HENTAIGANA LETTER HE-3;Lo;0;L;;;;;N;;;;; +1B0B6;HENTAIGANA LETTER HE-4;Lo;0;L;;;;;N;;;;; +1B0B7;HENTAIGANA LETTER HE-5;Lo;0;L;;;;;N;;;;; +1B0B8;HENTAIGANA LETTER HE-6;Lo;0;L;;;;;N;;;;; +1B0B9;HENTAIGANA LETTER HE-7;Lo;0;L;;;;;N;;;;; +1B0BA;HENTAIGANA LETTER HO-1;Lo;0;L;;;;;N;;;;; +1B0BB;HENTAIGANA LETTER HO-2;Lo;0;L;;;;;N;;;;; +1B0BC;HENTAIGANA LETTER HO-3;Lo;0;L;;;;;N;;;;; +1B0BD;HENTAIGANA LETTER HO-4;Lo;0;L;;;;;N;;;;; +1B0BE;HENTAIGANA LETTER HO-5;Lo;0;L;;;;;N;;;;; +1B0BF;HENTAIGANA LETTER HO-6;Lo;0;L;;;;;N;;;;; +1B0C0;HENTAIGANA LETTER HO-7;Lo;0;L;;;;;N;;;;; +1B0C1;HENTAIGANA LETTER HO-8;Lo;0;L;;;;;N;;;;; +1B0C2;HENTAIGANA LETTER MA-1;Lo;0;L;;;;;N;;;;; +1B0C3;HENTAIGANA LETTER MA-2;Lo;0;L;;;;;N;;;;; +1B0C4;HENTAIGANA LETTER MA-3;Lo;0;L;;;;;N;;;;; +1B0C5;HENTAIGANA LETTER MA-4;Lo;0;L;;;;;N;;;;; +1B0C6;HENTAIGANA LETTER MA-5;Lo;0;L;;;;;N;;;;; +1B0C7;HENTAIGANA LETTER MA-6;Lo;0;L;;;;;N;;;;; +1B0C8;HENTAIGANA LETTER MA-7;Lo;0;L;;;;;N;;;;; +1B0C9;HENTAIGANA LETTER MI-1;Lo;0;L;;;;;N;;;;; +1B0CA;HENTAIGANA LETTER MI-2;Lo;0;L;;;;;N;;;;; +1B0CB;HENTAIGANA LETTER MI-3;Lo;0;L;;;;;N;;;;; +1B0CC;HENTAIGANA LETTER MI-4;Lo;0;L;;;;;N;;;;; +1B0CD;HENTAIGANA LETTER MI-5;Lo;0;L;;;;;N;;;;; +1B0CE;HENTAIGANA LETTER MI-6;Lo;0;L;;;;;N;;;;; +1B0CF;HENTAIGANA LETTER MI-7;Lo;0;L;;;;;N;;;;; +1B0D0;HENTAIGANA LETTER MU-1;Lo;0;L;;;;;N;;;;; +1B0D1;HENTAIGANA LETTER MU-2;Lo;0;L;;;;;N;;;;; +1B0D2;HENTAIGANA LETTER MU-3;Lo;0;L;;;;;N;;;;; +1B0D3;HENTAIGANA LETTER MU-4;Lo;0;L;;;;;N;;;;; +1B0D4;HENTAIGANA LETTER ME-1;Lo;0;L;;;;;N;;;;; +1B0D5;HENTAIGANA LETTER ME-2;Lo;0;L;;;;;N;;;;; +1B0D6;HENTAIGANA LETTER ME-MA;Lo;0;L;;;;;N;;;;; +1B0D7;HENTAIGANA LETTER MO-1;Lo;0;L;;;;;N;;;;; +1B0D8;HENTAIGANA LETTER MO-2;Lo;0;L;;;;;N;;;;; +1B0D9;HENTAIGANA LETTER MO-3;Lo;0;L;;;;;N;;;;; +1B0DA;HENTAIGANA LETTER MO-4;Lo;0;L;;;;;N;;;;; +1B0DB;HENTAIGANA LETTER MO-5;Lo;0;L;;;;;N;;;;; +1B0DC;HENTAIGANA LETTER MO-6;Lo;0;L;;;;;N;;;;; +1B0DD;HENTAIGANA LETTER YA-1;Lo;0;L;;;;;N;;;;; +1B0DE;HENTAIGANA LETTER YA-2;Lo;0;L;;;;;N;;;;; +1B0DF;HENTAIGANA LETTER YA-3;Lo;0;L;;;;;N;;;;; +1B0E0;HENTAIGANA LETTER YA-4;Lo;0;L;;;;;N;;;;; +1B0E1;HENTAIGANA LETTER YA-5;Lo;0;L;;;;;N;;;;; +1B0E2;HENTAIGANA LETTER YA-YO;Lo;0;L;;;;;N;;;;; +1B0E3;HENTAIGANA LETTER YU-1;Lo;0;L;;;;;N;;;;; +1B0E4;HENTAIGANA LETTER YU-2;Lo;0;L;;;;;N;;;;; +1B0E5;HENTAIGANA LETTER YU-3;Lo;0;L;;;;;N;;;;; +1B0E6;HENTAIGANA LETTER YU-4;Lo;0;L;;;;;N;;;;; +1B0E7;HENTAIGANA LETTER YO-1;Lo;0;L;;;;;N;;;;; +1B0E8;HENTAIGANA LETTER YO-2;Lo;0;L;;;;;N;;;;; +1B0E9;HENTAIGANA LETTER YO-3;Lo;0;L;;;;;N;;;;; +1B0EA;HENTAIGANA LETTER YO-4;Lo;0;L;;;;;N;;;;; +1B0EB;HENTAIGANA LETTER YO-5;Lo;0;L;;;;;N;;;;; +1B0EC;HENTAIGANA LETTER YO-6;Lo;0;L;;;;;N;;;;; +1B0ED;HENTAIGANA LETTER RA-1;Lo;0;L;;;;;N;;;;; +1B0EE;HENTAIGANA LETTER RA-2;Lo;0;L;;;;;N;;;;; +1B0EF;HENTAIGANA LETTER RA-3;Lo;0;L;;;;;N;;;;; +1B0F0;HENTAIGANA LETTER RA-4;Lo;0;L;;;;;N;;;;; +1B0F1;HENTAIGANA LETTER RI-1;Lo;0;L;;;;;N;;;;; +1B0F2;HENTAIGANA LETTER RI-2;Lo;0;L;;;;;N;;;;; +1B0F3;HENTAIGANA LETTER RI-3;Lo;0;L;;;;;N;;;;; +1B0F4;HENTAIGANA LETTER RI-4;Lo;0;L;;;;;N;;;;; +1B0F5;HENTAIGANA LETTER RI-5;Lo;0;L;;;;;N;;;;; +1B0F6;HENTAIGANA LETTER RI-6;Lo;0;L;;;;;N;;;;; +1B0F7;HENTAIGANA LETTER RI-7;Lo;0;L;;;;;N;;;;; +1B0F8;HENTAIGANA LETTER RU-1;Lo;0;L;;;;;N;;;;; +1B0F9;HENTAIGANA LETTER RU-2;Lo;0;L;;;;;N;;;;; +1B0FA;HENTAIGANA LETTER RU-3;Lo;0;L;;;;;N;;;;; +1B0FB;HENTAIGANA LETTER RU-4;Lo;0;L;;;;;N;;;;; +1B0FC;HENTAIGANA LETTER RU-5;Lo;0;L;;;;;N;;;;; +1B0FD;HENTAIGANA LETTER RU-6;Lo;0;L;;;;;N;;;;; +1B0FE;HENTAIGANA LETTER RE-1;Lo;0;L;;;;;N;;;;; +1B0FF;HENTAIGANA LETTER RE-2;Lo;0;L;;;;;N;;;;; +1B100;HENTAIGANA LETTER RE-3;Lo;0;L;;;;;N;;;;; +1B101;HENTAIGANA LETTER RE-4;Lo;0;L;;;;;N;;;;; +1B102;HENTAIGANA LETTER RO-1;Lo;0;L;;;;;N;;;;; +1B103;HENTAIGANA LETTER RO-2;Lo;0;L;;;;;N;;;;; +1B104;HENTAIGANA LETTER RO-3;Lo;0;L;;;;;N;;;;; +1B105;HENTAIGANA LETTER RO-4;Lo;0;L;;;;;N;;;;; +1B106;HENTAIGANA LETTER RO-5;Lo;0;L;;;;;N;;;;; +1B107;HENTAIGANA LETTER RO-6;Lo;0;L;;;;;N;;;;; +1B108;HENTAIGANA LETTER WA-1;Lo;0;L;;;;;N;;;;; +1B109;HENTAIGANA LETTER WA-2;Lo;0;L;;;;;N;;;;; +1B10A;HENTAIGANA LETTER WA-3;Lo;0;L;;;;;N;;;;; +1B10B;HENTAIGANA LETTER WA-4;Lo;0;L;;;;;N;;;;; +1B10C;HENTAIGANA LETTER WA-5;Lo;0;L;;;;;N;;;;; +1B10D;HENTAIGANA LETTER WI-1;Lo;0;L;;;;;N;;;;; +1B10E;HENTAIGANA LETTER WI-2;Lo;0;L;;;;;N;;;;; +1B10F;HENTAIGANA LETTER WI-3;Lo;0;L;;;;;N;;;;; +1B110;HENTAIGANA LETTER WI-4;Lo;0;L;;;;;N;;;;; +1B111;HENTAIGANA LETTER WI-5;Lo;0;L;;;;;N;;;;; +1B112;HENTAIGANA LETTER WE-1;Lo;0;L;;;;;N;;;;; +1B113;HENTAIGANA LETTER WE-2;Lo;0;L;;;;;N;;;;; +1B114;HENTAIGANA LETTER WE-3;Lo;0;L;;;;;N;;;;; +1B115;HENTAIGANA LETTER WE-4;Lo;0;L;;;;;N;;;;; +1B116;HENTAIGANA LETTER WO-1;Lo;0;L;;;;;N;;;;; +1B117;HENTAIGANA LETTER WO-2;Lo;0;L;;;;;N;;;;; +1B118;HENTAIGANA LETTER WO-3;Lo;0;L;;;;;N;;;;; +1B119;HENTAIGANA LETTER WO-4;Lo;0;L;;;;;N;;;;; +1B11A;HENTAIGANA LETTER WO-5;Lo;0;L;;;;;N;;;;; +1B11B;HENTAIGANA LETTER WO-6;Lo;0;L;;;;;N;;;;; +1B11C;HENTAIGANA LETTER WO-7;Lo;0;L;;;;;N;;;;; +1B11D;HENTAIGANA LETTER N-MU-MO-1;Lo;0;L;;;;;N;;;;; +1B11E;HENTAIGANA LETTER N-MU-MO-2;Lo;0;L;;;;;N;;;;; +1B170;NUSHU CHARACTER-1B170;Lo;0;L;;;;;N;;;;; +1B171;NUSHU CHARACTER-1B171;Lo;0;L;;;;;N;;;;; +1B172;NUSHU CHARACTER-1B172;Lo;0;L;;;;;N;;;;; +1B173;NUSHU CHARACTER-1B173;Lo;0;L;;;;;N;;;;; +1B174;NUSHU CHARACTER-1B174;Lo;0;L;;;;;N;;;;; +1B175;NUSHU CHARACTER-1B175;Lo;0;L;;;;;N;;;;; +1B176;NUSHU CHARACTER-1B176;Lo;0;L;;;;;N;;;;; +1B177;NUSHU CHARACTER-1B177;Lo;0;L;;;;;N;;;;; +1B178;NUSHU CHARACTER-1B178;Lo;0;L;;;;;N;;;;; +1B179;NUSHU CHARACTER-1B179;Lo;0;L;;;;;N;;;;; +1B17A;NUSHU CHARACTER-1B17A;Lo;0;L;;;;;N;;;;; +1B17B;NUSHU CHARACTER-1B17B;Lo;0;L;;;;;N;;;;; +1B17C;NUSHU CHARACTER-1B17C;Lo;0;L;;;;;N;;;;; +1B17D;NUSHU CHARACTER-1B17D;Lo;0;L;;;;;N;;;;; +1B17E;NUSHU CHARACTER-1B17E;Lo;0;L;;;;;N;;;;; +1B17F;NUSHU CHARACTER-1B17F;Lo;0;L;;;;;N;;;;; +1B180;NUSHU CHARACTER-1B180;Lo;0;L;;;;;N;;;;; +1B181;NUSHU CHARACTER-1B181;Lo;0;L;;;;;N;;;;; +1B182;NUSHU CHARACTER-1B182;Lo;0;L;;;;;N;;;;; +1B183;NUSHU CHARACTER-1B183;Lo;0;L;;;;;N;;;;; +1B184;NUSHU CHARACTER-1B184;Lo;0;L;;;;;N;;;;; +1B185;NUSHU CHARACTER-1B185;Lo;0;L;;;;;N;;;;; +1B186;NUSHU CHARACTER-1B186;Lo;0;L;;;;;N;;;;; +1B187;NUSHU CHARACTER-1B187;Lo;0;L;;;;;N;;;;; +1B188;NUSHU CHARACTER-1B188;Lo;0;L;;;;;N;;;;; +1B189;NUSHU CHARACTER-1B189;Lo;0;L;;;;;N;;;;; +1B18A;NUSHU CHARACTER-1B18A;Lo;0;L;;;;;N;;;;; +1B18B;NUSHU CHARACTER-1B18B;Lo;0;L;;;;;N;;;;; +1B18C;NUSHU CHARACTER-1B18C;Lo;0;L;;;;;N;;;;; +1B18D;NUSHU CHARACTER-1B18D;Lo;0;L;;;;;N;;;;; +1B18E;NUSHU CHARACTER-1B18E;Lo;0;L;;;;;N;;;;; +1B18F;NUSHU CHARACTER-1B18F;Lo;0;L;;;;;N;;;;; +1B190;NUSHU CHARACTER-1B190;Lo;0;L;;;;;N;;;;; +1B191;NUSHU CHARACTER-1B191;Lo;0;L;;;;;N;;;;; +1B192;NUSHU CHARACTER-1B192;Lo;0;L;;;;;N;;;;; +1B193;NUSHU CHARACTER-1B193;Lo;0;L;;;;;N;;;;; +1B194;NUSHU CHARACTER-1B194;Lo;0;L;;;;;N;;;;; +1B195;NUSHU CHARACTER-1B195;Lo;0;L;;;;;N;;;;; +1B196;NUSHU CHARACTER-1B196;Lo;0;L;;;;;N;;;;; +1B197;NUSHU CHARACTER-1B197;Lo;0;L;;;;;N;;;;; +1B198;NUSHU CHARACTER-1B198;Lo;0;L;;;;;N;;;;; +1B199;NUSHU CHARACTER-1B199;Lo;0;L;;;;;N;;;;; +1B19A;NUSHU CHARACTER-1B19A;Lo;0;L;;;;;N;;;;; +1B19B;NUSHU CHARACTER-1B19B;Lo;0;L;;;;;N;;;;; +1B19C;NUSHU CHARACTER-1B19C;Lo;0;L;;;;;N;;;;; +1B19D;NUSHU CHARACTER-1B19D;Lo;0;L;;;;;N;;;;; +1B19E;NUSHU CHARACTER-1B19E;Lo;0;L;;;;;N;;;;; +1B19F;NUSHU CHARACTER-1B19F;Lo;0;L;;;;;N;;;;; +1B1A0;NUSHU CHARACTER-1B1A0;Lo;0;L;;;;;N;;;;; +1B1A1;NUSHU CHARACTER-1B1A1;Lo;0;L;;;;;N;;;;; +1B1A2;NUSHU CHARACTER-1B1A2;Lo;0;L;;;;;N;;;;; +1B1A3;NUSHU CHARACTER-1B1A3;Lo;0;L;;;;;N;;;;; +1B1A4;NUSHU CHARACTER-1B1A4;Lo;0;L;;;;;N;;;;; +1B1A5;NUSHU CHARACTER-1B1A5;Lo;0;L;;;;;N;;;;; +1B1A6;NUSHU CHARACTER-1B1A6;Lo;0;L;;;;;N;;;;; +1B1A7;NUSHU CHARACTER-1B1A7;Lo;0;L;;;;;N;;;;; +1B1A8;NUSHU CHARACTER-1B1A8;Lo;0;L;;;;;N;;;;; +1B1A9;NUSHU CHARACTER-1B1A9;Lo;0;L;;;;;N;;;;; +1B1AA;NUSHU CHARACTER-1B1AA;Lo;0;L;;;;;N;;;;; +1B1AB;NUSHU CHARACTER-1B1AB;Lo;0;L;;;;;N;;;;; +1B1AC;NUSHU CHARACTER-1B1AC;Lo;0;L;;;;;N;;;;; +1B1AD;NUSHU CHARACTER-1B1AD;Lo;0;L;;;;;N;;;;; +1B1AE;NUSHU CHARACTER-1B1AE;Lo;0;L;;;;;N;;;;; +1B1AF;NUSHU CHARACTER-1B1AF;Lo;0;L;;;;;N;;;;; +1B1B0;NUSHU CHARACTER-1B1B0;Lo;0;L;;;;;N;;;;; +1B1B1;NUSHU CHARACTER-1B1B1;Lo;0;L;;;;;N;;;;; +1B1B2;NUSHU CHARACTER-1B1B2;Lo;0;L;;;;;N;;;;; +1B1B3;NUSHU CHARACTER-1B1B3;Lo;0;L;;;;;N;;;;; +1B1B4;NUSHU CHARACTER-1B1B4;Lo;0;L;;;;;N;;;;; +1B1B5;NUSHU CHARACTER-1B1B5;Lo;0;L;;;;;N;;;;; +1B1B6;NUSHU CHARACTER-1B1B6;Lo;0;L;;;;;N;;;;; +1B1B7;NUSHU CHARACTER-1B1B7;Lo;0;L;;;;;N;;;;; +1B1B8;NUSHU CHARACTER-1B1B8;Lo;0;L;;;;;N;;;;; +1B1B9;NUSHU CHARACTER-1B1B9;Lo;0;L;;;;;N;;;;; +1B1BA;NUSHU CHARACTER-1B1BA;Lo;0;L;;;;;N;;;;; +1B1BB;NUSHU CHARACTER-1B1BB;Lo;0;L;;;;;N;;;;; +1B1BC;NUSHU CHARACTER-1B1BC;Lo;0;L;;;;;N;;;;; +1B1BD;NUSHU CHARACTER-1B1BD;Lo;0;L;;;;;N;;;;; +1B1BE;NUSHU CHARACTER-1B1BE;Lo;0;L;;;;;N;;;;; +1B1BF;NUSHU CHARACTER-1B1BF;Lo;0;L;;;;;N;;;;; +1B1C0;NUSHU CHARACTER-1B1C0;Lo;0;L;;;;;N;;;;; +1B1C1;NUSHU CHARACTER-1B1C1;Lo;0;L;;;;;N;;;;; +1B1C2;NUSHU CHARACTER-1B1C2;Lo;0;L;;;;;N;;;;; +1B1C3;NUSHU CHARACTER-1B1C3;Lo;0;L;;;;;N;;;;; +1B1C4;NUSHU CHARACTER-1B1C4;Lo;0;L;;;;;N;;;;; +1B1C5;NUSHU CHARACTER-1B1C5;Lo;0;L;;;;;N;;;;; +1B1C6;NUSHU CHARACTER-1B1C6;Lo;0;L;;;;;N;;;;; +1B1C7;NUSHU CHARACTER-1B1C7;Lo;0;L;;;;;N;;;;; +1B1C8;NUSHU CHARACTER-1B1C8;Lo;0;L;;;;;N;;;;; +1B1C9;NUSHU CHARACTER-1B1C9;Lo;0;L;;;;;N;;;;; +1B1CA;NUSHU CHARACTER-1B1CA;Lo;0;L;;;;;N;;;;; +1B1CB;NUSHU CHARACTER-1B1CB;Lo;0;L;;;;;N;;;;; +1B1CC;NUSHU CHARACTER-1B1CC;Lo;0;L;;;;;N;;;;; +1B1CD;NUSHU CHARACTER-1B1CD;Lo;0;L;;;;;N;;;;; +1B1CE;NUSHU CHARACTER-1B1CE;Lo;0;L;;;;;N;;;;; +1B1CF;NUSHU CHARACTER-1B1CF;Lo;0;L;;;;;N;;;;; +1B1D0;NUSHU CHARACTER-1B1D0;Lo;0;L;;;;;N;;;;; +1B1D1;NUSHU CHARACTER-1B1D1;Lo;0;L;;;;;N;;;;; +1B1D2;NUSHU CHARACTER-1B1D2;Lo;0;L;;;;;N;;;;; +1B1D3;NUSHU CHARACTER-1B1D3;Lo;0;L;;;;;N;;;;; +1B1D4;NUSHU CHARACTER-1B1D4;Lo;0;L;;;;;N;;;;; +1B1D5;NUSHU CHARACTER-1B1D5;Lo;0;L;;;;;N;;;;; +1B1D6;NUSHU CHARACTER-1B1D6;Lo;0;L;;;;;N;;;;; +1B1D7;NUSHU CHARACTER-1B1D7;Lo;0;L;;;;;N;;;;; +1B1D8;NUSHU CHARACTER-1B1D8;Lo;0;L;;;;;N;;;;; +1B1D9;NUSHU CHARACTER-1B1D9;Lo;0;L;;;;;N;;;;; +1B1DA;NUSHU CHARACTER-1B1DA;Lo;0;L;;;;;N;;;;; +1B1DB;NUSHU CHARACTER-1B1DB;Lo;0;L;;;;;N;;;;; +1B1DC;NUSHU CHARACTER-1B1DC;Lo;0;L;;;;;N;;;;; +1B1DD;NUSHU CHARACTER-1B1DD;Lo;0;L;;;;;N;;;;; +1B1DE;NUSHU CHARACTER-1B1DE;Lo;0;L;;;;;N;;;;; +1B1DF;NUSHU CHARACTER-1B1DF;Lo;0;L;;;;;N;;;;; +1B1E0;NUSHU CHARACTER-1B1E0;Lo;0;L;;;;;N;;;;; +1B1E1;NUSHU CHARACTER-1B1E1;Lo;0;L;;;;;N;;;;; +1B1E2;NUSHU CHARACTER-1B1E2;Lo;0;L;;;;;N;;;;; +1B1E3;NUSHU CHARACTER-1B1E3;Lo;0;L;;;;;N;;;;; +1B1E4;NUSHU CHARACTER-1B1E4;Lo;0;L;;;;;N;;;;; +1B1E5;NUSHU CHARACTER-1B1E5;Lo;0;L;;;;;N;;;;; +1B1E6;NUSHU CHARACTER-1B1E6;Lo;0;L;;;;;N;;;;; +1B1E7;NUSHU CHARACTER-1B1E7;Lo;0;L;;;;;N;;;;; +1B1E8;NUSHU CHARACTER-1B1E8;Lo;0;L;;;;;N;;;;; +1B1E9;NUSHU CHARACTER-1B1E9;Lo;0;L;;;;;N;;;;; +1B1EA;NUSHU CHARACTER-1B1EA;Lo;0;L;;;;;N;;;;; +1B1EB;NUSHU CHARACTER-1B1EB;Lo;0;L;;;;;N;;;;; +1B1EC;NUSHU CHARACTER-1B1EC;Lo;0;L;;;;;N;;;;; +1B1ED;NUSHU CHARACTER-1B1ED;Lo;0;L;;;;;N;;;;; +1B1EE;NUSHU CHARACTER-1B1EE;Lo;0;L;;;;;N;;;;; +1B1EF;NUSHU CHARACTER-1B1EF;Lo;0;L;;;;;N;;;;; +1B1F0;NUSHU CHARACTER-1B1F0;Lo;0;L;;;;;N;;;;; +1B1F1;NUSHU CHARACTER-1B1F1;Lo;0;L;;;;;N;;;;; +1B1F2;NUSHU CHARACTER-1B1F2;Lo;0;L;;;;;N;;;;; +1B1F3;NUSHU CHARACTER-1B1F3;Lo;0;L;;;;;N;;;;; +1B1F4;NUSHU CHARACTER-1B1F4;Lo;0;L;;;;;N;;;;; +1B1F5;NUSHU CHARACTER-1B1F5;Lo;0;L;;;;;N;;;;; +1B1F6;NUSHU CHARACTER-1B1F6;Lo;0;L;;;;;N;;;;; +1B1F7;NUSHU CHARACTER-1B1F7;Lo;0;L;;;;;N;;;;; +1B1F8;NUSHU CHARACTER-1B1F8;Lo;0;L;;;;;N;;;;; +1B1F9;NUSHU CHARACTER-1B1F9;Lo;0;L;;;;;N;;;;; +1B1FA;NUSHU CHARACTER-1B1FA;Lo;0;L;;;;;N;;;;; +1B1FB;NUSHU CHARACTER-1B1FB;Lo;0;L;;;;;N;;;;; +1B1FC;NUSHU CHARACTER-1B1FC;Lo;0;L;;;;;N;;;;; +1B1FD;NUSHU CHARACTER-1B1FD;Lo;0;L;;;;;N;;;;; +1B1FE;NUSHU CHARACTER-1B1FE;Lo;0;L;;;;;N;;;;; +1B1FF;NUSHU CHARACTER-1B1FF;Lo;0;L;;;;;N;;;;; +1B200;NUSHU CHARACTER-1B200;Lo;0;L;;;;;N;;;;; +1B201;NUSHU CHARACTER-1B201;Lo;0;L;;;;;N;;;;; +1B202;NUSHU CHARACTER-1B202;Lo;0;L;;;;;N;;;;; +1B203;NUSHU CHARACTER-1B203;Lo;0;L;;;;;N;;;;; +1B204;NUSHU CHARACTER-1B204;Lo;0;L;;;;;N;;;;; +1B205;NUSHU CHARACTER-1B205;Lo;0;L;;;;;N;;;;; +1B206;NUSHU CHARACTER-1B206;Lo;0;L;;;;;N;;;;; +1B207;NUSHU CHARACTER-1B207;Lo;0;L;;;;;N;;;;; +1B208;NUSHU CHARACTER-1B208;Lo;0;L;;;;;N;;;;; +1B209;NUSHU CHARACTER-1B209;Lo;0;L;;;;;N;;;;; +1B20A;NUSHU CHARACTER-1B20A;Lo;0;L;;;;;N;;;;; +1B20B;NUSHU CHARACTER-1B20B;Lo;0;L;;;;;N;;;;; +1B20C;NUSHU CHARACTER-1B20C;Lo;0;L;;;;;N;;;;; +1B20D;NUSHU CHARACTER-1B20D;Lo;0;L;;;;;N;;;;; +1B20E;NUSHU CHARACTER-1B20E;Lo;0;L;;;;;N;;;;; +1B20F;NUSHU CHARACTER-1B20F;Lo;0;L;;;;;N;;;;; +1B210;NUSHU CHARACTER-1B210;Lo;0;L;;;;;N;;;;; +1B211;NUSHU CHARACTER-1B211;Lo;0;L;;;;;N;;;;; +1B212;NUSHU CHARACTER-1B212;Lo;0;L;;;;;N;;;;; +1B213;NUSHU CHARACTER-1B213;Lo;0;L;;;;;N;;;;; +1B214;NUSHU CHARACTER-1B214;Lo;0;L;;;;;N;;;;; +1B215;NUSHU CHARACTER-1B215;Lo;0;L;;;;;N;;;;; +1B216;NUSHU CHARACTER-1B216;Lo;0;L;;;;;N;;;;; +1B217;NUSHU CHARACTER-1B217;Lo;0;L;;;;;N;;;;; +1B218;NUSHU CHARACTER-1B218;Lo;0;L;;;;;N;;;;; +1B219;NUSHU CHARACTER-1B219;Lo;0;L;;;;;N;;;;; +1B21A;NUSHU CHARACTER-1B21A;Lo;0;L;;;;;N;;;;; +1B21B;NUSHU CHARACTER-1B21B;Lo;0;L;;;;;N;;;;; +1B21C;NUSHU CHARACTER-1B21C;Lo;0;L;;;;;N;;;;; +1B21D;NUSHU CHARACTER-1B21D;Lo;0;L;;;;;N;;;;; +1B21E;NUSHU CHARACTER-1B21E;Lo;0;L;;;;;N;;;;; +1B21F;NUSHU CHARACTER-1B21F;Lo;0;L;;;;;N;;;;; +1B220;NUSHU CHARACTER-1B220;Lo;0;L;;;;;N;;;;; +1B221;NUSHU CHARACTER-1B221;Lo;0;L;;;;;N;;;;; +1B222;NUSHU CHARACTER-1B222;Lo;0;L;;;;;N;;;;; +1B223;NUSHU CHARACTER-1B223;Lo;0;L;;;;;N;;;;; +1B224;NUSHU CHARACTER-1B224;Lo;0;L;;;;;N;;;;; +1B225;NUSHU CHARACTER-1B225;Lo;0;L;;;;;N;;;;; +1B226;NUSHU CHARACTER-1B226;Lo;0;L;;;;;N;;;;; +1B227;NUSHU CHARACTER-1B227;Lo;0;L;;;;;N;;;;; +1B228;NUSHU CHARACTER-1B228;Lo;0;L;;;;;N;;;;; +1B229;NUSHU CHARACTER-1B229;Lo;0;L;;;;;N;;;;; +1B22A;NUSHU CHARACTER-1B22A;Lo;0;L;;;;;N;;;;; +1B22B;NUSHU CHARACTER-1B22B;Lo;0;L;;;;;N;;;;; +1B22C;NUSHU CHARACTER-1B22C;Lo;0;L;;;;;N;;;;; +1B22D;NUSHU CHARACTER-1B22D;Lo;0;L;;;;;N;;;;; +1B22E;NUSHU CHARACTER-1B22E;Lo;0;L;;;;;N;;;;; +1B22F;NUSHU CHARACTER-1B22F;Lo;0;L;;;;;N;;;;; +1B230;NUSHU CHARACTER-1B230;Lo;0;L;;;;;N;;;;; +1B231;NUSHU CHARACTER-1B231;Lo;0;L;;;;;N;;;;; +1B232;NUSHU CHARACTER-1B232;Lo;0;L;;;;;N;;;;; +1B233;NUSHU CHARACTER-1B233;Lo;0;L;;;;;N;;;;; +1B234;NUSHU CHARACTER-1B234;Lo;0;L;;;;;N;;;;; +1B235;NUSHU CHARACTER-1B235;Lo;0;L;;;;;N;;;;; +1B236;NUSHU CHARACTER-1B236;Lo;0;L;;;;;N;;;;; +1B237;NUSHU CHARACTER-1B237;Lo;0;L;;;;;N;;;;; +1B238;NUSHU CHARACTER-1B238;Lo;0;L;;;;;N;;;;; +1B239;NUSHU CHARACTER-1B239;Lo;0;L;;;;;N;;;;; +1B23A;NUSHU CHARACTER-1B23A;Lo;0;L;;;;;N;;;;; +1B23B;NUSHU CHARACTER-1B23B;Lo;0;L;;;;;N;;;;; +1B23C;NUSHU CHARACTER-1B23C;Lo;0;L;;;;;N;;;;; +1B23D;NUSHU CHARACTER-1B23D;Lo;0;L;;;;;N;;;;; +1B23E;NUSHU CHARACTER-1B23E;Lo;0;L;;;;;N;;;;; +1B23F;NUSHU CHARACTER-1B23F;Lo;0;L;;;;;N;;;;; +1B240;NUSHU CHARACTER-1B240;Lo;0;L;;;;;N;;;;; +1B241;NUSHU CHARACTER-1B241;Lo;0;L;;;;;N;;;;; +1B242;NUSHU CHARACTER-1B242;Lo;0;L;;;;;N;;;;; +1B243;NUSHU CHARACTER-1B243;Lo;0;L;;;;;N;;;;; +1B244;NUSHU CHARACTER-1B244;Lo;0;L;;;;;N;;;;; +1B245;NUSHU CHARACTER-1B245;Lo;0;L;;;;;N;;;;; +1B246;NUSHU CHARACTER-1B246;Lo;0;L;;;;;N;;;;; +1B247;NUSHU CHARACTER-1B247;Lo;0;L;;;;;N;;;;; +1B248;NUSHU CHARACTER-1B248;Lo;0;L;;;;;N;;;;; +1B249;NUSHU CHARACTER-1B249;Lo;0;L;;;;;N;;;;; +1B24A;NUSHU CHARACTER-1B24A;Lo;0;L;;;;;N;;;;; +1B24B;NUSHU CHARACTER-1B24B;Lo;0;L;;;;;N;;;;; +1B24C;NUSHU CHARACTER-1B24C;Lo;0;L;;;;;N;;;;; +1B24D;NUSHU CHARACTER-1B24D;Lo;0;L;;;;;N;;;;; +1B24E;NUSHU CHARACTER-1B24E;Lo;0;L;;;;;N;;;;; +1B24F;NUSHU CHARACTER-1B24F;Lo;0;L;;;;;N;;;;; +1B250;NUSHU CHARACTER-1B250;Lo;0;L;;;;;N;;;;; +1B251;NUSHU CHARACTER-1B251;Lo;0;L;;;;;N;;;;; +1B252;NUSHU CHARACTER-1B252;Lo;0;L;;;;;N;;;;; +1B253;NUSHU CHARACTER-1B253;Lo;0;L;;;;;N;;;;; +1B254;NUSHU CHARACTER-1B254;Lo;0;L;;;;;N;;;;; +1B255;NUSHU CHARACTER-1B255;Lo;0;L;;;;;N;;;;; +1B256;NUSHU CHARACTER-1B256;Lo;0;L;;;;;N;;;;; +1B257;NUSHU CHARACTER-1B257;Lo;0;L;;;;;N;;;;; +1B258;NUSHU CHARACTER-1B258;Lo;0;L;;;;;N;;;;; +1B259;NUSHU CHARACTER-1B259;Lo;0;L;;;;;N;;;;; +1B25A;NUSHU CHARACTER-1B25A;Lo;0;L;;;;;N;;;;; +1B25B;NUSHU CHARACTER-1B25B;Lo;0;L;;;;;N;;;;; +1B25C;NUSHU CHARACTER-1B25C;Lo;0;L;;;;;N;;;;; +1B25D;NUSHU CHARACTER-1B25D;Lo;0;L;;;;;N;;;;; +1B25E;NUSHU CHARACTER-1B25E;Lo;0;L;;;;;N;;;;; +1B25F;NUSHU CHARACTER-1B25F;Lo;0;L;;;;;N;;;;; +1B260;NUSHU CHARACTER-1B260;Lo;0;L;;;;;N;;;;; +1B261;NUSHU CHARACTER-1B261;Lo;0;L;;;;;N;;;;; +1B262;NUSHU CHARACTER-1B262;Lo;0;L;;;;;N;;;;; +1B263;NUSHU CHARACTER-1B263;Lo;0;L;;;;;N;;;;; +1B264;NUSHU CHARACTER-1B264;Lo;0;L;;;;;N;;;;; +1B265;NUSHU CHARACTER-1B265;Lo;0;L;;;;;N;;;;; +1B266;NUSHU CHARACTER-1B266;Lo;0;L;;;;;N;;;;; +1B267;NUSHU CHARACTER-1B267;Lo;0;L;;;;;N;;;;; +1B268;NUSHU CHARACTER-1B268;Lo;0;L;;;;;N;;;;; +1B269;NUSHU CHARACTER-1B269;Lo;0;L;;;;;N;;;;; +1B26A;NUSHU CHARACTER-1B26A;Lo;0;L;;;;;N;;;;; +1B26B;NUSHU CHARACTER-1B26B;Lo;0;L;;;;;N;;;;; +1B26C;NUSHU CHARACTER-1B26C;Lo;0;L;;;;;N;;;;; +1B26D;NUSHU CHARACTER-1B26D;Lo;0;L;;;;;N;;;;; +1B26E;NUSHU CHARACTER-1B26E;Lo;0;L;;;;;N;;;;; +1B26F;NUSHU CHARACTER-1B26F;Lo;0;L;;;;;N;;;;; +1B270;NUSHU CHARACTER-1B270;Lo;0;L;;;;;N;;;;; +1B271;NUSHU CHARACTER-1B271;Lo;0;L;;;;;N;;;;; +1B272;NUSHU CHARACTER-1B272;Lo;0;L;;;;;N;;;;; +1B273;NUSHU CHARACTER-1B273;Lo;0;L;;;;;N;;;;; +1B274;NUSHU CHARACTER-1B274;Lo;0;L;;;;;N;;;;; +1B275;NUSHU CHARACTER-1B275;Lo;0;L;;;;;N;;;;; +1B276;NUSHU CHARACTER-1B276;Lo;0;L;;;;;N;;;;; +1B277;NUSHU CHARACTER-1B277;Lo;0;L;;;;;N;;;;; +1B278;NUSHU CHARACTER-1B278;Lo;0;L;;;;;N;;;;; +1B279;NUSHU CHARACTER-1B279;Lo;0;L;;;;;N;;;;; +1B27A;NUSHU CHARACTER-1B27A;Lo;0;L;;;;;N;;;;; +1B27B;NUSHU CHARACTER-1B27B;Lo;0;L;;;;;N;;;;; +1B27C;NUSHU CHARACTER-1B27C;Lo;0;L;;;;;N;;;;; +1B27D;NUSHU CHARACTER-1B27D;Lo;0;L;;;;;N;;;;; +1B27E;NUSHU CHARACTER-1B27E;Lo;0;L;;;;;N;;;;; +1B27F;NUSHU CHARACTER-1B27F;Lo;0;L;;;;;N;;;;; +1B280;NUSHU CHARACTER-1B280;Lo;0;L;;;;;N;;;;; +1B281;NUSHU CHARACTER-1B281;Lo;0;L;;;;;N;;;;; +1B282;NUSHU CHARACTER-1B282;Lo;0;L;;;;;N;;;;; +1B283;NUSHU CHARACTER-1B283;Lo;0;L;;;;;N;;;;; +1B284;NUSHU CHARACTER-1B284;Lo;0;L;;;;;N;;;;; +1B285;NUSHU CHARACTER-1B285;Lo;0;L;;;;;N;;;;; +1B286;NUSHU CHARACTER-1B286;Lo;0;L;;;;;N;;;;; +1B287;NUSHU CHARACTER-1B287;Lo;0;L;;;;;N;;;;; +1B288;NUSHU CHARACTER-1B288;Lo;0;L;;;;;N;;;;; +1B289;NUSHU CHARACTER-1B289;Lo;0;L;;;;;N;;;;; +1B28A;NUSHU CHARACTER-1B28A;Lo;0;L;;;;;N;;;;; +1B28B;NUSHU CHARACTER-1B28B;Lo;0;L;;;;;N;;;;; +1B28C;NUSHU CHARACTER-1B28C;Lo;0;L;;;;;N;;;;; +1B28D;NUSHU CHARACTER-1B28D;Lo;0;L;;;;;N;;;;; +1B28E;NUSHU CHARACTER-1B28E;Lo;0;L;;;;;N;;;;; +1B28F;NUSHU CHARACTER-1B28F;Lo;0;L;;;;;N;;;;; +1B290;NUSHU CHARACTER-1B290;Lo;0;L;;;;;N;;;;; +1B291;NUSHU CHARACTER-1B291;Lo;0;L;;;;;N;;;;; +1B292;NUSHU CHARACTER-1B292;Lo;0;L;;;;;N;;;;; +1B293;NUSHU CHARACTER-1B293;Lo;0;L;;;;;N;;;;; +1B294;NUSHU CHARACTER-1B294;Lo;0;L;;;;;N;;;;; +1B295;NUSHU CHARACTER-1B295;Lo;0;L;;;;;N;;;;; +1B296;NUSHU CHARACTER-1B296;Lo;0;L;;;;;N;;;;; +1B297;NUSHU CHARACTER-1B297;Lo;0;L;;;;;N;;;;; +1B298;NUSHU CHARACTER-1B298;Lo;0;L;;;;;N;;;;; +1B299;NUSHU CHARACTER-1B299;Lo;0;L;;;;;N;;;;; +1B29A;NUSHU CHARACTER-1B29A;Lo;0;L;;;;;N;;;;; +1B29B;NUSHU CHARACTER-1B29B;Lo;0;L;;;;;N;;;;; +1B29C;NUSHU CHARACTER-1B29C;Lo;0;L;;;;;N;;;;; +1B29D;NUSHU CHARACTER-1B29D;Lo;0;L;;;;;N;;;;; +1B29E;NUSHU CHARACTER-1B29E;Lo;0;L;;;;;N;;;;; +1B29F;NUSHU CHARACTER-1B29F;Lo;0;L;;;;;N;;;;; +1B2A0;NUSHU CHARACTER-1B2A0;Lo;0;L;;;;;N;;;;; +1B2A1;NUSHU CHARACTER-1B2A1;Lo;0;L;;;;;N;;;;; +1B2A2;NUSHU CHARACTER-1B2A2;Lo;0;L;;;;;N;;;;; +1B2A3;NUSHU CHARACTER-1B2A3;Lo;0;L;;;;;N;;;;; +1B2A4;NUSHU CHARACTER-1B2A4;Lo;0;L;;;;;N;;;;; +1B2A5;NUSHU CHARACTER-1B2A5;Lo;0;L;;;;;N;;;;; +1B2A6;NUSHU CHARACTER-1B2A6;Lo;0;L;;;;;N;;;;; +1B2A7;NUSHU CHARACTER-1B2A7;Lo;0;L;;;;;N;;;;; +1B2A8;NUSHU CHARACTER-1B2A8;Lo;0;L;;;;;N;;;;; +1B2A9;NUSHU CHARACTER-1B2A9;Lo;0;L;;;;;N;;;;; +1B2AA;NUSHU CHARACTER-1B2AA;Lo;0;L;;;;;N;;;;; +1B2AB;NUSHU CHARACTER-1B2AB;Lo;0;L;;;;;N;;;;; +1B2AC;NUSHU CHARACTER-1B2AC;Lo;0;L;;;;;N;;;;; +1B2AD;NUSHU CHARACTER-1B2AD;Lo;0;L;;;;;N;;;;; +1B2AE;NUSHU CHARACTER-1B2AE;Lo;0;L;;;;;N;;;;; +1B2AF;NUSHU CHARACTER-1B2AF;Lo;0;L;;;;;N;;;;; +1B2B0;NUSHU CHARACTER-1B2B0;Lo;0;L;;;;;N;;;;; +1B2B1;NUSHU CHARACTER-1B2B1;Lo;0;L;;;;;N;;;;; +1B2B2;NUSHU CHARACTER-1B2B2;Lo;0;L;;;;;N;;;;; +1B2B3;NUSHU CHARACTER-1B2B3;Lo;0;L;;;;;N;;;;; +1B2B4;NUSHU CHARACTER-1B2B4;Lo;0;L;;;;;N;;;;; +1B2B5;NUSHU CHARACTER-1B2B5;Lo;0;L;;;;;N;;;;; +1B2B6;NUSHU CHARACTER-1B2B6;Lo;0;L;;;;;N;;;;; +1B2B7;NUSHU CHARACTER-1B2B7;Lo;0;L;;;;;N;;;;; +1B2B8;NUSHU CHARACTER-1B2B8;Lo;0;L;;;;;N;;;;; +1B2B9;NUSHU CHARACTER-1B2B9;Lo;0;L;;;;;N;;;;; +1B2BA;NUSHU CHARACTER-1B2BA;Lo;0;L;;;;;N;;;;; +1B2BB;NUSHU CHARACTER-1B2BB;Lo;0;L;;;;;N;;;;; +1B2BC;NUSHU CHARACTER-1B2BC;Lo;0;L;;;;;N;;;;; +1B2BD;NUSHU CHARACTER-1B2BD;Lo;0;L;;;;;N;;;;; +1B2BE;NUSHU CHARACTER-1B2BE;Lo;0;L;;;;;N;;;;; +1B2BF;NUSHU CHARACTER-1B2BF;Lo;0;L;;;;;N;;;;; +1B2C0;NUSHU CHARACTER-1B2C0;Lo;0;L;;;;;N;;;;; +1B2C1;NUSHU CHARACTER-1B2C1;Lo;0;L;;;;;N;;;;; +1B2C2;NUSHU CHARACTER-1B2C2;Lo;0;L;;;;;N;;;;; +1B2C3;NUSHU CHARACTER-1B2C3;Lo;0;L;;;;;N;;;;; +1B2C4;NUSHU CHARACTER-1B2C4;Lo;0;L;;;;;N;;;;; +1B2C5;NUSHU CHARACTER-1B2C5;Lo;0;L;;;;;N;;;;; +1B2C6;NUSHU CHARACTER-1B2C6;Lo;0;L;;;;;N;;;;; +1B2C7;NUSHU CHARACTER-1B2C7;Lo;0;L;;;;;N;;;;; +1B2C8;NUSHU CHARACTER-1B2C8;Lo;0;L;;;;;N;;;;; +1B2C9;NUSHU CHARACTER-1B2C9;Lo;0;L;;;;;N;;;;; +1B2CA;NUSHU CHARACTER-1B2CA;Lo;0;L;;;;;N;;;;; +1B2CB;NUSHU CHARACTER-1B2CB;Lo;0;L;;;;;N;;;;; +1B2CC;NUSHU CHARACTER-1B2CC;Lo;0;L;;;;;N;;;;; +1B2CD;NUSHU CHARACTER-1B2CD;Lo;0;L;;;;;N;;;;; +1B2CE;NUSHU CHARACTER-1B2CE;Lo;0;L;;;;;N;;;;; +1B2CF;NUSHU CHARACTER-1B2CF;Lo;0;L;;;;;N;;;;; +1B2D0;NUSHU CHARACTER-1B2D0;Lo;0;L;;;;;N;;;;; +1B2D1;NUSHU CHARACTER-1B2D1;Lo;0;L;;;;;N;;;;; +1B2D2;NUSHU CHARACTER-1B2D2;Lo;0;L;;;;;N;;;;; +1B2D3;NUSHU CHARACTER-1B2D3;Lo;0;L;;;;;N;;;;; +1B2D4;NUSHU CHARACTER-1B2D4;Lo;0;L;;;;;N;;;;; +1B2D5;NUSHU CHARACTER-1B2D5;Lo;0;L;;;;;N;;;;; +1B2D6;NUSHU CHARACTER-1B2D6;Lo;0;L;;;;;N;;;;; +1B2D7;NUSHU CHARACTER-1B2D7;Lo;0;L;;;;;N;;;;; +1B2D8;NUSHU CHARACTER-1B2D8;Lo;0;L;;;;;N;;;;; +1B2D9;NUSHU CHARACTER-1B2D9;Lo;0;L;;;;;N;;;;; +1B2DA;NUSHU CHARACTER-1B2DA;Lo;0;L;;;;;N;;;;; +1B2DB;NUSHU CHARACTER-1B2DB;Lo;0;L;;;;;N;;;;; +1B2DC;NUSHU CHARACTER-1B2DC;Lo;0;L;;;;;N;;;;; +1B2DD;NUSHU CHARACTER-1B2DD;Lo;0;L;;;;;N;;;;; +1B2DE;NUSHU CHARACTER-1B2DE;Lo;0;L;;;;;N;;;;; +1B2DF;NUSHU CHARACTER-1B2DF;Lo;0;L;;;;;N;;;;; +1B2E0;NUSHU CHARACTER-1B2E0;Lo;0;L;;;;;N;;;;; +1B2E1;NUSHU CHARACTER-1B2E1;Lo;0;L;;;;;N;;;;; +1B2E2;NUSHU CHARACTER-1B2E2;Lo;0;L;;;;;N;;;;; +1B2E3;NUSHU CHARACTER-1B2E3;Lo;0;L;;;;;N;;;;; +1B2E4;NUSHU CHARACTER-1B2E4;Lo;0;L;;;;;N;;;;; +1B2E5;NUSHU CHARACTER-1B2E5;Lo;0;L;;;;;N;;;;; +1B2E6;NUSHU CHARACTER-1B2E6;Lo;0;L;;;;;N;;;;; +1B2E7;NUSHU CHARACTER-1B2E7;Lo;0;L;;;;;N;;;;; +1B2E8;NUSHU CHARACTER-1B2E8;Lo;0;L;;;;;N;;;;; +1B2E9;NUSHU CHARACTER-1B2E9;Lo;0;L;;;;;N;;;;; +1B2EA;NUSHU CHARACTER-1B2EA;Lo;0;L;;;;;N;;;;; +1B2EB;NUSHU CHARACTER-1B2EB;Lo;0;L;;;;;N;;;;; +1B2EC;NUSHU CHARACTER-1B2EC;Lo;0;L;;;;;N;;;;; +1B2ED;NUSHU CHARACTER-1B2ED;Lo;0;L;;;;;N;;;;; +1B2EE;NUSHU CHARACTER-1B2EE;Lo;0;L;;;;;N;;;;; +1B2EF;NUSHU CHARACTER-1B2EF;Lo;0;L;;;;;N;;;;; +1B2F0;NUSHU CHARACTER-1B2F0;Lo;0;L;;;;;N;;;;; +1B2F1;NUSHU CHARACTER-1B2F1;Lo;0;L;;;;;N;;;;; +1B2F2;NUSHU CHARACTER-1B2F2;Lo;0;L;;;;;N;;;;; +1B2F3;NUSHU CHARACTER-1B2F3;Lo;0;L;;;;;N;;;;; +1B2F4;NUSHU CHARACTER-1B2F4;Lo;0;L;;;;;N;;;;; +1B2F5;NUSHU CHARACTER-1B2F5;Lo;0;L;;;;;N;;;;; +1B2F6;NUSHU CHARACTER-1B2F6;Lo;0;L;;;;;N;;;;; +1B2F7;NUSHU CHARACTER-1B2F7;Lo;0;L;;;;;N;;;;; +1B2F8;NUSHU CHARACTER-1B2F8;Lo;0;L;;;;;N;;;;; +1B2F9;NUSHU CHARACTER-1B2F9;Lo;0;L;;;;;N;;;;; +1B2FA;NUSHU CHARACTER-1B2FA;Lo;0;L;;;;;N;;;;; +1B2FB;NUSHU CHARACTER-1B2FB;Lo;0;L;;;;;N;;;;; 1BC00;DUPLOYAN LETTER H;Lo;0;L;;;;;N;;;;; 1BC01;DUPLOYAN LETTER X;Lo;0;L;;;;;N;;;;; 1BC02;DUPLOYAN LETTER P;Lo;0;L;;;;;N;;;;; @@ -28269,6 +29217,12 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1F248;TORTOISE SHELL BRACKETED CJK UNIFIED IDEOGRAPH-6557;So;0;L;<compat> 3014 6557 3015;;;;N;;;;; 1F250;CIRCLED IDEOGRAPH ADVANTAGE;So;0;L;<circle> 5F97;;;;N;;;;; 1F251;CIRCLED IDEOGRAPH ACCEPT;So;0;L;<circle> 53EF;;;;N;;;;; +1F260;ROUNDED SYMBOL FOR FU;So;0;ON;;;;;N;;;;; +1F261;ROUNDED SYMBOL FOR LU;So;0;ON;;;;;N;;;;; +1F262;ROUNDED SYMBOL FOR SHOU;So;0;ON;;;;;N;;;;; +1F263;ROUNDED SYMBOL FOR XI;So;0;ON;;;;;N;;;;; +1F264;ROUNDED SYMBOL FOR SHUANGXI;So;0;ON;;;;;N;;;;; +1F265;ROUNDED SYMBOL FOR CAI;So;0;ON;;;;;N;;;;; 1F300;CYCLONE;So;0;ON;;;;;N;;;;; 1F301;FOGGY;So;0;ON;;;;;N;;;;; 1F302;CLOSED UMBRELLA;So;0;ON;;;;;N;;;;; @@ -29248,6 +30202,8 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1F6D0;PLACE OF WORSHIP;So;0;ON;;;;;N;;;;; 1F6D1;OCTAGONAL SIGN;So;0;ON;;;;;N;;;;; 1F6D2;SHOPPING TROLLEY;So;0;ON;;;;;N;;;;; +1F6D3;STUPA;So;0;ON;;;;;N;;;;; +1F6D4;PAGODA;So;0;ON;;;;;N;;;;; 1F6E0;HAMMER AND WRENCH;So;0;ON;;;;;N;;;;; 1F6E1;SHIELD;So;0;ON;;;;;N;;;;; 1F6E2;OIL DRUM;So;0;ON;;;;;N;;;;; @@ -29268,6 +30224,8 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1F6F4;SCOOTER;So;0;ON;;;;;N;;;;; 1F6F5;MOTOR SCOOTER;So;0;ON;;;;;N;;;;; 1F6F6;CANOE;So;0;ON;;;;;N;;;;; +1F6F7;SLED;So;0;ON;;;;;N;;;;; +1F6F8;FLYING SAUCER;So;0;ON;;;;;N;;;;; 1F700;ALCHEMICAL SYMBOL FOR QUINTESSENCE;So;0;ON;;;;;N;;;;; 1F701;ALCHEMICAL SYMBOL FOR AIR;So;0;ON;;;;;N;;;;; 1F702;ALCHEMICAL SYMBOL FOR FIRE;So;0;ON;;;;;N;;;;; @@ -29617,6 +30575,18 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1F8AB;RIGHTWARDS FRONT-TILTED SHADOWED WHITE ARROW;So;0;ON;;;;;N;;;;; 1F8AC;WHITE ARROW SHAFT WIDTH ONE;So;0;ON;;;;;N;;;;; 1F8AD;WHITE ARROW SHAFT WIDTH TWO THIRDS;So;0;ON;;;;;N;;;;; +1F900;CIRCLED CROSS FORMEE WITH FOUR DOTS;So;0;ON;;;;;N;;;;; +1F901;CIRCLED CROSS FORMEE WITH TWO DOTS;So;0;ON;;;;;N;;;;; +1F902;CIRCLED CROSS FORMEE;So;0;ON;;;;;N;;;;; +1F903;LEFT HALF CIRCLE WITH FOUR DOTS;So;0;ON;;;;;N;;;;; +1F904;LEFT HALF CIRCLE WITH THREE DOTS;So;0;ON;;;;;N;;;;; +1F905;LEFT HALF CIRCLE WITH TWO DOTS;So;0;ON;;;;;N;;;;; +1F906;LEFT HALF CIRCLE WITH DOT;So;0;ON;;;;;N;;;;; +1F907;LEFT HALF CIRCLE;So;0;ON;;;;;N;;;;; +1F908;DOWNWARD FACING HOOK;So;0;ON;;;;;N;;;;; +1F909;DOWNWARD FACING NOTCHED HOOK;So;0;ON;;;;;N;;;;; +1F90A;DOWNWARD FACING HOOK WITH DOT;So;0;ON;;;;;N;;;;; +1F90B;DOWNWARD FACING NOTCHED HOOK WITH DOT;So;0;ON;;;;;N;;;;; 1F910;ZIPPER-MOUTH FACE;So;0;ON;;;;;N;;;;; 1F911;MONEY-MOUTH FACE;So;0;ON;;;;;N;;;;; 1F912;FACE WITH THERMOMETER;So;0;ON;;;;;N;;;;; @@ -29632,6 +30602,7 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1F91C;RIGHT-FACING FIST;So;0;ON;;;;;N;;;;; 1F91D;HANDSHAKE;So;0;ON;;;;;N;;;;; 1F91E;HAND WITH INDEX AND MIDDLE FINGERS CROSSED;So;0;ON;;;;;N;;;;; +1F91F;I LOVE YOU HAND SIGN;So;0;ON;;;;;N;;;;; 1F920;FACE WITH COWBOY HAT;So;0;ON;;;;;N;;;;; 1F921;CLOWN FACE;So;0;ON;;;;;N;;;;; 1F922;NAUSEATED FACE;So;0;ON;;;;;N;;;;; @@ -29640,7 +30611,17 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1F925;LYING FACE;So;0;ON;;;;;N;;;;; 1F926;FACE PALM;So;0;ON;;;;;N;;;;; 1F927;SNEEZING FACE;So;0;ON;;;;;N;;;;; +1F928;FACE WITH ONE EYEBROW RAISED;So;0;ON;;;;;N;;;;; +1F929;GRINNING FACE WITH STAR EYES;So;0;ON;;;;;N;;;;; +1F92A;GRINNING FACE WITH ONE LARGE AND ONE SMALL EYE;So;0;ON;;;;;N;;;;; +1F92B;FACE WITH FINGER COVERING CLOSED LIPS;So;0;ON;;;;;N;;;;; +1F92C;SERIOUS FACE WITH SYMBOLS COVERING MOUTH;So;0;ON;;;;;N;;;;; +1F92D;SMILING FACE WITH SMILING EYES AND HAND COVERING MOUTH;So;0;ON;;;;;N;;;;; +1F92E;FACE WITH OPEN MOUTH VOMITING;So;0;ON;;;;;N;;;;; +1F92F;SHOCKED FACE WITH EXPLODING HEAD;So;0;ON;;;;;N;;;;; 1F930;PREGNANT WOMAN;So;0;ON;;;;;N;;;;; +1F931;BREAST-FEEDING;So;0;ON;;;;;N;;;;; +1F932;PALMS UP TOGETHER;So;0;ON;;;;;N;;;;; 1F933;SELFIE;So;0;ON;;;;;N;;;;; 1F934;PRINCE;So;0;ON;;;;;N;;;;; 1F935;MAN IN TUXEDO;So;0;ON;;;;;N;;;;; @@ -29665,6 +30646,7 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1F949;THIRD PLACE MEDAL;So;0;ON;;;;;N;;;;; 1F94A;BOXING GLOVE;So;0;ON;;;;;N;;;;; 1F94B;MARTIAL ARTS UNIFORM;So;0;ON;;;;;N;;;;; +1F94C;CURLING STONE;So;0;ON;;;;;N;;;;; 1F950;CROISSANT;So;0;ON;;;;;N;;;;; 1F951;AVOCADO;So;0;ON;;;;;N;;;;; 1F952;CUCUMBER;So;0;ON;;;;;N;;;;; @@ -29680,6 +30662,19 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1F95C;PEANUTS;So;0;ON;;;;;N;;;;; 1F95D;KIWIFRUIT;So;0;ON;;;;;N;;;;; 1F95E;PANCAKES;So;0;ON;;;;;N;;;;; +1F95F;DUMPLING;So;0;ON;;;;;N;;;;; +1F960;FORTUNE COOKIE;So;0;ON;;;;;N;;;;; +1F961;TAKEOUT BOX;So;0;ON;;;;;N;;;;; +1F962;CHOPSTICKS;So;0;ON;;;;;N;;;;; +1F963;BOWL WITH SPOON;So;0;ON;;;;;N;;;;; +1F964;CUP WITH STRAW;So;0;ON;;;;;N;;;;; +1F965;COCONUT;So;0;ON;;;;;N;;;;; +1F966;BROCCOLI;So;0;ON;;;;;N;;;;; +1F967;PIE;So;0;ON;;;;;N;;;;; +1F968;PRETZEL;So;0;ON;;;;;N;;;;; +1F969;CUT OF MEAT;So;0;ON;;;;;N;;;;; +1F96A;SANDWICH;So;0;ON;;;;;N;;;;; +1F96B;CANNED FOOD;So;0;ON;;;;;N;;;;; 1F980;CRAB;So;0;ON;;;;;N;;;;; 1F981;LION FACE;So;0;ON;;;;;N;;;;; 1F982;SCORPION;So;0;ON;;;;;N;;;;; @@ -29698,7 +30693,36 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1F98F;RHINOCEROS;So;0;ON;;;;;N;;;;; 1F990;SHRIMP;So;0;ON;;;;;N;;;;; 1F991;SQUID;So;0;ON;;;;;N;;;;; +1F992;GIRAFFE FACE;So;0;ON;;;;;N;;;;; +1F993;ZEBRA FACE;So;0;ON;;;;;N;;;;; +1F994;HEDGEHOG;So;0;ON;;;;;N;;;;; +1F995;SAUROPOD;So;0;ON;;;;;N;;;;; +1F996;T-REX;So;0;ON;;;;;N;;;;; +1F997;CRICKET;So;0;ON;;;;;N;;;;; 1F9C0;CHEESE WEDGE;So;0;ON;;;;;N;;;;; +1F9D0;FACE WITH MONOCLE;So;0;ON;;;;;N;;;;; +1F9D1;ADULT;So;0;ON;;;;;N;;;;; +1F9D2;CHILD;So;0;ON;;;;;N;;;;; +1F9D3;OLDER ADULT;So;0;ON;;;;;N;;;;; +1F9D4;BEARDED PERSON;So;0;ON;;;;;N;;;;; +1F9D5;PERSON WITH HEADSCARF;So;0;ON;;;;;N;;;;; +1F9D6;PERSON IN STEAMY ROOM;So;0;ON;;;;;N;;;;; +1F9D7;PERSON CLIMBING;So;0;ON;;;;;N;;;;; +1F9D8;PERSON IN LOTUS POSITION;So;0;ON;;;;;N;;;;; +1F9D9;MAGE;So;0;ON;;;;;N;;;;; +1F9DA;FAIRY;So;0;ON;;;;;N;;;;; +1F9DB;VAMPIRE;So;0;ON;;;;;N;;;;; +1F9DC;MERPERSON;So;0;ON;;;;;N;;;;; +1F9DD;ELF;So;0;ON;;;;;N;;;;; +1F9DE;GENIE;So;0;ON;;;;;N;;;;; +1F9DF;ZOMBIE;So;0;ON;;;;;N;;;;; +1F9E0;BRAIN;So;0;ON;;;;;N;;;;; +1F9E1;ORANGE HEART;So;0;ON;;;;;N;;;;; +1F9E2;BILLED CAP;So;0;ON;;;;;N;;;;; +1F9E3;SCARF;So;0;ON;;;;;N;;;;; +1F9E4;GLOVES;So;0;ON;;;;;N;;;;; +1F9E5;COAT;So;0;ON;;;;;N;;;;; +1F9E6;SOCKS;So;0;ON;;;;;N;;;;; 20000;<CJK Ideograph Extension B, First>;Lo;0;L;;;;;N;;;;; 2A6D6;<CJK Ideograph Extension B, Last>;Lo;0;L;;;;;N;;;;; 2A700;<CJK Ideograph Extension C, First>;Lo;0;L;;;;;N;;;;; @@ -29707,6 +30731,8 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 2B81D;<CJK Ideograph Extension D, Last>;Lo;0;L;;;;;N;;;;; 2B820;<CJK Ideograph Extension E, First>;Lo;0;L;;;;;N;;;;; 2CEA1;<CJK Ideograph Extension E, Last>;Lo;0;L;;;;;N;;;;; +2CEB0;<CJK Ideograph Extension F, First>;Lo;0;L;;;;;N;;;;; +2EBE0;<CJK Ideograph Extension F, Last>;Lo;0;L;;;;;N;;;;; 2F800;CJK COMPATIBILITY IDEOGRAPH-2F800;Lo;0;L;4E3D;;;;N;;;;; 2F801;CJK COMPATIBILITY IDEOGRAPH-2F801;Lo;0;L;4E38;;;;N;;;;; 2F802;CJK COMPATIBILITY IDEOGRAPH-2F802;Lo;0;L;4E41;;;;N;;;;; diff --git a/lib/stdlib/uc_spec/gen_unicode_mod.escript b/lib/stdlib/uc_spec/gen_unicode_mod.escript index fefd7d3b70..fe5a860d45 100755 --- a/lib/stdlib/uc_spec/gen_unicode_mod.escript +++ b/lib/stdlib/uc_spec/gen_unicode_mod.escript @@ -65,7 +65,7 @@ main(_) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% parse_unicode_data(Line0, Acc) -> - Line = string:strip(Line0, right, $\n), + Line = string:chomp(Line0), [CodePoint,Name,_Cat,Class,_BiDi,Decomp, _N1,_N2,_N3,_BDMirror,_Uni1,_Iso|Case] = tokens(Line, ";"), {Dec,Comp} = case to_decomp(Decomp) of @@ -78,14 +78,14 @@ parse_unicode_data(Line0, Acc) -> |Acc]. to_class(String) -> - list_to_integer(string:strip(String, both)). + list_to_integer(string:trim(String, both)). to_decomp("") -> []; to_decomp("<" ++ Str) -> - [Tag,Rest] = string:tokens(Str, ">"), + [Tag,Rest] = string:lexemes(Str, ">"), {list_to_atom(Tag), to_decomp(Rest)}; to_decomp(CodePoints) -> - CPL = string:tokens(CodePoints, " "), + CPL = string:lexemes(CodePoints, " "), [hex_to_int(CP) || CP <- CPL]. to_case(["","",""]) -> []; @@ -105,20 +105,20 @@ parse_special_casing(Line, Table) -> array:set(CP, Entry#cp{cs=Case}, Table). to_scase([Lower,Title,Upper|_]) -> - {unlist([hex_to_int(CP) || CP <- string:strip(string:tokens(Upper, " "), both)]), - unlist([hex_to_int(CP) || CP <- string:strip(string:tokens(Lower, " "), both)]), - unlist([hex_to_int(CP) || CP <- string:strip(string:tokens(Title, " "), both)]), + {unlist([hex_to_int(CP) || CP <- string:lexemes(Upper, " ")]), + unlist([hex_to_int(CP) || CP <- string:lexemes(Lower, " ")]), + unlist([hex_to_int(CP) || CP <- string:lexemes(Title, " ")]), []}. parse_case_folding(Line, Table) -> [CodePoint, Class0, CaseStr |_Comments] = tokens(Line, ";"), - Class = string:strip(Class0, both), + Class = string:trim(Class0, both), if Class =:= "T" -> Table; %% Do not support localization yet Class =:= "S" -> Table; %% Ignore simple true -> CP = hex_to_int(CodePoint), Case = unlist([hex_to_int(CPC) || - CPC <- string:strip(string:tokens(CaseStr, " "), both)]), + CPC <- string:lexemes(CaseStr, " ")]), #cp{cs={U,L,T,_}} = Entry = array:get(CP, Table), array:set(CP, Entry#cp{cs={U,L,T,Case}}, Table) end. @@ -170,7 +170,7 @@ gen_header(Fd) -> io:put_chars(Fd, "-export([spec_version/0, lookup/1, get_case/1]).\n"), io:put_chars(Fd, "-inline([class/1]).\n"), io:put_chars(Fd, "-compile(nowarn_unused_vars).\n"), - io:put_chars(Fd, "-dialyzer({no_improper_lists, [cp/1, gc_prepend/2, gc_e_cont/2]}).\n"), + io:put_chars(Fd, "-dialyzer({no_improper_lists, [cp/1, gc/1, gc_prepend/2, gc_e_cont/2]}).\n"), io:put_chars(Fd, "-type gc() :: char()|[char()].\n\n\n"), ok. @@ -186,7 +186,7 @@ gen_static(Fd) -> " {U,L} -> #{upper=>U,lower=>L,title=>U,fold=>L};\n" " {U,L,T,F} -> #{upper=>U,lower=>L,title=>T,fold=>F}\n" " end.\n\n"), - io:put_chars(Fd, "spec_version() -> {9,0}.\n\n\n"), + io:put_chars(Fd, "spec_version() -> {10,0}.\n\n\n"), io:put_chars(Fd, "class(Codepoint) -> {CCC,_,_} = unicode_table(Codepoint),\n CCC.\n\n"), io:put_chars(Fd, "-spec uppercase(unicode:chardata()) -> " "maybe_improper_list(gc(),unicode:chardata()).\n"), @@ -240,7 +240,7 @@ gen_norm(Fd) -> "-spec nfd(unicode:chardata()) -> maybe_improper_list(gc(),unicode:chardata()) | {error, unicode:chardata()}.\n" "nfd(Str0) ->\n" " case gc(Str0) of\n" - " [GC|R] when GC < 127 -> [GC|R];\n" + " [GC|R] when GC < 128 -> [GC|R];\n" " [GC|Str] -> [decompose(GC)|Str];\n" " [] -> [];\n" " {error,_}=Error -> Error\n end.\n\n" @@ -250,7 +250,7 @@ gen_norm(Fd) -> "-spec nfkd(unicode:chardata()) -> maybe_improper_list(gc(),unicode:chardata()) | {error, unicode:chardata()}.\n" "nfkd(Str0) ->\n" " case gc(Str0) of\n" - " [GC|R] when GC < 127 -> [GC|R];\n" + " [GC|R] when GC < 128 -> [GC|R];\n" " [GC|Str] -> [decompose_compat(GC)|Str];\n" " [] -> [];\n" " {error,_}=Error -> Error\n end.\n\n" @@ -260,7 +260,7 @@ gen_norm(Fd) -> "-spec nfc(unicode:chardata()) -> maybe_improper_list(gc(),unicode:chardata()) | {error, unicode:chardata()}.\n" "nfc(Str0) ->\n" " case gc(Str0) of\n" - " [GC|R] when GC < 255 -> [GC|R];\n" + " [GC|R] when GC < 256 -> [GC|R];\n" " [GC|Str] -> [compose(decompose(GC))|Str];\n" " [] -> [];\n" " {error,_}=Error -> Error\n end.\n\n" @@ -270,7 +270,7 @@ gen_norm(Fd) -> "-spec nfkc(unicode:chardata()) -> maybe_improper_list(gc(),unicode:chardata()) | {error, unicode:chardata()}.\n" "nfkc(Str0) ->\n" " case gc(Str0) of\n" - " [GC|R] when GC < 127 -> [GC|R];\n" + " [GC|R] when GC < 128 -> [GC|R];\n" " [GC|Str] -> [compose_compat_0(decompose_compat(GC))|Str];\n" " [] -> [];\n" " {error,_}=Error -> Error\n end.\n\n" @@ -476,13 +476,30 @@ gen_gc(Fd, GBP) -> "-spec gc(String::unicode:chardata()) ->" " maybe_improper_list() | {error, unicode:chardata()}.\n"), io:put_chars(Fd, + "gc([CP1, CP2|_]=T)\n" + " when CP1 < 256, CP2 < 256, CP1 =/= $\r -> %% Ascii Fast path\n" + " T;\n" + "gc(<<CP1/utf8, Rest/binary>>) ->\n" + " if CP1 < 256, CP1 =/= $\r ->\n" + " case Rest of\n" + " <<CP2/utf8, _/binary>> when CP2 < 256 -> %% Ascii Fast path\n" + " [CP1|Rest];\n" + " _ -> gc_1([CP1|Rest])\n" + " end;\n" + " true -> gc_1([CP1|Rest])\n" + " end;\n" "gc(Str) ->\n" " gc_1(cp(Str)).\n\n" "gc_1([$\\r|R0] = R) ->\n" " case cp(R0) of % Don't break CRLF\n" " [$\\n|R1] -> [[$\\r,$\\n]|R1];\n" " _ -> R\n" - " end;\n"), + " end;\n" + %% "gc_1([CP1, CP2|_]=T) when CP1 < 256, CP2 < 256 ->\n" + %% " T; %% Fast path\n" + %% "gc_1([CP1|<<CP2/utf8, _/binary>>]=T) when CP1 < 256, CP2 < 256 ->\n" + %% " T; %% Fast path\n" + ), io:put_chars(Fd, "%% Handle control\n"), GenControl = fun(Range) -> io:format(Fd, "gc_1~s R0;\n", [gen_clause(Range)]) end, @@ -490,7 +507,7 @@ gen_gc(Fd, GBP) -> [R1,R2,R3|Crs] = CRs0, [GenControl(CP) || CP <- merge_ranges([R1,R2,R3], split), CP =/= {$\r, undefined}], %%GenControl(R1),GenControl(R2),GenControl(R3), - io:format(Fd, "gc_1([CP|R]) when CP < 255 -> gc_extend(R,CP);\n", []), + io:format(Fd, "gc_1([CP|R]) when CP < 256 -> gc_extend(R,CP);\n", []), [GenControl(CP) || CP <- Crs], %% One clause per CP %% CRs0 = merge_ranges(maps:get(cr, GBP) ++ maps:get(lf, GBP) ++ maps:get(control, GBP)), @@ -869,10 +886,10 @@ optimize_ranges_1(Rs) -> hex_to_int([]) -> []; hex_to_int(HexStr) -> - list_to_integer(string:strip(HexStr, both), 16). + list_to_integer(string:trim(HexStr, both), 16). to_atom(Str) -> - list_to_atom(string:to_lower(string:strip(Str, both))). + list_to_atom(string:lowercase(string:trim(Str, both))). foldl(Fun, Acc, Fd) -> Get = fun() -> file:read_line(Fd) end, @@ -892,7 +909,7 @@ foldl_1(Fun, Acc, Get) -> -%% Differs from string:tokens, it returns empty string as token between two delimiters +%% Differs from string:lexemes, it returns empty string as token between two delimiters tokens(S, [C]) -> tokens(lists:reverse(S), C, []). diff --git a/lib/stdlib/vsn.mk b/lib/stdlib/vsn.mk index 48db5dc900..69d258c2f0 100644 --- a/lib/stdlib/vsn.mk +++ b/lib/stdlib/vsn.mk @@ -1 +1 @@ -STDLIB_VSN = 3.4.2 +STDLIB_VSN = 3.4.3 diff --git a/lib/syntax_tools/doc/src/Makefile b/lib/syntax_tools/doc/src/Makefile index e55222e59c..1ce620b3d6 100644 --- a/lib/syntax_tools/doc/src/Makefile +++ b/lib/syntax_tools/doc/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2006-2016. All Rights Reserved. +# Copyright Ericsson AB 2006-2017. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -55,7 +55,7 @@ XML_REF3_FILES = \ merl_transform.xml \ prettypr.xml -XML_PART_FILES = part.xml part_notes.xml +XML_PART_FILES = part.xml XML_CHAPTER_FILES = chapter.xml XML_NOTES_FILES = notes.xml @@ -86,11 +86,11 @@ SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml) TOP_SPECS_FILE = specs.xml # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += +XML_FLAGS += SPECS_FLAGS = -I../../include -DVIPS_FLAGS += +DVIPS_FLAGS += # ---------------------------------------------------- # Targets @@ -112,13 +112,13 @@ $(XML_REF3_FILES): escript $(DOCGEN)/priv/bin/xml_from_edoc.escript $(SRC_DIR)/$(@:%.xml=%.erl) $(XML_CHAPTER_FILES): - escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(VSN) -chapter ../overview.edoc + escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(VSN) -chapter ../overview.edoc gifs: $(GIF_FILES:%=$(HTMLDIR)/%) xml: $(XML_REF3_FILES) $(XML_CHAPTER_FILES) -debug opt: +debug opt: clean clean_docs: rm -rf $(HTMLDIR)/* @@ -126,11 +126,11 @@ clean clean_docs: rm -f $(XML_REF3_FILES) $(XML_CHAPTER_FILES) *.html rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f $(SPECDIR)/* - rm -f errs core *~ + rm -f errs core *~ # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs diff --git a/lib/syntax_tools/doc/src/fascicules.xml b/lib/syntax_tools/doc/src/fascicules.xml deleted file mode 100644 index 37feca543f..0000000000 --- a/lib/syntax_tools/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/syntax_tools/doc/src/notes.xml b/lib/syntax_tools/doc/src/notes.xml index 8c91f01e3b..bd2bcde2c2 100644 --- a/lib/syntax_tools/doc/src/notes.xml +++ b/lib/syntax_tools/doc/src/notes.xml @@ -32,6 +32,21 @@ <p>This document describes the changes made to the Syntax_Tools application.</p> +<section><title>Syntax_Tools 2.1.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Removed all old unused files in the documentation. + </p> + <p> + Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p> + </item> + </list> + </section> + +</section> + <section><title>Syntax_Tools 2.1.3</title> <section><title>Improvements and New Features</title> diff --git a/lib/syntax_tools/doc/src/part_notes.xml b/lib/syntax_tools/doc/src/part_notes.xml deleted file mode 100644 index e02ffddcb2..0000000000 --- a/lib/syntax_tools/doc/src/part_notes.xml +++ /dev/null @@ -1,42 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2007</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>Syntax_Tools Release Notes</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p><em>Syntax_Tools</em> contains modules for handling abstract - Erlang syntax trees, in a way that is compatible with the "parse - trees" of the STDLIB module <c>erl_parse</c>, together with - utilities for reading source files in unusual ways and - pretty-printing syntax trees. Also included is an amazing module - merger and renamer called Igor, as well as an automatic - code-cleaner.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/syntax_tools/src/Makefile b/lib/syntax_tools/src/Makefile index 8325db45a8..c21d2f49c8 100644 --- a/lib/syntax_tools/src/Makefile +++ b/lib/syntax_tools/src/Makefile @@ -75,7 +75,7 @@ $(EBIN)/%.$(EMULATOR):%.erl # special rules and dependencies to apply the transform to itself $(EBIN)/merl_transform.beam: $(EBIN)/merl.beam ./merl_transform.beam \ - ../include/merl.hrl \ + ../include/merl.hrl $(EBIN)/erl_comment_scan.beam \ $(EBIN)/erl_syntax.beam $(EBIN)/erl_syntax_lib.beam ./merl_transform.beam: ./merl_transform.erl $(EBIN)/merl.beam \ ../include/merl.hrl diff --git a/lib/syntax_tools/src/erl_comment_scan.erl b/lib/syntax_tools/src/erl_comment_scan.erl index 07e501e553..e3eb95b819 100644 --- a/lib/syntax_tools/src/erl_comment_scan.erl +++ b/lib/syntax_tools/src/erl_comment_scan.erl @@ -208,7 +208,7 @@ scan_comment([], Cs1, L, Col, M, Ack) -> seen_comment(Cs, Cs1, L, Col, M, Ack) -> %% Compute indentation and strip trailing spaces N = Col - M, - Text = lists:reverse(string:strip(Cs1, left)), + Text = lists:reverse(string:trim(Cs1, leading)), Ack1 = [{L, Col + 1, N, Text} | Ack], scan_lines(Cs, L + 1, 0, 0, Ack1). diff --git a/lib/syntax_tools/src/erl_prettypr.erl b/lib/syntax_tools/src/erl_prettypr.erl index 40ddd2b22a..f03f326278 100644 --- a/lib/syntax_tools/src/erl_prettypr.erl +++ b/lib/syntax_tools/src/erl_prettypr.erl @@ -774,9 +774,17 @@ lay_2(Node, Ctxt) -> class_qualifier -> Ctxt1 = set_prec(Ctxt, max_prec()), D1 = lay(erl_syntax:class_qualifier_argument(Node), Ctxt1), - D2 = lay(erl_syntax:class_qualifier_body(Node), Ctxt1), - beside(D1, beside(text(":"), D2)); - + D2 = lay(erl_syntax:class_qualifier_body(Node), Ctxt1), + Stacktrace = erl_syntax:class_qualifier_stacktrace(Node), + case erl_syntax:variable_name(Stacktrace) of + '_' -> + beside(D1, beside(text(":"), D2)); + _ -> + D3 = lay(erl_syntax:class_qualifier_stacktrace(Node), + Ctxt1), + beside(D1, beside(beside(text(":"), D2), + beside(text(":"), D3))) + end; comment -> D = stack_comment_lines( erl_syntax:comment_text(Node)), diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index 9b2b503762..ed552b73df 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -342,8 +342,10 @@ typed_record_field_body/1, typed_record_field_type/1, class_qualifier/2, + class_qualifier/3, class_qualifier_argument/1, class_qualifier_body/1, + class_qualifier_stacktrace/1, tuple/1, tuple_elements/1, tuple_size/1, @@ -3884,7 +3886,7 @@ fold_try_clause({clause, Pos, [P], Guard, Body}) -> class_qualifier -> {tuple, Pos, [class_qualifier_argument(P), class_qualifier_body(P), - {var, Pos, '_'}]}; + class_qualifier_stacktrace(P)]}; _ -> {tuple, Pos, [{atom, Pos, throw}, P, {var, Pos, '_'}]} end, @@ -3896,9 +3898,9 @@ unfold_try_clauses(Cs) -> unfold_try_clause({clause, Pos, [{tuple, _, [{atom, _, throw}, V, _]}], Guard, Body}) -> {clause, Pos, [V], Guard, Body}; -unfold_try_clause({clause, Pos, [{tuple, _, [C, V, _]}], +unfold_try_clause({clause, Pos, [{tuple, _, [C, V, Stacktrace]}], Guard, Body}) -> - {clause, Pos, [class_qualifier(C, V)], Guard, Body}. + {clause, Pos, [class_qualifier(C, V, Stacktrace)], Guard, Body}. %% ===================================================================== @@ -6725,9 +6727,12 @@ try_expr_after(Node) -> %% %% @see class_qualifier_argument/1 %% @see class_qualifier_body/1 +%% @see class_qualifier_stacktrace/1 %% @see try_expr/4 --record(class_qualifier, {class :: syntaxTree(), body :: syntaxTree()}). +-record(class_qualifier, {class :: syntaxTree(), + body :: syntaxTree(), + stacktrace :: syntaxTree()}). %% type(Node) = class_qualifier %% data(Node) = #class_qualifier{class :: Class, body :: Body} @@ -6737,8 +6742,27 @@ try_expr_after(Node) -> -spec class_qualifier(syntaxTree(), syntaxTree()) -> syntaxTree(). class_qualifier(Class, Body) -> + Underscore = {var, get_pos(Body), '_'}, tree(class_qualifier, - #class_qualifier{class = Class, body = Body}). + #class_qualifier{class = Class, body = Body, + stacktrace = Underscore}). + +%% ===================================================================== +%% @doc Creates an abstract class qualifier. The result represents +%% "<code><em>Class</em>:<em>Body</em>:<em>Stacktrace</em></code>". +%% +%% @see class_qualifier_argument/1 +%% @see class_qualifier_body/1 +%% @see try_expr/4 + +-spec class_qualifier(syntaxTree(), syntaxTree(), syntaxTree()) -> + syntaxTree(). + +class_qualifier(Class, Body, Stacktrace) -> + tree(class_qualifier, + #class_qualifier{class = Class, + body = Body, + stacktrace = Stacktrace}). %% ===================================================================== @@ -6763,6 +6787,16 @@ class_qualifier_argument(Node) -> class_qualifier_body(Node) -> (data(Node))#class_qualifier.body. +%% ===================================================================== +%% @doc Returns the stacktrace subtree of a `class_qualifier' node. +%% +%% @see class_qualifier/2 + +-spec class_qualifier_stacktrace(syntaxTree()) -> syntaxTree(). + +class_qualifier_stacktrace(Node) -> + (data(Node))#class_qualifier.stacktrace. + %% ===================================================================== %% @doc Creates an abstract "implicit fun" expression. If diff --git a/lib/syntax_tools/src/merl_transform.erl b/lib/syntax_tools/src/merl_transform.erl index b298bc407f..571d7e4d86 100644 --- a/lib/syntax_tools/src/merl_transform.erl +++ b/lib/syntax_tools/src/merl_transform.erl @@ -196,7 +196,7 @@ var_name(V) -> V. var_to_tag(V) when is_integer(V) -> V; var_to_tag(V) -> - list_to_atom(string:to_lower(atom_to_list(V))). + list_to_atom(string:lowercase(atom_to_list(V))). pre_expand_case(Expr, Clauses, Line) -> merl:qquote(Line, "merl:switch(_@expr, _@clauses)", diff --git a/lib/syntax_tools/vsn.mk b/lib/syntax_tools/vsn.mk index e0880d61ee..8d37c40742 100644 --- a/lib/syntax_tools/vsn.mk +++ b/lib/syntax_tools/vsn.mk @@ -1 +1 @@ -SYNTAX_TOOLS_VSN = 2.1.3 +SYNTAX_TOOLS_VSN = 2.1.4 diff --git a/lib/tools/doc/src/Makefile b/lib/tools/doc/src/Makefile index d9c3b0ad2a..b554781382 100644 --- a/lib/tools/doc/src/Makefile +++ b/lib/tools/doc/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2016. All Rights Reserved. +# Copyright Ericsson AB 1997-2017. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -47,9 +47,9 @@ XML_REF3_FILES = \ make.xml \ tags.xml \ xref.xml \ - erlang_mode.xml + erlang_mode.xml -XML_PART_FILES = part.xml part_notes.xml part_notes_history.xml +XML_PART_FILES = part.xml XML_CHAPTER_FILES = \ cover_chapter.xml \ @@ -58,8 +58,7 @@ XML_CHAPTER_FILES = \ lcnt_chapter.xml \ erlang_mode_chapter.xml \ xref_chapter.xml \ - notes.xml \ - notes_history.xml + notes.xml BOOK_FILES = book.xml @@ -86,9 +85,9 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += +XML_FLAGS += # ---------------------------------------------------- # Targets @@ -108,17 +107,17 @@ man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) -debug opt: +debug opt: clean clean_docs: rm -rf $(HTMLDIR)/* rm -f $(MAN3DIR)/* rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ + rm -f errs core *~ # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs @@ -132,4 +131,3 @@ release_docs_spec: docs $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" release_spec: - diff --git a/lib/tools/doc/src/fascicules.xml b/lib/tools/doc/src/fascicules.xml deleted file mode 100644 index 37feca543f..0000000000 --- a/lib/tools/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/tools/doc/src/note.gif b/lib/tools/doc/src/note.gif Binary files differdeleted file mode 100644 index 6fffe30419..0000000000 --- a/lib/tools/doc/src/note.gif +++ /dev/null diff --git a/lib/tools/doc/src/notes.xml b/lib/tools/doc/src/notes.xml index 3eaa2058a0..1edc08c9cd 100644 --- a/lib/tools/doc/src/notes.xml +++ b/lib/tools/doc/src/notes.xml @@ -31,6 +31,21 @@ </header> <p>This document describes the changes made to the Tools application.</p> +<section><title>Tools 2.11.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Removed all old unused files in the documentation. + </p> + <p> + Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p> + </item> + </list> + </section> + +</section> + <section><title>Tools 2.11</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/tools/doc/src/part_notes.xml b/lib/tools/doc/src/part_notes.xml deleted file mode 100644 index c4c6fa4d7d..0000000000 --- a/lib/tools/doc/src/part_notes.xml +++ /dev/null @@ -1,39 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2004</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>Tools Release Notes</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p>The <em>Tools</em> application contains a number of stand-alone - tools, which are useful when developing Erlang programs.</p> - <p>For information about older versions, see - <url href="part_notes_history_frame.html">Release Notes History</url>.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/tools/doc/src/part_notes_history.xml b/lib/tools/doc/src/part_notes_history.xml deleted file mode 100644 index a34e35fc56..0000000000 --- a/lib/tools/doc/src/part_notes_history.xml +++ /dev/null @@ -1,39 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part> - <header> - <copyright> - <year>2006</year> - <year>2016</year> - <holder>Ericsson AB, All Rights Reserved</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>Tools Release Notes History</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p>The <em>Tools</em> application contains a number of stand-alone - tools, which are useful when developing Erlang programs.</p> - </description> - <include file="notes_history"></include> -</part> - diff --git a/lib/tools/doc/src/warning.gif b/lib/tools/doc/src/warning.gif Binary files differdeleted file mode 100644 index 96af52360e..0000000000 --- a/lib/tools/doc/src/warning.gif +++ /dev/null diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 411e0e13df..d9efadf64a 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -895,16 +895,16 @@ resulting regexp is surrounded by \\_< and \\_>." "decode_packet" "delay_trap" "delete_element" - "dexit" - "dgroup_leader" "display" "display_nl" "display_string" - "dist_exit" - "dlink" + "dist_get_stat" + "dist_ctrl_get_data" + "dist_ctrl_get_data_notification" + "dist_ctrl_input_handler" + "dist_ctrl_put_data" "dmonitor_node" "dmonitor_p" - "dsend" "dt_append_vm_tag_data" "dt_get_tag" "dt_get_tag_data" @@ -912,7 +912,6 @@ resulting regexp is surrounded by \\_< and \\_>." "dt_put_tag" "dt_restore_tag" "dt_spread_tag" - "dunlink" "convert_time_unit" "external_size" "finish_after_on_load" diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index 5517882ffa..801bbc7461 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -2439,11 +2439,11 @@ do_analyse_to_file1(Module, OutFile, ErlFile, HTML) -> Timestamp = io_lib:format("~p-~s-~s at ~s:~s:~s", [Y, - string:right(integer_to_list(Mo), 2, $0), - string:right(integer_to_list(D), 2, $0), - string:right(integer_to_list(H), 2, $0), - string:right(integer_to_list(Mi), 2, $0), - string:right(integer_to_list(S), 2, $0)]), + string:pad(integer_to_list(Mo), 2, leading, $0), + string:pad(integer_to_list(D), 2, leading, $0), + string:pad(integer_to_list(H), 2, leading, $0), + string:pad(integer_to_list(Mi), 2, leading, $0), + string:pad(integer_to_list(S), 2, leading, $0)]), H2Bin = unicode:characters_to_binary( ["File generated from ",ErlFile," by COVER ", @@ -2493,12 +2493,12 @@ print_lines(Module, CovLines, InFd, OutFd, L, HTML) -> if N=:=0, HTML=:=true -> LineNoNL = Line -- "\n", Str = " 0", - %%Str = string:right("0", 6, 32), + %%Str = string:pad("0", 6, leading, $\s), RedLine = ["<font color=red>",Str,fill1(), LineNoNL,"</font>\n"], ok = file:write(OutFd, RedLine); N < 1000000 -> - Str = string:right(integer_to_list(N), 6, 32), + Str = string:pad(integer_to_list(N), 6, leading, $\s), ok = file:write(OutFd, [Str,fill1(),Line]); N < 10000000 -> Str = integer_to_list(N), diff --git a/lib/tools/src/xref_utils.erl b/lib/tools/src/xref_utils.erl index 02e207d40c..eca751337b 100644 --- a/lib/tools/src/xref_utils.erl +++ b/lib/tools/src/xref_utils.erl @@ -557,12 +557,9 @@ subdir(Dir, SubDir, true) -> %% Avoid "App-01.01" - the zeroes will be lost. filename2appl(File) -> - Pos = string:rstr(File, "-"), - true = Pos > 1, - V = string:sub_string(File, Pos+1), - true = string:len(V) > 0, - VsnT = string:tokens(V, "."), - ApplName = string:sub_string(File, 1, Pos-1), + [ApplName, V] = string:split(File, "-", trailing), + true = string:length(V) > 0, + VsnT = string:lexemes(V, "."), Vsn = [list_to_integer(Vsn) || Vsn <- VsnT], {list_to_atom(ApplName),Vsn}. diff --git a/lib/tools/test/fprof_SUITE.erl b/lib/tools/test/fprof_SUITE.erl index 8fd164a4b3..ae0e7253ad 100644 --- a/lib/tools/test/fprof_SUITE.erl +++ b/lib/tools/test/fprof_SUITE.erl @@ -51,7 +51,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap,{seconds,60}}]. + {timetrap,{seconds,240}}]. all() -> case test_server:is_native(fprof_SUITE) of @@ -571,7 +571,7 @@ seq_r(Start, Stop, Succ, R) -> create_file_slow(Name, N) when is_integer(N), N >= 0 -> {ok, FD} = - file:open(Name, [raw, write, delayed_write, binary]), + file:open(Name, [raw, write, binary]), if N > 256 -> ok = file:write(FD, lists:map(fun (X) -> <<X:32/unsigned>> end, diff --git a/lib/tools/test/xref_SUITE.erl b/lib/tools/test/xref_SUITE.erl index d651cbcfee..018f632948 100644 --- a/lib/tools/test/xref_SUITE.erl +++ b/lib/tools/test/xref_SUITE.erl @@ -1112,27 +1112,16 @@ read_expected(Version) -> {POS7+2,{FF,{erlang,spawn_opt,4}}}, {POS8+1,{FF,{hej,san,1}}}, {POS8+4,{FF,{a,b,1}}}, - {POS8+4,{FF,{erlang,apply,2}}}, - {POS8+5,{FF,{erlang,apply,2}}}, {POS8+6,{FF,{m,f,1}}}, {POS9+1,{FF,{read,bi,0}}}, {POS9+2,{FF,{a,b,1}}}, - {POS9+2,{FF,{erlang,apply,2}}}, - {POS9+3,{FF,{erlang,apply,2}}}, - {POS9+4,{FF,{erlang,apply,2}}}, {POS9+4,{FF,{erlang,not_a_function,1}}}, {POS9+5,{FF,{mod,func,2}}}, {POS9+6,{FF,{erlang,apply,1}}}, - {POS9+7,{FF,{erlang,apply,2}}}, {POS9+7,{FF,{math,add3,1}}}, {POS9+8,{FF,{q,f,1}}}, - {POS10+4,{FF,{erlang,apply,2}}}, {POS10+5,{FF,{mod1,fun1,1}}}, - {POS11+6,{FF,{erlang,apply,2}}}, - {POS12+1,{FF,{erlang,apply,2}}}, - {POS12+4,{FF,{erlang,apply,2}}}, {POS12+5,{FF,{m3,f3,2}}}, - {POS12+7,{FF,{erlang,apply,2}}}, {POS13+1,{FF,{dm,df,1}}}, {POS13+6,{{read,bi,0},{foo,module_info,0}}}, {POS13+7,{{read,bi,0},{read,module_info,0}}}, @@ -1162,15 +1151,26 @@ read_expected(Version) -> {POS3+3, {FF,{erlang,spawn_link,3}}}, {POS3+4, {FF,{erlang,spawn_link,3}}}, {POS6+4, {FF,{erlang,spawn,3}}}, + {POS8+4,{FF,{erlang,apply,2}}}, + {POS8+5,{FF,{erlang,apply,2}}}, {POS8+6,{FF,{erlang,apply,3}}}, {POS8+7,{FF,{erlang,apply,3}}}, {POS9+1,{FF,{erlang,apply,3}}}, + {POS9+2,{FF,{erlang,apply,2}}}, + {POS9+3,{FF,{erlang,apply,2}}}, + {POS9+4,{FF,{erlang,apply,2}}}, {POS9+5,{FF,{erlang,apply,3}}}, + {POS9+7,{FF,{erlang,apply,2}}}, + {POS10+4,{FF,{erlang,apply,2}}}, {POS11+1,{FF,{erlang,apply,3}}}, {POS11+2,{FF,{erlang,apply,3}}}, {POS11+3,{FF,{erlang,apply,3}}}, {POS11+4,{FF,{erlang,apply,3}}}, + {POS11+6,{FF,{erlang,apply,2}}}, + {POS12+1,{FF,{erlang,apply,2}}}, + {POS12+4,{FF,{erlang,apply,2}}}, {POS12+5,{FF,{erlang,apply,3}}}, + {POS12+7,{FF,{erlang,apply,2}}}, {POS12+8,{FF,{erlang,apply,3}}}, {POS13+5, {{read,bi,0},{erlang,length,1}}}, {POS14+3, {{read,bi,0},{erlang,length,1}}}], diff --git a/lib/tools/vsn.mk b/lib/tools/vsn.mk index b9249ae45c..6cafbca6a7 100644 --- a/lib/tools/vsn.mk +++ b/lib/tools/vsn.mk @@ -1 +1 @@ -TOOLS_VSN = 2.11 +TOOLS_VSN = 2.11.1 diff --git a/lib/wx/c_src/wxe_driver.c b/lib/wx/c_src/wxe_driver.c index 5da71818e5..26ae3564e7 100644 --- a/lib/wx/c_src/wxe_driver.c +++ b/lib/wx/c_src/wxe_driver.c @@ -33,6 +33,7 @@ #include <sys/types.h> #include <fcntl.h> +#include <assert.h> #include "wxe_driver.h" #define TEMP_BINARY_SIZE 512 @@ -234,13 +235,21 @@ standard_outputv(ErlDrvData drv_data, ErlIOVec* ev) sd->max_bins = max; } - if(ev->vsize == 2) { - binref->base = ev->iov[1].iov_base; - binref->size = ev->iov[1].iov_len; - binref->from = driver_caller(sd->port_handle); - bin = ev->binv[1]; - driver_binary_inc_refc(bin); /* Otherwise it could get deallocated */ - binref->bin = bin; + if(ev->size > 0) { + assert(ev->vsize == 2 && ev->iov[0].iov_len == 0 + && "erts changed how the ErlIOVec is structured for outputv"); + binref->from = driver_caller(sd->port_handle); + binref->size = ev->iov[1].iov_len; + if(ev->binv[1]) { + binref->base = ev->iov[1].iov_base; + bin = ev->binv[1]; + driver_binary_inc_refc(bin); /* Otherwise it could get deallocated */ + } else { + bin = driver_alloc_binary(ev->iov[1].iov_len); + memcpy(bin->orig_bytes, ev->iov[1].iov_base, ev->iov[1].iov_len); + binref->base = bin->orig_bytes; + } + binref->bin = bin; } else { /* Empty binary (becomes NULL) */ binref->base = NULL; binref->size = 0; diff --git a/lib/wx/doc/src/Makefile b/lib/wx/doc/src/Makefile index 23890f47f0..a76740adf1 100644 --- a/lib/wx/doc/src/Makefile +++ b/lib/wx/doc/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2008-2016. All Rights Reserved. +# Copyright Ericsson AB 2008-2017. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -39,7 +39,7 @@ ModsNoExt = $(ErlMods:%.erl=%) $(GenMods:%.erl=%) XML_APPLICATION_FILES = ref_man.xml XML_REF3_FILES = $(ErlMods:%.erl=%.xml) $(GenMods:%.erl=%.xml) -XML_PART_FILES = part.xml part_notes.xml +XML_PART_FILES = part.xml XML_CHAPTER_FILES = chapter.xml XML_NOTES_FILES = notes.xml diff --git a/lib/wx/doc/src/fascicules.xml b/lib/wx/doc/src/fascicules.xml deleted file mode 100644 index 154c8a3b6d..0000000000 --- a/lib/wx/doc/src/fascicules.xml +++ /dev/null @@ -1,15 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> -</fascicules> - diff --git a/lib/wx/doc/src/notes.xml b/lib/wx/doc/src/notes.xml index 599b5b64fd..69ea906ec0 100644 --- a/lib/wx/doc/src/notes.xml +++ b/lib/wx/doc/src/notes.xml @@ -32,6 +32,22 @@ <p>This document describes the changes made to the wxErlang application.</p> +<section><title>Wx 1.8.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + wx crashes in otp 20.1 if empty binaries was sent down as + arguments.</p> + <p> + Own Id: OTP-14688</p> + </item> + </list> + </section> + +</section> + <section><title>Wx 1.8.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/wx/doc/src/part_notes.xml b/lib/wx/doc/src/part_notes.xml deleted file mode 100644 index 5a5a6494c1..0000000000 --- a/lib/wx/doc/src/part_notes.xml +++ /dev/null @@ -1,38 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2009</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>wxErlang Release Notes</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p>The <em>wxErlang</em> application is an api for writing graphical user - interfaces with wxWidgets. - </p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/wx/examples/demo/demo.erl b/lib/wx/examples/demo/demo.erl index 8fb70ad7b0..8f3291305b 100644 --- a/lib/wx/examples/demo/demo.erl +++ b/lib/wx/examples/demo/demo.erl @@ -411,7 +411,7 @@ find(Ed) -> keyWords() -> L = ["after","begin","case","try","cond","catch","andalso","orelse", - "end","fun","if","let","of","query","receive","when","bnot","not", + "end","fun","if","let","of","receive","when","bnot","not", "div","rem","band","and","bor","bxor","bsl","bsr","or","xor"], lists:flatten([K ++ " " || K <- L] ++ [0]). diff --git a/lib/wx/vsn.mk b/lib/wx/vsn.mk index 039fae322e..7da4529c98 100644 --- a/lib/wx/vsn.mk +++ b/lib/wx/vsn.mk @@ -1 +1 @@ -WX_VSN = 1.8.2 +WX_VSN = 1.8.3 diff --git a/lib/xmerl/doc/src/Makefile b/lib/xmerl/doc/src/Makefile index 2465217e8e..7d0b0b2392 100644 --- a/lib/xmerl/doc/src/Makefile +++ b/lib/xmerl/doc/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2004-2016. All Rights Reserved. +# Copyright Ericsson AB 2004-2017. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -59,9 +59,8 @@ XMERL_XML_FILES = $(XMERL_MODULES:=.xml) XML_REF3_FILES = $(XMERL_XML_FILES) \ xmerl_sax_parser.xml -XML_PART_FILES = \ - part.xml \ - part_notes.xml +XML_PART_FILES = \ + part.xml XML_REF6_FILES = @@ -107,10 +106,10 @@ TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf # ---------------------------------------------------- -# FLAGS +# FLAGS # ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += +XML_FLAGS += +DVIPS_FLAGS += # ---------------------------------------------------- # Targets @@ -120,14 +119,14 @@ $(HTMLDIR)/%.gif: %.gif docs: pdf html man -$(TOP_PDF_FILE): $(XML_FILES) +$(TOP_PDF_FILE): $(XML_FILES) pdf: $(TOP_PDF_FILE) html: gifs $(HTML_REF_MAN_FILE) -$(XMERL_XML_FILES): - escript $(DOCGEN)/priv/bin/xml_from_edoc.escript $(XMERL_DIR)/$(@:%.xml=%.erl) +$(XMERL_XML_FILES): + escript $(DOCGEN)/priv/bin/xml_from_edoc.escript $(XMERL_DIR)/$(@:%.xml=%.erl) man: $(MAN3_FILES) $(MAN6_FILES) @@ -135,15 +134,15 @@ gifs: $(GIF_FILES:%=$(HTMLDIR)/%) xml: $(XMERL_XML_FILES) -debug opt: +debug opt: clean clean_docs: rm -rf $(HTMLDIR)/* - rm -f $(MAN3DIR)/* - rm -f $(MAN6DIR)/* + rm -f $(MAN3DIR)/* + rm -f $(MAN6DIR)/* rm -f $(XMERL_XML_FILES) rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ + rm -f errs core *~ info: @@ -158,7 +157,7 @@ info: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs @@ -177,6 +176,3 @@ release_spec: release_tests_spec: - - - diff --git a/lib/xmerl/doc/src/fascicules.xml b/lib/xmerl/doc/src/fascicules.xml deleted file mode 100644 index 37feca543f..0000000000 --- a/lib/xmerl/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part" href="part_frame.html" entry="no"> - User's Guide - </fascicule> - <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> - Reference Manual - </fascicule> - <fascicule file="part_notes" href="part_notes_frame.html" entry="no"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/xmerl/doc/src/notes.xml b/lib/xmerl/doc/src/notes.xml index 1162561225..f62a8dc53d 100644 --- a/lib/xmerl/doc/src/notes.xml +++ b/lib/xmerl/doc/src/notes.xml @@ -32,6 +32,21 @@ <p>This document describes the changes made to the Xmerl application.</p> +<section><title>Xmerl 1.3.16</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Removed all old unused files in the documentation. + </p> + <p> + Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p> + </item> + </list> + </section> + +</section> + <section><title>Xmerl 1.3.15</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/xmerl/doc/src/part_notes.xml b/lib/xmerl/doc/src/part_notes.xml deleted file mode 100644 index 4ed441c7d4..0000000000 --- a/lib/xmerl/doc/src/part_notes.xml +++ /dev/null @@ -1,40 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2004</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>Xmerl Release Notes</title> - <prepared>Bertil Karlsson</prepared> - <docno></docno> - <date>>2004-12-15</date> - <rev></rev> - <file>part_notes.xml</file> - </header> - <description> - <p>The <em>Xmerl</em> application - contains modules with support for processing of xml files compliant to XML 1.0.</p> - <p>There are also release notes for - <url href="notes_history.html">older versions</url>.</p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/xmerl/vsn.mk b/lib/xmerl/vsn.mk index 2e9c9061d9..ddff0c8894 100644 --- a/lib/xmerl/vsn.mk +++ b/lib/xmerl/vsn.mk @@ -1 +1 @@ -XMERL_VSN = 1.3.15 +XMERL_VSN = 1.3.16 |
